-- BLList.mesa
-- last edited by Satterthwaite on October 20, 1982 12:06 pm
DIRECTORY
BcdDefs: TYPE USING [
Base, BCD, Link, ControlItem, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord,
EVIndex, EVNull, EVRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf,
IMPIndex, IMPRecord, LFIndex, LFNull, MTIndex, MTRecord, Namee, NameRecord,
NTIndex, NTNull, NTRecord, NullName, NullLink, RFIndex, RFNull, SGIndex, SGNull,
SGRecord, SpaceID, SPIndex, SPRecord, TFIndex, TFNull, TYPNull, VersionID, VersionStamp],
BcdOps: TYPE USING [BcdBase, MTHandle, NameString],
CharIO: TYPE USING [PutChar, PutDecimal, PutOctal, PutString, PutSubString],
FileSegment: TYPE USING [Pages, Span],
ListerOps: TYPE USING [],
ListerUtil: TYPE USING [
CreateStream, MapPages, Message, PrintRTBcd, PutTime, PutVersionId,
SetFileName, TTYStream],
OSMiscOps: TYPE USING [FileError, FindFile],
Space: TYPE USING [Error, Handle, LongPointer, Delete],
Stream: TYPE USING [Handle, Delete],
Strings: TYPE USING [String, SubStringDescriptor];
BLList: PROGRAM
IMPORTS CharIO, ListerUtil, OSMiscOps, Space, Stream
EXPORTS ListerOps = {
OPEN BcdDefs;
-- output streams
out: Stream.Handle ← NIL;
OpenOutput: PROC [output: Strings.String] = {
outName: STRING ← [40];
ListerUtil.SetFileName[outName, output, "bl"L];
out ← ListerUtil.CreateStream[outName]};
CloseOutput: PROC = {
Stream.Delete[out]; out ← NIL};
-- table bases
bcdSpace: Space.Handle;
bcd: BcdOps.BcdBase;
tb: BcdDefs.Base;
ssb: BcdOps.NameString;
evb: BcdDefs.Base;
spb: BcdDefs.Base;
fpb: BcdDefs.Base;
ctb: BcdDefs.Base;
mtb: BcdDefs.Base;
lfb: BcdDefs.Base;
tfb: BcdDefs.Base;
rfb: BcdDefs.Base;
itb: BcdDefs.Base;
etb: BcdDefs.Base;
sgb: BcdDefs.Base;
ftb: BcdDefs.Base;
ntb: BcdDefs.Base;
-- a more tolerant version of ListerUtil.LoadBcd
defaultSpan: FileSegment.Span = [base: 1, pages: 10]; -- default estimate
InstallBcd: PROC [fileName: Strings.String, span: FileSegment.Span] = {
seg: FileSegment.Pages;
seg ← [
file: OSMiscOps.FindFile[fileName, ! OSMiscOps.FileError => {GO TO noFile}],
span: span];
DO
bcdSpace ← ListerUtil.MapPages[seg];
bcd ← bcdSpace.LongPointer;
IF bcd.nPages <= seg.span.pages OR seg.span.pages >= 256 THEN EXIT;
seg.span.pages ← MIN[bcd.nPages, 256];
Space.Delete[bcdSpace];
ENDLOOP;
tb ← LOOPHOLE[bcd];
ssb ← LOOPHOLE[bcd + bcd.ssOffset];
ctb ← tb + bcd.ctOffset;
mtb ← tb + bcd.mtOffset;
IF bcd.extended THEN {
lfb ← tb + bcd.lfOffset;
tfb ← tb + bcd.tfOffset;
rfb ← tb + bcd.rfOffset};
itb ← tb + bcd.impOffset;
etb ← tb + bcd.expOffset;
sgb ← tb + bcd.sgOffset;
ftb ← tb + bcd.ftOffset;
ntb ← tb + bcd.ntOffset;
evb ← tb + bcd.evOffset;
spb ← tb + bcd.spOffset;
fpb ← tb + bcd.fpOffset
EXITS
noFile => bcd ← NIL};
UnstallBcd: PROC [] = {
Space.Delete[bcdSpace]};
WriteBcdID: PROC [name: Strings.String, bcd: BcdOps.BcdBase] = {
PutString[name];
PutString[", version "L]; ListerUtil.PutVersionId[out, bcd.version];
IF bcd.source # NullName THEN {
PutString["\n source "L]; PutName[bcd.source];
PutString[" of "L]; ListerUtil.PutTime[out, bcd.sourceVersion.time]};
IF bcd.versionIdent # BcdDefs.VersionID THEN {
PutString["\n (obsolete) version ID = "L];
PutDecimal[bcd.versionIdent]};
PutString["\n creator "L]; ListerUtil.PutVersionId[out, bcd.creator];
PutString["\n\n"L]};
PrintStamps: PROC = {
PutString["Imports:\n\n"L];
FOR iti: IMPIndex ← IMPIndex.FIRST, iti + IMPRecord.SIZE
UNTIL iti = bcd.impLimit DO
OPEN ii: itb[iti];
IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN
GO TO Bogus;
IF ii.namedInstance THEN {PutInstanceName[[import[iti]]]; PutString[": "L]};
PutName[ii.name];
PutFileStamp[ii.file, ii.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutChar['\n];
PutString["Exports:\n\n"L];
FOR eti: EXPIndex ← EXPIndex.FIRST, eti + etb[eti].size + EXPRecord.SIZE
UNTIL eti = bcd.expLimit DO
OPEN ee: etb[eti];
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
IF ee.namedInstance THEN {PutInstanceName[[export[eti]]]; PutString[": "L]};
PutName[ee.name];
PutFileStamp[ee.file, ee.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutString["\nModules:\n\n"L];
FOR mti: MTIndex ← MTIndex.FIRST, mti + MTSize[mti] UNTIL mti = bcd.mtLimit DO
OPEN mm: mtb[mti];
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
IF mm.namedInstance THEN {PutInstanceName[[module[mti]]]; PutString[": "L]};
PutName[mm.name];
PutFileStamp[mm.file, mm.name];
REPEAT
Bogus => PrintGarbage[];
ENDLOOP};
PutFileStamp: PROC [fti: FTIndex, mName: NameRecord] = {
OPEN ftb[fti];
SELECT fti FROM
FTNull => PutString["(null)"L];
FTSelf => PutString["(self)"L];
ENDCASE => {
IF name # mName THEN {PutString[", file: "L]; PutName[name]};
PutString[", version: "L];
ListerUtil.PutVersionId[out, version]};
PutChar['\n]};
dumpLinks: {none, rt, all} ← none;
PrintBcd: PROC = {
PrintHeader[];
PrintConfigs[];
PrintImports[];
PrintExports[];
PrintExpVars[];
PrintModules[];
PrintFiles[];
PrintFramePacks[];
PrintSpaces[]};
PrintHeader: PROC = {
PutString["Configurations: "L]; PutDecimal[bcd.nConfigs];
PutString[", Modules: "L]; PutDecimal[bcd.nModules];
PutString[", Imports: "L]; PutDecimal[bcd.nImports];
PutString[", Exports: "L]; PutDecimal[bcd.nExports];
PutString[", Dummy: "L]; PutDecimal[bcd.firstdummy];
PutString[", #Dummies: "L]; PutDecimal[bcd.nDummies];
PutChar['\n];
IF ~bcd.definitions THEN PutChar['~];
PutString["definitions, "L];
IF ~bcd.repackaged THEN PutChar['~];
PutString["repackaged, "L];
IF ~bcd.typeExported THEN PutChar['~];
PutString["type exported, "L];
IF ~bcd.tableCompiled THEN PutChar['~];
PutString["table compiled, "L];
IF ~bcd.versions THEN PutChar['~];
PutString["versions, "L];
IF ~bcd.extended THEN PutChar['~];
PutString["extended\n\n"L]};
PrintConfigs: PROC = {
cti: CTIndex ← CTIndex.FIRST;
PutString["Configurations"L];
PrintIndex[bcd.ctOffset];
PutString[":\n"L];
UNTIL cti = bcd.ctLimit DO
PrintConfig[cti];
cti ← cti + CTRecord.SIZE + ctb[cti].nControls*ControlItem.SIZE;
IF LOOPHOLE[cti, CARDINAL] > LOOPHOLE[bcd.ctLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutChar['\n]};
PrintConfig: PROC [cti: CTIndex] = {
OPEN ctb[cti];
Tab[2];
PutName[name];
PrintIndex[cti];
IF namedInstance THEN {
PutString[", instance name: "L]; PutInstanceName[[config[cti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN {
PutString[", parent: "L];
PutName[ctb[config].name];
PrintIndex[config]};
PutString[", #controls: "L]; PutDecimal[nControls];
IF nControls # 0 THEN {
PutString[", controls:"L];
FOR i: CARDINAL IN [0..nControls) DO
IF i MOD 6 = 0 THEN Tab[6] ELSE PutString[", "L];
WITH c: controls[i] SELECT FROM
module => PutName[mtb[c.mti].name];
config => {PutName[ctb[c.cti].name]; PutChar['*]};
ENDCASE => ERROR;
PrintIndex[controls[i]];
ENDLOOP};
PutChar['\n]};
PrintImports: PROC = {
iti: IMPIndex ← IMPIndex.FIRST;
PutString["Imports"L];
PrintIndex[bcd.impOffset];
PutChar[':];
PutChar['\n];
UNTIL iti = bcd.impLimit DO
PrintImport[iti];
iti ← iti + IMPRecord.SIZE;
IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutChar['\n]; PutChar['\n]};
PrintImport: PROC [iti: IMPIndex] = {
OPEN itb[iti];
Tab[2];
PutName[name];
PrintIndex[iti];
IF port = $module THEN PutString[" (module)"L];
IF namedInstance THEN {
PutString[", instance name: "L]; PutInstanceName[[import[iti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
PutString[", gfi: "L]; PutDecimal[gfi];
PutString[", ngfi: "L]; PutDecimal[ngfi]};
PrintExports: PROC = {
eti: EXPIndex ← EXPIndex.FIRST;
PutString["Exports"L];
PrintIndex[bcd.expOffset];
PutChar[':];
PutChar['\n];
UNTIL eti = bcd.expLimit DO
PrintExport[eti];
eti ← eti + etb[eti].size + EXPRecord.SIZE;
IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
IF dumpLinks # all THEN PutChar['\n];
PutChar['\n]};
PrintExport: PROC [eti: EXPIndex] = {
OPEN etb[eti];
Tab[2];
PutName[name];
PrintIndex[eti];
IF port = $module THEN PutString[" (module)"L];
IF namedInstance THEN {
PutString[", instance name: "L]; PutInstanceName[[export[eti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
PutString[", "L];
IF ~typeExported THEN PutChar['~];
PutString["typeExported"L];
PutString[", #links: "L]; PutDecimal[size];
IF dumpLinks = all THEN {
PutString[", links:"L];
FOR i: CARDINAL IN [0..size) DO
IF i MOD 7 = 0 THEN Tab[4] ELSE PutChar[' ];
PrintControlLink[links[i]];
IF i + 1 # size THEN PutChar[',];
ENDLOOP};
IF dumpLinks = all THEN PutChar['\n]};
PrintExpVars: PROC = {
evi: EVIndex ← EVIndex.FIRST;
evLimit: EVIndex = bcd.evLimit;
PutString["Exported variables:\n"L];
UNTIL evi = evLimit DO
PrintExpVar[evi];
evi ← evi + evb[evi].length + EVRecord.SIZE;
ENDLOOP;
PutChar['\n]};
PrintExpVar: PROC [evi: EVIndex] = {
OPEN evb[evi];
Tab[2];
PrintIndex[evi];
PutString[", #offsets: "L];
PutDecimal[length];
PutString[", offsets:"L];
FOR i: CARDINAL IN [1..length] DO
IF i MOD 8 = 1 THEN Tab[4] ELSE PutChar[' ];
PutOctal[offsets[i]];
IF i # length THEN PutChar[',];
ENDLOOP;
PutChar['\n]};
PrintSpaces: PROC = {
spi: SPIndex ← SPIndex.FIRST;
spLimit: SPIndex = bcd.spLimit;
PutString["Spaces:\n"L];
UNTIL spi = spLimit DO
PrintSpace[spi];
spi ← spi + SPRecord.SIZE + spb[spi].length*SpaceID.SIZE;
ENDLOOP;
PutChar['\n]};
PrintSpace: PROC [spi: SPIndex] = {
OPEN spb[spi];
Tab[2];
PrintIndex[spi];
PutString[", segment: "L]; PrintIndex[seg];
PutString[", #code packs: "L]; PutDecimal[length];
IF length # 0 THEN PutString[", code packs: "L];
FOR i: CARDINAL IN [0..length) DO
Tab[4];
PutString[" code pack "L]; PutName[spaces[i].name];
PutString[", "L];
IF ~spaces[i].resident THEN PutChar['~];
PutString["resident, offset: "L];
PutOctal[spaces[i].offset];
PutString[", pages: "L];
PutDecimal[spaces[i].pages];
PutChar['\n];
ENDLOOP};
PrintModules: PROC = {
mti: MTIndex ← MTIndex.FIRST;
PutString["Modules"L];
PrintIndex[bcd.mtOffset];
PutString[":\n"L];
UNTIL mti = bcd.mtLimit DO
PrintModule[@mtb[mti], mti];
mti ← mti + MTSize[mti];
IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutChar['\n]};
PrintModule: PROC [mth: BcdOps.MTHandle, mti: MTIndex] = {
OPEN mth;
Tab[2];
PutName[name];
PrintIndex[mti];
IF namedInstance THEN {
PutString["instance name: "L]; PutInstanceName[[module[mti]]]};
PutString[", file: "L];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN {
PutString[", config: "L];
PutName[ctb[config].name];
PrintIndex[config]};
Tab[4];
IF tableCompiled THEN PutString["table compiled, "L] ELSE {
PutSwitch: PROC [sw: CHAR, value: BOOL] = {
IF ~value THEN PutChar['-]; PutChar[sw]};
PutString["switches: "L];
PutSwitch['b, boundsChecks];
PutSwitch['c, long];
PutSwitch['j, crossJumped];
PutSwitch['l, linkLoc = $code];
PutSwitch['n, nilChecks];
PutSwitch['s, ~initial];
PutString[", "L]};
IF ~packageable THEN PutChar['~]; PutString["packageable, "L];
IF residentFrame THEN PutString["resident frame, "L];
Tab[4];
PutString["framesize: "L]; PutDecimal[framesize];
PutString[", gfi: "L]; PutDecimal[gfi];
PutString[", ngfi: "L]; PutDecimal[ngfi];
PutString[", links: "L]; PutString[IF linkLoc = $frame THEN "frame"L ELSE "code"L];
Tab[4];
PutString["code: "L]; PrintSegment[code.sgi];
PutString[", offset: "L]; PutOctal[code.offset];
PutString[", length: "L]; PutOctal[code.length];
IF code.linkspace THEN PutString[", link space"L];
IF code.packed THEN PutString[", packed"L];
Tab[4];
PutString["symbols: "L]; PrintSegment[sseg];
IF variables # EVNull THEN {
Tab[4]; PutString["exported variables: "L]; PrintIndex[variables]};
WITH mm: mth↑ SELECT FROM
direct => {
Tab[4];
PutString["#links: "L]; PutDecimal[mm.length];
IF dumpLinks = all THEN {
PutString[", links:"L];
FOR i: CARDINAL IN [0..mm.length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintControlLink[mm.frag[i]];
IF i + 1 # mm.length THEN PutChar[',];
ENDLOOP}};
indirect => {Tab[4]; PrintLinks[mm.links]};
multiple => {
Tab[4];
PrintLinks[mm.links];
Tab[4];
PrintTypes[mm.types];
IF mm.frameRefs THEN {
Tab[5];
PutString["frame type: "L]; PutDecimal[mm.frameType]};
Tab[4];
PrintRefLits[mm.refLiterals]};
ENDCASE;
PutChar['\n]};
MTSize: PROC [mti: MTIndex] RETURNS [NAT] = {
RETURN [WITH m: mtb[mti] SELECT FROM
direct => MTRecord.direct.SIZE + m.length*Link.SIZE,
indirect => MTRecord.indirect.SIZE,
multiple => MTRecord.multiple.SIZE,
ENDCASE => ERROR]};
PrintLinks: PROC [lfi: LFIndex] = {
PutString["#links: "L];
IF lfi = LFNull THEN PutString["none"L]
ELSE {
PutDecimal[lfb[lfi].length];
IF dumpLinks = all THEN {
PutString[", links:"L];
FOR i: CARDINAL IN [0..lfb[lfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintControlLink[lfb[lfi].frag[i]];
IF i + 1 # lfb[lfi].length THEN PutChar[',];
ENDLOOP}}};
PrintTypes: PROC [tfi: TFIndex] = {
PutString["#types: "L];
IF tfi = TFNull THEN PutString["none"L]
ELSE {
PutDecimal[tfb[tfi].length];
PutString[", offset: "L]; PutDecimal[tfb[tfi].offset];
IF dumpLinks # none THEN {
PutString[", indices:"L];
FOR i: CARDINAL IN [0..tfb[tfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintRTIndex[tfb[tfi].frag[i]];
IF i + 1 # tfb[tfi].length THEN PutChar[',];
ENDLOOP}}};
PrintRefLits: PROC [rfi: RFIndex] = {
PutString["#ref lits: "L];
IF rfi = RFNull THEN PutString["none"L]
ELSE {
PutDecimal[rfb[rfi].length];
PutString[", offset: "L]; PutDecimal[rfb[rfi].offset];
IF dumpLinks # none THEN {
PutString[", indices:"L];
FOR i: CARDINAL IN [0..rfb[rfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE PutChar[' ];
PrintRTIndex[rfb[rfi].frag[i]];
IF i + 1 # rfb[rfi].length THEN PutChar[',];
ENDLOOP}}};
PrintFramePacks: PROC = {
fpi: FPIndex ← FPIndex.FIRST;
fpLimit: FPIndex = bcd.fpLimit;
PutString["Frame Packs:\n"L];
UNTIL fpi = fpLimit DO
PrintFramePack[fpi];
fpi ← fpi + FPRecord.SIZE + fpb[fpi].length*MTIndex.SIZE;
ENDLOOP;
PutChar['\n]};
PrintFramePack: PROC [fpi: FPIndex] = {
OPEN fpb[fpi];
Tab[2];
PutName[name];
PrintIndex[fpi];
PutString[", #modules: "L];
PutDecimal[length];
PutString[", modules:\n"L];
FOR i: CARDINAL IN [0..length) DO
IF i MOD 4 = 0 THEN Tab[4] ELSE PutChar[' ];
PutName[mtb[modules[i]].name];
PrintIndex[modules[i]];
IF i # length - 1 THEN PutChar[',];
ENDLOOP;
PutChar['\n]};
PrintSegment: PROC [sgi: SGIndex] = {
IF sgi = BcdDefs.SGNull THEN PutString["(null)"L]
ELSE {
PrintFileName[sgb[sgi].file];
PutString[" [base: "L]; PutDecimal[sgb[sgi].base];
PutString[", pages: "L]; PutDecimal[sgb[sgi].pages];
IF sgb[sgi].extraPages # 0 THEN {PutChar['+]; PutDecimal[sgb[sgi].extraPages]};
PutChar[']]}};
PrintFiles: PROC = {
fti: FTIndex ← FTIndex.FIRST;
PutString["Files"L];
PrintIndex[bcd.ftOffset];
PutString[":\n"L];
UNTIL fti = bcd.ftLimit DO
PrintFile[fti];
fti ← fti + FTRecord.SIZE;
IF LOOPHOLE[fti, CARDINAL] > LOOPHOLE[bcd.ftLimit, CARDINAL] THEN GO TO Bogus;
REPEAT
Bogus => PrintGarbage[];
ENDLOOP;
PutChar['\n]; PutChar['\n]};
PrintFile: PROC [fti: FTIndex] = {
OPEN ftb[fti];
Tab[2];
SELECT fti FROM
FTNull => PutString["(null)"L];
FTSelf => PutString["(self)"L];
ENDCASE => {
PutName[name];
PrintIndex[fti];
PutString[", version: "L];
ListerUtil.PutVersionId[out, version]}};
PrintRT: PROC = {PrintRTBcdExt[FALSE]};
PrintRTSorted: PROC = {PrintRTBcdExt[TRUE]};
PrintRTBcdExt: PROC [sorted: BOOL] = {
PrintHeader[];
PrintConfigs[];
PrintModules[];
IF ~bcd.extended OR bcd.rtPages.pages = 0 THEN PutString["No RT Extensions"L]
ELSE {
ListerUtil.PrintRTBcd[out, bcd, sorted];
PrintSymbolSegments[];
PrintFiles[]};
PutChar['\n]; PutChar['\n]};
PrintSymbolSegments: PROC = {
sgi: SGIndex ← SGIndex.FIRST;
PutString["Symbol Segments\n"L];
UNTIL sgi = bcd.sgLimit DO
IF sgb[sgi].class = $symbols THEN {
Tab[1];
PrintIndex[sgi]; PutChar[' ];
PrintSegment[sgi]};
sgi ← sgi + SGRecord.SIZE;
ENDLOOP;
PutChar['\n]; PutChar['\n]};
-- Utility Prints
PrintControlLink: PROC [link: Link] = {
SELECT TRUE FROM
(link = BcdDefs.NullLink) =>
PutString["(null link)"L];
link.proc => {
PutString["proc["L];
PutDecimal[link.gfi]; PutChar[',]; PutDecimal[link.ep]; PutChar[']]};
link.type => {
PutString["type["L];
IF link.typeID = BcdDefs.TYPNull THEN PutString["null"L]
ELSE PutDecimal[LOOPHOLE[link.typeID]];
PutChar[']]};
ENDCASE => {
PutString["var["L];
PutDecimal[link.vgfi]; PutChar[',]; PutDecimal[link.var]; PutChar[']]}};
PrintRTIndex: PROC [index: NAT] = {
PutChar['[]; PutDecimal[index]; PutChar[']]};
PrintFileName: PROC [fti: FTIndex] = {
SELECT fti FROM
FTNull => PutString["(null)"L];
FTSelf => PutString["(self)"L];
ENDCASE => PutName[ftb[fti].name]};
PrintIndex: PROC [index: UNSPECIFIED] = {
PutString[" ["L]; PutDecimal[index]; PutChar[']]};
PrintGarbage: PROC = {
Tab[2];
PutString["? Looks like garbage ...\n"L]};
PrintAnonName: PROC = {PutString[" (anon) "L]};
Tab: PROC [n: CARDINAL] = {
PutChar['\n];
THROUGH [1..n/8] DO PutChar['\t] ENDLOOP;
THROUGH [1..n MOD 8] DO PutChar[' ] ENDLOOP};
-- Utility Puts
PutChar: PROC [c: CHAR] = INLINE {CharIO.PutChar[out, c]};
PutString: PROC [s: Strings.String] = INLINE {CharIO.PutString[out, s]};
PutDecimal: PROC [i: INTEGER] = INLINE {CharIO.PutDecimal[out, i]};
PutOctal: PROC [n: UNSPECIFIED] = INLINE {CharIO.PutOctal[out, n]};
PutName: PROC [n: NameRecord] = {
ssd: Strings.SubStringDescriptor ←
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
CharIO.PutSubString[out, @ssd]};
PutInstanceName: PROC [n: Namee] = {
FindName: PROC [ntb: Base, nti: NTIndex] RETURNS [stop: BOOL] = {
RETURN [ntb[nti].item = n]};
nti: NTIndex = EnumerateNameTable[FindName];
IF nti = NTNull THEN PrintAnonName[] ELSE PutName[ntb[nti].name]};
EnumerateNameTable: PROC [
proc: PROC [Base, NTIndex] RETURNS [BOOL]] RETURNS [nti: NTIndex] = {
FOR nti ← NTIndex.FIRST, nti + NTRecord.SIZE UNTIL nti = bcd.ntLimit DO
IF proc[ntb, nti] THEN RETURN[nti];
ENDLOOP;
RETURN [NTNull]};
ListVersion: PUBLIC PROC [root: Strings.String] = {
fileName: Strings.String ← [100];
ListerUtil.SetFileName[fileName, root, "bcd"L];
InstallBcd[fileName, defaultSpan];
IF bcd = NIL THEN ListerUtil.Message["File not found"L]
ELSE {
out ← ListerUtil.TTYStream[];
PutChar['\n];
PutString[fileName];
PutString[", version "L]; ListerUtil.PutVersionId[out, bcd.version];
IF bcd.versionIdent # VersionID THEN {
PutString["\n (obsolete) version ID = "L];
PutDecimal[bcd.versionIdent]}
ELSE IF bcd.source # BcdDefs.NullName THEN {
PutString["\n source "L]; PutName[bcd.source];
PutString[" of "L]; ListerUtil.PutTime[out, bcd.sourceVersion.time]};
PutString["\n creator "L]; ListerUtil.PutVersionId[out, bcd.creator];
PutChar['\n];
Stream.Delete[out]; out ← NIL;
UnstallBcd[]}};
BcdProc: PROC [root, output: Strings.String, span: FileSegment.Span, proc: PROC] = {
fileName: Strings.String ← [100];
ListerUtil.SetFileName[fileName, root, "bcd"L];
InstallBcd[fileName, span];
IF bcd = NIL THEN ListerUtil.Message["File not found"L]
ELSE {
OpenOutput[output];
WriteBcdID[fileName, bcd];
IF bcd.versionIdent # BcdDefs.VersionID THEN
ListerUtil.Message["Obsolete format, ouput may be garbage"L];
proc[];
CloseOutput[];
UnstallBcd[]}};
ListStamps: PUBLIC PROC [root, output: Strings.String] = {
BcdProc[root, output, [1, 10], PrintStamps]};
ListFiles: PUBLIC PROC [root, output: Strings.String] = {
BcdProc[root, output, defaultSpan, PrintFiles]};
BcdSegment: PUBLIC PROC [
root, output: Strings.String,
span: FileSegment.Span,
links: BOOL] = {
dumpLinks ← IF links THEN all ELSE none;
BEGIN
BcdProc[root, output, span, PrintBcd ! Space.Error => {GO TO BadSegment}];
EXITS
BadSegment => ListerUtil.Message["Bad Segment"L];
END;
dumpLinks ← none};
ListRTBcd: PUBLIC PROC [root, output: Strings.String, sorted: BOOL] = {
dumpLinks ← rt;
BcdProc[root, output, defaultSpan, IF sorted THEN PrintRTSorted ELSE PrintRT];
dumpLinks ← none};
ListBcd: PUBLIC PROC [root, output: Strings.String, links: BOOL] = {
IF links THEN dumpLinks ← all;
BcdProc[root, output, defaultSpan, PrintBcd];
dumpLinks ← none};
}.