tweag · acondolu · Mar 5, 2020
diff --git a/asterius/rts/rts.constants.mjs b/asterius/rts/rts.constants.mjs
@@ -48,6 +48,7 @@ export const offset_StgLargeBitmap_bitmap = 0x8;
 export const sizeof_StgMutArrPtrs = 0x18;
 export const offset_StgMutArrPtrs_ptrs = 0x8;
 export const offset_StgMutArrPtrs_payload = 0x18;
+export const offset_StgMutVar_var = 0x8;
 export const offset_StgMVar_head = 0x8;
 export const offset_StgMVar_tail = 0x10;
 export const offset_StgMVar_value = 0x18;
@@ -78,11 +79,13 @@ export const offset_StgThunk_payload = 0x10;
 export const offset_StgThunkInfoTable_i = 0x0;
 export const offset_StgThunkInfoTable_srt = 0x18;
 export const offset_StgTSO_id = 0x30;
+export const offset_StgTSO_dirty = 0x38;
 export const offset_StgTSO_stackobj = 0x18;
 export const offset_StgTSO_what_next = 0x20;
 export const offset_StgTSO_why_blocked = 0x22;
 export const offset_StgTSO_block_info = 0x28;
 export const offset_StgStack_stack_size = 0x8;
+export const offset_StgStack_dirty = 0xc;
 export const offset_StgStack_sp = 0x10;
 export const offset_StgStack_stack = 0x18;
 export const offset_StgUpdateFrame_updatee = 0x8;

diff --git a/asterius/rts/rts.gc.mjs b/asterius/rts/rts.gc.mjs
@@ -823,11 +823,18 @@ export class GC {
         this.scavengePointersFirst(c + 8, ptrs);
         return (1 + ptrs + non_ptrs) << 3;
       }
+      case ClosureTypes.MUT_VAR_CLEAN: {
+        this.scavengeClosureAt(c + rtsConstants.offset_StgMutVar_var);
+        return rtsConstants.offset_StgMutVar_var + 8;
+      }
+      case ClosureTypes.MUT_VAR_DIRTY: {
+        this.memory.i64Store(c, this.symbolTable["stg_MUT_VAR_CLEAN_info"]);
+        this.scavengeClosureAt(c + rtsConstants.offset_StgMutVar_var);
+        return rtsConstants.offset_StgMutVar_var + 8;
+      }
       case ClosureTypes.CONSTR:
       case ClosureTypes.CONSTR_NOCAF:
       case ClosureTypes.BLACKHOLE:
-      case ClosureTypes.MUT_VAR_CLEAN:
-      case ClosureTypes.MUT_VAR_DIRTY:
       case ClosureTypes.PRIM:
       case ClosureTypes.MUT_PRIM:
       case ClosureTypes.COMPACT_NFDATA: {
@@ -917,8 +924,14 @@ export class GC {
         this.scavengeClosureAt(c + rtsConstants.offset_StgIndStatic_indirectee);
         return; // size not important, this object won't be moved
       }
-      case ClosureTypes.MVAR_CLEAN:
+      case ClosureTypes.MVAR_CLEAN: {
+        this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_head);
+        this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_tail);
+        this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_value);
+        return rtsConstants.offset_StgMVar_value + 8;
+      }
       case ClosureTypes.MVAR_DIRTY: {
+        this.memory.i64Store(c, this.symbolTable["stg_MVAR_CLEAN_info"]);
         this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_head);
         this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_tail);
         this.scavengeClosureAt(c + rtsConstants.offset_StgMVar_value);
@@ -936,8 +949,6 @@ export class GC {
         );
       }
       case ClosureTypes.MUT_ARR_PTRS_CLEAN:
