-- CGenDebugStack.mesa  Edited by Sweet,  October 14, 1980  4:33 PM

DIRECTORY
  AllocDebugDefs USING [TableBase],
  CGenDebugDefs USING [GetFrameName, StackBottom, StackState],
  CodeDefs USING [CCNull, StackIndex, StackItem, StackNull],
  DebugUsefulDefs USING [ShortCopyREAD],
  IODefs USING [SP],
  RESOut USING [
    Complain, MakeRoom, PChar, PCr, PDecimal, PNext, PNextNull, 
    PNextUnsigned, PNull, PString, PUnsigned],
  STDebugDefs USING [showLinks],
  StringDefs USING [AppendChar, AppendDecimal, AppendString],
  Symbols USING [ContextLevel, lG, lL, lZ],
  Table USING [Base];

CGenDebugStack: PROGRAM 
  IMPORTS AllocDebugDefs, CGenDebugDefs, DebugUsefulDefs, RESOut, STDebugDefs, StringDefs
  EXPORTS CGenDebugDefs =
  BEGIN OPEN CodeDefs, CGenDebugDefs, RESOut;

  PutStackState: PUBLIC PROCEDURE =
    BEGIN OPEN CodeDefs;
    sip: StackIndex;
    sir: StackItem;
    cb: Table.Base = AllocDebugDefs.TableBase[];
    first: BOOLEAN _ TRUE;
    name: STRING _ [30];

    PCr[];
    PString["Stack["]; PString[IF StackState[] THEN "ON"L ELSE "OFF"L];
    PString["]: "L];
    sip _ StackBottom[];
    IF sip = StackNull THEN
      BEGIN PString["empty"L]; RETURN END;
    WHILE sip # StackNull DO
      name.length _ 0;
      DebugUsefulDefs.ShortCopyREAD[to: @sir, from: @cb[sip],
	nwords: SIZE[StackItem]];
      BEGIN OPEN StringDefs;
      AppendChar[name, '(]; AppendDecimal[name, LOOPHOLE[sip]];
      AppendString[name, ") "L];
      END;
      WITH sir SELECT FROM
	onStack => StringDefs.AppendString[name, "OnStk"L];
	inTemp => 
	  GetFrameName[s: name, level: tLevel, wd: tOffset, wSize: 1];
	inLink =>
	  BEGIN OPEN StringDefs;
	  AppendString[name, "LK "L];
	  AppendDecimal[name, link];
	  END;
	mark => StringDefs.AppendString[name, "Mark"L];
	ENDCASE;
      IF first THEN
	BEGIN PString[name]; first _ FALSE; END
      ELSE PNext[name];
      sip _ sir.uplink;
      ENDLOOP;
    END;

  lastSti: StackIndex _ StackNull;

  PutAsStack: PUBLIC PROCEDURE [sti: StackIndex] =
    BEGIN
    sir: StackItem;
    cb: Table.Base = AllocDebugDefs.TableBase[];
    Alias: PROCEDURE [wd: CARDINAL, lvl: Symbols.ContextLevel] =
      BEGIN OPEN StringDefs;
      name: STRING _ [15];
      AppendChar[name, '(];
      GetFrameName[s: name, wd: wd, level: lvl, wSize: 1];
      AppendChar[name, ')];
      IF MakeRoom[name.length+1, 2] THEN PChar[IODefs.SP];
      PString[name];
      END;

    IF sti = StackNull THEN RETURN;
    lastSti _ sti;
    DebugUsefulDefs.ShortCopyREAD[to: @sir, from: @cb[sti],
      nwords: SIZE[StackItem]];
    PCr[];
    PString["cb["L]; PDecimal[LOOPHOLE[sti]]; PString["] - "L];
    IF sir.free THEN PString["FREE!"L]
    ELSE
      WITH sir SELECT FROM
        onStack =>
	  BEGIN
	  PString["onStack"];
	  PNextUnsigned["tOff"L, tOffset];
	  PNextUnsigned["tLvl"L, tLevel];
	  IF tLevel # Symbols.lZ THEN Alias[tOffset, tLevel];
	  IF alsoLink THEN PNext["alsoLink"L];
	  END;
	inTemp =>
	  BEGIN
	  PString["inTemp - tOff: "L];
	  PUnsigned[tOffset];
	  PNext["tLvl: "L, 1];
	  PLevel[tLevel];
	  Alias[tOffset, tLevel];
	  END;
	inLink =>
	  BEGIN
	  PString["inLink: "L];
	  PUnsigned[link];
	  END;
	mark =>
	  BEGIN
	  PString["mark - label: "L];
	  PNull[label, CCNull];
	  END;
        ENDCASE;
    IF STDebugDefs.showLinks THEN
      BEGIN
      PNextNull["downlink"L, sir.downlink, StackNull];
      PNextNull["uplink"L, sir.uplink, StackNull];
      END;
    END;

  PLevel: PROCEDURE [l: Symbols.ContextLevel] =
    BEGIN OPEN Symbols;
    SELECT l FROM
      lZ => PChar['Z];
      lG => PChar['G];
      lL => PChar['L];
      ENDCASE => PUnsigned[LOOPHOLE[l]];
    END;

  PutStackDown: PUBLIC PROCEDURE =
    BEGIN
    sir: StackItem;
    cb: Table.Base = AllocDebugDefs.TableBase[];
    IF lastSti = StackNull THEN GO TO invalid;
    DebugUsefulDefs.ShortCopyREAD[to: @sir, from: @cb[lastSti],
      nwords: SIZE[StackItem]];
    IF sir.free THEN GO TO invalid
    ELSE PutAsStack[sir.downlink];
    EXITS
      invalid =>
        RESOut.Complain["no valid last stack index"L];
    END;

  PutStackUp: PUBLIC PROCEDURE =
    BEGIN
    sir: StackItem;
    cb: Table.Base = AllocDebugDefs.TableBase[];
    IF lastSti = StackNull THEN GO TO invalid;
    DebugUsefulDefs.ShortCopyREAD[to: @sir, from: @cb[lastSti],
      nwords: SIZE[StackItem]];
    IF sir.free THEN GO TO invalid
    ELSE PutAsStack[sir.uplink];
    EXITS
      invalid =>
        RESOut.Complain["no valid last stack index"L];
    END;

  END.