-- file Debug.Mesa
-- last modified by Satterthwaite, December 20, 1979  12:01 PM

DIRECTORY
  CharIO: FROM "chario"
    USING [CR, TAB, PutChar, PutDecimal, PutOctal, PutString],
  ComData: FROM "comdata" USING [bodyRoot, definitionsOnly, errorStream],
  CompilerUtil: FROM "compilerutil" USING [debug, TableSegment],
  ControlDefs: FROM "controldefs" USING [ControlLink],
  DebugTable: FROM "debugtable" USING [CSRptr],
  Literals: FROM "literals" USING [LitDescriptor, ltType],
  LiteralOps: FROM "literalops"
    USING [DescriptorValue, MasterString, StringValue],
  SegmentDefs: FROM "segmentdefs"
    USING [FileSegmentHandle, SegmentAddress, SwapIn, Unlock],
  StringDefs: FROM "stringdefs" USING [SubString, SubStringDescriptor],
  Symbols: FROM "symbols"
    USING [
      seType, ctxType, mdType, bodyType,
      BitAddress, CTXRecord, TransferMode, TypeClass,
      HTIndex, SEIndex, ISEIndex, RecordSEIndex, CTXIndex, BTIndex,
      HTNull, SENull, BTNull,
      lG, lZ, typeTYPE],
  SymbolOps: FROM "symbolops"
    USING [FindExtension, NextSe, SubStringForHash, TypeLink, XferMode],
  Table: FROM "table" USING [Base, Notifier, AddNotify, DropNotify, Bounds],
  Tree: FROM "tree" USING [Index, Link, Map, NodeName, NullIndex, treeType],
  TreeOps: FROM "treeops" USING [GetNode, UpdateTree];

