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


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;

UC: PROC [c: CHAR] RETURNS [CHAR] = {
RETURN [IF c IN ['a..'z] THEN 'A + (c - 'a) ELSE c];
};

ListSymbols: Commander.CommandProc = TRUSTED {
in: STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
tempName: ROPE;
combinedSymbols, totalFiles: LIST OF REF ANY _ NIL;
sortedSymbols: BOOL _ cmd.procData.clientData = $SortedSymbols OR cmd.procData.clientData = $SortedDefs;
stream: STREAM _ NIL;
inStream: STREAM _ NIL;
stb: SymbolTableBase _ NIL;
any: BOOL _ FALSE;
switches: PACKED ARRAY CHAR['A..'Z] OF BOOL _ ALL[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: BOOL _ FALSE] = {
noteName: FSBackdoor.NameProc = TRUSTED {
present _ TRUE;
continue _ FALSE};
FSBackdoor.EnumerateCacheForNames[proc: noteName, pattern: name]};
EachName: FS.NameProc = TRUSTED {
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: ROPE _ NIL;
outName: ROPE _ NIL;
configOk: BOOL _ FALSE;
defsOK: BOOL _ FALSE;
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: ROPE _ NIL;
IF bcd.nConfigs = 0 THEN {
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]]]};
sourceName _ RopeForBcdName[inStream, bcd.ssOffset, bcd.source];
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: BOOL _ TRUE;
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 {
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: CHAR _ UC[entry.Fetch[0]];
ris: IO.STREAM _ IO.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: BOOL _ TRUE;
pairs: LIST OF Pair _ NIL;
ros: STREAM _ IO.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: ROPE _ NIL;
mdi: MDIndex;
DoSei: PROC [sei: ISEIndex] = {
sep: LONG POINTER TO ISERecord = @stb.seb[sei];
IF sep.hash < firstCopiedHash THEN {
name: ROPE _ NIL;
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;

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 {
modFileName: ROPE _ NIL;
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;
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[];
};
};


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] = {
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 ROPE _ NIL;
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]};
};


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.




KLister.mesa
Copyright c 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
T Y P E S  &  C O N S T A N T S
Major procedures

