DIRECTORY
Basics: TYPE USING [bitsPerWord],
BcdDefs: TYPE 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: TYPE USING [],
FS: TYPE USING [Close, Error, nullOpenFile, Open, OpenFile, OpenFileFromStream, StreamOpen],
IO: TYPE USING [Close, Put, PutChar, PutF, PutF1, PutFR, PutRope, RopeFromROS, ROS, STREAM],
ListerUtils: TYPE USING [nullName, PrintName, PrintSei, PrintVersion, ReadBcd, ReadMtr, ReadSgr, RefBCD, SubString, WithPages],
PrincOps: TYPE USING [globalbase],
Rope: TYPE USING [Concat, Equal, Match, ROPE],
SymbolPack: TYPE,
Symbols: TYPE USING [Base, BitAddress, BodyRecord, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, CTXRecord, HTIndex, ISEIndex, ISENull, lG, RootBti, SEIndex, SENull, SERecord, typeTYPE],
SymbolTable: TYPE 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 = {
stream.PutRope["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]]]; stream.PutRope[": "]};
PutName[ip.name];
PutFileStamp[ip.file, ip.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
stream.PutRope["\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]]]; stream.PutRope[": "]};
PutName[ee.name];
PutFileStamp[ee.file, ee.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
stream.PutRope["\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]]]; stream.PutRope[": "]};
PutName[mm.name];
PutFileStamp[mm.file, mm.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutFileStamp:
PROC[fti: FTIndex, mName: NameRecord] = {
SELECT fti
FROM
FTNull => stream.PutRope["(null)"];
FTSelf => stream.PutRope["(self)"];
ENDCASE => {
ftr: LONG POINTER TO FTRecord = @ftb[fti];
IF ftr.name # mName THEN {stream.PutRope[", file: "]; PutName[ftr.name]};
stream.PutRope[", version: "];
ListerUtils.PrintVersion[ftr.version, stream]};
stream.PutChar['\n]};
PrintHeader:
PROC = {
stream.PutF1["Configurations: %g", [cardinal[bcd.nConfigs]]];
stream.PutF1[", Modules: %g", [cardinal[bcd.nModules]]];
stream.PutF1[", Imports: %g", [cardinal[bcd.nImports]]];
stream.PutF1[", Exports: %g", [cardinal[bcd.nExports]]];
stream.PutF1[", Dummy: %g", [cardinal[bcd.firstdummy]]];
stream.PutF1[", #Dummies: %g\n", [cardinal[bcd.nDummies]]];
IF ~bcd.definitions THEN stream.PutChar['~];
stream.PutRope["definitions, "];
IF ~bcd.repackaged THEN stream.PutChar['~];
stream.PutRope["repackaged, "];
IF ~bcd.typeExported THEN stream.PutChar['~];
stream.PutRope["type exported, "];
IF ~bcd.tableCompiled THEN stream.PutChar['~];
stream.PutRope["table compiled, "];
IF ~bcd.versions THEN stream.PutChar['~];
stream.PutRope["versions, "];
IF ~bcd.extended THEN stream.PutChar['~];
stream.PutRope["extended\n\n"]};
PrintConfigs:
PROC = {
cti: CTIndex ← CTIndex.FIRST;
stream.PutF["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;
stream.PutChar['\n]};
PrintConfig:
PROC[cti: CTIndex] = {
ctp: LONG POINTER TO CTRecord = @ctb[cti];
Tab[2];
PutName[ctp.name];
PrintIndex[LOOPHOLE[cti]];
IF ctp.namedInstance
THEN {
stream.PutRope[", instance name: "];
PutInstanceName[[config[cti]]]};
stream.PutRope[", file: "];
PrintFileName[ctp.file];
PrintIndex[LOOPHOLE[ctp.file]];
IF cti # CTNull
THEN {
stream.PutRope[", parent: "];
PutName[ctb[cti].name];
PrintIndex[LOOPHOLE[cti]]};
stream.PutF1[", #controls: %g", [cardinal[ctp.nControls]]];
IF ctp.nControls # 0
THEN {
stream.PutRope[", controls:"];
FOR i:
CARDINAL
IN [0..ctp.nControls)
DO
IF i MOD 6 = 0 THEN Tab[6] ELSE stream.PutRope[", "];
WITH c~~ctp.controls[i]
SELECT
FROM
module => PutName[mtb[c.mti].name];
config => {PutName[ctb[c.cti].name]; stream.PutChar['*]};
ENDCASE => ERROR;
PrintIndex[LOOPHOLE[ctp.controls[i]]];
ENDLOOP};
stream.PutChar['\n]};
PrintImports:
PROC = {
iti: IMPIndex ← IMPIndex.FIRST;
stream.PutF["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;
stream.PutRope["\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 stream.PutRope[" (module)"];
IF imp.namedInstance
THEN {
stream.PutRope[", instance name: "];
PutInstanceName[[import[iti]]]};
stream.PutRope[", file: "];
PrintFileName[imp.file];
PrintIndex[LOOPHOLE[imp.file]];
stream.PutF[", gfi: %g, ngfi: %g", [cardinal[imp.gfi]], [cardinal[imp.ngfi]]]};
PrintGlobals:
PROC[] = {
amperTable: AmperTable ← NIL;
words: INT ← 0;
frames: INT ← 0;
totalProcs: INT ← 0;
procs: INT ← 0;
waste: INT ← 0;
totalWaste: INT ← 0;
gfiSlots: INT ← 0;
AmperTable: TYPE = LIST OF AmperTableEntry;
AmperTableEntry: TYPE = RECORD [name: ROPE, count: INT, size: INT];
FOR mti: MTIndex ← MTIndex.
FIRST, mti + MTSize[mti]
UNTIL mti = bcd.mtLimit
DO
mtr: LONG POINTER TO MTRecord = @mtb[mti];
frameSize: CARDINAL ← mtr.framesize;
gfis: CARDINAL ← mtr.ngfi;
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];
stream.PutRope[" "];
IF hti # ListerUtils.nullName
THEN {
check for leading &
ss: ListerUtils.SubString = symbols.SubStringForName[hti];
IF ss.length # 0
AND ss.base[ss.offset] = '&
THEN {
ros: STREAM ← IO.ROS[];
rope: ROPE ← NIL;
ListerUtils.PrintName[hti, ros, symbols];
rope ← ros.RopeFromROS[];
FOR each: AmperTable ← amperTable, each.rest
WHILE each #
NIL
DO
IF (each.first.name).Equal[rope]
THEN {
each.first.size ← each.first.size + size;
each.first.count ← each.first.count + 1;
GO TO found};
ENDLOOP;
amperTable ← CONS [[name: rope, count: 1, size: size], amperTable];
EXITS found => {};
};
};
ListerUtils.PrintName[hti, stream, symbols];
stream.PutF1["\t%g\n", [cardinal[size]]];
RETURN[addr.wd + size]};
CountProcs:
PROC
RETURNS[n:
CARDINAL ← 0] =
TRUSTED {
Counts all of the procedures
prev: Symbols.BTIndex ← FIRST[Symbols.BTIndex];
bti: Symbols.BTIndex ← prev;
DO
WITH body~~symbols.bb[bti]
SELECT
FROM
Callable => IF NOT body.inline THEN n ← n + 1;
ENDCASE;
IF symbols.bb[bti].firstSon # Symbols.BTNull THEN bti ← symbols.bb[bti].firstSon
ELSE
DO
prev ← bti;
bti ← symbols.bb[bti].link.index;
IF bti = Symbols.BTNull THEN RETURN;
IF symbols.bb[prev].link.which # parent THEN EXIT;
ENDLOOP;
ENDLOOP;
};
bti: CBTIndex ← LOOPHOLE[RootBti];
frameOverhead: CARDINAL = PrincOps.globalbase+1; -- for start trap pointer
maxSpan: CARDINAL ← frameOverhead-1;
typeIn, typeOut: CSEIndex;
IF symbols =
NIL
THEN {
No symbols, so say so
stream.PutRope["Sorry, no symbols available (file must be local).\n"];
RETURN};
[typeIn, typeOut] ← symbols.TransferTypes[symbols.bb[bti].ioType];
IF typeIn # CSENull
THEN {
stream.PutRope[" Global arguments:\n"];
maxSpan ← MAX[DoFields[typeIn], maxSpan]};
IF typeOut # CSENull
THEN {
stream.PutRope[" Global results:\n"];
maxSpan ← MAX[DoFields[typeOut], maxSpan]};
IF symbols.bb[bti].localCtx # CTXNull
THEN {
stream.PutRope[" Global variables: (name & words)\n"];
maxSpan ← MAX[DoContext[symbols.bb[bti].localCtx], maxSpan]};
IF ~symbols.bb[bti].hints.noStrings
THEN
stream.PutRope[" Global string literals or string bodies\n"];
IF maxSpan # frameSize
AND frameSize > frameOverhead
THEN
stream.PutF1[
" %g words not in listed variables or overhead\n",
[integer[frameSize - maxSpan]]];
stream.PutRope["\n"];
procs ← CountProcs[]};
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
IF mtr.namedInstance THEN {PutInstanceName[[module[mti]]]; stream.PutRope[": "]};
PutName[mtr.name];
PutFileStamp[mtr.file, mtr.name];
frames ← frames + 1;
procs ← 0;
WithSymbolsForModule[mti, DoBody];
IF procs # 0
THEN {
waste ← gfis*32-procs;
stream.PutF["Global frame size: %g, gfi slots: %g, procs: %g (waste: %g)\n\n",
[cardinal[frameSize]],
[cardinal[gfis]],
[cardinal[procs]],
[integer[waste]]
]}
ELSE {
stream.PutF["Global frame size: %g, gfi slots: %g, procs: ?? (waste: ??)\n\n",
[cardinal[frameSize]],
[cardinal[gfis]]
];
gfiSlots ← gfiSlots + gfis;
words ← words + frameSize;
totalWaste ← totalWaste + waste;
totalProcs ← totalProcs + procs;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IF frames > 1
THEN {
stream.PutF["%g words in %g frames using %g gfi slots, %g procs (%g waste)\n",
[cardinal[words]],
[cardinal[frames]],
[cardinal[gfiSlots]],
[cardinal[totalProcs]],
[cardinal[totalWaste]]
];
stream.PutRope["\n&-variables\n"];
FOR each: AmperTable ← amperTable, each.rest
WHILE each #
NIL
DO
stream.PutF["\t%g\t%g\t%g\n",
[rope[each.first.name]], [integer[each.first.count]], [integer[each.first.size]]];
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 ← NameToRope[ftr.name].Concat[".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];
file.Close[]};
inner[symbols ← SymbolTable.Acquire[[file, [start, pages]]]];
SymbolTable.Release[symbols];
IF bcd # nBcd THEN file.Close[];
};
};
EXITS
loser => inner[NIL];
};
PrintExports:
PROC[printOffset:
BOOL] = {
eti: EXPIndex ← EXPIndex.FIRST;
IF printOffset THEN stream.PutF1["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 stream.PutChar['\n];
stream.PutChar['\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 stream.PutRope[" (module)"];
IF etr.namedInstance
THEN {
stream.PutRope[", instance name: "];
PutInstanceName[[export[eti]]]};
stream.PutRope[", file: "];
PrintFileName[etr.file];
PrintIndex[LOOPHOLE[etr.file]];
stream.PutRope[", "];
IF ~etr.typeExported THEN stream.PutChar['~];
stream.PutF1["typeExported, #links: %g", [cardinal[etr.size]]];
IF dumpLinks = all
THEN {
bcdName: ROPE = NameToRope[ftb[etr.file].name].Concat[".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;
stream.PutRope["\n\t\t"];
IF isUnbound THEN stream.PutRope["** unbound ** "];
stream.PutRope[name];
IF cmd = $Unbound THEN LOOP;
stream.PutRope[": "];
SELECT
TRUE
FROM
(link = NullLink) =>
stream.PutRope["(null link)"];
link.proc =>
stream.PutF["proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
link.type =>
IF link.typeID = TYPNull THEN stream.PutRope["type[null]"]
ELSE stream.PutF1["type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
ENDCASE =>
stream.PutF["var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
ENDLOOP;
};
stream.PutRope[", links:"];
exbcd ← ListerUtils.ReadBcd[bcdName ! FS.Error => CONTINUE];
SELECT
TRUE
FROM
exbcd =
NIL => {
stream.PutRope[bcdName];
stream.PutRope[" not found.\n"];
inner[NIL]};
exbcd.version # bcdVersion => {
stream.PutRope[bcdName];
stream.PutRope[", version "];
ListerUtils.PrintVersion[exbcd.version, stream];
stream.PutRope["found, version "];
ListerUtils.PrintVersion[bcdVersion, stream];
stream.PutRope["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]; file.Close[]}];
SymbolTable.Release[exstb];
file.Close[]};
stream.PutChar['\n];
};
};
PrintExpVars:
PROC = {
evi: EVIndex ← EVIndex.FIRST;
evLimit: EVIndex = bcd.evLimit;
stream.PutRope["Exported variables:\n"];
UNTIL evi = evLimit
DO
PrintExpVar[evi];
evi ← evi + evb[evi].length + EVRecord.SIZE;
ENDLOOP;
stream.PutChar['\n]};
PrintExpVar:
PROC[evi: EVIndex] = {
evr: LONG POINTER TO EVRecord = @evb[evi];
Tab[2];
stream.PutF["%g, #offsets: %g, offsets:",
[cardinal[LOOPHOLE[evi, CARDINAL]]], [cardinal[evr.length]]];
FOR i:
CARDINAL
IN [1..evr.length]
DO
IF i MOD 8 = 1 THEN Tab[4] ELSE stream.PutChar[' ];
stream.PutF1["%b", [cardinal[evr.offsets[i]]]];
IF i # evr.length THEN stream.PutChar[',];
ENDLOOP;
stream.PutChar['\n]};
PrintSpaces:
PROC = {
spi: SPIndex ← SPIndex.FIRST;
spLimit: SPIndex = bcd.spLimit;
stream.PutRope["Spaces:\n"];
UNTIL spi = spLimit
DO
PrintSpace[spi];
spi ← spi + SPRecord.SIZE + spb[spi].length*SpaceID.SIZE;
ENDLOOP;
stream.PutChar['\n]};
PrintSpace:
PROC[spi: SPIndex] = {
spr: LONG POINTER TO SPRecord = @spb[spi];
Tab[2];
PrintIndex[LOOPHOLE[spi, CARDINAL]];
stream.PutF1[", segment: [%g]", [cardinal[LOOPHOLE[spr.seg, CARDINAL]]]];
stream.PutF1[", #code packs: %g", [cardinal[spr.length]]];
IF spr.length # 0 THEN stream.PutRope[", code packs: "];
FOR i:
CARDINAL
IN [0..spr.length)
DO
Tab[4];
stream.PutRope[" code pack "];
PutName[spr.spaces[i].name];
stream.PutRope[", "];
IF ~spr.spaces[i].resident THEN stream.PutChar['~];
stream.PutF["resident, offset: %b, pages: %g\n",
[cardinal[spr.spaces[i].offset]], [cardinal[spr.spaces[i].pages]]];
ENDLOOP;
PrintModules:
PROC = {
mti: MTIndex ← MTIndex.FIRST;
stream.PutF1["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;
stream.PutChar['\n]};
PrintModule:
PROC[mth:
LONG
POINTER
TO MTRecord, mti: MTIndex] = {
Tab[2];
PutName[mth.name];
PrintIndex[LOOPHOLE[mti]];
IF mth.namedInstance
THEN {
stream.PutRope["instance name: "];
PutInstanceName[[module[mti]]]};
stream.PutRope[", file: "];
PrintFileName[mth.file];
PrintIndex[LOOPHOLE[mth.file]];
IF mth.config # CTNull
THEN {
stream.PutRope[", config: "];
PutName[ctb[mth.config].name];
PrintIndex[LOOPHOLE[mth.config]]};
Tab[4];
IF mth.tableCompiled THEN stream.PutRope["table compiled, "] ELSE {
PutSwitch:
PROC[sw:
CHAR, value:
BOOL] = {
IF ~value THEN stream.PutChar['-]; stream.PutChar[sw]};
stream.PutRope["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];
stream.PutRope[", "]};
IF ~mth.packageable THEN stream.PutChar['~]; stream.PutRope["packageable, "];
IF mth.residentFrame THEN stream.PutRope["resident frame, "];
Tab[4];
stream.PutF["framesize: %g, gfi: %g, ngfi: %g, links: ",
[cardinal[mth.framesize]], [cardinal[mth.gfi]], [cardinal[mth.ngfi]]];
IF mth.linkLoc = $frame THEN stream.PutRope["frame"] ELSE stream.PutRope["code"];
Tab[4];
stream.PutRope["code: "]; PrintSegment[mth.code.sgi];
stream.PutF[", offset: %b, length: %b",
[cardinal[mth.code.offset]], [cardinal[mth.code.length]]];
IF mth.code.linkspace THEN stream.PutRope[", link space"];
IF mth.code.packed THEN stream.PutRope[", packed"];
Tab[4];
stream.PutRope["symbols: "];
PrintSegment[mth.sseg];
IF mth.variables # EVNull
THEN {
Tab[4];
stream.PutF1[
"exported variables: [%g]", [cardinal[LOOPHOLE[mth.variables, CARDINAL]]]];
};
WITH mm~~mth^
SELECT
FROM
direct => {
Tab[4];
stream.PutF1["#links: %g", [cardinal[mm.length]]];
IF dumpLinks = all
THEN {
stream.PutRope[", links:"];
FOR i:
CARDINAL
IN [0..mm.length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
PrintControlLink[mm.frag[i]];
IF i + 1 # mm.length THEN stream.PutChar[',];
ENDLOOP}};
indirect => {Tab[4]; PrintLinks[mm.links]};
multiple => {
Tab[4];
PrintLinks[mm.links];
Tab[4];
PrintTypes[mm.types];
IF mm.frameRefs
THEN {
Tab[5];
stream.PutF1["frame type: %g", [cardinal[mm.frameType]]]};
Tab[4];
PrintRefLits[mm.refLiterals]};
ENDCASE;
stream.PutChar['\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] = {
stream.PutRope["#links: "];
IF lfi = LFNull THEN stream.PutRope["none"]
ELSE {
stream.Put[[cardinal[lfb[lfi].length]]];
IF dumpLinks = all
THEN {
stream.PutRope[", links:"];
FOR i:
CARDINAL
IN [0..lfb[lfi].length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
PrintControlLink[lfb[lfi].frag[i]];
IF i + 1 # lfb[lfi].length THEN stream.PutChar[',];
ENDLOOP;
};
};
PrintTypes:
PROC[tfi: TFIndex] = {
stream.PutRope["#types: "];
IF tfi = TFNull THEN stream.PutRope["none"]
ELSE {
stream.PutF["%g, offset: %g", [cardinal[tfb[tfi].length]], [cardinal[tfb[tfi].offset]]];
IF dumpLinks # none
THEN {
stream.PutRope[", indices:"];
FOR i:
CARDINAL
IN [0..tfb[tfi].length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
stream.PutF1["[%g]", [cardinal[tfb[tfi].frag[i]]]];
IF i + 1 # tfb[tfi].length THEN stream.PutChar[',];
ENDLOOP;
};
};
PrintRefLits:
PROC[rfi: RFIndex] = {
stream.PutRope["#ref lits: "];
IF rfi = RFNull THEN stream.PutRope["none"]
ELSE {
stream.PutF["%g, offset: %g", [cardinal[rfb[rfi].length]], [cardinal[rfb[rfi].offset]]];
IF dumpLinks # none
THEN {
stream.PutRope[", indices:"];
FOR i:
CARDINAL
IN [0..rfb[rfi].length)
DO
IF i MOD 7 = 0 THEN Tab[6] ELSE stream.PutChar[' ];
stream.PutF1["[%g]", [cardinal[rfb[rfi].frag[i]]]];
IF i + 1 # rfb[rfi].length THEN stream.PutChar[',];
ENDLOOP;
};
};
PrintFramePacks:
PROC = {
fpi: FPIndex ← FPIndex.FIRST;
fpLimit: FPIndex = bcd.fpLimit;
stream.PutRope["Frame Packs:\n"];
UNTIL fpi = fpLimit
DO
PrintFramePack[fpi];
fpi ← fpi + FPRecord.SIZE + fpb[fpi].length*MTIndex.SIZE;
ENDLOOP;
stream.PutChar['\n]};
PrintFramePack:
PROC[fpi: FPIndex] = {
fpr: LONG POINTER TO FPRecord = @fpb[fpi];
Tab[2];
PutName[fpr.name];
stream.PutF["[%g], #modules: %g, modules:\n",
[cardinal[LOOPHOLE[fpi, CARDINAL]]], [cardinal[fpr.length]]];
FOR i:
CARDINAL
IN [0..fpr.length)
DO
IF i MOD 4 = 0 THEN Tab[4] ELSE stream.PutChar[' ];
PutName[mtb[fpr.modules[i]].name];
PrintIndex[LOOPHOLE[fpr.modules[i]]];
IF i # fpr.length - 1 THEN stream.PutChar[',];
ENDLOOP;
stream.PutChar['\n]};
PrintSegment:
PROC[sgi: SGIndex] = {
IF sgi = SGNull THEN stream.PutRope["(null)"]
ELSE {
PrintFileName[sgb[sgi].file];
stream.PutF[" [base: %g, pages: %g",
[cardinal[sgb[sgi].base]], [cardinal[sgb[sgi].pages]]];
IF sgb[sgi].extraPages # 0
THEN
stream.PutF["+%g", [cardinal[sgb[sgi].extraPages]]];
stream.PutChar[']]};
PrintFiles:
PROC = {
fti: FTIndex ← FTIndex.FIRST;
stream.PutF1["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 {
PrintGarbage[];
EXIT};
ENDLOOP;
stream.PutRope["\n\n"]};
PrintFile:
PROC[fti: FTIndex] = {
Tab[2];
SELECT fti
FROM
FTNull => stream.PutRope["(null)"];
FTSelf => stream.PutRope["(self)"];
ENDCASE => {
ftr: LONG POINTER TO FTRecord = @ftb[fti];
PutName[ftr.name];
PrintIndex[LOOPHOLE[fti]];
stream.PutRope[", version: "];
ListerUtils.PrintVersion[ftr.version, stream]};
Utility Prints
PrintControlLink:
PROC[link: Link] = {
SELECT
TRUE
FROM
(link = NullLink) =>
stream.PutRope["(null link)"];
link.proc =>
stream.PutF["proc[%g,%g]", [cardinal[link.gfi]], [cardinal[link.ep]]];
link.type =>
IF link.typeID = TYPNull THEN stream.PutRope["type[null]"]
ELSE stream.PutF1["type[%g]", [cardinal[LOOPHOLE[link.typeID, CARDINAL]]]]
ENDCASE =>
stream.PutF["var[%g,%g]", [cardinal[link.vgfi]], [cardinal[link.var]]];
};
PrintFileName:
PROC[fti: FTIndex] = {
SELECT fti
FROM
FTNull => stream.PutRope["(null)"];
FTSelf => stream.PutRope["(self)"];
ENDCASE => PutName[ftb[fti].name];
PrintIndex:
PROC[index:
CARDINAL] = {
stream.PutF1[" [%g]", [cardinal[index]]]};
PrintGarbage:
PROC = {
Tab[2];
stream.PutRope["? Looks like garbage ...\n"];
};
Tab:
PROC[n:
CARDINAL] = {
stream.PutChar['\n];
THROUGH [1..n/8] DO stream.PutChar['\t] ENDLOOP;
THROUGH [1..n MOD 8] DO stream.PutChar[' ] 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
stream.PutChar[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
ros.PutChar[ss[i]];
ENDLOOP;
RETURN[ros.RopeFromROS[]]};
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 stream.PutRope[" (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;
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];
};