Revert "Per-thread allocation counters and limits"
authorSimon Marlow <marlowsd@gmail.com>
Sun, 4 May 2014 19:27:42 +0000 (20:27 +0100)
committerSimon Marlow <marlowsd@gmail.com>
Sun, 4 May 2014 19:28:58 +0000 (20:28 +0100)
Problems were found on 32-bit platforms, I'll commit again when I have a fix.

This reverts the following commits:
   54b31f744848da872c7c6366dea840748e01b5cf
   b0534f78a73f972e279eed4447a5687bd6a8308e

33 files changed:
compiler/cmm/CmmLayoutStack.hs
compiler/codeGen/StgCmmForeign.hs
includes/CodeGen.Platform.hs
includes/rts/Constants.h
includes/rts/Flags.h
includes/rts/Threads.h
includes/rts/storage/TSO.h
libraries/base/Control/Exception.hs
libraries/base/Control/Exception/Base.hs
libraries/base/GHC/Conc.lhs
libraries/base/GHC/Conc/Sync.lhs
libraries/base/GHC/IO/Exception.hs
rts/HeapStackCheck.cmm
rts/Linker.c
rts/Prelude.h
rts/RaiseAsync.c
rts/RaiseAsync.h
rts/RtsFlags.c
rts/RtsStartup.c
rts/Schedule.c
rts/Threads.c
rts/package.conf.in
rts/sm/Storage.c
rts/win32/libHSbase.def
testsuite/tests/concurrent/should_run/all.T
testsuite/tests/concurrent/should_run/allocLimit1.hs [deleted file]
testsuite/tests/concurrent/should_run/allocLimit1.stderr [deleted file]
testsuite/tests/concurrent/should_run/allocLimit2.hs [deleted file]
testsuite/tests/concurrent/should_run/allocLimit3.hs [deleted file]
testsuite/tests/concurrent/should_run/allocLimit3.stderr [deleted file]
testsuite/tests/concurrent/should_run/allocLimit3.stdout [deleted file]
testsuite/tests/concurrent/should_run/allocLimit4.hs [deleted file]
utils/deriveConstants/DeriveConstants.hs

index e7d57d5..bdc9478 100644 (file)
@@ -988,12 +988,9 @@ lowerSafeForeignCall dflags block
     id <- newTemp (bWord dflags)
     new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg))
     let (caller_save, caller_load) = callerSaveVolatileRegs dflags
+    load_tso <- newTemp (gcWord dflags)
     load_stack <- newTemp (gcWord dflags)
-    tso <- newTemp (gcWord dflags)
-    cn <- newTemp (bWord dflags)
-    bdfree <- newTemp (bWord dflags)
-    bdstart <- newTemp (bWord dflags)
-    let suspend = saveThreadState dflags tso cn  <*>
+    let suspend = saveThreadState dflags <*>
                   caller_save <*>
                   mkMiddle (callSuspendThread dflags id intrbl)
         midCall = mkUnsafeCall tgt res args
@@ -1002,7 +999,7 @@ lowerSafeForeignCall dflags block
                   -- might now have a different Capability!
                   mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*>
                   caller_load <*>
-                  loadThreadState dflags tso load_stack cn bdfree bdstart
+                  loadThreadState dflags load_tso load_stack
 
         (_, regs, copyout) =
              copyOutOflow dflags NativeReturn Jump (Young succ)
index 2730275..bf88f1c 100644 (file)
@@ -7,15 +7,12 @@
 -----------------------------------------------------------------------------
 
 module StgCmmForeign (
-  cgForeignCall,
+  cgForeignCall, loadThreadState, saveThreadState,
   emitPrimCall, emitCCall,
   emitForeignCall,     -- For CmmParse
-  emitSaveThreadState,
-  saveThreadState,
-  emitLoadThreadState,
-  loadThreadState,
-  emitOpenNursery,
-  emitCloseNursery,
+  emitSaveThreadState, -- will be needed by the Cmm parser
+  emitLoadThreadState, -- ditto
+  emitCloseNursery, emitOpenNursery
  ) where
 
 #include "HsVersions.h"
@@ -267,215 +264,94 @@ maybe_assign_temp e = do
 -- This stuff can't be done in suspendThread/resumeThread, because it
 -- refers to global registers which aren't available in the C world.
 
+saveThreadState :: DynFlags -> CmmAGraph
+saveThreadState dflags =
+  -- CurrentTSO->stackobj->sp = Sp;
+  mkStore (cmmOffset dflags (CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags)) stgSp
+  <*> closeNursery dflags
+  -- and save the current cost centre stack in the TSO when profiling:
+  <*> if gopt Opt_SccProfilingOn dflags then
+        mkStore (cmmOffset dflags stgCurrentTSO (tso_CCCS dflags)) curCCS
+      else mkNop
+
 emitSaveThreadState :: FCode ()
 emitSaveThreadState = do
   dflags <- getDynFlags
-  tso <- newTemp (gcWord dflags)
-  cn <- newTemp (bWord dflags)
-  emit $ saveThreadState dflags tso cn
-
-
--- saveThreadState must be usable from the stack layout pass, where we
--- don't have FCode.  Therefore it takes LocalRegs as arguments, so
--- the caller can create these.
-saveThreadState :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
-saveThreadState dflags tso cn =
-  catAGraphs [
-    -- tso = CurrentTSO;
-    mkAssign (CmmLocal tso) stgCurrentTSO,
-    -- tso->stackobj->sp = Sp;
-    mkStore (cmmOffset dflags (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags)) stgSp,
-    closeNursery dflags tso cn,
-    -- and save the current cost centre stack in the TSO when profiling:
-    if gopt Opt_SccProfilingOn dflags then
-        mkStore (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) curCCS
-      else mkNop
-    ]
+  emit (saveThreadState dflags)
 
 emitCloseNursery :: FCode ()
 emitCloseNursery = do