-      case ClosureTypes.MUT_ARR_PTRS_DIRTY:
-      case ClosureTypes.MUT_ARR_PTRS_FROZEN_DIRTY:
       case ClosureTypes.MUT_ARR_PTRS_FROZEN_CLEAN: {
         const ptrs = Number(
           this.memory.i64Load(c + rtsConstants.offset_StgMutArrPtrs_ptrs)
@@ -948,6 +959,28 @@ export class GC {
         );
         return rtsConstants.sizeof_StgMutArrPtrs + (ptrs << 3);
       }
+      case ClosureTypes.MUT_ARR_PTRS_DIRTY: {
+        this.memory.i64Store(c, this.symbolTable["stg_MUT_ARR_PTRS_CLEAN_info"]);
+        const ptrs = Number(
+          this.memory.i64Load(c + rtsConstants.offset_StgMutArrPtrs_ptrs)
+        );
+        this.scavengePointersFirst(
+          c + rtsConstants.offset_StgMutArrPtrs_payload,
+          ptrs
+        );
+        return rtsConstants.sizeof_StgMutArrPtrs + (ptrs << 3);
+      }
+      case ClosureTypes.MUT_ARR_PTRS_FROZEN_DIRTY: {
+        this.memory.i64Store(c, this.symbolTable["stg_MUT_ARR_PTRS_FROZEN_CLEAN_info"]);
+        const ptrs = Number(
+          this.memory.i64Load(c + rtsConstants.offset_StgMutArrPtrs_ptrs)
+        );
+        this.scavengePointersFirst(
+          c + rtsConstants.offset_StgMutArrPtrs_payload,
+          ptrs
+        );
+        return rtsConstants.sizeof_StgMutArrPtrs + (ptrs << 3);
+      }
       case ClosureTypes.WEAK: {
         this.scavengeClosureAt(c + rtsConstants.offset_StgWeak_cfinalizers);
         this.scavengeClosureAt(c + rtsConstants.offset_StgWeak_key);
@@ -956,10 +989,12 @@ export class GC {
         return rtsConstants.offset_StgWeak_link + 8;
       }
       case ClosureTypes.TSO: {
+        this.memory.i32Store(c + rtsConstants.offset_StgTSO_dirty, 0);
         this.scavengeClosureAt(c + rtsConstants.offset_StgTSO_stackobj);
         return; // size not important, this object won't be moved
       }
       case ClosureTypes.STACK: {
+        this.memory.i32Store(c + rtsConstants.offset_StgStack_dirty, 0);
         const
           stack_size =
             this.memory.i32Load(c + rtsConstants.offset_StgStack_stack_size) << 3,
@@ -969,8 +1004,6 @@ export class GC {
         return rtsConstants.offset_StgStack_stack + stack_size;
       }
       case ClosureTypes.SMALL_MUT_ARR_PTRS_CLEAN:
-      case ClosureTypes.SMALL_MUT_ARR_PTRS_DIRTY:
-      case ClosureTypes.SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
       case ClosureTypes.SMALL_MUT_ARR_PTRS_FROZEN_CLEAN: {
         const ptrs = Number(
           this.memory.i64Load(c + rtsConstants.offset_StgSmallMutArrPtrs_ptrs)
@@ -981,6 +1014,28 @@ export class GC {
         );
         return rtsConstants.offset_StgSmallMutArrPtrs_payload + (ptrs << 3);
       }
+      case ClosureTypes.SMALL_MUT_ARR_PTRS_DIRTY: {
+        this.memory.i64Store(c, this.symbolTable["stg_SMALL_MUT_ARR_PTRS_CLEAN_info"]);
+        const ptrs = Number(
+          this.memory.i64Load(c + rtsConstants.offset_StgSmallMutArrPtrs_ptrs)
+        );
+        this.scavengePointersFirst(
+          c + rtsConstants.offset_StgSmallMutArrPtrs_payload,
+          ptrs
+        );
+        return rtsConstants.offset_StgSmallMutArrPtrs_payload + (ptrs << 3);
+      }
+      case ClosureTypes.SMALL_MUT_ARR_PTRS_FROZEN_DIRTY: {
+        this.memory.i64Store(c, this.symbolTable["stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN_info"]);
+        const ptrs = Number(
+          this.memory.i64Load(c + rtsConstants.offset_StgSmallMutArrPtrs_ptrs)
+        );
+        this.scavengePointersFirst(
+          c + rtsConstants.offset_StgSmallMutArrPtrs_payload,
+          ptrs
+        );
+        return rtsConstants.offset_StgSmallMutArrPtrs_payload + (ptrs << 3);
+      }
       default:
         throw new WebAssembly.RuntimeError();
     }

diff --git a/asterius/src/Asterius/JSGen/Constants.hs b/asterius/src/Asterius/JSGen/Constants.hs
@@ -94,6 +94,7 @@ rtsConstants =
                  ("sizeof_StgMutArrPtrs", sizeof_StgMutArrPtrs),
                  ("offset_StgMutArrPtrs_ptrs", offset_StgMutArrPtrs_ptrs),
                  ("offset_StgMutArrPtrs_payload", offset_StgMutArrPtrs_payload),
+                 ("offset_StgMutVar_var", offset_StgMutVar_var),
                  ("offset_StgMVar_head", offset_StgMVar_head),
                  ("offset_StgMVar_tail", offset_StgMVar_tail),
                  ("offset_StgMVar_value", offset_StgMVar_value),
@@ -128,11 +129,13 @@ rtsConstants =
                  ("offset_StgThunkInfoTable_i", offset_StgThunkInfoTable_i),
                  ("offset_StgThunkInfoTable_srt", offset_StgThunkInfoTable_srt),
                  ("offset_StgTSO_id", offset_StgTSO_id),
+                 ("offset_StgTSO_dirty", offset_StgTSO_dirty),
                  ("offset_StgTSO_stackobj", offset_StgTSO_stackobj),
                  ("offset_StgTSO_what_next", offset_StgTSO_what_next),
                  ("offset_StgTSO_why_blocked", offset_StgTSO_why_blocked),
                  ("offset_StgTSO_block_info", offset_StgTSO_block_info),
                  ("offset_StgStack_stack_size", offset_StgStack_stack_size),
+                 ("offset_StgStack_dirty", offset_StgStack_dirty),
                  ("offset_StgStack_sp", offset_StgStack_sp),
                  ("offset_StgStack_stack", offset_StgStack_stack),
                  ("offset_StgUpdateFrame_updatee", offset_StgUpdateFrame_updatee),

diff --git a/asterius/src/Asterius/Ld.hs b/asterius/src/Asterius/Ld.hs
@@ -68,6 +68,12 @@ rtsUsedSymbols =
       "stg_BLACKHOLE_info",
       "stg_WHITEHOLE_info",
       "stg_IND_info",
+      "stg_MVAR_CLEAN_info",
+      "stg_MUT_ARR_PTRS_CLEAN_info",
+      "stg_MUT_ARR_PTRS_FROZEN_CLEAN_info",
+      "stg_MUT_VAR_CLEAN_info",
+      "stg_SMALL_MUT_ARR_PTRS_CLEAN_info",
+      "stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN_info",
       "stg_DEAD_WEAK_info",
       "stg_marked_upd_frame_info",
       "stg_NO_FINALIZER_closure",

diff --git a/ghc-toolkit/cbits/ghc_constants.c b/ghc-toolkit/cbits/ghc_constants.c
@@ -257,6 +257,8 @@ HsInt offset_StgMutArrPtrs_payload() {
   return offsetof(StgMutArrPtrs, payload);
 }
 
+HsInt offset_StgMutVar_var() { return offsetof(StgMutVar, var); }
+
 HsInt offset_StgMVar_head() { return offsetof(StgMVar, head); }
 
 HsInt offset_StgMVar_tail() { return offsetof(StgMVar, tail); }

diff --git a/ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs b/ghc-toolkit/src/Language/Haskell/GHC/Toolkit/Constants.hs
@@ -243,6 +243,8 @@ foreign import ccall unsafe "offset_StgMutArrPtrs_size"
 foreign import ccall unsafe "offset_StgMutArrPtrs_payload"
   offset_StgMutArrPtrs_payload :: Int
 
+foreign import ccall unsafe "offset_StgMutVar_var" offset_StgMutVar_var :: Int
+
 foreign import ccall unsafe "offset_StgMVar_head" offset_StgMVar_head :: Int
 
 foreign import ccall unsafe "offset_StgMVar_tail" offset_StgMVar_tail :: Int