<> <> <> <> DIRECTORY Basics USING [bytesPerWord], BcdDefs USING [BCD, FTIndex, FTRecord, MTIndex, MTNull, MTRecord, SGRecord, VersionID, VersionStamp], BcdLister USING [ListBcd], CodeLister USING [ListCode, ListFGT], Commander USING [CommandProc, Register], ConvertUnsafe USING [SubString], FS USING [Close, Error, ExpandName, Open, OpenFile, StreamOpen], List USING [CompareProc, Sort], Literals USING [LitDescriptor, LTIndex, LTNull, LTRecord, MSTIndex, STIndex, STNull], ListerUtils USING [PrintIndex, PrintName, PrintSE, PrintSei, PrintTree, PrintVersion, ReadBcd, ReadMtr, ReadSgr, ShortName], ListRTBcd USING [PrintRTBcd], IO USING [Close, EndOfStream, GetChar, GetTokenRope, IDProc, PutChar, PutF, PutFR, PutRope, RIS, RopeFromROS, ROS, SetIndex, STREAM, UnsafeGetBlock], Rope USING [Compare, Concat, Equal, Flatten, Length, Match, Replace, ROPE, SkipTo], SortedSymbolLister USING [AddSymbols], SymbolPack, Symbols USING [BitAddress, BodyRecord, BTIndex, ContextLevel, CSEIndex, CTXIndex, CTXNull, CTXRecord, HTIndex, ISEIndex, ISENull, lG, lL, 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, FS, 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; lG: ContextLevel = Symbols.lG; lL: ContextLevel = Symbols.lL; 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; VersionStamp: TYPE = BcdDefs.VersionStamp; <> ListSymbols: Commander.CommandProc = TRUSTED { <<[cmd: Handle] RETURNS [result: REF _ NIL, msg: Rope.ROPE _ NIL]>> in: STREAM = IO.RIS[cmd.commandLine]; name: ROPE; file: FS.OpenFile; 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; Cleanup: PROC = { IF stream # NIL AND stream # cmd.out THEN IO.Close[stream]; IF inStream # NIL THEN IO.Close[inStream]; IF stb # NIL THEN {SymbolTable.Release[stb]; stb _ NIL}; FS.Close[file]; }; IF sortedSymbols THEN IO.PutRope[cmd.out, "Combined symbols listing to Symbols.sort\n"]; DO name _ IO.GetTokenRope[in, IO.IDProc ! IO.EndOfStream => EXIT].token; any _ TRUE; SELECT TRUE FROM Rope.Match["*.bcd", name, FALSE], Rope.Match["*.bcd!*", name, FALSE] => {}; ENDCASE => name _ Rope.Concat[name, ".bcd"]; file _ FS.Open[name, $read ! FS.Error => { IF error.group = bug THEN REJECT; IO.PutF[cmd.out, "File not found: %g\n", [rope[name]]]; LOOP; }]; {ENABLE UNWIND => Cleanup[]; short: ROPE _ ListerUtils.ShortName[name _ FS.ExpandName[name].fullFName]; bcd: RefBCD _ ListerUtils.ReadBcd[name]; ext: ROPE _ NIL; outName: ROPE _ NIL; configOk: BOOL _ FALSE; inStream _ FS.StreamOpen[name, $read]; SELECT cmd.procData.clientData FROM $Bcd, $ShortBcd => {ext _ ".bcdList"; configOk _ TRUE}; $Bodies => ext _ ".bodyList"; $Code => ext _ ".codeList"; $Exports => {ext _ ".exportsList"; configOk _ TRUE}; $FGT => ext _ ".fgtList"; $Files => {ext _ ".filesList"; configOk _ TRUE}; $Globals => {ext _ ".globalFramesList"; configOk _ TRUE}; $RTBcd => {ext _ ".rtBcdList"; configOk _ TRUE}; $Symbols => ext _ ".symbolList"; $Unbound => {ext _ NIL; configOk _ TRUE}; $Using => ext _ ".usingList"; $SortedSymbols, $SortedDefs => ext _ NIL; ENDCASE => ext _ ".list"; IF ext # NIL THEN IF Rope.Match["*.bcd", short, FALSE] THEN outName _ short.Replace[short.Length[]-4, 4, ext] ELSE outName _ short.Concat[ext]; SELECT TRUE FROM bcd.versionIdent # BcdDefs.VersionID => IO.PutF[cmd.out, "Not a valid Cedar bcd file: %g\n", [rope[short]]]; bcd.nConfigs # 0 AND ~configOk => IO.PutF[cmd.out, "Bound configurations 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 { IO.PutF[cmd.out, "Error - no symbols from %g\n", [rope[name]]]; 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 ELSE { IO.PutF[ cmd.out, "%g output to %g\n", [rope[cmd.command]], [rope[outName]]]; stream _ FS.StreamOpen[outName, $create]; IO.PutRope[stream, outName]; }; IF sortedSymbols THEN { IF ~bcd.definitions AND cmd.procData.clientData = $SortedDefs THEN LOOP; totalFiles _ CONS[short, totalFiles]; } ELSE { IO.PutF[stream, "\n object: %g {", [rope[short]]]; ListerUtils.PrintVersion[bcd.version, stream]; IO.PutRope[stream, "}\n source: "]; IO.PutRope[stream, sourceName]; IO.PutRope[stream, " {"]; ListerUtils.PrintVersion[bcd.sourceVersion, stream, TRUE]; IO.PutRope[stream, "}\n creator: {"]; ListerUtils.PrintVersion[bcd.creator, stream]; IO.PutRope[stream, "}\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, name]; $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[]; }; ENDLOOP; IF sortedSymbols THEN { CompareCaseless: List.CompareProc = TRUSTED { <<[ref1: REF ANY, ref2: REF ANY] RETURNS [Basics.Comparison]>> r1: ROPE = NARROW[ref1]; r2: ROPE = NARROW[ref2]; RETURN[Rope.Compare[r1, r2, FALSE]]; }; totalFiles _ List.Sort[totalFiles, CompareCaseless]; stream _ FS.StreamOpen["Symbols.sort", $create]; IO.PutRope[stream, "Combined symbols for: "]; WHILE totalFiles # NIL DO IO.PutRope[stream, NARROW[totalFiles.first]]; totalFiles _ totalFiles.rest; ENDLOOP; IO.PutRope[stream, "\n\n"]; combinedSymbols _ List.Sort[combinedSymbols, CompareCaseless]; WHILE combinedSymbols # NIL DO IO.PutF[stream, "%g\n", [rope[NARROW[combinedSymbols.first]]]]; combinedSymbols _ combinedSymbols.rest; ENDLOOP; IO.Close[stream]; }; IF NOT any THEN { result _ $Failure; msg _ IO.PutFR["Usage: %g file ...", [rope[cmd.command]]]; }; }; PrintBodies: PUBLIC PROC [stream: STREAM, stb: SymbolTableBase] = { PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = { body: LONG POINTER TO BTRecord = @stb.bb[bti]; IO.PutRope[stream, "Body: "]; WITH b: body SELECT FROM Callable => { ListerUtils.PrintSei[b.id, stream, stb]; IF b.inline THEN IO.PutRope[stream, " [inline]"] ELSE { IO.PutF[stream, ", ep: %g", [cardinal[b.entryIndex]]]; WITH b SELECT FROM Inner => IO.PutF[stream, ", frame addr: %g", [cardinal[frameOffset]]]; ENDCASE; }; IO.PutRope[stream, ", attrs: "]; IO.PutChar[stream, IF ~b.noXfers THEN 'x ELSE '-]; IO.PutChar[stream, IF b.hints.safe THEN 's ELSE '-]; IO.PutChar[stream, IF b.hints.nameSafe THEN 'n ELSE '-]; IF ~b.hints.noStrings THEN IO.PutRope[stream, "\n string literals"]; }; ENDCASE => IO.PutRope[stream, "(anon)"]; IO.PutRope[stream, "\n context: "]; ListerUtils.PrintIndex[body.localCtx, stream]; IO.PutF[stream, ", level: %g", [cardinal[body.level]]]; WITH body.info SELECT FROM Internal => { IO.PutF[stream, ", frame size: %g", [cardinal[frameSize]]]; IF body.kind = Callable THEN ListerUtils.PrintTree[[subtree[index: bodyTree]], 0, stream, stb] ELSE {IO.PutRope[stream, ", tree root: "]; ListerUtils.PrintIndex[bodyTree, stream]}; }; ENDCASE; IO.PutRope[stream, "\n\n"]; RETURN [FALSE]; }; [] _ stb.EnumerateBodies[RootBti, PrintBody]; IO.PutRope[stream, "\n"]; }; PrintGlobalFrames: PUBLIC PROC [stream: STREAM, stb: SymbolTableBase] = { PrintBody: PROC [bti: BTIndex] RETURNS [BOOL] = { body: LONG POINTER TO BTRecord = @stb.bb[bti]; IO.PutRope[stream, "Body: "]; WITH b: body SELECT FROM Callable => { ListerUtils.PrintSei[b.id, stream, stb]; IF b.inline THEN IO.PutRope[stream, " [inline]"] ELSE { IO.PutF[stream, ", ep: %g", [cardinal[b.entryIndex]]]; WITH b SELECT FROM Inner => IO.PutF[stream, ", frame addr: %g", [cardinal[frameOffset]]]; ENDCASE; }; IO.PutRope[stream, ", attrs: "]; IO.PutChar[stream, IF ~b.noXfers THEN 'x ELSE '-]; IO.PutChar[stream, IF b.hints.safe THEN 's ELSE '-]; IO.PutChar[stream, IF b.hints.nameSafe THEN 'n ELSE '-]; IF ~b.hints.noStrings THEN IO.PutRope[stream, "\n string literals"]; }; ENDCASE => RETURN [FALSE]; IO.PutRope[stream, "\n context: "]; ListerUtils.PrintIndex[body.localCtx, stream]; IO.PutF[stream, ", level: %g", [cardinal[body.level]]]; WITH body.info SELECT FROM Internal => { IO.PutF[stream, ", frame size: %g", [cardinal[frameSize]]]; IF body.kind = Callable THEN ListerUtils.PrintTree[[subtree[index: bodyTree]], 0, stream, stb] ELSE {IO.PutRope[stream, ", tree root: "]; ListerUtils.PrintIndex[bodyTree, stream]}; }; ENDCASE; IO.PutRope[stream, "\n\n"]; RETURN [FALSE]; }; [] _ stb.EnumerateBodies[RootBti, PrintBody]; IO.PutRope[stream, "\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]; IO.PutRope[stream, "\n\n"]; ctx _ ctx + (WITH stb.ctxb[ctx] SELECT FROM included => CTXRecord.included.SIZE, imported => CTXRecord.imported.SIZE, ENDCASE => CTXRecord.simple.SIZE); ENDLOOP; IO.PutRope[stream, "\n"]; }; PrintContext: PROC [ctx: CTXIndex, definitionsOnly: BOOL, stream: STREAM, stb: SymbolTableBase] = { sei, root: ISEIndex; cp: LONG POINTER TO CTXRecord = @stb.ctxb[ctx]; IO.PutRope[stream, "Context: "]; ListerUtils.PrintIndex[ctx, stream]; IF stb.ctxb[ctx].level # lZ THEN IO.PutF[stream, ", level: %g", [cardinal[cp.level]]]; WITH c: cp SELECT FROM included => { IO.PutRope[stream, ", copied from: "]; ListerUtils.PrintName[stb.mdb[c.module].moduleId, stream, stb]; IO.PutRope[stream, " ["]; ListerUtils.PrintName[stb.mdb[c.module].fileId, stream, stb]; IO.PutRope[stream, ", "]; ListerUtils.PrintVersion[stb.mdb[c.module].stamp, stream]; IO.PutRope[stream, "], context: "]; ListerUtils.PrintIndex[c.map, stream]; }; imported => { IO.PutRope[stream, ", 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 _ IO.RopeFromROS[ros, 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 _ IO.RopeFromROS[ros, 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 _ IO.RopeFromROS[ros, FALSE]; modFileName _ Rope.Flatten[modFileName, 0, Rope.SkipTo[modFileName, 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 IO.PutRope[stream, "No DIRECTORY.\n"] ELSE { IO.PutRope[stream, "DIRECTORY\n"]; WHILE pairs # NIL DO pair: Pair = pairs.first; names: LIST OF ROPE _ pair.names; IO.PutRope[stream, " "]; IO.PutRope[stream, pair.key]; IF NOT Rope.Equal[pair.key, pair.file, FALSE] THEN { IO.PutF[stream, ": FROM \"%g\"", [rope[pair.file]]]; }; IO.PutRope[stream, " USING ["]; WHILE names # NIL DO IO.PutRope[stream, names.first]; IF names.rest # NIL THEN IO.PutRope[stream, ", "]; names _ names.rest; ENDLOOP; IF pairs.rest # NIL THEN IO.PutRope[stream, "],\n"] ELSE IO.PutRope[stream, "];\n"]; pairs _ pairs.rest; ENDLOOP; }; }; PrintFiles: PROC [stream: STREAM, bcd: RefBCD, fileName: ROPE] = { FTRSeq: TYPE = RECORD [SEQUENCE len: NAT OF FTRecord]; inStream: STREAM = FS.StreamOpen[fileName, $read]; fti: CARDINAL = LOOPHOLE[FIRST[FTIndex]]; nFiles: CARDINAL = (bcd.ftLimit-FIRST[FTIndex])/SIZE[FTRecord]; bytes: CARDINAL = nFiles*SIZE[FTRecord]*bytesPerWord; fileSeq: REF FTRSeq = NEW[FTRSeq[nFiles]]; ftp: LONG POINTER TO FTRecord _ @fileSeq[0]; IO.PutF[stream, "# files: %g\n\n", [integer[nFiles]]]; IO.SetIndex[inStream, (fti+bcd.ftOffset)*bytesPerWord]; [] _ IO.UnsafeGetBlock[ inStream, [base: LOOPHOLE[@fileSeq[0]], startIndex: 0, count: bytes]]; FOR i: NAT IN [0..nFiles) DO IO.PutF[ stream, "%g - fti: %g", [rope[RopeForBcdName[inStream, bcd.ssOffset, ftp.name]]], [integer[i*SIZE[FTRecord]]]]; IO.PutRope[stream, ", version: "]; ListerUtils.PrintVersion[ftp.version, stream]; IO.PutRope[stream, "\n"]; ftp _ ftp + SIZE[FTRecord]; ENDLOOP; IO.Close[inStream]; }; <> RopeForBcdName: PROC [inStream: STREAM, base: CARDINAL, index: CARDINAL] RETURNS [ROPE] = { ros: STREAM = IO.ROS[]; IO.SetIndex[inStream, base*bytesPerWord+index+3]; THROUGH [0..IO.GetChar[inStream]-0C) DO IO.PutChar[ros, IO.GetChar[inStream]]; ENDLOOP; RETURN [IO.RopeFromROS[ros]]; }; 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[rope, each.first, FALSE] FROM less => EXIT; equal => SELECT Rope.Compare[rope, 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 Rope.Compare[key, each.first.key, FALSE] FROM less => EXIT; equal => SELECT Rope.Compare[key, 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.