-- PsbPack.mesa             
-- Edited by:
--            Sandman on May 20, 1980  4:46 PM
--            Barbara on April 6, 1979  3:02 PM
--            Bruce on July 9, 1980  3:56 PM

DIRECTORY
  Actions USING [CallInterpreter],
  Ascii USING [CR, DEL, SP],
  ComData USING [idLOCK],
  Commands USING [GetComment, Prompt, WriteError],
  DebugOps USING [fileSW, Foo, Interpret, InvalidNumber, ShortCopyREAD, ShortREAD, StringExpToOctal, UserAborted],
  DI USING [Foo, GetValue, TypeForSe],
  DOutput USING [Char, EOL, Line, Octal, Text],
  Frames USING [Invalid],
  Init USING [CheckSymTabLength],
  Inline USING [COPY],
  Lf USING [Display, GF, Handle, NoPrevious, PC, Previous],
  Lookup USING [Fail],
  MachineDefs USING [FHandle, PHandle, Priority],
  PrincOps USING [StateVector, SVPointer],
  ProcessDefs USING [DefaultPriority, Priority],
  ProcessOps USING [CurrentPSB, FirstProcess, FirstStateVector, LastProcess, Queue, ReadyList],
  Psb USING [Handle],
  PSBDefs USING [Empty, MonitorLock, PSB],
  Source USING [Display, FileMissing],
  State USING [GetGS, GSHandle, SetParse],
  Storage USING [Free, Node],
  StringDefs USING [UpperCase],
  SymbolOps USING [FirstCtxSe, NextSe],
  Symbols USING [bodyType, CBTIndex, CBTNull, CTXIndex, CTXNull, ISEIndex, SENull, seType],
  SymbolTable USING [Missing],
  Table USING [AddNotify, Base, DropNotify, Notifier, Overflow],
  TextSW USING [BlinkingCaret],
  UserInput USING [ResetUserAbort];

