-- XDPsbPack.mesa             
-- Edited by:
--            Sandman on July 22, 1980  3:02 PM
--            Bruce on October 8, 1980  6:52 PM

DIRECTORY
  Actions USING [CallInterpreter],
  Ascii USING [CR, DEL, SP],
  ComData USING [typeLOCK, typeCONDITION],
  Commands USING [GetComment, Prompt, Umbrella],
  DebugOps USING [
    fileSW, Foo, Interpret, InvalidNumber, LongREAD, ShortCopyREAD, ShortREAD,
    StringExpToOctal],
  DI USING [Foo, GetNumber, GetValue, Number, TypeForSe],
  DOutput USING [Char, EOL, Line, Octal, Text],
  DPsb USING [Handle],
  Frames USING [Invalid],
  Init USING [CheckSymTabLength, TopLevel],
  Inline USING [COPY],
  Lf USING [Display, GF, Handle, NoPrevious, PC, Previous],
  MachineDefs USING [FHandle, Priority],
  PrincOps USING [StateVector],
  ProcessDefs USING [DefaultPriority, Priority],
  ProcessOps USING [
    CurrentPSB, FirstProcess, FirstStateVector, LastProcess, Queue, ReadyList],
  PSBDefs USING [Empty, MonitorLock, PSB],
  Source USING [Display],
  State USING [GetGS, GSHandle, SetParse],
  Storage USING [Free, Node],
  String USING [UpperCase],
  SymbolTable USING [Missing],
  Table USING [Overflow],
  TextSW USING [BlinkingCaret];

XDPsbPack: PROGRAM
  IMPORTS
    Actions, com: ComData, Commands, DebugOps, DI, DOutput,
    Init, Inline, Frames, Lf, Source, st: State, Storage, String,
    SymbolTable, Table, TextSW
  EXPORTS Commands, DPsb =
  BEGIN OPEN MachineDefs;

  PSB: TYPE = PSBDefs.PSB;
  Handle: TYPE = DPsb.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]};

  Current: PUBLIC PROC RETURNS [Handle] = {RETURN[current]};

  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.LongREAD[@State[].sv.dest]]
    END;

  State: PUBLIC PROC RETURNS [sv: LONG POINTER TO PrincOps.StateVector] =
    BEGIN OPEN DebugOps, ProcessOps;
    priority: CARDINAL;
    fsv: POINTER;
    IF Head = NIL THEN current _ ShortREAD[CurrentPSB]; 
    priority _
	IF Validate[current] THEN Priority[current] ELSE ProcessDefs.DefaultPriority;
    fsv _ ShortREAD[FirstStateVector];
    RETURN[LONG[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;

  prompt: BOOLEAN;

  StackCommands: PROCEDURE [char: CHARACTER] = {
    prompt _ TRUE;
    Init.TopLevel[];
    Commands.Umbrella[process, char];
    IF prompt THEN {Caret[]; TextSW.BlinkingCaret[DebugOps.fileSW, on]}};

  UProcess: PUBLIC 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 String.UpperCase[char] FROM
      'N  => {
	currentPSB _
	  IF dumping = process THEN Next[currentPSB]
	  ELSE DebugOps.ShortREAD[@currentPSB.link];
	IF currentPSB = headPSB OR currentPSB = NIL THEN {
	  Commands.Prompt[]; prompt _ FALSE}
	ELSE DumpPSB[currentPSB]};
      'P  => DumpPriority[currentPSB];
      'Q, Ascii.DEL  => {Commands.Prompt[]; prompt _ FALSE};
      'R  => DumpRoot[currentPSB];
      'L  => IF dumping = process THEN DumpSource[currentPSB, FALSE] ELSE BadChar[];
      'S  => IF dumping = process THEN DumpSource[currentPSB, TRUE] ELSE BadChar[];
      Ascii.SP => {Actions.CallInterpreter[]; prompt _ FALSE};
      '- => {Commands.GetComment[FALSE]; prompt _ FALSE};
      '? => 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[];
    END;

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

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

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

  StartQueue: PROCEDURE [condition: BOOLEAN] RETURNS [Handle] =
    BEGIN
    cleanupLink, local: Handle;
    IF qHead = NIL THEN RETURN[NIL];
    local _ Read[qHead];
    cleanupLink _ local.cleanup;
    IF ~condition OR 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;

  DumpSource: PROCEDURE [psb: Handle, loadSource: BOOLEAN]=
    BEGIN
    frame: MachineDefs.FHandle _ Frame[psb];
    DOutput.EOL[];
    Source.Display[Lf.GF[frame], Lf.PC[frame], loadSource ! 
      SymbolTable.Missing--[seg]-- => {DOutput.Text[" No symbol table."L]; CONTINUE}];
    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;

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

  DisplayQueue: PUBLIC PROC [q: STRING] = {
    condition: BOOLEAN;
    call: BOOLEAN _ TRUE;

    FindQueue: PROCEDURE [f: DebugOps.Foo] = {
      PSBBase: CARDINAL = 0;
      mLock: PSBDefs.MonitorLock;
      n: DI.Number;
      DI.GetValue[f];
      SELECT DI.TypeForSe[f.tsei] FROM
	com.typeLOCK => {condition _ FALSE; mLock _ f.addr.base^};
	com.typeCONDITION => {condition _ TRUE; mLock _ f.addr.base^};
	ENDCASE => {
	  call _ FALSE;
	  n _ DI.GetNumber[f];
	  IF n.type = one THEN
	    mLock _ DebugOps.ShortREAD[n.p]
	  ELSE mLock _ DebugOps.LongREAD[n.lp]};
      qHead _ IF mLock.queue = PSBDefs.Empty THEN NIL ELSE mLock.queue + PSBBase};

    qHead _ NIL;
    DebugOps.Interpret[q, FindQueue];
    IF call THEN DumpQueue[condition]
    ELSE {
      DOutput.Text[" Condition ([Y or N])? "L];
      st.SetParse[CheckCondition]} };
  
END.