-- file Debug.Mesa
-- last modified by Bruce, September 5, 1980  12:34 AM

DIRECTORY
  Ascii USING [TAB],
  BcdDefs USING [Link],
  ComData USING [definitionsOnly],
  CompilerUtil USING [debug, LockTableSegment, UnlockTableSegment],
  DebugFormat USING [LongSubString, LongSubStringDescriptor],
  DebugTable USING [CSRptr],
  DOutput USING [Char, Decimal, EOL, Octal, LongSubString, SubString, Text],
  Literals USING [LitDescriptor, ltType],
  LiteralOps USING [DescriptorValue, MasterString, StringValue],
  P1 USING [],
  Strings USING [SubString, SubStringDescriptor],
  Symbols USING [
    BitAddress, CTXRecord, TransferMode, TypeClass,
    HTIndex, SEIndex, ISEIndex, RecordSEIndex, CTXIndex, BTIndex,
    HTNull, SENull, lG, lZ, RootBti, typeTYPE,
    seType, ctxType, mdType, bodyType],
  SymbolOps USING [
    EnumerateBodies, FindExtension, HashForSe, NextSe, SubStringForHash,
    TypeLink, XferMode],
  Table USING [Base, Notifier, AddNotify, DropNotify, Bounds],
  Tree USING [Index, Link, Map, NodeName, NullIndex, treeType],
  TreeOps USING [GetNode, UpdateTree];

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

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

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

 -- basic io

  WriteChar: PROC [c: CHARACTER] = {DOutput.Char[c]};

  WriteString: PROC [s: STRING] = {DOutput.Text[s]};

  WriteDecimal: PROC [n: INTEGER] = {DOutput.Decimal[n]};

  WriteSubString: PROC [ss: DebugFormat.LongSubString] =  {
    DOutput.LongSubString[LOOPHOLE[ss]]};

  NewLine: PROC = {DOutput.EOL[]};

  Indent: PROC [n: CARDINAL] = {
    NewLine[];
    THROUGH [1..n/8] DO DOutput.Char[Ascii.TAB] ENDLOOP;
    THROUGH [1..n MOD 8] DO DOutput.Char[' ] ENDLOOP};


  -- csrP and desc.base are set by LockStringTable

  csrP: DebugTable.CSRptr;
  desc: DebugFormat.LongSubStringDescriptor;
  ss: DebugFormat.LongSubString = @desc;

  LockStringTable: PROC = {
    csrP _ CompilerUtil.LockTableSegment[CompilerUtil.debug];
    ss.base _ @csrP[csrP.stringOffset]};

  UnlockStringTable: PROC = {CompilerUtil.UnlockTableSegment[CompilerUtil.debug]};


  -- tree printing

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

  PrintNodeName: PUBLIC PROC [n: Tree.NodeName] = {
   LockStringTable[]; WriteNodeName[n]; UnlockStringTable[]};

  WriteNodeName: PROC [n: Tree.NodeName] = {
    ss.offset _ csrP.NodePrintName[n].offset; ss.length _ csrP.NodePrintName[n].length;
    WriteSubString[ss]};

  PrintSubTree: PROC [t: Tree.Link, nBlanks: CARDINAL] = {
    OPEN Tree;

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

    [] _ Printer[t]};


  PrintTree: PUBLIC PROC [t: Tree.Link] = {
    Table.AddNotify[DebugNotify];  LockStringTable[];
    PrintSubTree[t, 0];  NewLine[];  NewLine[];
    UnlockStringTable[];  Table.DropNotify[DebugNotify]};

  PrintBodies: PUBLIC PROC = {
    Table.AddNotify[DebugNotify];  LockStringTable[];
    [] _ SymbolOps.EnumerateBodies[RootBti, PrintBody];  NewLine[];
    UnlockStringTable[];  Table.DropNotify[DebugNotify]};

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


  PrintSymbols: PUBLIC PROC = {
    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[]};

  PrintContext: PROC [ctx: CTXIndex] = {
    sei, root: ISEIndex;
    Table.AddNotify[DebugNotify];  LockStringTable[];
    WriteString["Context: "L];  PrintIndex[ctx];
    IF ctxb[ctx].level # lZ THEN {WriteString[", level: "L]; WriteDecimal[ctxb[ctx].level]};
    WITH ctxb[ctx] SELECT FROM
      included => {
	WriteString[", copied from: "L]; PrintHti[mdb[module].moduleId];
	WriteString[" [file: "L]; PrintHti[mdb[module].fileId];
	WriteString["], context: "L];  PrintIndex[map]};
      imported => {
	WriteString[", imported from: "L]; PrintHti[mdb[ctxb[includeLink].module].moduleId]};
      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]};


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


  PrintHti: PROC [hti: HTIndex] = {
    desc: Strings.SubStringDescriptor;
    s: Strings.SubString = @desc;
    IF hti = HTNull
      THEN WriteString["(anon)"L]
      ELSE {SymbolOps.SubStringForHash[s, hti]; DOutput.SubString[s]}};

  PrintSei: PROC [sei: ISEIndex] = {PrintHti[SymbolOps.HashForSe[sei]]};


  WriteTypeName: PROC [n: TypeClass] = {
    ss.offset _ csrP.TypePrintName[n].offset;  ss.length _ csrP.TypePrintName[n].length;
    WriteSubString[ss]};

  WriteModeName: PROC [n: TransferMode] = {
    ss.offset _ csrP.ModePrintName[n].offset;  ss.length _ csrP.ModePrintName[n].length;
    WriteSubString[ss]};

  PrintType: PROC [sei: SEIndex] = {
    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 => {
		  IF sei # tSei THEN WriteChar[' ];
		  PrintSei[LOOPHOLE[tSei, ISEIndex]];
		  IF ~mark3 OR ctxb[idCtx].level # lZ THEN EXIT};
		ENDCASE;
	      ENDLOOP;
	  ENDCASE;
    WriteString[" ["L];  PrintIndex[sei];  WriteChar[']]};

  PrintTypeInfo: PROC [sei: SEIndex, nBlanks: CARDINAL] = {
    IF sei # SENull
      THEN
	WITH s: seb[sei] SELECT FROM
	  cons => {
	    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 => {
		IF t.machineDep THEN WriteString[" (md)"L];
		WriteString[", value ctx: "L];  PrintIndex[t.valueCtx]};
	      record => {
		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 => {WriteString[", link: "L]; PrintType[linkType]};
		  ENDCASE};
	      ref => {
		IF t.counted THEN WriteString[" (counted)"L];
		IF t.ordered THEN WriteString[" (ordered)"L];
		IF t.basing THEN WriteString[" (base)"L];
		WriteString[", to: "L]; PrintType[t.refType];
		IF t.readOnly THEN WriteString[" (readonly)"L];
		PrintTypeInfo[t.refType, nBlanks+2]};
	      array => {
		IF t.packed 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]};
	      arraydesc => {
		WriteString[", described type: "L]; PrintType[t.describedType];
		IF t.readOnly THEN WriteString[" (readonly)"L];
		PrintTypeInfo[t.describedType, nBlanks+2]};
	      transfer => {
		OutRecordCtx[", input ctx: "L, t.inRecord];
		OutRecordCtx[", output ctx: "L, t.outRecord]};
	      definition => {
		WriteString[", ctx: "L];  PrintIndex[t.defCtx];
		WriteString[", ngfi: "L];  WriteDecimal[t.nGfi]};
	      union => {
		IF t.overlaid THEN WriteString[" (overlaid)"L];
		IF t.controlled THEN {WriteString[", tag: "L]; PrintSei[t.tagSei]};
		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]};
	      relative => {
		WriteString[", base type: "L]; PrintType[t.baseType];
		WriteString[", offset type: "L]; PrintType[t.offsetType];
		PrintTypeInfo[t.baseType, nBlanks+2];
		PrintTypeInfo[t.offsetType, nBlanks+2]};
	      opaque => {
		WriteString[", id: "L]; PrintSei[t.id];
		IF t.lengthKnown THEN  {WriteString[", size: "L]; WriteDecimal[t.length]}};
	      zone => {
		IF t.counted THEN WriteString[" (counted)"L];
		IF t.mds THEN WriteString[" (mds)"L]};
	      subrange => {
		WriteString[" of: "L];  PrintType[t.rangeType];
		IF t.filled
		  THEN {
		    WriteString[" origin: "L];  WriteDecimal[t.origin];
		    WriteString[", range: "L]};
		PrintTypeInfo[t.rangeType, nBlanks+2]};
	      long, real => {
		WriteString[" of: "L];  PrintType[t.rangeType];
		PrintTypeInfo[t.rangeType, nBlanks+2]};
	      ENDCASE};
	  ENDCASE};

  OutRecordCtx: PROC [message: STRING, sei: RecordSEIndex] = {
    WriteString[message];
    IF sei = SENull
      THEN WriteString["NIL"L]
      ELSE PrintIndex[seb[sei].fieldCtx]};

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

  PrintLink: PROC [link: BcdDefs.Link] = {
    SELECT TRUE FROM
      link.proc => {
	WriteString["proc["L]; WriteDecimal[link.gfi]; WriteChar[',]; WriteDecimal[link.ep]};
      link.type => {WriteString["type["L]; PrintIndex[link.typeID]};
      ENDCASE => {
	WriteString["var["L]; WriteDecimal[link.gfi]; WriteChar[',]; WriteDecimal[link.var]};
    WriteChar[']]};

  END.