Merge pull request #211 from shwestrick/promo-stack

Promotion stacks

mlton/backend/rep-type.fun

@@ -732,6 +732,8 @@ fun ofGCField (f: GCField.t): t =
        | StackBottom => cpointer ()
        | StackLimit => cpointer ()
        | StackTop => cpointer ()
+       | PromoStackTop => cpointer ()
+       | PromoStackBot => cpointer ()
    end
 
 fun castIsOk {from, to, tyconTy = _} =

mlton/backend/runtime.fun

@@ -1,4 +1,5 @@
-(* Copyright (C) 2009,2016-2017,2019-2022 Matthew Fluet.
+(* Copyright (C) 2024 Sam Westrick.
+ * Copyright (C) 2009,2016-2017,2019-2022 Matthew Fluet.
  * Copyright (C) 2002-2007 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  *
@@ -20,6 +21,8 @@ structure GCField =
        | Frontier
        | Limit
        | LimitPlusSlop
+       | PromoStackTop
+       | PromoStackBot
        | SignalIsPending
        | SpareHeartbeatTokens
        | StackBottom
@@ -40,6 +43,8 @@ structure GCField =
              | Frontier => make "frontier"
              | Limit => make "limit"
              | LimitPlusSlop => make "limitPlusSlop"
+             | PromoStackTop => make "promoStackTop"
+             | PromoStackBot => make "promoStackBot"
              | SignalIsPending => make "signalsInfo.signalIsPending"
              | SpareHeartbeatTokens => make "spareHeartbeatTokens"
              | StackBottom => make "stackBottom"
@@ -54,6 +59,8 @@ structure GCField =
           | Frontier => "Frontier"
           | Limit => "Limit"
           | LimitPlusSlop => "LimitPlusSlop"
+          | PromoStackTop => "PromoStackTop"
+          | PromoStackBot => "PromoStackBot"
           | SignalIsPending => "SignalIsPending"
           | SpareHeartbeatTokens => "SpareHeartbeatTokens"
           | StackBottom => "StackBottom"

mlton/backend/runtime.sig

@@ -29,6 +29,8 @@ signature RUNTIME =
              | StackBottom
              | StackLimit (* Must have StackTop <= StackLimit *)
              | StackTop (* Points at the next available byte on the stack. *)
+             | PromoStackTop (* Points at the next available slot on the promotion stack *)
+             | PromoStackBot (* Points at the oldest entry of the promotion stack *)
 
             val layout: t -> Layout.t
             val offset: t -> Bytes.t (* Field offset in struct GC_state. *)

mlton/codegen/c-codegen/c-codegen.fun

@@ -1184,6 +1184,28 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...},
                 ; if amTimeProfiling
                      then flushStackTop ()
                      else ())
+            (* PromoStackTop += size *)
+            fun adjPromoStackTop (size: Bytes.t) =
+              outputStatement (Statement.PrimApp
+                               {args = Vector.new2
+                                       (Operand.gcField Runtime.GCField.PromoStackTop,
+                                       Operand.word
+                                       (WordX.fromBytes
+                                         (size,
+                                         WordSize.cptrdiff ()))), (* SAM_NOTE: What is this argument? *)
+                               dst = SOME (Operand.gcField Runtime.GCField.PromoStackTop),
+                               prim = Prim.CPointer_add})
+            (* PromoStackBot += size *)
+            fun adjPromoStackBot (size: Bytes.t) =
+              outputStatement (Statement.PrimApp
+                               {args = Vector.new2
+                                       (Operand.gcField Runtime.GCField.PromoStackBot,
+                                       Operand.word
+                                       (WordX.fromBytes
+                                         (size,
+                                         WordSize.cptrdiff ()))), (* SAM_NOTE: What is this argument? *)
+                               dst = SOME (Operand.gcField Runtime.GCField.PromoStackBot),
+                               prim = Prim.CPointer_add})
             fun pop (fi: FrameInfo.t) =
                adjStackTop (Bytes.~ (FrameInfo.size fi))
             fun push (return: Label.t, size: Bytes.t) =
@@ -1194,6 +1216,23 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...},
                                          volatile = amTimeProfiling},
                                   src = Operand.Label return})
                 ; adjStackTop size)
