-- file Debug.mesa
-- last modified by Satterthwaite, March 23, 1983 10:11 am
DIRECTORY
Alloc: TYPE USING [Base, Handle, Notifier, AddNotify, DropNotify, Top],
BcdDefs: TYPE USING [Link, VersionStamp],
CharIO: TYPE USING [CR, TAB, PutChar, PutDecimal, PutOctal, PutString],
CompilerUtil: TYPE USING [
AcquireStream, AcquireTable, ReleaseStream, ReleaseTable],
DebugTable: TYPE USING [CSRptr],
Literals: TYPE USING [Base, LitDescriptor, ltType],
LiteralOps: TYPE USING [DescriptorValue, MasterString, StringValue],
Strings: TYPE USING [String, SubString, SubStringDescriptor],
Stream: TYPE USING [Handle],
Symbols: TYPE USING [
Base, BitAddress, CTXRecord, TransferMode, TypeClass,
Name, SEIndex, ISEIndex, CSEIndex, CTXIndex, BTIndex,
nullName, SENull, CTXNull, lG, lZ, RootBti, typeTYPE,
seType, ctxType, mdType, bodyType],
SymbolOps: TYPE USING [
EnumerateBodies, FindExtension, NameForSe, NextSe,
SubStringForName, TypeLink, XferMode],
Tree: TYPE USING [Base, Index, Link, NodeName, Scan, NullIndex, treeType],
TreeOps: TYPE USING [GetNode, ScanSons];
Debug: PROGRAM
IMPORTS
Alloc, CharIO, CompilerUtil, LiteralOps, SymbolOps, TreeOps
EXPORTS CompilerUtil = {
OPEN Symbols;
tb: Tree.Base;
seb: Symbols.Base;
ctxb: Symbols.Base;
mdb: Symbols.Base;
bb: Symbols.Base;
ltb: Literals.Base;
definitionsOnly: BOOL;
DebugNotify: Alloc.Notifier = {
tb ← base[Tree.treeType];
seb ← base[seType]; ctxb ← base[ctxType]; mdb ← base[mdType];
bb ← base[bodyType];
ltb ← base[Literals.ltType]};
SubString: TYPE = Strings.SubString;
-- basic io
errorStream: Stream.Handle ← NIL;
WriteChar: PROC [c: CHAR] = {CharIO.PutChar[errorStream, c]};
WriteString: PROC [s: STRING] = {CharIO.PutString[errorStream, s]};
WriteDecimal: PROC [n: INTEGER] = {
CharIO.PutDecimal[errorStream, n]};
NewLine: PROC = INLINE {WriteChar[CharIO.CR]};
Indent: PROC [n: CARDINAL] = {
NewLine[];
THROUGH [1..n/8] DO WriteChar[CharIO.TAB] ENDLOOP;
THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP};
-- errorStream, csrP and desc.base are set by Enter
csrP: DebugTable.CSRptr;
desc: Strings.SubStringDescriptor;
ss: SubString = @desc;
LockStringTable: PROC = INLINE {
csrP ← CompilerUtil.AcquireTable[debug];
ss.base ← @csrP[csrP.stringOffset]};
UnlockStringTable: PROC = INLINE {CompilerUtil.ReleaseTable[debug]; csrP ← NIL};
Enter: PROC [table: Alloc.Handle] = {
table.AddNotify[DebugNotify];
errorStream ← CompilerUtil.AcquireStream[log]; LockStringTable[]};
Exit: PROC [table: Alloc.Handle] = {
UnlockStringTable[]; CompilerUtil.ReleaseStream[log]; errorStream ← NIL;
table.DropNotify[DebugNotify]};
WriteSubString: PROC [ss: SubString] = {
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
WriteChar[ss.base[i]] ENDLOOP};
-- tree printing
PrintLiteral: PROC [t: Tree.Link.literal] = {
WITH t.index SELECT FROM
string => {
s: Strings.String = LiteralOps.StringValue[sti];
WriteChar['"];
FOR i: CARDINAL IN [0..s.length) DO WriteChar[s[i]] ENDLOOP;
WriteChar['"];
IF sti # LiteralOps.MasterString[sti] THEN WriteChar['L]};
word => {
desc: Literals.LitDescriptor = LiteralOps.DescriptorValue[lti];
v: WORD;
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 CharIO.PutOctal[errorStream, v];
IF i+1 # desc.length THEN WriteChar[',];
ENDLOOP;
IF desc.length # 1 THEN WriteChar[']]};
ENDCASE};
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.Scan = {
Indent[nBlanks];
WITH s: t SELECT FROM
hash => PrintName[s.index];
symbol => {PrintSei[s.index]; WriteChar['[]; PrintIndex[s.index]; WriteChar[']]};
literal => PrintLiteral[s];
subtree => {
node: Tree.Index = 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.ScanSons[s, Printer]
ELSE {
WriteString[" link="L]; PrintIndex[TreeOps.GetNode[son[2]]];
Printer[son[1]]};
nBlanks ← nBlanks - 2}};
ENDCASE};
Printer[t]};
PrintTree: PUBLIC PROC [table: Alloc.Handle, root: Tree.Link] = {
Enter[table];
PrintSubTree[root, 0]; NewLine[]; NewLine[];
Exit[table]};
PrintBodies: PUBLIC PROC [table: Alloc.Handle] = {
Enter[table];
[] ← SymbolOps.EnumerateBodies[RootBti, PrintBody]; NewLine[];
Exit[table]};
PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = {
OPEN body: bb[bti];
WriteString["Body: "L];
WITH b: body SELECT FROM
Callable => {
PrintSei[b.id];
IF b.inline THEN WriteString[" [inline]"L]
ELSE {
WriteString[", ep: "L]; WriteDecimal[b.entryIndex];
WITH b SELECT FROM
Inner => {WriteString[", frame addr: "L]; WriteDecimal[frameOffset]};
ENDCASE};
WriteString[", attrs: "L];
WriteChar[IF ~b.noXfers THEN 'x ELSE '-];
WriteChar[IF b.hints.safe THEN 's ELSE '-];
WriteChar[IF b.hints.nameSafe THEN 'n ELSE '-];
IF ~b.hints.noStrings THEN {Indent[2]; WriteString["string literals"L]}};
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 [table: Alloc.Handle, definitions: BOOL] = {
ctx: CTXIndex;
limit: CTXIndex;
Enter[table];
definitionsOnly ← definitions;
limit ← table.Top[Symbols.ctxType];
ctx ← CTXIndex.FIRST + CTXRecord.nil.SIZE;
UNTIL ctx = limit DO
PrintContext[ctx]; NewLine[]; NewLine[];
ctx ← ctx + (WITH ctxb[ctx] SELECT FROM
included => CTXRecord.included.SIZE,
imported => CTXRecord.imported.SIZE,
ENDCASE => CTXRecord.simple.SIZE);
ENDLOOP;
NewLine[];
Exit[table]};
PrintContext: PROC [ctx: CTXIndex] = {
sei, root: ISEIndex;
WriteString["Context: "L]; PrintIndex[ctx];
IF ctxb[ctx].level # lZ THEN {WriteString[", level: "L]; WriteDecimal[ctxb[ctx].level]};
WITH c: ctxb[ctx] SELECT FROM
included => {
WriteString[", copied from: "L]; PrintName[mdb[c.module].moduleId];
WriteString[" ["L]; PrintName[mdb[c.module].fileId];
WriteString[", "L]; PrintVersion[mdb[c.module].stamp];
WriteString["], context: "L]; PrintIndex[c.map]};
imported => {
WriteString[", imported from: "L]; PrintName[mdb[ctxb[c.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};
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 CharIO.PutOctal[errorStream, idValue]};
(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]}};
PrintName: PROC [name: Name] = {
desc: Strings.SubStringDescriptor;
s: SubString = @desc;
IF name = nullName THEN WriteString["(anon)"L]
ELSE {SymbolOps.SubStringForName[s, name]; WriteSubString[s]}};
PrintSei: PROC [sei: ISEIndex] = {PrintName[SymbolOps.NameForSe[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]
ELSE IF t.unpainted THEN WriteString[" (~painted)"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];
OutCtx[", field"L, t.fieldCtx];
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 => {
SELECT TRUE FROM
t.counted => WriteString[" (counted)"L];
t.var => WriteString[" (var)"L];
ENDCASE;
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 => {
IF t.safe THEN WriteString[" (safe)"L];
OutArgType[", input"L, t.typeIn];
OutArgType[", output"L, t.typeOut]};
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]};
sequence => {
IF t.packed THEN WriteString[" (packed)"L];
IF t.controlled THEN {WriteString[", tag: "L]; PrintSei[t.tagSei]}
ELSE {WriteString[", index type: "L]; PrintType[seb[t.tagSei].idType]};
WriteString[", component type: "L]; PrintType[t.componentType];
IF t.controlled THEN PrintSE[t.tagSei, nBlanks+2]
ELSE PrintTypeInfo[seb[t.tagSei].idType, nBlanks+2];
PrintTypeInfo[t.componentType, 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]; WriteDecimal[t.range]};
PrintTypeInfo[t.rangeType, nBlanks+2]};
long, real => {
WriteString[" of: "L]; PrintType[t.rangeType];
PrintTypeInfo[t.rangeType, nBlanks+2]};
ENDCASE};
ENDCASE};
OutCtx: PROC [message: STRING, ctx: CTXIndex] = {
WriteString[message]; WriteString[" ctx: "L];
IF ctx = CTXNull THEN WriteString["NIL"L] ELSE PrintIndex[ctx]};
OutArgType: PROC [message: STRING, sei: CSEIndex] = {
IF sei = SENull THEN {WriteString[message]; WriteString[": NIL"L]}
ELSE
WITH t: seb[sei] SELECT FROM
record => OutCtx[message, t.fieldCtx];
any => {WriteString[message]; WriteString[": ANY"L]};
ENDCASE};
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[']]};
PrintVersion: PROC [stamp: BcdDefs.VersionStamp] = {
stampWords: CARDINAL = BcdDefs.VersionStamp.SIZE;
str: PACKED ARRAY [0..4*stampWords) OF [0..16) = LOOPHOLE[stamp];
digit: STRING = "0123456789abcdef"L;
FOR i: NAT IN [0..4*stampWords) DO WriteChar[digit[str[i]]] ENDLOOP};
}.