DIRECTORY
AMBridge USING [ContextPC, FHFromTV, GetWorld, GFHFromTV, IsRemote, OctalRead, RemoteFHFromTV, RemoteGFHFromTV, SetTVFromLI, TVToCardinal, TVToCharacter, TVToLC, TVToLI, TVToReal, TVToWordSequence, WordSequence, TVForSignal, TVForPointerReferent],
AMTypes USING [Apply, Argument, Class, Coerce, Copy, Domain, EnclosingBody, Error, First, GlobalParent, Globals, GroundStar, Index, IndexToName, IndexToTV, IndexToType, IsAtom, IsComputed, IsNil, IsOverlaid, IsRefAny, IsRope, Last, Length, Locals, NComponents, Next, Procedure,Range, Referent, Result, Signal, Tag, TVSize, TVToName, TVToType, TVType, TypeClass, UnderClass, UnderType, Variant, TV, Size],
BackStop USING [Call],
Convert USING [RopeFromChar],
IO USING [Put, PutChar, PutF, PutF1, PutRope, STREAM],
PrintTV USING [GetClassPrintProc, GetTVPrintProc, PrintType, TVPrintProc],
Rope USING [Concat, Fetch, InlineLength, IsEmpty, Map, ROPE, Size],
RuntimeError USING [SendMsgSignal, UNCAUGHT],
SafeStorage USING [EquivalentTypes, nullType, Type],
StructuredStreams USING [Begin, End, Bp],
VM USING [AddressFault],
WorldVM USING [Address, AddressFault, LocalWorld, Long, Read, World];
IMPORTS AMBridge, AMTypes, BackStop, Convert, IO, PrintTV, Rope, RuntimeError, SafeStorage, VM, WorldVM
EXPORTS PrintTV
= BEGIN OPEN PrintTV, Rope, AMBridge, AMTypes, SafeStorage, WorldVM;
procedures
EnsureInit:
ENTRY
PROC = {
ENABLE UNWIND => NULL;
IF needInit
THEN {
UnderBoolean ← UnderType[UnderBoolean];
UnderString ← UnderType[UnderString];
UnderLongString ← UnderType[UnderLongString];
UnderRefText ← UnderType[UnderRefText];
UnderPtrText ← UnderType[UnderPtrText];
needInit ← FALSE;
};
};
Print:
PUBLIC
PROC [tv:
TV, put:
STREAM, depth:
INT ← 4, width:
INT ← 32, verbose:
BOOL ←
FALSE] = {
PutWords:
PROC [tv:
TV, prefix:
ROPE ←
NIL, postfix:
ROPE ←
NIL] =
TRUSTED {
this routine must be relatively indestructible!!!
ENABLE {RuntimeError.UNCAUGHT => GOTO err};
size: INT ← 0;
IF prefix # NIL AND prefix.Size[] > 0 THEN put.PutRope[prefix];
size ← TVSize[tv];
SELECT size
FROM
0 => IO.PutRope[put, "[]"];
1 => PrintOctal[put, TVToCardinal[tv]];
2 => PrintOctal[put, TVToLC[tv]];
ENDCASE => {
sep: ROPE ← NIL;
IO.PutChar[put, '[];
FOR i:
INT
IN [0..size)
DO
IF i > width THEN {IO.PutRope[put, ", ..."]; EXIT};
put.PutRope[sep];
sep ← ", ";
PrintOctal[put, LOOPHOLE[AMBridge.OctalRead[tv, i], CARDINAL]]
ENDLOOP;
IO.PutChar[put, ']];
};
IF postfix # NIL AND postfix.Size[] > 0 THEN IO.PutRope[put, postfix]
EXITS
err => PutErr["??"]
};
PutEscape:
PROC [c:
CHAR]
RETURNS [quit:
BOOL ←
FALSE] = {
IO.PutRope[put, Convert.RopeFromChar[c, FALSE]];
};
PutRopeConst:
PROC [r:
ROPE, max:
INT] = {
size: INT ← r.Size[];
max ← max + 16; -- allow for a reasonable minimum length
IO.PutChar[put, '\"];
[] ← Rope.Map[base: r, start: 0, len: max, action: PutEscape];
IF size > max THEN IO.PutRope[put, "..."];
IO.PutChar[put, '"]
};
QPutName:
PROC [name:
ROPE] = {
IF name.Size[] = 0 THEN IO.PutRope[put, "??"] ELSE IO.PutRope[put, name]
};
PutStringConst:
PROC [s:
LONG
STRING] =
TRUSTED {
len: CARDINAL ← s.length;
charsToPrint: CARDINAL ← len;
max: CARDINAL ← width * depth;
IF max < charsToPrint THEN charsToPrint ← max;
IF max < 8 THEN max ← max + 16;
IO.PutChar[put, '"];
FOR i:
CARDINAL
IN [0..charsToPrint)
DO
[] ← PutEscape[s[i]];
ENDLOOP;
IF len > charsToPrint THEN IO.PutRope[put, "..."];
IO.PutChar[put, '"];
};
PutErr:
PROC [r1,r2:
ROPE ←
NIL] = {
IO.PutF[put, "--{%g%g}--", [rope[r1]], [rope[r2]] ];
};
PutRecord:
PROC [tv:
TV, start:
NAT ← 0, depth:
INT ← 0] = {
size: Index;
sep: ROPE ← NIL;
type: Type;
innerSize: PROC = {type ← TVType[tv]; size ← NComponents[type]};
IF depth <= 1 THEN {IO.PutRope[put, "[...]"]; RETURN};
sep ← BackStop.Call[innerSize];
IF sep # NIL THEN {PutErr["can't examine, ", sep]; RETURN};
IO.PutChar[put, '[];
StructuredStreams.Begin[put];
{ ENABLE UNWIND => StructuredStreams.End[put];
FOR i: Index
IN [start..size]
DO
name: ROPE;
inner: TV ← NIL;
quitFlag: BOOL ← FALSE;
innerIndexToTV: PROC = {inner ← IndexToTV[tv, i]};
innerPut:
PROC = {
itype: Type ← TVType[inner];
iunder: Type;
iclass: Class;
[iunder, iclass] ← UnderTypeAndClass[itype];
IF i = size
AND iclass = union
THEN {
variantTV: TV;
IF IsOverlaid[iunder] THEN {IO.PutRope[put, "--Overlaid--"]; RETURN};
IF IsComputed[iunder] THEN {IO.PutRope[put, "--Computed--"]; RETURN};
variantTV ← Variant[inner];
QPutName[TVToName[Tag[inner]]];
PutRecord[variantTV, i, depth - 1];
RETURN};
PutTV[inner, depth - 1];
};
msg: ROPE ← NIL;
IF i > start
THEN {
IO.PutRope[put, ", "];
StructuredStreams.Bp[put, FALSE, 0];
};
IF i > width THEN {IO.PutRope[put, "..."]; EXIT};
name ← IndexToName[type, i];
PrintName[put, name];
msg ← BackStop.Call[innerIndexToTV];
IF msg # NIL THEN {PutErr["Can't get element: ", msg]; LOOP};
msg ← BackStop.Call[innerPut];
IF msg # NIL THEN {PutErr["Can't print element: ", msg]; LOOP};
ENDLOOP;
}; -- end ENABLE UNWIND => StructuredStreams.End[put];
StructuredStreams.End[put];
IO.PutChar[put, ']]
};
PutTVAsType:
PROC [tv:
TV] =
TRUSTED {
type: Type ← TVToType[tv];
PrintTV.PrintType[type, put];
};
PutTypeOfTV:
PROC [tv:
TV, class: Class] = {
inner:
PROC = {
SELECT class
FROM
globalFrame => IO.PutRope[put, "--GlobalFrame--"];
localFrame => IO.PutRope[put, "--LocalFrame--"]
ENDCASE => {
type: Type ← TVType[tv];
PrintTV.PrintType[type, put];
};
};
PrintBraces[put, BackStop.Call[inner]];
};
PutTV:
PROC [tv:
TV, depth:
INT, verbose:
BOOL ←
FALSE] =
TRUSTED {
deep: BOOL ← TRUE;
msg1, msg2: ROPE ← NIL;
IF tv = NIL THEN {IO.PutRope[put, "NIL"]; RETURN};
IF depth <= 0 THEN {IO.PutRope[put, "&"]; RETURN};
try to get user print proc
IF
NOT HandledByPrintProc[tv: tv, type: TVType[tv], depth: depth]
THEN {
inner:
PROC =
TRUSTED {
PutTVNoCatch[tv, depth, verbose];
};
PrintBraces[put, BackStop.Call[inner]];
};
};
HandledByPrintProc:
PROC [tv:
TV, type: Type, depth:
INT]
RETURNS[handled:
BOOL ←
FALSE] =
TRUSTED {
proc: TVPrintProc;
data: REF;
[proc, data] ← GetTVPrintProc[type];
IF proc # NIL AND NOT proc[tv, data, put, depth, width, verbose] THEN RETURN [TRUE];
[proc, data] ← GetClassPrintProc[UnderClass[type]];
IF proc # NIL THEN handled ← NOT proc[tv, data, put, depth, width, verbose];
};
PutTVNoCatch:
PROC [tv:
TV, depth:
INT, verbose:
BOOL ←
FALSE, type: Type ← nullType] =
TRUSTED {
fooey: BOOL ← FALSE;
under: Type;
class: Class;
isRemote: BOOL ← AMBridge.IsRemote[tv];
putList:
PROC [node:
TV] =
CHECKED {
separate procedure because can be called from both ref, list, and structure case case. start with node, rather than element, because in case of structure, already at the node.
sep: ROPE ← NIL;
count: INT ← 0;
IO.PutRope[put, "LIST["];
StructuredStreams.Begin[put];
{ ENABLE UNWIND => StructuredStreams.End[put];
WHILE node #
NIL
DO
elem: TV ← IndexToTV[node, 2];
IF node = NIL THEN EXIT;
IO.PutRope[put, sep];
sep ← ", ";
StructuredStreams.Bp[put, FALSE, 0];
IF (count ← count + 1) > width THEN {IO.PutRope[put, "..."]; EXIT};
PutTV[IndexToTV[node, 1], depth];
node ← Referent[IndexToTV[node, 2]];
ENDLOOP;
}; -- end ENABLE UNWIND => StructuredStreams.End[put];
StructuredStreams.End[put];
IO.PutChar[put, ']];
isAList:
PROC [underType: Type]
RETURNS [is:
BOOL ←
FALSE, listType: Type ← nullType] =
CHECKED {
IF TypeClass[underType] = structure
AND NComponents[underType] = 2
THEN {
ENABLE AMTypes.Error => GO TO nope;
checks whether the rest field points to an object whose type is the same as the referrent of ref. Note that it is nnecessary to check to see whether TypeClass[IndexToType[underType, 2]] = list since this is a stronger test, i.e. that it is equivalent to the type of the first list node. The catch phrase is to handle REF ANY, for which Range causes a typefault.
IF EquivalentTypes[
Range[listType ← IndexToType[underType, 2]],
underType]
THEN RETURN [TRUE, listType];
EXITS nope => {};
};
RETURN [FALSE];
IF type = nullType THEN type ← TVType[tv];
[under, class] ← UnderTypeAndClass[type];
SELECT class
FROM
definition => ERROR;
record => PutRecord[tv, 1, depth];
structure => {
IF isAList[under].is THEN {putList[tv]; RETURN};
PutRecord[tv, 1, depth]};
union =>
PutWords[tv, "UNION#"]; -- shouldn't really happen
array, sequence => {
indexType: Type ← AMTypes.Domain[type];
index: TV ← AMTypes.First[indexType];
max: INT ← LAST[INT];
IF AMTypes.UnderClass[indexType] = integer
THEN {
Absolutely miserable kludge to get around indexing by INTEGER
index ← AMTypes.Copy[index];
AMBridge.SetTVFromLI[index, 0];
};
IF class = sequence
THEN
For sequences, the length is easy to find
max ← AMTypes.Length[tv]
ELSE {
For arrays, we have to do this the hard way (sigh)
low: INT ← AMBridge.TVToLI[index];
high: INT ← AMBridge.TVToLI[AMTypes.Last[indexType]];
max ← high-low+1;
};
First show the number of elements
IO.PutF1[put, "(%g)[", [integer[max]] ];
Next test to see if we have anything to print
IF depth <= 1 THEN {IO.PutRope[put, "...]"]; RETURN};
StructuredStreams.Begin[put];
{ ENABLE UNWIND => StructuredStreams.End[put];
Now try to output the remainder of the elements
FOR i:
INT
IN [0..width]
WHILE index #
NIL
AND i < max
DO
ENABLE AMTypes.Error => GOTO urp;
elem: TV ← NIL;
msg: ROPE ← NIL;
IF i > 0
THEN {
IO.PutRope[put, ", "];
StructuredStreams.Bp[put, FALSE, 0];
};
IF i = width THEN {IO.PutRope[put, "..."]; EXIT};
elem ← AMTypes.Apply[tv, index];
PutTV[elem, depth - 1];
index ← AMTypes.Next[index];
ENDLOOP;
IO.PutChar[put, ']];
EXITS urp => {PutErr["Can't fetch element"]; IO.PutChar[put, ']]};
}; -- end ENABLE UNWIND => StructuredStreams.End[put];
StructuredStreams.End[put];
};
enumerated => {
name: ROPE ← NIL;
wrap: BOOL ← verbose AND under # UnderBoolean AND under # type;
IF wrap
THEN {
PutTypeOfTV[tv, class];
IO.PutChar[put, '[]};
name ← TVToName[tv ! AMTypes.Error => CONTINUE];
IF name =
NIL
THEN PutWords[tv, NIL, "?"]
ELSE QPutName[name];
IF wrap THEN IO.PutChar[put, ']];
};
subrange => {
ground: Type = GroundStar[under];
wide: TV ← NIL;
wide ← Coerce[tv, ground ! AMTypes.Error => CONTINUE];
IF wide =
NIL
THEN PutWords[tv, "??"]
ELSE PutTV[wide, depth];
opaque =>
PutWords[tv, "OPAQUE#"];
countedZone =>
PutWords[tv, "ZONE#"];
uncountedZone =>
PutWords[tv, "UZONE#"];
list => {
count: INT ← 0;
valid: BOOL ← FALSE;
IF IsNil[tv] THEN GO TO putNil;
valid ← LocalValidate[tv, class];
IF depth <= 2
OR
NOT valid
THEN {
IO.PutF1[put, IF valid THEN "%bB^" ELSE "%bB^??", [cardinal[TVToLC[tv]]]];
RETURN};
putList[Referent[tv]];
atom => {
IF IsNil[tv] THEN GO TO putNil;
IO.PutChar[put, '$];
IO.PutRope[put, TVToName[tv]];
};
rope => {
IF IsNil[tv] THEN GO TO putNil;
PutRopeConst[TVToName[tv], width * depth];
};
ref => {
referentTV: TV ← NIL;
referentType: Type;
bits: LONG CARDINAL = TVToLC[tv];
msg: ROPE ← NIL;
useReferent: BOOL ← depth > 2;
inner: PROC = TRUSTED {referentTV ← Referent[tv]};
isList: BOOL;
listType: Type;
IF IsNil[tv] THEN GO TO putNil;
IF NOT LocalValidate[tv] THEN {IO.PutF1[put, "%bB^??", [cardinal[bits]]]; RETURN};
IF AMTypes.IsRefAny[type]
THEN {
IF AMTypes.IsAtom[tv]
THEN {
IO.PutChar[put, '$];
IO.PutRope[put, TVToName[tv]];
RETURN};
IF AMTypes.IsRope[tv]
THEN {
PutRopeConst[TVToName[tv], width * depth];
RETURN};
};
IF useReferent THEN msg ← BackStop.Call[inner];
IF msg #
NIL
OR
NOT useReferent
THEN {
use the octal
IO.PutF1[put, "%bB^", [cardinal[bits]] ];
PrintBraces[put, msg];
RETURN};
referentType ← TVType[referentTV];
No longer:
try to get user print proc
IF HandledByPrintProc[tv: referentTV, type: referentType] THEN RETURN;
[isList, listType] ← isAList[underType: referentType];
IF isList
THEN {
IF NOT HandledByPrintProc[tv: tv, type: listType, depth: depth] THEN putList[referentTV];
RETURN};
IO.PutChar[put, '^]; -- used to be @
PutTV[referentTV, depth - 1];
pointer => {
bits: CARDINAL ← TVToCardinal[tv];
short: POINTER ← LOOPHOLE[bits];
lp:
LONG
POINTER ← short;
NOTICE: this assumes that MDS is in the same place in all worlds!
IF bits = 0 THEN GO TO putNil;
IF
NOT LocalValidate[tv]
THEN {
IO.PutF1[put, "%bB@??", [cardinal[bits]] ];
RETURN};
IF
NOT isRemote
AND under = UnderString
THEN {
PutStringConst[LOOPHOLE[short, STRING]];
RETURN};
IO.PutF1[put, "%bB@", [cardinal[bits]] ];
};
longPointer, basePointer => {
bits: LONG CARDINAL ← TVToLC[tv];
IF IsNil[tv] THEN GO TO putNil;
IF
NOT LocalValidate[tv]
THEN {
IO.PutF1[put, "%bB@??", [cardinal[bits]] ];
RETURN};
IF
NOT isRemote
THEN
SELECT under
FROM
UnderLongString, UnderPtrText => {
PutStringConst[LOOPHOLE[bits, LONG STRING]];
RETURN};
ENDCASE;
IO.PutF1[put, "%bB@", [cardinal[bits]] ];
};
relativePointer => {
IF IsNil[tv] THEN GO TO putNil;
IO.PutF1[put, "%g^R", [integer[TVToLC[tv]]]];
};
descriptor, longDescriptor => {
ws: AMBridge.WordSequence = AMBridge.TVToWordSequence[tv];
base: LONG CARDINAL ← 0;
len: CARDINAL ← 0;
IO.PutRope[put, "DESCRIPTOR["];
SELECT class
FROM
descriptor => {
shortDesc:
LONG
POINTER
TO
DESCRIPTOR
FOR
ARRAY
OF
WORD =
LOOPHOLE[@ws[0]];
base ← LOOPHOLE[BASE[shortDesc^], CARDINAL];
len ← LENGTH[shortDesc^];
};
longDescriptor => {
longDesc:
LONG
POINTER
TO
LONG
DESCRIPTOR
FOR
ARRAY
OF
WORD =
LOOPHOLE[@ws[0]];
base ← LOOPHOLE[BASE[longDesc^]];
len ← LENGTH[longDesc^];
};
ENDCASE => ERROR;
IF base = 0
THEN IO.PutRope[put, "NIL, "]
ELSE IO.PutF1[put, "%bB@, ", [cardinal[base]] ];
IO.PutF1[put, "%g]", [integer[len]]];
};
port =>
PutWords[tv, "PORT#"];
process =>
PutWords[tv, "PROCESS#"];
type =>
this handles object of type TYPE.
Objects of type Type are also printed this way via a printproc.
PutTVAsType[tv];
any =>
PutWords[tv, "ANY??"];
globalFrame => {
name: ROPE ← TVToName[tv];
IO.PutRope[put, "{globalFrame: "];
QPutName[name];
IF verbose
THEN {
gf: CARDINAL ←
IF isRemote
THEN AMBridge.RemoteGFHFromTV[tv].gfh
ELSE LOOPHOLE[GFHFromTV[tv], CARDINAL];
IO.PutF1[put, " (GF#%bB)\n", [cardinal[gf]] ];
PrintVariables[tv, put];
};
IO.PutChar[put, '}];
localFrame => {
proc: TV ← NIL;
pc: CARDINAL = AMBridge.ContextPC[tv];
lf:
CARDINAL =
IF isRemote
THEN AMBridge.RemoteFHFromTV[tv].fh
ELSE LOOPHOLE[FHFromTV[tv], CARDINAL];
temp: TV ← tv;
WHILE temp #
NIL
DO
ENABLE AMTypes.Error => EXIT;
proc ← Procedure[temp ! AMTypes.Error => CONTINUE];
IF proc # NIL THEN EXIT;
temp ← EnclosingBody[temp];
ENDLOOP;
IF proc #
NIL
THEN {
ENABLE AMTypes.Error => GO TO oops;
IF UnderTypeAndClass[TVType[proc]].class = nil THEN proc ← NIL;
EXITS oops => proc ← NIL;
};
IF proc =
NIL
THEN {
ENABLE AMTypes.Error => GO TO oops;
gf: TV ← GlobalParent[tv];
IF gf = NIL THEN GO TO oops;
IO.PutRope[put, TVToName[gf]];
IO.PutRope[put, ".??"];
EXITS oops => {IO.PutRope[put, "??"]; RETURN}}
ELSE PutTV[proc, depth];
IF verbose
THEN {
IO.PutF[put, "(lf: %bB, pc: %bB)", [cardinal[lf]], [cardinal[pc]] ];
IF depth > 1
THEN {
IO.PutRope[put, "\nArguments:\n"];
PrintArguments[tv: tv, put: put, breakBetweenItems: TRUE];
IO.PutRope[put, "\nVariables:\n"];
PrintVariables[tv: tv, put: put, breakBetweenItems: TRUE];
};
IO.PutRope[put, "\n"];
};
};
program, procedure, signal, error => {
kind: ROPE ← NIL;
name: ROPE ← NIL;
useGlobalName: BOOL ← TRUE;
IF IsNil[tv] THEN GO TO putNil;
name ← TVToName[tv ! AMTypes.Error => CONTINUE];
SELECT class
FROM
program => {kind ← "PROGRAM#"; useGlobalName ← FALSE};
procedure => kind ← NIL;
signal, error => {
kind ← IF class = signal THEN "SIGNAL " ELSE "ERROR ";
IF AllCaps[name] THEN useGlobalName ← FALSE;
}
ENDCASE => ERROR;
IO.PutRope[put, kind];
IF useGlobalName
THEN {
ENABLE AMTypes.Error => GO TO oops;
gn: ROPE ← NIL;
gp: TV ← GlobalParent[tv];
IF gp # NIL THEN gn ← TVToName[gp];
QPutName[gn];
IO.PutChar[put, '.];
EXITS oops => IO.PutRope[put, "??."];
};
QPutName[name];
};
character =>
IO.PutRope[put, Convert.RopeFromChar[TVToCharacter[tv]]];
integer, longInteger =>
IO.Put[put, [integer[TVToLI[tv]]]];
unspecified, cardinal, longCardinal => {
lc: LONG CARDINAL = TVToLC[tv];
IO.PutF[put, "%bB (%g)", [cardinal[lc]], [cardinal[lc]] ];
};
real => IO.Put[put, [real[TVToReal[tv]]]];
ENDCASE => ERROR;
EXITS
putNil => IO.PutRope[put, "NIL"];
};
START Print HERE
IF needInit THEN EnsureInit[];
PutTV[tv, depth, verbose];
};
AllCaps:
PROC [name:
ROPE]
RETURNS [
BOOL] = {
FOR i:
INT
IN [0..name.Size[])
DO
IF name.Fetch[i] IN ['a..'z] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
};
PrintArguments:
PUBLIC
PROC [tv:
TV, put:
STREAM, depth:
INT ← 4, width:
INT ← 32, breakBetweenItems:
BOOL ←
FALSE] = {
print the arguments to the given local frame
the depth and width args apply to the individual printing
an error msg is printed if this is not a local frame
type: Type;
class: Class;
n: NAT ← 0;
i: NAT ← 0;
inner1:
PROC = {
Print[Argument[tv, i], put, depth, width, FALSE];
};
inner:
PROC = {
ptv: TV ← NIL;
sep: ROPE ← IF breakBetweenItems THEN "\n " ELSE ", ";
[type, class] ← UnderTypeAndClass[TVType[tv]];
IF class # localFrame
THEN {
IO.PutRope[put, "-- not a local frame! --"];
RETURN};
ptv ← Procedure[tv ! Error => CONTINUE];
IF ptv = NIL THEN ptv ← Signal[tv ! Error => CONTINUE];
IF ptv = NIL THEN RETURN;
[type, class] ← UnderTypeAndClass[TVType[ptv]];
IF type = nullType THEN RETURN;
[type, class] ← UnderTypeAndClass[Domain[type]];
IF type = nullType THEN RETURN;
n ← NComponents[type];
IF n = 0 THEN RETURN;
IO.PutRope[put, " "];
FOR i
IN [1..n]
DO
name: ROPE ← IndexToName[type, i];
each: ROPE ← NIL;
IF i > 1 THEN IO.PutRope[put, sep];
PrintName[put, name];
PrintBraces[put, BackStop.Call[inner1]];
ENDLOOP;
};
PrintBraces[put, BackStop.Call[inner]];
};
PrintResults:
PUBLIC
PROC [tv:
TV, put:
STREAM, depth:
INT ← 4, width:
INT ← 32, breakBetweenItems:
BOOL ←
FALSE] = {
print the results for the given local frame
the depth and width args apply to the individual printing
an error msg is printed if this is not a local frame
type: Type;
class: Class;
n: NAT ← 0;
i: NAT ← 0;
inner1:
PROC = {
Print[Result[tv, i], put, depth, width, FALSE];
};
inner:
PROC = {
ptv: TV ← NIL;
sep: ROPE ← IF breakBetweenItems THEN "\n " ELSE ", ";
[type, class] ← UnderTypeAndClass[TVType[tv]];
IF class # localFrame
THEN {
IO.PutRope[put, "-- not a local frame! --"]; RETURN};
ptv ← Procedure[tv ! AMTypes.Error => CONTINUE];
IF ptv =
NIL
THEN
ptv ← Signal[tv ! AMTypes.Error => CONTINUE];
IF ptv = NIL THEN RETURN;
[type, class] ← UnderTypeAndClass[TVType[ptv]];
IF type = nullType THEN RETURN;
[type, class] ← UnderTypeAndClass[Range[type]];
IF type = nullType THEN RETURN;
n ← NComponents[type];
IF n = 0 THEN RETURN;
IO.PutRope[put, " "];
FOR i
IN [1..n]
DO
name: ROPE ← IndexToName[type, i];
each: ROPE ← NIL;
IF i > 1 THEN IO.PutRope[put, sep];
PrintName[put, name];
PrintBraces[put, BackStop.Call[inner1]];
ENDLOOP;
};
PrintBraces[put, BackStop.Call[inner]];
};
PrintVariables:
PUBLIC
PROC [tv:
TV, put:
STREAM, depth:
INT ← 4, width:
INT ← 32, all, breakBetweenItems:
BOOL ←
TRUE] =
TRUSTED {
print the results for the given local frame
the depth and width args apply to the individual printing
an error msg is printed if this is not a local frame
if all = TRUE, then all variables in the frame are printed
type: Type;
local, global: BOOL ← FALSE;
class: Class;
n: NAT ← 0;
i: NAT ← 0;
indent: ROPE ← " ";
sep: ROPE ← IF breakBetweenItems THEN "\n" ELSE ", ";
nvars: NAT ← 0;
inner1:
PROC =
TRUSTED {
tv1: TV ← IF local THEN Locals[tv] ELSE Globals[tv];
type1: Type ← TVType[tv1];
nvars ← IF tv1 = NIL THEN 0 ELSE NComponents[type1];
FOR i:
INT
IN [1..nvars]
DO
inner2:
PROC =
TRUSTED {
name: ROPE ← IndexToName[type1, i];
IF breakBetweenItems THEN IO.PutRope[put, indent];
PrintName[put, name];
Print[IndexToTV[tv1, i], put, depth, width]
};
IF i > 1 THEN IO.PutRope[put, sep];
PrintBraces[put, BackStop.Call[inner2]];
ENDLOOP;
IF local
THEN tv ← EnclosingBody[tv]
ELSE tv ← NIL;
IF breakBetweenItems THEN indent ← Rope.Concat[indent, " "];
};
inner:
PROC =
TRUSTED {
[type, class] ← UnderTypeAndClass[TVType[tv]];
SELECT class
FROM
globalFrame => global ← TRUE;
localFrame => local ← TRUE;
ENDCASE => {IO.PutRope[put, "--{not a frame}--"]; RETURN};
WHILE tv #
NIL
DO
msg: ROPE ← NIL;
IF nvars # 0 THEN IO.PutRope[put, sep];
msg ← BackStop.Call[inner1];
IF msg # NIL THEN {PrintBraces[put, msg]; EXIT};
IF NOT all THEN EXIT;
ENDLOOP;
};
PrintBraces[put, BackStop.Call[inner]];
};
PrintSignal:
PUBLIC
PROC [signalTV, argsTV:
TV, put:
STREAM, depth:
INT ← 4, width:
INT ← 32, verbose:
BOOL ←
FALSE] =
TRUSTED {
msg, signal: UNSPECIFIED;
r: ROPE;
PutSignal1:
PROC =
TRUSTED {
OPEN AMTypes, IO;
signalType: Type;
argsType: Type;
ptr: LONG POINTER;
argsSize: NAT ← 0;
signalTV ← AMBridge.TVForSignal[LOOPHOLE[signal, ERROR ANY RETURNS ANY]];
signalType ← TVType[signalTV];
argsType ← Domain[signalType];
IF argsType # SafeStorage.nullType THEN argsSize ← AMTypes.Size[argsType];
IF argsSize > 1 THEN ptr ← LOOPHOLE[msg, POINTER] ELSE ptr ← @msg;
IF argsSize # 0 THEN argsTV ← AMBridge.TVForPointerReferent[ptr, argsType]
ELSE RETURN;
}; -- of PutSignal1
START PrintSignal HERE
IF signalTV =
NIL
THEN {
[msg, signal] ← SIGNAL RuntimeError.SendMsgSignal[];
SELECT signal
FROM
-- some common signals which have to be handled specially
-1 => {IO.PutRope[put, "ERROR"]; RETURN};
ABORTED => {IO.PutRope[put, "ABORTED"]; RETURN}; -- says andrew
ENDCASE;
r ← BackStop.Call[PutSignal1];
IF ~Rope.IsEmpty[r] THEN {IO.PutRope[put, r]; RETURN};
};
Print[tv: signalTV, put: put, depth: depth, width: width, verbose: verbose];
IF argsTV #
NIL THEN
Print[tv: argsTV, put: put, depth: depth, width: width, verbose: verbose];
};
PrintOctal:
PROC [put:
STREAM, n:
LONG
CARDINAL] = {
IO.PutF1[put, "%bB", [cardinal[n]]];
};
PrintName:
PROC [put:
STREAM, name:
ROPE] = {
IF Rope.InlineLength[name] # 0 THEN IO.PutF1[put, "%g: ", [rope[name]]];
};
PrintBraces:
PROC [put:
STREAM, stuff:
ROPE] = {
IF stuff # NIL THEN IO.PutF1[put, "--{%g}--", [rope[stuff]]];
};