-- 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};
    
  }.