Debug: PROGRAM
    IMPORTS
      CharIO, CompilerUtil, LiteralOps, SegmentDefs,
      SymbolOps, Table, TreeOps,
      dataPtr: ComData
    EXPORTS CompilerUtil =
  BEGIN
  OPEN Symbols;

  tb: Table.Base;
  seb: Table.Base;
  ctxb: Table.Base;
  mdb: Table.Base;
  bb: Table.Base;
  ltb: Table.Base;

  DebugNotify: Table.Notifier =
    BEGIN
    tb _ base[Tree.treeType];
    seb _ base[seType];  ctxb _ base[ctxType];  mdb _ base[mdType];
    bb _ base[bodyType];
    ltb _ base[Literals.ltType];
    END;

  SubString: TYPE = StringDefs.SubString;

 -- basic io

  WriteChar: PROCEDURE [c: CHARACTER] =
    BEGIN CharIO.PutChar[dataPtr.errorStream, c] END;

  WriteString: PROCEDURE [s: STRING] =
    BEGIN CharIO.PutString[dataPtr.errorStream, s] END;

  WriteDecimal: PROCEDURE [n: INTEGER] =
    BEGIN CharIO.PutDecimal[dataPtr.errorStream, n] END;

  NewLine: PROCEDURE = INLINE BEGIN WriteChar[CharIO.CR] END;

  Indent: PROCEDURE [n: CARDINAL] =
    BEGIN
    NewLine[];
    THROUGH [1..n/8] DO WriteChar[CharIO.TAB] ENDLOOP;
    THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP;
    END;


  -- csrP and desc.base are set by LockStringTable

  debugSeg: SegmentDefs.FileSegmentHandle =
    CompilerUtil.TableSegment[CompilerUtil.debug];

  csrP: DebugTable.CSRptr;
  desc: StringDefs.SubStringDescriptor;
  ss: SubString = @desc;

  LockStringTable: PROCEDURE =
    BEGIN
    SegmentDefs.SwapIn[debugSeg];
    csrP _ LOOPHOLE[SegmentDefs.SegmentAddress[debugSeg]];
    ss.base _ @csrP[csrP.stringOffset];
    END;

  UnlockStringTable: PROCEDURE = BEGIN SegmentDefs.Unlock[debugSeg] END;

  WriteSubString: PROCEDURE [ss: SubString] =
    BEGIN
    i: CARDINAL;
    FOR i IN [ss.offset..ss.offset+ss.length)
      DO  WriteChar[ss.base[i]]  ENDLOOP;
    END;


  -- tree printing

  PrintLiteral: PROCEDURE[t: literal Tree.Link] =
    BEGIN
    desc: Literals.LitDescriptor;
    i: CARDINAL;
    v: WORD;
    WITH t.info SELECT FROM
      string =>
	BEGIN  WriteChar['"];
	WriteString[LiteralOps.StringValue[index]];
	WriteChar['"];
	IF index # LiteralOps.MasterString[index] THEN WriteChar['L];
	END;
      word =>
	BEGIN
	desc _ LiteralOps.DescriptorValue[index];
	IF desc.length # 1 THEN WriteChar['[];
	FOR i IN [0 .. desc.length)
	  DO
	  IF (v _ ltb[desc.offset][i]) < 1000
	    THEN WriteDecimal[v]
	    ELSE CharIO.PutOctal[dataPtr.errorStream, v];
	  IF i+1 # desc.length THEN WriteChar[',];
	  ENDLOOP;
	IF desc.length # 1 THEN WriteChar[']];
	END;
      ENDCASE;
    END;

  WriteNodeName: PROCEDURE [n: Tree.NodeName] =
    BEGIN
    ss.offset _ csrP.NodePrintName[n].offset;
    ss.length _ csrP.NodePrintName[n].length;
    WriteSubString[ss];
    END;

  PrintSubTree: PROCEDURE [t: Tree.Link, nBlanks: CARDINAL] =
    BEGIN
    OPEN Tree;

    Printer: Tree.Map =
      BEGIN
      node: Tree.Index;
      Indent[nBlanks];
      WITH s: t SELECT FROM
	hash =>  PrintHti[s.index];
	symbol =>
	  BEGIN
	  PrintSei[s.index];
	  WriteChar['[]; PrintIndex[s.index]; WriteChar[']];
	  END;
	literal =>  PrintLiteral[s];
	subtree =>
	  BEGIN  node _ s.index;
	  IF node = Tree.NullIndex
	    THEN  WriteString["<empty>"L]
	    ELSE
	      BEGIN  OPEN tb[node];
	      WriteNodeName[name];
	      WriteChar['[];  PrintIndex[node];  WriteString["] "L];
	      IF info # 0
		THEN  BEGIN  WriteString["  info="L];  PrintIndex[info]  END;
	      IF attr1 OR attr2 OR attr3
		THEN
		  BEGIN
		  IF info = 0 THEN WriteChar[' ];
		  WriteChar['(];
		  IF attr1 THEN WriteChar['1];
		  IF attr2 THEN WriteChar['2];
		  IF attr3 THEN WriteChar['3];
		  WriteChar[')];
		  END;
	      nBlanks _ nBlanks + 2;
	      IF name # thread
		THEN  [] _ TreeOps.UpdateTree[s, Printer]
		ELSE
		  BEGIN
		  WriteString[" link="L]; PrintIndex[TreeOps.GetNode[son[2]]];
		  [] _ Printer[son[1]];
		  END;
	      nBlanks _ nBlanks - 2;
	      END;
	  END;
	ENDCASE;
      RETURN [t]
      END;

    [] _ Printer[t];
    END;


  PrintTree: PUBLIC PROCEDURE [t: Tree.Link] =
    BEGIN
    Table.AddNotify[DebugNotify];  LockStringTable[];
    PrintSubTree[t, 0];  NewLine[];  NewLine[];
    UnlockStringTable[];  Table.DropNotify[DebugNotify];
    END;

  PrintBodies: PUBLIC PROCEDURE =
    BEGIN
    bti, prev: BTIndex;
    Table.AddNotify[DebugNotify];  LockStringTable[];
    bti _ dataPtr.bodyRoot;
      DO
      PrintBody[bti];  NewLine[];  NewLine[];
      IF bb[bti].firstSon # BTNull
	THEN bti _ bb[bti].firstSon
	ELSE
	  DO
	  prev _ bti;  bti _ bb[bti].link.index;
	  IF bti = BTNull THEN GO TO Done;
	  IF bb[prev].link.which # parent THEN EXIT;
	  ENDLOOP;
      REPEAT
	Done => NULL;
      ENDLOOP;
    NewLine[];
    UnlockStringTable[];  Table.DropNotify[DebugNotify];
    END;

  PrintBody: PROCEDURE [bti: BTIndex] =
    BEGIN
    OPEN body: bb[bti];
    WriteString["Body: "L];
    WITH b: body SELECT FROM
      Callable =>
	BEGIN
	PrintSei[b.id];
	IF b.inline
	  THEN  WriteString[" [inline]"]
	  ELSE
	    BEGIN
	    WriteString[", ep: "L];  WriteDecimal[b.entryIndex];
	    WITH b SELECT FROM
	      Inner =>
		BEGIN
		WriteString[", frame address: "L]; WriteDecimal[frameOffset];
		END;
	      ENDCASE;
	    END;
	END;
      ENDCASE =>  WriteString["(anon)"L];
    Indent[2];
    WriteString["context: "L];  PrintIndex[body.localCtx];
    WriteString[", level: "L];  WriteDecimal[body.level];
    WITH body.info SELECT FROM
      Internal =>
	BEGIN
	WriteString[", frame size: "L];  WriteDecimal[frameSize];
	IF body.kind = Callable
	  THEN  PrintSubTree[[subtree[index: bodyTree]], 0]
	  ELSE  BEGIN WriteString[", tree root: "L]; PrintIndex[bodyTree] END;
	END;
      ENDCASE;
    END;


  PrintSymbols: PUBLIC PROCEDURE =
    BEGIN
    ctx: CTXIndex;
    limit: CTXIndex = LOOPHOLE[Table.Bounds[Symbols.ctxType].size];
    ctx _ FIRST[CTXIndex] + SIZE [nil CTXRecord];
    UNTIL ctx = limit
      DO
      PrintContext[ctx];  NewLine[];  NewLine[];
      ctx _ ctx + (WITH ctxb[ctx] SELECT FROM
	included => SIZE [included CTXRecord],
	imported => SIZE [imported CTXRecord],
	ENDCASE => SIZE [simple CTXRecord]);
      ENDLOOP;
    NewLine[];
    END;

  PrintContext: PROCEDURE [ctx: CTXIndex] =
    BEGIN
    sei, root: ISEIndex;
    Table.AddNotify[DebugNotify];  LockStringTable[];
    WriteString["Context: "L];  PrintIndex[ctx];
    IF ctxb[ctx].level # lZ THEN
      BEGIN WriteString[", level: "L]; WriteDecimal[ctxb[ctx].level] END;
    WITH ctxb[ctx] SELECT FROM
      included =>
	BEGIN
	WriteString[", copied from: "L]; PrintHti[mdb[module].moduleId];
	WriteString[" [file: "L]; PrintHti[mdb[module].fileId];
	WriteString["], context: "L];  PrintIndex[map];
	END;
      imported =>
	BEGIN  WriteString[", imported from : "L];
	PrintHti[mdb[ctxb[includeLink].module].moduleId];
	END;
      ENDCASE;
    root _ sei _ ctxb[ctx].seList;
      DO
      IF sei = SENull THEN EXIT;
      PrintSE[sei, 2];
      IF (sei _ SymbolOps.NextSe[sei]) = root THEN EXIT;
      ENDLOOP;
    UnlockStringTable[];  Table.DropNotify[DebugNotify];
    END;


  PrintSE: PROCEDURE [sei: ISEIndex, nBlanks: CARDINAL] =
    BEGIN  OPEN seb[sei];
    typeSei: SEIndex;
    addr: BitAddress;
    link: ControlDefs.ControlLink;
    Indent[nBlanks];
    PrintSei[sei];
    WriteString[" ["L];  PrintIndex[sei];  WriteChar[']];
    IF public THEN WriteString[" [public]"L];
    IF mark3
      THEN
	BEGIN
	WriteString[", type = "L];
	IF idType = typeTYPE
	  THEN
	    BEGIN  typeSei _ idInfo;
	    WriteString["TYPE, equated to: "L];
	    PrintType[typeSei];
	    IF ctxb[idCtx].level = lZ AND SymbolOps.TypeLink[sei] # SENull
	      THEN
		BEGIN WriteString[", tag code: "L]; WriteDecimal[idValue] END;
	    END
	  ELSE
	    BEGIN  typeSei _ idType;  PrintType[typeSei];
	    SELECT TRUE FROM
	      constant => WriteString[" [const]"L];
	      immutable => WriteString[" [init only]"L];
	      ENDCASE;
	    IF ~mark4
	      THEN
		BEGIN WriteString[", # refs: "L]; WriteDecimal[idInfo] END
	      ELSE
		SELECT TRUE FROM
		  constant =>
		    IF ~ extended THEN
		      BEGIN  WriteString[", value: "L];
		      SELECT SymbolOps.XferMode[typeSei] FROM
			procedure, program, signal, error =>
			  BEGIN  link _ idValue;
			  WriteChar['[];
			  WriteDecimal[link.gfi];  WriteChar[',];
			  WriteDecimal[link.ep];  WriteChar[',];
			  WriteDecimal[LOOPHOLE[link.tag]];  WriteChar[']];
			  END;
			ENDCASE =>
			  IF LOOPHOLE[idValue, CARDINAL] < 1000
			    THEN  WriteDecimal[idValue]
			    ELSE
			      CharIO.PutOctal[dataPtr.errorStream, idValue];
		      END;
		  (dataPtr.definitionsOnly AND ctxb[idCtx].level = lG) =>
		    BEGIN WriteString[", index: "L]; WriteDecimal[idValue] END;
		  ENDCASE =>
		    BEGIN  addr _ idValue;
		    WriteString[", address: "L];
		    WriteDecimal[addr.wd];  WriteChar[' ];
		    WriteChar['[];  WriteDecimal[addr.bd];
		    WriteChar[':];  WriteDecimal[idInfo];
		    WriteChar[']];
		    IF linkSpace THEN WriteChar['*];
		    END;
	    END;
	PrintTypeInfo[typeSei, nBlanks+2];
	IF extended
	  THEN PrintSubTree[SymbolOps.FindExtension[sei].tree, nBlanks+4];
	END;
    END;


  PrintHti: PROCEDURE [hti: HTIndex] =
    BEGIN
    desc: StringDefs.SubStringDescriptor;
    s: SubString = @desc;
    IF hti = HTNull
      THEN WriteString["(anon)"L]
      ELSE BEGIN SymbolOps.SubStringForHash[s, hti]; WriteSubString[s] END;
    END;

  PrintSei: PROCEDURE [sei: ISEIndex] =
    BEGIN PrintHti[IF sei=SENull THEN HTNull ELSE seb[sei].hash] END;


  WriteTypeName: PROCEDURE [n: TypeClass] =
    BEGIN
    ss.offset _ csrP.TypePrintName[n].offset;
    ss.length _ csrP.TypePrintName[n].length;
    WriteSubString[ss];
    END;

  WriteModeName: PROCEDURE [n: TransferMode] =
    BEGIN
    ss.offset _ csrP.ModePrintName[n].offset;
    ss.length _ csrP.ModePrintName[n].length;
    WriteSubString[ss];
    END;

  PrintType: PROCEDURE [sei: SEIndex] =
    BEGIN
    tSei: SEIndex;
    IF sei = SENull
      THEN WriteChar['?]
      ELSE
	WITH t: seb[sei] SELECT FROM
	  cons =>
	    WITH t SELECT FROM
	      transfer => WriteModeName[mode];
	      ENDCASE =>  WriteTypeName[t.typeTag];
	  id =>
	    FOR tSei _ sei, SymbolOps.TypeLink[tSei] UNTIL tSei = SENull
	      DO
	      WITH seb[tSei] SELECT FROM
		id =>
		  BEGIN
		  IF sei # tSei THEN WriteChar[' ];
		  PrintSei[LOOPHOLE[tSei, ISEIndex]];
		  IF ~mark3 OR ctxb[idCtx].level # lZ THEN EXIT; 
		  END;
		ENDCASE;
	      ENDLOOP;
	  ENDCASE;
    WriteString[" ["L];  PrintIndex[sei];  WriteChar[']];
    END;

  PrintTypeInfo: PROCEDURE [sei: SEIndex, nBlanks: CARDINAL] =
    BEGIN
    IF sei # SENull
      THEN
	WITH s: seb[sei] SELECT FROM
	  cons =>
	    BEGIN  Indent[nBlanks];
	    WriteChar['[];  PrintIndex[sei];  WriteString["] "L];
	    WITH s SELECT FROM
	      transfer => WriteModeName[mode];
	      ENDCASE => WriteTypeName[s.typeTag];
	    WITH t: s SELECT FROM
	      basic =>  NULL;
	      enumerated =>
		BEGIN
		WriteString[", value ctx: "L]; PrintIndex[t.valueCtx];
		END;
	      record =>
		BEGIN
		IF t.machineDep THEN WriteString[" (md)"L];
		IF t.monitored THEN WriteString[" (monitored)"L];
		IF t.hints.variant THEN WriteString[" (variant)"L];
		OutRecordCtx[", field ctx: "L, LOOPHOLE[sei, RecordSEIndex]];
		WITH ctxb[t.fieldCtx] SELECT FROM
		  included => IF ~complete THEN WriteString[" [partial]"L];
		  imported => WriteString[" [partial]"L];
		  ENDCASE;
		WITH t SELECT FROM
		  linked =>
		    BEGIN WriteString[", link: "L]; PrintType[linkType] END;
		  ENDCASE;
		END;
	      pointer =>
		BEGIN
		IF t.ordered THEN WriteString[" (ordered)"L];
		IF t.basing THEN WriteString[" (base)"L];
		WriteString[", pointing to: "L]; PrintType[t.refType];
		IF t.readOnly THEN WriteString[" (readonly)"L];
		PrintTypeInfo[t.refType, nBlanks+2];
		END;
	      array =>
		BEGIN
		IF t.oldPacked THEN WriteString[" (packed)"L];
		WriteString[", index type: "L]; PrintType[t.indexType];
		WriteString[", component type: "L]; PrintType[t.componentType];
		PrintTypeInfo[t.indexType, nBlanks+2];
		PrintTypeInfo[t.componentType, nBlanks+2];
		END;
	      arraydesc =>
		BEGIN
		WriteString[", described type: "L]; PrintType[t.describedType];
		IF t.readOnly THEN WriteString[" (readonly)"L];
		PrintTypeInfo[t.describedType, nBlanks+2];
		END;
	      transfer =>
		BEGIN
		OutRecordCtx[", input ctx: "L, t.inRecord];
		OutRecordCtx[", output ctx: "L, t.outRecord];
		END;
	      definition =>
		BEGIN
		WriteString[", ctx: "L];  PrintIndex[t.defCtx];
		WriteString[", ngfi: "L];  WriteDecimal[t.nGfi];
		END;
	      union =>
		BEGIN
		IF t.overlayed THEN WriteString[" (overlaid)"L];
		IF t.controlled
		  THEN BEGIN WriteString[", tag: "L]; PrintSei[t.tagSei]  END;
		WriteString[", tag type: "L];
		PrintType[seb[t.tagSei].idType];
		WriteString[", case ctx: "L];  PrintIndex[t.caseCtx];
		IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2];
		END;
	      relative =>
		BEGIN
		WriteString[", base type: "L]; PrintType[t.baseType];
		WriteString[", offset type: "L]; PrintType[t.offsetType];
		PrintTypeInfo[t.baseType, nBlanks+2];
		PrintTypeInfo[t.offsetType, nBlanks+2];
		PrintTypeInfo[t.resultType, nBlanks+2];
		END;
	      subrange =>
		BEGIN
		WriteString[" of: "L];  PrintType[t.rangeType];
		IF t.filled
		  THEN
		    BEGIN
		    WriteString[" origin: "L];  WriteDecimal[t.origin];
		    WriteString[", range: "L];
		    IF t.flexible
		      THEN WriteChar['*]
		      ELSE WriteDecimal[t.range];
		    END;
		PrintTypeInfo[t.rangeType, nBlanks+2];
		END;
	      long, real =>
		BEGIN
		WriteString[" of: "L];  PrintType[t.rangeType];
		PrintTypeInfo[t.rangeType, nBlanks+2];
		END;
	      ENDCASE;
	    END;
	  ENDCASE;
    END;

  OutRecordCtx: PROCEDURE [message: STRING, sei: RecordSEIndex] =
    BEGIN
    WriteString[message];
    IF sei = SENull
      THEN WriteString["NIL"L]
      ELSE PrintIndex[seb[sei].fieldCtx];
    END;

  PrintIndex: PROCEDURE [v: UNSPECIFIED] = LOOPHOLE[WriteDecimal];

  END.