-- DebugImpl.Mesa
--  Last edited by Lewis on  2-Apr-81 10:14:37
--  Last edited by Levin on July 6, 1982 3:42 pm

DIRECTORY
  Alloc USING [AddNotify, DropNotify, Handle, Notifier],
  BcdDefs USING [
    CTIndex, CTNull, CTRecord, EVIndex, EVNull, FTIndex, FTNull, FTRecord, FTSelf,
    MTIndex, MTRecord, Namee, NameRecord, NTIndex, NTRecord, NullName,
    PackedString, SGIndex, SGRecord, VersionID, VersionStamp],
  CodePackProcs USING [ModuleIndex],
  CharIO USING [
    CR, NumberFormat, TAB, PutChar, PutDecimal, PutNumber, PutOctal,
    PutString],
  Debug,
  PackagerDefs USING [
    globalData, packsstype, packsttype, packmdtype, packtreetype,
    packctreetype],
  ProcessingOrder USING [Enumerate],
  SemanticEntry USING [STIndex],
  SourceBcd USING [
    bcdBases, bcdHeader, bcdLimits, configTreeRoot, CTreeIndex,
    NullCTreeIndex, EnumerateModules, EnumerateModulesInConfig,
    EnumerateConfigs],
  Strings USING [SubString, SubStringDescriptor],
  SymTabDefs USING [HTIndex, HTNull],
  SymTabOps USING [SubStringForHash],
  Table USING [Base, Limit],
  Time USING [Append, Packed, Unpack],
  Tree: FROM "PackTree" USING [Index, Link, Map, NodeName, NullIndex, root],
  TreeOps: FROM "PackTreeOps" USING [UpdateTree];