[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
[fullGName: ROPE] RETURNS [continue: BOOLEAN]
[fullFName: ROPE] RETURNS [continue: BOOL]
Now we have a single-module file.
Get the module.
Get the source fullFName for later

Open the output stream (if any)
[ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison]
Get the module name
Get the module file name
At this point all of the entries have been made.
Utility procedures
If no such named list is found, one is created and inserted into the base.
I N I T
Κt˜
codeš
œ™Kšœ
Οm
œ1™<K™$K™0K™*K˜—š
Οk	˜	Kšœžœ˜KšœžœžœE˜WKšœ
žœ˜Kšœžœ˜%Kšœ
žœ˜(Kšœžœ˜(Kšœžœ
˜ Kšžœ
˜Kš
œ˜Kšœžœ˜Kšœ	žœG˜UKšœžœb˜sKšœ
žœ˜Kš
žœ
žœMžœžœžœ˜Ž
KšœžœBžœ
˜ZKšœžœ˜&Kš
œ˜KšœžœΩ
˜ζ
Kšœžœ˜+Kšœžœ˜#—
headšœ	ž˜Kšžœ0žœžœQ˜š
Kšœž˜—K˜š
œ™K˜Kšžœžœžœ
˜Kšœžœ˜&Kšœ	žœ˜ Kšœ
žœ˜$Kšœžœ˜(šœ
žœ˜"Kš
œ&˜&—šœžœ˜*Kš
œ˜—šœ
žœ˜"Kš
œ$˜$—Kšœžœ˜$Kšœ	žœ˜ Kšœ
žœ˜"Kšœ	žœ˜ šœ
žœ˜"Kš
œ$˜$—Kšœžœ˜šœ	žœ˜!Kš
œ"˜"—Kšœ
žœ˜#Kšœžœ˜-Kšœ	žœ˜ šœ
žœ˜#Kšœžœ	˜%—šœ	žœ˜ Kš
œ!˜!—Kšœ
žœ˜"šœžœ˜Kš
œ"˜"—Kšœ
žœ˜Kšœžœžœ
žœ
˜Kšœ
žœžœ
˜!Kšœ
žœžœ
˜!Kš
œ#˜#Kšžœžœžœ
˜šœ	žœ˜ Kš
œ!˜!—Kšœ
žœ˜"Kšœ
žœ˜"šœ	žœ˜!Kš
œ"˜"—Kšžœžœžœ
žœ
˜Kšœžœ˜*Kšœžœ˜)Kšœžœ˜*Kšœžœ˜$K˜—Kš
œ™™š
žœžœžœžœžœ˜%Kš
žœžœžœ
žœžœ˜4Kš
œ˜—K˜šœ%žœ˜.Kšœžœ
žœžœžœžœ
™:Kšœžœžœ
žœ˜%Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
žœ
žœ
žœžœ
˜3Kšœžœ,žœ'˜hKšœžœžœ
˜Kšœ
žœžœ
˜Kšœžœ
˜Kšœžœžœ
˜Kšœ
žœ
žœ
žœ	žœ
žœžœ
žœ˜9šœžœ
žœ
žœ˜0Kšœ)žœ
žœ˜6Kš
œ˜—šΟnœžœ˜Kšžœ
žœ
žœžœ˜9Kšžœžœ
žœ˜(Kšžœžœ
žœ"žœ˜9—šŸ	œžœžœžœžœžœ˜@•StartOfExpansion1 -- [fullGName: ROPE] RETURNS [continue: BOOLEAN]šœ žœ˜)KšΠckžœ ™-Kšœ
žœ
˜Kšœžœ˜—Kš
œB˜B—–. -- [fullFName: ROPE] RETURNS [continue: BOOL]šœ
žœžœ˜!Kš žœ ™*Kšžœžœ˜1š
ž˜šœžœ<žœž˜jKšœžœ$žœ
žœ˜5Kš
œ˜——šœžœ-žœžœžœžœžœžœ
˜oKšœžœ$žœ
žœ˜5Kš
œ˜—šœ
žœ
žœ˜Kšœžœ$˜/Kšœžœ
žœ˜Kšœžœžœ
˜Kšœ	žœžœ
˜Kšœ
žœžœ
˜Kšœžœžœ
˜Kšœžœžœ˜4š
œ˜Kšœžœžœ
žœ˜E—Kšžœžœžœžœ
žœ
žœ
˜Qšžœž˜#Kšœ1žœžœ˜FKš
œ˜Kš
œ˜Kšœ.žœ˜4Kš
œ˜Kšœ*žœžœ˜?Kšœ3žœ˜9Kšœ*žœ˜0Kšœ+žœ˜1Kšœžœ
žœ˜)Kšœ(žœ˜.Kšœ&žœžœ˜:Kšžœ˜—šžœžœ
žœ˜šžœ
žœ
ž˜Kšœžœ
˜šœžœ˜$Kš
œ2˜2—Kšžœ ˜'—K˜—šžœ
žœ
ž˜˜'Kš
œC˜C—šœžœ
˜!Kš
œK˜K—šœžœ
žœ
˜!Kš
œH˜H—šžœ˜Kšœžœžœ
˜šžœžœ˜Kš
œ!™!Kš
œ™Kšœ6žœ˜CKš
œ@˜@šœžœ˜Kšžœžœžœ˜=—šžœžœ˜Kš
œC˜CKš
œ˜Kšžœ
žœ	˜K˜—Kš
œ8˜8—Kš
œ"™"Kš
œ@˜@K™Kš
œ™šžœžœ
žœ˜K˜Kš
œ8˜8—šžœ˜š
œ˜Kš
œ;˜;—Kšœ	žœ˜)Kš
œ˜—šžœžœ˜Kš
žœžœ'žœ
žœ
žœ	˜QKšœ
žœ˜%—šžœ˜Kš
œ0˜0Kš
œ.˜.Kš
œ ˜ Kš
œ˜Kš
œ˜Kšœ4žœ˜:Kš
œ"˜"Kš
œ.˜.Kš
œ˜—šžœž˜#Kš
œ7˜7Kš
œ$˜$Kšœ9žœ˜>Kš
œ?˜?Kš
œ7˜7Kš
œ-˜-Kš
œ?˜?Kš
œ6˜6Kš
œ7˜7Kš
œ?˜?Kš
œq˜qKš
œ"˜"Kšžœ
˜—Kšžœ˜K˜——Kš
œ
˜
Kšœžœ
˜Kšžœžœ
˜%Kš
œ˜—Kšžœ4žœ˜@K˜—šžœžœ
˜Kš
œ@˜@—šžœžœ
ž˜Kš
œ˜Kš
œ˜šžœ
žœ
ž˜š
œ˜Kšœžœžœ
˜Kšœžœ˜
šžœžœ
žœž˜#Kšœžœ˜šžœž˜
Kšžœ!˜#Kšžœ)˜+Kšžœ'˜)Kšœžœ˜Kšžœ
˜—Kšžœ
˜—Kšžœ
˜K˜—Kšœžœžœ˜KKšžœ˜&—Kšœžœ
˜šœžœ˜Kšœžœ$žœ
žœ	˜6Kš
œ˜—Kšžœ
žœžœ˜=Kšžœ#˜%Kš
žœ
žœ
žœ
žœ
žœ˜"Kšžœ
˜—šžœžœ˜Kšœ
žœ˜–> -- [ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison]šœ$žœ˜-Kš žœ ™:Kšœžœžœ˜Kšœžœžœ˜Kšžœžœ˜!—Kš
œ4˜4Kšœ	žœ%˜0Kš
œ)˜)šžœžœ
ž˜Kšœžœ˜6Kš
œ˜Kšžœ
˜—Kš
œ˜Kš
œ>˜>šžœžœ
ž˜Kšœžœ
˜Kšœžœžœ˜,Kšœžœžœ˜Kš	œžœ
žœžœ
žœ˜Kšžœžœ:˜Ošžœž˜Kš
œ˜Kš
œ%˜%Kšžœ
˜—Kš
œ'˜'Kšžœ
˜—Kš
œ˜—šžœ
žœžœ˜Kš
œ˜Kšœžœ4˜<—Kšžœ˜"K˜K˜—šŸœžœ
žœ
žœ˜CšŸ	œžœžœžœ˜1Kšœžœ
žœ
žœ˜.Kš
œ˜šžœ	žœ
ž˜˜
Kš
œ(˜(Kšžœ
žœ˜,šžœ˜Kš
œ3˜3šžœžœ
ž˜Kš
œC˜CKšžœ
˜—Kš
œ˜—Kš
œ˜Kšœžœžœžœ˜.Kšœžœžœžœ˜0Kšœžœžœžœ˜4Kšžœžœ(˜B—Kšžœ˜$—Kš
œ ˜ Kš
œ.˜.Kš
œ4˜4šžœžœ
ž˜˜
Kš
œ8˜8šžœž˜Kš
œA˜A—KšžœN˜R—Kšžœ
˜—Kš
œ˜Kšžœžœ˜—Kš
œ-˜-Kš
œ˜Kš
œ˜K˜—šŸœžœ
žœ
žœ˜IšŸ	œžœžœžœ˜1Kšœžœ
žœ
žœ˜.Kš
œ˜šžœ	žœ
ž˜˜
Kš
œ(˜(Kšžœ
žœ˜,šžœ˜Kš
œ3˜3šžœžœ
ž˜Kš
œC˜CKšžœ
˜—Kš
œ˜—Kš
œ˜Kšœžœžœžœ˜.Kšœžœžœžœ˜0Kšœžœžœžœ˜4Kšžœžœ(˜B—Kšžœžœžœ˜—Kš
œ ˜ Kš
œ.˜.Kš
œ4˜4šžœžœ
ž˜˜
Kš
œ8˜8šžœž˜Kš
œA˜A—KšžœN˜R—Kšžœ
˜—Kš
œ˜Kšžœžœ˜—Kš
œ-˜-Kš
œ˜Kš
œ˜K˜—š
Ÿœžœ
žœžœ
žœ˜WK˜K˜Kšœžœ˜-Kšœžœžœ
˜*šžœ
ž˜K˜,Kš
œ˜šœ
žœžœ
ž˜+Kšœžœ
˜$Kšœžœ
˜$Kšžœžœ˜"—Kšžœ
˜—Kš
œ˜Kš
œ˜K˜—šŸœžœ"žœ
žœ˜cK˜Kšœžœ
žœ
žœ˜/Kš
œ˜Kš
œ$˜$Kšžœžœ3˜Sšžœžœ
ž˜˜
Kš
œ"˜"Kš
œ?˜?Kš
œ˜Kš
œ=˜=Kš
œ˜Kš
œ:˜:Kš
œ˜Kš
œ'˜'—˜
Kš
œ$˜$Kš
œV˜V—Kšžœ
˜—K˜"š
ž˜Kšžœžœ
žœ
˜Kš
œ;˜;Kšžœ žœ
žœ
˜,Kšžœ
˜—Kš
œ˜K˜—šŸ
œžœ
žœ˜;Kšœžœ˜7Kšœžœžœ
˜4Kšœžœžœ
˜Kšœžœ
žœžœ
˜Kšœžœžœ
žœ˜K˜!šŸœžœžœžœ˜4šžœ˜Kšœ@žœž˜Yšžœ4žœ
ž˜CKš	œžœžœ
žœžœ˜4Kšžœ
˜—Kšžœ
˜—Kšžœžœ˜—šŸ	œžœ˜#šžœžœ˜Kš
œ˜Kšœžœ
žœ
žœ˜/Kšœžœ
žœžœ
˜Kšœžœžœ
˜K˜
šŸœžœ˜Kšœžœ
žœ
žœ˜/šžœžœ˜$Kšœžœžœ
˜šžœžœ˜K˜šžœžœ
ž˜&˜Kšžœžœžœ
žœ˜;—Kšžœ
˜—Kš
œ˜—Kšœžœ
žœ˜Kš
œ$˜$Kšœžœ˜Kš
œ9˜9—K˜—šžœžœ
ž˜˜
Kš
œ˜—˜
Kš
œ&˜&—Kšžœžœ
˜—K˜Kš
œ™Kšœžœ
žœ˜Kš
œ7˜7Kšœžœ˜!K˜Kš
œ*˜*šžœžœ
žœ˜ Kš
œ™Kšœ
žœžœ
˜Kšœžœ
žœ˜Kš
œ5˜5Kšœžœ˜%Kš
œA˜AKš
œ ˜ —K˜"š
ž˜Kšžœžœ
žœ
˜Kš
œ˜Kšžœ žœ
žœ
˜,Kšžœ
˜—K˜—K˜—šžœžœžœ
ž˜*šžœ/žœ˜7Kšœžœ˜—Kšžœ
žœžœ	˜4Kšžœ
˜—šžœ˜Kšœ@žœž˜Yšžœ4žœ
ž˜CKš
œ#˜#Kšžœ
˜—Kšžœ
˜—šžœ˜Kšœ=žœž˜Všžœ4žœ
ž˜CKš
œ#˜#š
œ
˜
Kš
œ&˜&Kš
œ!˜!—Kšžœ
˜—Kšžœ
˜—Kš
œ0™0Kšžœ	žœ
žœ"˜5šžœ˜Kš
œ˜šžœ	žœ
ž˜Kš
œ˜Kšœžœ
žœ
žœ˜!Kš
œ˜Kš
œ˜šžœ
žœžœžœ˜0Kš
œ2˜2—Kš
œ˜šžœ	žœ
ž˜Kš
œ˜Kšžœžœ
žœ˜.K˜Kšžœ
˜—Kš	œžœžœ
žœžœ	˜<Kš
œ˜Kšžœ
˜—K˜—Kš
œ˜K˜—šŸ
œžœ
žœžœ˜BKšœžœžœžœžœ
žœ˜6Kšœžœžœžœ˜?šžœžœžœ˜Kšœžœ
žœ˜5Kšœ	žœ
žœ˜*Kšœžœ
žœ
žœ˜,Kšœ
žœžœ˜2Kšœžœžœ
žœ˜)Kš
œ3˜3Kš
œ3˜3š
œ˜Kšœžœ-˜<—šžœžœ
žœ
ž˜š
œ˜Kš
œ9˜9Kšœžœ˜—Kš
œ˜Kš
œ.˜.Kš
œ˜Kšœžœ˜Kšžœ
˜—Kš
œ˜Kš
œ˜—K˜K˜——š
œ™K˜šŸœžœžœžœ	žœžœžœ˜[Kšœžœžœ
žœ˜Kš
œ-˜-Kšžœžœ"žœ˜PKšžœ˜Kš
œ˜K˜—Kšœžœžœžœžœ	žœ
žœ
žœ˜AšŸœžœžœžœ
žœžœžœ
žœžœ˜^Kš
œJ™JKš
œ˜šžœ	žœ
ž˜šžœžœ
žœžœžœ
ž˜?Kšžœžœžœ˜9Kšžœ
˜—Kšœžœžœ˜/Kšžœ
˜—K˜K˜—šŸ
œžœžœžœ
žœ
žœžœžœ
žœ
žœ˜LKš	œžœ
žœ
žœžœ
˜š
žœžœ
žœ
žœžœžœ
ž˜<šžœžœž˜+Kšœ	žœ
˜š
œ	˜	šžœžœž˜*Kšœ	žœ
˜Kšœ
žœ˜K˜Kšžœ
˜——K˜Kšžœžœ
˜—K˜Kšžœ
˜—Kš
žœžœ
žœ
žœžœ
˜+Kšžœ
žœžœ
˜7K˜—šŸ
œžœžœ
žœžœžœ
žœ
˜LKšœžœ
žœžœ
˜Kšœžœ˜šžœžœ
žœžœžœ
ž˜<šžœžœž˜.Kšœ	žœ
˜š
œ	˜	šžœžœž˜-Kšœ	žœ
˜Kšœ
žœ˜K˜Kšžœ
˜——K˜Kšžœžœ
˜—K˜Kšžœ
˜—šžœž˜Kšžœ
žœžœ
˜Kšžœ
žœžœ	˜6—Kš
œ˜K˜——™K˜˜Kš
œ˜Kš
œ*˜*K˜—˜Kš
œ˜Kš
œ,˜,K˜—˜Kš
œ˜Kš
œ(˜(K˜—˜Kš
œ˜Kš
œ.˜.K˜—˜Kš
œ˜Kš
œ3˜3K˜—˜Kš
œ˜Kš
œ.˜.K˜—˜Kš
œ"˜"Kš
œ4˜4K˜—˜Kš
œ˜Kš
œ:˜:K˜—˜Kš
œ˜Kš
œ.˜.K˜—˜Kš
œ˜Kš
œ,˜,K˜—˜Kš
œ˜Kš
œ0˜0K˜—˜Kš
œ˜Kš
œ.˜.K˜—˜Kš
œ"˜"Kš
œi˜iK˜—˜Kš
œ ˜ Kš
œx˜xK˜——Kšžœ
˜K˜K˜K˜K˜—…—Tjsκ