-- STDebugTrees.mesa	Edited by Sweet,  May 21, 1980  9:38 AM
--			Edited by Bruce,  October 13, 1980  1:46 PM

DIRECTORY
  Ascii USING [SP, TAB],
  Literals USING [
    LitRecord, LTIndex, LTRecord, ltType, STIndex, STRecord, stType],
  RESOut USING [
    Log10, Log8, PChar, PCr, PNext, PNextUnsigned, POctal, PString, 
    PUnsigned],
  STDebugDefs USING [
    HashForSei, LockSymbols, PSTString, PutHashString, PutNodeName, 
    showLinks, STCopyRead, STRead, TableBase, UnlockSymbols],
  String USING [InvalidNumber, StringToDecimal],
  Symbols USING [HTIndex],
  Table USING [Base],
  Tree USING [Index, Link, Node, Null, treeType];

STDebugTrees: PROGRAM 
  IMPORTS RESOut, String, STDebugDefs
  EXPORTS STDebugDefs =
  BEGIN OPEN RESOut, STDebugDefs;

  depthString: PUBLIC STRING _ NIL;

  PutAsTree: PUBLIC PROCEDURE [t: Tree.Link] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    maxDepth: CARDINAL _ 0;
    IF depthString # NIL THEN
      maxDepth _ String.StringToDecimal[depthString !
	String.InvalidNumber => CONTINUE];
    LockSymbols[];
    PutSubTree[t, 0, maxDepth];
    UnlockSymbols[];
    END;

  PutSubTree: PROCEDURE [t: Tree.Link, depth, remaining: CARDINAL] =
    BEGIN OPEN Tree;
    overflow: CARDINAL = 2*depth+1;

    PCr[];
    THROUGH [0..depth/4) DO PChar[Ascii.TAB]; ENDLOOP;
    THROUGH [0.. depth MOD 4) DO PChar[Ascii.SP]; PChar[Ascii.SP] ENDLOOP;
    WITH tt: t SELECT FROM
      literal =>
	BEGIN
	PutLiteral[tt, overflow];
	IF showLinks THEN
	  BEGIN
	  extra: CARDINAL _ 6 + Log10[(WITH tt.info SELECT FROM
	    word => LOOPHOLE[index],
	    string => LOOPHOLE[index],
	    ENDCASE => ERROR)];
	  PNext["("L, extra, overflow];
	  WITH tt.info SELECT FROM
	    word =>
	      BEGIN PString["lti: "L]; PUnsigned[LOOPHOLE[index]] END;
	    string =>
	      BEGIN PString["sti: "L]; PUnsigned[LOOPHOLE[index]] END;
	    ENDCASE;
	  PChar[')];
	  END;
	END; -- of literal arm
      symbol =>
	BEGIN
	hti: Symbols.HTIndex _ HashForSei[tt.index];
	PutHashString[hti];
	IF showLinks THEN
	  BEGIN
	  extra: CARDINAL _ Log10[LOOPHOLE[tt.index]]+1;
	  PNext["(sei: "L, extra, overflow];
	  PUnsigned[LOOPHOLE[tt.index]];
	  PChar[')];
	  END;
	END; -- of symbol arm
      hash =>
	BEGIN
	PutHashString[tt.index];
	IF showLinks THEN
	  BEGIN
	  extra: CARDINAL _ Log10[tt.index]+1;
	  PNext["(hti: "L, extra, overflow];
	  PUnsigned[tt.index];
	  PChar[')];
	  END;
	END; -- of hash arm
      subtree => IF t = Tree.Null THEN
	BEGIN
	PString["<empty>"L];
	END
      ELSE
	BEGIN
	tb: Table.Base _ TableBase[treeType];
	tn: Tree.Node;
	STCopyRead[to: @tn, from: @tb[tt.index],
          nwords: SIZE [Tree.Node]];
	PChar['[]; PUnsigned[LOOPHOLE[tt.index]]; PString["] "L];
	IF tn.free THEN
	  BEGIN
	  PString["FREE!"L];
	  GO TO done
	  END;
	PutNodeName[tn.name];
	PNextUnsigned["info"L, tn.info, overflow];
	IF tn.attr1 OR tn.attr2 OR tn.attr3 THEN
	  BEGIN
	  PNext["attr: "L, 3, overflow];
	  IF tn.attr1 THEN PChar['1];
	  IF tn.attr2 THEN PChar['2];
	  IF tn.attr3 THEN PChar['3];
	  END;
	IF tn.shared THEN PNext["shared"L,,overflow];
	IF remaining # 0 THEN
	  BEGIN
	  EndIndex: Tree.Index = LAST[Tree.Index];
	  EndMark: Tree.Link = [subtree[index: EndIndex]];

	  son: Tree.Link;
	  p: POINTER _ @tb[tt.index].son[1];
	  IF tn.name # list OR tn.nSons # 0 THEN
	    THROUGH [0..tn.nSons) DO
	      son _ STRead[p];
	      PutSubTree[son, depth+1, remaining-1];
	      p _ p+1;
	      ENDLOOP
	  ELSE
	    DO
	      son _ STRead[p];
	      IF son = EndMark THEN EXIT;
	      PutSubTree[son, depth+1, remaining-1];
	      p _ p+1;
	      ENDLOOP;
	  END;
        EXITS
	  done => NULL;
	END; -- of subtree arm
      ENDCASE;
    END;

  PutAsLti: PUBLIC PROCEDURE [lti: Literals.LitRecord] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    LockSymbols[];
    PCr[];
    WITH lti SELECT FROM
      word =>
        BEGIN PString["ltb["L]; PUnsigned[LOOPHOLE[index]] END;
      string =>
        BEGIN PString["stb["L]; PUnsigned[LOOPHOLE[index]] END;
      ENDCASE;
    PString["] = "L];
    PutLiteral[[literal[lti]], 2];
    UnlockSymbols[];
    END;


  PutLiteral: PROCEDURE[t: literal Tree.Link, overflow: CARDINAL] =
    BEGIN OPEN Literals;
    WITH t.info SELECT FROM
      word => PutWordLiteral[index, overflow];
      string => PutStringLiteral[index];
      ENDCASE;
    END;

  PutWordLiteral: PROCEDURE [lti: Literals.LTIndex, overflow: CARDINAL] =
    BEGIN OPEN Literals;
    ltr: LTRecord;
    ltb: Table.Base;

    ltb _ TableBase[ltType];
    STCopyRead[to: @ltr, from: @ltb[lti],
      nwords: SIZE[LTRecord]];
    WITH ltr SELECT FROM
      short => POctal[value];
      long =>
	BEGIN
	i, w: CARDINAL;
        p: POINTER _ @(LOOPHOLE[ltb[lti], long LTRecord]).value;
        PChar['[];
	FOR i IN [0..length) DO
	  w _ STRead[p+i];
          IF i # 0 THEN PNext[""L, Log8[w], overflow];
	  POctal[w];
	  ENDLOOP;
	PChar[']];
	END;
      ENDCASE;
    END;

  PutStringLiteral: PROCEDURE [sti: Literals.STIndex] =
    BEGIN OPEN Literals;
    stb: Table.Base;
    str: STRecord;

    stb _ TableBase[stType];
    DO -- until a master string (at most twice)
      STCopyRead[to: @str, from: @stb[sti],
        nwords: SIZE[STRecord]];
      WITH str SELECT FROM
        copy => sti _ link;
        master =>
	  BEGIN
          PChar['"];
	  PSTString[@(LOOPHOLE[ stb[sti], master STRecord]).string];
          PChar['"];
	  IF local THEN PChar['L];
	  EXIT;
	  END;
	ENDCASE;
      ENDLOOP;
    END;

  END.