-- ListUnbound.Mesa  
--  Edited by Sweet on July 8, 1980  9:42 AM
--  Edited by Bruce on 13-Jan-81 11:06:19
--  Edited by Satterthwaite on September 20, 1982 1:42 pm

DIRECTORY
  BcdDefs: TYPE USING [
    Base, BCD, EXPIndex, EXPRecord, FTIndex, FTNull, FTSelf,
    NameRecord, NullName],
  BcdOps: TYPE USING [BcdBase, NameString],
  CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
  FileSegment: TYPE USING [Pages],
  ListerDefs: TYPE USING [
    IncorrectVersion, Indent, Load, MapPages, MultipleModules, NoCode, NoFGT,
    NoFile, NoSymbols, PrintSei, SetRoutineSymbols, WriteString, WriteVersionId],
  OSMiscOps: TYPE USING [FileError, FindFile],
  OutputDefs: TYPE USING [
    CloseOutput, OpenOutput, PutCR, PutString, PutLongSubString],
  Space: TYPE USING [Handle, Delete, LongPointer],
  Strings: TYPE USING [AppendString, AppendSubString, SubStringDescriptor],
  Symbols: TYPE USING [ISEIndex, ISENull],
  SymbolTable: TYPE USING [Acquire, Base, Release];

ListUnbound: PROGRAM
  IMPORTS
    CommanderOps, ListerDefs, Strings, OSMiscOps, OutputDefs, Space, SymbolTable =
  BEGIN OPEN OutputDefs, BcdDefs;
  
  bcdSpace: Space.Handle;
  bcd: BcdOps.BcdBase;

  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: FileSegment.Pages] =
    BEGIN
    DO
      nPages: CARDINAL;
      bcdSpace _ ListerDefs.MapPages[seg];
      bcd _ bcdSpace.LongPointer;
      IF (nPages _ bcd.nPages) = seg.span.pages THEN EXIT;
      seg.span.pages _ nPages;
      Space.Delete[bcdSpace];
      ENDLOOP;
    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: FileSegment.Pages] =
    BEGIN
    Space.Delete[bcdSpace];
    RETURN
    END;
    
  WriteBcdID: PROCEDURE [name: STRING, bcd: BcdOps.BcdBase] =
    BEGIN
    PutString[name];
    PutString[", version "L];  ListerDefs.WriteVersionId[bcd.version];
    IF bcd.source # BcdDefs.NullName THEN
      BEGIN PutString[",  source "L]; PutName[bcd.source] END;
    PutString["\n  creator "L];
    ListerDefs.WriteVersionId[bcd.creator];
    PutCR[];  PutCR[];
    END;
    
  PrintUnbound: PROCEDURE =
    BEGIN
    eti: EXPIndex _ FIRST[EXPIndex];
    UNTIL eti = bcd.expLimit DO
      CheckExport[
	eti !
	ListerDefs.NoFile =>
	  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: FileSegment.Pages;
  loaded: BOOLEAN _ FALSE;
  
  LoadSymbols: PROCEDURE [file: FTIndex] =
    BEGIN OPEN ListerDefs;
    s: STRING _ [60];
    IF file = FTNull OR file = FTSelf OR symbols # NIL THEN ERROR;
    GetBcdName[s, ftb[file].name];
    [symbols: sseg] _ Load[s ! NoCode, NoFGT => RESUME ];
    symbols _ SymbolTable.Acquire[sseg];
    SetRoutineSymbols[symbols];
    loaded _ TRUE;
    END;
    
  UnloadSymbols: PROCEDURE =
    BEGIN
    IF symbols # NIL THEN SymbolTable.Release[symbols];
    symbols _ 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: Strings.SubStringDescriptor _
      [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
    s.length _ 0;
    Strings.AppendSubString[s, @ssd];
    FOR i IN [0..s.length) DO IF s[i] = '. THEN RETURN ENDLOOP;
    Strings.AppendString[s, ".bcd"L];
    RETURN
    END;
    
  -- Utility Puts
  
  
  PutName: PUBLIC PROCEDURE [n: NameRecord] =
    BEGIN
    ssd: Strings.SubStringDescriptor _
      [base: @ssb.string, offset: n, length: MIN[ssb.size[n], 100]];
    PutLongSubString[@ssd];
    RETURN
    END;
    
  Tab: PROCEDURE [n: CARDINAL] = BEGIN ListerDefs.Indent[n]; RETURN END;
    
  UnboundExports: PROCEDURE [root: STRING] =
    BEGIN
    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;
    BEGIN
    seg _ [
      file: OSMiscOps.FindFile[bcdfile, ! OSMiscOps.FileError => GO TO NoFile],
      span: [base: 1, pages: 1]];
    InstallBcd[seg];
    OpenOutput[root, ".xl"L];
    WriteBcdID[bcdfile, bcd];
    PrintUnbound[];
    CloseOutput[];
    UnstallBcd[seg];
    EXITS NoFile => ListerDefs.WriteString["File not found"L];
    END;
    RETURN
    END;
    
  Init: PROCEDURE =
    BEGIN
    command: CommanderOps.CommandBlockHandle;
    command _ CommanderOps.AddCommand[
      "UnboundExports", LOOPHOLE[UnboundExports], 1];
    command.params[0] _ [type: string, prompt: "Bcd name"];
    END;
    
  Init[];
  
  END....