-- DumpHot.mesa; modified by Johnsson, July 16, 1980  8:33 AM
--		 modified by Bruce, October 25, 1980  8:16 PM

DIRECTORY
  Ascii USING [CR, DEL, LF, NUL, SP, TAB],
  Commands USING [WriteError],
  DebugFormat USING [BitAddress, Fob, Foo, LongSubString],
  DebugOps USING [
    Foo, FooProc, Lengthen, LongCopyREAD, LongREAD, NotImplemented, ShortREAD,
    InvalidAddress, UserAborted],
  DI USING [
    CheckClass, CSEIndex, CTXIndex, EnumeratedSEIndex, FindField, Foo,
    Format, GetValue, ISEIndex, LongSEIndex, Normalize, Pad, SearchCtxForVal,
    SEIndex, SubrangeSEIndex, TagIsei, TypeForSe, UnionSEIndex, ValFormat, VariantType],
  DOutput USING [
    Blanks, Char, Decimal, EOL, LongDecimal, LongOctal, Number, Octal, SubString, Text],
  Strings USING [SubString, SubStringDescriptor],
  Dump USING [
    Array, ArrayDesc, LongArrayDesc, Opaque, Printer, printers, PrintRec, Real,
    Type, Xfer, CompareSes, Sequence],
  DHeap USING [AllocFob],
  Init USING [],
  Lookup USING [CopyMore],
  State USING [GetGS, GSHandle],
  String USING [SubString],
  SymbolOps USING [BitsForType, RecordRoot, SubStringForHash],
  Symbols USING [
    CSEIndex, CTXIndex, HTIndex, HTNull, ISEIndex, ISENull, RecordSEIndex,
    RecordSENull, SEIndex, SENull, SERecord, TransferMode, TypeClass, typeTYPE],
  SymbolSegment USING [bodyType, ctxType, seType],
  Table USING [AddNotify, Base, DropNotify, Notifier],
  UserInput USING [ResetUserAbort, userAbort];

DumpHot: PROGRAM
  IMPORTS
    Commands, DebugOps, DI, DOutput, Dump, DHeap, Lookup,
    State, SymbolOps, Table, UserInput
  EXPORTS DebugOps, Dump, Init =
BEGIN OPEN DI, Dump, SymbolOps, Symbols;

NoTypeInfo: PUBLIC ERROR [sei: SEIndex] = CODE;
StrangeRecord: ERROR = CODE;

seb: Table.Base;
ctxb: Table.Base;
bb: Table.Base;
data: State.GSHandle _ State.GetGS[];
entryDepth: CARDINAL _ 0;

StringLimit: PUBLIC CARDINAL _ LAST[CARDINAL];

Enter: PROCEDURE = {
  IF entryDepth = 0 THEN Table.AddNotify[Notify];
  entryDepth _ entryDepth + 1};

Exit: PROC = {IF (entryDepth _ entryDepth-1) = 0 THEN Table.DropNotify[Notify]};

Notify: Table.Notifier =
  BEGIN OPEN SymbolSegment;
  seb _ base[seType];
  ctxb _ base[ctxType];
  bb _ base[bodyType];
  END;

UserPrint: PROCEDURE [f: Foo] RETURNS [BOOLEAN] =
  BEGIN
  p: POINTER TO PrintRec;
  IF f.tsei = SENull THEN RETURN[FALSE];
  FOR p _ printers, p.link UNTIL p = NIL DO
    IF ~CompareSes[p.tsei, f.tsei] THEN LOOP;
    p.proc[f !ANY => BEGIN p.tsei _ SENull; CONTINUE END];
    RETURN [TRUE];
    ENDLOOP;
  RETURN[FALSE];
  END;

DisplayFoo: PUBLIC DebugOps.FooProc = {Display[f]};