-  dflags <- getDynFlags
-  tso <- newTemp (gcWord dflags)
-  cn <- newTemp (bWord dflags)
-  emit $ mkAssign (CmmLocal tso) stgCurrentTSO <*>
-         closeNursery dflags tso cn
-
-{-
-Closing the nursery corresponds to the following code:
-
-  tso = CurrentTSO;
-  cn = CurrentNuresry;
+  df <- getDynFlags
+  emit (closeNursery df)
 
-  // Update the allocation limit for the current thread.  We don't
-  // check to see whether it has overflowed at this point, that check is
-  // made when we run out of space in the current heap block (stg_gc_noregs)
-  // and in the scheduler when context switching (schedulePostRunThread).
-  tso->alloc_limit -= Hp + WDS(1) - cn->start;
+   -- CurrentNursery->free = Hp+1;
+closeNursery :: DynFlags -> CmmAGraph
+closeNursery dflags = mkStore (nursery_bdescr_free dflags) (cmmOffsetW dflags stgHp 1)
 
-  // Set cn->free to the next unoccupied word in the block
-  cn->free = Hp + WDS(1);
--}
-
-closeNursery :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
-closeNursery df tso cn =
-  let
-      tsoreg     = CmmLocal tso
-      cnreg      = CmmLocal cn
-  in
+loadThreadState :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
+loadThreadState dflags tso stack = do
   catAGraphs [
-    mkAssign cnreg stgCurrentNursery,
-
-    let alloc =
-           CmmMachOp (mo_wordSub df)
-              [ cmmOffsetW df stgHp 1
-              , CmmLoad (nursery_bdescr_start df cnreg) (bWord df)
-              ]
-
-        alloc_limit = cmmOffset df (CmmReg tsoreg) (tso_alloc_limit df)
-    in
-
-    -- tso->alloc_limit += alloc
-    mkStore alloc_limit (CmmMachOp (mo_wordSub df)
-                               [ CmmLoad alloc_limit b64
-                               , alloc ]),
-
-    -- CurrentNursery->free = Hp+1;
-    mkStore (nursery_bdescr_free df cnreg) (cmmOffsetW df stgHp 1)
-   ]
+        -- tso = CurrentTSO;
+        mkAssign (CmmLocal tso) stgCurrentTSO,
+        -- stack = tso->stackobj;
+        mkAssign (CmmLocal stack) (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)),
+        -- Sp = stack->sp;
+        mkAssign sp (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
+        -- SpLim = stack->stack + RESERVED_STACK_WORDS;
+        mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
+                                    (rESERVED_STACK_WORDS dflags)),
+        -- HpAlloc = 0;
+        --   HpAlloc is assumed to be set to non-zero only by a failed
+        --   a heap check, see HeapStackCheck.cmm:GC_GENERIC
+        mkAssign hpAlloc (zeroExpr dflags),
+
+        openNursery dflags,
+        -- and load the current cost centre stack from the TSO when profiling:
+        if gopt Opt_SccProfilingOn dflags then
+          storeCurCCS
+            (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) (ccsType dflags))
+        else mkNop]
 
 emitLoadThreadState :: FCode ()
 emitLoadThreadState = do
   dflags <- getDynFlags
-  tso <- newTemp (gcWord dflags)
-  stack <- newTemp (gcWord dflags)
-  cn <- newTemp (bWord dflags)
-  bdfree <- newTemp (bWord dflags)
-  bdstart <- newTemp (bWord dflags)
-  emit $ loadThreadState dflags tso stack cn bdfree bdstart
-
--- loadThreadState must be usable from the stack layout pass, where we
--- don't have FCode.  Therefore it takes LocalRegs as arguments, so
--- the caller can create these.
-loadThreadState :: DynFlags
-                -> LocalReg -> LocalReg -> LocalReg -> LocalReg -> LocalReg
-                -> CmmAGraph
-loadThreadState dflags tso stack cn bdfree bdstart =
-  catAGraphs [
-    -- tso = CurrentTSO;
-    mkAssign (CmmLocal tso) stgCurrentTSO,
-    -- stack = tso->stackobj;
-    mkAssign (CmmLocal stack) (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_stackobj dflags)) (bWord dflags)),
-    -- Sp = stack->sp;
-    mkAssign sp (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_SP dflags)) (bWord dflags)),
-    -- SpLim = stack->stack + RESERVED_STACK_WORDS;
-    mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
-                                (rESERVED_STACK_WORDS dflags)),
-    -- HpAlloc = 0;
-    --   HpAlloc is assumed to be set to non-zero only by a failed
-    --   a heap check, see HeapStackCheck.cmm:GC_GENERIC
-    mkAssign hpAlloc (zeroExpr dflags),
-    openNursery dflags tso cn bdfree bdstart,
-    -- and load the current cost centre stack from the TSO when profiling:
-    if gopt Opt_SccProfilingOn dflags
-       then storeCurCCS
-              (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso))
-                 (tso_CCCS dflags)) (ccsType dflags))
-       else mkNop
-   ]
-
+  load_tso <- newTemp (gcWord dflags)
+  load_stack <- newTemp (gcWord dflags)
+  emit $ loadThreadState dflags load_tso load_stack
 
 emitOpenNursery :: FCode ()
 emitOpenNursery = do
