-- ListPackageInfo.mesa
-- Last modified by Sweet on September 16, 1980  9:13 AM
-- Last modified by Lewis on 15-Jan-81 17:36:18
-- Last modified by Satterthwaite on May 10, 1983 12:56 pm

DIRECTORY
  Ascii USING [SP],
  BcdDefs,
  BcdOps,
  CommanderOps USING [AddCommand, CommandBlockHandle],
  FileSegment: TYPE USING [Pages],
  ListerDefs USING [
    IncorrectVersion, Load, LoadFromConfig, MapPages, MultipleModules,
    NoCode, NoFGT, NoFile, NoSymbols, PrintHti, SetRoutineSymbols,
    WriteFileID, WriteString],
  LongStorage USING [Node, Free],
  OutputDefs USING [
    CloseOutput, NumberFormat, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber,
    PutOctal, PutString],
  PackageSymbols USING [
    ConstRecord, InnerPackRecord, IPIndex, IPNull, OPIndex, OuterPackRecord],
  PrincOps USING [CSegPrefix],
  Space: TYPE USING [Handle, Delete, LongPointer],
  Strings USING [AppendString],
  Symbols USING [BTIndex, HTIndex],
  SymbolTable USING [Acquire, Base, Release];

ListPackageInfo: PROGRAM
  IMPORTS
    CommanderOps, ListerDefs, LongStorage, OutputDefs, Space,
    Strings, SymbolTable =
  BEGIN OPEN ListerDefs, OutputDefs, Symbols, PackageSymbols;
  
  symbols: SymbolTable.Base;
  
  Decimal3: OutputDefs.NumberFormat =
    [base: 10, unsigned: TRUE, zerofill: FALSE, columns: 3];
  Decimal5: OutputDefs.NumberFormat =
    [base: 10, unsigned: TRUE, zerofill: FALSE, columns: 5];
  Octal5: OutputDefs.NumberFormat =
    [base: 8, unsigned: TRUE, zerofill: FALSE, columns: 5];
  
  epMap: LONG POINTER TO ARRAY [0..0) OF HTIndex;
  
  CreateEpMap: PROCEDURE =
    BEGIN
    max: CARDINAL _ 0;
    
    Count: PROCEDURE [bti: BTIndex] RETURNS [stop: BOOLEAN] =
      BEGIN
      stop _ FALSE;
      WITH b: symbols.bb[bti] SELECT FROM
	Callable => IF ~b.inline THEN max _ MAX[b.entryIndex, max];
	ENDCASE;
      END;
      
    Enter: PROCEDURE [bti: BTIndex] RETURNS [stop: BOOLEAN] =
      BEGIN
      stop _ FALSE;
      WITH b: symbols.bb[bti] SELECT FROM
	Callable =>
	  IF ~b.inline THEN epMap[b.entryIndex] _ symbols.NameForSe[b.id];
	ENDCASE;
      END;
      
    [] _ symbols.EnumerateBodies[FIRST[BTIndex], Count];
    epMap _ LongStorage.Node[max + 1];
    [] _ symbols.EnumerateBodies[FIRST[BTIndex], Enter];
    END;
    
  PrintOuterPackTable: PROCEDURE =
    BEGIN OPEN s: symbols;
    opb: LONG DESCRIPTOR FOR ARRAY OF OuterPackRecord _ DESCRIPTOR[
      (s.stHandle + s.stHandle.outerPackBlock.offset),
      (s.stHandle.outerPackBlock.size / SIZE[OuterPackRecord])];
    opr: OuterPackRecord;
    PutString["OuterPackTable"];
    PutCR[];
    PutCR[];
    FOR i: OPIndex IN [0..LENGTH[opb]) DO
      opr _ opb[i];
      PutNumber[i, Decimal3];
      PutString[": hti:"L];  PutNumber[opr.hti, Decimal5];
      PutString[" ("L];  PrintHti[opr.hti];
      PutString["), ep: "];  PutOctal[opr.entryIndex];
      PutString[" ("L];  PutOctal[cspp.entry[opr.entryIndex].initialpc*2];
      PutString["), len: "];  PutOctal[opr.length];
      IF opr.firstSon # IPNull THEN {PutString[", son: "L];  PutDecimal[opr.firstSon]};
      IF opr.resident THEN PutString[", resident"L];
      IF opr.placed THEN PutString[", placed"L];
      IF opr.attr1 THEN PutString[", attr1"L];
      IF opr.attr2 THEN PutString[", attr2"L];
      PutCR[];
      ENDLOOP;
    PutCR[];
    PutCR[];
    END;
    
  PrintInnerPackTable: PROCEDURE =
    BEGIN OPEN s: symbols;
    ipb: LONG DESCRIPTOR FOR ARRAY OF InnerPackRecord _ DESCRIPTOR[
      (s.stHandle + s.stHandle.innerPackBlock.offset),
      (s.stHandle.innerPackBlock.size / SIZE[InnerPackRecord])];
    ipr: InnerPackRecord;
    PutString["InnerPackTable"];
    PutCR[];
    PutCR[];
    FOR i: IPIndex IN [0..LENGTH[ipb]) DO
      ipr _ ipb[i];
      PutNumber[i, Decimal3];
      PutString[": ("L];  PrintHti[epMap[ipr.entryIndex]];
      PutString["), ep: "];  PutOctal[ipr.entryIndex];
      PutString[" ("L];  PutOctal[cspp.entry[ipr.entryIndex].initialpc*2];
      PutString["), len: "];  PutOctal[ipr.length];
      IF ipr.lastSon THEN PutString[", lastSon"L];
      PutCR[];
      ENDLOOP;
    PutCR[];
    PutCR[];
    END;
    
  PrintConstantTable: PROCEDURE =
    BEGIN OPEN s: symbols;
    cstb: LONG DESCRIPTOR FOR ARRAY OF ConstRecord _ DESCRIPTOR[
      (s.stHandle + s.stHandle.constBlock.offset),
      (s.stHandle.constBlock.size / SIZE[ConstRecord])];
    
    PrintEntry: PROCEDURE [i: CARDINAL] =
      BEGIN
      cstr: ConstRecord = cstb[i];
      PutNumber[cstr.offset, Octal5];
      PutString["B, len:"];  PutNumber[cstr.length, Decimal3];
      END;
      
    PutString["ConstantTable"];
    PutCR[];
    PutCR[];
    PrintByColumns[PrintEntry, LENGTH[cstb], 3, 4];
    PutCR[];
    PutCR[];
    END;
    
  PrintByColumns: PROCEDURE [
      PrintOne: PROCEDURE [i: CARDINAL], nItems, nColumns, spaceBetween: CARDINAL] =
    BEGIN
    nc: CARDINAL;
    delta: CARDINAL _ (nItems + nColumns - 1)/nColumns;
    last: BOOLEAN;
    FOR i: CARDINAL IN [0..delta) DO
      nc _ 0;
      last _ FALSE;
      FOR j: CARDINAL _ i, j + delta WHILE ~last AND j < nItems DO
	nc _ nc + 1;
	last _ nc = nColumns;
	PrintOne[j];
	IF ~last THEN THROUGH [0..spaceBetween) DO PutChar[Ascii.SP]; ENDLOOP;
	ENDLOOP;
      PutCR[];
      ENDLOOP;
    END;
    
  cspp: LONG POINTER TO PrincOps.CSegPrefix;
  
  PackInfo: PROCEDURE [root: STRING] =
    BEGIN
    bcdFile: STRING _ [40];
    cseg, sseg: FileSegment.Pages;
    codeSpace: Space.Handle;
    Strings.AppendString[bcdFile, root];
    FOR i: CARDINAL IN [0..bcdFile.length) DO
      IF bcdFile[i] = '. THEN {bcdFile.length _ i;  EXIT}; 
      ENDLOOP;
    Strings.AppendString[bcdFile, ".bcd"];
    [symbols: sseg, code: cseg] _ Load[bcdFile 
      ! NoFGT => RESUME; 
        NoCode => GO TO badformat;
        NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
        NoFile => 
	  BEGIN
	  ListerDefs.WriteString["  "L];
	  ListerDefs.WriteString[bcdFile];
	  ListerDefs.WriteString[" not found"L];
	  GOTO badname;
	  END];
    symbols _ SymbolTable.Acquire[sseg];
    ListerDefs.SetRoutineSymbols[symbols];
    codeSpace _ ListerDefs.MapPages[cseg];
    cspp _ codeSpace.LongPointer;
    IF cspp.header.info.altoCode THEN ListerDefs.WriteString["Not Dstar"L]
    ELSE
      BEGIN
      CreateEpMap[];
      OutputDefs.OpenOutput[root, ".pl"];
      WriteFileID[];
      PrintOuterPackTable[];
      PrintInnerPackTable[];
      PrintConstantTable[];
      OutputDefs.CloseOutput[];
      LongStorage.Free[epMap];
      END;
    SymbolTable.Release[symbols];
    Space.Delete[codeSpace];
    EXITS
      badformat => ListerDefs.WriteString["Bad Format!"];
      badname => NULL;
    END;
    
  PackInfoInConfig: PROCEDURE [config, module: STRING] =
    BEGIN
    bcdFile: STRING _ [40];
    mti: BcdDefs.MTIndex;
    mth: BcdOps.MTHandle;
    bcd: BcdOps.BcdBase;
    cseg, sseg, bcdseg: FileSegment.Pages;
    bcdSpace, codeSpace: Space.Handle;
    Strings.AppendString[bcdFile, config];
    FOR i: CARDINAL IN [0..bcdFile.length) DO
      IF bcdFile[i] = '. THEN {bcdFile.length _ i;  EXIT}; 
      ENDLOOP;
    Strings.AppendString[bcdFile, ".bcd"];
    [symbols: sseg, code: cseg, bcd: bcdseg, mti: mti] _ LoadFromConfig[
      configName: bcdFile, moduleName: module ! 
        NoFGT => RESUME; 
        NoCode => GO TO badformat;
        NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
        NoFile =>  
	  BEGIN
	  ListerDefs.WriteString["  "L];
	  ListerDefs.WriteString[bcdFile];
	  ListerDefs.WriteString[" not found"L];
	  GOTO badname;
	  END];
    symbols _ SymbolTable.Acquire[sseg];
    ListerDefs.SetRoutineSymbols[symbols];
    bcdSpace _ ListerDefs.MapPages[bcdseg];
    bcd _ bcdSpace.LongPointer;
    mth _ @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][mti];
    codeSpace _ ListerDefs.MapPages[cseg];
    cspp _ codeSpace.LongPointer + mth.code.offset;
    IF cspp.header.info.altoCode THEN ListerDefs.WriteString["Not Dstar"L]
    ELSE
      BEGIN
      CreateEpMap[];
      OutputDefs.OpenOutput[module, ".pl"];
      WriteFileID[];
      PrintOuterPackTable[];
      PrintInnerPackTable[];
      PrintConstantTable[];
      OutputDefs.CloseOutput[];
      LongStorage.Free[epMap];
      END;
    SymbolTable.Release[symbols];
    Space.Delete[bcdSpace];  Space.Delete[codeSpace];
    EXITS
      badformat => ListerDefs.WriteString["Bad Format!"];
      badname => NULL;
    END;
    
    
  command: CommanderOps.CommandBlockHandle;
   
  command _ CommanderOps.AddCommand["PackInfo", LOOPHOLE[PackInfo], 1];
  command.params[0] _ [type: string, prompt: "Filename"];
  
  command _ CommanderOps.AddCommand["PackInfoInConfig", LOOPHOLE[PackInfoInConfig], 2];
  command.params[0] _ [type: string, prompt: "ConfigName"];
  command.params[1] _ [type: string, prompt: "ModName"];
  
  END.