Commit e1d4140b authored by Ben Gamari's avatar Ben Gamari 🐢

Revert "Improve accuracy of get/setAllocationCounter"

This reverts commit a1a689dd.
parent 8bb150df
......@@ -408,8 +408,8 @@ Opening the nursery corresponds to the following code:
@
tso = CurrentTSO;
cn = CurrentNursery;
bdfree = CurrentNursery->free;
bdstart = CurrentNursery->start;
bdfree = CurrentNuresry->free;
bdstart = CurrentNuresry->start;
// We *add* the currently occupied portion of the nursery block to
// the allocation limit, because we will subtract it again in
......
......@@ -2921,20 +2921,6 @@ primop TraceMarkerOp "traceMarker#" GenPrimOp
has_side_effects = True
out_of_line = True
primop GetThreadAllocationCounter "getThreadAllocationCounter#" GenPrimOp
State# RealWorld -> (# State# RealWorld, INT64 #)
{ Retrieves the allocation counter for the current thread. }
with
has_side_effects = True
out_of_line = True
primop SetThreadAllocationCounter "setThreadAllocationCounter#" GenPrimOp
INT64 -> State# RealWorld -> State# RealWorld
{ Sets the allocation counter for the current thread to the given value. }
with
has_side_effects = True
out_of_line = True
------------------------------------------------------------------------
section "Safe coercions"
------------------------------------------------------------------------
......
......@@ -43,6 +43,8 @@ StgRegTable * resumeThread (void *);
//
int cmp_thread (StgPtr tso1, StgPtr tso2);
int rts_getThreadId (StgPtr tso);
HsInt64 rts_getThreadAllocationCounter (StgPtr tso);
void rts_setThreadAllocationCounter (StgPtr tso, HsInt64 i);
void rts_enableThreadAllocationLimit (StgPtr tso);
void rts_disableThreadAllocationLimit (StgPtr tso);
......
......@@ -468,9 +468,6 @@ RTS_FUN_DECL(stg_traceCcszh);
RTS_FUN_DECL(stg_clearCCSzh);
RTS_FUN_DECL(stg_traceEventzh);
RTS_FUN_DECL(stg_traceMarkerzh);
RTS_FUN_DECL(stg_getThreadAllocationCounterzh);
RTS_FUN_DECL(stg_setThreadAllocationCounterzh);
/* Other misc stuff */
// See wiki:Commentary/Compiler/Backends/PprC#Prototypes
......
......@@ -105,7 +105,6 @@ import Data.Maybe
import GHC.Base
import {-# SOURCE #-} GHC.IO.Handle ( hFlush )
import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )
import GHC.Int
import GHC.IO
import GHC.IO.Encoding.UTF8
import GHC.IO.Exception
......@@ -195,16 +194,18 @@ instance Ord ThreadId where
--
-- @since 4.8.0.0
setAllocationCounter :: Int64 -> IO ()
setAllocationCounter (I64# i) = IO $ \s ->
case setThreadAllocationCounter# i s of s' -> (# s', () #)
setAllocationCounter i = do
ThreadId t <- myThreadId
rts_setThreadAllocationCounter t i
-- | Return the current value of the allocation counter for the
-- current thread.
--
-- @since 4.8.0.0
getAllocationCounter :: IO Int64
getAllocationCounter = IO $ \s ->
case getThreadAllocationCounter# s of (# s', ctr #) -> (# s', I64# ctr #)
getAllocationCounter = do
ThreadId t <- myThreadId
rts_getThreadAllocationCounter t
-- | Enables the allocation counter to be treated as a limit for the
-- current thread. When the allocation limit is enabled, if the
......@@ -241,6 +242,16 @@ disableAllocationLimit = do
ThreadId t <- myThreadId
rts_disableThreadAllocationLimit t
-- We cannot do these operations safely on another thread, because on
-- a 32-bit machine we cannot do atomic operations on a 64-bit value.
-- Therefore, we only expose APIs that allow getting and setting the
-- limit of the current thread.
foreign import ccall unsafe "rts_setThreadAllocationCounter"
rts_setThreadAllocationCounter :: ThreadId# -> Int64 -> IO ()
foreign import ccall unsafe "rts_getThreadAllocationCounter"
rts_getThreadAllocationCounter :: ThreadId# -> IO Int64
foreign import ccall unsafe "rts_enableThreadAllocationLimit"
rts_enableThreadAllocationLimit :: ThreadId# -> IO ()
......
......@@ -2495,23 +2495,3 @@ stg_traceMarkerzh ( W_ msg )
return ();
}
stg_getThreadAllocationCounterzh ()
{
// Account for the allocation in the current block
W_ offset;
offset = Hp - bdescr_start(CurrentNursery);
return (StgTSO_alloc_limit(CurrentTSO) - offset);
}
stg_setThreadAllocationCounterzh ( I64 counter )
{
// Allocation in the current block will be subtracted by
// getThreadAllocationCounter#, so we have to offset any existing
// allocation here. See also openNursery/closeNursery in
// compiler/codeGen/StgCmmForeign.hs.
W_ offset;
offset = Hp - bdescr_start(CurrentNursery);
StgTSO_alloc_limit(CurrentTSO) = counter + offset;
return ();
}
......@@ -744,6 +744,8 @@
SymI_HasProto(rts_isProfiled) \
SymI_HasProto(rts_isDynamic) \
SymI_HasProto(rts_setInCallCapability) \
SymI_HasProto(rts_getThreadAllocationCounter) \
SymI_HasProto(rts_setThreadAllocationCounter) \
SymI_HasProto(rts_enableThreadAllocationLimit) \
SymI_HasProto(rts_disableThreadAllocationLimit) \
SymI_HasProto(rts_setMainThread) \
......@@ -894,8 +896,6 @@
SymI_HasProto(stg_traceCcszh) \
SymI_HasProto(stg_traceEventzh) \
SymI_HasProto(stg_traceMarkerzh) \
SymI_HasProto(stg_getThreadAllocationCounterzh) \
SymI_HasProto(stg_setThreadAllocationCounterzh) \
SymI_HasProto(getMonotonicNSec) \
SymI_HasProto(lockFile) \
SymI_HasProto(unlockFile) \
......
......@@ -165,8 +165,19 @@ rts_getThreadId(StgPtr tso)
}
/* ---------------------------------------------------------------------------
* Enabling and disabling the thread allocation limit
* Getting & setting the thread allocation limit
* ------------------------------------------------------------------------ */
HsInt64 rts_getThreadAllocationCounter(StgPtr tso)
{
// NB. doesn't take into account allocation in the current nursery
// block, so it might be off by up to 4k.
return PK_Int64((W_*)&(((StgTSO *)tso)->alloc_limit));
}
void rts_setThreadAllocationCounter(StgPtr tso, HsInt64 i)
{
ASSIGN_Int64((W_*)&(((StgTSO *)tso)->alloc_limit), i);
}
void rts_enableThreadAllocationLimit(StgPtr tso)
{
......
......@@ -382,10 +382,3 @@ test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, [''])
test('T13832', exit_code(1), compile_and_run, ['-threaded'])
test('T13894', normal, compile_and_run, [''])
test('T14497', normal, compile_and_run, ['-O'])
test('alloccounter1', normal, compile_and_run,
[
# avoid allocating stack chunks, which counts as
# allocation and messes up the results:
'-with-rtsopts=-k1m'
])
module Main where
import Control.Exception
import Control.Monad
import Data.List
import System.Mem
main = do
let
testAlloc n = do
let start = 999999
setAllocationCounter start
evaluate (last [1..n])
c <- getAllocationCounter
-- print (start - c)
return (start - c)
results <- forM [1..1000] testAlloc
print (sort results == results)
-- results better be in ascending order
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment