-- 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.