-  dflags <- getDynFlags
-  tso <- newTemp (gcWord dflags)
-  cn <- newTemp (bWord dflags)
-  bdfree <- newTemp (bWord dflags)
-  bdstart <- newTemp (bWord dflags)
-  emit $ mkAssign (CmmLocal tso) stgCurrentTSO <*>
-         openNursery dflags tso cn bdfree bdstart
-
-{-
-Opening the nursery corresponds to the following code:
-
-   tso = CurrentTSO;
-   cn = CurrentNursery;
-   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
-   // closeNursery.
-   tso->alloc_limit += bdfree - bdstart;
-
-   // Set Hp to the last occupied word of the heap block.  Why not the
-   // next unocupied word?  Doing it this way means that we get to use
-   // an offset of zero more often, which might lead to slightly smaller
-   // code on some architectures.
-   Hp = bdfree - WDS(1);
-
-   // Set HpLim to the end of the current nursery block (note that this block
-   // might be a block group, consisting of several adjacent blocks.
-   HpLim = bdstart + CurrentNursery->blocks*BLOCK_SIZE_W - 1;
--}
-
-openNursery :: DynFlags
-            -> LocalReg -> LocalReg -> LocalReg -> LocalReg
-            -> CmmAGraph
-openNursery df tso cn bdfree bdstart =
-  let
-      tsoreg     = CmmLocal tso
-      cnreg      = CmmLocal cn
-      bdfreereg  = CmmLocal bdfree
-      bdstartreg = CmmLocal bdstart
-  in
-  catAGraphs [
-     mkAssign cnreg stgCurrentNursery,
-     mkAssign bdfreereg  (CmmLoad (nursery_bdescr_free df cnreg)  (bWord df)),
-     mkAssign bdstartreg (CmmLoad (nursery_bdescr_start df cnreg) (bWord df)),
-
-     -- alloc = bd->free - bd->start
-     let alloc =
-           CmmMachOp (mo_wordSub df) [CmmReg bdfreereg, CmmReg bdstartreg]
-
-         alloc_limit = cmmOffset df (CmmReg tsoreg) (tso_alloc_limit df)
-     in
-
-     -- tso->alloc_limit += alloc
-     mkStore alloc_limit (CmmMachOp (mo_wordAdd df)
-                               [ CmmLoad alloc_limit b64
-                               , alloc ]),
-
-     -- Hp = CurrentNursery->free - 1;
-     mkAssign hp (cmmOffsetW df (CmmReg bdfreereg) (-1)),
-
-     -- HpLim = CurrentNursery->start +
-     --              CurrentNursery->blocks*BLOCK_SIZE_W - 1;
-     mkAssign hpLim
-         (cmmOffsetExpr df
-             (CmmReg bdstartreg)
-             (cmmOffset df
-               (CmmMachOp (mo_wordMul df) [
-                 CmmMachOp (MO_SS_Conv W32 (wordWidth df))
-                   [CmmLoad (nursery_bdescr_blocks df cnreg) b32],
-                 mkIntExpr df (bLOCK_SIZE df)
-                ])
-               (-1)
-             )
-         )
+  df <- getDynFlags
+  emit (openNursery df)
+
+openNursery :: DynFlags -> CmmAGraph
+openNursery dflags = catAGraphs [
+        -- Hp = CurrentNursery->free - 1;
+        mkAssign hp (cmmOffsetW dflags (CmmLoad (nursery_bdescr_free dflags) (bWord dflags)) (-1)),
+
+        -- HpLim = CurrentNursery->start +
+        --              CurrentNursery->blocks*BLOCK_SIZE_W - 1;
+        mkAssign hpLim
+            (cmmOffsetExpr dflags
+                (CmmLoad (nursery_bdescr_start dflags) (bWord dflags))
+                (cmmOffset dflags
+                  (CmmMachOp (mo_wordMul dflags) [
+                    CmmMachOp (MO_SS_Conv W32 (wordWidth dflags))
+                      [CmmLoad (nursery_bdescr_blocks dflags) b32],
+                    mkIntExpr dflags (bLOCK_SIZE dflags)
+                   ])
+                  (-1)
+                )
+            )
    ]
 
-nursery_bdescr_free, nursery_bdescr_start, nursery_bdescr_blocks
-  :: DynFlags -> CmmReg -> CmmExpr
-nursery_bdescr_free   dflags cn =
-  cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_free dflags)
-nursery_bdescr_start  dflags cn =
-  cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_start dflags)
-nursery_bdescr_blocks dflags cn =
-  cmmOffset dflags (CmmReg cn) (oFFSET_bdescr_blocks dflags)
+nursery_bdescr_free, nursery_bdescr_start, nursery_bdescr_blocks :: DynFlags -> CmmExpr
+nursery_bdescr_free   dflags = cmmOffset dflags stgCurrentNursery (oFFSET_bdescr_free dflags)
+nursery_bdescr_start  dflags = cmmOffset dflags stgCurrentNursery (oFFSET_bdescr_start dflags)
+nursery_bdescr_blocks dflags = cmmOffset dflags stgCurrentNursery (oFFSET_bdescr_blocks dflags)
 
-tso_stackobj, tso_CCCS, tso_alloc_limit, stack_STACK, stack_SP :: DynFlags -> ByteOff
+tso_stackobj, tso_CCCS, stack_STACK, stack_SP :: DynFlags -> ByteOff
 tso_stackobj dflags = closureField dflags (oFFSET_StgTSO_stackobj dflags)
-tso_alloc_limit dflags = closureField dflags (oFFSET_StgTSO_alloc_limit dflags)
 tso_CCCS     dflags = closureField dflags (oFFSET_StgTSO_cccs dflags)
 stack_STACK  dflags = closureField dflags (oFFSET_StgStack_stack dflags)
 stack_SP     dflags = closureField dflags (oFFSET_StgStack_sp dflags)
index f3abb3d..3d6dd41 100644 (file)
@@ -741,8 +741,10 @@ globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)
 # ifdef REG_CurrentNursery
 globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)
 # endif
-#endif
 globalRegMaybe _                        = Nothing
+#else
+globalRegMaybe = panic "globalRegMaybe not defined for this platform"
+#endif
 
 freeReg :: RegNo -> FastBool
 
index a7eef0f..842c37b 100644 (file)
 #define TSO_SQUEEZED 128
 
 /*
- * Enables the AllocationLimitExceeded exception when the thread's
- * allocation limit goes negative.
- */
-#define TSO_ALLOC_LIMIT 256
-
-/*
  * The number of times we spin in a spin lock before yielding (see
  * #3758).  To tune this value, use the benchmark in #3758: run the
  * server with -N2 and the client both on a dual-core.  Also make sure
index ec54270..bf6a7f3 100644 (file)
@@ -56,14 +56,6 @@ struct GC_FLAGS {
     rtsBool doIdleGC;
 
     StgWord heapBase;           /* address to ask the OS for memory */
