DIRECTORY
Alloc: TYPE USING [AddNotify, DropNotify, Notifier, Top],
BcdBindDefs: TYPE USING [RelocHandle, RelocType],
BcdComData: TYPE USING [errorStream, table],
BcdControlDefs: TYPE USING [],
BcdDefs:
TYPE
USING [
ControlItem, CTIndex, CTNull, CTRecord, cttype, cxtype,
EVIndex, EVRecord, EVNull, evtype, EXPIndex, EXPRecord, exptype, fptype,
FTIndex, FTNull, FTRecord, FTSelf, fttype, IMPIndex, IMPNull, IMPRecord, imptype,
LFIndex, LFNull, lftype, Link, MTIndex, MTNull, MTRecord, mttype,
Namee, NameRecord, NameString, NTIndex, NTRecord, nttype, RFIndex, RFNull, rftype,
SGIndex, sgtype, SPIndex, SPRecord, sptype, sstype, sttype,
TFIndex, TFNull, tftype, treetype, TMIndex, TMRecord, tmtype,
TYPIndex, TYPRecord, typtype, VersionStamp],
ConvertUnsafe: TYPE USING [SubString, SubStringToRope],
HashOps: TYPE USING [SubStringForHash],
IO: TYPE USING [card, int, Put, PutChar, PutF, rope, string, time],
Symbols: TYPE USING [CXIndex, CXRecord, HTIndex, htNull, STIndex, stNull],
Table: TYPE USING [Base, Limit],
Tree: TYPE USING [Index, Link, NodeName, Scan, nullIndex],
TreeOps: TYPE USING [ScanSons];
BcdDebug:
PROGRAM
IMPORTS Alloc, ConvertUnsafe, HashOps, IO, TreeOps, data: BcdComData
EXPORTS BcdControlDefs = {
OPEN BcdDefs;
tb, cxb, stb, mtb, lfb, rfb, tfb: Table.Base;
etb, evb, itb, ctb, sgb, ftb, typb, tmb, ntb, spb, fpb: Table.Base;
ssb: BcdDefs.NameString;
DebugNotify: Alloc.Notifier ~ {
tb ← base[treetype]; stb ← base[sttype]; cxb ← base[cxtype];
ctb ← base[cttype]; mtb ← base[mttype];
lfb ← base[lftype]; rfb ← base[rftype]; tfb ← base[tftype];
etb ← base[exptype]; evb ← base[evtype]; itb ← base[imptype];
sgb ← base[sgtype]; ftb ← base[fttype];
typb ← base[typtype]; tmb ← base[tmtype];
ntb ← base[nttype]; ssb ← base[sstype];
spb ← base[sptype]; fpb ← base[fptype]};
SubString: TYPE ~ ConvertUnsafe.SubString;
Utility Writes
WriteChar:
PROC [c:
CHAR] ~
INLINE {
IO.PutChar[data.errorStream, c]};
WriteString:
PROC [s:
LONG
STRING] ~
INLINE {
IO.Put[data.errorStream, IO.string[s]]};
WriteSubString:
PROC [ss: SubString] ~
INLINE {
IO.Put[data.errorStream, IO.rope[ConvertUnsafe.SubStringToRope[ss]]]};
WriteName:
PUBLIC
PROC [n: NameRecord] ~ {
ssd: ConvertUnsafe.SubString ← [base~@ssb.string, offset~n, length~ssb.size[n]];
WriteSubString[ssd]};
WriteTime:
PUBLIC
PROC [t:
LONG
CARDINAL] ~ {
IO.Put[data.errorStream, IO.time[LOOPHOLE[t]]]};
WriteCR: PROC ~ INLINE {WriteChar['\n]};
Indent:
PROC [n:
CARDINAL] ~ {
WriteCR[];
THROUGH [1..n/8] DO WriteChar['\t] ENDLOOP;
THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP};
annotated printing
WriteDecimal:
PROC [id:
STRING, n:
INTEGER] ~ {
IO.Put[data.errorStream, IO.string[id], IO.int[n]]};
WriteOctal:
PROC [id:
STRING, n:
UNSPECIFIED] ~ {
IF id # NIL THEN IO.Put[data.errorStream, IO.string[id]];
IO.PutF[data.errorStream, "%g%b", IO.string[id], IO.card[LOOPHOLE[n, CARDINAL]]]};
WriteIndex:
PROC [id:
STRING, index:
UNSPECIFIED] ~ {
IF id # NIL THEN IO.Put[data.errorStream, IO.string[id]];
PrintIndex[index]};
Parse tree printing
WriteNodeName:
PROC [n: Tree.NodeName] ~ {
NodePrintName:
ARRAY Tree.NodeName
OF
STRING ~ [
"list"L, "item"L, "source"L, "config"L,
"module"L, "assign"L, "plus"L, "then"L,
"dot"L, "slash"L, "null"L];
WriteString[NodePrintName[n]]};
PrintSubTree:
PROC [t: Tree.Link, nBlanks:
CARDINAL] ~ {
OPEN Tree;
Printer: Tree.Scan ~ {
Indent[nBlanks];
WITH s~~t
SELECT
FROM
hash => PrintHti[s.index];
symbol => {PrintHti[stb[s.index].hti]; PrintIndex[s.index]};
subtree => {
node: Tree.Index ~ s.index;
IF node = Tree.nullIndex THEN WriteString["<empty>"L]
ELSE {
OPEN tb[node];
WriteNodeName[name]; PrintIndex[node];
SELECT name
FROM
$config => IF attrs[$exportsALL] THEN WriteString[" (EXPORTS ALL)"L];
$module =>
IF attrs[$explicitLinkLoc]
THEN
WriteString[IF attrs[$codeLinks] THEN " (Code Links)"L ELSE " (Frame Links)"L];
$item => IF attrs[$codeLinks] THEN WriteString[" (Code Links)"L];
ENDCASE;
WriteDecimal[" ["L, info]; WriteChar[']];
nBlanks ← nBlanks + 2;
TreeOps.ScanSons[s, Printer];
nBlanks ← nBlanks - 2}};
ENDCASE};
Printer[t]};
PrintTree:
PUBLIC
PROC [t: Tree.Link] ~ {
(data.table).AddNotify[DebugNotify];
PrintSubTree[t, 0]; WriteCR[]; WriteCR[];
(data.table).DropNotify[DebugNotify]};
PrintHti:
PROC [hti: Symbols.HTIndex] ~ {
s: SubString;
IF hti = Symbols.htNull THEN WriteString["(anonymous)"L]
ELSE {s ← HashOps.SubStringForHash[hti]; WriteSubString[s]}};
PrintBcd:
PUBLIC
PROC ~ {
PrintConfigs[];
PrintImports[];
PrintExports[];
PrintExpVars[];
PrintTypes[];
PrintTypeMap[];
PrintModules[];
PrintFiles[]};
PrintConfigs:
PUBLIC
PROC ~ {
cti: CTIndex ← CTIndex.FIRST;
ctLimit: CTIndex ~ (data.table).Top[cttype];
(data.table).AddNotify[DebugNotify];
WriteString["\nConfigurations:"L];
UNTIL cti = ctLimit
DO
PrintConfig[cti];
cti ← cti + (CTRecord.SIZE+ctb[cti].nControls*ControlItem.SIZE);
ENDLOOP;
WriteCR[];
(data.table).DropNotify[DebugNotify]};
PrintConfig:
PUBLIC
PROC [cti: CTIndex] ~ {
OPEN ctb[cti];
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteName[name]; PrintIndex[cti];
IF namedInstance
THEN {
WriteString[", instance: "L]; WriteNameFromTable[[config[cti]]]};
WriteString[", file: "L];
PrintFileName[file]; PrintIndex[file];
IF config # CTNull
THEN {
WriteString[", parent: "L]; WriteName[ctb[config].name]; PrintIndex[config]};
IF nControls # 0
THEN {
WriteString[", controls: ["L];
FOR i:
CARDINAL
IN [0..nControls)
DO
WITH c~~controls[i]
SELECT
FROM
module => WriteName[mtb[c.mti].name];
config => {WriteName[ctb[c.cti].name]; WriteChar['*]};
ENDCASE => ERROR;
PrintIndex[controls[i]];
WriteString[IF i # nControls-1 THEN ", "L ELSE "]"L];
ENDLOOP};
(data.table).DropNotify[DebugNotify]};
PrintImports:
PUBLIC
PROC ~ {
iti: IMPIndex ← IMPIndex.FIRST;
impLimit: IMPIndex ~ (data.table).Top[imptype];
WriteString["\nImports:"L];
UNTIL iti = impLimit DO PrintImport[iti]; iti ← iti + IMPRecord.SIZE ENDLOOP;
WriteCR[]};
PrintImport:
PUBLIC
PROC [iti: IMPIndex] ~ {
OPEN itb[iti];
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteName[name]; PrintIndex[iti];
SELECT port
FROM
$module => WriteString[" (module)"L];
ENDCASE;
IF namedInstance
THEN {
WriteString[", instance: "L]; WriteNameFromTable[[import[iti]]]};
WriteString[", version: "L]; PrintFileVersion[file]; PrintIndex[file];
WriteDecimal[", gfi: "L, gfi]; WriteDecimal[", ngfi: "L, ngfi];
(data.table).DropNotify[DebugNotify]};
PrintExports:
PUBLIC
PROC ~ {
eti: EXPIndex ← EXPIndex.FIRST;
expLimit: EXPIndex ~ (data.table).Top[exptype];
WriteString["\nExports:"L];
UNTIL eti = expLimit
DO
PrintExport[eti]; eti ← eti + etb[eti].size+EXPRecord.SIZE ENDLOOP;
WriteCR[]};
PrintExport:
PUBLIC
PROC [eti: EXPIndex] ~ {
OPEN etb[eti];
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteName[name]; PrintIndex[eti];
IF port = $module THEN WriteString[" [module]"L];
IF namedInstance
THEN {
WriteString[", instance: "L]; WriteNameFromTable[[export[eti]]]};
WriteString[", file: "L]; PrintFileVersion[file]; PrintIndex[file];
WriteDecimal[", size: "L, size];
WriteString[", links:"L];
FOR i:
CARDINAL
IN [0..size)
DO
IF i MOD 8 = 0 THEN Indent[4] ELSE WriteChar[' ];
PrintControlLink[links[i]];
IF i+1 # size THEN WriteChar[',];
ENDLOOP;
(data.table).DropNotify[DebugNotify]};
PrintExpVars:
PUBLIC
PROC ~ {
evi: EVIndex ← EVIndex.FIRST;
evLimit: EVIndex ~ (data.table).Top[evtype];
WriteString["\nExported variables:"L];
UNTIL evi = evLimit
DO
PrintExpVar[evi]; evi ← evi + evb[evi].length+EVRecord.SIZE ENDLOOP;
WriteCR[]};
PrintExpVar:
PUBLIC
PROC [evi: EVIndex] ~ {
OPEN evb[evi];
(data.table).AddNotify[DebugNotify];
Indent[2];
PrintIndex[evi];
WriteDecimal[", length: "L, length];
WriteString[", offsets:\n"L];
FOR i:
CARDINAL
IN [1..length]
DO
IF i MOD 8 = 1 THEN Indent[4] ELSE WriteChar[' ];
WriteOctal[NIL, offsets[i]];
IF i # length THEN WriteChar[',];
ENDLOOP;
(data.table).DropNotify[DebugNotify]};
PrintTypes:
PUBLIC
PROC ~ {
typi: TYPIndex ← TYPIndex.FIRST;
typLimit: TYPIndex ~ (data.table).Top[typtype];
WriteString["\nExported types:"L];
UNTIL typi = typLimit DO PrintType[typi]; typi ← typi + TYPRecord.SIZE ENDLOOP;
WriteCR[]};
PrintType:
PUBLIC
PROC [typi: TYPIndex] ~ {
OPEN typb[typi];
(data.table).AddNotify[DebugNotify];
Indent[2];
PrintIndex[typi];
WriteDecimal[", id: "L, id];
WriteString[", from: "L]; PrintVersion[version];
(data.table).DropNotify[DebugNotify]};
PrintTypeMap:
PUBLIC
PROC ~ {
tmi: TMIndex ← TMIndex.FIRST;
tmLimit: TMIndex ~ (data.table).Top[tmtype];
WriteString["\nType map:"L];
UNTIL tmi = tmLimit DO PrintMapEntry[tmi]; tmi ← tmi + TMRecord.SIZE ENDLOOP;
WriteCR[]};
PrintMapEntry:
PUBLIC
PROC [tmi: TMIndex] ~ {
OPEN tmb[tmi];
(data.table).AddNotify[DebugNotify];
Indent[2];
PrintIndex[tmi];
WriteDecimal[", entry: "L, offset];
WriteString[", in: "L]; PrintVersion[version];
WriteIndex[", mapped to: "L, map];
(data.table).DropNotify[DebugNotify]};
PrintSpaces:
PUBLIC
PROC ~ {
spi: SPIndex ← SPIndex.FIRST;
spLimit: SPIndex ~ (data.table).Top[sptype];
WriteString["\nSpaces:"L];
UNTIL spi = spLimit DO PrintSpace[spi]; spi ← spi + spb[spi].length+SPRecord.SIZE ENDLOOP;
WriteCR[]};
PrintSpace:
PUBLIC
PROC [spi: SPIndex] ~ {
OPEN spb[spi];
(data.table).AddNotify[DebugNotify];
Indent[2];
PrintIndex[spi];
WriteIndex[", segment: "L, seg]; WriteDecimal[", length: "L, length];
FOR i:
CARDINAL
IN [0..length)
DO
Indent[4];
IF spaces[i].resident THEN WriteString[", resident"L];
WriteOctal[", offset: "L, spaces[i].offset];
WriteDecimal[", pages: "L, spaces[i].pages];
WriteCR[];
ENDLOOP;
(data.table).DropNotify[DebugNotify]};
PrintModules:
PUBLIC
PROC ~ {
mti: MTIndex ← MTIndex.FIRST;
mtLimit: MTIndex ~ (data.table).Top[mttype];
WriteString["\nModules:"L];
UNTIL mti = mtLimit
DO
PrintModule[mti];
mti ← mti + (
WITH m~~mtb[mti]
SELECT
FROM
direct => MTRecord.direct.SIZE + m.length*Link.SIZE,
indirect => MTRecord.indirect.SIZE,
multiple => MTRecord.multiple.SIZE,
ENDCASE => ERROR);
ENDLOOP;
WriteCR[]};
PrintModule:
PUBLIC
PROC [mti: MTIndex] ~ {
OPEN mtb[mti];
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteName[name]; PrintIndex[mti];
IF namedInstance
THEN {
WriteString["instance: "L]; WriteNameFromTable[[module[mti]]]};
WriteString[", file: "L]; PrintFileName[file];
WriteChar[' ]; PrintFileVersion[file]; PrintIndex[file];
IF config # CTNull
THEN {
WriteString[", config: "L]; WriteName[ctb[config].name]; PrintIndex[config]};
Indent[4];
WriteDecimal["framesize: "L, framesize];
WriteDecimal[", gfi: "L, gfi]; WriteDecimal[", ngfi: "L, ngfi];
WriteString[", links: "L];
WriteString[IF linkLoc=$frame THEN "frame"L ELSE "code"L];
Indent[4];
WriteString["code: "L]; PrintSegment[code.sgi];
WriteOctal[", offset: "L, code.offset];
WriteOctal[", length: "L, code.length];
IF code.linkspace THEN WriteString[", space available for links"L];
Indent[4];
WriteString["symbols: "L]; PrintSegment[sseg];
IF variables # EVNull THEN {Indent[4]; WriteIndex["variables: "L, variables]};
WITH m~~mtb[mti]
SELECT
FROM
direct => {
Indent[4];
WriteDecimal["number of links (direct): "L, m.length];
WriteString[", control links:"L];
FOR i:
CARDINAL
IN [0..m.length)
DO
IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ];
PrintControlLink[m.frag[i]];
IF i+1 # m.length THEN WriteChar[',];
ENDLOOP};
indirect => IF m.links # LFNull THEN PrintLinkFrag[m.links];
multiple => {
IF m.links # LFNull THEN PrintLinkFrag[m.links];
IF m.refLiterals # RFNull THEN PrintRefLitFrag[m.refLiterals];
IF m.types # TFNull THEN PrintTypeFrag[m.types]};
ENDCASE;
(data.table).DropNotify[DebugNotify]};
PrintLinkFrag:
PROC [lfi: LFIndex] ~ {
Indent[4];
WriteDecimal["number of links (indirect): "L, lfb[lfi].length];
WriteString[", control links:"L];
FOR i:
CARDINAL
IN [0..lfb[lfi].length)
DO
IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ];
PrintControlLink[lfb[lfi].frag[i]];
IF i+1 # lfb[lfi].length THEN WriteChar[',];
ENDLOOP};
PrintRefLitFrag:
PROC [rfi: RFIndex] ~ {
Indent[4]; WriteDecimal["number of atoms: "L, rfb[rfi].length];
WriteString[", atom and REF literal links:"L];
FOR i:
CARDINAL
IN [0..rfb[rfi].length)
DO
IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ];
WriteDecimal[NIL, rfb[rfi].frag[i]];
IF i+1 # rfb[rfi].length THEN WriteChar[',];
ENDLOOP};
PrintTypeFrag:
PROC [tfi: TFIndex] ~ {
Indent[4];
WriteDecimal["number of types: "L, tfb[tfi].length];
WriteString[", type codes:"L];
FOR i:
CARDINAL
IN [0..tfb[tfi].length)
DO
IF i MOD 8 = 0 THEN Indent[6] ELSE WriteChar[' ];
WriteDecimal[NIL, tfb[tfi].frag[i]];
IF i+1 # tfb[tfi].length THEN WriteChar[',];
ENDLOOP};
PrintSegment:
PUBLIC
PROC [sgi: SGIndex] ~ {
OPEN sd~~sgb[sgi];
PrintFileName[sd.file];
WriteDecimal[" [base: "L, sd.base]; WriteDecimal[", pages: "L, sd.pages];
IF sd.extraPages # 0 THEN WriteDecimal["+"L, sd.extraPages];
WriteChar[']]};
PrintFiles:
PUBLIC
PROC ~ {
fti: FTIndex ← FTIndex.FIRST;
ftLimit: FTIndex ~ (data.table).Top[fttype];
WriteString["\nFiles:"L];
UNTIL fti = ftLimit DO PrintFile[fti]; fti ← fti + FTRecord.SIZE ENDLOOP;
WriteCR[]};
PrintFile:
PUBLIC
PROC [fti: FTIndex] ~ {
OPEN ftb[fti];
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteName[name]; PrintIndex[fti];
WriteString[", version: "L]; PrintFileVersion[fti];
(data.table).DropNotify[DebugNotify]};
Utility Prints
PrintControlLink:
PROC [link: BcdDefs.Link] ~ {
SELECT
TRUE
FROM
link.proc => {WriteDecimal["proc["L, link.gfi]; WriteDecimal[","L, link.ep]};
link.type => {WriteString["type["L]; PrintIndex[link.typeID]};
ENDCASE => {WriteDecimal["var["L, link.vgfi]; WriteDecimal[","L, link.var]};
WriteChar[']]};
PrintFileName:
PROC [fti: FTIndex] ~ {
SELECT fti
FROM
FTNull => WriteString["(null)"L];
FTSelf => WriteString["(self)"L];
ENDCASE => WriteName[ftb[fti].name]};
PrintFileVersion:
PROC [fti: FTIndex] ~
INLINE
{PrintVersion[ftb[fti].version]};
PrintVersion:
PROC [version: VersionStamp] ~ {
WriteChar['(];
IF version.time = 0 THEN WriteString["<null version>"L]
ELSE {
StampWords: CARDINAL ~ VersionStamp.SIZE;
str: PACKED ARRAY [0..4*StampWords) OF [0..16) ~ LOOPHOLE[version];
digit: STRING ~ "0123456789abcdef"L;
WriteChar['"];
FOR i: NAT IN [0..4*StampWords) DO WriteChar[digit[str[i]]] ENDLOOP;
WriteChar['"]};
WriteChar[')]};
PrintIndex:
PROC [index:
UNSPECIFIED] ~ {
WriteChar['[];
IF index = Table.Limit-1 THEN WriteString["Null"L]
ELSE IO.Put[data.errorStream, IO.card[LOOPHOLE[index, CARDINAL]]];
WriteChar[']]};
WriteNameFromTable:
PROC [n: Namee] ~ {
ntLimit: NTIndex ~ (data.table).Top[nttype];
FOR nti: NTIndex ← NTIndex.
FIRST, nti + NTRecord.
SIZE
UNTIL nti = ntLimit
DO
IF ntb[nti].item = n THEN {WriteName[ntb[nti].name]; EXIT};
ENDLOOP};
Relocation printing
PrintRelocations:
PUBLIC
PROC [relHead: BcdBindDefs.RelocHandle] ~ {
WriteString["\nRelocations:"L];
FOR rel: BcdBindDefs.RelocHandle ← relHead, rel.link
UNTIL rel =
NIL
DO
PrintRel[rel] ENDLOOP;
WriteCR[]};
PrintRel:
PUBLIC
PROC [rel: BcdBindDefs.RelocHandle] ~ {
RelType:
ARRAY BcdBindDefs.RelocType
OF
STRING ~ [
outer:"outer"L, inner:"inner"L, file:"file "L];
mti: MTIndex;
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteString[RelType[rel.type]];
IF rel.import <
CARDINAL[rel.importLimit-IMPIndex.
FIRST]
THEN {
WriteDecimal[" imports: ["L, rel.import];
WriteDecimal[".."L, (rel.importLimit-IMPIndex.FIRST)-IMPRecord.SIZE];
WriteString["],"L]};
WriteDecimal[" context: "L, LOOPHOLE[rel.context]];
IF rel.type = $file
AND (mti ← rel.module+MTIndex.
FIRST) # MTNull
THEN {
WriteString[", module: "L]; WriteName[mtb[mti].name]; PrintIndex[mti]};
WriteDecimal[", firstgfi: "L, LOOPHOLE[rel.firstgfi]];
WriteDecimal[", lastgfi: "L, LOOPHOLE[rel.lastgfi]];
WriteDecimal[", dummygfi: "L, LOOPHOLE[rel.dummygfi]];
WriteDecimal[", orig1stdummy: "L, LOOPHOLE[rel.originalfirstdummy]];
(data.table).DropNotify[DebugNotify]};
}.