PsbPack: PROGRAM
  IMPORTS
    Actions, com: ComData, Commands, DebugOps, DI, DOutput, Init, Inline, Frames,
    Lf, Lookup, Source, st: State, Storage, StringDefs, SymbolOps,
    SymbolTable, Table, TextSW, UserInput
  EXPORTS Psb =
  BEGIN

  PSB: TYPE = PSBDefs.PSB;
  Handle: TYPE = Psb.Handle;

  NotAnXfer: ERROR = CODE;
  Invalid: PUBLIC SIGNAL [psb: Handle] = CODE;

  data: st.GSHandle _ st.GetGS[];

  Head: POINTER TO PItem _ NIL;
  lastRead: PSB;
  first: Handle _ NIL;
  last: Handle _ NIL;
  current: Handle _ NIL;

  PItem: TYPE = RECORD [
    link: POINTER TO PItem,
    p: Handle,
    psb: PSB];

  Read: PUBLIC PROCEDURE [p: Handle] RETURNS [local: Handle] = 
    BEGIN
    l: POINTER TO PItem;
    Check[p];
    IF (l _ CheckCache[p]) # NIL THEN RETURN[@l.psb];
    DebugOps.ShortCopyREAD[from: p, to: @lastRead, nwords: SIZE[PSB]];
    RETURN[IF lastRead.state # dead THEN @Cache[p].l.psb ELSE @lastRead];
    END;

  CheckCache: PROCEDURE [p: Handle] RETURNS [l: POINTER TO PItem] = 
    BEGIN
    FOR l _ Head, l.link UNTIL l = NIL DO
      IF l.p = p THEN RETURN;
      ENDLOOP;
    END;

  Cache: PROCEDURE [p: Handle] RETURNS [l: POINTER TO PItem] = 
    BEGIN
    IF (l _ CheckCache[p]) # NIL THEN RETURN;
    l _ Storage.Node[SIZE[PItem]];
    l^ _ [link: Head, p: p, psb:];
    Head _ l;
    Inline.COPY[from: @lastRead, to: @l.psb, nwords: SIZE[PSB]];
    END;

  ResetCache: PUBLIC PROCEDURE =
    BEGIN OPEN ProcessOps;
    p, next: POINTER TO PItem;
    FOR p _ Head, next UNTIL p = NIL DO
      next _ p.link;
      Storage.Free[p];
      ENDLOOP;
    first _ DebugOps.ShortREAD[FirstProcess];
    last _ DebugOps.ShortREAD[LastProcess];
    current _ DebugOps.ShortREAD[CurrentPSB];
    Head _ NIL;
    END;

  First: PUBLIC PROC RETURNS [Handle] = {RETURN[first]};

  Last: PUBLIC PROC RETURNS [Handle] = {RETURN[last]};

  Next: PUBLIC PROC [psb: Handle] RETURNS [Handle] =
    BEGIN
    head: Handle _ psb;
    Check[psb];
    DO
      psb _ IF psb # last THEN psb+SIZE[PSB] ELSE first;
      IF psb = head THEN RETURN[NIL];
      IF Validate[psb] AND StateOK[psb] THEN RETURN[psb];
      ENDLOOP;
    END;

  Check: PUBLIC PROC [p: Handle] =
    BEGIN IF ~Validate[p] THEN SIGNAL Invalid[p] END;

  Validate: PUBLIC PROCEDURE [p: Handle] RETURNS [BOOLEAN] =
    BEGIN
    IF LOOPHOLE[p,CARDINAL] < LOOPHOLE[first,CARDINAL]
      OR LOOPHOLE[p,CARDINAL] > LOOPHOLE[last,CARDINAL] THEN RETURN[FALSE];
    RETURN[
      LOOPHOLE[(p-LOOPHOLE[first, CARDINAL]), CARDINAL] MOD SIZE[PSB] = 0]
    END;

  Priority: PUBLIC PROCEDURE [p: Handle] RETURNS [MachineDefs.Priority] =
    BEGIN RETURN[Read[p].local.priority] END;

  WaitingCV: PUBLIC PROCEDURE [p: Handle] RETURNS [BOOLEAN] =
    BEGIN
    p1: Handle _ Read[p];
    RETURN[~p1.enterFailed AND p1.waitingOnCV]
    END;

  WaitingML: PUBLIC PROCEDURE [p: Handle] RETURNS [BOOLEAN] =
    BEGIN RETURN[Read[p].local.enterFailed] END;

  Running: PUBLIC PROCEDURE [p: Handle] RETURNS [BOOLEAN] =
    BEGIN
    p1: Handle _ Read[p];
    RETURN[~p1.enterFailed AND ~p1.waitingOnCV AND p1.state = alive]
    END;

  Frame: PUBLIC PROC [psb: Handle] RETURNS [MachineDefs.FHandle] =
    --get the frame for the currently running process from the StateVector
    BEGIN 
    RETURN[IF psb # current THEN Read[psb].local.frame
	ELSE DebugOps.ShortREAD[@State[].sv.dest]]
    END;

  State: PUBLIC PROC RETURNS [sv: PrincOps.SVPointer] =
    BEGIN
    priority: CARDINAL _ IF Validate[current]
      THEN Priority[current] ELSE ProcessDefs.DefaultPriority;
    fsv: POINTER _ DebugOps.ShortREAD[ProcessOps.FirstStateVector];
    RETURN[fsv + priority*SIZE[PrincOps.StateVector]]
    END;

  StateOK: PROCEDURE [psb: Handle] RETURNS [BOOLEAN] =
    BEGIN RETURN[Read[psb].local.state # dead] END;

  ListProcesses: PUBLIC PROCEDURE =
    BEGIN
    i: Handle _ last;
    DO
      i _ Next[i];
      DumpPSB[i]; DOutput.EOL[];
      IF i = last THEN EXIT;
      ENDLOOP;
    RETURN
    END;

  StackType: TYPE = {process, queue};
  dumping: StackType;
  headPSB, currentPSB, qHead: Handle;

  Caret: PROC = {DOutput.EOL[]; DOutput.Text["  >"L]};

  DumpStack: PROCEDURE [psb: Handle, s: StackType] =
    BEGIN
    headPSB _ currentPSB _ psb;
    dumping _ s;
    Caret[];
    st.SetParse[StackCommands];
    RETURN
    END;

  StackCommands: PROCEDURE [char: CHARACTER] =
    BEGIN ENABLE Table.Overflow => {Init.CheckSymTabLength[]; RETRY};
    IF char # Ascii.SP AND char # Ascii.DEL THEN
    {DOutput.Char[char]; TextSW.BlinkingCaret[DebugOps.fileSW, off]};
    SELECT StringDefs.UpperCase[char] FROM
      'N  =>
	BEGIN
	currentPSB _ IF dumping = process THEN Next[currentPSB]
	  ELSE DebugOps.ShortREAD[@currentPSB.link];
	IF currentPSB = headPSB OR currentPSB = NIL THEN 
	  BEGIN Commands.Prompt[]; RETURN END
	ELSE DumpPSB[currentPSB];
	END;
      'P  => DumpPriority[currentPSB ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}];
      'Q, Ascii.DEL  => BEGIN Commands.Prompt[]; RETURN END;
      'R  => DumpRoot[currentPSB ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}];
      'L  => IF dumping = process THEN DumpSource[currentPSB, FALSE
	  ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}]
	ELSE BadChar[];
      'S  => IF dumping = process THEN DumpSource[currentPSB, TRUE
	  ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}]
	ELSE BadChar[];
      Ascii.SP => Actions.CallInterpreter[];
      '- => {Commands.GetComment[FALSE]; RETURN};
      '? => DOutput.Text[IF dumping = process THEN 
	" --Options are: List source, Next, Priority, Quit, Root, Source"L
	ELSE " --Options are: Next, Priority, Quit, Root"L];
      ENDCASE => BadChar[];
    Caret[]; TextSW.BlinkingCaret[DebugOps.fileSW, on];
    RETURN
    END;

  BadChar: PROC = {DOutput.Char['?]};

  DisplayQueue: PUBLIC PROCEDURE [q: STRING] =
    BEGIN
    IF (qHead _ StringToPSB[q]) # NIL THEN
      BEGIN
      DOutput.Text[" condition variable? [Y or N]"L];
      st.SetParse[CheckCondition];
      END
    ELSE
      BEGIN
      cv: BOOLEAN;
      [qHead, cv] _ Queue[q];
      DumpQueue[cv];
      END;
    END;

  DisplayReadyList: PUBLIC PROCEDURE =
    {qHead _ DebugOps.ShortREAD[ProcessOps.ReadyList]; DumpQueue[FALSE]};

  CheckCondition: PROCEDURE [char: CHARACTER] =
    BEGIN
    SELECT char FROM
      'y, 'Y, Ascii.CR  => {DOutput.Text[" yes"L]; DumpQueue[TRUE]};
      ENDCASE => {DOutput.Text[" no"L]; DumpQueue[FALSE]};
    RETURN
    END;

  DumpQueue: PROCEDURE [cv: BOOLEAN] =
    BEGIN
    IF (qHead _ StartQueue[cv]) = NIL THEN 
      BEGIN
      DOutput.Text[" Queue empty!"L];
      Commands.Prompt[];
      RETURN
      END;
    DumpPSB[qHead];
    DumpStack[qHead, queue];
    RETURN
    END;

  StartQueue: PROCEDURE [cv: BOOLEAN]
    RETURNS [Handle] =
    BEGIN
    cleanupLink, local: Handle;
    IF qHead = NIL THEN RETURN[NIL];
    local _ Read[qHead];
    IF ~cv THEN RETURN[local.link];
    cleanupLink _ local.cleanup;
    IF cleanupLink = NIL THEN RETURN[local.link];
    UNTIL cleanupLink = NIL OR cleanupLink = qHead DO
      qHead _ cleanupLink;
      cleanupLink _ DebugOps.ShortREAD[@cleanupLink.cleanup];
      ENDLOOP;
    RETURN[IF cleanupLink = NIL THEN qHead ELSE NIL];
    END;

  DisplayProcess: PUBLIC PROCEDURE [p: STRING] =
    BEGIN
    psb: Handle;
    DumpPSB[psb _ StringToPSB[p]];
    DumpStack[psb, process];
    RETURN
    END;

  DumpPSB: PROCEDURE [psb: Handle] =
    BEGIN
    f: MachineDefs.FHandle;
    Check[psb]; DOutput.EOL[];
    DOutput.Text["PSB: "L];
    DOutput.Octal[psb]; IF psb = current THEN DOutput.Char['*];
    DOutput.Text[", "L];
    SELECT TRUE FROM
      WaitingML[psb] => DOutput.Text["waiting ML, "L];
      WaitingCV[psb] => DOutput.Text["waiting CV, "L];
      ENDCASE;
    IF (f _ Frame[psb]) = NIL THEN DOutput.Line["No frame!"L]
    ELSE Lf.Display[f ! Frames.Invalid => 
      {DOutput.Octal[f]; DOutput.Text[" is not a valid frame!"L]; CONTINUE}];
    RETURN
    END;

  ControlDel: PROC = {UserInput.ResetUserAbort[]; DOutput.Text[" ... aborted"L]};

  DumpSource: PROCEDURE [psb: Handle, loadSource: BOOLEAN]=
    BEGIN
    frame: MachineDefs.FHandle _ Frame[psb];
    DOutput.EOL[];
    Source.Display[Lf.GF[frame], Lf.PC[frame], loadSource ! 
      Source.FileMissing => {
	Commands.WriteError[file];
	IF name # NIL THEN DOutput.Text[name] ELSE Commands.WriteError[compress];
	CONTINUE};
      DebugOps.UserAborted => {ControlDel[]; CONTINUE};
      SymbolTable.Missing--[seg]-- =>
        BEGIN DOutput.Text[" No symbol table."L]; CONTINUE END];
    RETURN
    END;

  DumpRoot: PROCEDURE [psb: Handle] =
    BEGIN
    f: MachineDefs.FHandle _ Frame[psb];
    DO
      f _ Lf.Previous[f ! Lf.NoPrevious => EXIT];
      ENDLOOP;
    IF f = NIL THEN RETURN;
    DOutput.EOL[];
    Lf.Display[f];
    RETURN
    END;
  
  DumpPriority: PROCEDURE [psb: Handle] =
    BEGIN DOutput.Text["riority "L]; DOutput.Octal[Priority[psb]] END;
  
  StringToPSB: PROCEDURE [p: STRING] RETURNS [psb: Handle] =
    BEGIN
    psb _ NIL;
    psb _ LOOPHOLE[
      DebugOps.StringExpToOctal[p !DebugOps.InvalidNumber => CONTINUE]];
    IF psb # NIL THEN Check[psb];
    END;

  seb: Table.Base;
  bb: Table.Base;

  Notify: Table.Notifier =
    BEGIN
    seb _ base[Symbols.seType];
    bb _ base[Symbols.bodyType];
    END;

Queue: PUBLIC PROC [q: STRING]
    RETURNS [qHead: MachineDefs.PHandle, cv: BOOLEAN] =
  BEGIN
  FindQueue: PROCEDURE [f: DebugOps.Foo] =
    BEGIN
    PSBBase: CARDINAL = 0;
    mLock: PSBDefs.MonitorLock;
    Table.AddNotify[Notify];
    WITH seb[DI.TypeForSe[f.tsei]] SELECT FROM
      record => IF fieldCtx = MLCtx THEN cv _ FALSE;
      ENDCASE =>
	BEGIN
	found: BOOLEAN _ FALSE;
	[found, cv] _ SearchML[f !UNWIND => Table.DropNotify[Notify]];
	IF ~found THEN {Table.DropNotify[Notify]; RETURN};
	END;
    Table.DropNotify[Notify];
    DI.GetValue[f];
    mLock _ f.addr.base^;
    qHead _
      IF mLock.queue = PSBDefs.Empty THEN NIL ELSE mLock.queue + PSBBase;
    RETURN
    END;

  qHead _ NIL;
  DebugOps.Interpret[q, FindQueue ! ANY => CONTINUE];
  IF qHead = NIL THEN SIGNAL Lookup.Fail[q]; 
  RETURN
  END;
  
MLCtx: Symbols.CTXIndex = LOOPHOLE[8];
CVCtx: Symbols.CTXIndex = LOOPHOLE[10];

SearchML: PROCEDURE [f: DebugOps.Foo] RETURNS [found, cv: BOOLEAN] =
  BEGIN
  cbti: Symbols.CBTIndex;
  c: Symbols.CTXIndex _ Symbols.CTXNull;
  WITH seb[DI.TypeForSe[f.tsei]] SELECT FROM
    record =>
      IF monitored THEN c _ fieldCtx
      ELSE
	IF fieldCtx = CVCtx THEN
	  BEGIN
	  f.tsei _ SymbolOps.FirstCtxSe[fieldCtx];
	  RETURN[TRUE, TRUE];
	  END
	ELSE RETURN[FALSE,FALSE];
    transfer =>
      IF mode = program THEN 
	BEGIN
	WITH seb[f.tsei] SELECT FROM
	  id => cbti _ idInfo;
	  ENDCASE => ERROR NotAnXfer;
	IF cbti # Symbols.CBTNull THEN c _ bb[cbti].localCtx;
      END;
    ENDCASE;
  IF c = Symbols.CTXNull THEN RETURN[FALSE, FALSE];
  RETURN[SearchCtxForLock[f, c], FALSE]
  END;

SearchCtxForLock: PROCEDURE [f: DebugOps.Foo, c: Symbols.CTXIndex]
  RETURNS [BOOLEAN] =
  BEGIN OPEN SymbolOps;
  sei: Symbols.ISEIndex;
  FOR sei _ FirstCtxSe[c], NextSe[sei] UNTIL sei = Symbols.SENull DO
    IF sei # com.idLOCK THEN LOOP;
    f.tsei _ DI.TypeForSe[sei];
    RETURN[TRUE]
    ENDLOOP;
  RETURN[FALSE]
  END;

END..