-- STDebugSymbols.mesa  
-- Edited by Bruce,  October 13, 1980  1:48 PM
-- Edited by Sweet,  September 2, 1980  10:11 AM

DIRECTORY
  BcdDefs USING [VersionStamp],
  RESOut USING [
    PChar, PCr, PNext, PNextNull, PNextUnsigned, PNull, PNumber, PString, 
    PUnsigned],
  STDebugDefs USING [
    HashForSei, LockSymbols, PutHashString, PutModeName, PutTypeName, 
    showLinks, STCopyRead, TableBase, TableSize, UnlockSymbols],
  String USING [AppendChar, AppendDecimal, AppendString],
  Symbols USING [
    BodyRecord, bodyType, BTIndex, BTNull, CTXIndex, CTXNull, CTXRecord, 
    ctxType, ExtensionType, HTIndex, HTNull, HTRecord, htType, ISEIndex, 
    ISENull, MDIndex, MDRecord, mdType, SEIndex, SENull, SERecord, seType],
  SymbolSegment USING [ExtIndex, ExtRecord, extType],
  Table USING [Base],
  Time USING [Append, Unpack],
  Tree USING [Link, Null];

STDebugSymbols: PROGRAM 
  IMPORTS RESOut, STDebugDefs, String, Time
  EXPORTS STDebugDefs =
  BEGIN OPEN Symbols, RESOut, STDebugDefs;

  PU: PROCEDURE [u: UNSPECIFIED] = LOOPHOLE[RESOut.PUnsigned];
  PNextU: PROCEDURE [s: STRING, num: UNSPECIFIED, indent: CARDINAL _ 2] =
    LOOPHOLE[RESOut.PNextUnsigned];

  NextSe: PUBLIC PROCEDURE =
    BEGIN
    IF nextSe # Symbols.ISENull THEN PutAsSei[nextSe];
    END;

  nextSe: Symbols.ISEIndex _ ISENull;

  FindExt: PRIVATE PROCEDURE [sei: ISEIndex] RETURNS
      [type: ExtensionType, tree: Tree.Link] =
    BEGIN OPEN SymbolSegment;
    extb: Table.Base = TableBase[extType];
    exti: ExtIndex;
    extr: ExtRecord;
    extLimit: ExtIndex = LOOPHOLE[TableSize[extType]];
    
    FOR exti _ FIRST[ExtIndex], exti + SIZE[ExtRecord] UNTIL exti = extLimit DO
      STCopyRead[to: @extr, from: @extb[exti], nwords: SIZE[ExtRecord]];
      IF extr.sei = sei THEN RETURN[extr.type, extr.tree];
      ENDLOOP;
    RETURN[none, Tree.Null];
    END;

  PutAsSei: PUBLIC PROCEDURE [sei: Symbols.SEIndex] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    seb: Table.Base;
    ser: SERecord;
    hti: HTIndex;
    eString: STRING _ [20];
  
    LockSymbols[];
    seb _ TableBase[seType];
    STCopyRead[to: @ser, from: @seb[sei],
      nwords: SIZE [SERecord]];
    PCr[];
    PString["seb["L]; PU[sei]; PString["] "L];
    WITH se: ser SELECT FROM
      id =>
        BEGIN
        hti _ HashForSei[LOOPHOLE[sei]];
        PutHashString[hti];
        PNextNull["hti"L, hti, HTNull];
        PNextNull["ctx"L, se.idCtx, CTXNull];
        PNextU["value"L, se.idValue];
        PNextU["info"L, se.idInfo];
        PNextU["type"L, se.idType];
        IF se.extended THEN 
	  BEGIN OPEN String;
	  type: ExtensionType;
	  tree: Tree.Link;

	  [type, tree] _ FindExt[LOOPHOLE[sei]];
	  eString.length _ 0;
	  AppendString[eString, "extended["L];
	  AppendString[eString, (SELECT type FROM
	    value => "val"L,
	    form => "for"L,
	    default => "def"L,
	    ENDCASE => "non"L)];
	  AppendChar[eString,',];
	  AppendDecimal[eString, LOOPHOLE[tree]];
	  AppendChar[eString,']];
	  PNext[eString];
	  END;
        IF se.public THEN PNext["public"L];
        IF se.immutable THEN PNext["immutable"L];
        IF se.constant THEN PNext["constant"L];
        IF se.linkSpace THEN PNext["linkSpace"L];
        WITH se SELECT FROM
          terminal => BEGIN PNext["terminal"L]; nextSe _ ISENull END;
          linked => {PNextNull["linked"L, link, ISENull]; nextSe _ link};
	  sequential => nextSe _ LOOPHOLE[sei+SIZE[sequential id SERecord]];
          ENDCASE;
        END;
      cons => 
	BEGIN
        WITH se SELECT FROM
	  transfer => PutModeName[mode];
	  ENDCASE => PutTypeName[se.typeTag];
	WITH cse: se SELECT FROM
          mode => NULL;
          basic =>
            BEGIN
            PString[" - code: "L]; PUnsigned[cse.code];
            PNextU["length"L, cse.length];
            IF cse.ordered THEN PNext["ordered"L];
            END;
          enumerated =>
            BEGIN
            PString[" - valCtx: "L];
            PU[cse.valueCtx]; PNextU["nVals"L, cse.nValues];
            IF cse.ordered THEN PNext["ordered"L];
            IF cse.machineDep THEN PNext["machineDep"L];
            IF cse.sparse THEN PNext["sparse"L];
            END;
          record =>
            BEGIN
            PString[" - fieldCtx: "L]; PU[cse.fieldCtx];
            PNextU["length"L, cse.length];
	    WITH lnkp: cse SELECT FROM
	      linked => PNextU["linkType",lnkp.linkType];
	      ENDCASE;
            IF cse.argument THEN PNext["argument"L];
            IF cse.monitored THEN PNext["monitored"L];
            IF cse.painted THEN PNext["painted"L];
            IF cse.machineDep THEN PNext["machineDep"L];
            IF cse.hints.variant THEN PNext["variant"L];
            IF cse.hints.comparable THEN PNext["comparable"L];
            IF cse.hints.privateFields THEN PNext["privateFields"L];
            IF cse.hints.unifield THEN PNext["unifield"L];
            IF cse.hints.refField THEN PNext["refField"L];
            IF cse.hints.default THEN PNext["default"L];
            IF cse.hints.voidable THEN PNext["voidable"L];
            END;
          ref =>
            BEGIN
            PString[" - refT: "L]; PU[cse.refType];
            IF cse.counted THEN PNext["counted"L];
            IF cse.list THEN PNext["list"L];
            IF cse.ordered THEN PNext["ordered"L];
            IF cse.readOnly THEN PNext["readOnly"L];
            IF cse.basing THEN PNext["basing"L];
            END;
          array =>
            BEGIN
            PString[" - index: "L]; PU[cse.indexType];
            PNextU["comp"L, cse.componentType];
            IF cse.packed THEN PNext["packed"L];
            END;
          arraydesc =>
            BEGIN
            PString[" - of: "L]; PU[cse.describedType];
            IF cse.readOnly THEN PNext["readOnly"L];
            END;
          transfer =>
            BEGIN
            PNextNull["in"L, cse.inRecord, SENull];
            PNextNull["out"L, cse.outRecord, SENull];
            END;
          definition =>
            BEGIN
            PString[" - defCtx: "L]; PU[cse.defCtx];
            PNext["nGfi: "L, 1]; PU[cse.nGfi];
            IF cse.named THEN PNext["named"L];
            END;
          union =>
            BEGIN
            PString[" - tag: "L]; PNull[cse.tagSei, SENull];
            PNextU["caseCtx"L, cse.caseCtx];
            IF cse.overlaid THEN PNext["overlaid"L];
            IF cse.controlled THEN PNext["controlled"L];
            IF cse.machineDep THEN PNext["machineDep"L];
            IF cse.hints.equalLengths THEN PNext["equalLengths"];
            IF cse.hints.refField THEN PNext["refField"];
            IF cse.hints.default THEN PNext["default"];
            IF cse.hints.voidable THEN PNext["voidable"];
            END;
	  sequence =>
	    BEGIN
            PString[" - tag: "L]; PNull[cse.tagSei, SENull];
            PNextU["comp"L, cse.componentType];
            IF cse.controlled THEN PNext["controlled"L];
            IF cse.packed THEN PNext["packed"L];
            IF cse.machineDep THEN PNext["machineDep"L];
	    END;
          relative =>
            BEGIN
            PString[" - base: "L]; PU[cse.baseType];
            PNextU["offset"L, cse.offsetType];
            PNextU["result"L, cse.resultType];
            END;
          subrange =>
            BEGIN
            PString[" - of: "L]; PNull[cse.rangeType, SENull];
            PNextU["origin"L, cse.origin];
            PNextU["range"L, cse.range];
            IF cse.filled THEN PNext["filled"L];
            IF cse.empty THEN PNext["empty"L];
            END;
          long, real =>
            BEGIN
            PString[" - of: "L]; PNull[cse.rangeType, SENull];
            END;
          opaque =>
            BEGIN
            PString[" - id(se): "L]; PNull[cse.id, SENull];
            PNextU["length"L, cse.length];
            IF cse.lengthKnown THEN PNext["lengthKnown"L];
            END;
	  zone =>
	    BEGIN
            IF cse.counted THEN PNext["counted"L];
            IF cse.mds THEN PNext["mds"L];
	    END;
          ENDCASE;
	END;
      ENDCASE;
    IF showLinks THEN
      BEGIN
      IF ser.mark3 THEN PNext["mk3"L];
      IF ser.mark4 THEN PNext["mk4"L];
      END;
    UnlockSymbols[];
    END;

  PutAsHti: PUBLIC PROCEDURE [hti: Symbols.HTIndex] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    ht: DESCRIPTOR FOR ARRAY HTIndex OF HTRecord;
    htr: HTRecord;

    LockSymbols[];
    ht _ DESCRIPTOR[TableBase[htType], 0]; -- ignore length
    STCopyRead[to: @htr, from: @ht[hti],
      nwords: SIZE[HTRecord]];
    PCr[];
    PString["ht["L]; PU[hti]; PString["] "L];
    PutHashString[hti];
    PNextU["ssI"L, htr.ssIndex];
    PNextU["link"L, htr.link];
    IF htr.anyInternal THEN PNext["anyInt"L];
    IF htr.anyPublic THEN PNext["anyPub"L];
    UnlockSymbols[];
    END;

  PutAsCti: PUBLIC PROCEDURE [cti: Symbols.CTXIndex] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    ctxb: Table.Base;
    ctx: CTXRecord;

    LockSymbols[];
    ctxb _ TableBase[ctxType];
    STCopyRead[to: @ctx, from: @ctxb[cti],
      nwords: SIZE[CTXRecord]];
    PCr[];
    PString["ctx["L]; PU[cti]; PString["] level: "L];
    PU[ctx.level]; 
    PNextU["seList"L, ctx.seList];
    IF ctx.mark THEN PNext["mark"L];
    IF ctx.varUpdated THEN PNext["varUpdated"L];
    IF ctx.ctxType # nil THEN
      BEGIN
      WITH ctx SELECT FROM
	simple => 
	  BEGIN
	  PNextU["simple - ctxNew"L, ctxNew];
	  END;
	imported => 
	  BEGIN
	  PNextU["imported - link"L, includeLink];
	  END;
	included => 
	  BEGIN
	  PCr[]; PString["    "L];
	  PString["included - chain: "L]; PNull[chain, CTXNull];
	  PNextU["module"L, module];
          PNextU["map"L, map];
	  IF closed THEN PNext["closed"L,,6];
	  IF complete THEN PNext["complete"L,,6];
	  IF restricted THEN PNext["restricted"L,,6];
	  IF reset THEN PNext["reset"L,,6];
	  END;
	ENDCASE;
      END;
    UnlockSymbols[];
    END;

  PutAsBti: PUBLIC PROCEDURE [bti: Symbols.BTIndex] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    bb: Table.Base;
    btr: BodyRecord;

    LockSymbols[];
    bb _ TableBase[bodyType];
    STCopyRead[to: @btr, from: @bb[bti],
      nwords: SIZE[BodyRecord]];
    PCr[];
    PString["bb["L]; PU[bti]; PString["] link: "L];
    IF btr.link.index = BTNull THEN PString["Null"L]
    ELSE
      BEGIN
      PU[btr.link.index];
      PString[(IF btr.link.which = sibling THEN " (sib)"L ELSE " (parent)"L)];
      END;
    PNextNull["firstSon"L, btr.firstSon, BTNull];
    PNextNull["localCtx"L, btr.localCtx, CTXNull];
    PNextU["level"L, btr.level];
    PNextU["source"L, btr.sourceIndex];
    PCr[]; PString["    "L];
    WITH btr.info SELECT FROM
      Internal =>
	BEGIN
	PString["Internal - tree: "L]; PNull[bodyTree, Tree.Null];
	PNextU["thread"L, thread, 6];
	PNextU["frameSz"L, frameSize, 6];
	END;
      External =>
	BEGIN
	PString["External - bytes: "L]; PU[bytes];
	PNextU["startInd"L, startIndex, 6];
	PNextU["indLen"L, indexLength, 6];
	END;
      ENDCASE;
    WITH bc: btr SELECT FROM
      Callable =>
	BEGIN
        hti: HTIndex = HashForSei[bc.id];
	PCr[]; PString["    Callable - id(se): "L]; PU[bc.id];
	PString[" ("L]; PutHashString[hti]; PChar[')];
	PNextU["ioType"L, bc.ioType, 6];
	PNextU["entIndex"L, bc.entryIndex, 6];
	WITH bc SELECT FROM
	  Inner => BEGIN PNextU["frameOff"L, frameOffset, 6] END;
	  ENDCASE;
        IF bc.inline THEN PNext["inline"L,,6];
        IF bc.monitored THEN PNext["monitored"L,,6];
        IF bc.stopping THEN PNext["stopping"L,,6];
        IF bc.resident THEN PNext["resident"L,,6];
        IF bc.entry THEN PNext["entry"L,,6];
        IF bc.internal THEN PNext["internal"L,,6];
        IF bc.hints.safe THEN PNext["safe"L,,6];
        IF bc.hints.argUpdated THEN PNext["argUpdated"L,,6];
        IF bc.hints.nameSafe THEN PNext["nameSafe"L,,6];
        IF bc.hints.attr4 THEN PNext["attr4"L,,6];
	END;
      Other =>
	BEGIN
	PCr[]; PString["    Other - relOffset: "L]; PU[bc.relOffset];
	END;
      ENDCASE;
    UnlockSymbols[];
    END;

  PutAsMdi: PUBLIC PROCEDURE [mdi: Symbols.MDIndex] =
    BEGIN ENABLE UNWIND => UnlockSymbols[];
    mdb: Table.Base;
    mdr: MDRecord;

    LockSymbols[];
    mdb _ TableBase[mdType];
    STCopyRead[to: @mdr, from: @mdb[mdi],
      nwords: SIZE[MDRecord]];
    PCr[];
    PString["mdb["L]; PU[mdi]; PString["] stamp: "L]; PutVersion[@mdr.stamp];
    PNextU["modId"L, mdr.moduleId];
    PNextU["fileId"L, mdr.fileId];
    PNextNull["ctx"L, mdr.ctx, CTXNull];
    PNextNull["defaultImport"L, mdr.defaultImport, CTXNull];
    PNextUnsigned["file"L, mdr.file];
    IF mdr.shared THEN PNext["shared"L];
    IF mdr.exported THEN PNext["exported"L];
    UnlockSymbols[];
    END;


  PutVersion: PUBLIC PROCEDURE [stamp: POINTER TO BcdDefs.VersionStamp] =
    BEGIN
    s: STRING _ [20];
    Time.Append[s, Time.Unpack[stamp.time]];
    PString[s];
    PString[" on "L];
    PNumber[stamp.net,[8,FALSE,TRUE,1]];
    PChar['#];
    PNumber[stamp.host,[8,FALSE,TRUE,1]];
    PChar['#];
    RETURN
    END;

  END.