-- ListPackageInfo.mesa; modified by Sweet, September 16, 1980  9:13 AM

DIRECTORY
  BcdDefs,
  BcdOps,
  CommanderDefs USING [AddCommand, CommandBlockHandle],
  ControlDefs USING [CSegPrefix],
  Inline USING [LowHalf],
  IODefs USING [NumberFormat, SP, WriteString],
  ListerDefs USING [
    FileSegmentHandle, IncorrectVersion, Load, LoadFromConfig, MultipleModules, NoCode, NoFGT,
    NoSymbols, PrintHti, SetRoutineSymbols, WriteFileID],
  OutputDefs USING [
    CloseOutput, NumberFormat, OpenOutput, PutChar, PutCR, PutDecimal, PutNumber,
    PutOctal, PutString],
  PackageSymbols USING [
    ConstRecord, InnerPackRecord, IPIndex, IPNull, OPIndex, OuterPackRecord],
  SegmentDefs USING [
    DeleteFileSegment, FileNameError, FileSegmentAddress, FileSegmentHandle,
    SwapError, SwapIn, Unlock],
  String USING [AppendString],
  Symbols USING [BTIndex, HTIndex],
  SymbolTable USING [Acquire, Base, Release, TableForSegment],
  Storage USING [Node, Free];

ListPackageInfo: PROGRAM
  IMPORTS
    CommanderDefs, Inline, IODefs, ListerDefs, OutputDefs, SegmentDefs,
    String, SymbolTable, Storage
  EXPORTS ListerDefs =
  BEGIN OPEN ListerDefs, OutputDefs, Symbols, PackageSymbols;
  
  symbols: SymbolTable.Base;
  
  Decimal3: IODefs.NumberFormat =
    [base: 10, unsigned: TRUE, zerofill: FALSE, columns: 3];
  Decimal5: IODefs.NumberFormat =
    [base: 10, unsigned: TRUE, zerofill: FALSE, columns: 5];
  Octal5: IODefs.NumberFormat =
    [base: 8, unsigned: TRUE, zerofill: FALSE, columns: 5];
  
  epMap: 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.HashForSe[b.id];
	ENDCASE;
      END;
      
    [] _ symbols.EnumerateBodies[FIRST[BTIndex], Count];
    epMap _ Storage.Node[max + 1];
    [] _ symbols.EnumerateBodies[FIRST[BTIndex], Enter];
    END;
    
  PrintOuterPackTable: PROCEDURE =
    BEGIN OPEN s: symbols;
    i: OPIndex;
    opb: DESCRIPTOR FOR ARRAY OF OuterPackRecord _ DESCRIPTOR[
      Inline.LowHalf[s.stHandle] + s.stHandle.outerPackBlock.offset,
	s.stHandle.outerPackBlock.size/SIZE[OuterPackRecord]];
    opr: OuterPackRecord;
    PutString["OuterPackTable"];
    PutCR[];
    PutCR[];
    FOR i 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[];
    RETURN
    END;
    
  PrintInnerPackTable: PROCEDURE =
    BEGIN OPEN s: symbols;
    i: IPIndex;
    ipb: DESCRIPTOR FOR ARRAY OF InnerPackRecord _ DESCRIPTOR[
      Inline.LowHalf[s.stHandle] + s.stHandle.innerPackBlock.offset,
	s.stHandle.innerPackBlock.size/SIZE[InnerPackRecord]];
    ipr: InnerPackRecord;
    PutString["InnerPackTable"];
    PutCR[];
    PutCR[];
    FOR i 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[];
    RETURN
    END;
    
  PrintConstantTable: PROCEDURE =
    BEGIN OPEN s: symbols;
    cstb: DESCRIPTOR FOR ARRAY OF ConstRecord _ DESCRIPTOR[
      Inline.LowHalf[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[];
    RETURN
    END;
    
  PrintByColumns: PROCEDURE [
    PrintOne: PROCEDURE [i: CARDINAL], 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[j];
	IF ~last THEN THROUGH [0..spaceBetween) DO PutChar[IODefs.SP]; ENDLOOP;
	ENDLOOP;
      PutCR[];
      ENDLOOP;
    END;
    
  cspp: POINTER TO ControlDefs.CSegPrefix;
  
  PackInfo: PROCEDURE [root: STRING] =
    BEGIN OPEN String, SegmentDefs;
    i: CARDINAL;
    bcdFile: STRING _ [40];
    cseg, sseg: FileSegmentHandle;
    AppendString[bcdFile, root];
    FOR i IN [0..bcdFile.length) DO
      IF bcdFile[i] = '. THEN {bcdFile.length _ i; EXIT}; ENDLOOP;
    AppendString[bcdFile, ".bcd"];
    BEGIN
    [symbols: sseg, code: cseg] _ Load[
      bcdFile ! NoFGT => RESUME ; NoCode => GO TO badformat;
      NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
      SegmentDefs.FileNameError => GOTO badname];
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
    ListerDefs.SetRoutineSymbols[symbols];
    SwapIn[cseg];
    cspp _ FileSegmentAddress[cseg];
    IF cspp.header.info.altoCode THEN IODefs.WriteString["Not D*"L]
    ELSE
      BEGIN
      CreateEpMap[];
      OpenOutput[root, ".pl"];
      WriteFileID[];
      PrintOuterPackTable[];
      PrintInnerPackTable[];
      PrintConstantTable[];
      CloseOutput[];
      Storage.Free[epMap];
      END;
    SymbolTable.Release[symbols];
    SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
    Unlock[cseg];
    DeleteFileSegment[cseg ! SwapError => CONTINUE];
    EXITS
      badformat => IODefs.WriteString["Bad Format!"];
      badname => IODefs.WriteString["File Not Found!"];
    END;
    END;
    
  PackInfoInConfig: PROCEDURE [config, module: STRING] =
    BEGIN OPEN String, SegmentDefs;
    i: CARDINAL;
    bcdFile: STRING _ [40];
    mti: BcdDefs.MTIndex;
    mth: BcdOps.MTHandle;
    bcd: BcdOps.BcdBase;
    cseg, sseg, bcdseg: FileSegmentHandle;
    AppendString[bcdFile, config];
    FOR i IN [0..bcdFile.length) DO
      IF bcdFile[i] = '. THEN {bcdFile.length _ i; EXIT}; ENDLOOP;
    AppendString[bcdFile, ".bcd"];
    BEGIN
    [symbols: sseg, code: cseg, bcdseg: bcdseg, mti: mti] _ LoadFromConfig[
      bcdFile, module, TRUE ! NoFGT => RESUME ; NoCode => GO TO badformat;
      NoSymbols, IncorrectVersion, MultipleModules => GOTO badformat;
      SegmentDefs.FileNameError => GOTO badname];
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[sseg]];
    ListerDefs.SetRoutineSymbols[symbols];
    SwapIn[cseg];
    bcd _ FileSegmentAddress[bcdseg];
    mth _ @LOOPHOLE[bcd + bcd.mtOffset, BcdDefs.Base][mti];
    cspp _ FileSegmentAddress[cseg] + mth.code.offset;
    IF cspp.header.info.altoCode THEN IODefs.WriteString["Not D*"L]
    ELSE
      BEGIN
      CreateEpMap[];
      OpenOutput[module, ".pl"];
      WriteFileID[];
      PrintOuterPackTable[];
      PrintInnerPackTable[];
      PrintConstantTable[];
      CloseOutput[];
      Storage.Free[epMap];
      END;
    SymbolTable.Release[symbols];
    SegmentDefs.DeleteFileSegment[sseg ! SegmentDefs.SwapError => CONTINUE];
    Unlock[bcdseg];
    DeleteFileSegment[bcdseg];
    Unlock[cseg];
    DeleteFileSegment[cseg ! SwapError => CONTINUE];
    EXITS
      badformat => IODefs.WriteString["Bad Format!"];
      badname => IODefs.WriteString["File Not Found!"];
    END;
    END;
    
  command: CommanderDefs.CommandBlockHandle;
  
  command _ CommanderDefs.AddCommand["PackInfo", LOOPHOLE[PackInfo], 1];
  command.params[0] _ [type: string, prompt: "Filename"];
  
    command _ CommanderDefs.AddCommand[
      "PackInfoInConfig", LOOPHOLE[PackInfoInConfig], 2];
    command.params[0] _ [type: string, prompt: "ConfigName"];
    command.params[1] _ [type: string, prompt: "ModName"];
  END...