Display: PUBLIC PROCEDURE [f: Foo, rec: BOOLEAN _ FALSE] =
  BEGIN
  csei: CSEIndex;
  IF f = NIL THEN RETURN;
  Enter[];
  IF f.typeOnly THEN
    WITH seb[f.tsei] SELECT FROM
      id => Type[LOOPHOLE[f.tsei]];
      ENDCASE => {Exit[]; ERROR NoTypeInfo[f.tsei]}
  ELSE
    BEGIN ENABLE {
	DebugOps.InvalidAddress => {
	  Commands.WriteError[badAddress,FALSE];
	  DOutput.LongOctal[address]; DOutput.Char[']];
	  CONTINUE};
	UNWIND => Exit[]};
    IF f.hti # HTNull THEN {
      IF f.indent # 0 THEN DOutput.Blanks[f.indent];
      HtiVal[f.hti];
      DOutput.Text[IF rec THEN ":"L ELSE " = "L]};
    IF ~UserPrint[f] THEN {
      csei _ DI.TypeForSe[f.tsei];
      WITH seb[csei] SELECT FROM
	basic, enumerated, ref, arraydesc,
	relative, subrange, long, real, zone => GetValue[f];
	transfer, record, array, union, opaque => NULL;
	ENDCASE;
      WITH seb[csei] SELECT FROM
	basic, ref, enumerated => TypedNum[f.addr.base^, f.tsei];
	zone => Zone[f, mds];
	relative => Relative[f];
	record => Record[f];
	array => Array[f];
	arraydesc => ArrayDesc[f];
	transfer => Xfer[f];
	union => UnionErr[];
	subrange => Subrange[f];
	long => Long[f];
	real => Real[f];
	opaque => Opaque[f];
	ENDCASE};
    END;
  Exit[];
  IF ~rec THEN DOutput.EOL[];
  END;

UnionErr: PROC = {SIGNAL DebugOps.NotImplemented[" Printing entire variant parts"L]};

Zone: PUBLIC PROCEDURE [f: Foo, short: BOOLEAN] =
  BEGIN
  lp: LONG POINTER TO LONG UNSPECIFIED = f.addr.base;
  IF short THEN TypedNum[f.addr.base^, f.tsei] ELSE TypedLongNum[lp^, f.tsei];
  END;

Basic: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  [] _ CheckClass[basic, f];
  TypedNum[f.addr.base^, f.tsei];
  END;

Pointer, StringPrinter: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  [] _ CheckClass[ref, f];
  TypedNum[f.addr.base^, f.tsei];
  END;

Relative: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  type: {p, long, desc};
  csei: Symbols.CSEIndex _ DI.TypeForSe[f.tsei];
  [] _ CheckClass[relative, f];
  Enter[];
  WITH seb[csei] SELECT FROM
    arraydesc => {f.tsei _ csei; DOutput.Text[" RELATIVE "L]; type _ desc};
    long => {
      csei: Symbols.CSEIndex _ DI.TypeForSe[rangeType];
      IF seb[csei].typeTag = arraydesc THEN {f.tsei _ csei; DOutput.Text[" RELATIVE "L]};  
      type _ long};
    ENDCASE => type _ p;
  Exit[];
  SELECT type FROM
    long => Long[f];
    desc => ArrayDesc[f];
    ENDCASE => TypedNum[f.addr.base^, f.tsei];
  END;

Enumerated: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  [] _ CheckClass[enumerated, f];
  TypedNum[f.addr.base^, f.tsei];
  END;

Record: PUBLIC PROCEDURE [f: Foo] = {
  variant: RecordSEIndex _ CheckClass[record, f];
  root: RecordSEIndex _ SymbolOps.RecordRoot[variant];
  VariantType: PROC RETURNS [RecordSEIndex] = {RETURN[variant]};
  IF root # RecordSENull THEN f.tsei _ root;
  IF root = variant THEN variant _ RecordSENull;
  RecordCommon[f,VariantType]};

NullVariant: PUBLIC PROC RETURNS [Symbols.RecordSEIndex] = {RETURN[Symbols.RecordSENull]};

RecordCommon: PROC [f: Foo, variant: PROC RETURNS [Symbols.RecordSEIndex]] =
  BEGIN
  rsei: RecordSEIndex _ CheckClass[record, f];
  Lookup.CopyMore[rsei];
  Enter[];
  WITH seb[f.tsei] SELECT FROM
    id => HtiVal[hash];
    ENDCASE;
  FieldCtx[f, seb[rsei].fieldCtx, Pad[f,rsei], variant, rsei !UNWIND => Exit[]];
  Exit[];
  END;

