SAFE PROC [fileName: Rope.
Inner:
PROC [mob: MobDefs.MobBase] = {
Start: PROC [FormIdentifier] = begin;
End: PROC = end;
PutRope: PROC [ROPE] = putROPE;
PutINT: PROC [int: INT] = putINT;
PutLabeledINT: PROC [symbol: ATOM, int: INT] = {Start[symbol]; PutINT[int]; End[]};
PutLabeledBOOL: PROC [symbol: ATOM, bool: BOOL] = {Start[symbol]; putBOOL[bool]; End[]};
PrintStamps:
PROC = {
IF filter[imports]
THEN {Start[$imports];
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 {Start[$instance]; PutInstanceName[[0,0,import[iti]]]; PutName[ip.name]; End[]}
ELSE PutName[ip.name];
PutFileStamp[ip.file, ip.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
End[]};
IF filter[exports]
THEN {
Start[$exports];
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];
OnlyTypes:
PROC
RETURNS [
BOOL] = {
FOR i:
CARD16
IN [0..ee.nLinks)
DO
IF ee[i].from = [tag: var, modIndex: 0, offset: 0] THEN EXIT;
IF ee[i].from.tag # type THEN RETURN [FALSE]
ENDLOOP;
RETURN [TRUE]
};
IF LOOPHOLE[eti, CARD] > LOOPHOLE[mob.expLimit, CARD] THEN GO TO Bogus;
IF NOT filter[typeExports] AND OnlyTypes[] THEN LOOP;
IF filter[exportedItems]
THEN {
Start[$export];
PutFileStamp[ee.file, ee.name];
FOR i:
CARD16
IN [0..ee.nLinks)
DO
IF ee[i].from = [tag: var, modIndex: 0, offset: 0] THEN EXIT;
Start[SELECT ee[i].from.tag FROM var => $var, proc => $proc, type => $type, ENDCASE => $other];
PutINT[ee[i].to];
End[];
ENDLOOP;
End[]}
ELSE PutFileStamp[ee.file, ee.name];
IF ee.namedInstance
THEN {Start[$instance]; PutInstanceName[[0,0,export[eti]]]; PutName[ee.name]; End[]}
ELSE PutName[ee.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
End[]};
IF filter[modules]
THEN {
Start[$modules];
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 {Start[$instance]; PutInstanceName[[0,0,module[mti]]]; PutName[mm.name]; End[]}
ELSE PutName[mm.name];
PutFileStamp[mm.file, mm.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
End[]};
PutFileStamp:
PROC[fti: FTIndex, mName: NameRecord] = {
SELECT fti
FROM
FTNull => PutName[mName];
FTSelf => PutName[mName];
ENDCASE => {
ftr: LONG POINTER TO FTRecord = @ftb[fti];
PutStampedName[n: ftr.name, stamp: ftr.version];
};
};
PutMobName:
PROC[] = {
name: NameRecord = IF mob.nModules=1 AND mob.nConfigs = 0 THEN (@mtb[MTIndex.FIRST]).name ELSE mob.source;
PutStampedName[n: name, stamp: mob.version];
};
PrintHeader:
PROC = {
{
Start[$header];
PutLabeledINT[$configurations, mob.nConfigs];
PutLabeledINT[$modules, mob.nModules];
PutLabeledINT[$imports, mob.nImports];
PutLabeledINT[$exports, mob.nExports];
PutLabeledINT[$firstdummy, mob.firstdummy];
PutLabeledINT[$dummies, mob.nDummies];
PutLabeledBOOL[$definitions, mob.definitions];
PutLabeledBOOL[$repackaged, mob.repackaged];
PutLabeledBOOL[$typeexported, mob.typeExported];
PutLabeledBOOL[$inlinefloat, mob.inlineFloat];
PutLabeledBOOL[$mappingstarted, mob.mappingStarted];
PutLabeledBOOL[$mappingfinished, mob.mappingFinished];
PutLabeledBOOL[$versions, mob.versions];
PutLabeledBOOL[$extended, mob.extended];
End[]};
};
PrintConfigs:
PROC = {
cti: CTIndex ¬ CTIndex.FIRST;
IF cti = mob.ctLimit THEN RETURN;
{
Start[$configurations];
PutLabeledINT[$offset, 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;
End[]};
};
PrintConfig:
PROC[cti: CTIndex] = {
ctp: LONG POINTER TO CTRecord = @ctb[cti];
Start[$configuration];
PutName[ctp.name];
IF ctp.namedInstance THEN {Start[$instancename]; PutInstanceName[[0,0,config[cti]]]; End[]};
PutFileInfo[ctp.file];
IF cti # CTNull THEN {Start[$parent]; PutNameAndIndex[ctb[cti].name, LOOPHOLE[cti]]; End[]};
IF ctp.nControls # 0
THEN {
Start[$control];
FOR i:
CARDINAL
IN [0..ctp.nControls)
DO
WITH c~~ctp.controls[i]
SELECT
FROM
module => {PutName[mtb[c.mti].name]};
config => {Start[$config]; PutName[ctb[c.cti].name]; End[]};
ENDCASE => ERROR;
ENDLOOP;
End[]};
End[]};
PrintImports: PROC = {
iti: IMPIndex ← IMPIndex.FIRST;
stream.PutF["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];
PutNameAndIndex[imp.name, 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.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;
units ← units + frameSize;
totalWaste ← totalWaste + waste;
totalProcs ← totalProcs + procs;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IF frames > 1 THEN {
stream.PutF["%g units in %g frames using %g gfi slots, %g procs (%g waste)\n",
[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];
MobListerUtils.FreeMob[nMob];
};
EXITS
loser => inner[NIL];
};
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];
};
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];
PutNameAndIndex[etr.name, 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.PutF["\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];
};
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];
PutNameAndIndex[mth.name, 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: "];
PutNameAndIndex[ctb[mth.config].name, 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.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;
};
};
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;
};
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];
PutNameAndIndex[ftr.name, LOOPHOLE[fti]];
stream.PutRope[", version: "];
MobListerUtils.PrintVersion[ftr.version, stream]};
PrintUsing:
PROC [stb: SymbolTableBase] = {
limit: CTXIndex = LOOPHOLE[stb.stHandle.ctxBlock.size];
ctx: CTXIndex ¬ CTXIndex.FIRST + CTXRecord.nil.SIZE;
pairs: LIST OF Pair ¬ NIL;
ros: IO.STREAM ¬ IO.ROS[];
firstCopiedHash: Symbols.HTIndex;
InDirectory:
PROC [ctx: CTXIndex]
RETURNS [
BOOL] = {
FOR dirSei: ISEIndex
¬ SymbolOps.FirstCtxSe[stb, stb.stHandle.directoryCtx], SymbolOps.NextSe[stb, dirSei] UNTIL dirSei = ISENull DO
WITH se~~stb.seb[SymbolOps.UnderType[stb, stb.seb[dirSei].idType]]
SELECT
FROM
definition => IF ctx = se.defCtx THEN RETURN [TRUE];
ENDCASE;
ENDLOOP;
RETURN [FALSE]};
DoContext:
PROC [ctx: CTXIndex] = {
IF ctx # CTXNull
THEN {
sei, root: ISEIndex;
cp: LONG POINTER TO CTXRecord = @stb.ctxb[ctx];
which: LIST OF Pair ¬ NIL;
key, modName: ROPE ¬ NIL;
mdi: Symbols.MDIndex;
DoSei:
PROC [sei: ISEIndex] = {
sep: LONG POINTER TO ISERecord = @stb.seb[sei];
IF
LOOPHOLE[sep.hash,
CARD] <
LOOPHOLE[firstCopiedHash,
CARD]
THEN {
name: ROPE ¬ NIL;
IF sep.idType = typeTYPE
THEN {
typeSei: SEIndex ¬ SymbolOps.DecodeType[sep.idInfo];
WITH tse~~stb.seb[typeSei]
SELECT
FROM
id => {
IF tse.idCtx # ctx AND InDirectory[tse.idCtx] THEN RETURN};
ENDCASE;
};
ros ¬ IO.ROS[ros];
MobListerUtils.PrintSei[sei, ros, stb];
name ¬ ros.RopeFromROS[FALSE];
which.first.names ¬ InsertName[name, which.first.names]};
};
WITH c~~cp
SELECT
FROM
included => {
mdi ¬ c.module};
imported => {
mdi ¬ stb.ctxb[c.includeLink].module};
ENDCASE => RETURN;
Get the module name
ros ¬ IO.ROS[ros];
MobListerUtils.PrintName[stb.mdb[mdi].moduleId, ros, stb];
modName ¬ ros.RopeFromROS[FALSE];
[which, pairs] ¬ FindList[modName, pairs];
IF which.first.file =
NIL
THEN {
Get the module file name
modFileName: ROPE ¬ NIL;
ros ¬ IO.ROS[ros];
MobListerUtils.PrintName[stb.mdb[mdi].fileId, ros, stb];
modFileName ¬ ros.RopeFromROS[FALSE];
modFileName ¬ modFileName.Flatten[0, modFileName.SkipTo[0, "."]];
which.first.file ¬ modFileName};
root ¬ sei ¬ stb.ctxb[ctx].seList;
DO
IF sei = SENull THEN EXIT;
DoSei[sei];
IF (sei ¬ SymbolOps.NextSe[stb, sei]) = root THEN EXIT;
ENDLOOP;
};
};
BEGIN
firstCopiedHash ¬ LAST[Symbols.HTIndex];
hti: HTIndex ← Symbols.HTFirst;
FOR hti: HTIndex ← Symbols.HTFirst, hti + SIZE[HTRecord] UNTIL hti = stb.htLimit DO
IF stb.htb[hti].ssIndex = stb.htb[hti - SIZE[HTRecord]].ssIndex THEN {
firstCopiedHash ← hti; EXIT};
REPEAT FINISHED => firstCopiedHash ← LENGTH[stb.hashVec];
ENDLOOP;
END;
FOR dirSei: ISEIndex
¬ SymbolOps.FirstCtxSe[stb, stb.stHandle.directoryCtx], SymbolOps.NextSe[stb, dirSei] UNTIL dirSei = ISENull DO
WITH se~~stb.seb[SymbolOps.UnderType[stb, stb.seb[dirSei].idType]]
SELECT
FROM
definition => DoContext[se.defCtx];
ENDCASE;
ENDLOOP;
FOR dirSei: ISEIndex
¬ SymbolOps.FirstCtxSe[stb, stb.stHandle.importCtx], SymbolOps.NextSe[stb, dirSei] UNTIL dirSei = ISENull DO
WITH se~~stb.seb[SymbolOps.UnderType[stb, stb.seb[dirSei].idType]]
SELECT
FROM
definition => DoContext[se.defCtx];
transfer => {
bti: BTIndex = SymbolOps.DecodeBti[stb.seb[dirSei].idInfo];
DoContext[stb.bb[bti].localCtx]};
ENDCASE;
ENDLOOP;
At this point all of the entries have been made.
IF pairs #
NIL
THEN {
Start[$directory];
WHILE pairs #
NIL
DO
pair: Pair = pairs.first;
names: LIST OF ROPE ¬ pair.names;
{
Start[$item];
putATOM[Atom.MakeAtom[pair.key]];
IF
NOT (pair.key).Equal[pair.file,
FALSE]
THEN {
Start[$from];
PutRope[pair.file];
End[]};
IF filter[using]
THEN {Start[$using];
WHILE names #
NIL
DO
PutRope[names.first];
names ¬ names.rest;
ENDLOOP;
End[]};
End[]};
pairs ¬ pairs.rest;
ENDLOOP;
End[]};
};
Utility Prints
PutFileInfo: PROC [fti: FTIndex] = {
Start[$file];
PrintFileName[fti];
PrintLongIndex[LOOPHOLE[fti]];
End[]
};
PrintFileName:
PROC[fti: FTIndex] = {
SELECT fti
FROM
FTNull => putATOM[$null];
FTSelf => putATOM[$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];
PutRope["? Looks like garbage ..."];
};
Tab:
PROC[n:
CARDINAL] = {
};
Utility Puts
PutName:
PROC[n: NameRecord] = {
putATOM[SymbolFromName[n]];
};
PutStampedName:
PROC[n: NameRecord, stamp: VersionStamp] = {
IF filter[versions]
THEN putModuleID[[SymbolFromName[n], SymbolFromStamp[stamp]]]
ELSE PutName[n];
};
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;
i: CARDINAL ¬ index+1;
P: SAFE PROC RETURNS [c: CHAR] = TRUSTED { c ¬ ss[i]; i ¬ i + 1 };
RETURN[Rope.FromProc[len: len, p: P]];
};
SymbolFromName:
PROC[n: NameRecord]
RETURNS [a:
ATOM] = {
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;
text: REF TEXT ¬ RefText.ObtainScratch[len];
FOR i:
NAT
IN [index+1..index+1+len)
DO
text[text.length] ¬ ss[i];
text.length ¬ text.length + 1;
ENDLOOP;
a ¬ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[text];
};
SymbolFromNameAndIndex:
PROC[n: NameRecord, card:
CARD]
RETURNS [a:
ATOM] = {
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;
text: REF TEXT ¬ RefText.ObtainScratch[len+9];
FOR i:
NAT
IN [index+1..index+1+len)
DO
text[text.length] ¬ ss[i];
text.length ¬ text.length + 1;
ENDLOOP;
text[text.length] ¬ '-;
text.length ¬ text.length + 1;
text ¬ Convert.AppendCard[to: text, from: card, base: 16, showRadix: FALSE];
a ¬ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[text];
};
SymbolFromNameAndVersionStamp:
PROC [n: NameRecord, stamp: VersionStamp]
RETURNS [a:
ATOM] = {
DigitArray:
TYPE =
PACKED
ARRAY DigitArrayIndex
OF HexDigit;
HexDigit: TYPE = [0..16);
DigitArrayIndex: TYPE = [0..BITS[VersionStamp]/BITS[HexDigit]);
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;
text: REF TEXT ¬ RefText.ObtainScratch[len+17];
FOR i:
NAT
IN [index+1..index+1+len)
DO
text[text.length] ¬ ss[i];
text.length ¬ text.length + 1;
ENDLOOP;
text[text.length] ¬ '-;
text.length ¬ text.length + 1;
FOR i: DigitArrayIndex
IN DigitArrayIndex
DO
d: HexDigit = LOOPHOLE[stamp, DigitArray][i];
text[text.length] ¬ IF d < 10 THEN '0+d ELSE 'a-10+d;
text.length ¬ text.length + 1;
ENDLOOP;
a ¬ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[text];
};
SymbolFromStamp:
PROC [stamp: VersionStamp]
RETURNS [a:
ATOM] = {
DigitArray:
TYPE =
PACKED
ARRAY DigitArrayIndex
OF HexDigit;
HexDigit: TYPE = [0..16);
DigitArrayIndex: TYPE = [0..BITS[VersionStamp]/BITS[HexDigit]);
text: REF TEXT ¬ RefText.ObtainScratch[17];
text[text.length] ¬ 'v;
text.length ¬ text.length + 1;
FOR i: DigitArrayIndex
IN DigitArrayIndex
DO
d: HexDigit = LOOPHOLE[stamp, DigitArray][i];
text[text.length] ¬ IF d < 10 THEN '0+d ELSE 'a-10+d;
text.length ¬ text.length + 1;
ENDLOOP;
a ¬ Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[text];
};
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 putATOM[$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;
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;
InitTableBases:
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;
};
dumpLinks: {none, all} ← IF cmd # $ShortMob THEN all ELSE none;
tb ¬ NIL;
IF mob.versionIdent # MobDefs.VersionID THEN Error[fileName, "not a valid Cedar mob file"];
InitTableBases[mob];
{
Start[
IF mob.definitions
THEN $definitions
ELSE
IF mob.nConfigs = 0
THEN $program
ELSE $configuration];
PutMobName[];
IF filter[directory]
AND mob.nConfigs = 0
THEN {
mtb: MobDefs.Base = LOOPHOLE[mob+mob.mtOffset.units];
sgh: MobDefs.SGHandle = IF mtb[FIRST[MobDefs.MTIndex]].sseg = MobDefs.SGNull
THEN Error[fileName, "NoSymbols"] -- NoSymbols
ELSE @sgb[mtb[FIRST[MobDefs.MTIndex]].sseg];
stb: LONG POINTER TO SymbolSegment.STHeader = LOOPHOLE[mob+sgh.base.units];
IF sgh.file = MobDefs.FTSelf AND sgh.units.units # 0 AND stb.versionIdent = SymbolSegment.VersionID THEN PrintUsing[InstallTable[stb]];
};
IF filter = ALL[FALSE] THEN PrintHeader[];
PrintStamps[];
IF filter[configurations] THEN PrintConfigs[];
End[]};
};
theMob: MobDefs.MobBase ~ MobListerUtils.ReadMob[fileName ! MobListerUtils.MobErr => ERROR Error[culprit: fileName, msg: err]];