DIRECTORY
File USING [wordsPerPage],
IO USING [Put1, PutChar, PutF, PutF1, PutFL, PutFR1, PutRope, RopeFromROS, ROS, STREAM],
MobDefs USING [Base, CTIndex, CTNull, CTRecord, EVIndex, EVNull, EVRecord, EXPIndex, EXPLink, EXPRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord, LFIndex, LFNull, Link, LinkFrag, Mob, MobBase, MTIndex, MTRecord, Namee, NameRecord, NameString, NTIndex, NTNull, NTRecord, nullLink, RefLitFrag, RFIndex, RFNull, SGHandle, SGIndex, SGNull, SGRecord, SpaceID, SPIndex, SPRecord, TFIndex, TFNull, TypeFrag, TYPIndex, TYPNull, TYPRecord, VersionStamp],
MobLister USING [],
MobListerUtils USING [FreeMob, MobErr, nullName, PrintName, PrintSei, PrintVersion, ReadMob, SubString],
OSMiscOps USING [bytesPerUnit],
Rope USING [Concat, Equal, Match, ROPE],
SymbolOps USING [DecodeBitAddr, DecodeCard, FirstCtxSe, LinkMode, NameForSe, NextSe, STB, SubString, SubStringForName, TransferTypes],
Symbols USING [BitAddress, BodyRecord, BTIndex, BTNull, CBTIndex, ContextLevel, CSEIndex, CSENull, CTXIndex, CTXNull, CTXRecord, HTIndex, ISEIndex, ISENull, lG, MDFirst, RootBti, SEIndex, SENull, SERecord, typeTYPE],
SymbolSegment USING [Base, biases, bodyType, ctxType, ExtFirst, extType, FGHeader, htType, ltType, mdType, seType, ssType, STHeader, stType, treeType, VersionID],
SymbolTable USING [SymbolTableBaseRep],
SymbolTablePrivate USING [SymbolTableBase, SymbolTableBaseRep],
Table USING [Base];
MobListerImpl:
PROGRAM
IMPORTS IO, MobListerUtils, Rope, SymbolOps
EXPORTS MobLister, SymbolTable = {
bytesPerUnit: NAT = BYTES[WORD];
unitsPerFilePage: NAT = File.wordsPerPage;
bytesPerFilePage: NAT = unitsPerFilePage*bytesPerUnit;
bitsPerByte: CARD = 8;
bitsPerUnit: CARD = OSMiscOps.bytesPerUnit*bitsPerByte;
UnitsToFilePages:
PROC[units:
INT]
RETURNS[
INT] = {
RETURN[(units+unitsPerFilePage-1)/unitsPerFilePage]};
BytesToFilePages:
PROC[bytes:
INT]
RETURNS[
INT] = {
RETURN[(bytes+bytesPerFilePage-1)/bytesPerFilePage]};
Base: TYPE = MobDefs.Base;
Mob: TYPE = MobDefs.Mob;
BitAddress: TYPE = Symbols.BitAddress;
BodyRecord: TYPE = Symbols.BodyRecord;
BTIndex:
TYPE = Symbols.BTIndex;
RootBti: BTIndex = Symbols.RootBti;
CBTIndex: TYPE = Symbols.CBTIndex;
ContextLevel:
TYPE = Symbols.ContextLevel;
lG: ContextLevel = Symbols.lG;
CSEIndex:
TYPE = Symbols.CSEIndex;
CSENull: CSEIndex = Symbols.CSENull;
typeTYPE: CSEIndex = Symbols.typeTYPE;
CTIndex:
TYPE = MobDefs.CTIndex;
CTNull: CTIndex = MobDefs.CTNull;
CTRecord: TYPE = MobDefs.CTRecord;
CTXIndex:
TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
CTXRecord: TYPE = Symbols.CTXRecord;
EVIndex:
TYPE = MobDefs.EVIndex;
EVNull: EVIndex = MobDefs.EVNull;
EVRecord: TYPE = MobDefs.EVRecord;
EXPIndex: TYPE = MobDefs.EXPIndex;
EXPLink: TYPE = MobDefs.EXPLink;
EXPRecord: TYPE = MobDefs.EXPRecord;
FPIndex: TYPE = MobDefs.FPIndex;
FPRecord: TYPE = MobDefs.FPRecord;
FTIndex:
TYPE = MobDefs.FTIndex;
FTNull: FTIndex = MobDefs.FTNull;
FTSelf: FTIndex = MobDefs.FTSelf;
FTRecord: TYPE = MobDefs.FTRecord;
HTIndex: TYPE = Symbols.HTIndex;
ISEIndex:
TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
ISERecord: TYPE = SERecord.id;
LFIndex:
TYPE = MobDefs.LFIndex;
LFNull: LFIndex = MobDefs.LFNull;
LFRecord: TYPE = MobDefs.LinkFrag;
Link:
TYPE = MobDefs.Link;
nullLink: Link = MobDefs.nullLink;
Namee: TYPE = MobDefs.Namee;
NameRecord: TYPE = MobDefs.NameRecord;
NameString: TYPE = MobDefs.NameString;
NTIndex:
TYPE = MobDefs.NTIndex;
NTNull: NTIndex = MobDefs.NTNull;
NTRecord: TYPE = MobDefs.NTRecord;
IMPIndex: TYPE = MobDefs.IMPIndex;
IMPRecord: TYPE = MobDefs.IMPRecord;
MTIndex: TYPE = MobDefs.MTIndex;
MTRecord: TYPE = MobDefs.MTRecord;
RefMob: TYPE = REF Mob;
RefMTRecord: TYPE = REF MTRecord;
RefSGRecord: TYPE = REF SGRecord;
RFIndex:
TYPE = MobDefs.RFIndex;
RFNull: RFIndex = MobDefs.RFNull;
RFRecord: TYPE = MobDefs.RefLitFrag;
ROPE: TYPE = Rope.ROPE;
SEIndex:
TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
SGIndex:
TYPE = MobDefs.SGIndex;
SGNull: SGIndex = MobDefs.SGNull;
SGRecord: TYPE = MobDefs.SGRecord;
SpaceID: TYPE = MobDefs.SpaceID;
SPIndex: TYPE = MobDefs.SPIndex;
SPRecord: TYPE = MobDefs.SPRecord;
STREAM: TYPE = IO.STREAM;
SymbolTableBase: TYPE = REF SymbolTableBaseRep;
SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
TFIndex:
TYPE = MobDefs.TFIndex;
TFNull: TFIndex = MobDefs.TFNull;
TFRecord: TYPE = MobDefs.TypeFrag;
TYPIndex:
TYPE = MobDefs.TYPIndex;
TYPNull: TYPIndex = MobDefs.TYPNull;
TYPRecord: TYPE = MobDefs.TYPRecord;
VersionStamp: TYPE = MobDefs.VersionStamp;
ListMob:
PUBLIC
PROC[stream:
IO.
STREAM, mob: MobDefs.MobBase, cmd:
ATOM] = {
PrintStamps:
PROC = {
stream.PutRope["Imports:\n\n"];
FOR iti: IMPIndex ¬ IMPIndex.
FIRST, iti + IMPRecord.
SIZE
UNTIL iti = mob.impLimit
DO
ip: LONG POINTER TO IMPRecord = @itb[iti];
IF
LOOPHOLE[iti,
CARD] >
LOOPHOLE[mob.impLimit,
CARD]
THEN
GO TO Bogus;
IF ip.namedInstance THEN {PutInstanceName[[0,0,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].nLinks*EXPLink.
SIZE + EXPRecord.
SIZE
UNTIL eti = mob.expLimit DO
ee: LONG POINTER TO EXPRecord = @etb[eti];
IF LOOPHOLE[eti, CARD] > LOOPHOLE[mob.expLimit, CARD] THEN GO TO Bogus;
IF ee.namedInstance THEN {PutInstanceName[[0,0,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 = mob.mtLimit
DO
mm: LONG POINTER TO MTRecord = @mtb[mti];
IF LOOPHOLE[mti, CARD] > LOOPHOLE[mob.mtLimit, CARD] THEN GO TO Bogus;
IF mm.namedInstance THEN {PutInstanceName[[0,0,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: "];
MobListerUtils.PrintVersion[ftr.version, stream]};
stream.PutChar['\n]};
PrintHeader:
PROC = {
stream.PutF1["Configurations: %g", [cardinal[mob.nConfigs]]];
stream.PutF1[", Modules: %g", [cardinal[mob.nModules]]];
stream.PutF1[", Imports: %g", [cardinal[mob.nImports]]];
stream.PutF1[", Exports: %g", [cardinal[mob.nExports]]];
stream.PutF1[", Dummy: %g", [cardinal[mob.firstdummy]]];
stream.PutF1[", #Dummies: %g\n", [cardinal[mob.nDummies]]];
IF ~mob.definitions THEN stream.PutChar['~];
stream.PutRope["definitions, "];
IF ~mob.repackaged THEN stream.PutChar['~];
stream.PutRope["repackaged, "];
IF ~mob.typeExported THEN stream.PutChar['~];
stream.PutRope["type exported, "];
IF ~mob.inlineFloat THEN stream.PutChar['~];
stream.PutRope["inline fload, "];
IF ~mob.mappingStarted THEN stream.PutChar['~];
stream.PutRope["mapping started, "];
IF ~mob.mappingFinished THEN stream.PutChar['~];
stream.PutRope["mapping finished, "];
IF ~mob.versions THEN stream.PutChar['~];
stream.PutRope["versions, "];
IF ~mob.extended THEN stream.PutChar['~];
stream.PutRope["extended\n\n"]};
PrintConfigs:
PROC = {
cti: CTIndex ¬ CTIndex.FIRST;
stream.PutF1["Configurations[%g]:\n", [cardinal[mob.ctOffset.units]]];
UNTIL cti = mob.ctLimit
DO
PrintConfig[cti];
cti ¬ cti + CTRecord.SIZE + ctb[cti].nControls*Namee.SIZE;
IF LOOPHOLE[cti, CARD] > LOOPHOLE[mob.ctLimit, CARD] 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];
PrintLongIndex[LOOPHOLE[cti]];
IF ctp.namedInstance
THEN {
stream.PutRope[", instance name: "];
PutInstanceName[[0,0,config[cti]]]};
stream.PutRope[", file: "];
PrintFileName[ctp.file];
PrintLongIndex[LOOPHOLE[ctp.file]];
IF cti # CTNull
THEN {
stream.PutRope[", parent: "];
PutName[ctb[cti].name];
PrintLongIndex[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];
PrintLongIndex[LOOPHOLE[c.mti]]};
config => {
PutName[ctb[c.cti].name];
stream.PutChar['*];
PrintLongIndex[LOOPHOLE[c.cti]]};
ENDCASE => ERROR;
ENDLOOP};
stream.PutChar['\n]};
PrintImports:
PROC = {
iti: IMPIndex ¬ IMPIndex.FIRST;
stream.PutF1["Imports[%g]:\n", [cardinal[mob.impOffset.units]]];
UNTIL iti = mob.impLimit
DO
PrintImport[iti];
iti ¬ iti + IMPRecord.SIZE;
IF LOOPHOLE[iti, CARD] > LOOPHOLE[mob.impLimit, CARD] 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];
PrintLongIndex[LOOPHOLE[iti]];
IF imp.port = $module THEN stream.PutRope[" (module)"];
IF imp.namedInstance
THEN {
stream.PutRope[", instance name: "];
PutInstanceName[[0,0,import[iti]]]};
stream.PutRope[", file: "];
PrintFileName[imp.file];
PrintLongIndex[LOOPHOLE[imp.file]];
stream.PutF[", gfi: %g, ngfi: %g", [cardinal[imp.modIndex]], [cardinal[1]]]};
PrintGlobals:
PROC[] = {
amperTable: AmperTable ¬ NIL;
units: 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 = mob.mtLimit
DO
mtr: LONG POINTER TO MTRecord = @mtb[mti];
frameSize: CARD ¬ mtr.framesize;
gfis: CARDINAL ¬ 1;
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 ¬ SymbolOps.FirstCtxSe[symbols, ctx], SymbolOps.NextSe[symbols, 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 = SymbolOps.DecodeBitAddr[symbols.seb[sei].idValue];
size: CARD = (SymbolOps.DecodeCard[symbols.seb[sei].idInfo]+bitsPerUnit-1) / bitsPerUnit;
hti: HTIndex = SymbolOps.NameForSe[symbols, sei];
stream.PutRope[" "];
IF hti # MobListerUtils.nullName
THEN {
check for leading &
ss: MobListerUtils.SubString = SymbolOps.SubStringForName[symbols, hti];
IF ss.length # 0
AND ss.base[ss.offset] = '&
THEN {
ros: STREAM ¬ IO.ROS[];
rope: ROPE ¬ NIL;
MobListerUtils.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 => {};
};
};
MobListerUtils.PrintName[hti, stream, symbols];
stream.PutF1["\t%g\n", [cardinal[size]]];
RETURN[addr.bd/bitsPerUnit + 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 = 4--words of frame overhead-- * UNITS[WORD];
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] ¬ SymbolOps.TransferTypes[symbols, 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 & units)\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 units not in listed variables or overhead\n",
[integer[frameSize - maxSpan]]];
stream.PutRope["\n"];
procs ¬ CountProcs[]};
IF LOOPHOLE[mti, CARD] > LOOPHOLE[mob.mtLimit, CARD] THEN GO TO Bogus;
IF mtr.namedInstance THEN {PutInstanceName[[0,0,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 ¬ 0;
stream.PutFL["Global frame size: %g, gfi slots: %g, procs: %g (waste: %g)\n\n",
LIST[
[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;
units ¬ units + frameSize;
totalWaste ¬ totalWaste + waste;
totalProcs ¬ totalProcs + procs;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IF frames > 1
THEN {
stream.PutFL["%g units in %g frames using %g gfi slots, %g procs (%g waste)\n",
LIST[
[cardinal[units]],
[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: CARD ¬ UnitsToFilePages[sgr.base.units];
pages: CARD ¬ UnitsToFilePages[sgr.units.units];
nMob: MobDefs.MobBase ¬ mob;
IF start = 0 OR sgr.units.units = 0 OR sgr.file = FTNull THEN GO TO loser;
IF sgr.file # FTSelf
THEN {
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[".mob"];
nMob ¬ MobListerUtils.ReadMob[fileName ! MobListerUtils.MobErr => GO TO loser ];
};
IF nMob.extended THEN pages ¬ pages + UnitsToFilePages[sgr.extraUnits.units];
DoSymbols[nMob, inner];
IF nMob#mob THEN MobListerUtils.FreeMob[nMob];
};
EXITS
loser => inner[NIL];
};
STB: TYPE = REF SymbolTableBaseRep;
DoSymbols:
PUBLIC
PROC [mob: MobDefs.MobBase, proc:
PROC[sym:
STB]] = {
sym: STB ¬ NIL;
sgb: MobDefs.Base = LOOPHOLE[mob+mob.sgOffset.units];
mtb: MobDefs.Base = LOOPHOLE[mob+mob.mtOffset.units];
sgh: MobDefs.SGHandle = IF mtb[FIRST[MobDefs.MTIndex]].sseg = MobDefs.SGNull
THEN ERROR --NoSymbols
ELSE @sgb[mtb[FIRST[MobDefs.MTIndex]].sseg];
stb: LONG POINTER TO SymbolSegment.STHeader = LOOPHOLE[mob+sgh.base.units];
IF mob.nConfigs # 0 THEN ERROR; -- Configuration;
IF sgh.file # MobDefs.FTSelf OR sgh.units.units = 0 THEN ERROR; -- NoSymbols;
IF stb.versionIdent # SymbolSegment.VersionID
THEN
Consistency check failed!
ERROR; -- WrongSymbolsVersion;
sym ¬ InstallTable[stb];
proc[sym];
};
InstallTable:
PROC [node:
LONG
POINTER]
RETURNS [
STB] = {
b: LONG POINTER = node;
tB: SymbolSegment.Base = LOOPHOLE[b];
p: LONG POINTER TO SymbolSegment.STHeader = b;
base: STB ¬ NEW[SymbolTableBaseRep];
base.cacheInfo ¬ LOOPHOLE[node];
base.hashVec ¬ b+p.hvBlock.offset;
base.htb ¬ tB + p.htBlock.offset - SymbolSegment.biases[SymbolSegment.htType];
base.ssb ¬ b + p.ssBlock.offset - SymbolSegment.biases[SymbolSegment.ssType];
base.seb ¬ tB + p.seBlock.offset - SymbolSegment.biases[SymbolSegment.seType];
base.ctxb ¬ tB + p.ctxBlock.offset - SymbolSegment.biases[SymbolSegment.ctxType];
base.mdb ¬ tB + p.mdBlock.offset - SymbolSegment.biases[SymbolSegment.mdType];
base.bb ¬ tB + p.bodyBlock.offset - SymbolSegment.biases[SymbolSegment.bodyType];
base.tb ¬ tB + p.treeBlock.offset - SymbolSegment.biases[SymbolSegment.treeType];
base.ltb ¬ tB + p.litBlock.offset - SymbolSegment.biases[SymbolSegment.ltType];
base.stb ¬ tB + p.sLitBlock.offset - SymbolSegment.biases[SymbolSegment.stType];
base.extb ¬ tB + p.extBlock.offset - SymbolSegment.biases[SymbolSegment.extType];
base.mdLimit ¬ Symbols.MDFirst + p.mdBlock.size;
base.extLimit ¬ SymbolSegment.ExtFirst + p.extBlock.size;
base.mainCtx ¬ p.outerCtx; base.stHandle ¬ p;
IF p.fgRelBase = 0
OR p.fgCount = 0
THEN {
base.sourceFile ¬ NIL;
base.fgTable ¬ NIL;
}
ELSE {
q: LONG POINTER TO SymbolSegment.FGHeader = LOOPHOLE[b + p.fgRelBase];
source: LONG STRING = LOOPHOLE[q + SIZE[SymbolSegment.FGHeader[0]]
- SIZE[StringBody[0]]];
base.sourceFile ¬ source;
base.fgTable ¬ DESCRIPTOR[q + q.offset, q.length];
};
RETURN [base];
};
PrintExports:
PROC[printOffset:
BOOL] = {
eti: EXPIndex ¬ EXPIndex.FIRST;
IF printOffset THEN stream.PutF1["Exports[%g]:\n", [cardinal[mob.expOffset.units]]];
UNTIL eti = mob.expLimit
DO
PrintExport[eti];
eti ¬ eti + etb[eti].nLinks*EXPLink.SIZE + EXPRecord.SIZE;
IF LOOPHOLE[eti, CARD] > LOOPHOLE[mob.expLimit, CARD] 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.nLinks;
Tab[2];
PutName[etr.name];
PrintLongIndex[LOOPHOLE[eti]];
IF etr.port = $module THEN stream.PutRope[" (module)"];
IF etr.namedInstance
THEN {
stream.PutRope[", instance name: "];
PutInstanceName[[0,0,export[eti]]]};
stream.PutRope[", file: "];
PrintFileName[etr.file];
PrintLongIndex[LOOPHOLE[etr.file]];
stream.PutRope[", "];
IF ~etr.typeExported THEN stream.PutChar['~];
stream.PutF1["typeExported, #links: %g", [cardinal[etr.nLinks]]];
IF dumpLinks = all
THEN {
mobName: ROPE = NameToRope[ftb[etr.file].name].Concat[".mob"];
mobVersion: VersionStamp = ftb[etr.file].version;
exmob: MobDefs.MobBase ¬ NIL;
inner:
PROC[exstb: SymbolTableBase] = {
FOR i:
CARDINAL
IN [0..size)
DO
link: Link = etr.links[i].from;
name: ROPE = NameFromIndex[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.PutF1["\n\t\t%g: ", [cardinal[i]]];
IF isUnbound THEN stream.PutRope["** unbound ** "];
stream.PutRope[name];
IF cmd = $Unbound THEN LOOP;
stream.PutRope[": "];
SELECT link.tag
FROM
proc =>
stream.PutF["proc[%g,%g]", [cardinal[link.modIndex]], [cardinal[link.offset]]];
type =>
stream.PutF1["type[%g]", [cardinal[link.offset]]];
ENDCASE =>
stream.PutF["var[%g,%g]", [cardinal[link.modIndex]], [cardinal[link.offset]]];
ENDLOOP;
}; -- End of inner
stream.PutRope[", links:"];
exmob ¬ MobListerUtils.ReadMob[mobName ! MobListerUtils.MobErr => CONTINUE];
SELECT
TRUE
FROM
exmob =
NIL => {
stream.PutRope[mobName];
stream.PutRope[" not found.\n"];
inner[NIL]};
exmob.version # mobVersion => {
stream.PutRope[mobName];
stream.PutRope[", version "];
MobListerUtils.PrintVersion[exmob.version, stream];
stream.PutRope[" found, version "];
MobListerUtils.PrintVersion[mobVersion, stream];
stream.PutRope[" needed.\n"];
exmob ← NIL;
inner[NIL];
};
ENDCASE => {
DoSymbols[exmob, inner];
};
IF exmob#mob THEN MobListerUtils.FreeMob[exmob ! MobListerUtils.MobErr => CONTINUE];
stream.PutChar['\n];
};
};
PrintExpVars:
PROC = {
evi: EVIndex ¬ EVIndex.FIRST;
evLimit: EVIndex = mob.evLimit;
stream.PutRope["Exported variables:\n"];
UNTIL evi = evLimit
DO
PrintExpVar[evi];
evi ¬ evi + evb[evi].length*CARD.SIZE + 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, CARD]]], [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 = mob.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];
PrintLongIndex[LOOPHOLE[spi, CARD]];
stream.PutF1[", segment: [%g]", [cardinal[LOOPHOLE[spr.seg, CARD]]]];
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[mob.mtOffset.units]]];
UNTIL mti = mob.mtLimit
DO
PrintModule[@mtb[mti], mti];
mti ¬ mti + MTSize[mti];
IF LOOPHOLE[mti, CARD] > LOOPHOLE[mob.mtLimit, CARD] 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];
PrintLongIndex[LOOPHOLE[mti]];
IF mth.namedInstance
THEN {
stream.PutRope["instance name: "];
PutInstanceName[[0,0,module[mti]]]};
stream.PutRope[", file: "];
PrintFileName[mth.file];
PrintLongIndex[LOOPHOLE[mth.file]];
IF mth.config # CTNull
THEN {
stream.PutRope[", config: "];
PutName[ctb[mth.config].name];
PrintLongIndex[LOOPHOLE[mth.config]]};
Tab[4];
IF mth.inlineFloat THEN stream.PutRope["inline float, "] 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 = $codePrefix];
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.modIndex]], [cardinal[1]]];
IF mth.linkLoc = $framePrefix 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, CARD]]]];
};
BEGIN
Tab[4];
PrintLinks[mth.links];
Tab[4];
PrintTypes[mth.types];
IF mth.frameRefs
THEN {
Tab[5];
stream.PutF1["frame type: %g", [cardinal[mth.frameType]]]};
Tab[4];
PrintRefLits[mth.refLiterals];
END;
stream.PutChar['\n]};
MTSize:
PROC[mti: MTIndex]
RETURNS[
NAT] = {
RETURN[MTRecord.SIZE]
PrintLinks:
PROC[lfi: LFIndex] = {
stream.PutRope["#links: "];
IF lfi = LFNull THEN stream.PutRope["none"]
ELSE {
stream.Put1[[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 = mob.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, CARD]]], [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];
PrintLongIndex[LOOPHOLE[fpr.modules[i]]];
IF i # CARD[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[UnitsToFilePages[sgb[sgi].base.units]]], [cardinal[UnitsToFilePages[sgb[sgi].units.units]]]];
IF sgb[sgi].extraUnits.units # 0
THEN
stream.PutF1["+%g", [cardinal[UnitsToFilePages[sgb[sgi].extraUnits.units]]]];
stream.PutChar[']]};
PrintFiles:
PROC = {
fti: FTIndex ¬ FTIndex.FIRST;
stream.PutF1["Files[%g]:\n", [cardinal[mob.ftOffset.units]]];
UNTIL fti = mob.ftLimit
DO
PrintFile[fti];
fti ¬ fti + FTRecord.SIZE;
IF
LOOPHOLE[fti,
CARD] >
LOOPHOLE[mob.ftLimit,
CARD]
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];
PrintLongIndex[LOOPHOLE[fti]];
stream.PutRope[", version: "];
MobListerUtils.PrintVersion[ftr.version, stream]};
Utility Prints
PrintControlLink:
PROC[link: Link] = {
SELECT link.tag
FROM
proc =>
stream.PutF["proc[%g,%g]", [cardinal[link.modIndex]], [cardinal[link.offset]]];
type =>
stream.PutF1["type[%g]", [cardinal[link.offset]]];
ENDCASE =>
stream.PutF["var[%g,%g]", [cardinal[link.modIndex]], [cardinal[link.offset]]];
};
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]]]};
PrintLongIndex:
PROC[index:
CARD] = {
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+4;
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+4;
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 = mob.ntLimit
DO
IF proc[ntb, nti] THEN RETURN[nti];
ENDLOOP;
Executable part of ListMob
tb: MobDefs.Base;
inner:
PROC[ptr:
LONG
POINTER] = {
tb ¬ LOOPHOLE[ptr];
ssb ¬ LOOPHOLE[ptr + mob.ssOffset.units];
ctb ¬ tb + mob.ctOffset.units;
mtb ¬ tb + mob.mtOffset.units;
IF mob.extended
THEN {
lfb ¬ tb + mob.lfOffset.units;
tfb ¬ tb + mob.tfOffset.units;
rfb ¬ tb + mob.rfOffset.units};
itb ¬ tb + mob.impOffset.units;
etb ¬ tb + mob.expOffset.units;
sgb ¬ tb + mob.sgOffset.units;
ftb ¬ tb + mob.ftOffset.units;
ntb ¬ tb + mob.ntOffset.units;
evb ¬ tb + mob.evOffset.units;
spb ¬ tb + mob.spOffset.units;
fpb ¬ tb + mob.fpOffset.units;
SELECT cmd
FROM
$Globals =>
PrintGlobals[];
$Exports, $Unbound =>
PrintExports[FALSE];
$Mob, $ShortMob => {
PrintHeader[];
PrintConfigs[];
PrintImports[];
PrintExports[TRUE];
PrintExpVars[];
PrintModules[];
PrintFiles[];
PrintFramePacks[];
PrintSpaces[]};
ENDCASE;
};
Table Bases
ssb: MobDefs.NameString ¬ NIL;
evb: MobDefs.Base ¬ NIL;
spb: MobDefs.Base ¬ NIL;
fpb: MobDefs.Base ¬ NIL;
ctb: MobDefs.Base ¬ NIL;
mtb: MobDefs.Base ¬ NIL;
lfb: MobDefs.Base ¬ NIL;
tfb: MobDefs.Base ¬ NIL;
rfb: MobDefs.Base ¬ NIL;
itb: MobDefs.Base ¬ NIL;
etb: MobDefs.Base ¬ NIL;
sgb: MobDefs.Base ¬ NIL;
ftb: MobDefs.Base ¬ NIL;
ntb: MobDefs.Base ¬ NIL;
dumpLinks: {none, all} ¬ IF cmd # $ShortMob THEN all ELSE none;
tb ¬ NIL;
inner[mob];
}; -- End of ListMob