KLister.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Sweet October 9, 1985 2:45:46 pm PDT
Russ Atkinson (RRA) June 25, 1986 3:28:56 pm PDT
Satterthwaite March 8, 1986 5:20:20 pm PST
DIRECTORY
Basics USING [bytesPerWord],
BcdDefs USING [BCD, FTIndex, FTRecord, MTIndex, MTNull, MTRecord, SGRecord, VersionID],
BcdLister USING [ListBcd],
CodeLister USING [ListCode, ListFGT],
Commander USING [CommandProc, Register],
CommandTool USING [Failed, ParseToList],
ConvertUnsafe USING [SubString],
FS,
FSBackdoor,
List USING [CompareProc, Sort],
Literals USING [LitDescriptor, LTIndex, LTNull, LTRecord, MSTIndex, STIndex, STNull],
ListerUtils USING [PrintIndex, PrintName, PrintSE, PrintSei, PrintTree, PrintVersion, ReadMtr, ReadSgr, ShortName],
ListRTBcd USING [PrintRTBcd],
IO USING [Close, EndOf, GetChar, GetLineRope, PutChar, PutF, PutF1, PutFR1, PutRope, RIS, RopeFromROS, ROS, SetIndex, STREAM, UnsafeGetBlock],
Rope USING [Compare, Concat, Equal, Fetch, Flatten, Length, Match, Replace, ROPE, SkipTo],
SortedSymbolLister USING [AddSymbols],
SymbolPack,
Symbols USING [BitAddress, BodyRecord, BTIndex, ContextLevel, CSEIndex, CTXIndex, CTXNull, CTXRecord, HTIndex, ISEIndex, ISENull, lZ, MDIndex, Name, nullName, RootBti, SEIndex, SENull, SERecord, TransferMode, TypeClass, typeTYPE],
SymbolTable USING [Acquire, Base, Release],
Tree USING [Index, Link, NodeName];
KLister: PROGRAM
IMPORTS BcdLister, CodeLister, Commander, CommandTool, FS, FSBackdoor, IO, List, ListerUtils, ListRTBcd, Rope, SortedSymbolLister, SymbolPack, SymbolTable
= BEGIN
T Y P E S & C O N S T A N T S
BCD: TYPE = BcdDefs.BCD;
BitAddress: TYPE = Symbols.BitAddress;
BTIndex: TYPE = Symbols.BTIndex;
BTRecord: TYPE = Symbols.BodyRecord;
bytesPerWord: NAT = Basics.bytesPerWord;
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;
FTIndex: TYPE = BcdDefs.FTIndex;
FTRecord: TYPE = BcdDefs.FTRecord;
HTIndex: TYPE = Symbols.HTIndex;
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;
MSTIndex: TYPE = Literals.MSTIndex;
MSTNull: MSTIndex = LOOPHOLE[STNull];
MTIndex: TYPE = BcdDefs.MTIndex;
MTNull: MTIndex = BcdDefs.MTNull;
MTRecord: TYPE = BcdDefs.MTRecord;
Name: TYPE = Symbols.Name;
nullName: Name = Symbols.nullName;
NodeName: TYPE = Tree.NodeName;
RefBCD: TYPE = REF BCD;
RefMTRecord: TYPE = REF MTRecord;
RefSGRecord: TYPE = REF SGRecord;
RootBti: BTIndex = Symbols.RootBti;
ROPE: TYPE = Rope.ROPE;
SEIndex: TYPE = Symbols.SEIndex;
SENull: SEIndex = Symbols.SENull;
SERecord: TYPE = Symbols.SERecord;
SGRecord: TYPE = BcdDefs.SGRecord;
STIndex: TYPE = Literals.STIndex;
STNull: STIndex = Literals.STNull;
STREAM: TYPE = IO.STREAM;
SubString: TYPE = ConvertUnsafe.SubString;
SymbolTableBase: TYPE = SymbolTable.Base;
TransferMode: TYPE = Symbols.TransferMode;
TypeClass: TYPE = Symbols.TypeClass;
Major procedures
UC: PROC [c: CHAR] RETURNS [CHAR] = {
RETURN [IF c IN ['a..'z] THEN 'A + (c - 'a) ELSE c];
};
ListSymbols: Commander.CommandProc = TRUSTED {
[cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
in: STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
tempName: ROPE;
combinedSymbols, totalFiles: LIST OF REF ANYNIL;
sortedSymbols: BOOL ← cmd.procData.clientData = $SortedSymbols OR cmd.procData.clientData = $SortedDefs;
stream: STREAMNIL;
inStream: STREAMNIL;
stb: SymbolTableBase ← NIL;
any: BOOLFALSE;
switches: PACKED ARRAY CHAR['A..'Z] OF BOOLALL[FALSE];
args: LIST OF ROPE ← CommandTool.ParseToList[cmd
! CommandTool.Failed => {msg ← errorMsg; GO TO failed}
].list;
Cleanup: PROC = {
IF stream # NIL AND stream # cmd.out THEN stream.Close[];
IF inStream # NIL THEN inStream.Close[];
IF stb # NIL THEN {SymbolTable.Release[stb]; stb ← NIL}};
IsInCache: PROC [name: ROPE] RETURNS [present: BOOLFALSE] = {
noteName: FSBackdoor.NameProc = TRUSTED {
[fullGName: ROPE] RETURNS [continue: BOOLEAN]
present ← TRUE;
continue ← FALSE};
FSBackdoor.EnumerateCacheForNames[proc: noteName, pattern: name]};
EachName: FS.NameProc = TRUSTED {
[fullFName: ROPE] RETURNS [continue: BOOL]
IF IsInCache[fullFName] THEN tempName ← fullFName
ELSE
tempName ← FS.Copy[from: fullFName, to: "///Temp/Lister.temp$", setKeep: TRUE, keep: 6, remoteCheck: FALSE
! FS.Error => {msg ← error.explanation; GO TO failed}
];
inStream ← FS.StreamOpen[fileName: tempName, remoteCheck: FALSE, streamOptions: [FALSE, TRUE, TRUE, TRUE, TRUE]
! FS.Error => {msg ← error.explanation; GO TO failed}
];
{ENABLE UNWIND => Cleanup[];
short: ROPE = ListerUtils.ShortName[fullFName];
bcd: RefBCD ← NEW[BCD];
ext: ROPENIL;
outName: ROPENIL;
configOk: BOOLFALSE;
defsOK: BOOLFALSE;
file: FS.OpenFile ← FS.OpenFileFromStream[inStream];
[] ← inStream.UnsafeGetBlock[
[base: LOOPHOLE[bcd], startIndex: 0, count: SIZE[BCD]*bytesPerWord]];
IF switches['M] AND (bcd.nConfigs # 0 OR bcd.definitions) THEN GO TO processNext;
SELECT cmd.procData.clientData FROM
$Bcd, $ShortBcd => {ext ← ".bcdList"; configOk ← TRUE; defsOK ← TRUE};
$Bodies => ext ← ".bodyList";
$Code => ext ← ".codeList";
$Exports => {ext ← ".exportsList"; configOk ← TRUE};
$FGT => ext ← ".fgtList";
$Files => {ext ← ".filesList"; configOk ← TRUE; defsOK ← TRUE};
$Globals => {ext ← ".globalFramesList"; configOk ← TRUE};
$RTBcd => {ext ← ".rtBcdList"; configOk ← TRUE};
$Symbols => {ext ← ".symbolList"; defsOK ← TRUE};
$Unbound => {ext ← NIL; configOk ← TRUE};
$Using => {ext ← ".usingList"; defsOK ← TRUE};
$SortedSymbols, $SortedDefs => {ext ← NIL; defsOK ← TRUE};
ENDCASE => ext ← ".list";
IF ext # NIL THEN {
SELECT TRUE FROM
switches['C] => ext ← NIL;
Rope.Match["*.bcd", short, FALSE] =>
outName ← short.Replace[short.Length[]-4, 4, ext];
ENDCASE => outName ← short.Concat[ext];
};
SELECT TRUE FROM
bcd.versionIdent # BcdDefs.VersionID =>
(cmd.out).PutF1["Not a valid Cedar bcd file: %g\n", [rope[short]]];
bcd.nConfigs # 0 AND ~configOk =>
(cmd.out).PutF1["Bound configurations not supported: %g\n", [rope[short]]];
bcd.definitions AND NOT defsOK =>
(cmd.out).PutF1["Definitions files not supported: %g\n", [rope[short]]];
ENDCASE => {
sourceName: ROPENIL;
IF bcd.nConfigs = 0 THEN {
Now we have a single-module file.
Get the module.
mtr: RefMTRecord = ListerUtils.ReadMtr[inStream, bcd, LOOPHOLE[0]];
sgr: RefSGRecord = ListerUtils.ReadSgr[inStream, bcd, mtr.sseg];
pages: CARDINAL =
IF bcd.extended THEN sgr.pages+sgr.extraPages ELSE sgr.pages;
IF pages = 0 THEN {
(cmd.out).PutF1["Error - no symbols from %g\n", [rope[fullFName]]];
result ← $Failure;
GO TO bailOut;
};
stb ← SymbolTable.Acquire[[file, [sgr.base-1, pages]]]};
Get the source fullFName for later
sourceName ← RopeForBcdName[inStream, bcd.ssOffset, bcd.source];
Open the output stream (if any)
IF ext = NIL THEN {
stream ← cmd.out;
(cmd.out).PutF1["Listing for %g\n", [rope[fullFName]] ]}
ELSE {
(cmd.out).PutF[
"%g output to %g\n", [rope[cmd.command]], [rope[outName]]];
stream ← FS.StreamOpen[outName, $create];
stream.PutRope[outName]};
IF sortedSymbols THEN {
IF ~bcd.definitions AND cmd.procData.clientData = $SortedDefs THEN GO TO bailOut;
totalFiles ← CONS[short, totalFiles]}
ELSE {
stream.PutF1["\n object: %g {", [rope[short]]];
ListerUtils.PrintVersion[bcd.version, stream];
stream.PutRope["}\n source: "];
stream.PutRope[sourceName];
stream.PutRope[" {"];
ListerUtils.PrintVersion[bcd.sourceVersion, stream, TRUE];
stream.PutRope["}\n creator: {"];
ListerUtils.PrintVersion[bcd.creator, stream];
stream.PutRope["}\n\n"]};
SELECT cmd.procData.clientData FROM
$Bcd => BcdLister.ListBcd[stream, inStream, bcd, $Bcd];
$Bodies => PrintBodies[stream, stb];
$Code => CodeLister.ListCode[stream, inStream, stb, bcd, NIL];
$Exports => BcdLister.ListBcd[stream, inStream, bcd, $Exports];
$FGT => CodeLister.ListFGT[stream, inStream, stb, bcd];
$Files => PrintFiles[stream, bcd, fullFName];
$Globals => BcdLister.ListBcd[stream, inStream, bcd, $Globals];
$RTBcd => ListRTBcd.PrintRTBcd[stream, inStream, bcd];
$Symbols => PrintSymbols[bcd.definitions, stream, stb];
$Unbound => BcdLister.ListBcd[stream, inStream, bcd, $Unbound];
$SortedSymbols, $SortedDefs => combinedSymbols ← SortedSymbolLister.AddSymbols[rList: combinedSymbols, stb: stb];
$Using => PrintUsing[stream, stb];
ENDCASE;
EXITS bailOut => {};
};
Cleanup[];
continue ← TRUE;
EXITS processNext => continue ← TRUE;
};
EXITS failed => {result ← $Failed; Cleanup[]; continue ← FALSE};
};
IF sortedSymbols THEN
(cmd.out).PutRope["Combined symbols listing to Symbols.sort\n"];
WHILE args # NIL DO
name ← args.first;
args ← args.rest;
SELECT TRUE FROM
Rope.Match["-*", name] => {
sense: BOOLTRUE;
num: INT ← 0;
FOR i: INT IN [1..name.Length[]) DO
c: CHAR ← name.Fetch[i];
SELECT c FROM
IN ['A..'Z] => switches[c] ← sense;
IN ['a..'z] => switches[c-('a-'A)] ← sense;
IN ['0..'9] => num ← num * 10 + (c - '0);
'~ => sense ← NOT sense;
ENDCASE;
ENDLOOP;
LOOP;
};
Rope.Match["*.bcd", name, FALSE], Rope.Match["*.bcd!*", name, FALSE] => {};
ENDCASE => name ← name.Concat[".bcd"];
any ← TRUE;
name ← FS.ExpandName[name
! FS.Error => {msg ← error.explanation; GO TO failed};
].fullFName;
IF NOT Rope.Match["*!*", name] THEN name ← name.Concat["!h"];
FS.EnumerateForNames[name, EachName];
IF result # NIL THEN GO TO failed;
ENDLOOP;
IF sortedSymbols THEN {
lastChar: CHAR ← 0C;
CompareCaseless: List.CompareProc = TRUSTED {
[ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison]
r1: ROPE = NARROW[ref1];
r2: ROPE = NARROW[ref2];
RETURN [r1.Compare[r2, FALSE]]};
totalFiles ← List.Sort[totalFiles, CompareCaseless];
stream ← FS.StreamOpen["Symbols.sort", $create];
stream.PutRope["Combined symbols for: "];
WHILE totalFiles # NIL DO
stream.PutF1["%g ", [rope[NARROW[totalFiles.first]]]];
totalFiles ← totalFiles.rest;
ENDLOOP;
stream.PutRope["\n\n"];
combinedSymbols ← List.Sort[combinedSymbols, CompareCaseless];
WHILE combinedSymbols # NIL DO
line: ROPE;
entry: ROPE = NARROW[combinedSymbols.first];
ch: CHARUC[entry.Fetch[0]];
ris: IO.STREAMIO.RIS[entry];
IF ch # lastChar THEN {stream.PutF1["--%g\n", [character[ch]]]; lastChar ← ch};
WHILE ~ris.EndOf[] DO
line ← ris.GetLineRope[];
stream.PutF1[" %g\n", [rope[line]]];
ENDLOOP;
combinedSymbols ← combinedSymbols.rest;
ENDLOOP;
stream.Close[]};
IF NOT any THEN {
result ← $Failure;
msg ← IO.PutFR1["Usage: %g file ...", [rope[cmd.command]]]};
EXITS failed => result ← $Failure;
};
PrintBodies: PUBLIC PROC [stream: STREAM, stb: SymbolTableBase] = {
PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = {
body: LONG POINTER TO BTRecord = @stb.bb[bti];
stream.PutRope["Body: "];
WITH b~~body SELECT FROM
Callable => {
ListerUtils.PrintSei[b.id, stream, stb];
IF b.inline THEN stream.PutRope[" [inline]"]
ELSE {
stream.PutF1[", ep: %g", [cardinal[b.entryIndex]]];
WITH b SELECT FROM
Inner => stream.PutF1[", frame addr: %g", [cardinal[frameOffset]]];
ENDCASE;
};
stream.PutRope[", attrs: "];
stream.PutChar[IF ~b.noXfers THEN 'x ELSE '-];
stream.PutChar[IF b.hints.safe THEN 's ELSE '-];
stream.PutChar[IF b.hints.nameSafe THEN 'n ELSE '-];
IF ~b.hints.noStrings THEN stream.PutRope["\n string literals"]};
ENDCASE => stream.PutRope["(anon)"];
stream.PutRope["\n context: "];
ListerUtils.PrintIndex[body.localCtx, stream];
stream.PutF1[", level: %g", [cardinal[body.level]]];
WITH body.info SELECT FROM
Internal => {
stream.PutF1[", frame size: %g", [cardinal[frameSize]]];
IF body.kind = Callable THEN
ListerUtils.PrintTree[[subtree[index: bodyTree]], 0, stream, stb]
ELSE {stream.PutRope[", tree root: "]; ListerUtils.PrintIndex[bodyTree, stream]}};
ENDCASE;
stream.PutRope["\n\n"];
RETURN [FALSE]};
[] ← stb.EnumerateBodies[RootBti, PrintBody];
stream.PutRope["\n"];
};
PrintGlobalFrames: PUBLIC PROC [stream: STREAM, stb: SymbolTableBase] = {
PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = {
body: LONG POINTER TO BTRecord = @stb.bb[bti];
stream.PutRope["Body: "];
WITH b~~body SELECT FROM
Callable => {
ListerUtils.PrintSei[b.id, stream, stb];
IF b.inline THEN stream.PutRope[" [inline]"]
ELSE {
stream.PutF1[", ep: %g", [cardinal[b.entryIndex]]];
WITH b SELECT FROM
Inner => stream.PutF1[", frame addr: %g", [cardinal[frameOffset]]];
ENDCASE;
};
stream.PutRope[", attrs: "];
stream.PutChar[IF ~b.noXfers THEN 'x ELSE '-];
stream.PutChar[IF b.hints.safe THEN 's ELSE '-];
stream.PutChar[IF b.hints.nameSafe THEN 'n ELSE '-];
IF ~b.hints.noStrings THEN stream.PutRope["\n string literals"]};
ENDCASE => RETURN [FALSE];
stream.PutRope["\n context: "];
ListerUtils.PrintIndex[body.localCtx, stream];
stream.PutF1[", level: %g", [cardinal[body.level]]];
WITH body.info SELECT FROM
Internal => {
stream.PutF1[", frame size: %g", [cardinal[frameSize]]];
IF body.kind = Callable THEN
ListerUtils.PrintTree[[subtree[index: bodyTree]], 0, stream, stb]
ELSE {stream.PutRope[", tree root: "]; ListerUtils.PrintIndex[bodyTree, stream]}};
ENDCASE;
stream.PutRope["\n\n"];
RETURN [FALSE]};
[] ← stb.EnumerateBodies[RootBti, PrintBody];
stream.PutRope["\n"];
};
PrintSymbols: PUBLIC PROC [definitions: BOOL, stream: STREAM, stb: SymbolTableBase] = {
ctx: CTXIndex;
limit: CTXIndex;
limit ← LOOPHOLE[stb.stHandle.ctxBlock.size];
ctx ← CTXIndex.FIRST + CTXRecord.nil.SIZE;
UNTIL ctx = limit DO
PrintContext[ctx, definitions, stream, stb];
stream.PutRope["\n\n"];
ctx ← ctx + (WITH stb.ctxb[ctx] SELECT FROM
included => CTXRecord.included.SIZE,
imported => CTXRecord.imported.SIZE,
ENDCASE => CTXRecord.simple.SIZE);
ENDLOOP;
stream.PutRope["\n"];
};
PrintContext: PROC [ctx: CTXIndex, definitionsOnly: BOOL, stream: STREAM, stb: SymbolTableBase] = {
sei, root: ISEIndex;
cp: LONG POINTER TO CTXRecord = @stb.ctxb[ctx];
stream.PutRope["Context: "];
ListerUtils.PrintIndex[ctx, stream];
IF stb.ctxb[ctx].level # lZ THEN stream.PutF1[", level: %g", [cardinal[cp.level]]];
WITH c~~cp SELECT FROM
included => {
stream.PutRope[", copied from: "];
ListerUtils.PrintName[stb.mdb[c.module].moduleId, stream, stb];
stream.PutRope[" ["];
ListerUtils.PrintName[stb.mdb[c.module].fileId, stream, stb];
stream.PutRope[", "];
ListerUtils.PrintVersion[stb.mdb[c.module].stamp, stream];
stream.PutRope["], context: "];
ListerUtils.PrintIndex[c.map, stream]};
imported => {
stream.PutRope[", imported from: "];
ListerUtils.PrintName[stb.mdb[stb.ctxb[c.includeLink].module].moduleId, stream, stb]};
ENDCASE;
root ← sei ← stb.ctxb[ctx].seList;
DO
IF sei = SENull THEN EXIT;
ListerUtils.PrintSE[sei, 2, definitionsOnly , stream, stb];
IF (sei ← stb.NextSe[sei]) = root THEN EXIT;
ENDLOOP;
};
PrintUsing: PROC [stream: STREAM, stb: SymbolTableBase] = {
limit: CTXIndex = LOOPHOLE[stb.stHandle.ctxBlock.size];
ctx: CTXIndex ← CTXIndex.FIRST + CTXRecord.nil.SIZE;
firstUsing: BOOLTRUE;
pairs: LIST OF Pair ← NIL;
ros: STREAMIO.ROS[];
firstCopiedHash: Symbols.HTIndex;
InDirectory: PROC [ctx: CTXIndex] RETURNS [BOOL] = {
FOR dirSei: ISEIndex
← stb.FirstCtxSe[stb.stHandle.directoryCtx], stb.NextSe[dirSei] UNTIL dirSei = ISENull DO
WITH se~~stb.seb[stb.UnderType[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: ROPENIL;
mdi: MDIndex;
DoSei: PROC [sei: ISEIndex] = {
sep: LONG POINTER TO ISERecord = @stb.seb[sei];
IF sep.hash < firstCopiedHash THEN {
name: ROPENIL;
IF sep.idType = typeTYPE THEN {
typeSei: SEIndex ← 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];
ListerUtils.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];
ListerUtils.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: ROPENIL;
ros ← IO.ROS[ros];
ListerUtils.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 ← stb.NextSe[sei]) = root THEN EXIT;
ENDLOOP;
};
};
FOR hti: HTIndex IN (0..LENGTH[stb.ht]) DO
IF stb.ht[hti].ssIndex = stb.ht[hti - 1].ssIndex THEN {
firstCopiedHash ← hti; EXIT};
REPEAT FINISHED => firstCopiedHash ← LENGTH[stb.ht];
ENDLOOP;
FOR dirSei: ISEIndex
← stb.FirstCtxSe[stb.stHandle.directoryCtx], stb.NextSe[dirSei] UNTIL dirSei = ISENull DO
WITH se~~stb.seb[stb.UnderType[stb.seb[dirSei].idType]] SELECT FROM
definition => DoContext[se.defCtx];
ENDCASE;
ENDLOOP;
FOR dirSei: ISEIndex
← stb.FirstCtxSe[stb.stHandle.importCtx], stb.NextSe[dirSei] UNTIL dirSei = ISENull DO
WITH se~~stb.seb[stb.UnderType[stb.seb[dirSei].idType]] SELECT FROM
definition => DoContext[se.defCtx];
transfer => {
bti: BTIndex = 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 stream.PutRope["No DIRECTORY.\n"]
ELSE {
stream.PutRope["DIRECTORY\n"];
WHILE pairs # NIL DO
pair: Pair = pairs.first;
names: LIST OF ROPE ← pair.names;
stream.PutRope[" "];
stream.PutRope[pair.key];
IF NOT (pair.key).Equal[pair.file, FALSE] THEN {
stream.PutF1[": FROM \"%g\"", [rope[pair.file]]]};
stream.PutRope[" USING ["];
WHILE names # NIL DO
stream.PutRope[names.first];
IF names.rest # NIL THEN stream.PutRope[", "];
names ← names.rest;
ENDLOOP;
stream.PutRope[IF pairs.rest # NIL THEN "],\n" ELSE "];\n"];
pairs ← pairs.rest;
ENDLOOP;
};
};
PrintFiles: PROC [stream: STREAM, bcd: RefBCD, fileName: ROPE] = {
FTRSeq: TYPE = RECORD [SEQUENCE len: NAT OF FTRecord];
nFiles: CARDINAL = (bcd.ftLimit-FIRST[FTIndex])/SIZE[FTRecord];
IF nFiles IN [1..1024] THEN {
bytes: CARDINAL = nFiles*SIZE[FTRecord]*bytesPerWord;
fileSeq: REF FTRSeq = NEW[FTRSeq[nFiles]];
ftp: LONG POINTER TO FTRecord ← @fileSeq[0];
inStream: STREAM = FS.StreamOpen[fileName, $read];
fti: CARDINAL = LOOPHOLE[FIRST[FTIndex]];
stream.PutF1["# files: %g\n\n", [integer[nFiles]]];
inStream.SetIndex[(fti+bcd.ftOffset)*bytesPerWord];
[] ← inStream.UnsafeGetBlock[
[base: LOOPHOLE[@fileSeq[0]], startIndex: 0, count: bytes]];
FOR i: NAT IN [0..nFiles) DO
stream.PutF["%g - fti: %g",
[rope[RopeForBcdName[inStream, bcd.ssOffset, ftp.name]]],
[integer[i*SIZE[FTRecord]]]];
stream.PutRope[", version: "];
ListerUtils.PrintVersion[ftp.version, stream];
stream.PutRope["\n"];
ftp ← ftp + SIZE[FTRecord];
ENDLOOP;
inStream.Close[];
};
};
Utility procedures
RopeForBcdName: PROC [inStream: STREAM, base: CARDINAL, index: CARDINAL] RETURNS [ROPE] = {
ros: STREAM = IO.ROS[];
inStream.SetIndex[base*bytesPerWord+index+3];
THROUGH [0..inStream.GetChar[]-0C) DO ros.PutChar[inStream.GetChar[]]; ENDLOOP;
RETURN [ros.RopeFromROS[]];
};
Pair: TYPE = RECORD [key: ROPE, file: ROPE, names: LIST OF ROPE];
FindList: PROC [key: ROPE, base: LIST OF Pair] RETURNS [which,newBase: LIST OF Pair ← NIL] = {
If no such named list is found, one is created and inserted into the base.
newBase ← base;
WHILE which = NIL DO
FOR each: LIST OF Pair ← newBase, each.rest WHILE each # NIL DO
IF key.Equal[each.first.key] THEN {which ← each; RETURN};
ENDLOOP;
newBase ← InsertPair[[key, NIL, NIL], newBase];
ENDLOOP;
};
InsertName: PROC [rope: ROPE, list: LIST OF ROPE] RETURNS [LIST OF ROPE] = {
lag: LIST OF ROPENIL;
FOR each: LIST OF ROPE ← list, each.rest WHILE each # NIL DO
SELECT rope.Compare[each.first, FALSE] FROM
$less => EXIT;
$equal =>
SELECT rope.Compare[each.first, TRUE] FROM
$less => EXIT;
$equal => RETURN [list];
$greater => {};
ENDCASE;
$greater => {};
ENDCASE => ERROR;
lag ← each;
ENDLOOP;
IF lag = NIL THEN RETURN [CONS[rope, list]]
ELSE {lag.rest ← CONS[rope, lag.rest]; RETURN [list]}};
InsertPair: PROC [pair: Pair, list: LIST OF Pair] RETURNS [LIST OF Pair] = {
lag: LIST OF Pair ← NIL;
key: ROPE ← pair.key;
FOR each: LIST OF Pair ← list, each.rest WHILE each # NIL DO
SELECT key.Compare[each.first.key, FALSE] FROM
$less => EXIT;
$equal =>
SELECT key.Compare[each.first.key, TRUE] FROM
$less => EXIT;
$equal => RETURN [list];
$greater => {};
ENDCASE;
$greater => {};
ENDCASE => ERROR;
lag ← each;
ENDLOOP;
IF lag = NIL
THEN RETURN [CONS[pair, list]]
ELSE {lag.rest ← CONS[pair, lag.rest]; RETURN [list]};
};
I N I T
Commander.Register[
"BcdLister", ListSymbols,
"List the contents of a bcd file.", $Bcd];
Commander.Register[
"BodyLister", ListSymbols,
"List the bodies for a bcd file.", $Bodies];
Commander.Register[
"CodeLister", ListSymbols,
"List the code for a bcd file.", $Code];
Commander.Register[
"ExportsLister", ListSymbols,
"List the exports for a bcd file.", $Exports];
Commander.Register[
"FGTLister", ListSymbols,
"List the fine grain table for a bcd file.", $FGT];
Commander.Register[
"FilesLister", ListSymbols,
"List the items used by a bcd file.", $Files];
Commander.Register[
"GlobalFramesLister", ListSymbols,
"List the global frames for a bcd file.", $Globals];
Commander.Register[
"ShortBcdLister", ListSymbols,
"List the symbols (no links) for a bcd file.", $ShortBcd];
Commander.Register[
"SymbolLister", ListSymbols,
"List the symbols for a bcd file.", $Symbols];
Commander.Register[
"RTBcdLister", ListSymbols,
"List the symbols for a bcd file.", $RTBcd];
Commander.Register[
"UnboundLister", ListSymbols,
"List the items used by a bcd file.", $Unbound];
Commander.Register[
"UsingLister", ListSymbols,
"List the items used by a bcd file.", $Using];
Commander.Register[
"SortedSymbolLister", ListSymbols,
"Produce a sorted list of all symbols in a collection of files (writes Symbols.sorted)", $SortedSymbols];
Commander.Register[
"SortedDefsLister", ListSymbols,
"Produce a sorted list of all symbols in the defs files of a collection of files (writes Symbols.sorted)", $SortedDefs];
END.