-
-    StgWord allocLimitGrace;    /* units: *blocks*
-                                 * After an AllocationLimitExceeded
-                                 * exception has been raised, how much
-                                 * extra space is given to the thread
-                                 * to handle the exception before we
-                                 * raise it again.
-                                 */
 };
 
 struct DEBUG_FLAGS {  
index f6264ad..da6f7a4 100644 (file)
@@ -42,12 +42,8 @@ StgRegTable * resumeThread  (void *);
 //
 // Thread operations from Threads.c
 //
-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);
+int    cmp_thread      (StgPtr tso1, StgPtr tso2);
+int    rts_getThreadId (StgPtr tso);
 
 #if !defined(mingw32_HOST_OS)
 pid_t  forkProcess     (HsStablePtr *entry);
index b933067..187b668 100644 (file)
@@ -145,18 +145,15 @@ typedef struct StgTSO_ {
     */
     struct StgBlockingQueue_ *bq;
 
-    /*
-     * The allocation limit for this thread, which is updated as the
-     * thread allocates.  If the value drops below zero, and
-     * TSO_ALLOC_LIMIT is set in flags, we raise an exception in the
-     * thread, and give the thread a little more space to handle the
-     * exception before we raise the exception again.
-     *
-     * This is an integer, because we might update it in a place where
-     * it isn't convenient to raise the exception, so we want it to
-     * stay negative until we get around to checking it.
-     */
-    StgInt64  alloc_limit;     /* in bytes */
+#ifdef TICKY_TICKY
+    /* TICKY-specific stuff would go here. */
+#endif
+#ifdef PROFILING
+    StgTSOProfInfo prof;
+#endif
+#ifdef mingw32_HOST_OS
+    StgWord32 saved_winerror;
+#endif
 
     /*
      * sum of the sizes of all stack chunks (in words), used to decide
@@ -171,16 +168,6 @@ typedef struct StgTSO_ {
      */
     StgWord32  tot_stack_size;
 
-#ifdef TICKY_TICKY
-    /* TICKY-specific stuff would go here. */
-#endif
-#ifdef PROFILING
-    StgTSOProfInfo prof;
-#endif
-#ifdef mingw32_HOST_OS
-    StgWord32 saved_winerror;
-#endif
-
 } *StgTSOPtr;
 
 typedef struct StgStack_ {
index e13a0e9..7c019eb 100644 (file)
@@ -48,7 +48,6 @@ module Control.Exception (
         NestedAtomically(..),
         BlockedIndefinitelyOnMVar(..),
         BlockedIndefinitelyOnSTM(..),
-        AllocationLimitExceeded(..),
         Deadlock(..),
         NoMethodError(..),
         PatternMatchFail(..),
index be9f4e5..d8a0d96 100644 (file)
@@ -31,7 +31,6 @@ module Control.Exception.Base (
         NestedAtomically(..),
         BlockedIndefinitelyOnMVar(..),
         BlockedIndefinitelyOnSTM(..),
-        AllocationLimitExceeded(..),
         Deadlock(..),
         NoMethodError(..),
         PatternMatchFail(..),
index 804fd15..1ba17f2 100644 (file)
@@ -60,12 +60,6 @@ module GHC.Conc
         , threadWaitWriteSTM
         , closeFdWith
 
-        -- * Allocation counter and limit
-        , setAllocationCounter
-        , getAllocationCounter
-        , enableAllocationLimit
-        , disableAllocationLimit
-
         -- * TVars
         , STM(..)
         , atomically
index 6d786f5..ebb7226 100644 (file)
@@ -61,12 +61,6 @@ module GHC.Conc.Sync
         , threadStatus
         , threadCapability
 
-        -- * Allocation counter and quota
-        , setAllocationCounter
-        , getAllocationCounter
-        , enableAllocationLimit
-        , disableAllocationLimit
-
         -- * TVars
         , STM(..)
         , atomically
@@ -183,92 +177,16 @@ instance Eq ThreadId where
 instance Ord ThreadId where
    compare = cmpThread
 
--- | Every thread has an allocation counter that tracks how much
--- memory has been allocated by the thread.  The counter is
--- initialized to zero, and 'setAllocationCounter' sets the current
--- value.  The allocation counter counts *down*, so in the absence of
--- a call to 'setAllocationCounter' its value is the negation of the
--- number of bytes of memory allocated by the thread.
---
--- There are two things that you can do with this counter:
---
--- * Use it as a simple profiling mechanism, with
---   'getAllocationCounter'.
---
--- * Use it as a resource limit.  See 'enableAllocationLimit'.
---
--- Allocation accounting is accurate only to about 4Kbytes.
---
-setAllocationCounter :: Int64 -> IO ()
-setAllocationCounter i = do
-  ThreadId t <- myThreadId
-  rts_setThreadAllocationCounter t i
-
--- | Return the current value of the allocation counter for the
--- current thread.
-getAllocationCounter :: IO Int64
-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
--- allocation counter counts down below zero, the thread will be sent
--- the 'AllocationLimitExceeded' asynchronous exception.  When this
--- happens, the counter is reinitialised (by default
--- to 100K, but tunable with the @+RTS -xq@ option) so that it can handle
--- the exception and perform any necessary clean up.  If it exhausts
--- this additional allowance, another 'AllocationLimitExceeded' exception
--- is sent, and so forth.
---
--- Note that memory allocation is unrelated to /live memory/, also
--- known as /heap residency/.  A thread can allocate a large amount of
--- memory and retain anything between none and all of it.  It is
--- better to think of the allocation limit as a limit on
--- /CPU time/, rather than a limit on memory.
---
--- Compared to using timeouts, allocation limits don't count time
--- spent blocked or in foreign calls.
---
-enableAllocationLimit :: IO ()
-enableAllocationLimit = do
-  ThreadId t <- myThreadId
-  rts_enableThreadAllocationLimit t
-
--- | Disable allocation limit processing for the current thread.
-disableAllocationLimit :: IO ()
-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 ()
-
-foreign import ccall unsafe "rts_disableThreadAllocationLimit"
-  rts_disableThreadAllocationLimit :: ThreadId# -> IO ()
-
 {- |
-Creates a new thread to run the 'IO' computation passed as the
+Sparks off a new thread to run the 'IO' computation passed as the
 first argument, and returns the 'ThreadId' of the newly created
 thread.
 
-The new thread will be a lightweight, /unbound/ thread.  Foreign calls
-made by this thread are not guaranteed to be made by any particular OS
-thread; if you need foreign calls to be made by a particular OS
-thread, then use 'Control.Concurrent.forkOS' instead.
+The new thread will be a lightweight thread; if you want to use a foreign
+library that uses thread-local storage, use 'Control.Concurrent.forkOS' instead.
 
-The new thread inherits the /masked/ state of the parent (see
-'Control.Exception.mask').
+GHC note: the new thread inherits the /masked/ state of the parent
+(see 'Control.Exception.mask').
 
 The newly created thread has an exception handler that discards the
 exceptions 'BlockedIndefinitelyOnMVar', 'BlockedIndefinitelyOnSTM', and
index af9e766..7f5bc4e 100644 (file)
@@ -22,7 +22,6 @@ module GHC.IO.Exception (
   BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
   BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
   Deadlock(..),
-  AllocationLimitExceeded(..), allocationLimitExceeded,
   AssertionFailed(..),
 
   SomeAsyncException(..),
@@ -100,23 +99,6 @@ instance Show Deadlock where
 
 -----
 
--- |This thread has exceeded its allocation limit.  See
--- 'GHC.Conc.setAllocationCounter' and
--- 'GHC.Conc.enableAllocationLimit'.
-data AllocationLimitExceeded = AllocationLimitExceeded
-    deriving Typeable
-
-instance Exception AllocationLimitExceeded
-
-instance Show AllocationLimitExceeded where
-    showsPrec _ AllocationLimitExceeded =
-      showString "allocation limit exceeded"
-
-allocationLimitExceeded :: SomeException -- for the RTS
-allocationLimitExceeded = toException AllocationLimitExceeded
-
------
-
 -- |'assert' was applied to 'False'.
 data AssertionFailed = AssertionFailed String
     deriving Typeable
@@ -193,8 +175,7 @@ data ArrayException
 
 instance Exception ArrayException
 
--- for the RTS
-stackOverflow, heapOverflow :: SomeException
+stackOverflow, heapOverflow :: SomeException -- for the RTS
 stackOverflow = toException StackOverflow
 heapOverflow  = toException HeapOverflow
 
index 2808203..12bcfb2 100644 (file)
@@ -100,9 +100,7 @@ stg_gc_noregs
             CurrentNursery = bdescr_link(CurrentNursery);
             OPEN_NURSERY();
             if (Capability_context_switch(MyCapability()) != 0 :: CInt ||
-                Capability_interrupt(MyCapability())      != 0 :: CInt ||
-                (StgTSO_alloc_limit(CurrentTSO) `lt` 0 &&
-                 (TO_W_(StgTSO_flags(CurrentTSO)) & TSO_ALLOC_LIMIT) != 0)) {
+                Capability_interrupt(MyCapability())      != 0 :: CInt) {
                 ret = ThreadYielding;
                 goto sched;
             } else {
index 6ddf4be..ea7c1c6 100644 (file)
@@ -1230,10 +1230,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(rts_getFunPtr)                                      \
       SymI_HasProto(rts_getStablePtr)                                   \
       SymI_HasProto(rts_getThreadId)                                    \
-      SymI_HasProto(rts_getThreadAllocationCounter)                     \
-      SymI_HasProto(rts_setThreadAllocationCounter)                     \
-      SymI_HasProto(rts_enableThreadAllocationLimit)                    \
-      SymI_HasProto(rts_disableThreadAllocationLimit)                   \
       SymI_HasProto(rts_getWord)                                        \
       SymI_HasProto(rts_getWord8)                                       \
       SymI_HasProto(rts_getWord16)                                      \
index ca08e2c..89e80a0 100644 (file)
@@ -37,7 +37,6 @@ extern StgClosure ZCMain_main_closure;
 
 PRELUDE_CLOSURE(base_GHCziIOziException_stackOverflow_closure);
 PRELUDE_CLOSURE(base_GHCziIOziException_heapOverflow_closure);
-PRELUDE_CLOSURE(base_GHCziIOziException_allocationLimitExceeded_closure);
 PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnThrowTo_closure);
 PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnMVar_closure);
 PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnSTM_closure);
@@ -101,7 +100,6 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
 
 #define stackOverflow_closure     DLL_IMPORT_DATA_REF(base_GHCziIOziException_stackOverflow_closure)
 #define heapOverflow_closure      DLL_IMPORT_DATA_REF(base_GHCziIOziException_heapOverflow_closure)
-#define allocationLimitExceeded_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_allocationLimitExceeded_closure)
 #define blockedIndefinitelyOnMVar_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_blockedIndefinitelyOnMVar_closure)
 #define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_blockedIndefinitelyOnSTM_closure)
 #define nonTermination_closure    DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nonTermination_closure)
index 847076b..a5440e4 100644 (file)
@@ -89,60 +89,6 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
 }
 
 /* -----------------------------------------------------------------------------
-   throwToSelf
-
-   Useful for throwing an async exception in a thread from the
-   runtime.  It handles unlocking the throwto message returned by
-   throwTo().
-
-   Note [Throw to self when masked]
-   
-   When a StackOverflow occurs when the thread is masked, we want to
-   defer the exception to when the thread becomes unmasked/hits an
-   interruptible point.  We already have a mechanism for doing this,
-   the blocked_exceptions list, but the use here is a bit unusual,
-   because an exception is normally only added to this list upon
-   an asynchronous 'throwTo' call (with all of the relevant
-   multithreaded nonsense). Morally, a stack overflow should be an
-   asynchronous exception sent by a thread to itself, and it should
-   have the same semantics.  But there are a few key differences:
-   
-   - If you actually tried to send an asynchronous exception to
-     yourself using throwTo, the exception would actually immediately
-     be delivered.  This is because throwTo itself is considered an
-     interruptible point, so the exception is always deliverable. Thus,
-     ordinarily, we never end up with a message to onesself in the
-     blocked_exceptions queue.
-   
-   - In the case of a StackOverflow, we don't actually care about the
-     wakeup semantics; when an exception is delivered, the thread that
-     originally threw the exception should be woken up, since throwTo
-     blocks until the exception is successfully thrown.  Fortunately,
-     it is harmless to wakeup a thread that doesn't actually need waking
-     up, e.g. ourselves.
-   
-   - No synchronization is necessary, because we own the TSO and the
-     capability.  You can observe this by tracing through the execution
-     of throwTo.  We skip synchronizing the message and inter-capability
-     communication.
-   
-   We think this doesn't break any invariants, but do be careful!
-   -------------------------------------------------------------------------- */
-
-void
-throwToSelf (Capability *cap, StgTSO *tso, StgClosure *exception)
-{
-    MessageThrowTo *m;
-
-    m = throwTo(cap, tso, tso, exception);
-
-    if (m != NULL) {
-        // throwTo leaves it locked
-        unlockClosure((StgClosure*)m, &stg_MSG_THROWTO_info);
-    }
-}
-
-/* -----------------------------------------------------------------------------
    throwTo
 
    This function may be used to throw an exception from one thread to
index 65ca4f5..1f61b8c 100644 (file)
@@ -28,11 +28,7 @@ void throwToSingleThreaded_ (Capability *cap,
                             StgClosure *exception, 
                             rtsBool stop_at_atomically);
 
-void throwToSelf (Capability *cap,
-                  StgTSO *tso,
-                  StgClosure *exception);
-
-void suspendComputation (Capability *cap,
+void suspendComputation (Capability *cap, 
                         StgTSO *tso, 
                         StgUpdateFrame *stop_here);
 
index fb1e2ec..af1b204 100644 (file)
@@ -137,7 +137,6 @@ void initRtsFlagsDefaults(void)
 #else
     RtsFlags.GcFlags.heapBase           = 0;   /* means don't care */
 #endif
-    RtsFlags.GcFlags.allocLimitGrace    = (100*1024) / BLOCK_SIZE;
 
 #ifdef DEBUG
     RtsFlags.DebugFlags.scheduler       = rtsFalse;
@@ -403,8 +402,6 @@ usage_text[] = {
 "            +PAPI_EVENT   - collect papi preset event PAPI_EVENT",
 "            #NATIVE_EVENT - collect native event NATIVE_EVENT (in hex)",
 #endif
-"  -xq       The allocation limit given to a thread after it receives",
-"            an AllocationLimitExceeded exception. (default: 100k)",
 "",
 "RTS options may also be specified using the GHCRTS environment variable.",
 "",
@@ -1363,13 +1360,6 @@ error = rtsTrue;
 
                   /* The option prefix '-xx' is reserved for future extension.  KSW 1999-11. */
 
-                case 'q':
-                  OPTION_UNSAFE;
-                  RtsFlags.GcFlags.allocLimitGrace
-                      = decodeSize(rts_argv[arg], 3, BLOCK_SIZE, HS_INT_MAX)
-                          / BLOCK_SIZE;
-                  break;
-
                   default:
                     OPTION_SAFE;
                     errorBelch("unknown RTS option: %s",rts_argv[arg]);
index 640811f..aa7306f 100644 (file)
@@ -208,7 +208,6 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     getStablePtr((StgPtr)blockedIndefinitelyOnMVar_closure);
     getStablePtr((StgPtr)nonTermination_closure);
     getStablePtr((StgPtr)blockedIndefinitelyOnSTM_closure);
-    getStablePtr((StgPtr)allocationLimitExceeded_closure);
     getStablePtr((StgPtr)nestedAtomically_closure);
 
     getStablePtr((StgPtr)runSparks_closure);
index b1b489a..adf2b5c 100644 (file)
@@ -481,10 +481,6 @@ run_thread:
     // happened.  So find the new location:
     t = cap->r.rCurrentTSO;
 
-    // cap->r.rCurrentTSO is charged for calls to allocate(), so we
-    // don't want it set during scheduler operations.
-    cap->r.rCurrentTSO = NULL;
-
     // And save the current errno in this thread.
     // XXX: possibly bogus for SMP because this thread might already
     // be running again, see code below.
@@ -1082,21 +1078,6 @@ schedulePostRunThread (Capability *cap, StgTSO *t)
         }
     }
 
-    //
-    // If the current thread's allocation limit has run out, send it
-    // the AllocationLimitExceeded exception.
-
-    if (t->alloc_limit < 0 && (t->flags & TSO_ALLOC_LIMIT)) {
-        // Use a throwToSelf rather than a throwToSingleThreaded, because
-        // it correctly handles the case where the thread is currently
-        // inside mask.  Also the thread might be blocked (e.g. on an
-        // MVar), and throwToSingleThreaded doesn't unblock it
-        // correctly in that case.
-        throwToSelf(cap, t, allocationLimitExceeded_closure);
-        t->alloc_limit = (StgInt64)RtsFlags.GcFlags.allocLimitGrace
-            * BLOCK_SIZE;
-    }
-
   /* some statistics gathering in the parallel case */
 }
 
