
<<BLList.mesa  >>
<<last edited by Satterthwaite on October 20, 1982 12:06 pm>>
<<Last Edited by: Maxwell, August 12, 1983 8:43 am>>
DIRECTORY
BcdDefs: TYPE USING [
Base, BCD, BcdBase, Link, ControlItem, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord,
EVIndex, EVNull, EVRecord, FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf,
IMPIndex, IMPRecord, LFIndex, LFNull, MTHandle, MTIndex, MTRecord, 
Namee, NameRecord, NameString,
NTIndex, NTNull, NTRecord, NullName, NullLink, RFIndex, RFNull, SGIndex, SGNull,
SGRecord, SpaceID, SPIndex, SPRecord, TFIndex, TFNull, TYPNull, VersionID, VersionStamp],
ConvertUnsafe: TYPE USING [SubString, SubStringToRope],
FileSegment: TYPE USING [Pages, Span],
IO: TYPE USING [card, Close, int, Put, PutChar, PutF, PutRope, STREAM],
ListerOps: TYPE USING [],
ListerUtil: TYPE USING [
CreateStream, GetTypescript, MapPages, Message, PrintRTBcd, PutTime, 
PutVersionId, SetExtension],
OSMiscOps: TYPE USING [FileError, FindFile],
Rope: TYPE USING [ROPE],
VM: TYPE USING [Free, Interval, AddressForPageNumber];

BLList: PROGRAM
IMPORTS ConvertUnsafe, IO, ListerUtil, OSMiscOps, VM
EXPORTS ListerOps = {
OPEN BcdDefs;

<<output streams>>

out: IO.STREAM _ NIL;

OpenOutput: PROC [output: Rope.ROPE] = {
output _ ListerUtil.SetExtension[output, "bl"];
out _ ListerUtil.CreateStream[output]};

CloseOutput: PROC = {
IO.Close[out];  out _ NIL};


<<table bases>>

bcdInterval: VM.Interval;
bcd: BcdDefs.BcdBase;

tb:  BcdDefs.Base;
ssb: BcdDefs.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: Rope.ROPE, span: FileSegment.Span] = {
seg: FileSegment.Pages;
seg _ [
file: OSMiscOps.FindFile[fileName,  ! OSMiscOps.FileError => {GO TO noFile}],  
span: span];
DO
bcdInterval _ ListerUtil.MapPages[seg];
bcd _ VM.AddressForPageNumber[bcdInterval.page];
IF bcd.nPages <= seg.span.pages OR seg.span.pages >= 256 THEN EXIT;
seg.span.pages _ MIN[bcd.nPages, 256];
VM.Free[bcdInterval];
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 [] = {
VM.Free[bcdInterval]};

WriteBcdID: PROC [name: Rope.ROPE, bcd: BcdDefs.BcdBase] = {
out.PutRope[name];
out.PutRope[", version "]; ListerUtil.PutVersionId[out, bcd.version];
IF bcd.source # NullName THEN { 
out.PutRope["\n  source  "];  PutName[bcd.source];
out.PutRope[" of "];  ListerUtil.PutTime[out, LOOPHOLE[bcd.sourceVersion.time]]};
IF bcd.versionIdent # BcdDefs.VersionID THEN {
out.PutRope["\n  (obsolete) version ID = "];
out.Put[IO.int[bcd.versionIdent]]};
out.PutRope["\n  creator "];  ListerUtil.PutVersionId[out, bcd.creator];
out.PutRope["\n\n"]};

