-- 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.