-- ListBcd.Mesa  
--  Last edited by Lewis on May 15, 1980  4:28 PM
--  Last edited by Sweet on September 22, 1980  9:51 AM

DIRECTORY
  AltoDefs USING [PageCount, PageNumber],
  BcdDefs USING [
    Base, BCD, Link, CTIndex, CTNull, CTRecord, EXPIndex, EXPRecord, EVNull,
    FPIndex, FPRecord, FTIndex, FTNull, FTRecord, FTSelf, IMPIndex, IMPRecord,
    MTIndex, MTRecord, Namee, NameRecord, NTIndex, NTNull, NTRecord, NullName,
    SGIndex, VersionID, EVIndex, SpaceID, SPIndex, EVRecord, SPRecord],
  BcdOps USING [MTHandle, NameString],
  CommanderDefs USING [AddCommand, CommandBlockHandle],
  IODefs USING [WriteString],
  ListerDefs USING [Indent, PrintMachine, WriteVersions],
  OutputDefs USING [
    CloseOutput, GetOutputStream, OpenOutput, outStream, PutChar, PutCR,
    PutDecimal, PutOctal, PutString, PutSubString, PutTime],
  SegmentDefs USING [
    DefaultVersion, FileNameError, FileSegmentAddress, FileSegmentHandle,
    InvalidSegmentSize, MoveFileSegment, NewFile, NewFileSegment, Read,
    SegmentFault, SwapError, SwapIn, SwapOut, Unlock],
  StreamDefs USING [GetDefaultDisplayStream],
  String USING [AppendString, SubStringDescriptor];