PrintStamps: PROC = {
out.PutRope["Imports:\n\n"];
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]]]; out.PutRope[": "]};
PutName[ii.name];
PutFileStamp[ii.file, ii.name];
REPEAT 
Bogus => PrintGarbage[];
ENDLOOP;
out.PutChar['\n];
out.PutRope["Exports:\n\n"];
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]]]; out.PutRope[": "]};
PutName[ee.name];
PutFileStamp[ee.file, ee.name];
REPEAT 
Bogus => PrintGarbage[];
ENDLOOP;
out.PutRope["\nModules:\n\n"];
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]]];  out.PutRope[": "]};
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 => out.PutRope["(null)"];
FTSelf => out.PutRope["(self)"];
ENDCASE => {
IF name # mName THEN {out.PutRope[", file: "];  PutName[name]};
out.PutRope[", version: "];
ListerUtil.PutVersionId[out, version]};
out.PutChar['\n]};


dumpLinks: {none, rt, all} _ none;

PrintBcd: PROC = {
PrintHeader[];
PrintConfigs[];
PrintImports[];
PrintExports[];
PrintExpVars[];
PrintModules[];
PrintFiles[];
PrintFramePacks[];
PrintSpaces[]};

PrintHeader: PROC = {
out.PutRope["Configurations: "];  out.Put[IO.int[bcd.nConfigs]];
out.PutRope[", Modules: "];  out.Put[IO.int[bcd.nModules]];
out.PutRope[", Imports: "];  out.Put[IO.int[bcd.nImports]];
out.PutRope[", Exports: "];  out.Put[IO.int[bcd.nExports]];
out.PutRope[", Dummy: "];  out.Put[IO.int[bcd.firstdummy]];
out.PutRope[", #Dummies: "];  out.Put[IO.int[bcd.nDummies]];
out.PutChar['\n];
IF ~bcd.definitions THEN out.PutChar['~];  
out.PutRope["definitions, "];
IF ~bcd.repackaged THEN out.PutChar['~];  
out.PutRope["repackaged, "];
IF ~bcd.typeExported THEN out.PutChar['~];  
out.PutRope["type exported, "];
IF ~bcd.tableCompiled THEN out.PutChar['~];  
out.PutRope["table compiled, "];
IF ~bcd.versions THEN out.PutChar['~];  
out.PutRope["versions, "];
IF ~bcd.extended THEN out.PutChar['~];  
out.PutRope["extended\n\n"]};

PrintConfigs: PROC = {
cti: CTIndex _ CTIndex.FIRST;
out.PutRope["Configurations"];
PrintIndex[bcd.ctOffset];
out.PutRope[":\n"];
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;
out.PutChar['\n]};

PrintConfig: PROC [cti: CTIndex] = {
OPEN ctb[cti];
Tab[2];
PutName[name];
PrintIndex[cti];
IF namedInstance THEN {
out.PutRope[", instance name: "];  PutInstanceName[[config[cti]]]};
out.PutRope[", file: "];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN {
out.PutRope[", parent: "];
PutName[ctb[config].name];
PrintIndex[config]};
out.PutRope[", #controls: "];  out.Put[IO.int[nControls]];
IF nControls # 0 THEN {
out.PutRope[", controls:"];
FOR i: CARDINAL IN [0..nControls) DO
IF i MOD 6 = 0 THEN Tab[6] ELSE out.PutRope[", "];
WITH c: controls[i] SELECT FROM
module => PutName[mtb[c.mti].name];
config => {PutName[ctb[c.cti].name]; out.PutChar['*]};
ENDCASE => ERROR;
PrintIndex[controls[i]];
ENDLOOP};
out.PutChar['\n]};

PrintImports: PROC = {
iti: IMPIndex _ IMPIndex.FIRST;
out.PutRope["Imports"];
PrintIndex[bcd.impOffset];
out.PutChar[':];
out.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;
out.PutChar['\n]; out.PutChar['\n]};

PrintImport: PROC [iti: IMPIndex] = {
OPEN itb[iti];
Tab[2];
PutName[name];
PrintIndex[iti];
IF port = $module THEN out.PutRope[" (module)"];
IF namedInstance THEN {
out.PutRope[", instance name: "];  PutInstanceName[[import[iti]]]};
out.PutRope[", file: "];
PrintFileName[file];
PrintIndex[file];
out.PutRope[", gfi: "];  out.Put[IO.int[gfi]];
out.PutRope[", ngfi: "];  out.Put[IO.int[ngfi]]};

PrintExports: PROC = {
eti: EXPIndex _ EXPIndex.FIRST;
out.PutRope["Exports"];
PrintIndex[bcd.expOffset];
out.PutChar[':];
out.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 out.PutChar['\n];
out.PutChar['\n]};

PrintExport: PROC [eti: EXPIndex] = {
OPEN etb[eti];
Tab[2];
PutName[name];
PrintIndex[eti];
IF port = $module THEN out.PutRope[" (module)"];
IF namedInstance THEN {
out.PutRope[", instance name: "];  PutInstanceName[[export[eti]]]};
out.PutRope[", file: "];
PrintFileName[file];
PrintIndex[file];
out.PutRope[", "]; 
IF ~typeExported THEN out.PutChar['~];  
out.PutRope["typeExported"];
out.PutRope[", #links: "];  out.Put[IO.int[size]];
IF dumpLinks = all THEN {
out.PutRope[", links:"];
FOR i: CARDINAL IN [0..size) DO
IF i MOD 7 = 0 THEN Tab[4] ELSE out.PutChar[' ];
PrintControlLink[links[i]];
IF i + 1 # size THEN out.PutChar[',];
ENDLOOP};
IF dumpLinks = all THEN out.PutChar['\n]};

PrintExpVars: PROC = {
evi: EVIndex _ EVIndex.FIRST;
evLimit: EVIndex = bcd.evLimit;
out.PutRope["Exported variables:\n"];
UNTIL evi = evLimit DO
PrintExpVar[evi]; 
evi _ evi + evb[evi].length + EVRecord.SIZE; 
ENDLOOP;
out.PutChar['\n]};

PrintExpVar: PROC [evi: EVIndex] = {
OPEN evb[evi];
Tab[2];
PrintIndex[evi];
out.PutRope[", #offsets: "];
out.Put[IO.int[length]];
out.PutRope[", offsets:"];
FOR i: CARDINAL IN [1..length] DO
IF i MOD 8 = 1 THEN Tab[4] ELSE out.PutChar[' ];
out.PutF["%b", IO.card[offsets[i]]];
IF i # length THEN out.PutChar[',];
ENDLOOP;
out.PutChar['\n]};

PrintSpaces: PROC = {
spi: SPIndex _ SPIndex.FIRST;
spLimit: SPIndex = bcd.spLimit;
out.PutRope["Spaces:\n"];
UNTIL spi = spLimit DO
PrintSpace[spi];
spi _ spi + SPRecord.SIZE + spb[spi].length*SpaceID.SIZE;
ENDLOOP;
out.PutChar['\n]};

PrintSpace: PROC [spi: SPIndex] = {
OPEN spb[spi];
Tab[2];
PrintIndex[spi];
out.PutRope[", segment: "];  PrintIndex[seg];
out.PutRope[", #code packs: "];  out.Put[IO.int[length]];
IF length # 0 THEN out.PutRope[", code packs: "];
FOR i: CARDINAL IN [0..length) DO
Tab[4];
out.PutRope["  code pack "];  PutName[spaces[i].name];
out.PutRope[", "];
IF ~spaces[i].resident THEN out.PutChar['~];
out.PutRope["resident, offset: "];
out.PutF["%b", IO.card[spaces[i].offset]];
out.PutRope[", pages: "];
out.Put[IO.int[spaces[i].pages]];
out.PutChar['\n];
ENDLOOP};

PrintModules: PROC = {
mti: MTIndex _ MTIndex.FIRST;
out.PutRope["Modules"];
PrintIndex[bcd.mtOffset];
out.PutRope[":\n"];
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;
out.PutChar['\n]};

PrintModule: PROC [mth: BcdDefs.MTHandle, mti: MTIndex] = {
OPEN mth;
Tab[2];
PutName[name];
PrintIndex[mti];
IF namedInstance THEN {
out.PutRope["instance name: "]; PutInstanceName[[module[mti]]]};
out.PutRope[", file: "];
PrintFileName[file];
PrintIndex[file];
IF config # CTNull THEN {
out.PutRope[", config: "];
PutName[ctb[config].name];
PrintIndex[config]};
Tab[4];
IF tableCompiled THEN out.PutRope["table compiled, "] ELSE {

PutSwitch: PROC [sw: CHAR, value: BOOL] = {
IF ~value THEN out.PutChar['-];  out.PutChar[sw]};

out.PutRope["switches: "];
PutSwitch['b, boundsChecks];
PutSwitch['c, long];
PutSwitch['j, crossJumped];
PutSwitch['l, linkLoc = $code];
PutSwitch['n, nilChecks];
PutSwitch['s, ~initial];
out.PutRope[", "]};
IF ~packageable THEN out.PutChar['~];  out.PutRope["packageable, "];
IF residentFrame THEN out.PutRope["resident frame, "];
Tab[4];
out.PutRope["framesize: "];  out.Put[IO.int[framesize]];
out.PutRope[", gfi: "];  out.Put[IO.int[gfi]];
out.PutRope[", ngfi: "];  out.Put[IO.int[ngfi]];
out.PutRope[", links: "];  out.PutRope[IF linkLoc = $frame THEN "frame" ELSE "code"];
Tab[4];
out.PutRope["code: "];  PrintSegment[code.sgi];
out.PutRope[", offset: "];  out.PutF["%b", IO.card[code.offset]];
out.PutRope[", length: "];  out.PutF["%b", IO.card[code.length]];
IF code.linkspace THEN out.PutRope[", link space"];
IF code.packed THEN out.PutRope[", packed"];
Tab[4];
out.PutRope["symbols: "];  PrintSegment[sseg];
IF variables # EVNull THEN {
Tab[4];  out.PutRope["exported variables: "];  PrintIndex[variables]};
WITH mm: mth^ SELECT FROM
direct => {
Tab[4];
out.PutRope["#links: "];  out.Put[IO.int[mm.length]];
IF dumpLinks = all THEN {
out.PutRope[", links:"];
FOR i: CARDINAL IN [0..mm.length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE out.PutChar[' ];
PrintControlLink[mm.frag[i]];
IF i + 1 # mm.length THEN out.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];
out.PutRope["frame type: "]; out.Put[IO.int[mm.frameType]]};
Tab[4];
PrintRefLits[mm.refLiterals]};
ENDCASE;
out.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] = {
out.PutRope["#links: "];
IF lfi = LFNull THEN out.PutRope["none"]
ELSE {
out.Put[IO.int[lfb[lfi].length]];
IF dumpLinks = all THEN {
out.PutRope[", links:"];
FOR i: CARDINAL IN [0..lfb[lfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE out.PutChar[' ];
PrintControlLink[lfb[lfi].frag[i]];
IF i + 1 # lfb[lfi].length THEN out.PutChar[',];
ENDLOOP}}};

PrintTypes: PROC [tfi: TFIndex] = {
out.PutRope["#types: "];
IF tfi = TFNull THEN out.PutRope["none"]
ELSE {
out.Put[IO.int[tfb[tfi].length]];
out.PutRope[", offset: "];  out.Put[IO.int[tfb[tfi].offset]];
IF dumpLinks # none THEN {
out.PutRope[", indices:"];
FOR i: CARDINAL IN [0..tfb[tfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE out.PutChar[' ];
PrintRTIndex[tfb[tfi].frag[i]];
IF i + 1 # tfb[tfi].length THEN out.PutChar[',];
ENDLOOP}}};

PrintRefLits: PROC [rfi: RFIndex] = {
out.PutRope["#ref lits: "];
IF rfi = RFNull THEN out.PutRope["none"]
ELSE {
out.Put[IO.int[rfb[rfi].length]];
out.PutRope[", offset: "];  out.Put[IO.int[rfb[rfi].offset]];
IF dumpLinks # none THEN {
out.PutRope[", indices:"];
FOR i: CARDINAL IN [0..rfb[rfi].length) DO
IF i MOD 7 = 0 THEN Tab[6] ELSE out.PutChar[' ];
PrintRTIndex[rfb[rfi].frag[i]];
IF i + 1 # rfb[rfi].length THEN out.PutChar[',];
ENDLOOP}}};


PrintFramePacks: PROC = {
fpi: FPIndex _ FPIndex.FIRST;
fpLimit: FPIndex = bcd.fpLimit;
out.PutRope["Frame Packs:\n"];
UNTIL fpi = fpLimit DO
PrintFramePack[fpi];
fpi _ fpi + FPRecord.SIZE + fpb[fpi].length*MTIndex.SIZE;
ENDLOOP;
out.PutChar['\n]};

PrintFramePack: PROC [fpi: FPIndex] = {
OPEN fpb[fpi];
Tab[2];
PutName[name];
PrintIndex[fpi];
out.PutRope[", #modules: "];
out.Put[IO.int[length]];
out.PutRope[", modules:\n"];
FOR i: CARDINAL IN [0..length) DO
IF i MOD 4 = 0 THEN Tab[4] ELSE out.PutChar[' ];
PutName[mtb[modules[i]].name];
PrintIndex[modules[i]];
IF i # length - 1 THEN out.PutChar[',];
ENDLOOP;
out.PutChar['\n]};

PrintSegment: PROC [sgi: SGIndex] = {
IF sgi = BcdDefs.SGNull THEN out.PutRope["(null)"]
ELSE {
PrintFileName[sgb[sgi].file];
out.PutRope[" [base: "];  out.Put[IO.int[sgb[sgi].base]];
out.PutRope[", pages: "];  out.Put[IO.int[sgb[sgi].pages]];
IF sgb[sgi].extraPages # 0 THEN {out.PutChar['+];  out.Put[IO.int[sgb[sgi].extraPages]]};
out.PutChar[']]}};

PrintFiles: PROC = {
fti: FTIndex _ FTIndex.FIRST;
out.PutRope["Files"];
PrintIndex[bcd.ftOffset];
out.PutRope[":\n"];
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;
out.PutChar['\n]; out.PutChar['\n]};

PrintFile: PROC [fti: FTIndex] = {
OPEN ftb[fti];
Tab[2];
SELECT fti FROM
FTNull => out.PutRope["(null)"];
FTSelf => out.PutRope["(self)"];
ENDCASE => {
PutName[name];
PrintIndex[fti];
out.PutRope[", version: "];
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 out.PutRope["No RT Extensions"]
ELSE {
ListerUtil.PrintRTBcd[out, bcd, sorted];
PrintSymbolSegments[];
PrintFiles[]};
out.PutChar['\n]; out.PutChar['\n]};

PrintSymbolSegments: PROC = {
sgi: SGIndex _ SGIndex.FIRST;
out.PutRope["Symbol Segments\n"];
UNTIL sgi = bcd.sgLimit DO
IF sgb[sgi].class = $symbols THEN {
Tab[1];
PrintIndex[sgi];  out.PutChar[' ];
PrintSegment[sgi]};
sgi _ sgi + SGRecord.SIZE;
ENDLOOP;
out.PutChar['\n]; out.PutChar['\n]};


<<Utility Prints>>

PrintControlLink: PROC [link: Link] = {
SELECT TRUE FROM
(link = BcdDefs.NullLink) => 
out.PutRope["(null link)"];
link.proc => {  
out.PutRope["proc["];  
out.Put[IO.int[link.gfi]]; out.PutChar[',]; out.Put[IO.int[link.ep]]; out.PutChar[']]};
link.type => {  
out.PutRope["type["];  
IF link.typeID = BcdDefs.TYPNull THEN out.PutRope["null"] 
ELSE out.Put[IO.card[LOOPHOLE[link.typeID, CARDINAL]]];
out.PutChar[']]};
ENDCASE => {  
out.PutRope["var["];  
out.Put[IO.int[link.vgfi]]; out.PutChar[',]; out.Put[IO.int[link.var]]; out.PutChar[']]}};

PrintRTIndex: PROC [index: NAT] = {
out.PutChar['[]; out.Put[IO.int[index]]; out.PutChar[']]};


PrintFileName: PROC [fti: FTIndex] = {
SELECT fti FROM
FTNull => out.PutRope["(null)"];
FTSelf => out.PutRope["(self)"];
ENDCASE => PutName[ftb[fti].name]};

PrintIndex: PROC [index: UNSPECIFIED] = {
out.PutRope[" ["]; out.Put[IO.card[LOOPHOLE[index, CARDINAL]]]; out.PutChar[']]};

PrintGarbage: PROC = {
Tab[2];
out.PutRope["? Looks like garbage ...\n"]};

PrintAnonName: PROC = {out.PutRope[" (anon) "]};

Tab: PROC [n: CARDINAL] = {
out.PutChar['\n];
THROUGH [1..n/8] DO out.PutChar['\t] ENDLOOP;
THROUGH [1..n MOD 8] DO out.PutChar[' ] ENDLOOP};


<<Utility Puts>>

PutName: PROC [n: NameRecord] = {
ssd: ConvertUnsafe.SubString _
[base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
IO.PutRope[out, ConvertUnsafe.SubStringToRope[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: Rope.ROPE] = {
fileName: Rope.ROPE;
fileName _ ListerUtil.SetExtension[root, "bcd"];
InstallBcd[fileName, defaultSpan];
IF bcd = NIL THEN ListerUtil.Message["File not found"]
ELSE {
out _ ListerUtil.GetTypescript[];
out.PutChar['\n];
out.PutRope[fileName];
out.PutRope[", version "]; ListerUtil.PutVersionId[out, bcd.version];
IF bcd.versionIdent # VersionID THEN {
out.PutRope["\n  (obsolete) version ID = "];
out.Put[IO.int[bcd.versionIdent]]}
ELSE IF bcd.source # BcdDefs.NullName THEN {
out.PutRope["\n  source "]; PutName[bcd.source];
out.PutRope[" of "];  ListerUtil.PutTime[out, LOOPHOLE[bcd.sourceVersion.time]]};
out.PutRope["\n  creator "]; ListerUtil.PutVersionId[out, bcd.creator];
out.PutChar['\n];
IO.Close[out];  out _ NIL;
UnstallBcd[]}};

BcdProc: PROC [root, output: Rope.ROPE, span: FileSegment.Span, proc: PROC] = {
fileName: Rope.ROPE;
fileName _ ListerUtil.SetExtension[root, "bcd"];
InstallBcd[fileName, span];
IF bcd = NIL THEN ListerUtil.Message["File not found"]
ELSE {
OpenOutput[output];
WriteBcdID[fileName, bcd];
IF bcd.versionIdent # BcdDefs.VersionID THEN
ListerUtil.Message["Obsolete format, ouput may be garbage"];
proc[];
CloseOutput[];
UnstallBcd[]}};

ListStamps: PUBLIC PROC [root, output: Rope.ROPE] = {
BcdProc[root, output, [1,  10], PrintStamps]};

ListFiles: PUBLIC PROC [root, output: Rope.ROPE] = {
BcdProc[root, output, defaultSpan, PrintFiles]};


BcdSegment: PUBLIC PROC [
root, output: Rope.ROPE,
span: FileSegment.Span,
links: BOOL] = {
dumpLinks _ IF links THEN all ELSE none;
BcdProc[root, output, span, PrintBcd];
dumpLinks _ none};

ListRTBcd: PUBLIC PROC [root, output: Rope.ROPE, sorted: BOOL] = {
dumpLinks _ rt;  
BcdProc[root, output, defaultSpan, IF sorted THEN PrintRTSorted ELSE PrintRT];
dumpLinks _ none};


ListBcd: PUBLIC PROC [root, output: Rope.ROPE, links: BOOL] = {
IF links THEN dumpLinks _ all;  
BcdProc[root, output, defaultSpan, PrintBcd];  
dumpLinks _ none};

}.