(* new module KRML *)
UNSAFE MODULE RTStackKRML EXPORTS RTStackKRML, RTStackRep;

IMPORT Word, Thread, ThreadF;

REVEAL
  T = UNTRACED BRANDED REF RECORD
      next, prev: T := NIL;  (* a doubly linked list is used so that stack
                                disposals can be done quickly *)
      size: CARDINAL := 0;  (* in number of Word.T *)
      s: UNTRACED REF ARRAY OF Word.T := NIL;
      thread: ADDRESS  (* Note, this is really an untraced pointer to
                          a traced Thread.T object! *)
    END;

VAR
  stackList: T := NIL;

PROCEDURE New( t: Thread.T; size: CARDINAL;
               modelFrame: UNTRACED REF ARRAY OF Word.T;
               VAR stackLow, stackHigh: ADDRESS ): T =
  (* REQUIRES Thread.inSystemCritical AND size # 0 AND modelFrame # NIL *)
  VAR stack: T := NEW( T, size := size,
                          thread := LOOPHOLE( t, ADDRESS ));
  BEGIN
    ThreadF.EnterSystemCritical();
      stack.next := stackList;
      stackList := stack;
    ThreadF.ExitSystemCritical();
    WITH n = NUMBER( modelFrame^ ) DO
      stack.s := NEW( UNTRACED REF ARRAY OF Word.T, size + n );
      SUBARRAY( stack.s^, size, n ) := modelFrame^
    END;
    stackLow := ADR( stack.s[0] );
    stackHigh := ADR( stack.s[ size ] );
    RETURN stack
  END New;

PROCEDURE InitGcStack( stack: ADDRESS; totalSize: CARDINAL;
                       modelFrame: UNTRACED REF ARRAY OF Word.T;
                       VAR stackLow, stackHigh: ADDRESS ) =
  (* This procedure initializes the garbage collector's thread.  'stack'
     is the address of the garbage collector stack, and totalSize is
     the total size of this stack (including the space to be used for
     the frame) in Word.T.
     The OUT parameters stackLow and stackHigh return as the low and
     high ends of the stack, to be used in calls to SetCurrentStackLimits. *)
  TYPE
    LOTS = [0..9999];
  VAR n: CARDINAL := NUMBER( modelFrame^ );
      sizeProper: INTEGER := totalSize - n;
      p: UNTRACED REF ARRAY LOTS OF Word.T := stack;
  BEGIN
    (* WARNING.  This implementation is for stacks that grow down only. *)
    SUBARRAY( p^, sizeProper, n ) := modelFrame^;
    stackLow := ADR( p[ 0 ] );
    stackHigh := ADR( p[ sizeProper ] )
  END InitGcStack;

PROCEDURE Dispose( VAR stack: T ) =
  (* REQUIRES Thread.inSystemCritical *)
  BEGIN
    DISPOSE( stack.s );
    IF stack.next # NIL THEN
      stack.next.prev := stack.prev
    END;
    IF stack.prev # NIL THEN
      stack.prev.next := stack.next
    ELSE
      stackList := stack.next
    END;
    DISPOSE( stack )
  END Dispose;

PROCEDURE GetBounds( VAR resumeKey: ADDRESS;
                     VAR low, high: UNTRACED REF Word.T ): BOOLEAN =
  VAR stack: T;
  BEGIN
    (* WARNING!  Assumes that stack grows down. *)
    <* ASSERT Thread.Self() = ThreadF.gcThread *>

    IF resumeKey = NIL THEN
      (* do main thread *)
      high := ThreadF.bottom_of_stack;
      low := ThreadF.GetRecordedStackPointer( ThreadF.mainThread );
      resumeKey := LOOPHOLE( 1, ADDRESS )
    ELSE
      (* do 'stack' next *)
      IF resumeKey = LOOPHOLE( 1, ADDRESS )
        THEN stack := stackList
        ELSE stack := LOOPHOLE( resumeKey, T ).next
      END;
      IF stack = NIL THEN RETURN FALSE END;
      high := ADR( stack.s[ stack.size - 1 ] );
      low := ThreadF.GetRecordedStackPointer( LOOPHOLE( stack.thread,
                                                        Thread.T ));
      resumeKey := stack
    END;
    RETURN TRUE
  END GetBounds;

PROCEDURE GetMainStackLimits( VAR low, high: ADDRESS ) =
  CONST
    (* WARNING!  This is an arbitrary number.  It would be nice to be
       able to get the actual top_of_stack value, rather than adding
       this constant to the bottom of the stack. *)
    MainStackSize = 16_2000;
  BEGIN
    (* WARNING!  This code assumes the stack grows down. *)
    low := ThreadF.bottom_of_stack - MainStackSize;
    high := ThreadF.bottom_of_stack;
  END GetMainStackLimits;

PROCEDURE SetCurrentStackLimits( low, high: ADDRESS ) =
  BEGIN
    (* low is the lowest address in the stack; high is the lowest
       address not used in stack *)
    <* ASSERT low <= high *>
    currStackLow := low;
    currStackHigh := high
  END SetCurrentStackLimits;
 
BEGIN
  (* Note, before the following is executed, no stack checking will be done.
     It is assumed this code is executed in the main thread. *)
  GetMainStackLimits( currStackLow, currStackHigh );
  doStackOverflowChecks := TRUE
END RTStackKRML.