FieldCtx: PUBLIC PROCEDURE [
    f: Foo, ctx: Symbols.CTXIndex, pad: CARDINAL,
    variant: PROC RETURNS [Symbols.RecordSEIndex] _ NullVariant,
    rsei: Symbols.RecordSEIndex _ Symbols.RecordSENull] =
  BEGIN
  notXfer: BOOLEAN _ ~f.xfer;
  root,isei: ISEIndex; 
  first: BOOLEAN _ TRUE;
  csei: CSEIndex;
  GetNextSe: PROC =
    BEGIN
    WITH id: seb[isei] SELECT FROM
      sequential =>  isei _ isei + SIZE[sequential id Symbols.SERecord];
      linked =>  IF (isei _ id.link) = root THEN isei _ Symbols.ISENull;
      ENDCASE => isei _ Symbols.ISENull;
    END;
  Enter[];
  isei _ root _ ctxb[ctx].seList;
  IF notXfer THEN DOutput.Char['[];
  DO
    IF isei = Symbols.ISENull THEN EXIT;
    IF seb[isei].constant OR seb[isei].idType = Symbols.typeTYPE OR seb[isei].idCtx # ctx THEN
      {GetNextSe[]; LOOP};
    IF notXfer AND ~first THEN DOutput.Text[", "L];
    csei _ DI.TypeForSe[isei];
    SELECT seb[csei].typeTag FROM
      union => Variant[f, pad, LOOPHOLE[csei], variant];
      sequence => {
	HashVal[isei]; DOutput.Char[':]; Sequence[f, pad, LOOPHOLE[csei], variant]};
      ENDCASE =>
	BEGIN ENABLE UNWIND => Exit[];
	temp: Foo _ FindField[f,pad,isei];
	IF temp.typeOnly THEN {GetNextSe[]; LOOP};
	temp.addr.useStack _ temp.xfer _ FALSE;
	IF notXfer THEN temp.indent _ 0;
	Display[temp, notXfer];
	END;
    IF first THEN first _ FALSE;
    GetNextSe[];
    ENDLOOP;
  WITH ctxb[ctx] SELECT FROM
    included => IF ~complete THEN {
      IF notXfer AND ~first THEN DOutput.Text[", "L] ELSE DOutput.Blanks[f.indent];
      DOutput.Text["..."L]};
    ENDCASE;
  IF notXfer THEN DOutput.Char[']];
  Exit[];
  END;

Variant: PUBLIC PROCEDURE [f: Foo, pad: CARDINAL, usei: UnionSEIndex,
  variant: PROC RETURNS [Symbols.RecordSEIndex] _ NullVariant] =
  BEGIN
  isei: ISEIndex;
  bound: RecordSEIndex _ variant[];
  SELECT VariantType[usei] FROM
    controlled =>
      BEGIN
      IF (isei _ TagIsei[f,pad,usei]) = ISENull THEN
	BEGIN DOutput.Text["UnknownVariant[...]"L]; RETURN END;
      HashVal[isei];
      RecordCommon[MakeVarFoo[f, pad, DI.TypeForSe[isei], bound], NullVariant];
      END;
    overlaid => {
      DOutput.Text["OVERLAID"L];
      IF bound = Symbols.RecordSENull THEN DOutput.Text["[...]"L]
      ELSE RecordCommon[MakeVarFoo[f, pad, bound, Symbols.RecordSENull], NullVariant]};
    computed => {
      DOutput.Text["COMPUTED"L];
      IF bound = Symbols.RecordSENull THEN DOutput.Text["[...]"L]
      ELSE RecordCommon[MakeVarFoo[f, pad, bound, Symbols.RecordSENull], NullVariant]};
    ENDCASE => ERROR StrangeRecord;
  END;

MakeVarFoo: PROC [r: Foo, pad: CARDINAL, tag, bound: CSEIndex]
    RETURNS [f: Foo] =
  BEGIN
--  IF bound # Symbols.RecordSENull AND bound # tag THEN
--    DOutput.Text[" ! Incorrect tag for bound variant. "L];
  f _ DHeap.AllocFob[];
  f.tsei _ tag;
  f.there _ r.there;
  f.addr.base _ r.addr.base;
  f.addr.offset _ pad;
  [f.words, f.bits] _ Normalize[BitsForType[f.tsei]];
  END;

Subrange: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  sei: SubrangeSEIndex _ CheckClass[subrange, f];
  vf: ValFormat _ Format[sei].vf;
  org,end,val: INTEGER;
  Enter[];
  org _ seb[sei].origin;
  end _ org + seb[sei].range;
  Exit[];
  val _ org+f.addr.base^;
  WITH vf SELECT FROM
    card,none => NULL;
    ENDCASE => SELECT org FROM
      < end => IF val ~IN [org..end] THEN vf _ [none[]];
      > end => IF LOOPHOLE[val,CARDINAL]
        ~IN [LOOPHOLE[org,CARDINAL]..LOOPHOLE[end,CARDINAL]] THEN vf _ [none[]];
      ENDCASE;
  Num[val, vf];
  END;

Long: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  sei: LongSEIndex _ CheckClass[long, f];
  p: LONG POINTER TO LONG UNSPECIFIED _ LOOPHOLE[f.addr.base];
  rsei: SEIndex;
  Enter[];
  rsei _ seb[sei].rangeType;
  WITH seb[DI.TypeForSe[rsei]] SELECT FROM
    arraydesc => LongArrayDesc[f !UNWIND => Exit[]];
    ENDCASE => TypedLongNum[p^, rsei];
  Exit[];
  END;

Char: PUBLIC PROCEDURE [c: UNSPECIFIED] =
  BEGIN OPEN Ascii;	
  SELECT c FROM
    NUL => DOutput.Text["NUL"L];
    TAB => DOutput.Text["TAB"L];
    LF => DOutput.Text["LF"L];
    14C => DOutput.Text["FF"L];
    CR => DOutput.Text["CR"L];
    33C => DOutput.Text["ESC"L];
    IN CHARACTER[NUL..SP) =>
      BEGIN DOutput.Char['^]; DOutput.Char[LOOPHOLE[c+100B, CHARACTER]] END;
    SP => DOutput.Text["SP"L];
    DEL => DOutput.Text["DEL"L];
    ENDCASE =>
      IF c ~IN CHARACTER[NUL..DEL] THEN DOutput.Octal[c]
      ELSE BEGIN DOutput.Char['']; DOutput.Char[c] END;
  RETURN
  END;

HashVal: PUBLIC PROCEDURE [sei: ISEIndex] =
  BEGIN
  Enter[];
  HtiVal[IF sei = SENull THEN HTNull ELSE seb[sei].hash];
  Exit[];
  END;

HtiVal: PUBLIC PROCEDURE [hti: HTIndex] =
  BEGIN
  IF hti = HTNull THEN DOutput.Text["(anon)"L]
  ELSE
    BEGIN OPEN Strings;
    desc: SubStringDescriptor;
    ss: SubString _ @desc;
    SubStringForHash[ss,hti];
    DOutput.SubString[ss];
    END;
  END;

EnumVal: PUBLIC PROCEDURE [val: UNSPECIFIED, esei: EnumeratedSEIndex] =
  BEGIN
  ictx: CTXIndex = seb[esei].valueCtx;
  sei: ISEIndex = DI.SearchCtxForVal[val,ictx,none];
  IF sei # ISENull THEN HashVal[sei] ELSE BadNum[val];
  END;

TypedNum: PUBLIC PROCEDURE [val: UNSPECIFIED, tsei: SEIndex] =
  BEGIN Num[val, Format[tsei].vf] END;

Num: PUBLIC PROCEDURE [val: UNSPECIFIED, vf: ValFormat] =
  BEGIN
  WITH vf SELECT FROM
    card => DOutput.Octal[val];
    int => MyDecimal[val];
    char => Char[val];
    pointer => IF val = NIL THEN DOutput.Text["NIL"L]
      ELSE BEGIN DOutput.Octal[val]; DOutput.Char['^]; END;
    relative => {
	DOutput.Number[val, [base: 10, zerofill: FALSE, unsigned: TRUE, columns: 0]];
	DOutput.Text["^R"L]};
    string => StringCommon[DebugOps.Lengthen[val]];
    enum => EnumVal[val, esei];
    ENDCASE => BadNum[val];
  END;

BadNum: PUBLIC PROCEDURE [val: UNSPECIFIED] =
  BEGIN DOutput.Text["?["L]; DOutput.Octal[val]; DOutput.Char[']] END;

TypedLongNum: PUBLIC PROCEDURE [val: LONG UNSPECIFIED, tsei: SEIndex] =
  BEGIN LongNum[val, Format[tsei].vf] END;

LongNum: PUBLIC PROCEDURE [val: LONG UNSPECIFIED, vf: ValFormat] =
  BEGIN
  WITH vf SELECT FROM
    card => DOutput.LongOctal[val];
    int => DOutput.LongDecimal[LOOPHOLE[val, LONG INTEGER]];
    pointer => IF val = NIL THEN DOutput.Text["NIL"L]
      ELSE BEGIN DOutput.LongOctal[val]; DOutput.Char['^]; END;
    relative =>
      {DOutput.LongDecimal[LOOPHOLE[val, LONG INTEGER]]; DOutput.Text["R^"L]};
    string => StringCommon[val];
    ENDCASE => BadLongNum[val];
  END;

BadLongNum: PROCEDURE [val: LONG UNSPECIFIED] =
  BEGIN DOutput.Text["?["L]; DOutput.LongOctal[val]; DOutput.Char[']] END;

MyDecimal: PROCEDURE [u: UNSPECIFIED] = INLINE 
  BEGIN DOutput.Decimal[LOOPHOLE[u,INTEGER]] END;

StringCommon: PROCEDURE [ls: LONG STRING] =
  BEGIN OPEN DOutput;
  sb: StringBody;
  IF ls = NIL THEN BEGIN DOutput.Text["NIL"L]; RETURN END;
  DebugOps.LongCopyREAD[from: ls, nwords: SIZE[StringBody], to: @sb];
  Char['(]; MyDecimal[sb.length]; Char[',];
  MyDecimal[sb.maxlength]; Text[")"""L];
  UserLongText[ls ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}];
  Char['"];
  END;

-- write strings from user world

UserText: PUBLIC PROCEDURE [s: STRING] =
  BEGIN
  length: CARDINAL _ DebugOps.ShortREAD[@s.length];
  UserDump[DebugOps.Lengthen[s], 0, length];
  RETURN
  END;

UserSubString: PUBLIC PROCEDURE[ss: String.SubString] =
  BEGIN UserDump[DebugOps.Lengthen[ss.base], ss.offset, ss.length] END;

UserLongText: PUBLIC PROCEDURE [s: LONG STRING] =
  BEGIN
  length: CARDINAL = DebugOps.LongREAD[@s.length];
  UserDump[s, 0, length];
  RETURN
  END;

UserLongSubString: PUBLIC PROCEDURE [ls: DebugFormat.LongSubString] =
  BEGIN UserDump[ls.base, ls.offset, ls.length] END;

UserDump: PROCEDURE [base: LONG STRING, offset, length: CARDINAL] =
  BEGIN
  i: CARDINAL;
  s: PACKED ARRAY [0..1] OF CHARACTER;
  p: POINTER = @s;
  bad: BOOLEAN _ offset > 5000 OR length > 5000 OR
    LONG[offset]+LONG[length] > LAST[CARDINAL];
  IF offset MOD 2 # 0 THEN p^ _ DebugOps.LongREAD[@base.text+offset/2];
  FOR i IN [offset..offset+length) DO
    IF i MOD 2 = 0 THEN p^ _ DebugOps.LongREAD[@base.text+i/2];
    DOutput.Char[s[i MOD 2]];
    IF i - offset > StringLimit THEN RETURN;
    IF UserInput.userAbort THEN {ControlDel[]; RETURN};
    ENDLOOP;
  RETURN
  END;

ControlDel: PROC ={UserInput.ResetUserAbort[]; DOutput.Text[" ... aborted"L]};
  
END.