-- DumpCold.mesa; modified by Bruce,  October 25, 1980  10:00 PM

DIRECTORY
  Ascii USING [SP],
  DebugFormat USING [BitAddress, Fob, Foo, OctalFormat],
  DebugOps USING [Display, DisplayFoo, Foo, FooProc, Interpret, LongREAD, UserAborted],
  DI USING [
    BitAddress, CheckClass, CSEIndex, DerefProcDesc, Foo, GetControlLink,
    GetDesc, GetLongDesc, LongDesc, Normalize, NotAProcedure, SEIndex,
    TransferSEIndex, TypeForSe, FindField, GetValue, SequenceSEIndex],
  DOutput USING [Char, Decimal, Number, Octal, Text],
  Dump USING [
    ArrayHandle, ArrayInfo, BadNum, HashVal, LongNum, Printer, PrintRec, PrintUCS,
    NullVariant],
  Frames USING [Invalid],
  Gf USING [Display, DisplayInMsg, FrameGfi, Handle, OldLink, Validate],
  DHeap USING [AllocFob],
  Init USING [],
  Inline USING [LongDivMod, LongMult],
  Lookup USING [Signal],
  MachineDefs USING [WordLength],
  Pc USING [LinkToIsei],
  PrincOps USING [ControlLink, Port, ProcDesc, SignalDesc],
  State USING [GetGS, GSHandle],
  Storage USING [Node],
  SymbolOps USING [BitsPerElement, Cardinality],
  SymbolPack,
  Symbols USING [
    ArraySEIndex, CSEIndex, HTIndex, HTNull, ISEIndex, ISENull, SEIndex, SENull,
    RecordSEIndex, seType, TransferMode, TypeClass],
  Table USING [AddNotify, Base, DropNotify, Notifier],
  TajoMisc USING [initialToolStateDefault],
  Types USING [Equivalent, Handle],
  UserInput USING [ResetUserAbort, userAbort];

DumpCold: PROGRAM
  IMPORTS DebugOps, DI, DOutput, Dump, Frames, Gf, DHeap, Inline, Lookup,
    Pc, State, Storage, SymbolOps, MyBase: SymbolPack, Table, TajoMisc, Types, UserInput
  EXPORTS Dump, Init =
BEGIN OPEN DI, Dump, SymbolOps, Symbols;

TriedToPrintWrongType: ERROR [foo: Foo] = CODE;
BadTag: ERROR = CODE;

seb: Table.Base;
data: State.GSHandle _ State.GetGS[];
printers: PUBLIC POINTER TO PrintRec _ NIL;
entryDepth: CARDINAL _ 0;

ArrayLimit: 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 = {seb _ base[seType]};

AddPrinter: PUBLIC PROCEDURE [type: STRING, proc: Printer] =
  BEGIN
  Type: DebugOps.FooProc = {p.tsei _ f.tsei};
  p: POINTER TO PrintRec _ Storage.Node[SIZE[PrintRec]];
  p^ _ [
    link: printers, sym: type, tsei: SENull, proc: proc];
  IF TajoMisc.initialToolStateDefault # inactive THEN
    DebugOps.Interpret[p.sym, Type ! ANY => {p.tsei _ SENull; CONTINUE}];
  printers _ p;
  END;

ResetPrinters: PUBLIC PROCEDURE =
  BEGIN
  Type: DebugOps.FooProc = {p.tsei _ f.tsei};
  p: POINTER TO PrintRec;
  FOR p _ printers, p.link UNTIL p = NIL DO
    DebugOps.Interpret[p.sym, Type ! ANY => {p.tsei _ SENull; CONTINUE}];
    ENDLOOP;
  END;

CompareSes: PUBLIC PROC [sei1, sei2: Symbols.SEIndex] RETURNS [print: BOOLEAN] =
  BEGIN
  left: Types.Handle _ [LOOPHOLE[MyBase],TypeForSe[sei1]];
  right: Types.Handle _ [LOOPHOLE[MyBase],TypeForSe[sei2]];
  RETURN[Types.Equivalent[type1: left, type2: right]];
  END;

Sequence: PUBLIC PROC [f: Foo, pad: CARDINAL, sei: DI.SequenceSEIndex,
    variant: PROC RETURNS [Symbols.RecordSEIndex] _ NullVariant] =
  BEGIN
  tag: Foo;
  ai: ArrayInfo;
  ba: BitAddress;
  words: CARDINAL;
  Enter[];
  IF ~seb[sei].controlled THEN {DOutput.Text["(?) ..."L]; Exit[]; RETURN};
  tag _ DI.FindField[f,pad,seb[sei].tagSei];
  IF tag.bits + tag.addr.offset > MachineDefs.WordLength THEN ERROR BadTag;
  ba _ [base: tag.addr.base, offset: ];
  [words, ba.offset] _ Normalize[tag.addr.offset+tag.bits];
  ba.base _ tag.words + ba.base + words;
  DI.GetValue[tag];
  ai _ [start: 0, stop: tag.addr.base^, length: tag.addr.base^, addr: ba,
    packing: SymbolOps.BitsPerElement[seb[sei].componentType, seb[sei].packed],
    type: seb[sei].componentType];
  Elements[@ai ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}; UNWIND => Exit[]];
  Exit[];
  END;

