DIRECTORY
Basics USING [bitsPerWord],
BcdDefs
USING
[Base, BCD, ControlItem, CTIndex, CTNull, CTRecord, EVIndex, EVNull, EVRecord, EXPIndex, EXPRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord, LFIndex, LFNull, Link, LinkFrag, MTIndex, MTRecord, Namee, NameRecord, NameString, NTIndex, NTNull, NTRecord, NullLink, RefLitFrag, RFIndex, RFNull, SGIndex, SGNull, SGRecord, SpaceID, SPIndex, SPRecord, TFIndex, TFNull, TypeFrag, TYPIndex, TYPNull, TYPRecord, VersionStamp],
BcdLister USING [],
FS USING [Close, Error, nullOpenFile, Open, OpenFile, OpenFileFromStream, StreamOpen],
IO USING [Close, Put, PutChar, PutF, PutFR, PutRope, RopeFromROS, ROS, STREAM],
ListerUtils
USING
[PrintName, PrintSei, PrintVersion, ReadBcd, ReadMtr, ReadSgr, RefBCD, WithPages],
PrincOps USING [globalbase],
Rope USING [Concat, Match, ROPE],
SymbolPack,
Symbols
USING
[Base, BitAddress, BodyRecord, BTIndex, CBTIndex, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, CTXRecord, HTIndex, ISEIndex, ISENull, lG, RootBti, SEIndex, SENull, SERecord, typeTYPE],
SymbolTable USING [Acquire, Base, Release];
BcdListerImpl:
PROGRAM
IMPORTS FS, IO, ListerUtils, Rope, SymbolPack, SymbolTable
EXPORTS BcdLister = {
Base: TYPE = BcdDefs.Base;
BCD: TYPE = BcdDefs.BCD;
BitAddress: TYPE = Symbols.BitAddress;
bitsPerWord: NAT = Basics.bitsPerWord;
BodyRecord: TYPE = Symbols.BodyRecord;
BTIndex:
TYPE = Symbols.BTIndex;
RootBti: BTIndex = Symbols.RootBti;
CBTIndex: TYPE = Symbols.CBTIndex;
ContextLevel:
TYPE = Symbols.ContextLevel;
lG: ContextLevel = Symbols.lG;
ControlItem: TYPE = BcdDefs.ControlItem;
CSEIndex:
TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
typeTYPE: CSEIndex = Symbols.typeTYPE;
CTIndex:
TYPE = BcdDefs.CTIndex;
CTNull: CTIndex = BcdDefs.CTNull;
CTRecord: TYPE = BcdDefs.CTRecord;
CTXIndex:
TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
CTXRecord: TYPE = Symbols.CTXRecord;
EVIndex:
TYPE = BcdDefs.EVIndex;
EVNull: EVIndex = BcdDefs.EVNull;
EVRecord: TYPE = BcdDefs.EVRecord;
EXPIndex: TYPE = BcdDefs.EXPIndex;
EXPRecord: TYPE = BcdDefs.EXPRecord;
FPIndex: TYPE = BcdDefs.FPIndex;
FPRecord: TYPE = BcdDefs.FPRecord;
FTIndex:
TYPE = BcdDefs.FTIndex;
FTNull: FTIndex = BcdDefs.FTNull;
FTSelf: FTIndex = BcdDefs.FTSelf;
FTRecord: TYPE = BcdDefs.FTRecord;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex:
TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
ISERecord: TYPE = SERecord.id;
LFIndex:
TYPE = BcdDefs.LFIndex;
LFNull: LFIndex = BcdDefs.LFNull;
LFRecord: TYPE = BcdDefs.LinkFrag;
Link:
TYPE = BcdDefs.Link;
NullLink: Link = BcdDefs.NullLink;
Namee: TYPE = BcdDefs.Namee;
NameRecord: TYPE = BcdDefs.NameRecord;
NameString: TYPE = BcdDefs.NameString;
NTIndex:
TYPE = BcdDefs.NTIndex;
NTNull: NTIndex = BcdDefs.NTNull;
NTRecord: TYPE = BcdDefs.NTRecord;
IMPIndex: TYPE = BcdDefs.IMPIndex;
IMPRecord: TYPE = BcdDefs.IMPRecord;
MTIndex: TYPE = BcdDefs.MTIndex;
MTRecord: TYPE = BcdDefs.MTRecord;
RefBCD: TYPE = REF BCD;
RefMTRecord: TYPE = REF MTRecord;
RefSGRecord: TYPE = REF SGRecord;
RFIndex:
TYPE = BcdDefs.RFIndex;
RFNull: RFIndex = BcdDefs.RFNull;
RFRecord: TYPE = BcdDefs.RefLitFrag;
ROPE: TYPE = Rope.ROPE;
SEIndex:
TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
SGIndex:
TYPE = BcdDefs.SGIndex;
SGNull: SGIndex = BcdDefs.SGNull;
SGRecord: TYPE = BcdDefs.SGRecord;
SpaceID: TYPE = BcdDefs.SpaceID;
SPIndex: TYPE = BcdDefs.SPIndex;
SPRecord: TYPE = BcdDefs.SPRecord;
STREAM: TYPE = IO.STREAM;
SymbolTableBase: TYPE = SymbolTable.Base;
TFIndex:
TYPE = BcdDefs.TFIndex;
TFNull: TFIndex = BcdDefs.TFNull;
TFRecord: TYPE = BcdDefs.TypeFrag;
TYPIndex:
TYPE = BcdDefs.TYPIndex;
TYPNull: TYPIndex = BcdDefs.TYPNull;
TYPRecord: TYPE = BcdDefs.TYPRecord;
VersionStamp: TYPE = BcdDefs.VersionStamp;
ListBcd:
PUBLIC
PROC [stream,inStream:
STREAM, bcd: RefBCD, cmd:
ATOM] = {
PrintStamps:
PROC = {
IO.PutRope[stream, "Imports:\n\n"];
FOR iti: IMPIndex ← IMPIndex.
FIRST, iti + IMPRecord.
SIZE
UNTIL iti = bcd.impLimit DO
ip: LONG POINTER TO IMPRecord = @itb[iti];
IF
LOOPHOLE[iti,
CARDINAL] >
LOOPHOLE[bcd.impLimit,
CARDINAL]
THEN
GO TO Bogus;
IF ip.namedInstance THEN {PutInstanceName[[import[iti]]]; IO.PutRope[stream, ": "]};
PutName[ip.name];
PutFileStamp[ip.file, ip.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IO.PutRope[stream, "\nExports:\n\n"];
FOR eti: EXPIndex ← EXPIndex.
FIRST, eti + etb[eti].size + EXPRecord.
SIZE
UNTIL eti = bcd.expLimit DO
ee: LONG POINTER TO EXPRecord = @etb[eti];
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
IF ee.namedInstance THEN {PutInstanceName[[export[eti]]]; IO.PutRope[stream, ": "]};
PutName[ee.name];
PutFileStamp[ee.file, ee.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IO.PutRope[stream, "\nModules:\n\n"];
FOR mti: MTIndex ← MTIndex.
FIRST, mti + MTSize[mti]
UNTIL mti = bcd.mtLimit
DO
mm: LONG POINTER TO MTRecord = @mtb[mti];
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
IF mm.namedInstance THEN {PutInstanceName[[module[mti]]]; IO.PutRope[stream, ": "]};
PutName[mm.name];
PutFileStamp[mm.file, mm.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutFileStamp:
PROC [fti: FTIndex, mName: NameRecord] = {
SELECT fti
FROM
FTNull => IO.PutRope[stream, "(null)"];
FTSelf => IO.PutRope[stream, "(self)"];
ENDCASE => {
ftr: LONG POINTER TO FTRecord = @ftb[fti];
IF ftr.name # mName THEN {IO.PutRope[stream, ", file: "]; PutName[ftr.name]};
IO.PutRope[stream, ", version: "];
ListerUtils.PrintVersion[ftr.version, stream];
};
IO.PutChar[stream, '\n];
};
PrintHeader:
PROC = {
IO.PutF[stream, "Configurations: %g", [cardinal[bcd.nConfigs]]];
IO.PutF[stream, ", Modules: %g", [cardinal[bcd.nModules]]];
IO.PutF[stream, ", Imports: %g", [cardinal[bcd.nImports]]];
IO.PutF[stream, ", Exports: %g", [cardinal[bcd.nExports]]];
IO.PutF[stream, ", Dummy: %g", [cardinal[bcd.firstdummy]]];
IO.PutF[stream, ", #Dummies: %g\n", [cardinal[bcd.nDummies]]];
IF ~bcd.definitions THEN IO.PutChar[stream, '~];
IO.PutRope[stream, "definitions, "];
IF ~bcd.repackaged THEN IO.PutChar[stream, '~];
IO.PutRope[stream, "repackaged, "];
IF ~bcd.typeExported THEN IO.PutChar[stream, '~];
IO.PutRope[stream, "type exported, "];
IF ~bcd.tableCompiled THEN IO.PutChar[stream, '~];
IO.PutRope[stream, "table compiled, "];
IF ~bcd.versions THEN IO.PutChar[stream, '~];
IO.PutRope[stream, "versions, "];
IF ~bcd.extended THEN IO.PutChar[stream, '~];
IO.PutRope[stream, "extended\n\n"];
};
PrintConfigs:
PROC = {
cti: CTIndex ← CTIndex.FIRST;
IO.PutF[stream, "Configurations[%g]:\n", [cardinal[bcd.ctOffset]]];
UNTIL cti = bcd.ctLimit
DO
PrintConfig[cti];
cti ← cti + CTRecord.SIZE + ctb[cti].nControls*ControlItem.SIZE;
IF LOOPHOLE[cti, CARDINAL] > LOOPHOLE[bcd.ctLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintConfig:
PROC [cti: CTIndex] = {
ctp: LONG POINTER TO CTRecord = @ctb[cti];
Tab[2];
PutName[ctp.name];
PrintIndex[LOOPHOLE[cti]];
IF ctp.namedInstance
THEN {
IO.PutRope[stream, ", instance name: "];
PutInstanceName[[config[cti]]];
};
IO.PutRope[stream, ", file: "];
PrintFileName[ctp.file];
PrintIndex[LOOPHOLE[ctp.file]];
IF cti # CTNull
THEN {
IO.PutRope[stream, ", parent: "];
PutName[ctb[cti].name];
PrintIndex[LOOPHOLE[cti]]};
IO.PutF[stream, ", #controls: %g", [cardinal[ctp.nControls]]];
IF ctp.nControls # 0
THEN {
IO.PutRope[stream, ", controls:"];
FOR i:
CARDINAL
IN [0..ctp.nControls)
DO
IF i MOD 6 = 0 THEN Tab[6] ELSE IO.PutRope[stream, ", "];
WITH c: ctp.controls[i]
SELECT
FROM
module => PutName[mtb[c.mti].name];
config => {PutName[ctb[c.cti].name]; IO.PutChar[stream, '*]};
ENDCASE => ERROR;
PrintIndex[LOOPHOLE[ctp.controls[i]]];
ENDLOOP};
IO.PutChar[stream, '\n];
};
PrintImports:
PROC = {
iti: IMPIndex ← IMPIndex.FIRST;
IO.PutF[stream, "Imports[%g]:\n", [cardinal[bcd.impOffset]]];
UNTIL iti = bcd.impLimit
DO
PrintImport[iti];
iti ← iti + IMPRecord.SIZE;
IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IO.PutRope[stream, "\n\n"];
};
PrintImport:
PROC [iti: IMPIndex] = {
imp: LONG POINTER TO IMPRecord = @itb[iti];
Tab[2];
PutName[imp.name];
PrintIndex[LOOPHOLE[iti]];
IF imp.port = $module THEN IO.PutRope[stream, " (module)"];
IF imp.namedInstance
THEN {
IO.PutRope[stream, ", instance name: "]; PutInstanceName[[import[iti]]]};
IO.PutRope[stream, ", file: "];
PrintFileName[imp.file];
PrintIndex[LOOPHOLE[imp.file]];
IO.PutF[stream, ", gfi: %g", [cardinal[imp.gfi]]];
IO.PutF[stream, ", ngfi: %g", [cardinal[imp.ngfi]]];
};
PrintGlobals:
PROC [] = {
FOR mti: MTIndex ← MTIndex.
FIRST, mti + MTSize[mti]
UNTIL mti = bcd.mtLimit
DO
mtr: LONG POINTER TO MTRecord = @mtb[mti];
frameSize: CARDINAL ← mtr.framesize;
DoBody:
PROC [symbols: SymbolTableBase] = {
DoFields:
PROC [rSei: CSEIndex]
RETURNS [maxSpan:
CARDINAL ← 0] = {
WITH t: symbols.seb[rSei]
SELECT
FROM
record => maxSpan ← DoContext[t.fieldCtx];
ENDCASE;
};
DoContext:
PROC [ctx: CTXIndex]
RETURNS [maxSpan:
CARDINAL ← 0] = {
FOR sei: ISEIndex ← symbols.FirstCtxSe[ctx], symbols.NextSe[sei]
UNTIL sei = ISENull DO
IF ~symbols.seb[sei].constant THEN maxSpan ← MAX[DoSymbol[sei], maxSpan];
ENDLOOP;
};
DoSymbol:
PROC [sei: ISEIndex]
RETURNS [span:
CARDINAL] = {
addr: BitAddress = symbols.seb[sei].idValue;
size: CARDINAL = (symbols.seb[sei].idInfo+bitsPerWord-1) / bitsPerWord;
hti: HTIndex = symbols.NameForSe[sei];
IO.PutRope[stream, " "];
ListerUtils.PrintName[hti, stream, symbols];
IO.PutF[stream, "\t%g\n", [cardinal[size]]];
RETURN [addr.wd + size];
};
bti: CBTIndex ← LOOPHOLE[RootBti];
frameOverhead: CARDINAL = PrincOps.globalbase+1; -- for start trap pointer
maxSpan: CARDINAL ← frameOverhead-1;
typeIn, typeOut: CSEIndex;
[typeIn, typeOut] ← symbols.TransferTypes[symbols.bb[bti].ioType];
IF typeIn # CSENull
THEN {
IO.PutRope[stream, " Global arguments:\n"];
maxSpan ← MAX[DoFields[typeIn], maxSpan]};
IF typeOut # CSENull
THEN {
IO.PutRope[stream, " Global results:\n"];
maxSpan ← MAX[DoFields[typeOut], maxSpan]};
IF symbols.bb[bti].localCtx # CTXNull
THEN {
IO.PutRope[stream, " Global variables: (name & words)\n"];
maxSpan ← MAX[DoContext[symbols.bb[bti].localCtx], maxSpan]};
IF ~symbols.bb[bti].hints.noStrings
THEN
IO.PutRope[stream, " Global string literals or string bodies\n"];
IF maxSpan # frameSize
AND frameSize > frameOverhead
THEN
IO.PutF[
stream, " %g words not in listed variables or overhead\n",
[integer[frameSize - maxSpan]]];
IO.PutRope[stream, "\n"];
};
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
IF mtr.namedInstance THEN {PutInstanceName[[module[mti]]]; IO.PutRope[stream, ": "]};
PutName[mtr.name];
PutFileStamp[mtr.file, mtr.name];
IO.PutF[stream, " Global frame size: %g", [cardinal[frameSize]]];
IO.PutF[stream, ", gfi slots: %g\n", [cardinal[mtb[mti].ngfi]]];
WithSymbolsForModule[mti, DoBody];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
};
WithSymbolsForModule:
PROC
[mti: MTIndex, inner: PROC [symbols: SymbolTableBase]] = {
mm: LONG POINTER TO MTRecord = @mtb[mti];
IF mm.sseg = SGNull
THEN GO TO loser
ELSE {
symbols: SymbolTableBase ← NIL;
sgr: LONG POINTER TO SGRecord = @sgb[mm.sseg];
start: CARDINAL ← sgr.base;
pages: CARDINAL ← sgr.pages;
file: FS.OpenFile ← FS.nullOpenFile;
nBcd: RefBCD ← bcd;
version: VersionStamp ← bcd.version;
IF start = 0 OR sgr.pages = 0 OR sgr.file = FTNull THEN GO TO loser;
start ← start - 1;
SELECT sgr.file
FROM
FTSelf => {
There really is no problem, since the symbols are already here.
ENABLE UNWIND => IF symbols # NIL THEN SymbolTable.Release[symbols];
version ← bcd.version;
file ← FS.OpenFileFromStream[inStream];
};
ENDCASE => {
We have to pull in the symbols from the file system.
ftr: LONG POINTER TO FTRecord = @ftb[sgr.file];
fileName: ROPE ← Rope.Concat[NameToRope[ftr.name], ".bcd"];
version ← ftr.version;
file ←
FS.Open[fileName, $read
! FS.Error => IF error.group # bug THEN GO TO loser];
nBcd ← ListerUtils.ReadBcd[fileName];
};
version ← bcd.version;
IF nBcd.extended THEN pages ← pages + sgr.extraPages;
{
ENABLE
UNWIND => {
IF symbols # NIL THEN SymbolTable.Release[symbols];
FS.Close[file]};
inner[symbols ← SymbolTable.Acquire[[file, [start, pages]]]];
SymbolTable.Release[symbols];
IF bcd # nBcd THEN FS.Close[file];
};
};
EXITS
loser => inner[NIL];
};
PrintExports:
PROC [printOffset:
BOOL] = {
eti: EXPIndex ← EXPIndex.FIRST;
IF printOffset THEN IO.PutF[stream, "Exports[%g]:\n", [cardinal[bcd.expOffset]]];
UNTIL eti = bcd.expLimit
DO
PrintExport[eti];
eti ← eti + etb[eti].size + EXPRecord.SIZE;
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IF dumpLinks # all THEN IO.PutChar[stream, '\n];
IO.PutChar[stream, '\n];
};
PrintExport:
PROC [eti: EXPIndex] = {
etr: LONG POINTER TO EXPRecord = @etb[eti];
size: CARDINAL ← etr.size;
Tab[2];
PutName[etr.name];
PrintIndex[LOOPHOLE[eti]];
IF etr.port = $module THEN IO.PutRope[stream, " (module)"];
IF etr.namedInstance
THEN {
IO.PutRope[stream, ", instance name: "];
PutInstanceName[[export[eti]]];
};
IO.PutRope[stream, ", file: "];
PrintFileName[etr.file];
PrintIndex[LOOPHOLE[etr.file]];
IO.PutRope[stream, ", "];
IF ~etr.typeExported THEN IO.PutChar[stream, '~];
IO.PutF[stream, "typeExported, #links: %g", [cardinal[etr.size]]];
IF dumpLinks = all
THEN {
bcdName: ROPE = Rope.Concat[NameToRope[ftb[etr.file].name], ".bcd"];
bcdVersion: VersionStamp = ftb[etr.file].version;
exbcd: RefBCD ← NIL;
inner:
PROC [exstb: SymbolTableBase] = {
FOR i:
CARDINAL
IN [0..size)
DO
link: Link = etr.links[i];
name: ROPE = NameFromIndex[exbcd, exstb, i];
isInline: BOOL = Rope.Match["*[inline]*", name, FALSE];
isUnbound: BOOL = link = NullLink AND NOT isInline;
IF cmd = $Unbound AND NOT isUnbound THEN LOOP;
IO.PutRope[stream, "\n\t\t"];
IF isUnbound THEN IO.PutRope[stream, "** unbound ** "];
IO.PutRope[stream, name];
IF cmd = $Unbound THEN LOOP;
IO.PutRope[stream, ": "];
SELECT
TRUE
FROM
(link = NullLink) =>
IO.PutRope[stream, "(null link)"];
link.proc =>
IO.PutF[stream, "proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
link.type =>
IF link.typeID = TYPNull
THEN IO.PutRope[stream, "type[null]"]
ELSE IO.PutF[stream, "type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
ENDCASE =>
IO.PutF[stream, "var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
ENDLOOP;
};
IO.PutRope[stream, ", links:"];
exbcd ← ListerUtils.ReadBcd[bcdName ! FS.Error => CONTINUE];
SELECT
TRUE
FROM
exbcd =
NIL => {
IO.PutRope[stream, bcdName];
IO.PutRope[stream, " not found.\n"];
inner[NIL];
};
exbcd.version # bcdVersion => {
IO.PutRope[stream, bcdName];
IO.PutRope[stream, ", version "];
ListerUtils.PrintVersion[exbcd.version, stream];
IO.PutRope[stream, "found, version "];
ListerUtils.PrintVersion[bcdVersion, stream];
IO.PutRope[stream, "needed.\n"];
exbcd ← NIL;
inner[NIL];
};
ENDCASE => {
file: STREAM = FS.StreamOpen[bcdName, $read];
mtr: RefMTRecord = ListerUtils.ReadMtr[file, exbcd, LOOPHOLE[0]];
sgr: RefSGRecord = ListerUtils.ReadSgr[file, exbcd, mtr.sseg];
pages: CARDINAL = IF exbcd.extended THEN sgr.pages+sgr.extraPages ELSE sgr.pages;
exstb: SymbolTable.Base ← SymbolTable.Acquire[
[FS.OpenFileFromStream[file], [sgr.base-1, pages]]];
inner[exstb
! UNWIND => {SymbolTable.Release[exstb]; IO.Close[file]}];
SymbolTable.Release[exstb];
IO.Close[file];
};
IO.PutChar[stream, '\n];
};
};
PrintExpVars:
PROC = {
evi: EVIndex ← EVIndex.FIRST;
evLimit: EVIndex = bcd.evLimit;
IO.PutRope[stream, "Exported variables:\n"];
UNTIL evi = evLimit
DO
PrintExpVar[evi];
evi ← evi + evb[evi].length + EVRecord.SIZE;
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintExpVar:
PROC [evi: EVIndex] = {
evr: LONG POINTER TO EVRecord = @evb[evi];
Tab[2];
IO.PutF[stream, "%g, #offsets: ", [cardinal[LOOPHOLE[evi, CARDINAL]]]];
IO.PutF[stream, "%g, offsets:", [cardinal[evr.length]]];
FOR i:
CARDINAL
IN [1..evr.length]
DO
IF i MOD 8 = 1 THEN Tab[4] ELSE IO.PutChar[stream, ' ];
IO.PutF[stream, "%b", [cardinal[evr.offsets[i]]]];
IF i # evr.length THEN IO.PutChar[stream, ',];
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintSpaces:
PROC = {
spi: SPIndex ← SPIndex.FIRST;
spLimit: SPIndex = bcd.spLimit;
IO.PutRope[stream, "Spaces:\n"];
UNTIL spi = spLimit
DO
PrintSpace[spi];
spi ← spi + SPRecord.SIZE + spb[spi].length*SpaceID.SIZE;
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintSpace:
PROC [spi: SPIndex] = {
spr: LONG POINTER TO SPRecord = @spb[spi];
Tab[2];
PrintIndex[LOOPHOLE[spi, CARDINAL]];
IO.PutF[stream, ", segment: [%g]", [cardinal[LOOPHOLE[spr.seg, CARDINAL]]]];
IO.PutF[stream, ", #code packs: %g", [cardinal[spr.length]]];
IF spr.length # 0 THEN IO.PutRope[stream, ", code packs: "];
FOR i:
CARDINAL
IN [0..spr.length)
DO
Tab[4];
IO.PutRope[stream, " code pack "];
PutName[spr.spaces[i].name];
IO.PutRope[stream, ", "];
IF ~spr.spaces[i].resident THEN IO.PutChar[stream, '~];
IO.PutF[stream, "resident, offset: %b", [cardinal[spr.spaces[i].offset]]];
IO.PutF[stream, ", pages: %g\n", [cardinal[spr.spaces[i].pages]]];
ENDLOOP;
PrintModules:
PROC = {
mti: MTIndex ← MTIndex.FIRST;
IO.PutF[stream, "Modules[%g]:\n", [cardinal[bcd.mtOffset]]];
UNTIL mti = bcd.mtLimit
DO
PrintModule[@mtb[mti], mti];
mti ← mti + MTSize[mti];
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintModule:
PROC [mth:
LONG
POINTER
TO MTRecord, mti: MTIndex] = {
Tab[2];
PutName[mth.name];
PrintIndex[LOOPHOLE[mti]];
IF mth.namedInstance
THEN {
IO.PutRope[stream, "instance name: "];
PutInstanceName[[module[mti]]]};
IO.PutRope[stream, ", file: "];
PrintFileName[mth.file];
PrintIndex[LOOPHOLE[mth.file]];
IF mth.config # CTNull
THEN {
IO.PutRope[stream, ", config: "];
PutName[ctb[mth.config].name];
PrintIndex[LOOPHOLE[mth.config]]};
Tab[4];
IF mth.tableCompiled THEN IO.PutRope[stream, "table compiled, "] ELSE {
PutSwitch:
PROC [sw:
CHAR, value:
BOOL] = {
IF ~value THEN IO.PutChar[stream, '-]; IO.PutChar[stream, sw];
};
IO.PutRope[stream, "switches: "];
PutSwitch['b, mth.boundsChecks];
PutSwitch['c, mth.long];
PutSwitch['j, mth.crossJumped];
PutSwitch['l, mth.linkLoc = $code];
PutSwitch['n, mth.nilChecks];
PutSwitch['s, ~mth.initial];
IO.PutRope[stream, ", "]};
IF ~mth.packageable THEN IO.PutChar[stream, '~]; IO.PutRope[stream, "packageable, "];
IF mth.residentFrame THEN IO.PutRope[stream, "resident frame, "];
Tab[4];
IO.PutF[stream, "framesize: %g", [cardinal[mth.framesize]]];
IO.PutF[stream, ", gfi: %g", [cardinal[mth.gfi]]];
IO.PutF[stream, ", ngfi: %g", [cardinal[mth.ngfi]]];
IO.PutRope[stream, ", links: "];
IF mth.linkLoc = $frame THEN IO.PutRope[stream, "frame"] ELSE IO.PutRope[stream, "code"];
Tab[4];
IO.PutRope[stream, "code: "]; PrintSegment[mth.code.sgi];
IO.PutF[stream, ", offset: %b", [cardinal[mth.code.offset]]];
IO.PutF[stream, ", length: %b", [cardinal[mth.code.length]]];
IF mth.code.linkspace THEN IO.PutRope[stream, ", link space"];
IF mth.code.packed THEN IO.PutRope[stream, ", packed"];
Tab[4];
IO.PutRope[stream, "symbols: "]; PrintSegment[mth.sseg];
IF mth.variables # EVNull
THEN {
Tab[4];
IO.PutF[
stream, "exported variables: [%g]", [cardinal[LOOPHOLE[mth.variables, CARDINAL]]]];
};
WITH mm: mth^
SELECT
FROM
direct => {
Tab[4];
IO.PutF[stream, "#links: %g", [cardinal[mm.length]]];
IF dumpLinks = all
THEN {
IO.PutRope[stream, ", links:"];
FOR i:
CARDINAL
IN [0..mm.length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE IO.PutChar[stream, ' ];
PrintControlLink[mm.frag[i]];
IF i + 1 # mm.length THEN IO.PutChar[stream, ',];
ENDLOOP}};
indirect => {Tab[4]; PrintLinks[mm.links]};
multiple => {
Tab[4];
PrintLinks[mm.links];
Tab[4];
PrintTypes[mm.types];
IF mm.frameRefs
THEN {
Tab[5];
IO.PutF[stream, "frame type: %g", [cardinal[mm.frameType]]];
};
Tab[4];
PrintRefLits[mm.refLiterals]};
ENDCASE;
IO.PutChar[stream, '\n];
};
MTSize:
PROC [mti: MTIndex]
RETURNS [
NAT] = {
RETURN [
WITH m: mtb[mti]
SELECT
FROM
direct => MTRecord.direct.SIZE + m.length*Link.SIZE,
indirect => MTRecord.indirect.SIZE,
multiple => MTRecord.multiple.SIZE,
ENDCASE => ERROR]};
PrintLinks:
PROC [lfi: LFIndex] = {
IO.PutRope[stream, "#links: "];
IF lfi = LFNull
THEN IO.PutRope[stream, "none"]
ELSE {
IO.Put[stream, [cardinal[lfb[lfi].length]]];
IF dumpLinks = all
THEN {
IO.PutRope[stream, ", links:"];
FOR i:
CARDINAL
IN [0..lfb[lfi].length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE IO.PutChar[stream, ' ];
PrintControlLink[lfb[lfi].frag[i]];
IF i + 1 # lfb[lfi].length THEN IO.PutChar[stream, ',];
ENDLOOP;
};
};
PrintTypes:
PROC [tfi: TFIndex] = {
IO.PutRope[stream, "#types: "];
IF tfi = TFNull
THEN IO.PutRope[stream, "none"]
ELSE {
IO.Put[stream, [cardinal[tfb[tfi].length]]];
IO.PutF[stream, ", offset: %g", [cardinal[tfb[tfi].offset]]];
IF dumpLinks # none
THEN {
IO.PutRope[stream, ", indices:"];
FOR i:
CARDINAL
IN [0..tfb[tfi].length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE IO.PutChar[stream, ' ];
IO.PutF[stream, "[%g]", [cardinal[tfb[tfi].frag[i]]]];
IF i + 1 # tfb[tfi].length THEN IO.PutChar[stream, ',];
ENDLOOP;
};
};
PrintRefLits:
PROC [rfi: RFIndex] = {
IO.PutRope[stream, "#ref lits: "];
IF rfi = RFNull
THEN IO.PutRope[stream, "none"]
ELSE {
IO.Put[stream, [cardinal[rfb[rfi].length]]];
IO.PutF[stream, ", offset: %g", [cardinal[rfb[rfi].offset]]];
IF dumpLinks # none
THEN {
IO.PutRope[stream, ", indices:"];
FOR i:
CARDINAL
IN [0..rfb[rfi].length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE IO.PutChar[stream, ' ];
IO.PutF[stream, "[%g]", [cardinal[rfb[rfi].frag[i]]]];
IF i + 1 # rfb[rfi].length THEN IO.PutChar[stream, ',];
ENDLOOP;
};
};
PrintFramePacks:
PROC = {
fpi: FPIndex ← FPIndex.FIRST;
fpLimit: FPIndex = bcd.fpLimit;
IO.PutRope[stream, "Frame Packs:\n"];
UNTIL fpi = fpLimit
DO
PrintFramePack[fpi];
fpi ← fpi + FPRecord.SIZE + fpb[fpi].length*MTIndex.SIZE;
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintFramePack:
PROC [fpi: FPIndex] = {
fpr: LONG POINTER TO FPRecord = @fpb[fpi];
Tab[2];
PutName[fpr.name];
IO.PutF[stream, "[%g], #modules: ", [cardinal[LOOPHOLE[fpi, CARDINAL]]]];
IO.PutF[stream, "%g, modules:\n", [cardinal[fpr.length]]];
FOR i:
CARDINAL
IN [0..fpr.length)
DO
IF i MOD 4 = 0 THEN Tab[4] ELSE IO.PutChar[stream, ' ];
PutName[mtb[fpr.modules[i]].name];
PrintIndex[LOOPHOLE[fpr.modules[i]]];
IF i # fpr.length - 1 THEN IO.PutChar[stream, ',];
ENDLOOP;
IO.PutChar[stream, '\n];
};
PrintSegment:
PROC [sgi: SGIndex] = {
IF sgi = SGNull
THEN IO.PutRope[stream, "(null)"]
ELSE {
PrintFileName[sgb[sgi].file];
IO.PutF[stream, " [base: %g", [cardinal[sgb[sgi].base]]];
IO.PutF[stream, ", pages: %g", [cardinal[sgb[sgi].pages]]];
IF sgb[sgi].extraPages # 0
THEN
IO.PutF[stream, "+%g", [cardinal[sgb[sgi].extraPages]]];
IO.PutChar[stream, ']];
};
PrintFiles:
PROC = {
fti: FTIndex ← FTIndex.FIRST;
IO.PutF[stream, "Files[%g]:\n", [cardinal[bcd.ftOffset]]];
UNTIL fti = bcd.ftLimit
DO
PrintFile[fti];
fti ← fti + FTRecord.SIZE;
IF LOOPHOLE[fti, CARDINAL] > LOOPHOLE[bcd.ftLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IO.PutRope[stream, "\n\n"];
};
PrintFile:
PROC [fti: FTIndex] = {
Tab[2];
SELECT fti
FROM
FTNull => IO.PutRope[stream, "(null)"];
FTSelf => IO.PutRope[stream, "(self)"];
ENDCASE => {
ftr: LONG POINTER TO FTRecord = @ftb[fti];
PutName[ftr.name];
PrintIndex[LOOPHOLE[fti]];
IO.PutRope[stream, ", version: "];
ListerUtils.PrintVersion[ftr.version, stream];
};
Utility Prints
PrintControlLink:
PROC [link: Link] = {
SELECT
TRUE
FROM
(link = NullLink) =>
IO.PutRope[stream, "(null link)"];
link.proc =>
IO.PutF[stream, "proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
link.type =>
IF link.typeID = TYPNull
THEN IO.PutRope[stream, "type[null]"]
ELSE IO.PutF[stream, "type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
ENDCASE =>
IO.PutF[stream, "var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
};
PrintFileName:
PROC [fti: FTIndex] = {
SELECT fti
FROM
FTNull => IO.PutRope[stream, "(null)"];
FTSelf => IO.PutRope[stream, "(self)"];
ENDCASE => PutName[ftb[fti].name];
PrintIndex:
PROC [index:
CARDINAL] = {
IO.PutF[stream, " [%g]", [cardinal[index]]];
};
PrintGarbage:
PROC = {
Tab[2];
IO.PutRope[stream, "? Looks like garbage ...\n"];
};
Tab:
PROC [n:
CARDINAL] = {
IO.PutChar[stream, '\n];
THROUGH [1..n/8] DO IO.PutChar[stream, '\t] ENDLOOP;
THROUGH [1..n MOD 8] DO IO.PutChar[stream, ' ] ENDLOOP;
};
Utility Puts
PutName:
PROC [n: NameRecord] = {
CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR];
ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb];
index: CARDINAL = n+3;
len: CARDINAL = ss[index]-0C;
FOR i:
NAT
IN [index+1..index+len]
DO
IO.PutChar[stream, ss[i]];
ENDLOOP;
};
NameToRope:
PROC [n: NameRecord]
RETURNS [
ROPE] = {
CharSeq: TYPE = RECORD[PACKED SEQUENCE COMPUTED CARDINAL OF CHAR];
ss: LONG POINTER TO CharSeq = LOOPHOLE[ssb];
index: CARDINAL = n+3;
len: CARDINAL = ss[index]-0C;
ros: STREAM = IO.ROS[];
FOR i:
NAT
IN [index+1..index+len]
DO
IO.PutChar[ros, ss[i]];
ENDLOOP;
RETURN [IO.RopeFromROS[ros]];
};
PutInstanceName: PROC [n: Namee] = {
FindName:
PROC [ntb: Base, nti: NTIndex]
RETURNS [stop:
BOOL] = {
RETURN [ntb[nti].item = n]};
nti: NTIndex = EnumerateNameTable[FindName];
IF nti = NTNull THEN IO.PutRope[stream, " (anon) "] ELSE PutName[ntb[nti].name];
};
EnumerateNameTable:
PROC [
proc: PROC [Base, NTIndex] RETURNS [BOOL]] RETURNS [nti: NTIndex] = {
FOR nti ← NTIndex.
FIRST, nti + NTRecord.
SIZE
UNTIL nti = bcd.ntLimit
DO
IF proc[ntb, nti] THEN RETURN[nti];
ENDLOOP;
RETURN [NTNull];
Executable part of ListBcd
inner:
PROC [ptr:
LONG
POINTER] = {
tb ← LOOPHOLE[ptr];
ssb ← LOOPHOLE[ptr + bcd.ssOffset];
ctb ← tb + bcd.ctOffset;
mtb ← tb + bcd.mtOffset;
IF bcd.extended
THEN {
lfb ← tb + bcd.lfOffset;
tfb ← tb + bcd.tfOffset;
rfb ← tb + bcd.rfOffset};
itb ← tb + bcd.impOffset;
etb ← tb + bcd.expOffset;
sgb ← tb + bcd.sgOffset;
ftb ← tb + bcd.ftOffset;
ntb ← tb + bcd.ntOffset;
evb ← tb + bcd.evOffset;
spb ← tb + bcd.spOffset;
fpb ← tb + bcd.fpOffset;
SELECT cmd
FROM
$Globals =>
PrintGlobals[];
$Exports, $Unbound =>
PrintExports[FALSE];
$Bcd, $ShortBcd => {
PrintHeader[];
PrintConfigs[];
PrintImports[];
PrintExports[TRUE];
PrintExpVars[];
PrintModules[];
PrintFiles[];
PrintFramePacks[];
PrintSpaces[];
};
ENDCASE;
};
Table Bases
tb: BcdDefs.Base ← NIL;
ssb: BcdDefs.NameString ← NIL;
evb: BcdDefs.Base ← NIL;
spb: BcdDefs.Base ← NIL;
fpb: BcdDefs.Base ← NIL;
ctb: BcdDefs.Base ← NIL;
mtb: BcdDefs.Base ← NIL;
lfb: BcdDefs.Base ← NIL;
tfb: BcdDefs.Base ← NIL;
rfb: BcdDefs.Base ← NIL;
itb: BcdDefs.Base ← NIL;
etb: BcdDefs.Base ← NIL;
sgb: BcdDefs.Base ← NIL;
ftb: BcdDefs.Base ← NIL;
ntb: BcdDefs.Base ← NIL;
dumpLinks: {none, all} ← IF cmd # $ShortBcd THEN all ELSE none;
ListerUtils.WithPages[inStream, bcd, 0, bcd.nPages, inner];
};