-- ListBcd.Mesa  
--  Last edited by Lewis on 14-Jan-81 16:04:17
--  Last edited by Sweet on 17-Feb-81 12:23:01
--  Last edited by Satterthwaite on September 20, 1982 1:36 pm

DIRECTORY
  BcdDefs: TYPE USING [
    Base, BCD, Link, 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],
  CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
  Environment: TYPE USING [PageCount, PageNumber, wordsPerPage],
  FileSegment: TYPE USING [Pages],
  ListerDefs: TYPE USING [
    Indent, MapPages, PrintRTBcd,
    WriteChar, WriteDecimal, WriteOctal, WriteString, WriteVersionId],
  OSMiscOps: TYPE USING [FileError, FindFile],
  OutputDefs: TYPE USING [
    CloseOutput, OpenOutput, PutChar, PutCR, PutDecimal, PutLongSubString, PutOctal, 
    PutString, PutTime],
  RTBcd: TYPE USING [RTBase],
  Space: TYPE USING [Error, Handle, LongPointer, Delete],
  Strings: TYPE USING [AppendString, SubStringDescriptor],
  Time: TYPE USING [Append, Unpack];

ListBcd: PROGRAM
    IMPORTS
      CommanderOps, ListerDefs, OSMiscOps, OutputDefs, Space, Strings, Time = {
  OPEN OutputDefs, BcdDefs;
  
  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;
  rtHeader: RTBcd.RTBase;
  
  InstallBcd: PROC [seg: FileSegment.Pages] = {
    DO
      bcdSpace _ ListerDefs.MapPages[seg];
      bcd _ bcdSpace.LongPointer;
      IF bcd.nPages <= seg.span.pages THEN EXIT;
      seg.span.pages _ bcd.nPages;
      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;
    rtHeader _ IF bcd.extended AND bcd.rtPages.pages # 0
      THEN LOOPHOLE[bcd + bcd.rtPages.relPageBase*Environment.wordsPerPage]
      ELSE NIL};
    
  UnstallBcd: PROC [seg: FileSegment.Pages] = {
    Space.Delete[bcdSpace]};
    
  WriteBcdID: PROC [name: STRING, bcd: BcdOps.BcdBase] = {
    PutString[name];
    PutString[", version "L]; ListerDefs.WriteVersionId[bcd.version];
    IF bcd.source # NullName THEN { 
      PutString["\n  source  "L];  PutName[bcd.source];
      PutString[" of "L];  PutTime[[bcd.sourceVersion.time]]};
    IF bcd.versionIdent # BcdDefs.VersionID THEN {
      PutString["\n  (obsolete) version ID = "L];
      PutDecimal[bcd.versionIdent]};
    PutString["\n  creator "L];  ListerDefs.WriteVersionId[bcd.creator];
    PutString["\n\n"L]};

  PrintStamps: PROC = {
    PutString["Imports:\n\n"L];
    FOR iti: IMPIndex _ FIRST[IMPIndex], iti + SIZE[IMPRecord]
	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;
    PutCR[];
    PutString["Exports:\n\n"L];
    FOR eti: EXPIndex _ FIRST[EXPIndex], eti + etb[eti].size + SIZE[EXPRecord]
	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 _ FIRST[MTIndex], 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];
	ListerDefs.WriteVersionId[version]};
    PutCR[]};
    
  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];
    PutCR[];
    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 _ FIRST[CTIndex];
    PutString["Configurations"L];
    PrintIndex[bcd.ctOffset];
    PutString[":\n"L];
    UNTIL cti = bcd.ctLimit DO
      PrintConfig[cti];
      cti _ cti + SIZE[CTRecord] + ctb[cti].nControls;
      IF LOOPHOLE[cti, CARDINAL] > LOOPHOLE[bcd.ctLimit, CARDINAL] THEN GO TO Bogus;
      REPEAT 
        Bogus => PrintGarbage[];
      ENDLOOP;
    PutCR[]};
    
  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};
    PutCR[]};
    
  PrintImports: PROC = {
    iti: IMPIndex _ FIRST[IMPIndex];
    PutString["Imports"L];
    PrintIndex[bcd.impOffset];
    PutChar[':];
    PutCR[];
    UNTIL iti = bcd.impLimit DO
      PrintImport[iti];
      iti _ iti + SIZE[IMPRecord];
      IF LOOPHOLE[iti, CARDINAL] > LOOPHOLE[bcd.impLimit, CARDINAL] THEN GO TO Bogus;
      REPEAT 
        Bogus => PrintGarbage[];
      ENDLOOP;
    PutCR[]; PutCR[]};
    
  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 _ FIRST[EXPIndex];
    PutString["Exports"L];
    PrintIndex[bcd.expOffset];
    PutChar[':];
    PutCR[];
    UNTIL eti = bcd.expLimit DO
      PrintExport[eti];
      eti _ eti + etb[eti].size + SIZE[EXPRecord];
      IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN GO TO Bogus;
      REPEAT 
        Bogus => PrintGarbage[];
      ENDLOOP;
    IF DumpLinks # all THEN PutCR[];
    PutCR[]};
    
  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 PutCR[]};
    
  PrintExpVars: PROC = {
    evi: EVIndex _ FIRST[EVIndex];
    evLimit: EVIndex = bcd.evLimit;
    PutString["Exported variables:\n"L];
    UNTIL evi = evLimit DO
      PrintExpVar[evi]; 
      evi _ evi + evb[evi].length + SIZE[EVRecord]; 
      ENDLOOP;
    PutCR[]};
    
  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;
    PutCR[]};
    
  PrintSpaces: PROC = {
    spi: SPIndex _ FIRST[SPIndex];
    spLimit: SPIndex = bcd.spLimit;
    PutString["Spaces:\n"L];
    UNTIL spi = spLimit DO
      PrintSpace[spi];
      spi _ spi + SIZE[SPRecord] + spb[spi].length*SIZE[SpaceID];
      ENDLOOP;
    PutCR[]};
    
  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];
      PutCR[];
      ENDLOOP};
    
  PrintModules: PROC = {
    mti: MTIndex _ FIRST[MTIndex];
    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;
    PutCR[]};
    
  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;
    PutCR[]};
    
  MTSize: PROC [mti: MTIndex] RETURNS [NAT] = {
    RETURN [WITH m: mtb[mti] SELECT FROM
      direct => SIZE[direct MTRecord] + m.length,
      indirect => SIZE[indirect MTRecord],
      multiple => SIZE[multiple MTRecord],
      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 _ FIRST[FPIndex];
    fpLimit: FPIndex = bcd.fpLimit;
    PutString["Frame Packs:\n"L];
    UNTIL fpi = fpLimit DO
      PrintFramePack[fpi];
      fpi _ fpi + SIZE[FPRecord] + fpb[fpi].length*SIZE[MTIndex];
      ENDLOOP;
    PutCR[]};
    
  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;
    PutCR[]};
    
  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 _ FIRST[FTIndex];
    PutString["Files"L];
    PrintIndex[bcd.ftOffset];
    PutString[":\n"L];
    UNTIL fti = bcd.ftLimit DO
      PrintFile[fti];
      fti _ fti + SIZE[FTRecord];
      IF LOOPHOLE[fti, CARDINAL] > LOOPHOLE[bcd.ftLimit, CARDINAL] THEN GO TO Bogus;
      REPEAT 
        Bogus => PrintGarbage[];
      ENDLOOP;
    PutCR[]; PutCR[]};
    
  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];
	ListerDefs.WriteVersionId[version]}};
    
  PrintRTBcdExt: PROC = {
    PrintHeader[];
    PrintConfigs[];
    PrintModules[];
    IF rtHeader = NIL THEN PutString["No RT Extensions"L]
    ELSE {
      ListerDefs.PrintRTBcd[rtHeader];
      PrintSymbolSegments[]};
    PutCR[]; PutCR[]};
    
  PrintSymbolSegments: PROC = {
    sgi: SGIndex _ FIRST[SGIndex];
    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 + SIZE[SGRecord];
      ENDLOOP;
    PutCR[]};
    

  -- 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]};
  
    
  -- Utility Puts
  
  PutName: PROC [n: NameRecord] = {
    ssd: Strings.SubStringDescriptor _
      [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
    PutLongSubString[@ssd]};
    
  Tab: PROC [n: CARDINAL] = {ListerDefs.Indent[n]};
    
  PutInstanceName: PROC [n: Namee] = {
    
    FindName: PROC [ntb: Base, nti: NTIndex] RETURNS [stop: BOOLEAN] = {
      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 [BOOLEAN]] RETURNS [nti: NTIndex] = {
    FOR nti _ FIRST[NTIndex], nti + SIZE[NTRecord] UNTIL nti = bcd.ntLimit DO
      IF proc[ntb, nti] THEN RETURN[nti]; 
      ENDLOOP;
    RETURN [NTNull]};
    
  Version: PROC [root: STRING] = {
    bcdfile: STRING _ [40];
    seg: FileSegment.Pages;
    Strings.AppendString[bcdfile, root];
    FOR i: CARDINAL IN [0..bcdfile.length) DO
      IF bcdfile[i] = '. THEN EXIT;
      REPEAT 
        FINISHED => Strings.AppendString[bcdfile, ".bcd"L];
      ENDLOOP;
    seg _ [
      file: OSMiscOps.FindFile[bcdfile ! OSMiscOps.FileError => GO TO NoFile], 
      span: [base: 1, pages: 10]];
    InstallBcd[seg];
    ListerDefs.WriteChar['\n];
    ListerDefs.WriteString[bcdfile];
    ListerDefs.WriteString[", version "L];  WriteVersion[bcd.version];
    IF bcd.source # BcdDefs.NullName THEN {
      ListerDefs.WriteString["\n  source "L];  WriteName[bcd.source];
      ListerDefs.WriteString[" of "L];  WriteTime[bcd.sourceVersion.time]};
    IF bcd.versionIdent # VersionID THEN {
      ListerDefs.WriteString["\n  (obsolete) version ID = "L];
      ListerDefs.WriteDecimal[bcd.versionIdent]};
    ListerDefs.WriteString["\n  creator "L];  WriteVersion[bcd.creator];
    ListerDefs.WriteChar['\n];
    UnstallBcd[seg];
    EXITS 
      NoFile => ListerDefs.WriteString["File not found"L]};
    
  WriteVersion: PROC [stamp: BcdDefs.VersionStamp] = {
    StampWords: CARDINAL = SIZE[BcdDefs.VersionStamp];
    str: PACKED ARRAY [0..4*StampWords) OF [0..16) = LOOPHOLE[stamp];
    digit: STRING = "0123456789abcdef"L;
    ListerDefs.WriteChar['"];
    FOR i: CARDINAL IN [0..4*StampWords) DO
      ListerDefs.WriteChar[digit[str[i]]] ENDLOOP;
    ListerDefs.WriteString["\" ("L];
    WriteTime[stamp.time]; ListerDefs.WriteString[", "]; WriteMachine[stamp]};

  WriteTime: PROC [time: LONG CARDINAL] = {
    t: STRING _ [20];
    Time.Append[t, Time.Unpack[LOOPHOLE[time]]];
    ListerDefs.WriteString[t]};
    
  WriteName: PROC [n: BcdDefs.NameRecord] = {
    ssd: Strings.SubStringDescriptor _
      [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
    FOR i: CARDINAL IN [ssd.offset .. ssd.offset+ssd.length) DO
      ListerDefs.WriteChar[ssd.base[i]];
      ENDLOOP};
        
  WriteMachine: PROC [version: BcdDefs.VersionStamp] = {
    ListerDefs.WriteOctal[version.net];   ListerDefs.WriteChar['#];
    ListerDefs.WriteOctal[version.host];  ListerDefs.WriteChar['#]};
        
  BcdProc: PROC [
        root: STRING,
	base: Environment.PageNumber, pages: Environment.PageCount,
	proc: PROC] = {
    bcdfile: STRING _ [40];
    seg: FileSegment.Pages;
    Strings.AppendString[bcdfile, root];
    FOR i: CARDINAL IN [0..bcdfile.length) DO
      IF bcdfile[i] = '. THEN EXIT;
      REPEAT 
        FINISHED => Strings.AppendString[bcdfile, ".bcd"L];
      ENDLOOP;
    seg _ [
      file: OSMiscOps.FindFile[bcdfile, ! OSMiscOps.FileError => GO TO NoFile],  
      span: [base: base, pages: pages]];
    InstallBcd[seg];
    OpenOutput[root, ".bl"L];
    WriteBcdID[bcdfile, bcd];
    proc[];
    CloseOutput[];
    UnstallBcd[seg];
    EXITS 
      NoFile => ListerDefs.WriteString["File not found"L]};
    
  Stamps: PROC [root: STRING] = {
    BcdProc[root, 1,  10, PrintStamps]};
    
  Files: PROC [root: STRING] = {
    BcdProc[root, 1, 10, PrintFiles]};
    
  
  Bcd: PROC [root: STRING] = {
    BcdProc[root, 1, 10, PrintBcd]};
    
  BcdLinks: PROC [root: STRING] = {
    DumpLinks _ all;  
    Bcd[root];  
    DumpLinks _ none};
    
  BcdSegment: PROC [
      root: STRING,
      base: Environment.PageNumber, pages: Environment.PageCount,
      links: BOOLEAN] = {
    DumpLinks _ IF links THEN all ELSE none;
      BEGIN
      BcdProc[root, base, pages, PrintBcd ! Space.Error => GO TO BadSegment];
      EXITS
        BadSegment => ListerDefs.WriteString["Bad Segment"L];
      END;
    DumpLinks _ none};
    
  RTBcdExt: PROC [root: STRING] = {
    DumpLinks _ rt;  
    BcdProc[root, 1, 10, PrintRTBcdExt];
    DumpLinks _ none};
    
    
  DumpLinks: {none, rt, all} _ none;
  
  Init: PROC = {
    command: CommanderOps.CommandBlockHandle;
    command _ CommanderOps.AddCommand["Bcd", LOOPHOLE[Bcd], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderOps.AddCommand["BcdLinks", LOOPHOLE[BcdLinks], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderOps.AddCommand["Version", LOOPHOLE[Version], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderOps.AddCommand["Stamps", LOOPHOLE[Stamps], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderOps.AddCommand["Files", LOOPHOLE[Files], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderOps.AddCommand["BcdSegment", LOOPHOLE[BcdSegment], 4];
    command.params[0] _ [type: string, prompt: "Filename"];
    command.params[1] _ [type: numeric, prompt: "Base"];
    command.params[2] _ [type: numeric, prompt: "Pages"];
    command.params[3] _ [type: boolean, prompt: "Links"];
    command _ CommanderOps.AddCommand["RTBcd", LOOPHOLE[RTBcdExt], 1];
    command.params[0] _ [type: string, prompt: "Filename"]};
    
  Init[];
  
  }.