-- listFGT.mesa; modified by Sweet, July 8, 1980  9:31 AM

DIRECTORY
  CommanderDefs USING [AddCommand, CommandBlockHandle],
  IODefs USING [NumberFormat, SP, WriteString],
  ListerDefs USING [
    FileSegmentHandle, IncorrectVersion, Load, MultipleModules, NoCode, NoFGT,
    NoSymbols, PrintSei, SetRoutineSymbols, WriteFileID],
  OutputDefs USING [
    CloseOutput, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber, PutOctal,
    PutString],
  PrincOps USING [CSegPrefix],
  SegmentDefs USING [
    DeleteFileSegment, FileNameError, FileSegmentAddress, SwapError, SwapIn,
    Unlock],
  String USING [AppendString],
  Symbols USING [BTIndex, BTNull],
  SymbolTable USING [Acquire, Base, Release, TableForSegment],
  Storage USING [Node, Free];

ListFGT: PROGRAM
  IMPORTS
    CommanderDefs, IODefs, ListerDefs, OutputDefs, SegmentDefs, String,
    SymbolTable, Storage
  EXPORTS ListerDefs =
  BEGIN OPEN ListerDefs, OutputDefs, Symbols;
  
  SP: CHARACTER = ' ;
  
  symbols: SymbolTable.Base;
  code: POINTER TO PrincOps.CSegPrefix;
  
  SortByFirstFG: PROCEDURE [na: DESCRIPTOR FOR ARRAY OF BodyData] =
    BEGIN
    i: CARDINAL;
    j: INTEGER;
    key: BodyData;
    FOR i IN [1..LENGTH[na]) DO
      key _ na[i];
      j _ i - 1;
      WHILE j >= 0 AND na[j].firstFG > key.firstFG DO
	na[j + 1] _ na[j]; j _ j - 1; ENDLOOP;
      na[j + 1] _ key;
      ENDLOOP;
    END;
    
  GenBT: PROCEDURE [p: PROCEDURE [Symbols.BTIndex]] =
    BEGIN OPEN symbols;
    bti, prev: BTIndex;
    bti _ FIRST[BTIndex];
    DO
      p[bti];
      IF bb[bti].firstSon # BTNull THEN bti _ bb[bti].firstSon
      ELSE
	DO
	  prev _ bti;
	  bti _ bb[bti].link.index;
	  IF bti = BTNull THEN GO TO Done;
	  IF bb[prev].link.which # parent THEN EXIT;
	  ENDLOOP;
      REPEAT Done => NULL;
      ENDLOOP;
    END;
    
  PrintByColumns: PROCEDURE [
    PrintOne: PROCEDURE [item: CARDINAL, lastOnLine: BOOLEAN],
    firstItem, nItems, nColumns, spaceBetween: CARDINAL] =
    BEGIN
    i, j, nc: CARDINAL;
    delta: CARDINAL _ (nItems + nColumns - 1)/nColumns;
    last: BOOLEAN;
    FOR i IN [0..delta) DO
      nc _ 0;
      last _ FALSE;
      FOR j _ i, j + delta WHILE ~last AND j < nItems DO
	nc _ nc + 1;
	last _ nc = nColumns;
	PrintOne[firstItem + j, last];
	IF ~last THEN THROUGH [0..spaceBetween) DO PutChar[SP]; ENDLOOP;
	ENDLOOP;
      PutCR[];
      ENDLOOP;
    END;
    
  BodyData: TYPE = RECORD [firstFG, lastFG: CARDINAL, bti: Symbols.BTIndex];
  
  lastSource, lastObject, bodyObject: CARDINAL;
  
  PrintFGT: PROCEDURE =
    BEGIN OPEN Symbols, symbols;
    cbti: BTIndex;
    i, n, cfirst, clast: CARDINAL;
    na: DESCRIPTOR FOR ARRAY OF BodyData;
    
    countBti: PROCEDURE [bti: BTIndex] =
      BEGIN
      WITH bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
      n _ n + 1;
      END;
      
    insertBti: PROCEDURE [bti: BTIndex] =
      BEGIN OPEN symbols;
      WITH bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
      WITH bb[bti].info SELECT FROM
	External => na[i] _ [startIndex, startIndex + indexLength - 1, bti];
	ENDCASE;
      i _ i + 1;
      END;
      
    PrintBodyLine: PROCEDURE [depth: CARDINAL] =
      BEGIN
      first, last: CARDINAL;
      origin: CARDINAL;
      bti: BTIndex;
      [first, last, bti] _ na[i];
      THROUGH [0..depth*2) DO PutChar[SP]; ENDLOOP;
      PutString["  ["L];
      PutDecimal[LOOPHOLE[bti]];
      PutString["] fg: ["L];
      PutDecimal[first];
      PutString[".."L];
      PutDecimal[last];
      PutString["], pc: ["L];
      WITH br: bb[bti] SELECT FROM
	Callable =>
	  BEGIN
	  bodyObject _ origin _ code.entry[br.entryIndex].initialpc*2;
	  lastObject _ 0;
	  lastSource _ br.sourceIndex;
	  END;
	Other => origin _ bodyObject + br.relOffset;
	ENDCASE;
      WITH bi: bb[bti].info SELECT FROM
	External =>
	  BEGIN
	  PutOctal[origin];
	  PutString[".."L];
	  PutOctal[origin + bi.bytes - 1];
	  PutChar[']];
	  END;
	ENDCASE;
      PutString[", source: "L];
      PutDecimal[bb[bti].sourceIndex];
      WITH br: bb[bti] SELECT FROM
	Callable => BEGIN PutString[", ep: "L]; PutDecimal[br.entryIndex]; END;
	Other => BEGIN PutString[", relO: "L]; PutOctal[br.relOffset]; END;
	ENDCASE;
      PutCR[];
      i _ i + 1;
      END;
      
    PrintBodyStuff: PROCEDURE [depth: CARDINAL] =
      BEGIN
      myLast: CARDINAL = na[i].lastFG;
      PrintBodyLine[depth];
      WHILE i < n AND na[i].firstFG <= myLast DO
	PrintBodyStuff[depth + 1]; ENDLOOP;
      END;
      
    PrintFGEntry: PROCEDURE [item: CARDINAL, lastOnLine: BOOLEAN] =
      BEGIN OPEN symbols;
      PutNumber[item, decimal5];
      PutString[": "L];
      WITH ff: fgTable[item] SELECT FROM
	normal =>
	  BEGIN -- 34 chars wide?
	  PutNumber[ff.deltaObject, octal3];
	  PutString["B, "L];
	  PutNumber[ff.deltaSource, decimal3];
	  PutString[" = "L];
	  PutNumber[absFGT[item - cfirst].object, octal5];
	  PutString["B, "L];
	  PutNumber[absFGT[item - cfirst].source, decimal5];
	  PutString[" ("L];
	  PutNumber[absFGT[item - cfirst].object + bodyObject, octal6];
	  PutString["B)"];
	  END;
	step =>
	  BEGIN
	  PutString["Step "];
	  IF ff.which = source THEN
	    BEGIN
	    PutString["source:"L];
	    PutNumber[ff.delta, decimal5];
	    PutChar[IODefs.SP];
	    END
	  ELSE
	    BEGIN
	    PutString["object:"L];
	    PutNumber[ff.delta, octal5];
	    PutChar['B];
	    END;
	  IF ~lastOnLine THEN THROUGH [17..34) DO PutChar[IODefs.SP]; ENDLOOP;
	  END;
	ENDCASE;
      END;
      
    AbsFGTEntry: TYPE = RECORD [object, source: CARDINAL];
    absFGT: POINTER TO ARRAY [0..0) OF AbsFGTEntry;
    
    GenAbsFGT: PROCEDURE =
      BEGIN OPEN s: symbols;
      i: CARDINAL;
      absFGT _ Storage.Node[(clast - cfirst + 1)*SIZE[AbsFGTEntry]];
      FOR i IN [cfirst..clast] DO
	WITH ff: s.fgTable[i] SELECT FROM
	  normal =>
	    BEGIN
	    lastSource _ lastSource + ff.deltaSource;
	    lastObject _ lastObject + ff.deltaObject;
	    END;
	  step =>
	    IF ff.which = source THEN lastSource _ lastSource + ff.delta
	    ELSE lastObject _ lastObject + ff.delta;
	  ENDCASE;
	absFGT[i - cfirst] _ [source: lastSource, object: lastObject];
	ENDLOOP;
      END;
      
    n _ 0;
    GenBT[countBti];
    na _ DESCRIPTOR[Storage.Node[SIZE[BodyData]*n], n];
    i _ 0;
    GenBT[insertBti];
    SortByFirstFG[na];
    i _ 0;
    WHILE i < n DO
      [cfirst, clast, cbti] _ na[i];
      WITH br: bb[cbti] SELECT FROM
	Callable =>
	  IF ~br.inline THEN
	    BEGIN
	    PrintSei[br.id];
	    PutCR[];
	    PrintBodyStuff[0];
	    GenAbsFGT[];
	    PrintByColumns[
	      PrintOne: PrintFGEntry, firstItem: cfirst,
	      nItems: clast - cfirst + 1, nColumns: 2, spaceBetween: 2];
	    Storage.Free[absFGT];
	    PutCR[];
	    END;
	ENDCASE => ERROR;
      ENDLOOP;
    Storage.Free[BASE[na]];
    RETURN
    END;
    
  octal3: IODefs.NumberFormat =
    [base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
  decimal3: IODefs.NumberFormat =
    [base: 10, columns: 3, zerofill: FALSE, unsigned: TRUE];
  octal4: IODefs.NumberFormat =
    [base: 8, columns: 4, zerofill: FALSE, unsigned: TRUE];
  octal5: IODefs.NumberFormat =
    [base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
  decimal5: IODefs.NumberFormat =
    [base: 10, columns: 5, zerofill: FALSE, unsigned: TRUE];
  octal6: IODefs.NumberFormat =
    [base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
  
  PrintFGEntry: PROCEDURE [item: CARDINAL, lastOnLine: BOOLEAN] =
    BEGIN OPEN symbols;
    PutNumber[item, decimal5];
    PutString[": "L];
    WITH ff: fgTable[item] SELECT FROM
      normal =>
	BEGIN -- 34 chars wide?
	PutNumber[ff.deltaObject, octal3];
	PutString["B, "L];
	PutNumber[ff.deltaSource, decimal3];
	lastSource _ lastSource + ff.deltaSource;
	lastObject _ lastObject + ff.deltaObject;
	PutString[" = "L];
	PutNumber[lastObject, octal5];
	PutString["B, "L];
	PutNumber[lastSource, decimal5];
	PutString[" ("L];
	PutNumber[lastObject + bodyObject, octal6];
	PutString["B)"];
	END;
      step =>
	BEGIN
	PutString["Step "];
	IF ff.which = source THEN
	  BEGIN
	  PutString["source:"L];
	  lastSource _ lastSource + ff.delta;
	  PutNumber[ff.delta, decimal5];
	  PutChar[IODefs.SP];
	  END
	ELSE
	  BEGIN
	  PutString["object:"L];
	  lastObject _ lastObject + ff.delta;
	  PutNumber[ff.delta, octal5];
	  PutChar['B];
	  END;
	IF ~lastOnLine THEN THROUGH [17..34) DO PutChar[IODefs.SP]; ENDLOOP;
	END;
      ENDCASE;
    END;
    
  FGTable: PROCEDURE [root: STRING] =
    BEGIN OPEN String, SegmentDefs;
    i: CARDINAL;
    defs: BOOLEAN _ FALSE;
    bcdFile: STRING _ [40];
    sseg, cseg: FileSegmentHandle;
    AppendString[bcdFile, root];
    FOR i IN [0..bcdFile.length) DO
      IF bcdFile[i] = '. THEN EXIT;
      REPEAT FINISHED => AppendString[bcdFile, ".bcd"];
      ENDLOOP;
    BEGIN
    [code: cseg, symbols: sseg] _ Load[
      bcdFile ! NoFGT => GOTO badformat; NoCode => GO TO defsFile;
      NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
      SegmentDefs.FileNameError => GOTO badname];
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
    SegmentDefs.SwapIn[cseg];
    code _ SegmentDefs.FileSegmentAddress[cseg];
    ListerDefs.SetRoutineSymbols[symbols];
    OpenOutput[root, ".fl"];
    WriteFileID[];
    IF symbols.sourceFile # NIL THEN
      BEGIN PutString["  Source: "]; PutString[symbols.sourceFile]; PutCR[]; END;
    PrintFGT[];
    SegmentDefs.Unlock[cseg];
    SymbolTable.Release[symbols];
    SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
    SegmentDefs.DeleteFileSegment[cseg ! SegmentDefs.SwapError => CONTINUE];
    CloseOutput[];
    EXITS
      defsFile => IODefs.WriteString["Definitions File!"];
      badformat => IODefs.WriteString["Bad Format!"];
      badname => IODefs.WriteString["File Not Found!"];
    END;
    END;
    
  command: CommanderDefs.CommandBlockHandle;
  
  command _ CommanderDefs.AddCommand["FGTable", LOOPHOLE[FGTable], 1];
  command.params[0] _ [type: string, prompt: "Filename"];
  
  END...