(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Last modified on Wed Jul  1 21:19:07 1992 by rustan         *)

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

IMPORT Word, Thread, ThreadF, RTMemory, System, RTHeap;

(* Note.  This implementation works for stacks that grow down only. *)

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;
               VAR stackLow, stackHigh: ADDRESS ): T =
  (* REQUIRES NOT System.inSystemCritical AND size # 0 *)
  (* This procedure allocates a new stack of size 'size' for new thread 't'.
     The OUT parameters stackLow and stackHigh return as the low and
     high ends of the stack, to be used in calls to SetCurrentStackLimits
     and RTRegisters.New.  Note, the RTMemory module also needs to be
     consistent about this. *)
  VAR stack: T := NEW( T, size := size,
                          thread := LOOPHOLE( t, ADDRESS ));
  BEGIN
    stack.s := NEW( UNTRACED REF ARRAY OF Word.T, size );
    stackLow := ADR( stack.s[0] );
    stackHigh := stackLow + size * ADRSIZE( Word.T );
    System.EnterSystemCritical();
      IF stackList # NIL THEN
        stackList.prev := stack;
        stack.next := stackList
      END;
      stackList := stack;
    System.ExitSystemCritical();
    RETURN stack
  END New;

PROCEDURE Dispose( VAR stack: T ) =
  (* REQUIRES System.inSystemCritical *)
  BEGIN
    <* ASSERT System.InSystemCritical() AND stack.s # NIL *>
    VAR a: ADDRESS := stack.s; BEGIN
      RTHeap.BackdoorDisposeUntraced( a )
    END;
    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;
    VAR a: ADDRESS := stack; BEGIN
      RTHeap.BackdoorDisposeUntraced( a );
      stack := NIL
    END
  END Dispose;

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

    IF resumeKey.c = 0 THEN
      (* do main thread *)
      IF ThreadF.userSequenceThread = ThreadF.mainThread THEN
        ThreadF.SaveThreadState( ThreadF.mainThread )
      END;
      high := RTMemory.MainStackHigh;
      low := ThreadF.GetRecordedStackPointer( ThreadF.mainThread );
      ThreadF.GetRegisterBounds( ThreadF.mainThread, regLow, regHigh );
      IF ThreadF.gcInvokedFromSystemThread THEN
        resumeKey.c := 1
      ELSE
        (* no need to return bounds for system thread *)
        resumeKey := ResumeKey{ c := 2, t := stackList }
      END
    ELSIF resumeKey.c = 1 THEN
      (* do system thread *)
      high := RTMemory.SystemStackHigh;
      low := ThreadF.GetRecordedStackPointer( ThreadF.systemThread );
      ThreadF.GetRegisterBounds( ThreadF.systemThread, regLow, regHigh );
      resumeKey := ResumeKey{ c := 2, t := stackList }
    ELSIF resumeKey.t # NIL THEN
      (* do resumeKey.t *)
      stack := resumeKey.t;
      VAR thread: Thread.T := LOOPHOLE( stack.thread, Thread.T ); BEGIN
        IF ThreadF.userSequenceThread = thread THEN
          ThreadF.SaveThreadState( thread )
        END;
        high := ADR( stack.s[ stack.size - 1 ] );
        low := ThreadF.GetRecordedStackPointer( LOOPHOLE( stack.thread,
                                                          Thread.T ));
        ThreadF.GetRegisterBounds( LOOPHOLE( stack.thread, Thread.T ),
                                   regLow, regHigh );
        resumeKey.t := stack.next
      END
    ELSE
      (* done *)
      RETURN FALSE
    END;
    RETURN TRUE
  END GetBounds;

BEGIN
  (* Note, before the following is executed, no stack checking will be done.
     It is assumed this code is executed in the main thread. *)
  SetCurrentStackLimits( RTMemory.MainStackLow, RTMemory.MainStackHigh );
  doStackOverflowChecks := TRUE  (* start checking for stack overflows *)
END RTStack.