-- DumpPack.mesa; modified by Bruce, June 11, 1980  2:42 PM

DIRECTORY
  Ascii: FROM "ascii" USING [CR, DEL, LF, NUL, SP, TAB],
  Copier: FROM "copier"USING [CtxValue,TokenSymbol],
  DebugFormat USING [BitAddress, Fob, LongSubString, OctalFormat],
  DebugOps USING [
    FooProc, Interpret, Lengthen, LongCopyREAD, LongREAD, ShortREAD],
  DI: FROM "di",
  DOutput: FROM "doutput" USING [
    Blanks, Char, Decimal, EOL, LongDecimal, LongOctal, Number, Octal,
    SubString, Text],
  Dump: FROM "dump",
  Frames: FROM "frames",
  Gf: FROM "gf" USING [
    Display, FrameGfi, Handle, DisplayInMsg, OldLink, Validate],
  Heap: FROM "heap" USING [AllocFob],
  InlineDefs: FROM "inlinedefs" USING [DIVMOD, LongDivMod, LongMult],
  Lookup: FROM "lookup" USING [CopyMore, Signal],
  MachineDefs: FROM "machinedefs" USING [WordLength],
  Mopcodes,
  Pc: FROM "Pc" USING [LinkToIsei],
  PrincOps: FROM "princops" USING [ControlLink, ProcDesc, SignalDesc],
  State: FROM "state",
  Storage: FROM "storage" USING [Node],
  StringDefs: FROM "stringdefs" USING [SubString, SubStringDescriptor],
  SymbolOps USING [
    BitsForType, BitsPerElement, Cardinality, RecordRoot, SubStringForHash],
  Symbols USING [
    ArraySEIndex, CSEIndex, CTXIndex, HTIndex, HTNull, ISEIndex,
    ISENull, RecordSEIndex, RecordSENull, SEIndex, SENull,
    SERecord, TransferMode, TypeClass, typeTYPE],
  SymbolSegment: FROM "symbolsegment" USING [bodyType, ctxType, seType],
  Table: FROM "table" USING [AddNotify, Base, DropNotify, Notifier],
  UserInput USING [ResetUserAbort, userAbort];

DumpPack: PROGRAM
  IMPORTS Copier, DebugOps, DI, DOutput, Dump, Frames, Gf,
    Heap, InlineDefs, Lookup, Pc, State, Storage, SymbolOps, Table,
    UserInput
  EXPORTS DebugOps, Dump =
BEGIN OPEN DI, Dump, SymbolOps, Symbols;

NoTypeInfo: PUBLIC ERROR [sei: SEIndex] = CODE;
TriedToPrintWrongType: ERROR [foo: Foo] = CODE;
NeedBitAddressToPrintUnion: ERROR = CODE;
StrangeRecord: ERROR = CODE;

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

ArrayLimit: PUBLIC CARDINAL _ LAST[CARDINAL];
StringLimit: PUBLIC CARDINAL _ LAST[CARDINAL];

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

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;

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];
    ENDLOOP;
  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 p.tsei # f.tsei THEN LOOP;
    p.proc[f !ANY => BEGIN p.tsei _ SENull; CONTINUE END];
    RETURN [TRUE];
    ENDLOOP;
  RETURN[FALSE];
  END;

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];
  DebugOps.Interpret[p.sym, Type];
  printers _ p;
  END;

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

Display: PUBLIC PROCEDURE [f: Foo, rec: BOOLEAN _ FALSE] =
  BEGIN
  IF f = NIL THEN RETURN;
  Enter[];
  SELECT TRUE FROM
    UserPrint[f] => NULL;
    f.typeOnly =>
      WITH seb[f.tsei] SELECT FROM
	id => Type[LOOPHOLE[f.tsei]];
	ENDCASE => ERROR NoTypeInfo[f.tsei]
    ENDCASE =>
      BEGIN ENABLE UNWIND => Exit[];
      csei: CSEIndex _ DI.TypeForSe[f.tsei];
      IF f.hti # HTNull THEN
	BEGIN
        IF f.indent # 0 THEN DOutput.Blanks[f.indent];
	HtiVal[f.hti];
	DOutput.Text[IF rec THEN ":"L ELSE " = "L];
	END;
      WITH seb[csei] SELECT FROM
	basic, enumerated, ref, arraydesc,
	relative, subrange, long, real => GetValue[f];
	transfer, record, array, union, opaque => NULL;
	ENDCASE;
      WITH seb[csei] SELECT FROM
	basic, ref, relative, enumerated => TypedNum[f.addr.base^, f.tsei];
	record => Record[f];
	array => Array[f];
	arraydesc => ArrayDesc[f];
	transfer => Xfer[f];
	union => ERROR NeedBitAddressToPrintUnion;
	subrange => Subrange[f];
	long => Long[f];
	real => Real[f];
	opaque => Opaque[f];
	ENDCASE;
      END;
  Exit[];
  IF ~rec THEN DOutput.EOL[];
  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
  [] _ CheckClass[relative, f];
  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] = {RecordCommon[f,FALSE]};

RecordCommon: PUBLIC PROCEDURE [f: Foo, recurring: BOOLEAN] =
  BEGIN
  rsei: RecordSEIndex _ CheckClass[record, f];
  root: RecordSEIndex _ SymbolOps.RecordRoot[rsei];
  IF ~recurring AND root # RecordSENull THEN f.tsei _ rsei _ root;
  Lookup.CopyMore[rsei];
  Enter[];
  WITH seb[f.tsei] SELECT FROM
    id => HtiVal[hash];
    ENDCASE;
  FieldCtx[f, seb[rsei].fieldCtx, Pad[f,rsei], rsei !UNWIND => Exit[]];
  Exit[];
  END;

