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, time],
Rope: TYPE USING [ROPE],
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, Rope;
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:
ROPE] ~
INLINE {
IO.Put[data.errorStream, IO.rope[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:
ROPE, n:
INTEGER] ~ {
IO.Put[data.errorStream, IO.rope[id], IO.int[n]]};
WriteOctal:
PROC [id:
ROPE, n:
UNSPECIFIED] ~ {
IF id # NIL THEN IO.Put[data.errorStream, IO.rope[id]];
IO.PutF[data.errorStream, "%g%b", IO.rope[id], IO.card[LOOPHOLE[n, CARDINAL]]]};
WriteIndex:
PROC [id:
ROPE, index:
UNSPECIFIED] ~ {
IF id # NIL THEN IO.Put[data.errorStream, IO.rope[id]];
PrintIndex[index]};
Parse tree printing
WriteNodeName:
PROC [n: Tree.NodeName] ~ {
WriteString[
SELECT n FROM
list => "list",
item => "item",
source => "source",
config => "config",
module => "module",
assign => "assign",
plus => "plus",
then => "then",
dot => "dot",
slash => "slash",
none => "null",
ENDCASE => "ERROR"
];
};
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>"]
ELSE {
OPEN tb[node];
WriteNodeName[name]; PrintIndex[node];
SELECT name
FROM
$config => IF attrs[$exportsALL] THEN WriteString[" (EXPORTS ALL)"];
$module =>
IF attrs[$explicitLinkLoc]
THEN
WriteString[IF attrs[$codeLinks] THEN " (Code Links)" ELSE " (Frame Links)"];
$item => IF attrs[$codeLinks] THEN WriteString[" (Code Links)"];
ENDCASE;
WriteDecimal[" [", 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)"]
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:"];
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: "]; WriteNameFromTable[[config[cti]]]};
WriteString[", file: "];
PrintFileName[file]; PrintIndex[file];
IF config # CTNull
THEN {
WriteString[", parent: "]; WriteName[ctb[config].name]; PrintIndex[config]};
IF nControls # 0
THEN {
WriteString[", controls: ["];
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 ", " ELSE "]"];
ENDLOOP};
(data.table).DropNotify[DebugNotify]};
PrintImports:
PUBLIC
PROC ~ {
iti: IMPIndex ← IMPIndex.FIRST;
impLimit: IMPIndex ~ (data.table).Top[imptype];
WriteString["\nImports:"];
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)"];
ENDCASE;
IF namedInstance
THEN {
WriteString[", instance: "]; WriteNameFromTable[[import[iti]]]};
WriteString[", version: "]; PrintFileVersion[file]; PrintIndex[file];
WriteDecimal[", gfi: ", gfi]; WriteDecimal[", ngfi: ", ngfi];
(data.table).DropNotify[DebugNotify]};
PrintExports:
PUBLIC
PROC ~ {
eti: EXPIndex ← EXPIndex.FIRST;
expLimit: EXPIndex ~ (data.table).Top[exptype];
WriteString["\nExports:"];
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]"];
IF namedInstance
THEN {
WriteString[", instance: "]; WriteNameFromTable[[export[eti]]]};
WriteString[", file: "]; PrintFileVersion[file]; PrintIndex[file];
WriteDecimal[", size: ", size];
WriteString[", links:"];
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:"];
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: ", length];
WriteString[", offsets:\n"];
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:"];
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: ", id];
WriteString[", from: "]; PrintVersion[version];
(data.table).DropNotify[DebugNotify]};
PrintTypeMap:
PUBLIC
PROC ~ {
tmi: TMIndex ← TMIndex.FIRST;
tmLimit: TMIndex ~ (data.table).Top[tmtype];
WriteString["\nType map:"];
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: ", offset];
WriteString[", in: "]; PrintVersion[version];
WriteIndex[", mapped to: ", map];
(data.table).DropNotify[DebugNotify]};
PrintSpaces:
PUBLIC
PROC ~ {
spi: SPIndex ← SPIndex.FIRST;
spLimit: SPIndex ~ (data.table).Top[sptype];
WriteString["\nSpaces:"];
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: ", seg]; WriteDecimal[", length: ", length];
FOR i:
CARDINAL
IN [0..length)
DO
Indent[4];
IF spaces[i].resident THEN WriteString[", resident"];
WriteOctal[", offset: ", spaces[i].offset];
WriteDecimal[", pages: ", spaces[i].pages];
WriteCR[];
ENDLOOP;
(data.table).DropNotify[DebugNotify]};
PrintModules:
PUBLIC
PROC ~ {
mti: MTIndex ← MTIndex.FIRST;
mtLimit: MTIndex ~ (data.table).Top[mttype];
WriteString["\nModules:"];
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: "]; WriteNameFromTable[[module[mti]]]};
WriteString[", file: "]; PrintFileName[file];
WriteChar[' ]; PrintFileVersion[file]; PrintIndex[file];
IF config # CTNull
THEN {
WriteString[", config: "]; WriteName[ctb[config].name]; PrintIndex[config]};
Indent[4];
WriteDecimal["framesize: ", framesize];
WriteDecimal[", gfi: ", gfi]; WriteDecimal[", ngfi: ", ngfi];
WriteString[", links: "];
WriteString[IF linkLoc=$frame THEN "frame" ELSE "code"];
Indent[4];
WriteString["code: "]; PrintSegment[code.sgi];
WriteOctal[", offset: ", code.offset];
WriteOctal[", length: ", code.length];
IF code.linkspace THEN WriteString[", space available for links"];
Indent[4];
WriteString["symbols: "]; PrintSegment[sseg];
IF variables # EVNull THEN {Indent[4]; WriteIndex["variables: ", variables]};
WITH m~~mtb[mti]
SELECT
FROM
direct => {
Indent[4];
WriteDecimal["number of links (direct): ", m.length];
WriteString[", control links:"];
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): ", lfb[lfi].length];
WriteString[", control links:"];
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: ", rfb[rfi].length];
WriteString[", atom and REF literal links:"];
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: ", tfb[tfi].length];
WriteString[", type codes:"];
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: ", sd.base]; WriteDecimal[", pages: ", sd.pages];
IF sd.extraPages # 0 THEN WriteDecimal["+", sd.extraPages];
WriteChar[']]};
PrintFiles:
PUBLIC
PROC ~ {
fti: FTIndex ← FTIndex.FIRST;
ftLimit: FTIndex ~ (data.table).Top[fttype];
WriteString["\nFiles:"];
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: "]; PrintFileVersion[fti];
(data.table).DropNotify[DebugNotify]};
Utility Prints
PrintControlLink:
PROC [link: BcdDefs.Link] ~ {
SELECT
TRUE
FROM
link.proc => {WriteDecimal["proc[", link.gfi]; WriteDecimal[",", link.ep]};
link.type => {WriteString["type["]; PrintIndex[link.typeID]};
ENDCASE => {WriteDecimal["var[", link.vgfi]; WriteDecimal[",", link.var]};
WriteChar[']]};
PrintFileName:
PROC [fti: FTIndex] ~ {
SELECT fti
FROM
FTNull => WriteString["(null)"];
FTSelf => WriteString["(self)"];
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>"]
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"]
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:"];
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 ROPE;
mti: MTIndex;
RelType[outer] ← "outer";
RelType[inner] ← "inner";
RelType[file] ← "file ";
(data.table).AddNotify[DebugNotify];
Indent[2];
WriteString[RelType[rel.type]];
IF rel.import <
CARDINAL[rel.importLimit-IMPIndex.
FIRST]
THEN {
WriteDecimal[" imports: [", rel.import];
WriteDecimal["..", (rel.importLimit-IMPIndex.FIRST)-IMPRecord.SIZE];
WriteString["],"]};
WriteDecimal[" context: ", LOOPHOLE[rel.context]];
IF rel.type = $file
AND (mti ← rel.module+MTIndex.
FIRST) # MTNull
THEN {
WriteString[", module: "]; WriteName[mtb[mti].name]; PrintIndex[mti]};
WriteDecimal[", firstgfi: ", LOOPHOLE[rel.firstgfi]];
WriteDecimal[", lastgfi: ", LOOPHOLE[rel.lastgfi]];
WriteDecimal[", dummygfi: ", LOOPHOLE[rel.dummygfi]];
WriteDecimal[", orig1stdummy: ", LOOPHOLE[rel.originalfirstdummy]];
(data.table).DropNotify[DebugNotify]};
}.