[commit: ghc] wip/nonmoving-gc: rts: Give stack flags proper macros (4928f58)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nonmoving-gc
Link       : http://ghc.haskell.org/trac/ghc/changeset/4928f580183e06db694c2253560c1e6d72925028/ghc

>---------------------------------------------------------------

commit 4928f580183e06db694c2253560c1e6d72925028
Author: Ben Gamari <ben at well-typed.com>
Date:   Tue Feb 5 11:01:10 2019 -0500

    rts: Give stack flags proper macros
    
    This were previously quite unclear and will change a bit under the
    non-moving collector so let's clear this up now.


>---------------------------------------------------------------

4928f580183e06db694c2253560c1e6d72925028
 includes/rts/storage/TSO.h    | 5 +++++
 rts/PrimOps.cmm               | 4 ++--
 rts/Threads.c                 | 4 ++--
 rts/sm/Sanity.c               | 8 ++++----
 rts/sm/Storage.c              | 4 ++--
 utils/deriveConstants/Main.hs | 3 +++
 6 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h
index 9301858..63d2a11 100644
--- a/includes/rts/storage/TSO.h
+++ b/includes/rts/storage/TSO.h
@@ -185,6 +185,11 @@ typedef struct StgTSO_ {
 
 } *StgTSOPtr; // StgTSO defined in rts/Types.h
 
+
+#define STACK_DIRTY 1
+// used by sanity checker to verify that all dirty stacks are on the mutable list
+#define STACK_SANE 64
+
 typedef struct StgStack_ {
     StgHeader  header;
     StgWord32  stack_size;     // stack size in *words*
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 625f5f5..364a075 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1721,7 +1721,7 @@ loop:
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
 
-    if (TO_W_(StgStack_dirty(stack)) == 0) {
+    if ((TO_W_(StgStack_dirty(stack)) & STACK_DIRTY) == 0) {
         ccall dirty_STACK(MyCapability() "ptr", stack "ptr");
     }
 
@@ -1802,7 +1802,7 @@ loop:
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
 
-    if (TO_W_(StgStack_dirty(stack)) == 0) {
+    if ((TO_W_(StgStack_dirty(stack)) & STACK_DIRTY) == 0) {
         ccall dirty_STACK(MyCapability() "ptr", stack "ptr");
     }
 
diff --git a/rts/Threads.c b/rts/Threads.c
index 9776353..674ba80 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -85,7 +85,7 @@ createThread(Capability *cap, W_ size)
     SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS);
     stack->stack_size   = stack_size - sizeofW(StgStack);
     stack->sp           = stack->stack + stack->stack_size;
-    stack->dirty        = 1;
+    stack->dirty        = STACK_DIRTY;
 
     tso = (StgTSO *)allocate(cap, sizeofW(StgTSO));
     TICK_ALLOC_TSO();
@@ -788,7 +788,7 @@ loop:
     // indicate that the MVar operation has now completed.
     tso->_link = (StgTSO*)&stg_END_TSO_QUEUE_closure;
 
-    if (stack->dirty == 0) {
+    if ((stack->dirty & STACK_DIRTY) == 0) {
         dirty_STACK(cap, stack);
     }
 
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index 28c9b43..1b13f4f 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -619,9 +619,9 @@ checkGlobalTSOList (bool checkTSOs)
 
               stack = tso->stackobj;
               while (1) {
-                  if (stack->dirty & 1) {
-                      ASSERT(Bdescr((P_)stack)->gen_no == 0 || (stack->dirty & TSO_MARKED));
-                      stack->dirty &= ~TSO_MARKED;
+                  if (stack->dirty & STACK_DIRTY) {
+                      ASSERT(Bdescr((P_)stack)->gen_no == 0 || (stack->dirty & STACK_SANE));
+                      stack->dirty &= ~STACK_SANE;
                   }
                   frame = (StgUnderflowFrame*) (stack->stack + stack->stack_size
                                                 - sizeofW(StgUnderflowFrame));
@@ -656,7 +656,7 @@ checkMutableList( bdescr *mut_bd, uint32_t gen )
                 ((StgTSO *)p)->flags |= TSO_MARKED;
                 break;
             case STACK:
-                ((StgStack *)p)->dirty |= TSO_MARKED;
+                ((StgStack *)p)->dirty |= STACK_SANE;
                 break;
             }
         }
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index dcc5b3a..8a46787 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -1133,8 +1133,8 @@ dirty_TSO (Capability *cap, StgTSO *tso)
 void
 dirty_STACK (Capability *cap, StgStack *stack)
 {
-    if (stack->dirty == 0) {
-        stack->dirty = 1;
+    if (! (stack->dirty & STACK_DIRTY)) {
+        stack->dirty = STACK_DIRTY;
         recordClosureMutated(cap,(StgClosure*)stack);
     }
 }
diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs
index 5d5dbc4..335afcd 100644
--- a/utils/deriveConstants/Main.hs
+++ b/utils/deriveConstants/Main.hs
@@ -307,6 +307,9 @@ wanteds os = concat
                              "sizeofW(StgHeader) - sizeofW(StgProfHeader)"
           ,constantWord Both "PROF_HDR_SIZE" "sizeofW(StgProfHeader)"
 
+           -- Stack flags for C--
+          ,constantWord C "STACK_DIRTY" "STACK_DIRTY"
+
            -- Size of a storage manager block (in bytes).
           ,constantWord Both "BLOCK_SIZE"  "BLOCK_SIZE"
           ,constantWord C    "MBLOCK_SIZE" "MBLOCK_SIZE"