FieldCtx: PUBLIC PROCEDURE [
    f: Foo, ctx: Symbols.CTXIndex, pad: CARDINAL,
    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 THEN
      {GetNextSe[]; LOOP};
    IF notXfer AND ~first THEN DOutput.Text[", "L];
    csei _ DI.TypeForSe[isei];
    IF seb[csei].typeTag = union THEN Variant[f, pad, LOOPHOLE[csei]]
    ELSE
      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]; DOutput.Text["..."L]};
    ENDCASE;
  IF notXfer THEN DOutput.Char[']];
  Exit[];
  END;

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

MakeVarFoo: PROCEDURE [r: Foo, pad: CARDINAL, isei: ISEIndex]
    RETURNS [f: Foo] =
  BEGIN OPEN seb[isei];
  f _ Heap.AllocFob[];
  f.tsei _ idInfo;
  f.there _ TRUE;
  f.addr.base _ r.addr.base;
  f.addr.offset _ pad;
  [f.words, f.bits] _ Normalize[BitsForType[f.tsei]];
  END;

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

ArrayCommon: PROCEDURE [tsei: SEIndex, ba: BitAddress, length: CARDINAL] =
  BEGIN
  csei: CSEIndex _ DI.TypeForSe[tsei];
  sei: ArraySEIndex _ IF seb[csei].typeTag = array THEN LOOPHOLE[csei]
    ELSE ERROR TriedToPrintWrongType[NIL];
  ai: ArrayInfo _ [start: 0, stop: length, length: length, addr: ba,
    packing: SymbolOps.BitsPerElement[sei], type: seb[sei].componentType];
  Elements[@ai];
  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.Desc;
  sei: ArraySEIndex;
  [d,sei] _ DI.GetDesc[f];
  Text["DESCRIPTOR["L]; Num[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:, xfer:,
    tsei: ai.type,
    typeOnly: FALSE,
    there: TRUE,
    addr:, words:, bits:];
  [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 _ Heap.AllocFob[];
    f^ _ fob;
    IF i = 3 AND ~printAll AND ai.length > ArrayLimit THEN
      BEGIN
      f.addr _ CalculateAddr[ai, ai.stop-1];
      Text["..., "L];
      Display[f,TRUE];
      EXIT;
      END;
    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 InlineDefs, MachineDefs;
  words: CARDINAL;
  ba.useStack _ ai.addr.useStack;
  [words, ba.offset] _ Normalize[ai.packing+ai.addr.offset];
  ba.base _ ai.addr.base + LongMult[words, n];
  [words, ba.offset] _ LongDivMod[LongMult[ba.offset, n], WordLength];
  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;

XferName: PUBLIC PROC [cl: PrincOps.ProcDesc, isei: ISEIndex] =
  {IF isei = ISENull THEN BadNum[Gf.OldLink[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 _ DI.GetControlLink[f];
  Enter[];
  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 => Process[cl];
    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 => BadNum[Gf.OldLink[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 BadNum[gf];
  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 => IF val ~IN [org..end] THEN vf _ [none[]];
  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;

Real: PUBLIC PROCEDURE [f: Foo] =
  BEGIN
  p: LONG POINTER TO ARRAY [0..2) OF CARDINAL _ LOOPHOLE[f.addr.base];
  [] _ CheckClass[real, f];
  DOutput.Text["REAL [ "L];
  DOutput.Octal[p[0]]; DOutput.Char[',]; DOutput.Octal[p[1]];
  DOutput.Char[']];
  END;

Opaque: PROCEDURE [f: Foo] =
  BEGIN
  osei: Symbols.CSEIndex _ CheckClass[opaque, f];
  proc: PROCEDURE [LONG POINTER] RETURNS [UNSPECIFIED] _
    IF f.there THEN DebugOps.LongREAD ELSE MyRead;
  Enter[];
  WITH seb[osei] SELECT FROM
    opaque =>
      BEGIN
      IF id # Symbols.ISENull THEN HashVal[id];
      IF lengthKnown AND length # 0 THEN 
	BEGIN
	n: CARDINAL;
	DOutput.Char['(]; DOutput.Octal[length]; DOutput.Text["):"L];
	FOR j: CARDINAL IN [0..length) 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;

  MyRead: PROCEDURE [p: LONG POINTER] RETURNS [UNSPECIFIED] =
    BEGIN
    ReadMem: PROCEDURE [LONG POINTER] RETURNS [UNSPECIFIED] =
      MACHINE CODE BEGIN Mopcodes.zPOP; Mopcodes.zR0 END;
    RETURN[ReadMem[p]]
    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 StringDefs;
    desc: SubStringDescriptor;
    ss: SubString _ @desc;
    SubStringForHash[ss,hti];
    DOutput.SubString[ss];
    END;
  END;

EnumVal: PUBLIC PROCEDURE [val: UNSPECIFIED, esei: EnumeratedSEIndex] =
  BEGIN OPEN Copier;
  ictx: CTXIndex = seb[esei].valueCtx;
  sei: ISEIndex = TokenSymbol[ictx,CtxValue[ictx,val]];
  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 =>
      BEGIN MyDecimal[val]; DOutput.Text["^R"L]; END;
    string => StringCommon[DebugOps.Lengthen[val]];
    enum => EnumVal[val, esei];
    ENDCASE => BadNum[val];
  END;

BadNum: 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];
  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: StringDefs.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]};
  
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.
(1792)