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