-- ListFGT.mesa
-- last modified by Bruce, 13-Jan-81 11:03:14
-- last modified by Satterthwaite, September 20, 1982 1:38 pm

DIRECTORY
  Ascii: TYPE USING [SP],
  BcdDefs: TYPE USING [Base, MTIndex],
  BcdOps: TYPE USING [BcdBase, MTHandle],
  CommanderOps: TYPE USING [AddCommand, CommandBlockHandle],
  FileSegment: TYPE USING [Pages],
  Format: TYPE USING [NumberFormat],
  Heap: TYPE USING [systemZone],
  ListerDefs: TYPE USING [
    IncorrectVersion, Load, MapPages, MultipleModules, NoCode, NoFGT, NoFile,
    NoSymbols, PrintSei, SetRoutineSymbols, WriteFileID, WriteString],
  OutputDefs: TYPE USING [
    CloseOutput, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber, PutOctal,
    PutLongString, PutString],
  PrincOps: TYPE USING [CSegPrefix],
  Space: TYPE USING [Handle, Delete, LongPointer],
  Strings: TYPE USING [AppendString],
  Symbols: TYPE USING [BTIndex, BTNull],
  SymbolTable: TYPE USING [Acquire, Base, Release, SetCacheSize];

ListFGT: PROGRAM
  IMPORTS
    CommanderOps, Heap, ListerDefs, OutputDefs, Space, Strings, SymbolTable =
  BEGIN OPEN ListerDefs, OutputDefs, Symbols;
  
  SP: CHARACTER = ' ;
  
  symbols: SymbolTable.Base;
  code: LONG POINTER TO PrincOps.CSegPrefix;
  
  BodyData: TYPE = RECORD [firstFG, lastFG: CARDINAL, bti: Symbols.BTIndex];
  BodyList: TYPE = RECORD [SEQUENCE length: NAT OF BodyData];
    
  SortByFirstFG: PROC [na: LONG POINTER TO BodyList] =
    BEGIN
    j: INTEGER;
    key: BodyData;
    FOR i: NAT IN [1..na.length) 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: PROC [p: PROC [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: PROC [
    PrintOne: PROC [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;
    
  lastSource, lastObject, bodyObject: CARDINAL;
  
  PrintFGT: PROC =
    BEGIN OPEN Symbols, symbols;
    cbti: BTIndex;
    i, n, cfirst, clast: CARDINAL;
    na: LONG POINTER TO BodyList;
    
    countBti: PROC [bti: BTIndex] =
      BEGIN
      WITH bb[bti] SELECT FROM Callable => IF inline THEN RETURN; ENDCASE;
      n _ n + 1;
      END;
      
    insertBti: PROC [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: PROC [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: PROC [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: PROC [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[Ascii.SP];
	    END
	  ELSE
	    BEGIN
	    PutString["object:"L];
	    PutNumber[ff.delta, octal5];
	    PutChar['B];
	    END;
	  IF ~lastOnLine THEN THROUGH [17..34) DO PutChar[Ascii.SP]; ENDLOOP;
	  END;
	ENDCASE;
      END;
      
    AbsFGTEntry: TYPE = RECORD [object, source: CARDINAL];
    AbsFGTList: TYPE = RECORD [SEQUENCE length: NAT OF AbsFGTEntry];
    absFGT: LONG POINTER TO AbsFGTList;
    
    GenAbsFGT: PROC =
      BEGIN OPEN s: symbols;
      i: CARDINAL;
      absFGT _ (Heap.systemZone).NEW[AbsFGTList[(clast - cfirst + 1)]];
      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 _ (Heap.systemZone).NEW[BodyList[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];
	    (Heap.systemZone).FREE[@absFGT];
	    PutCR[];
	    END;
	ENDCASE => ERROR;
      ENDLOOP;
    (Heap.systemZone).FREE[@na];
    END;
    
  octal3: Format.NumberFormat =
    [base: 8, columns: 3, zerofill: FALSE, unsigned: TRUE];
  decimal3: Format.NumberFormat =
    [base: 10, columns: 3, zerofill: FALSE, unsigned: TRUE];
  octal4: Format.NumberFormat =
    [base: 8, columns: 4, zerofill: FALSE, unsigned: TRUE];
  octal5: Format.NumberFormat =
    [base: 8, columns: 5, zerofill: FALSE, unsigned: TRUE];
  decimal5: Format.NumberFormat =
    [base: 10, columns: 5, zerofill: FALSE, unsigned: TRUE];
  octal6: Format.NumberFormat =
    [base: 8, columns: 6, zerofill: FALSE, unsigned: TRUE];
  
  PrintFGEntry: PROC [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[Ascii.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[Ascii.SP]; ENDLOOP;
	END;
      ENDCASE;
    END;
    
  FGTable: PROC [root: STRING] =
    BEGIN
    defs: BOOLEAN _ FALSE;
    bcdFile: STRING _ [40];
    bcdseg, sseg, cseg: FileSegment.Pages;
    bcdSpace, codeSpace: Space.Handle;
    bcd: BcdOps.BcdBase;
    mth: BcdOps.MTHandle;
    Strings.AppendString[bcdFile, root];
    FOR i: CARDINAL IN [0..bcdFile.length) DO
      IF bcdFile[i] = '. THEN EXIT;
      REPEAT FINISHED => Strings.AppendString[bcdFile, ".bcd"];
      ENDLOOP;
    BEGIN
    [bcd: bcdseg, code: cseg, symbols: sseg] _ Load[
      bcdFile ! NoFGT => GOTO badformat; NoCode => GO TO defsFile;
      NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
      NoFile => GOTO badname];
    bcdSpace _ ListerDefs.MapPages[bcdseg];
    bcd _ bcdSpace.LongPointer;
    mth _ @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][FIRST[BcdDefs.MTIndex]];
    codeSpace _ ListerDefs.MapPages[cseg];
    code _ codeSpace.LongPointer + mth.code.offset;
    Space.Delete[bcdSpace];
    SymbolTable.SetCacheSize[0];
    symbols _ SymbolTable.Acquire[sseg];
    ListerDefs.SetRoutineSymbols[symbols];
    OpenOutput[root, ".fl"];
    WriteFileID[];
    IF symbols.sourceFile # NIL THEN
      BEGIN PutString["  Source: "]; PutLongString[symbols.sourceFile]; PutCR[]; END;
    PrintFGT[];
    SymbolTable.Release[symbols];
    Space.Delete[codeSpace];
    CloseOutput[];
    EXITS
      defsFile => ListerDefs.WriteString["Definitions File!"];
      badformat => ListerDefs.WriteString["Bad Format!"];
      badname => ListerDefs.WriteString["File Not Found!"];
    END;
    END;
    
  command: CommanderOps.CommandBlockHandle;
  
  command _ CommanderOps.AddCommand["FGTable", LOOPHOLE[FGTable], 1];
  command.params[0] _ [type: string, prompt: "Filename"];
  
  END...