-- ListUnbound.Mesa  Edited by Sweet on July 8, 1980  9:42 AM

DIRECTORY
  AltoDefs: FROM "altodefs",
  BcdDefs USING [
    Base, BCD, EXPIndex, EXPRecord, FTIndex, FTNull, FTSelf, NameRecord, NullName,
    VersionID],
  BcdOps USING [NameString],
  CommanderDefs USING [AddCommand, CommandBlockHandle],
  IODefs USING [WriteString],
  ListerDefs USING [
    FileSegmentHandle, IncorrectVersion, Indent, Load, MultipleModules, NoCode,
    NoFGT, NoSymbols, PrintMachine, PrintSei, SetRoutineSymbols],
  OutputDefs USING [
    CloseOutput, OpenOutput, PutCR, PutDecimal, PutString, PutSubString, PutTime],
  SegmentDefs USING [
    DefaultVersion, DeleteFileSegment, FileNameError, FileSegmentAddress,
    FileSegmentHandle, MoveFileSegment, NewFile, NewFileSegment, Read, SwapError,
    SwapIn, SwapOut, Unlock],
  String USING [AppendString, AppendSubString, SubStringDescriptor],
  Symbols USING [ISEIndex, ISENull],
  SymbolTable USING [Acquire, Base, Release, TableForSegment];

ListUnbound: PROGRAM
  IMPORTS
    CommanderDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs, String,
    SymbolTable
  EXPORTS ListerDefs =
  BEGIN OPEN OutputDefs, BcdDefs;
  
  bcd: POINTER TO BCD;
  tb: Base;
  ssb: BcdOps.NameString;
  evb: Base;
  spb: 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;
    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 # BcdDefs.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;
    
  PrintUnbound: PROCEDURE =
    BEGIN
    eti: EXPIndex _ FIRST[EXPIndex];
    UNTIL eti = bcd.expLimit DO
      CheckExport[
	eti !
	SegmentDefs.FileNameError =>
	  BEGIN OPEN etb[eti];
	  PutString["Can't find "L];
	  PutName[ftb[file].name];
	  PutCR[];
	  CONTINUE
	  END;
	ListerDefs.MultipleModules =>
	  BEGIN OPEN etb[eti];
	  PutString["Bad format for "L];
	  PutName[ftb[file].name];
	  PutCR[];
	  CONTINUE
	  END;
	ListerDefs.NoSymbols =>
	  BEGIN OPEN etb[eti];
	  PutString["No symbols for "L];
	  PutName[ftb[file].name];
	  PutCR[];
	  CONTINUE
	  END;
	ListerDefs.IncorrectVersion =>
	  BEGIN OPEN etb[eti];
	  PutString["Wrong version: "L];
	  PutName[ftb[file].name];
	  PutCR[];
	  CONTINUE
	  END];
      UnloadSymbols[];
      eti _ eti + etb[eti].size + SIZE[EXPRecord];
      IF LOOPHOLE[eti, CARDINAL] > LOOPHOLE[bcd.expLimit, CARDINAL] THEN
	GO TO Bogus;
      REPEAT Bogus => PrintGarbage[];
      ENDLOOP;
    RETURN
    END;
    
  CheckExport: PUBLIC PROCEDURE [eti: EXPIndex] =
    BEGIN OPEN etb[eti];
    i: CARDINAL;
    n: CARDINAL _ 0;
    sei: Symbols.ISEIndex;
    FOR i IN [0..size) DO
      IF links[i].gfi = 0 THEN
	BEGIN
	IF ~loaded THEN LoadSymbols[file];
	sei _ SeiForItem[i];
	IF sei = Symbols.ISENull THEN LOOP;
	IF n = 0 THEN
	  BEGIN
	  PutString["Unbound exports to "L];
	  PutName[name];
	  PutString[": "L];
	  END;
	IF n MOD 3 = 0 THEN Tab[2] ELSE PutString[", "L];
	n _ n + 1;
	ListerDefs.PrintSei[sei];
	END;
      ENDLOOP;
    IF n # 0 THEN BEGIN PutCR[]; PutCR[]; END;
    RETURN
    END;
    
  SeiForItem: PROCEDURE [item: CARDINAL] RETURNS [sei: Symbols.ISEIndex] =
    BEGIN OPEN symbols;
    FOR sei _ FirstCtxSe[stHandle.outerCtx], NextSe[sei] UNTIL sei =
      Symbols.ISENull DO
      IF seb[sei].idValue = item THEN
	SELECT LinkMode[
	  sei] FROM
	  val => IF seb[sei].extended THEN RETURN[Symbols.ISENull] ELSE RETURN;
	  ref => RETURN[sei];
	  manifest => LOOP; -- constant
	  
	  ENDCASE => RETURN[Symbols.ISENull];
      ENDLOOP;
    ERROR;
    END;
    
  symbols: SymbolTable.Base _ NIL;
  sseg: SegmentDefs.FileSegmentHandle _ NIL;
  loaded: BOOLEAN _ FALSE;
  
  LoadSymbols: PROCEDURE [file: FTIndex] =
    BEGIN OPEN ListerDefs;
    s: STRING _ [60];
    cseg: SegmentDefs.FileSegmentHandle;
    IF file = FTNull OR file = FTSelf OR symbols # NIL OR sseg # NIL THEN ERROR;
    GetBcdName[s, ftb[file].name];
    [code: cseg, symbols: sseg] _ Load[s ! NoCode, NoFGT => RESUME ];
    IF cseg # NIL THEN SegmentDefs.DeleteFileSegment[cseg];
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
    SetRoutineSymbols[symbols];
    loaded _ TRUE;
    END;
    
  UnloadSymbols: PROCEDURE =
    BEGIN OPEN SegmentDefs;
    IF symbols # NIL THEN SymbolTable.Release[symbols];
    IF sseg # NIL THEN DeleteFileSegment[sseg ! SwapError => CONTINUE];
    symbols _ NIL;
    sseg _ NIL;
    loaded _ FALSE;
    END;
    
  -- Utility Prints
  
  
  PrintGarbage: PROCEDURE =
    BEGIN
    Tab[2];
    PutString["? looks like garbage to me ..."];
    PutCR[];
    RETURN
    END;
    
  GetBcdName: PUBLIC PROCEDURE [s: STRING, n: NameRecord] =
    BEGIN
    i: CARDINAL;
    ssd: String.SubStringDescriptor _
      [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
    s.length _ 0;
    String.AppendSubString[s, @ssd];
    FOR i IN [0..s.length) DO IF s[i] = '. THEN RETURN ENDLOOP;
    String.AppendString[s, ".bcd"L];
    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;
    
  UnboundExports: 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, ".xl"L];
    WriteBcdID[bcdfile, bcd];
    PrintUnbound[];
    CloseOutput[];
    UnstallBcd[seg];
    EXITS NoFile => IODefs.WriteString["File not found"];
    END;
    RETURN
    END;
    
  Init: PROCEDURE =
    BEGIN
    command: CommanderDefs.CommandBlockHandle;
    command _ CommanderDefs.AddCommand[
      "UnboundExports", LOOPHOLE[UnboundExports], 1];
    command.params[0] _ [type: string, prompt: "Bcd name"];
    END;
    
  Init[];
  
  END....