index b822952..af4353f 100644 (file)
@@ -110,8 +110,6 @@ createThread(Capability *cap, W_ size)
     tso->stackobj       = stack;
     tso->tot_stack_size = stack->stack_size;
 
-    tso->alloc_limit = 0;
-
     tso->trec = NO_TREC;
 
 #ifdef PROFILING
@@ -166,31 +164,6 @@ rts_getThreadId(StgPtr tso)
   return ((StgTSO *)tso)->id;
 }
 
-/* ---------------------------------------------------------------------------
- * 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 ((StgTSO *)tso)->alloc_limit;
-}
-
-void rts_setThreadAllocationCounter(StgPtr tso, HsInt64 i)
-{
-    ((StgTSO *)tso)->alloc_limit = i;
-}
-
-void rts_enableThreadAllocationLimit(StgPtr tso)
-{
-    ((StgTSO *)tso)->flags |= TSO_ALLOC_LIMIT;
-}
-
-void rts_disableThreadAllocationLimit(StgPtr tso)
-{
-    ((StgTSO *)tso)->flags &= ~TSO_ALLOC_LIMIT;
-}
-
 /* -----------------------------------------------------------------------------
    Remove a thread from a queue.
    Fails fatally if the TSO is not on the queue.
@@ -551,8 +524,21 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
                                  stg_min(tso->stackobj->stack + tso->stackobj->stack_size,
                                          tso->stackobj->sp+64)));
 
-        // Note [Throw to self when masked], also #767 and #8303.
-        throwToSelf(cap, tso, (StgClosure *)stackOverflow_closure);
+        if (tso->flags & TSO_BLOCKEX) {
+            // NB. StackOverflow exceptions must be deferred if the thread is
+            // inside Control.Exception.mask.  See bug #767 and bug #8303.
+            // This implementation is a minor hack, see Note [Throw to self when masked]
+            MessageThrowTo *msg = (MessageThrowTo*)allocate(cap, sizeofW(MessageThrowTo));
+            SET_HDR(msg, &stg_MSG_THROWTO_info, CCS_SYSTEM);
+            msg->source = tso;
+            msg->target = tso;
+            msg->exception = (StgClosure *)stackOverflow_closure;
+            blockedThrowTo(cap, tso, msg);
+        } else {
+            // Send this thread the StackOverflow exception
+            throwToSingleThreaded(cap, tso, (StgClosure *)stackOverflow_closure);
+            return;
+        }
     }
 
 
@@ -683,6 +669,39 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
     // IF_DEBUG(scheduler,printTSO(new_tso));
 }
 
+/* Note [Throw to self when masked]
+ *
+ * When a StackOverflow occurs when the thread is masked, we want to
+ * defer the exception to when the thread becomes unmasked/hits an
+ * interruptible point.  We already have a mechanism for doing this,
+ * the blocked_exceptions list, but the use here is a bit unusual,
+ * because an exception is normally only added to this list upon
+ * an asynchronous 'throwTo' call (with all of the relevant
+ * multithreaded nonsense). Morally, a stack overflow should be an
+ * asynchronous exception sent by a thread to itself, and it should
+ * have the same semantics.  But there are a few key differences:
+ *
+ * - If you actually tried to send an asynchronous exception to
+ *   yourself using throwTo, the exception would actually immediately
+ *   be delivered.  This is because throwTo itself is considered an
+ *   interruptible point, so the exception is always deliverable. Thus,
+ *   ordinarily, we never end up with a message to onesself in the
+ *   blocked_exceptions queue.
+ *
+ * - In the case of a StackOverflow, we don't actually care about the
+ *   wakeup semantics; when an exception is delivered, the thread that
+ *   originally threw the exception should be woken up, since throwTo
+ *   blocks until the exception is successfully thrown.  Fortunately,
+ *   it is harmless to wakeup a thread that doesn't actually need waking
+ *   up, e.g. ourselves.
+ *
+ * - No synchronization is necessary, because we own the TSO and the
+ *   capability.  You can observe this by tracing through the execution
+ *   of throwTo.  We skip synchronizing the message and inter-capability
+ *   communication.
+ *
+ * We think this doesn't break any invariants, but do be careful!
+ */
 
 
 /* ---------------------------------------------------------------------------
index 914dd9c..4c8686f 100644 (file)
@@ -98,7 +98,6 @@ ld-options:
          , "-Wl,-u,_base_ControlziExceptionziBase_nonTermination_closure"
          , "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
          , "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
-         , "-Wl,-u,_base_GHCziIOziException_allocationLimitExceeded_closure"
          , "-Wl,-u,_base_ControlziExceptionziBase_nestedAtomically_closure"
          , "-Wl,-u,_base_GHCziWeak_runFinalizzerBatch_closure"
          , "-Wl,-u,_base_GHCziTopHandler_flushStdHandles_closure"
@@ -139,7 +138,6 @@ ld-options:
          , "-Wl,-u,base_ControlziExceptionziBase_nonTermination_closure"
          , "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
          , "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
-         , "-Wl,-u,base_GHCziIOziException_allocationLimitExceeded_closure"
          , "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure"
          , "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure"
          , "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure"
index 865a890..86bd1c2 100644 (file)
@@ -684,10 +684,7 @@ StgPtr allocate (Capability *cap, W_ n)
 
     TICK_ALLOC_HEAP_NOCTR(WDS(n));
     CCS_ALLOC(cap->r.rCCCS,n);
-    if (cap->r.rCurrentTSO != NULL) {
-        cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_);
-    }
-
+    
     if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
         W_ req_blocks =  (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
 
@@ -824,9 +821,6 @@ allocatePinned (Capability *cap, W_ n)
 
     TICK_ALLOC_HEAP_NOCTR(WDS(n));
     CCS_ALLOC(cap->r.rCCCS,n);
-    if (cap->r.rCurrentTSO != NULL) {
-        cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_);
-    }
 
     bd = cap->pinned_object_block;
     
index 6bb19da..119237b 100644 (file)
@@ -36,7 +36,6 @@ EXPORTS
        base_GHCziPack_unpackCString_closure
        base_GHCziIOziException_blockedIndefinitelyOnMVar_closure
        base_GHCziIOziException_blockedIndefinitelyOnSTM_closure
-       base_GHCziIOziException_allocationLimitExceeded_closure
        base_GHCziIOziException_stackOverflow_closure
 
        base_ControlziExceptionziBase_nonTermination_closure
index f8f583e..d4e76c6 100644 (file)
@@ -81,12 +81,6 @@ test('tryReadMVar1', normal, compile_and_run, [''])
 
 test('T7970', normal, compile_and_run, [''])
 
-test('allocLimit1', exit_code(1), compile_and_run, [''])
-test('allocLimit2', normal, compile_and_run, [''])
-test('allocLimit3', exit_code(1), compile_and_run, [''])
-test('allocLimit4', [ extra_run_opts('+RTS -xq300k -RTS') ],
-                    compile_and_run, [''])
-
 # -----------------------------------------------------------------------------
 # These tests we only do for a full run
 
@@ -251,4 +245,3 @@ test('setnumcapabilities001',
 
 # omit ghci, which can't handle unboxed tuples:
 test('compareAndSwap', [omit_ways(['ghci','hpc']), reqlib('primitive')], compile_and_run, [''])
-
diff --git a/testsuite/tests/concurrent/should_run/allocLimit1.hs b/testsuite/tests/concurrent/should_run/allocLimit1.hs
deleted file mode 100644 (file)
index b1c8fa6..0000000
+++ /dev/null
@@ -1,9 +0,0 @@
-module Main (main) where
-
-import GHC.Conc
-
-main = do
-  setAllocationCounter (10*1024)
-  enableAllocationLimit
-  print (length [1..])
-
diff --git a/testsuite/tests/concurrent/should_run/allocLimit1.stderr b/testsuite/tests/concurrent/should_run/allocLimit1.stderr
deleted file mode 100644 (file)
index 2133e14..0000000
+++ /dev/null
@@ -1 +0,0 @@
-allocLimit1: allocation limit exceeded
diff --git a/testsuite/tests/concurrent/should_run/allocLimit2.hs b/testsuite/tests/concurrent/should_run/allocLimit2.hs
deleted file mode 100644 (file)
index 4fd117b..0000000
+++ /dev/null
@@ -1,17 +0,0 @@
-module Main (main) where
-
-import GHC.Conc
-import Control.Concurrent
-import Control.Exception
-import System.Exit
-
-main = do
-  m <- newEmptyMVar
-  let action =  do setAllocationCounter (10*1024)
-                   enableAllocationLimit
-                   print (length [1..])
-  forkFinally action (putMVar m)
-  r <- takeMVar m
-  case r of
-    Left e | Just AllocationLimitExceeded <- fromException e -> return ()
-    _ -> print r >> exitFailure
diff --git a/testsuite/tests/concurrent/should_run/allocLimit3.hs b/testsuite/tests/concurrent/should_run/allocLimit3.hs
deleted file mode 100644 (file)
index 28881dc..0000000
+++ /dev/null
@@ -1,15 +0,0 @@
-module Main (main) where
-
-import GHC.Conc
-import Control.Concurrent
-import Control.Exception
-
-main = do
-  setAllocationCounter (10*1024)
-  enableAllocationLimit
-
-  -- alloc limit overflow while masked: should successfully print the
-  -- result, and then immediately raise the exception
-  r <- mask_ $ try $ print (length [1..100000])
-
-  print (r :: Either SomeException ())
diff --git a/testsuite/tests/concurrent/should_run/allocLimit3.stderr b/testsuite/tests/concurrent/should_run/allocLimit3.stderr
deleted file mode 100644 (file)
index 27ae0a9..0000000
+++ /dev/null
@@ -1 +0,0 @@
-allocLimit3: allocation limit exceeded
diff --git a/testsuite/tests/concurrent/should_run/allocLimit3.stdout b/testsuite/tests/concurrent/should_run/allocLimit3.stdout
deleted file mode 100644 (file)
index f7393e8..0000000
+++ /dev/null
@@ -1 +0,0 @@
-100000
diff --git a/testsuite/tests/concurrent/should_run/allocLimit4.hs b/testsuite/tests/concurrent/should_run/allocLimit4.hs
deleted file mode 100644 (file)
index b589ffa..0000000
+++ /dev/null
@@ -1,31 +0,0 @@
-module Main (main) where
-
-import GHC.Conc
-import Control.Concurrent
-import Control.Exception
-import System.Exit
-import Control.Monad
-
--- check that +RTS -xq is doing the right thing: the test requires
--- +RTS -xq300k
-
-main = do
-  m <- newEmptyMVar
-  let action = do
-         e <- try $ do
-          setAllocationCounter (10*1024)
-          enableAllocationLimit
-          print (length [1..])
-         case e of
-           Left AllocationLimitExceeded{} -> do
-             c <- getAllocationCounter
-             when (c < 250*1024 || c > 350*1024) $ fail "wrong limit grace"
-             print (length [2..])
-           Right _ ->
-             fail "didn't catch AllocationLimitExceeded"
-
-  forkFinally action (putMVar m)
-  r <- takeMVar m
-  case r of
-    Left e | Just AllocationLimitExceeded <- fromException e -> return ()
-    _ -> print r >> exitFailure
index 0ed18bc..8c943f0 100644 (file)
@@ -411,7 +411,6 @@ wanteds = concat
           ,closureField  C    "StgTSO"      "flags"
           ,closureField  C    "StgTSO"      "dirty"
           ,closureField  C    "StgTSO"      "bq"
-          ,closureField  Both "StgTSO"      "alloc_limit"
           ,closureField_ Both "StgTSO_cccs" "StgTSO" "prof.cccs"
           ,closureField  Both "StgTSO"      "stackobj"