Array: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  sei: ArraySEIndex _ CheckClass[array, f];
  Enter[];
  ArrayCommon[sei, f.addr, Cardinality[seb[sei].indexType] ! UNWIND => Exit[]];
  Exit[];
  END;

ArrayCommon: PROCEDURE [tsei: SEIndex, ba: BitAddress, length: CARDINAL] =
  BEGIN
  csei: CSEIndex _ DI.TypeForSe[tsei];
  sei: ArraySEIndex;
  ai: ArrayInfo;
  Enter[];
  IF seb[csei].typeTag = array THEN sei _ LOOPHOLE[csei]
    ELSE {Exit[]; ERROR TriedToPrintWrongType[NIL]};
  ai _ [start: 0, stop: length, length: length, addr: ba,
    packing: SymbolOps.BitsPerElement[seb[sei].componentType, seb[sei].packed],
    type: seb[sei].componentType];
  Elements[@ai ! DebugOps.UserAborted => {ControlDel[]; CONTINUE}; UNWIND => Exit[]];
  Exit[];
  END;

LongArrayDesc: PUBLIC PROCEDURE [f: Foo] =
  BEGIN OPEN DOutput;
  d: DI.LongDesc;
  sei: ArraySEIndex;
  [d,sei] _ DI.GetLongDesc[f];
  Text["DESCRIPTOR["L]; LongNum[d.base, [pointer[]]]; Char[',];
  MyDecimal[d.length]; Char[']];
  IF d.base = NIL THEN RETURN;
  ArrayCommon[sei, [d.base,0], d.length];
  END;

ArrayDesc: PUBLIC PROCEDURE [f: Foo] =
  BEGIN OPEN DOutput;
  d: DI.LongDesc;
  sei: ArraySEIndex;
  [d,sei] _ DI.GetDesc[f];
  Text["DESCRIPTOR["L]; LongNum[d.base, [pointer[]]]; Char[',];
  MyDecimal[d.length]; Char[']];
  IF d.base = NIL THEN RETURN;
  ArrayCommon[sei, [d.base,0], d.length];
  END;

Elements: PUBLIC PROCEDURE [ai: ArrayHandle, printAll: BOOLEAN _ FALSE] =
  BEGIN OPEN DOutput;
  i: CARDINAL;
  f: Foo;
  fob: DebugFormat.Fob _ [
    hti: HTNull,
    indent: 0, xfer: FALSE,
    tsei: ai.type,
    typeOnly: FALSE,
    there: TRUE,
    addr:, words:, bits:, nesting: 0];
  [fob.words, fob.bits] _ Normalize[ai.packing];
  fob.addr _ CalculateAddr[ai, ai.start];
  Char['(]; MyDecimal[ai.length]; Text[")["L];
  FOR i IN [ai.start..ai.stop) DO
    IF i # ai.start THEN Text[", "L];
    f _ DHeap.AllocFob[];
    f^ _ fob;
    IF i = 3 AND ~printAll AND ai.length > ArrayLimit THEN
      BEGIN
      f.addr _ CalculateAddr[ai, ai.stop-1];
      Text["..., "L];
      DebugOps.Display[f,TRUE];
      EXIT;
      END;
    DebugOps.Display[f,TRUE];
    NextAddr[@fob,ai.packing];
    IF UserInput.userAbort THEN {ControlDel[]; RETURN};
    ENDLOOP;
  Char[']];
  END;

CalculateAddr: PUBLIC PROC [ai: ArrayHandle, n: CARDINAL] RETURNS [ba: BitAddress] =
  BEGIN OPEN Inline, MachineDefs;
  words, offset: CARDINAL;
  ba.useStack _ ai.addr.useStack;
  [words, offset] _ Normalize[ai.packing];
  ba.base _ ai.addr.base + LongMult[words, n];
  [words, ba.offset] _ LongDivMod[LongMult[offset, n], WordLength];
  ba.base _ ba.base + words;
  [words, ba.offset] _ Normalize[ba.offset+ai.addr.offset];
  ba.base _ ba.base + words;
  RETURN
  END;

NextAddr: PROCEDURE [f: Foo, packing: CARDINAL] =
  BEGIN
  words, bits: CARDINAL;
  [words, bits] _ Normalize[packing];
  IF bits = 0 THEN BEGIN f.addr.base _ f.addr.base + words; RETURN END;
  IF bits + f.addr.offset = 16 THEN
    BEGIN f.addr.base _ f.addr.base + 1; f.addr.offset _ 0 END
  ELSE f.addr.offset _ f.addr.offset + bits;
  RETURN;
  END;

BadDesc: PROC [cl: PrincOps.ControlLink] = {
  IF cl.gfi = 0 OR ~cl.tag THEN BadNum[Gf.OldLink[cl]]
  ELSE {
    DOutput.Char['[]; DOutput.Octal[Gf.OldLink[cl]]; DOutput.Char[']]}};

XferName: PUBLIC PROC [cl: PrincOps.ProcDesc, isei: ISEIndex] =
  {IF isei = ISENull THEN BadDesc[cl] ELSE HashVal[isei]};

XferFrame: PUBLIC PROC [cl: PrincOps.ProcDesc] =
  BEGIN Gf.DisplayInMsg[Gf.FrameGfi[cl.gfi], "module"L] END;

Sig: PUBLIC PROC [cl: PrincOps.ProcDesc] =
  BEGIN
  IF data.signal = cl THEN Dump.PrintUCS[]
  ELSE {XferName[cl, Lookup.Signal[cl]]; XferFrame[cl]};
  END;

Xfer: PUBLIC PROCEDURE [f: Foo] =
  BEGIN ENABLE UNWIND => Exit[];
  sei: TransferSEIndex _ CheckClass[transfer, f];
  cl: PrincOps.ControlLink;
  Enter[];
  IF seb[sei].mode # process THEN cl _ DI.GetControlLink[f];
  SELECT seb[sei].mode FROM
    proc => Proc[cl];
    port => Port[cl];
    signal => {DOutput.Text["SIGNAL "L]; Sig[LOOPHOLE[cl]]};
    error => {DOutput.Text["ERROR "L]; Sig[LOOPHOLE[cl]]};
    process => {DI.GetValue[f]; Process[f.addr.base^]};
    program => Prog[cl];
    ENDCASE => ERROR TriedToPrintWrongType[f];
  Exit[];
  END;

Proc: PUBLIC PROC [cl: PrincOps.ControlLink] =
  BEGIN
  DOutput.Text["PROCEDURE "L];
    BEGIN ENABLE Frames.Invalid => GOTO bad;
    cl _ DI.DerefProcDesc[cl ! DI.NotAProcedure => GOTO bad];
    XferName[LOOPHOLE[cl], Pc.LinkToIsei[cl]];
    XferFrame[LOOPHOLE[cl]];
    EXITS bad => BadDesc[cl];
    END;
  END;

Port: PUBLIC PROC [cl: PrincOps.ControlLink] =
  BEGIN OPEN DOutput;
  Text["PORT ["L];
  Octal[cl.port.in]; Text[", "L]; Octal[cl.port.out]; Char[']];
  END;

Process: PUBLIC PROC [psb: UNSPECIFIED] =
  {DOutput.Text["PROCESS ["L]; DOutput.Octal[psb]; DOutput.Char[']]};

Prog: PUBLIC PROC [gf: UNSPECIFIED] =
  BEGIN
  IF Gf.Validate[gf] THEN Gf.Display[gf,"PROGRAM"L] ELSE BadDesc[gf];
  END;

Opaque: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  osei: Symbols.CSEIndex _ CheckClass[opaque, f];
  proc: PROCEDURE [LONG POINTER] RETURNS [UNSPECIFIED] _
    IF f.there THEN DebugOps.LongREAD ELSE ReadMem;
  Enter[];
  WITH seb[osei] SELECT FROM
    opaque =>
      BEGIN
      IF id # Symbols.ISENull THEN HashVal[id];
      IF lengthKnown AND length # 0 THEN 
	BEGIN
	n: CARDINAL;
	size: CARDINAL = length/MachineDefs.WordLength;
	DOutput.Char['(]; DOutput.Octal[size]; DOutput.Text["):"L];
	FOR j: CARDINAL IN [0..size) DO
	  DOutput.Char[' ];
	  DOutput.Number[n _ proc[f.addr.base+j], DebugFormat.OctalFormat];
	  DOutput.Char[IF n ~IN[0..7] THEN 'B ELSE Ascii.SP];
	  IF UserInput.userAbort THEN {ControlDel[]; RETURN};
	  ENDLOOP;
	END;
      END;
    ENDCASE;
  Exit[];
  END;

ReadMem: PUBLIC PROC [p: LONG POINTER] RETURNS [UNSPECIFIED] = {RETURN[p^]};

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

ControlDel: PROC = {UserInput.ResetUserAbort[]; DOutput.Text[" ... aborted"L]};
  
ModeName: PUBLIC PROCEDURE [n: TransferMode] =
  BEGIN
  ModePrintName: ARRAY TransferMode OF STRING = ["PROCEDURE"L, "PORT"L,
    "SIGNAL"L, "ERROR"L, "PROCESS"L, "PROGRAM"L, "NONE"L];
  DOutput.Text[ModePrintName[n]]
  END;

END.