ListBcd: PROGRAM
  IMPORTS CommanderDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs, StreamDefs, String
  EXPORTS ListerDefs =
  BEGIN OPEN OutputDefs, BcdDefs;
  
  bcd: POINTER TO BCD;
  tb: Base;
  ssb: BcdOps.NameString;
  evb: Base;
  spb: Base;
  fpb: Base;
  ctb: Base;
  mtb: Base;
  itb: Base;
  etb: Base;
  sgb: Base;
  ftb: Base;
  ntb: Base;
  
  InstallBcd: PROCEDURE [seg: SegmentDefs.FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    size: CARDINAL;
    IF ~seg.swappedin THEN SwapIn[seg];
    bcd _ FileSegmentAddress[seg];
    IF (size _ bcd.nPages) # seg.pages THEN
      BEGIN
      Unlock[seg];
      MoveFileSegment[seg, seg.base, size];
      SwapIn[seg];
      bcd _ FileSegmentAddress[seg];
      END;
    tb _ LOOPHOLE[bcd];
    ssb _ LOOPHOLE[bcd + bcd.ssOffset];
    ctb _ tb + bcd.ctOffset;
    mtb _ tb + bcd.mtOffset;
    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;
    RETURN
    END;
    
  UnstallBcd: PROCEDURE [seg: SegmentDefs.FileSegmentHandle] =
    BEGIN OPEN SegmentDefs;
    IF seg.swappedin THEN Unlock[seg];
    SwapOut[seg];
    RETURN
    END;
    
  WriteBcdID: PROCEDURE [name: STRING, bcd: POINTER TO BCD] =
    BEGIN
    PutString[name];
    PutString[" configured "];
    PutTime[LOOPHOLE[bcd.version.time]];
    IF bcd.source # NullName THEN
      BEGIN PutString[" from "]; PutName[bcd.source]; END;
    PutString[" by "];
    ListerDefs.PrintMachine[bcd.version];
    IF bcd.versionIdent # VersionID THEN
      BEGIN
      PutString["  Obsolete VersionID = "];
      PutDecimal[bcd.versionIdent]
      END;
    PutCR[];
    PutString["  Configured by "];
    PutTime[LOOPHOLE[bcd.creator.time]];
    PutString[" "];
    ListerDefs.PrintMachine[bcd.creator];
    PutCR[];
    PutCR[];
    RETURN
    END;

  PrintStamps: PROC =
    BEGIN
    PutString["Imports:"L]; PutCR[]; PutCR[];
    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:"L]; PutCR[]; PutCR[];
    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;
    PutCR[];
    PutString["Modules:"L]; PutCR[]; PutCR[];
    FOR mti: MTIndex _ FIRST[MTIndex],
	mti + SIZE[MTRecord] + mtb[mti].frame.length 
	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;
    END;
    
  PutFileStamp: PUBLIC PROCEDURE [fti: FTIndex, mName: NameRecord] =
    BEGIN OPEN ftb[fti];
    SELECT fti FROM
      FTNull => PutString["(null)"];
      FTSelf => PutString["(self)"];
      ENDCASE =>
	BEGIN
	IF name # mName THEN {PutString[", file: "L]; PutName[name]};
	PutString[", time: "];
	PutTime[LOOPHOLE[version.time]];
	PutString[", processor: "];
	ListerDefs.PrintMachine[version];
	END;
    PutCR[];
    RETURN
    END;
  PrintBcd: PUBLIC PROCEDURE =
    BEGIN
    PrintHeader[];
    PrintConfigs[];
    PrintImports[];
    PrintExports[];
    PrintExpVars[];
    PrintModules[];
    PrintFiles[];
    PrintFramePacks[];
    PrintSpaces[];
    RETURN
    END;
    
  PrintHeader: PUBLIC PROCEDURE =
    BEGIN
    PutString["Configurations: "];
    PutDecimal[bcd.nConfigs];
    PutString[", Modules: "];
    PutDecimal[bcd.nModules];
    PutString[", Imports: "];
    PutDecimal[bcd.nImports];
    PutString[", Exports: "];
    PutDecimal[bcd.nExports];
    PutString[", Dummy: "];
    PutDecimal[bcd.firstdummy];
    PutString[", #Dummies: "];
    PutDecimal[bcd.nDummies];
    PutCR[];
    PutCR[];
    RETURN
    END;
    
  PrintConfigs: PUBLIC PROCEDURE =
    BEGIN
    cti: CTIndex _ FIRST[CTIndex];
    PutString["Configurations"];
    PrintIndex[bcd.ctOffset];
    PutChar[':];
    PutCR[];
    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[];
    RETURN
    END;
    
  PrintConfig: PUBLIC PROCEDURE [cti: CTIndex] =
    BEGIN OPEN ctb[cti];
    Tab[2];
    PutName[name];
    PrintIndex[cti];
    IF namedInstance THEN
      BEGIN PutString[", instance: "]; PutInstanceName[[config[cti]]]; END;
    PutString[", file: "];
    PrintFileName[file];
    PrintIndex[file];
    IF config # CTNull THEN
      BEGIN
      PutString[", parent: "];
      PutName[ctb[config].name];
      PrintIndex[config];
      END;
    IF nControls # 0 THEN
      BEGIN
      i: CARDINAL;
      first: BOOLEAN _ TRUE;
      PutString[", controls: ["];
      FOR i IN [0..nControls) DO
	IF first THEN first _ FALSE ELSE PutString[", "L];
	PutName[mtb[controls[i]].name];
	PrintIndex[controls[i]];
	ENDLOOP;
      PutChar[']];
      END;
    PutCR[];
    RETURN
    END;
    
  PrintImports: PUBLIC PROCEDURE =
    BEGIN
    iti: IMPIndex _ FIRST[IMPIndex];
    PutString["Imports"];
    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[];
    RETURN
    END;
    
  PrintImport: PUBLIC PROCEDURE [iti: IMPIndex] =
    BEGIN OPEN itb[iti];
    Tab[2];
    PutName[name];
    PrintIndex[iti];
    IF port = module THEN PutString[" (module)"];
    IF namedInstance THEN
      BEGIN PutString[", instance: "]; PutInstanceName[[import[iti]]]; END;
    PutString[", file: "];
    PrintFileName[file];
    PrintIndex[file];
    PutString[", gfi: "];
    PutDecimal[gfi];
    PutString[", ngfi: "];
    PutDecimal[ngfi];
    PutCR[];
    RETURN
    END;
    
  PrintExports: PUBLIC PROCEDURE =
    BEGIN
    eti: EXPIndex _ FIRST[EXPIndex];
    PutString["Exports"];
    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;
    PutCR[];
    RETURN
    END;
    
  PrintExport: PUBLIC PROCEDURE [eti: EXPIndex] =
    BEGIN OPEN etb[eti];
    i: CARDINAL;
    Tab[2];
    PutName[name];
    PrintIndex[eti];
    IF port = module THEN PutString[" (module)"];
    IF namedInstance THEN
      BEGIN PutString[", instance: "]; PutInstanceName[[export[eti]]]; END;
    PutString[", file: "];
    PrintFileName[file];
    PrintIndex[file];
    PutString[", size: "];
    PutDecimal[size];
    IF DumpLinks THEN
      BEGIN
      PutString[", links:"];
      FOR i IN [0..size) DO
	IF i MOD 8 = 0 THEN Tab[4] ELSE PutChar[' ];
	PrintControlLink[links[i]];
	IF i + 1 # size THEN PutChar[',];
	ENDLOOP;
      END;
    PutCR[];
    RETURN
    END;
    
  PrintExpVars: PUBLIC PROCEDURE =
    BEGIN
    evi: EVIndex _ FIRST[EVIndex];
    evLimit: EVIndex = bcd.evLimit;
    PutString["Exported variables:"L];
    PutCR[];
    UNTIL evi = evLimit DO
      PrintExpVar[evi]; evi _ evi + evb[evi].length + SIZE[EVRecord]; ENDLOOP;
    PutCR[];
    RETURN
    END;
    
  PrintExpVar: PUBLIC PROCEDURE [evi: EVIndex] =
    BEGIN OPEN evb[evi];
    i: CARDINAL;
    Tab[2];
    PrintIndex[evi];
    PutString[", length: "L];
    PutDecimal[length];
    PutString[", offsets:"L];
    PutCR[];
    FOR i IN [1..length] DO
      IF i MOD 8 = 1 THEN Tab[4] ELSE PutChar[' ];
      PutOctal[offsets[i]];
      IF i # length THEN PutChar[',];
      ENDLOOP;
    PutCR[];
    RETURN
    END;
    
  PrintSpaces: PUBLIC PROCEDURE =
    BEGIN
    spi: SPIndex _ FIRST[SPIndex];
    spLimit: SPIndex = bcd.spLimit;
    PutString["Spaces:"L];
    PutCR[];
    UNTIL spi = spLimit DO
      PrintSpace[spi];
      spi _ spi + SIZE[SPRecord] + spb[spi].length*SIZE[SpaceID];
      ENDLOOP;
    PutCR[];
    RETURN
    END;
    
  PrintSpace: PUBLIC PROCEDURE [spi: SPIndex] =
    BEGIN OPEN spb[spi];
    i: CARDINAL;
    Tab[2];
    PrintIndex[spi];
    PutString[", segment: "L];
    PrintIndex[seg];
    PutString[", length: "L];
    PutDecimal[length];
    FOR i IN [0..length) DO
      Tab[4];
      PutName[spaces[i].name];
      IF spaces[i].resident THEN PutString[", resident"L];
      PutString[", offset: "L];
      PutOctal[spaces[i].offset];
      PutString[", pages: "L];
      PutDecimal[spaces[i].pages];
      PutCR[];
      ENDLOOP;
    RETURN
    END;
    
  PrintModules: PUBLIC PROCEDURE =
    BEGIN
    mti: MTIndex _ FIRST[MTIndex];
    PutString["Modules"];
    PrintIndex[bcd.mtOffset];
    PutChar[':];
    PutCR[];
    UNTIL mti = bcd.mtLimit DO
      PrintModule[@mtb[mti], mti];
      mti _ mti + SIZE[MTRecord] + mtb[mti].frame.length;
      IF LOOPHOLE[mti, CARDINAL] > LOOPHOLE[bcd.mtLimit, CARDINAL] THEN
	GO TO Bogus;
      REPEAT Bogus => PrintGarbage[];
      ENDLOOP;
    PutCR[];
    RETURN
    END;
    
  PrintModule: PUBLIC PROCEDURE [mth: BcdOps.MTHandle, mti: MTIndex] =
    BEGIN OPEN mth;
    i: CARDINAL;
    Tab[2];
    PutName[name];
    PrintIndex[mti];
    IF namedInstance THEN
      BEGIN PutString["instance: "]; PutInstanceName[[module[mti]]]; END;
    PutString[", file: "];
    PrintFileName[file];
    PrintIndex[file];
    PutString[", links: "];
    PutString[IF links = frame THEN "frame" ELSE "code"];
    IF config # CTNull THEN
      BEGIN
      PutString[", config: "];
      PutName[ctb[config].name];
      PrintIndex[config];
      END;
    Tab[4];
    PutString[IF altoCode THEN "Alto code"L ELSE "DStar code"L];
    IF residentFrame THEN PutString[", resident frame"L];
    IF crossJumped THEN PutString[", cross jumped"L];
    IF packageable THEN PutString[", packageable"L];
    PutString[", framesize: "];
    PutDecimal[framesize];
    PutString[", gfi: "];
    PutDecimal[gfi];
    PutString[", ngfi: "];
    PutDecimal[ngfi];
    Tab[4];
    PutString["code: "];
    PrintSegment[code.sgi];
    PutString[", offset: "];
    PutOctal[code.offset];
    PutString[", length: "];
    PutOctal[code.length];
    IF code.linkspace THEN PutString[", link space"L];
    IF code.packed THEN PutString[", packed"L];
    IF long THEN PutString[", long"L];
    IF tableCompiled THEN PutString[", tableCompiled"L];
    IF boundsChecks THEN PutString[", boundsChecks"L];
    IF nilChecks THEN PutString[", nilChecks"L];
    Tab[4];
    PutString["symbols: "];
    PrintSegment[sseg];
    IF variables # EVNull THEN
      BEGIN Tab[4]; PutString["variables: "]; PrintIndex[variables] END;
    BEGIN OPEN frame;
    Tab[4];
    PutString["frame length: "];
    PutDecimal[length];
    IF DumpLinks THEN
      BEGIN
      PutString[", control links:"];
      FOR i IN [0..length) DO
	IF i MOD 8 = 0 THEN Tab[6] ELSE PutChar[' ];
	PrintControlLink[frag[i]];
	IF i + 1 # length THEN PutChar[',];
	ENDLOOP;
      END;
    END;
    PutCR[];
    RETURN
    END;
    
  PrintFramePacks: PUBLIC PROCEDURE =
    BEGIN
    fpi: FPIndex _ FIRST[FPIndex];
    fpLimit: FPIndex = bcd.fpLimit;
    PutString["Frame Packs:"L];
    PutCR[];
    UNTIL fpi = fpLimit DO
      PrintFramePack[fpi];
      fpi _ fpi + SIZE[FPRecord] + fpb[fpi].length*SIZE[MTIndex];
      ENDLOOP;
    PutCR[];
    RETURN
    END;
    
  PrintFramePack: PUBLIC PROCEDURE [fpi: FPIndex] =
    BEGIN OPEN fpb[fpi];
    i: CARDINAL;
    Tab[2];
    PutName[name];
    PrintIndex[fpi];
    PutString[", length: "L];
    PutDecimal[length];
    PutString[", modules:"L];
    PutCR[];
    FOR i 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[];
    RETURN
    END;
    
  PrintSegment: PUBLIC PROCEDURE [sgi: SGIndex] =
    BEGIN OPEN sd: sgb[sgi];
    PrintFileName[sd.file];
    PutString[" [base: "];
    PutDecimal[sd.base];
    PutString[", pages: "];
    PutDecimal[sd.pages];
    IF sd.extraPages # 0 THEN BEGIN PutChar['+]; PutDecimal[sd.extraPages]; END;
    PutChar[']];
    RETURN
    END;
    
  PrintFiles: PUBLIC PROCEDURE =
    BEGIN
    fti: FTIndex _ FIRST[FTIndex];
    PutString["Files"];
    PrintIndex[bcd.ftOffset];
    PutChar[':];
    PutCR[];
    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[];
    RETURN
    END;
    
  PrintFile: PUBLIC PROCEDURE [fti: FTIndex] =
    BEGIN OPEN ftb[fti];
    Tab[2];
    SELECT fti FROM
      FTNull => PutString["(null)"];
      FTSelf => PutString["(self)"];
      ENDCASE =>
	BEGIN
	PutName[name];
	PrintIndex[fti];
	PutString[", time: "];
	PutTime[LOOPHOLE[version.time]];
	PutString[", processor: "];
	ListerDefs.PrintMachine[version];
	END;
    PutCR[];
    RETURN
    END;
    
  -- Utility Prints
  
  
  PrintControlLink: PROCEDURE [link: Link] =
    BEGIN
    map: ARRAY BOOLEAN OF CHARACTER = ['0, '1];
    PutChar['[];
    PutDecimal[link.gfi];
    PutChar[',];
    PutDecimal[link.ep];
    PutChar[',];
    PutChar[map[link.tag]];
    PutChar[']];
    RETURN
    END;
    
  PrintFileName: PROCEDURE [fti: FTIndex] =
    BEGIN
    SELECT fti FROM
      FTNull => PutString["(null)"];
      FTSelf => PutString["(self)"];
      ENDCASE => PutName[ftb[fti].name];
    RETURN
    END;
    
  PrintIndex: PROCEDURE [index: UNSPECIFIED] =
    BEGIN PutString[" ["]; PutDecimal[index]; PutChar[']]; RETURN END;
    
  PrintGarbage: PROCEDURE =
    BEGIN
    Tab[2];
    PutString["? looks like garbage to me ..."];
    PutCR[];
    RETURN
    END;
    
  PrintAnonName: PROCEDURE = BEGIN PutString[" (anon) "]; RETURN END;
    
  -- Utility Puts
  
  
  PutName: PUBLIC PROCEDURE [n: NameRecord] =
    BEGIN
    ssd: String.SubStringDescriptor _
      [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
    PutSubString[@ssd];
    RETURN
    END;
    
  Tab: PROCEDURE [n: CARDINAL] = BEGIN ListerDefs.Indent[n]; RETURN END;
    
  PutInstanceName: PROCEDURE [n: Namee] =
    BEGIN
    
    FindName: PROCEDURE [ntb: Base, nti: NTIndex] RETURNS [BOOLEAN] =
      BEGIN RETURN[ntb[nti].item = n]; END;
      
    nti: NTIndex;
    IF (nti _ EnumerateNameTable[FindName]) = NTNull THEN PrintAnonName[]
    ELSE PutName[ntb[nti].name];
    END;
    
  EnumerateNameTable: PROCEDURE [
    proc: PROCEDURE [Base, NTIndex] RETURNS [BOOLEAN]] RETURNS [nti: NTIndex] =
    BEGIN
    FOR nti _ FIRST[NTIndex], nti + SIZE[NTRecord] UNTIL nti = bcd.ntLimit DO
      IF proc[ntb, nti] THEN RETURN[nti]; ENDLOOP;
    RETURN[NTNull];
    END;
    
  -- IncorrectVersion: EXTERNAL SIGNAL;

  Version: PROCEDURE [root: STRING] =
    BEGIN
    i: CARDINAL;
    bcdfile: STRING _ [40];
    seg: SegmentDefs.FileSegmentHandle;
    BEGIN OPEN String;
    AppendString[bcdfile, root];
    FOR i IN [0..bcdfile.length) DO
      IF bcdfile[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
      ENDLOOP;
    END;
    BEGIN OPEN SegmentDefs;
    seg _ NewFileSegment[
      NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile], 1,
      1, Read];
    SwapIn[seg];
    bcd _ FileSegmentAddress[seg];
    [] _ OutputDefs.GetOutputStream[]; -- make sure Output is started
    OutputDefs.outStream _ StreamDefs.GetDefaultDisplayStream[];
    PutCR[];
    ListerDefs.WriteVersions[
      version: @bcd.version, 
      creator: @bcd.creator, 
      source: @bcd.sourceVersion];
    IF bcd.versionIdent # VersionID THEN
      BEGIN
      PutString["  Obsolete VersionID = "];
      PutDecimal[bcd.versionIdent]
      END;
    OutputDefs.outStream _ NIL;
    Unlock[seg];
    SwapOut[seg];
    EXITS NoFile => IODefs.WriteString["File not found"];
    END;
    RETURN
    END;
  
  Stamps: PROCEDURE [root: STRING] =
    BEGIN
    i: CARDINAL;
    bcdfile: STRING _ [40];
    seg: SegmentDefs.FileSegmentHandle;
    BEGIN OPEN String;
    AppendString[bcdfile, root];
    FOR i IN [0..bcdfile.length) DO
      IF bcdfile[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
      ENDLOOP;
    END;
    BEGIN OPEN SegmentDefs;
    seg _ NewFileSegment[
      NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile], 1,
      1, Read];
    InstallBcd[seg];
    OpenOutput[root, ".bl"];
    WriteBcdID[bcdfile, bcd];
    PrintStamps[];
    CloseOutput[];
    UnstallBcd[seg];
    EXITS NoFile => IODefs.WriteString["File not found"];
    END;
    RETURN
    END;
    
  
  Bcd: PROCEDURE [root: STRING] =
    BEGIN
    i: CARDINAL;
    bcdfile: STRING _ [40];
    seg: SegmentDefs.FileSegmentHandle;
    BEGIN OPEN String;
    AppendString[bcdfile, root];
    FOR i IN [0..bcdfile.length) DO
      IF bcdfile[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
      ENDLOOP;
    END;
    BEGIN OPEN SegmentDefs;
    seg _ NewFileSegment[
      NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile], 1,
      1, Read];
    InstallBcd[seg];
    OpenOutput[root, ".bl"];
    WriteBcdID[bcdfile, bcd];
    PrintBcd[];
    CloseOutput[];
    UnstallBcd[seg];
    EXITS NoFile => IODefs.WriteString["File not found"];
    END;
    RETURN
    END;
    
  BcdLinks: PROCEDURE [root: STRING] =
    BEGIN DumpLinks _ TRUE; Bcd[root]; DumpLinks _ FALSE; RETURN END;
    
  BcdSegment: PROCEDURE [
    root: STRING, base: AltoDefs.PageNumber, pages: AltoDefs.PageCount,
    links: BOOLEAN] =
    BEGIN
    i: CARDINAL;
    bcdfile: STRING _ [40];
    seg: SegmentDefs.FileSegmentHandle;
    DumpLinks _ links;
    BEGIN OPEN String;
    AppendString[bcdfile, root];
    FOR i IN [0..bcdfile.length) DO
      IF bcdfile[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdfile, ".bcd"];
      ENDLOOP;
    END;
    BEGIN OPEN SegmentDefs;
    seg _ NewFileSegment[
      NewFile[bcdfile, Read, DefaultVersion ! FileNameError => GO TO NoFile],
      base, pages, Read ! InvalidSegmentSize => GO TO BadSegment];
    InstallBcd[seg ! SwapError, SegmentFault => GO TO BadSegment];
    OpenOutput[root, ".bl"];
    WriteBcdID[bcdfile, bcd];
    PrintBcd[];
    CloseOutput[];
    UnstallBcd[seg];
    EXITS
      NoFile => IODefs.WriteString["File not found"];
      BadSegment => IODefs.WriteString["Bad Segment"];
    END;
    DumpLinks _ FALSE;
    END;
    
  DumpLinks: BOOLEAN _ FALSE;
  
  Init: PROCEDURE =
    BEGIN
    command: CommanderDefs.CommandBlockHandle;
    command _ CommanderDefs.AddCommand["Bcd", LOOPHOLE[Bcd], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["BcdLinks", LOOPHOLE[BcdLinks], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["Version", LOOPHOLE[Version], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.AddCommand["Stamps", LOOPHOLE[Stamps], 1];
    command.params[0] _ [type: string, prompt: "Filename"];
    command _ CommanderDefs.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"];
    END;
    
  Init[];
  
  END....