+            (* Hacking this together *)
+            fun promoStackPush () =
+               let
+                  val putStackTop =
+                     "\t*(CPointer*)("
+                     ^ operandToString (Operand.gcField Runtime.GCField.PromoStackTop)
+                     ^ ") = "
+                     ^ operandToString Operand.StackTop
+                     ^ ";\n"
+               in
+                  print putStackTop;
+                  adjPromoStackTop (Bits.toBytes (Control.Target.Size.cpointer ()))
+               end
+            fun promoStackPop () =
+               adjPromoStackTop (Bytes.~ (Bits.toBytes (Control.Target.Size.cpointer ())))
+            fun promoStackChopBot () =
+               adjPromoStackBot (Bytes.~ (Bits.toBytes (Control.Target.Size.cpointer ())))
             fun copyArgs (args: Operand.t vector): string list * (unit -> unit) =
                let
                   fun usesStack z =
@@ -1438,6 +1477,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...},
                    | Goto dst => gotoLabel (dst, {tab = true})
                    | PCall {label, cont, parl, parr, size, ...} =>
                         (push (cont, size)
+                         ; promoStackPush ()
                          ; jump label)
                    | Raise {raisesTo} =>
                         (outputStatement (Statement.PrimApp
@@ -1680,7 +1720,13 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...},
                       | Kind.Func _ => ()
                       | Kind.Handler {frameInfo, ...} => pop frameInfo
                       | Kind.Jump => ()
-                      | Kind.PCallReturn {frameInfo, ...} => pop frameInfo
+                      | Kind.PCallReturn {frameInfo, ...} =>
+                           (pop frameInfo
+                            ; promoStackPop ()
+                            ; case FrameInfo.kind frameInfo of
+                                FrameInfo.Kind.PCALL_PARL_FRAME => promoStackChopBot ()
+                              | FrameInfo.Kind.PCALL_PARR_FRAME => promoStackChopBot ()
+                              | _ => ())
                   val _ =
                      if !Control.codegenFuseOpAndChk
                         then outputStatementsFuseOpAndChk statements

runtime/gc/enter_leave.c

@@ -18,6 +18,7 @@ void enter (GC_state s) {
   GC_MayTerminateThread(s);
   /* used needs to be set because the mutator has changed s->stackTop. */
   getStackCurrent(s)->used = sizeofGCStateCurrentStackUsed (s);
+  setPromoStackOfCurrentThread(s, s->promoStackBot, s->promoStackTop);
   getThreadCurrent(s)->exnStack = s->exnStack;
   getThreadCurrent(s)->spareHeartbeatTokens = s->spareHeartbeatTokens;
   HM_HH_updateValues(getThreadCurrent(s), s->frontier);
@@ -36,11 +37,13 @@ void enter (GC_state s) {
 }
 
 void leave (GC_state s) {
+  s->spareHeartbeatTokens = getThreadCurrent(s)->spareHeartbeatTokens;
+  s->promoStackBot = getStackCurrent(s)->promoStackBot;
+
   /* The mutator frontier invariant may not hold
    * for functions that don't ensureBytesFree.
    */
   assert(invariantForMutator(s, FALSE, TRUE));
-  s->spareHeartbeatTokens = getThreadCurrent(s)->spareHeartbeatTokens;
   endAtomic (s);
   // Trace0(EVENT_RUNTIME_LEAVE);
 }

runtime/gc/foreach.c

@@ -96,7 +96,7 @@ void printObjectsInRange(GC_state s,
       p += alignWithExtra (s, dataBytes, GC_SEQUENCE_METADATA_SIZE);
     }
     else if (STACK_TAG == oi.tag) {
-      p += sizeof (struct GC_stack) + ((GC_stack)p)->reserved;
+      p += sizeof (struct GC_stack) + ((GC_stack)p)->reserved + ((GC_stack)p)->promoStackReserved;
     }
     else {
       fprintf(stderr, "cannot handle tag %u", oi.tag);
@@ -253,7 +253,7 @@ pointer foreachObjptrInObject (GC_state s, pointer p,
     assert(top == bottom);
 
  STACK_DONE:
-    p += sizeof (struct GC_stack) + stack->reserved;
+    p += sizeof (struct GC_stack) + stack->reserved + ((GC_stack)p)->promoStackReserved;;
   } else {
     assert (0 and "unknown object tag type");
   }

runtime/gc/garbage-collection.c

@@ -13,21 +13,22 @@
 // extern int64_t CheckActivationStack(void);
 
 void growStackCurrent(GC_state s) {
-  size_t reserved;
+  size_t newReserved;
   size_t stackSize;
   GC_stack stack;
 
-  reserved = sizeofStackGrowReserved(s, getStackCurrent(s));
-  assert(isStackReservedAligned (s, reserved));
-  stackSize = sizeofStackWithMetaData(s, reserved);
+  newReserved = sizeofStackGrowReserved(s, getStackCurrent(s));
+  size_t newPromoStackReserved = desiredPromoStackReserved(s, newReserved);
+  assert(isStackReservedAligned(s, newReserved));
+  stackSize = sizeofStackWithMetaData(s, newReserved, newPromoStackReserved);
   if (DEBUG_STACKS or s->controls->messages)
     fprintf (stderr,
              "[GC: Growing stack of size %s bytes to size %s bytes, using %s bytes.]\n",
              uintmaxToCommaString(getStackCurrent(s)->reserved),
-             uintmaxToCommaString(reserved),
+             uintmaxToCommaString(newReserved),
              uintmaxToCommaString(getStackCurrent(s)->used));
-  if (reserved > s->cumulativeStatistics->maxStackSize)
-    s->cumulativeStatistics->maxStackSize = reserved;
+  if (newReserved > s->cumulativeStatistics->maxStackSize)
+    s->cumulativeStatistics->maxStackSize = newReserved;
 
   HM_chunk chunk = HM_getChunkOf((pointer)getStackCurrent(s));
   HM_HierarchicalHeap hh = HM_getLevelHeadPathCompress(chunk);
@@ -37,12 +38,30 @@ void growStackCurrent(GC_state s) {
   }
 
   assert(HM_getChunkFrontier(chunk) == HM_getChunkStart(chunk) +
-    sizeofStackWithMetaData(s, getStackCurrent(s)->reserved));
+    sizeofStackWithMetaData(
+      s,
+      getStackCurrent(s)->reserved,
+      getStackCurrent(s)->promoStackReserved));
 
-  /* the easy case: plenty of space in the stack's chunk to just grow the
+  /* the fast case: plenty of space in the stack's chunk to just grow the
    * stack in place. */
   if (stackSize <= (size_t)(HM_getChunkLimit(chunk) - HM_getChunkStart(chunk))) {
-    getStackCurrent(s)->reserved = reserved;
+    GC_stack this = getStackCurrent(s);
+    assert(newReserved >= this->reserved);
+
+    size_t promoStackUsed = this->promoStackTop - this->promoStackBot;
+    pointer newPromoStackBot = this->promoStackBot + (newReserved - this->reserved);
+    pointer newPromoStackTop = newPromoStackBot + promoStackUsed;
+    GC_memmove(
+      this->promoStackBot,
+      newPromoStackBot,
+      promoStackUsed);
+
+    this->reserved = newReserved;
+    this->promoStackBot = newPromoStackBot;
+    this->promoStackTop = newPromoStackTop;
+    this->promoStackReserved = newPromoStackReserved;
+
     HM_updateChunkFrontierInList(
       HM_HH_getChunkList(hh),
       chunk,
@@ -73,7 +92,8 @@ void growStackCurrent(GC_state s) {
   assert(GC_STACK_METADATA_SIZE == GC_HEADER_SIZE);
   *((GC_header*)frontier) = GC_STACK_HEADER;
   stack = (GC_stack)(frontier + GC_HEADER_SIZE);
-  stack->reserved = reserved;
+  stack->reserved = newReserved;
+  stack->promoStackReserved = newPromoStackReserved;
   stack->used = 0;
   HM_updateChunkFrontierInList(
     HM_HH_getChunkList(newhh),

runtime/gc/gc_state.c

@@ -49,6 +49,8 @@ void setGCStateCurrentThreadAndStack (GC_state s) {
   s->stackBottom = getStackBottom (s, stack);
   s->stackTop = getStackTop (s, stack);
   s->stackLimit = getStackLimit (s, stack);
+  s->promoStackTop = stack->promoStackTop;
+  s->promoStackBot = stack->promoStackBot;
 }
 
 struct FixedSizeAllocator* getHHAllocator(GC_state s) {

runtime/gc/gc_state.h

@@ -1,4 +1,5 @@
-/* Copyright (C) 2012,2014,2019-2022 Matthew Fluet.
+/* Copyright (C) 2024 Sam Westrick.
+ * Copyright (C) 2012,2014,2019-2022 Matthew Fluet.
  * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -23,6 +24,8 @@ struct GC_state {
   volatile pointer stackTop; /* Top of stack in current thread. */
   pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */
   ptrdiff_t exnStack;
+  pointer promoStackTop;
+  pointer promoStackBot;
   /* Alphabetized fields follow. */
   size_t alignment; /* */
   volatile bool amInGC;