T Y P E S & C O N S T A N T S
Mob: TYPE = MobDefs.Mob;
BaseRelativePointer: TYPE ~ Symbols.Base RELATIVE LONG POINTER;
BitAddress: TYPE = Symbols.BitAddress;
BTIndex:
TYPE = Symbols.BTIndex;
BTNull: BTIndex = Symbols.BTNull;
BTRecord: TYPE = Symbols.BodyRecord;
CSEIndex:
TYPE = Symbols.CSEIndex;
typeTYPE: CSEIndex = Symbols.typeTYPE;
ContextLevel:
TYPE = Symbols.ContextLevel;
lZ: ContextLevel = Symbols.lZ;
CTXIndex:
TYPE = Symbols.CTXIndex;
CTXNull: CTXIndex = Symbols.CTXNull;
CTXRecord: TYPE = Symbols.CTXRecord;
ExtIndex: TYPE ~ SymbolSegment.ExtIndex;
ExtRecord: TYPE ~ SymbolSegment.ExtRecord;
FTIndex: TYPE = MobDefs.FTIndex;
FTRecord: TYPE = MobDefs.FTRecord;
HTIndex: TYPE = Symbols.HTIndex;
HTRecord: TYPE = Symbols.HTRecord;
ISEIndex:
TYPE = Symbols.ISEIndex;
ISENull: ISEIndex = Symbols.ISENull;
ISERecord: TYPE = SERecord.id;
LTIndex:
TYPE = Literals.LTIndex;
LTNull: LTIndex = Literals.LTNull;
LTRecord: TYPE = Literals.LTRecord;
LitDescriptor: TYPE = Literals.LitDescriptor;
MDIndex: TYPE = Symbols.MDIndex;
MDRecord: TYPE = Symbols.MDRecord;
MSTIndex:
TYPE = Literals.MSTIndex;
MSTNull: MSTIndex = LOOPHOLE[STNull];
MTIndex:
TYPE = MobDefs.MTIndex;
MTNull: MTIndex = MobDefs.MTNull;
MTRecord: TYPE = MobDefs.MTRecord;
Name:
TYPE = Symbols.Name;
nullName: Name = Symbols.nullName;
NodeName: TYPE = Tree.NodeName;
RefMob: TYPE = REF Mob;
RefMTRecord: TYPE = REF MTRecord;
RefSGRecord: TYPE = REF SGRecord;
RootBti: BTIndex = Symbols.RootBti;
ROPE: TYPE = Rope.ROPE;
SEHandle: TYPE = Symbols.SEPointer;
SEIndex:
TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
SGIndex: TYPE = MobDefs.SGIndex;
SGRecord: TYPE = MobDefs.SGRecord;
STIndex:
TYPE = Literals.STIndex;
STNull: STIndex = Literals.STNull;
STREAM: TYPE = IO.STREAM;
SubString: TYPE = ConvertUnsafe.SubString;
Switches: TYPE = PACKED ARRAY CHAR['A..'Z] OF BOOL;
SymbolTableBase: TYPE = REF SymbolTableBaseRep;
SymbolTableBaseRep: PUBLIC TYPE = SymbolTablePrivate.SymbolTableBaseRep;
STHeader: TYPE ~ LONG POINTER TO SymbolSegment.STHeader;
TransferMode: TYPE = Symbols.TransferMode;
TypeClass: TYPE = Symbols.TypeClass;
PackDescriptor: TYPE = LONG DESCRIPTOR FOR ARRAY OF PackageSymbols.OuterPackRecord;
UC:
PROC [c:
CHAR]
RETURNS [
CHAR] = {
RETURN [IF c IN ['a..'z] THEN 'A + (c - 'a) ELSE c];
};
DetailMob: Commander.CommandProc =
TRUSTED {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
ENABLE
CommanderOps.Failed => {msg ¬ errorMsg; GO TO failed};
name: ROPE;
any: BOOL ¬ FALSE;
args: LIST OF ROPE ¬ CommanderOps.ParseToList[cmd].list;
filesDone: INT ¬ 0;
configOk: BOOL ¬ TRUE;
defsOK: BOOL ¬ TRUE;
namePath: PFS.PATH;
EachName:
PFS.NameProc =
TRUSTED {
[name: PATHROPE] RETURNS [continue: BOOL]
ENABLE MobListerUtils.MobErr => { msg ¬ err; continue ¬ FALSE; GO TO failed };
mob: MobDefs.MobBase;
Cleanup:
PROC = {
MobListerUtils.FreeMob[mob];
};
fullFName: ROPE ~ PFS.RopeFromPath[name];
filesDone ¬ filesDone + 1;
mob ¬ MobListerUtils.ReadMob[fullFName];
{
ENABLE
UNWIND => Cleanup[];
short: ROPE = MobListerUtils.ShortName[fullFName];
SELECT
TRUE
FROM
mob.versionIdent # MobDefs.VersionID =>
(cmd.out).PutF1["Not a valid Cedar mob file: %g\n", [rope[short]]];
mob.nConfigs # 0
AND ~configOk =>
(cmd.out).PutF1["Bound configurations not supported: %g\n", [rope[short]]];
mob.definitions
AND
NOT defsOK =>
(cmd.out).PutF1["Definitions files not supported: %g\n", [rope[short]]];
ENDCASE => {
ProcessSymbols[mob, cmd, fullFName];
};
Cleanup[];
continue ¬ TRUE;
};
EXITS failed => NULL;
}; -- End of EachName
begin ListSymbols
WHILE args #
NIL
DO
ENABLE PFS.Error => { msg ¬ error.explanation; GO TO failed };
name ¬ args.first;
args ¬ args.rest;
SELECT
TRUE
FROM
Rope.Match["*.mob", name, FALSE], Rope.Match["*.mob!*", name, FALSE] => {};
ENDCASE => name ¬ name.Concat[".mob"];
any ¬ TRUE;
name ← FS.ExpandName[name].fullFName;
namePath ¬ PFS.PathFromRope[name];
IF NOT Rope.Match["*!*", name] THEN name ← name.Concat["!h"];
IF PFSNames.ShortName[namePath].version.versionKind = none THEN
namePath ¬ PFSNames.SetVersionNumber[namePath, [highest, 0]];
filesDone ¬ 0;
MobListerUtils.InitMobTab[];
PFS.EnumerateForNames[PFS.PathFromRope[name], EachName];
IF result # NIL THEN GO TO failed;
IF filesDone = 0
THEN
IO.PutF1[cmd.out, "No matches found for '%g'\n", [rope[name]] ];
ENDLOOP;
IF
NOT any
THEN {
result ¬ $Failure;
msg ¬ IO.PutFR1["Usage: %g file ...", [rope[cmd.command]]];
};
EXITS failed => result ¬ $Failure;
}; -- End of ListSymbols
ProcessSymbols:
PROC [mob: MobDefs.MobBase, cmd: Commander.Handle, fullFName:
ROPE] = {
short: ROPE = MobListerUtils.ShortName[fullFName];
sgb: MobDefs.Base = LOOPHOLE[mob+mob.sgOffset.units];
ext: ROPE ~ ".details";
outName:
ROPE ~
SELECT
TRUE
FROM
Rope.Match["*.mob", short, FALSE] => short.Replace[short.Length[]-4, 4, ext],
ENDCASE => short.Concat[ext];
stream: STREAM ~ PFS.StreamOpen[PFS.PathFromRope[outName], $create];
sourceName: ROPE ¬ NIL;
stb: SymbolTableBase ¬ NIL;
Open the output stream
cmd.out.PutF["Mob details of %g output to %g\n", [rope[fullFName]], [rope[outName]] ];
stream.PutRope[outName];
PrintMob[stream, mob];
FOR sgi: SGIndex ¬ SGIndex.
FIRST, sgi+SGRecord.
SIZE
WHILE sgi#mob.sgLimit
DO
sgic: CARD ~ LOOPHOLE[sgi, CARD];
sgh: MobDefs.SGHandle = @sgb[sgi];
IF sgic >
LOOPHOLE[mob.sgLimit,
CARD]
THEN {
stream.PutF1["\n!Final SGI: %x\n", [cardinal[sgic]]];
EXIT};
IF sgh.class # symbols
THEN {
stream.PutF["\n Segment %x has class %x.\n", [cardinal[sgic]], [cardinal[sgh.class.ORD]]];
LOOP};
IF sgh.units.units = 0
THEN {
stream.PutF1["\n Segment %x is empty.\n", [cardinal[sgic]]];
LOOP};
{sth: STHeader = LOOPHOLE[mob+sgh.base.units];
IF sth.versionIdent # SymbolSegment.VersionID THEN ERROR; -- WrongSymbolsVersion;
PrintSymbolsSegmentHeader[stream, sth, sgi];
IO.Flush[stream];
stb ¬ InstallTable[sth];
PrintModuleDirectory[stream, mob, sth, stb];
PrintBodies[stream, sth, stb];
PrintContexts[stream, sth, stb];
PrintSemanticEntries[stream, mob, sth, stb];
PrintExtensions[stream, mob, sth, stb];
}ENDLOOP;
PrintFiles[stream, mob];
IF stream # NIL AND stream # cmd.out THEN stream.Close[];
}; -- End of ProcessSymbols
PrintMob:
PROC [to:
STREAM, mob: MobDefs.MobBase] ~ {
sourceName:
ROPE ~ RopeForMobName[mob,
add one to source to compensate for Mimosa bug
[IF mob.nConfigs = 0 THEN mob.source+1 ELSE mob.source]];
PrintSubtable:
PROC [name:
LONG
STRING, offset: MobDefs.MobOffset, limit: MobDefs.Base
RELATIVE
LONG
POINTER] ~ {
to.PutF["%g: %x %x\n", [rope[ConvertUnsafe.ToRope[name]]], [integer[offset.units]], [cardinal[LOOPHOLE[limit]]]];
};
to.PutF1["\n versionIdent: %x, version: ", [integer[mob.versionIdent]]];
PrintCorrectlyVersion[mob.version, to];
to.PutRope[", creator: "];
PrintCorrectlyVersion[mob.creator, to];
to.PutRope[", sourceVersion: "];
PrintCorrectlyVersion[mob.sourceVersion, to];
to.PutFL["\n source: %g, nBytes: %x, nConfigs: %x, nModules: %x, nImports: %x", LIST[ [rope[sourceName]], [integer[mob.nBytes]], [cardinal[mob.nConfigs]], [cardinal[mob.nModules]], [cardinal[mob.nImports]]]];
to.PutFL[", nExports: %x\n definitions: %g, repackaged: %g, typeExported: %g, inlineFloat: %g", LIST[[cardinal[mob.nExports]], [boolean[mob.definitions]], [boolean[mob.repackaged]], [boolean[mob.typeExported]], [boolean[mob.inlineFloat]]]];
to.PutFL["\n mappingStarted: %g mappingFinished: %g, versions: %g, extended: %g", LIST[ [boolean[mob.mappingStarted]], [boolean[mob.mappingFinished]], [boolean[mob.versions]], [boolean[mob.extended]]]];
to.PutFL["\n padOptions: %x padDummy: %x, firstdummy: %x, nDummies: %x", LIST[ [cardinal[mob.padOptions]], [cardinal[mob.padDummy]], [cardinal[mob.firstdummy]], [cardinal[mob.nDummies]]]];
to.PutF1[", pad1: %x\n", [cardinal[mob.pad1]]];
to.PutF["string table: %x %x\n", [integer[mob.ssOffset.units]], [integer[mob.ssLimit.units]]];
PrintSubtable["config table", mob.ctOffset, mob.ctLimit];
PrintSubtable["module table", mob.mtOffset, mob.mtLimit];
PrintSubtable["import table", mob.impOffset, mob.impLimit];
PrintSubtable["export table", mob.expOffset, mob.expLimit];
PrintSubtable["external variable table", mob.evOffset, mob.evLimit];
PrintSubtable["segment table", mob.sgOffset, mob.sgLimit];
PrintSubtable["file table", mob.ftOffset, mob.ftLimit];
PrintSubtable["space table", mob.spOffset, mob.spLimit];
PrintSubtable["name table", mob.ntOffset, mob.ntLimit];
PrintSubtable["type table", mob.typOffset, mob.typLimit];
PrintSubtable["type map table", mob.tmOffset, mob.tmLimit];
PrintSubtable["frame pack table", mob.fpOffset, mob.fpLimit];
PrintSubtable["link fragment table", mob.lfOffset, mob.lfLimit];
PrintSubtable["ref literal fragment table", mob.rfOffset, mob.rfLimit];
PrintSubtable["type fragment table", mob.tfOffset, mob.tfLimit];
to.PutF["RTT table: %x %x\n", [integer[mob.rtOffset.units]], [integer[mob.rtLimit.units]]];
};
PrintSymbolsSegmentHeader:
PROC [to:
STREAM, sth: STHeader, sgi: SGIndex] ~ {
PrintBlock:
PROC [name:
LONG
STRING, block: SymbolSegment.BlockDescriptor] ~ {
to.PutF["%g: %x %x\n", [rope[ConvertUnsafe.ToRope[name]]], [integer[block.offset]], [cardinal[block.size]]];
};
to.PutF["\n Segment %x header\n versionIdent: %x, version: ", [cardinal[LOOPHOLE[sgi]]], [integer[sth.versionIdent]]];
PrintCorrectlyVersion[sth.version, to];
to.PutRope[", creator: "];
PrintCorrectlyVersion[sth.creator, to];
to.PutRope[", sourceVersion: "];
PrintCorrectlyVersion[sth.sourceVersion, to];
to.PutFL["\n definitionsFile: %g, extended: %g, directoryCtx: ctx%x, importCtx: ctx%x, outerCtx: ctx%x\n",
LIST[[boolean[sth.definitionsFile]], [boolean[sth.extended]], [cardinal[LOOPHOLE[sth.directoryCtx]]], [cardinal[LOOPHOLE[sth.directoryCtx]]], [cardinal[LOOPHOLE[sth.directoryCtx]]]]];
PrintBlock["hvBlock", sth.hvBlock];
PrintBlock["htBlock", sth.htBlock];
PrintBlock["ssBlock", sth.ssBlock];
PrintBlock["outerPackBlock", sth.outerPackBlock];
PrintBlock["innerPackBlock", sth.innerPackBlock];
PrintBlock["constBlock", sth.constBlock];
PrintBlock["seBlock", sth.seBlock];
PrintBlock["ctxBlock", sth.ctxBlock];
PrintBlock["mdBlock", sth.mdBlock];
PrintBlock["bodyBlock", sth.bodyBlock];
PrintBlock["extBlock", sth.extBlock];
PrintBlock["treeBlock", sth.treeBlock];
PrintBlock["litBlock", sth.litBlock];
PrintBlock["sLitBlock", sth.sLitBlock];
PrintBlock["epMapBlock", sth.epMapBlock];
PrintBlock["spareBlock", sth.spareBlock];
to.PutF["fgRelBase: %x, fgCount: %x\n", [cardinal[sth.fgRelBase]], [cardinal[sth.fgCount]] ];
};
PrintModuleDirectory:
PUBLIC
PROC [to:
STREAM, mob: MobDefs.MobBase, sth: STHeader, stb: SymbolTableBase] = {
mdi: MDIndex ¬ Symbols.MDFirst;
to.PutRope["\n Module Directory:\n"];
WHILE mdi < stb.mdLimit
DO
mdh: LONG POINTER TO MDRecord = @stb.mdb[mdi];
to.PutF1["%g: [stamp: ", FmtIdx["md", mdi, Symbols.MDNull] ];
PrintCorrectlyVersion[mdh.stamp, to];
IO.Flush[to];
to.PutFL[", moduleId: %g, fileId: %g, shared: %g, exported: %g", LIST[[rope[RopeForHTI[mob, stb, mdh.moduleId]]], [rope[RopeForHTI[mob, stb, mdh.fileId]]], [boolean[mdh.shared]], [boolean[mdh.exported]]]];
to.PutF[", file: %x, ctx: %g, defaultImport: %g]\n", [cardinal[mdh.file]], FmtIdx["ctx", mdh.ctx, CTXNull], FmtIdx["ctx", mdh.defaultImport, CTXNull] ];
mdi ¬ mdi + MDRecord.SIZE;
ENDLOOP;
IF mdi > stb.mdLimit THEN to.PutF1["Final MDI: %x\n", [cardinal[LOOPHOLE[mdi]]] ];
to.PutRope["\n"];
};
PrintBodies:
PUBLIC
PROC [to:
STREAM, sth: STHeader, stb: SymbolTableBase] = {
bti: BTIndex ¬ Symbols.BTFirst;
to.PutRope["Body Table:\n"];
WHILE bti - Symbols.BTFirst < sth.bodyBlock.size
DO
body: LONG POINTER TO BTRecord = @stb.bb[bti];
to.PutFL["%g: [%g: %g, firstSon: %g, type: %g", LIST[FmtIdx["bt", bti, BTNull], [rope[SELECT body.link.which FROM sibling => "sibling", parent => "parent", ENDCASE => ERROR]], FmtIdx["bt", body.link.index, BTNull], FmtIdx["bt", body.firstSon, BTNull], FmtIdx["se", body.type, SENull]]];
to.PutFL[", localCtx: %g, sourceIndex: %g, level: %x, class: %g, info: ", LIST[FmtIdx["ctx", body.localCtx, CTXNull], [cardinal[body.sourceIndex]], [cardinal[body.level]], [rope[IF body.class <= Fork THEN ConvertUnsafe.ToRope[ProcClassName[body.class]] ELSE Convert.RopeFromInt[body.class.ORD, 16, FALSE]]]]];
WITH x: body.info
SELECT
FROM
Internal => {
to.PutF1["Internal[frameSize: %x, bodyTree: ", [cardinal[x.frameSize]] ];
PrintTree[to, x.bodyTree, stb, bodyTreeUtilly];
to.PutRope[", thread: "];
PrintTree[to, x.thread, stb, threadUtilly];
to.PutRope["], "]};
External => to.PutFL["External[pad: %x, bytes: %x, startIndex: %x, indexLength: %x], ", LIST[[cardinal[x.pad]], [integer[x.bytes]], [integer[x.startIndex]], [integer[x.indexLength]]]];
ENDCASE => ERROR;
WITH x: body
SELECT
FROM
Callable => {
to.PutFL["Callable[id: %g, io: %g, frameOffset: %x, entryIndex: %x, kind: %g", LIST[FmtIdx["se", x.id, SENull], FmtIdx["se", x.ioType, SENull], [integer[x.frameOffset]], [cardinal[x.entryIndex]], [rope[SELECT x.kind FROM Outer => "Outer", Inner => "Inner", Catch => "Catch", Other => "Other", ENDCASE => ERROR]]]];
to.PutFL[", safe: %g, argUpdated: %g, nameSafe: %g, noStrings: %g", LIST[[boolean[x.hints.safe]], [boolean[x.hints.argUpdated]], [boolean[x.hints.nameSafe]], [boolean[x.hints.noStrings]]]];
to.PutFL[", entry: %g, internal: %g, inline: %g, monitored: %g, noXfers: %g", LIST[[boolean[x.entry]], [boolean[x.internal]], [boolean[x.inline]], [boolean[x.monitored]], [boolean[x.noXfers]]]];
to.PutF1[", resident: %g]", [boolean[x.resident]] ];
bti ¬ bti + SIZE[Callable BTRecord]};
Other => {
to.PutF1["Other[relOffset: %x]", [integer[x.relOffset]] ];
bti ¬ bti + SIZE[Other BTRecord]};
ENDCASE => ERROR;
to.PutRope["]\n"];
ENDLOOP;
IF bti-Symbols.BTFirst > sth.bodyBlock.size THEN to.PutF1["Final BTI: %x\n", [cardinal[LOOPHOLE[bti]]] ];
to.PutRope["\n"];
};
bodyTreeUtilly, threadUtilly: BOOL ¬ FALSE;
PrintTree:
PROC [to:
STREAM, tree: BaseRelativePointer, stb: SymbolTableBase, utilly:
BOOL] ~ {
IF utilly
THEN {
<<Nil: BaseRelativePointer ~ FIRST[BaseRelativePointer];
IF Untag[tree]=Nil THEN to.PutRope["NIL"] ELSE >>MobListerUtils.PrintTree[LOOPHOLE[tree], 1, to, stb];
}
ELSE to.PutF1["%x", [cardinal[LOOPHOLE[tree]]] ];
RETURN};
PrintContexts:
PUBLIC
PROC [to:
STREAM, sth: STHeader, stb: SymbolTableBase] = {
ctxi: CTXIndex ¬ Symbols.CTXFirst;
to.PutRope["Context Table:\n"];
WHILE ctxi - Symbols.CTXFirst < sth.ctxBlock.size
DO
ctx: LONG POINTER TO CTXRecord = @stb.ctxb[ctxi];
to.PutFL["%g: [seList: %g, level: %x, varUpdated: %g, ", LIST[FmtIdx["ctx", ctxi, CTXNull], FmtIdx["se", ctx.seList, SENull], [cardinal[ctx.level]], [boolean[ctx.varUpdated]]]];
WITH x: ctx
SELECT
FROM
simple => {
to.PutF1["simple[copied: %g]", ClosureVal[x.copied] ];
ctxi ¬ ctxi + SIZE[simple CTXRecord]};
included => {
to.PutFL["included[chain: %g, module: md%x, map: %g, copied: %g, ", LIST[FmtIdx["ctx", x.chain, CTXNull], [cardinal[LOOPHOLE[x.module]]], FmtIdx["ctx", x.map, CTXNull], ClosureVal[x.copied]]];
to.PutFL["reset: %g, closed: %g, complete: %g, restricted: %g]", LIST[[boolean[x.reset]], [boolean[x.closed]], [boolean[x.complete]], [boolean[x.restricted]]]];
ctxi ¬ ctxi + SIZE[included CTXRecord]};
imported => {
to.PutF1["imported[includeLink: %g]", FmtIdx["ctx", x.includeLink, CTXNull] ];
ctxi ¬ ctxi + SIZE[imported CTXRecord]};
nil => {
to.PutRope["nil[]"];
ctxi ¬ ctxi + SIZE[nil CTXRecord]};
ENDCASE => ERROR;
to.PutRope["]\n"];
ENDLOOP;
IF ctxi - Symbols.CTXFirst > sth.ctxBlock.size THEN to.PutF1["Final CTXI: %x\n", [cardinal[LOOPHOLE[ctxi]]] ];
to.PutRope["\n"];
};
PrintSemanticEntries:
PUBLIC
PROC [to:
STREAM, mob: MobDefs.MobBase, sth: STHeader, stb: SymbolTableBase] = {
sei: SEIndex ¬ Symbols.SEFirst;
to.PutRope["Semantic Entry Table:\n"];
WHILE
INT[sei - Symbols.SEFirst] <
INT[sth.seBlock.size]
DO
seh: LONG POINTER TO SERecord = @stb.seb[sei];
to.PutF1["%g: ", FmtIdx["se", sei, SENull] ];
WITH x: seh
SELECT
FROM
id => {
to.PutFL["id[extended: %g, public: %g, immutable: %g, constant: %g, linkSpace: %g, ", LIST[[boolean[x.extended]], [boolean[x.public]], [boolean[x.immutable]], [boolean[x.constant]], [boolean[x.linkSpace]]]];
to.PutF["idCtx: %g, idType: %g", FmtIdx["ctx", x.idCtx, CTXNull], FmtIdx["se", x.idType, SENull] ];
SELECT
TRUE
FROM
x.idType = Symbols.typeTYPE => to.PutF[", idInfo: %g, idValue: %g", FmtIdx["se", LOOPHOLE[x.idInfo], SENull], FmtIdx["se", LOOPHOLE[x.idValue], SENull] ];
ENDCASE => to.PutF[", idInfo: %x, idValue: %x", [cardinal[LOOPHOLE[x.idInfo]]], [cardinal[LOOPHOLE[x.idValue]]] ];
to.PutF[", hash: %g, special: %g", [rope[RopeForHTI[mob, stb, x.hash]]], IF x.special<=extensionVar THEN [rope[ConvertUnsafe.ToRope[SpecialVarKindName[x.special]]]] ELSE [rope[Convert.RopeFromInt[x.special.ORD, 16, FALSE]]] ];
to.PutF1[", flags: [%gvalid", Flg[x.flags.valid]];
AddBool[to, x.flags.used, "used"];
AddBool[to, x.flags.addressed, "addressed"];
AddBool[to, x.flags.assigned, "assigned"];
AddBool[to, x.flags.upLevel, "upLevel"];
AddBool[to, x.flags.sized, "sized]"];
WITH y: x
SELECT
FROM
terminal => {to.PutRope[", terminal]"]; sei ¬ sei + SIZE[terminal id SERecord]};
sequential => {to.PutRope[", sequential]"]; sei ¬ sei + SIZE[terminal id SERecord]};
linked => {to.PutF1[", link: %g]", FmtIdx["se", y.link, SENull] ]; sei ¬ sei + SIZE[linked id SERecord]};
embedded => {to.PutF1[", base: %g]", FmtIdx["se", y.base, SENull] ]; sei ¬ sei + SIZE[embedded id SERecord]};
ENDCASE => ERROR;
};
cons => {
to.PutF1["cons[align: %x, ", [cardinal[x.align.ORD]] ];
WITH y: x
SELECT
FROM
mode => {to.PutRope["mode]"]; sei ¬ sei + SIZE[mode cons SERecord]};
basic => {to.PutF["basic[ordered: %g, code: %g, length: %x]]", [boolean[y.ordered]], [integer[y.code]], [cardinal[y.length]] ]; sei ¬ sei + SIZE[basic cons SERecord]};
signed => {to.PutF1["signed[length: %x]]", [integer[y.length]] ]; sei ¬ sei + SIZE[signed cons SERecord]};
unsigned => {to.PutF1["unsigned[length: %x]]", [integer[y.length]] ]; sei ¬ sei + SIZE[unsigned cons SERecord]};
real => {to.PutF1["real[length: %x]]", [integer[y.length]] ]; sei ¬ sei + SIZE[real cons SERecord]};
enumerated => {
to.PutF["enumerated[range: %x, valueCtx: %g", [cardinal[y.range]], FmtIdx["ctx", y.valueCtx, CTXNull] ];
to.PutFL[", empty: %g, sparse: %g, painted: %g, ordered: %g, machineDep: %g]]", LIST[[boolean[y.empty]], [boolean[y.sparse]], [boolean[y.painted]], [boolean[y.ordered]], [boolean[y.machineDep]]]];
sei ¬ sei + SIZE[enumerated cons SERecord]};
record => {
to.PutFL["record[length: %x, fieldCtx: %g, bitOrder: %g, grain: %x", LIST[[integer[y.length]], FmtIdx["ctx", y.fieldCtx, CTXNull], [rope[ConvertUnsafe.ToRope[BitOrderName[y.bitOrder]]]], [integer[y.grain]]]];
AddBool[to, y.hints.comparable, "comparable"];
AddBool[to, y.hints.assignable, "assignable"];
AddBool[to, y.hints.unifield, "unifield"];
AddBool[to, y.hints.variant, "variant"];
AddBool[to, y.hints.privateFields, "privateFields"];
AddBool[to, y.hints.refField, "refField"];
AddBool[to, y.hints.default, "default"];
AddBool[to, y.hints.voidable, "voidable"];
AddBool[to, y.spare, "spare"];
AddBool[to, y.packed, "packed"];
AddBool[to, y.list, "list"];
AddBool[to, y.argument, "argument"];
AddBool[to, y.monitored, "monitored"];
AddBool[to, y.machineDep, "machineDep"];
AddBool[to, y.painted, "painted"];
WITH z: y
SELECT
FROM
notLinked => {to.PutRope[", notLinked]"]; sei ¬ sei + SIZE[notLinked record cons SERecord]};
linked => {to.PutF1[", linked[linkType: %g]]", FmtIdx["se", z.linkType, SENull] ]; sei ¬ sei + SIZE[linked record cons SERecord]};
ENDCASE => ERROR;
};
ref => {
to.PutF["ref[refType: %g, length: %x", FmtIdx["se", y.refType, SENull], [cardinal[y.length]] ];
to.PutFL[", counted: %g, ordered: %g, readOnly: %g, list: %g, var: %g]]", LIST[ [boolean[y.counted]], [boolean[y.ordered]], [boolean[y.readOnly]], [boolean[y.list]], [boolean[y.var]]]];
to.PutF[", basing: %g, spare1: %g, spare2: %g]]", [boolean[y.basing]], [boolean[y.spare1]], [boolean[y.spare2]] ];
sei ¬ sei + SIZE[ref cons SERecord]};
array => {
to.PutFL["array[componentType: %g, indexType: %g, packed: %g, bitOrder: %g]", LIST[FmtIdx["se", y.componentType, SENull], FmtIdx["se", y.indexType, SENull], [boolean[y.packed]], [rope[ConvertUnsafe.ToRope[BitOrderName[y.bitOrder]]]]]];
sei ¬ sei + SIZE[array cons SERecord]};
arraydesc => {
to.PutFL["arraydesc[describedType: %g, var: %g, readOnly: %g, bitOrder: %g, length: %x]", LIST[FmtIdx["se", y.describedType, SENull], [boolean[y.var]], [boolean[y.readOnly]], [rope[ConvertUnsafe.ToRope[BitOrderName[y.bitOrder]]]], [cardinal[y.length]]]];
sei ¬ sei + SIZE[arraydesc cons SERecord]};
transfer => {
to.PutFL["transfer[typeIn: %g, typeOut: %g, %g, safe: %g, length: %x]", LIST[FmtIdx["se", y.typeIn, SENull], FmtIdx["se", y.typeOut, SENull], [rope[ConvertUnsafe.ToRope[TransferModeName[y.mode]]]], [boolean[y.safe]], [cardinal[y.length]]]];
sei ¬ sei + SIZE[transfer cons SERecord]};
definition => {
to.PutF["definition[defCtx: %g, slots: %x, named: %g]", FmtIdx["ctx", y.defCtx, CTXNull], [cardinal[y.slots]], [boolean[y.named]] ];
sei ¬ sei + SIZE[definition cons SERecord]};
union => {
to.PutFL["union[caseCtx: %g, tagSei: %g, bitOrder: %g, grain: %x", LIST[FmtIdx["ctx", y.caseCtx, CTXNull], FmtIdx["se", y.tagSei, SENull], [rope[ConvertUnsafe.ToRope[BitOrderName[y.bitOrder]]]], [integer[y.grain]]]];
AddBool[to, y.hints.equalLengths, "equalLengths"];
AddBool[to, y.hints.refField, "refField"];
AddBool[to, y.hints.default, "default"];
AddBool[to, y.hints.voidable, "voidable"];
AddBool[to, y.overlaid, "overlaid"];
AddBool[to, y.controlled, "controlled"];
AddBool[to, y.machineDep, "machineDep"];
AddBool[to, y.spare, "spare"];
to.PutRope["]"];
sei ¬ sei + SIZE[union cons SERecord]};
sequence => {
to.PutFL["sequence[parentType: %g, tagSei: %g, componentType: %g, bitOrder: %g, grain: %x", LIST[FmtIdx["se", y.parentType, SENull], FmtIdx["se", y.tagSei, SENull], FmtIdx["se", y.componentType, SENull], [rope[ConvertUnsafe.ToRope[BitOrderName[y.bitOrder]]]], [integer[y.grain]]]];
to.PutF[", packed: %g, controlled: %g, machineDep: %g]]", [boolean[y.packed]], [boolean[y.controlled]], [boolean[y.machineDep]] ];
sei ¬ sei + SIZE[sequence cons SERecord]};
relative => {
to.PutF["relative[baseType: %g, offsetType: %g, resultType: %g]]", FmtIdx["se", y.baseType, SENull], FmtIdx["se", y.offsetType, SENull], FmtIdx["se", y.resultType, SENull] ];
sei ¬ sei + SIZE[relative cons SERecord]};
subrange => {
to.PutF["subrange[rangeType: %g, origin: %x, range: %x", FmtIdx["se", y.rangeType, SENull], [integer[y.origin]], [cardinal[y.range]] ];
to.PutF[", filled: %g, biased: %g, empty: %g]]", [boolean[y.filled]], [boolean[y.biased]], [boolean[y.empty]] ];
sei ¬ sei + SIZE[subrange cons SERecord]};
opaque => {
to.PutF["opaque[id: %g, length: %x, lengthKnown: %g]]", FmtIdx["se", y.id, SENull], [integer[y.length]], [boolean[y.lengthKnown]] ];
sei ¬ sei + SIZE[opaque cons SERecord]};
zone => {
to.PutF["zone[counted: %g, mds: %g, length: %x]]", [boolean[y.counted]], [boolean[y.mds]], [cardinal[y.length]] ];
sei ¬ sei + SIZE[zone cons SERecord]};
any => {to.PutRope["any]"]; sei ¬ sei + SIZE[any cons SERecord]};
nil => {to.PutRope["nil]"]; sei ¬ sei + SIZE[nil cons SERecord]};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
to.PutRope["]\n"];
ENDLOOP;
IF INT[sei - Symbols.SEFirst] > INT[sth.seBlock.size] THEN to.PutF1["Final SEI: %x\n", [cardinal[LOOPHOLE[sei]]] ];
to.PutRope["\n"];
};
PrintExtensions:
PUBLIC
PROC [to:
STREAM, mob: MobDefs.MobBase, sth: STHeader, stb: SymbolTableBase] = {
exti: ExtIndex ¬ SymbolSegment.ExtFirst;
to.PutRope["Symbol Table Extensions:\n"];
WHILE exti - SymbolSegment.ExtFirst < sth.extBlock.size
DO
exth: LONG POINTER TO ExtRecord = @stb.extb[exti];
to.PutFL["%g: [type: %g, sei: %g (%g), tree: ", LIST[FmtIdx["ext", exti, SymbolSegment.ExtNull], [rope[ConvertUnsafe.ToRope[ExtensionTypeName[exth.type]]]], FmtIdx["se", exth.sei, SENull], [rope[RopeForHTI[mob, stb, stb.seb[exth.sei].hash]]]]];
PrintTree[to, LOOPHOLE[exth.tree], stb, extensionUtilly];
to.PutRope["]\n"];
exti ¬ exti + ExtRecord.SIZE;
ENDLOOP;
IF exti - SymbolSegment.ExtFirst > sth.extBlock.size THEN to.PutF1["Final EXTI: %x\n", [cardinal[LOOPHOLE[exti]]] ];
to.PutRope["\n"];
};
extensionUtilly: BOOL ¬ TRUE;
AddBool:
PROC [to:
STREAM, b:
BOOL, name:
ROPE] ~ {
to.PutRope[", "];
IF NOT b THEN to.PutChar['~];
to.PutRope[name];
RETURN};
Untag:
PROC [brp: BaseRelativePointer]
RETURNS [BaseRelativePointer] ~ {
ir: Table.IndexRep ¬ LOOPHOLE[brp];
ir.tag ¬ 0;
RETURN [LOOPHOLE[ir]]};
FmtIdx:
PROC [kind:
ROPE, ptr, nil: BaseRelativePointer]
RETURNS [
IO.Value] ~ {
ir: Table.IndexRep ~ LOOPHOLE[ptr];
IF ptr=nil THEN RETURN [[rope[IO.PutFR1["%gNIL", [rope[kind]] ]]]];
RETURN [[rope[IO.PutFR["(%x)%g%x", [cardinal[ir.tag]], [rope[kind]], [cardinal[LOOPHOLE[Untag[ptr]]]] ]]]]};
BitOrderName:
ARRAY Symbols.BitOrder
OF
LONG
STRING ~ [msBit: "msBit", lsBit: "lsBit"];
TransferModeName:
ARRAY Symbols.TransferMode
OF
LONG
STRING = [
proc: "proc", port: "port",
signal: "signal", error: "error",
process: "process", program: "program",
other: "otherXferMode", none: "noneXferMode"];
ExtensionTypeName:
ARRAY Symbols.ExtensionType
OF
LONG
STRING = [
value: "value", form: "form",
default: "default", none: "none"];
SpecialVarKindName:
ARRAY Symbols.SpecialVarKind[normal..extensionVar]
OF
LONG
STRING = [
normal: "normal", globalLink: "globalLink",
staticLink: "staticLink", frameExtension: "frameExtension",
memoryLink: "memoryLink", returnLink: "returnLink",
argLink: "argLink", returnVar: "returnVar",
argVar: "argVar", globalVar: "globalVar",
extensionVar: "extensionVar"];
ProcClassName:
ARRAY Symbols.ProcClass[Blank..Fork]
OF
LONG
STRING = [
Blank: "Blank", Outer: "Outer",
Inner: "Inner", Install: "Install",
Init: "Init", Catch: "Catch",
Scope: "Scope", Fork: "Fork"];
ClosureVal:
PROC [c: Symbols.Closure]
RETURNS [
IO.Value] ~ {
RETURN [SELECT c FROM none => [rope["none"]], unit => [rope["unit"]], rc => [rope["rc"]], full => [rope["full"]], ENDCASE => [cardinal[c.ORD]] ]};
PrintFiles:
PROC [stream:
STREAM, mob: MobDefs.MobBase] = {
nFiles: CARDINAL = (mob.ftLimit-FIRST[FTIndex])/SIZE[FTRecord];
IF nFiles
IN [1..1024]
THEN {
ftb: MobDefs.Base ¬ LOOPHOLE[mob + mob.ftOffset.units];
fti: MobDefs.FTIndex ¬ FIRST[FTIndex];
stream.PutF1["# files: %x\n", [integer[nFiles]]];
FOR fti ¬ FTIndex.
FIRST, fti+FTRecord.
SIZE
UNTIL fti = mob.ftLimit
DO
ftp: LONG POINTER TO FTRecord ¬ @ftb[fti];
stream.PutF["fti%x: %g",
[integer[LOOPHOLE[fti]]],
[rope[RopeForMobName[mob, ftp.name]]] ];
stream.PutRope[", version: "];
PrintCorrectlyVersion[ftp.version, stream];
stream.PutRope["\n"];
ENDLOOP;
};
};
PrintCorrectlyVersion:
PROC [vs: MobDefs.VersionStamp, to:
STREAM] = {
IO.PutF[to, "%08x%08x", [cardinal[vs[0]]], [cardinal[vs[1]]] ]};
InstallTable:
PROC [node:
LONG
POINTER]
RETURNS [SymbolTableBase] = {
b: LONG POINTER = node;
tB: SymbolSegment.Base = LOOPHOLE[b];
p: STHeader = b;
base: SymbolTableBase ¬ 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.opb ← tB + p.outerPackBlock.offset - SymbolSegment.biases[SymbolSegment.opType];
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];
};
NameForEntryIndex:
PROC [sth: SymbolTableBase, entryIndex:
CARDINAL]
RETURNS [name: Symbols.Name] = {
VisitBody:
PROC [bti: BTIndex]
RETURNS [
BOOL] = {
body: LONG POINTER TO BTRecord = @sth.bb[bti];
WITH b~~body
SELECT
FROM
Callable => {
IF ~b.inline
THEN {
IF b.entryIndex = entryIndex
THEN {
name ¬ SymbolOps.NameForSe[sth, b.id];
RETURN[TRUE];
};
};
};
ENDCASE => NULL;
RETURN [FALSE]};
name ¬ Symbols.nullName;
[] ¬ SymbolOps.EnumerateBodies[sth, RootBti, VisitBody];
};