DebugImpl: PROGRAM
    IMPORTS Alloc, CharIO, PackagerDefs, SourceBcd, SymTabOps, Time,
      Tree, TreeOps, ProcessingOrder
    EXPORTS Debug =
  BEGIN  OPEN PackagerDefs;

  SubString: TYPE = Strings.SubString;

  table: Alloc.Handle _ NIL;

 -- Initialization and Finalization

  Initialize: PUBLIC PROC =
    {table _ PackagerDefs.globalData.ownTable;
    table.AddNotify[UpdateBases]};

  Finalize: PUBLIC PROC =
    {table.DropNotify[UpdateBases];
    table _ NIL};
 
  stb, tb, mdb, ctreeb: Table.Base;
  pssb: LONG POINTER TO BcdDefs.PackedString;

  UpdateBases: Alloc.Notifier =
    BEGIN
    pssb   _ base[PackagerDefs.packsstype];     -- packed string table
    tb     _ base[PackagerDefs.packtreetype];   -- parse tree table
    stb    _ base[PackagerDefs.packsttype];     -- semantic entry table
    ctreeb _ base[PackagerDefs.packctreetype];  -- config tree table
    mdb    _ base[PackagerDefs.packmdtype];     -- code pack module table
    END;


 -- Utility Writes

  WriteChar: PROC [c: CHARACTER] = {CharIO.PutChar[globalData.errorStream, c]};

  WriteString: PROC [s: STRING] = {CharIO.PutString[globalData.errorStream, s]};

  WriteSubString: PROC [ss: SubString] =
    BEGIN
    i: CARDINAL;
    FOR i IN [ss.offset..ss.offset+ss.length) 
      DO WriteChar[ss.base[i]] ENDLOOP;
    END;

  WriteTime: PROC [t: Time.Packed] =
    BEGIN
    s: STRING _ [20];
    Time.Append[s, Time.Unpack[t]];
    WriteString[s];
    END;

  WriteCR: PROC = INLINE {WriteChar[CharIO.CR]};

  Indent: PROC [n: CARDINAL] =
    BEGIN
    THROUGH [1..n/8] DO WriteChar[CharIO.TAB] ENDLOOP;
    THROUGH [1..n MOD 8] DO WriteChar[' ] ENDLOOP;
    END;

  Tab: PROC [n: CARDINAL] = {WriteCR[]; Indent[n]};


 -- Annotated printing

  WriteDecimal: PROC [id: STRING, n: INTEGER] =
    BEGIN
    IF id # NIL THEN WriteString[id];
    CharIO.PutDecimal[PackagerDefs.globalData.errorStream, n];
    END;

  WriteOctal: PROC [id: STRING, n: UNSPECIFIED] =
    BEGIN
    IF id # NIL THEN WriteString[id];
    CharIO.PutOctal[PackagerDefs.globalData.errorStream, n];
    END;

  WriteIndex: PROC [id: STRING, index: UNSPECIFIED] =
    BEGIN
    IF id # NIL THEN WriteString[id];
    PrintIndex[index];
    END;


 -- Utility Prints

  PrintMachine: PROC [stamp: BcdDefs.VersionStamp] =
    BEGIN
    octal: CharIO.NumberFormat = [8,FALSE,FALSE,1];
    CharIO.PutNumber[PackagerDefs.globalData.errorStream, stamp.net, octal];
    WriteChar['#];
    CharIO.PutNumber[PackagerDefs.globalData.errorStream, stamp.host, octal];
    WriteChar['#];
    END;

  PrintFileName: PROC [fti: BcdDefs.FTIndex] =
    BEGIN OPEN BcdDefs;
    SELECT fti FROM
      FTNull => WriteString["(null)"L];
      FTSelf => WriteString["(self)"L];
      ENDCASE => WriteName[SourceBcd.bcdBases.ftb[fti].name];
    END;

  PrintFileVersion: PROC [fti: BcdDefs.FTIndex] =
    BEGIN  OPEN SourceBcd.bcdBases.ftb[fti];
    WriteChar['(];
    IF version.time = 0 THEN WriteString ["Null Version"L]
    ELSE
      BEGIN
      WriteTime[LOOPHOLE[version.time]];
      WriteChar[' ];  PrintMachine[version];
      END;
    WriteChar[')];
    END;

  PrintIndex: PROC [index: UNSPECIFIED] =
    BEGIN
    WriteChar['[];
    IF index = Table.Limit-1
      THEN WriteString["Null"L]
      ELSE CharIO.PutDecimal[PackagerDefs.globalData.errorStream, index];
    WriteChar[']];
    END;

  WriteNameFromTable: PROC [n: BcdDefs.Namee] =
    BEGIN OPEN BcdDefs;
    nti: NTIndex _ FIRST[NTIndex];
    UNTIL nti = SourceBcd.bcdLimits.nt DO
      IF SourceBcd.bcdBases.ntb[nti].item = n THEN 
        BEGIN 
        WriteName[SourceBcd.bcdBases.ntb[nti].name];  EXIT; 
        END;
      nti _ nti + SIZE[NTRecord];
      ENDLOOP;
    END;


 -- ********************** Parse Tree Printing ********************** 

  PrintTree: PUBLIC PROC =
    BEGIN
    WriteCR[];  WriteCR[];  WriteString["--Parse Tree--"L];  WriteCR[];
    PrintSubTree[Tree.root, 0];  WriteCR[];  WriteCR[];
    END;

  PrintSubTree: PROC [t: Tree.Link, nBlanks: CARDINAL] =
    BEGIN OPEN Tree;

    Printer: Tree.Map =
      BEGIN
      node: Tree.Index;
      Tab[nBlanks];
      WITH s: t SELECT FROM
        hash    => WriteHTI[s.index];
        symbol  => WriteSymbol[s.index]; 
        procs   => WriteCodePackProcs[s.index]; 
        subtree =>
          BEGIN  node _ s.index;
          IF node = Tree.NullIndex
            THEN WriteString["<empty>"L]
            ELSE
              BEGIN  OPEN tb[node];
              WriteNodeName[name];  PrintIndex[node];
              WriteOctal[", source["L, info];  WriteChar[']];
              SELECT name FROM
		allComp, compItems, exceptItems, exceptPacks,
	        itemsExceptPacks, exceptPacksItems, mainProcs =>
		  BEGIN
		  WriteString[", cp"L];  PrintIndex[cp];
	          WriteString[", seg"L];  PrintIndex[seg];
		  END;
		ENDCASE;
              IF attr1 THEN SELECT name FROM
		codePack, unnamedCodePack, discardCodePack =>
	          WriteString[", except MAIN"L];
		ENDCASE;
              IF attr2 THEN SELECT name FROM
		codeSeg, codePack, unnamedCodePack, merge, mergeFP,
		discardCodePack =>
	          WriteString[", superceded"L];
		ENDCASE;
              IF attr3 THEN SELECT name FROM
		codeSeg, codePack, unnamedCodePack, merge, mergeFP,
                discardCodePack =>
	          WriteString[", placed"L];
		ENDCASE;
	      nBlanks _ nBlanks + 2;
	      [] _ TreeOps.UpdateTree[s, Printer];
	      nBlanks _ nBlanks - 2;
              END;
          END;
        ENDCASE;
      RETURN [t]
      END;

    [] _ Printer[t];
    END;

  WriteHTI: PROC [hti: SymTabDefs.HTIndex] =
    BEGIN
    ss: Strings.SubString = @desc;
      desc: Strings.SubStringDescriptor;
    IF hti = SymTabDefs.HTNull
      THEN WriteString["(anonymous)"L]
      ELSE {SymTabOps.SubStringForHash[ss, hti];  WriteSubString[ss]};
    END;

  WriteNodeName: PROC [n: Tree.NodeName] =
    BEGIN
    NodePrintName: ARRAY Tree.NodeName OF STRING = [
      "list"L, 
      "code segment"L, "code pack"L, "unnamed code pack"L,
      "discard code pack"L, "frame pack"L,
      "merge segment"L, "merge frame pack"L,
      "allComp"L, "compItems"L, "exceptItems"L, "exceptPacks"L,
      "itemsExceptPacks"L, "exceptPacks&Items"L, "main procs"L,
      "component", "MAIN",
      "none"L];
    WriteString[NodePrintName[n]];
    END;

  WriteSymbol: PROC [sym: SemanticEntry.STIndex] =
    BEGIN
    WriteIndex["symbol"L, sym];
    WriteChar[' ];  WriteHTI[stb[sym].hti];
    WriteIndex[", parse tree"L, stb[sym].treeNode];
    WITH stb[sym] SELECT FROM
      unknown => WriteString[" <unknown>"L];
      config => 
        BEGIN
        WriteIndex[", config: cti"L, cti];  
        WriteIndex[", cNode"L, cNode];
        END;
      module => 
        BEGIN
        WriteIndex[", module: mti"L, mti];  
        WriteIndex[", mNode"L, mNode];
        END;
      segment => 
        WriteString[", segment"L];
      codePack => 
        WriteString[", code pack"L];
      framePack => 
        WriteString[", frame pack"L];
      ENDCASE;
    END;

  WriteCodePackProcs: PROC [mi: CodePackProcs.ModuleIndex] =
    BEGIN
    WriteIndex["code pack procs"L, mi];
    END;


-- ********************** Source Bcd Table Printing **********************

  PrintSourceBcd: PUBLIC PROC =
    BEGIN
    WriteCR[];  WriteCR[];  WriteString["--Source Bcd--"L];  WriteCR[];
    PrintHeader[];
    WriteString["Configurations:"L];
    SourceBcd.EnumerateConfigs[PrintConfig];
    WriteCR[];  WriteCR[];  WriteString["Modules:"L];
    SourceBcd.EnumerateModules[PrintModule];
    WriteCR[];
    PrintFiles[];
    END;
    
  PrintHeader: PROC =
    BEGIN OPEN bcd: SourceBcd.bcdHeader;
    WriteString["  Configured "L];
    WriteTime[LOOPHOLE[bcd.version.time]];
    IF bcd.source # BcdDefs.NullName THEN
      BEGIN WriteString[" from "L];  WriteName[bcd.source];  END;
    WriteString[" by "L];
    PrintMachine[bcd.version];
    IF bcd.versionIdent # BcdDefs.VersionID THEN
      WriteDecimal["  Obsolete VersionID = "L, bcd.versionIdent];
    WriteCR[];
    WriteString["  Configured by "L];
    WriteTime[LOOPHOLE[bcd.creator.time]];
    WriteChar[' ];
    PrintMachine[bcd.creator];
    WriteCR[];
    WriteString["  "L];
    IF ~bcd.definitions THEN WriteChar['~];  
    WriteString["definitions, "L];
    IF ~bcd.repackaged THEN WriteChar['~];  
    WriteString["repackaged, "L];
    IF ~bcd.tableCompiled THEN WriteChar['~];  
    WriteString["tableCompiled"L];
    WriteCR[];  WriteCR[];
    WriteDecimal["  Configurations: "L, bcd.nConfigs];
    WriteDecimal[", Modules: "L, bcd.nModules];
    WriteDecimal[", Imports: "L, bcd.nImports];
    WriteDecimal[", Exports: "L, bcd.nExports];
    WriteDecimal[", Dummy: "L, bcd.firstdummy];
    WriteDecimal[", #Dummies: "L, bcd.nDummies];
    WriteCR[];  WriteCR[];
    END;

  PrintConfig: PROC [cti: BcdDefs.CTIndex] RETURNS [stop: BOOLEAN] =
    BEGIN OPEN BcdDefs;
    config: LONG POINTER TO BcdDefs.CTRecord = @SourceBcd.bcdBases.ctb[cti];
    i: CARDINAL;
    Tab[2];
    WriteName[config.name];  PrintIndex[cti];
    IF config.namedInstance THEN
      {WriteString[", instance: "L];  WriteNameFromTable[[config[cti]]]};
    WriteString[", file: "L];  PrintFileName[config.file];
    PrintIndex[config.file];
    IF config.config # CTNull THEN
      BEGIN WriteString[", parent: "L];
      WriteName[SourceBcd.bcdBases.ctb[config.config].name];
      PrintIndex[config.config];
      END;
    IF config.nControls # 0 THEN
      BEGIN
      WriteString[", controls:"L];
      FOR i IN [0..config.nControls) DO
        IF i MOD 6 = 0 THEN Tab[6] ELSE WriteChar[' ];
        WITH item: config.controls[i] SELECT FROM
          module => WriteName[SourceBcd.bcdBases.mtb[item.mti].name];
          config => WriteName[SourceBcd.bcdBases.ctb[item.cti].name];
          ENDCASE;
        PrintIndex[config.controls[i]];
        IF i+1 # config.nControls THEN WriteChar[',];
        ENDLOOP;
      END;
    RETURN[FALSE];
    END;

  PrintModule: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOLEAN] =
    BEGIN OPEN BcdDefs;
    module: LONG POINTER TO BcdDefs.MTRecord = @SourceBcd.bcdBases.mtb[mti];
    Tab[2];
    WriteName[module.name];  PrintIndex[mti];
    IF module.namedInstance THEN
      {WriteString[", instance: "L];  WriteNameFromTable[[module[mti]]]};
    WriteString[", file: "L];  
    PrintFileName[module.file];  PrintIndex[module.file];
    IF module.config # CTNull THEN
      BEGIN
      WriteString[", config: "L];
      WriteName[SourceBcd.bcdBases.ctb[module.config].name];
      PrintIndex[module.config];
      END;
    Tab[4];
    WriteDecimal["framesize: "L, module.framesize];
    WriteDecimal[", gfi: "L, module.gfi];
    WriteDecimal[", ngfi: "L, module.ngfi];
    WriteString[", links: "L];
    WriteString[IF module.linkLoc=frame THEN "frame"L ELSE "code"L];
    Tab[4];
    WriteString["code: "L];  PrintSegment[module.code.sgi];
    WriteOctal[", offset: "L, module.code.offset];
    WriteOctal[", length: "L, module.code.length];
    IF module.code.linkspace THEN WriteString [", space available for links"L];
    Tab[4];
    WriteString["symbols: "L];  PrintSegment[module.sseg];
    IF module.variables # EVNull THEN
      {Tab[4];  WriteIndex["variables: "L, module.variables]};
    Tab[4];
    WriteDecimal["number of links: "L, NLinks[module]];
    Tab[4];
    IF ~module.altoCode THEN WriteChar['~];
    WriteString["altoCode, "L];
    IF ~module.packageable THEN WriteChar['~];
    WriteString["packageable, "L];
    IF ~module.tableCompiled THEN WriteChar['~];
    WriteString["tableCompiled, "L];
    IF ~module.residentFrame THEN WriteChar['~];
    WriteString["residentFrame"L];
    RETURN[FALSE];
    END;

  NLinks: PROC [module: LONG POINTER TO BcdDefs.MTRecord]
    RETURNS [nLinks: [0..Table.Limit)] =
    BEGIN
    WITH mth: module SELECT FROM
      direct => RETURN[mth.length];
      indirect => RETURN[SourceBcd.bcdBases.lfb[mth.links].length];
      multiple => RETURN[SourceBcd.bcdBases.lfb[mth.links].length];
      ENDCASE;
    END;

  PrintSegment: PROC [sgi: BcdDefs.SGIndex] =
    BEGIN 
    sd: LONG POINTER TO BcdDefs.SGRecord = @SourceBcd.bcdBases.sgb[sgi];
    PrintFileName[sd.file];  PrintIndex[sgi];
    WriteDecimal[", [base: "L, sd.base]; WriteDecimal[", pages: "L, sd.pages];
    IF sd.extraPages # 0 THEN WriteDecimal["+"L, sd.extraPages];
    WriteChar[']];
    END;

  PrintFiles: PROC =
    BEGIN OPEN BcdDefs;
    fti: FTIndex _ FIRST[FTIndex];
    WriteCR[];  WriteString["Files:"L];
    UNTIL fti = SourceBcd.bcdLimits.ft DO 
      PrintFile[fti]; 
      fti _ fti + SIZE[FTRecord] 
      ENDLOOP;
    WriteCR[];
    END;

  PrintFile: PROC [fti: BcdDefs.FTIndex] =
    BEGIN OPEN SourceBcd.bcdBases.ftb[fti];
    Tab[2];
    SELECT fti FROM
      BcdDefs.FTNull => WriteString["(null)"];
      BcdDefs.FTSelf => WriteString["(self)"];
      ENDCASE =>
	BEGIN
	WriteName[name];  PrintIndex[fti];
	WriteString[", version: "L];  PrintFileVersion[fti];
	END;
    END;

  WriteName: PROC [n: BcdDefs.NameRecord] =
    BEGIN
    ssd: Strings.SubStringDescriptor _ [
      base: @SourceBcd.bcdBases.ssb.string, 
      offset: n, 
      length: SourceBcd.bcdBases.ssb.size[n]];
    WriteSubString[@ssd];
    END;


 -- ********************** Configuration Tree Printing **********************

  PrintConfigTree: PUBLIC PROC =
    BEGIN  OPEN SourceBcd;
    WriteCR[];  WriteCR[];  WriteString["--Configuration Tree--"L];  WriteCR[];    
    IF configTreeRoot = NullCTreeIndex THEN WriteString[" <Empty>"L]
    ELSE {WriteSubConfigTree[configTreeRoot, 0];  WriteCR[]};
    WriteCR[];
    END;

  WriteSubConfigTree: PROC [root: SourceBcd.CTreeIndex, nBlanks: CARDINAL] =
    BEGIN  OPEN SourceBcd, node: ctreeb[root];
    son: CTreeIndex;
    Tab[nBlanks];
    WITH node SELECT FROM
      instance => {WriteName[instanceName];  WriteChar[':]};
      ENDCASE;
    WriteName[node.prototypeName];  PrintIndex[root];
    WriteChar[' ];
    IF ~node.anotherNodeWSameProtoName THEN WriteChar['~];
    WriteString["pNameTwice"L];
    WITH node.index SELECT FROM
      module => WriteIndex[", module"L, mti];
      config => WriteIndex[", config"L, cti];
      ENDCASE;
    WriteIndex[", Link: i"L, node.instanceLink];
    WriteIndex[", p"L, node.prototypeLink];
    WriteIndex[", Prev: i"L, node.instancePrev];
    WriteIndex[", p"L, node.prototypePrev];
    IF node.firstSon # NullCTreeIndex THEN
      BEGIN
      nBlanks _ nBlanks + 2;
      FOR son _ node.firstSon, ctreeb[son].brother UNTIL son = NullCTreeIndex DO
        WriteSubConfigTree[son, nBlanks];
        ENDLOOP;
      nBlanks _ nBlanks - 2;
      END;
    END;


 -- ******************** Processing Order Printing ********************

  PrintProcessingOrder: PUBLIC PROC =
    BEGIN
    WriteCR[];  WriteCR[];  WriteString["--Processing Order--"L];  WriteCR[];
    SourceBcd.EnumerateModulesInConfig[
      kind: prototype,
      configTreeNode: SourceBcd.configTreeRoot,
      userProc: PrintOneModulesOrder];
    WriteCR[];
    END;

  PrintOneModulesOrder: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOLEAN] =
    BEGIN
    printCount: CARDINAL _ 0;

    PrintOneCDNode: PROC [cdNode: Tree.Index] RETURNS [stop: BOOLEAN] =
      BEGIN  -- print one component description node to be processed for mti
      IF (printCount _ printCount+1) > 10 THEN 
        {WriteCR[];  WriteString["  "L];  printCount _ 1}
      ELSE WriteString[" "L];
      PrintIndex[cdNode];
      RETURN[FALSE];
      END;
  
    Tab[0];
    WriteName[SourceBcd.bcdBases.mtb[mti].name];  
    PrintIndex[mti];  WriteString[": "L];  
    ProcessingOrder.Enumerate[mti, PrintOneCDNode];
    RETURN[FALSE];
    END;

  END.