SELECT class
FROM
definition => ERROR;
record => PutRecord[tv, 1, depth];
structure =>
{
IF isAList[under]
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
put.PutRope["("];
put.Put[IO.int[max]];
put.PutRope[")["];
Next test to see if we have anything to print
IF depth <= 1 THEN {put.PutRope["...]"]; 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 {
put.PutRope[", "];
StructuredStreams.Bp[put, FALSE, 0];
};
IF i = width THEN {put.PutRope["..."]; EXIT};
elem ← AMTypes.Apply[tv, index];
PutTV[elem, depth - 1];
index ← AMTypes.Next[index];
ENDLOOP;
put.PutChar[']];
EXITS
urp => {PutErr["Can't fetch element"]; put.PutChar[']]};
}; -- 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];
put.PutChar['[]};
name ← TVToName[tv ! AMTypes.Error => CONTINUE];
IF name =
NIL
THEN PutWords[tv, NIL, "?"]
ELSE QPutName[name];
IF wrap THEN put.PutChar[']];
};
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 {
put.PutRope["NIL"]; RETURN};
valid ← LocalValidate[tv, class];
IF depth <= 2
OR
NOT valid
THEN {
PutCardRope[TVToLC[tv], IF valid THEN "^" ELSE "^??"];
RETURN};
putList[Referent[tv]];
atom => {
IF IsNil[tv] THEN put.PutRope["NIL"]
ELSE {put.PutChar['$]; put.PutRope[TVToName[tv]]};
};
rope => {
IF IsNil[tv] THEN put.PutRope["NIL"]
ELSE 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]};
IF IsNil[tv] THEN {put.PutRope["NIL"]; RETURN};
IF NOT LocalValidate[tv] THEN {PutCardRope[bits, "^??"]; RETURN};
IF AMTypes.IsRefAny[type]
THEN {
IF AMTypes.IsAtom[tv]
THEN {
put.PutChar['$];
put.PutRope[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
PutCardRope[bits, "^"];
IF msg # NIL THEN PutErr[msg];
RETURN};
try to get user print proc
referentType ← TVType[referentTV];
IF HandledByPrintProc[tv: referentTV, type: referentType]
THEN RETURN;
IF isAList[underType: referentType]
THEN {
putList[referentTV];
RETURN};
put.PutChar['^]; -- used to be @
PutTV[referentTV, depth - 1];
pointer => {
bits: CARDINAL ← TVToCardinal[tv];
short: POINTER ← LOOPHOLE[bits];
lp: LONG POINTER ← short;
IF bits = 0 THEN {put.PutRope["NIL"]; RETURN};
IF NOT LocalValidate[tv] THEN {PutCardRope[bits, "@??"]; RETURN};
IF under = UnderString
THEN {
PutStringConst[LOOPHOLE[short, STRING]];
RETURN};
PutCardRope[bits, "@"];
};
longPointer, basePointer => {
bits: LONG CARDINAL ← TVToLC[tv];
IF IsNil[tv] THEN {put.PutRope["NIL"]; RETURN};
IF NOT LocalValidate[tv] THEN {PutCardRope[bits, "@??"]; RETURN};
IF under = UnderLongString
OR under = UnderPtrText
THEN
IF
NOT isRemote
THEN {
PutStringConst[LOOPHOLE[bits, LONG STRING]];
RETURN};
PutCardRope[bits, "@"];
};
relativePointer => {
IF IsNil[tv] THEN {put.PutRope["NIL"]; RETURN};
put.Put[IO.int[TVToLC[tv]]];
put.PutRope["^R"];
};
descriptor, longDescriptor => {
ws: AMBridge.WordSequence = AMBridge.TVToWordSequence[tv];
base: LONG CARDINAL ← 0;
len: CARDINAL ← 0;
put.PutRope["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 put.PutRope["NIL, "] ELSE PutCardRope[base, "@, "];
put.Put[IO.int[len]];
put.PutRope["]"];
};
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];
nil =>
put.PutRope["NIL"];
any =>
PutWords[tv, "ANY??"];
globalFrame => {
name: ROPE ← TVToName[tv];
put.PutRope["{globalFrame: "];
QPutName[name];
IF verbose
THEN {
gf: CARDINAL ←
IF isRemote
THEN AMBridge.RemoteGFHFromTV[tv].gfh
ELSE LOOPHOLE[GFHFromTV[tv], CARDINAL];
put.PutRope[" (GF#"];
PutCardRope[gf, ")\n"];
PrintVariables[tv, put];
};
put.PutChar['}];
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;
put.PutRope[TVToName[gf]];
put.PutRope[".??"];
EXITS oops => {put.PutRope["??"]; RETURN}}
ELSE PutTV[proc, depth];
IF verbose
THEN {
put.PutRope["(lf: "];
PutCardRope[lf, ", pc: "];
PutCardRope[pc, ")"];
IF depth > 1
THEN {
put.PutRope["\nArguments:\n"];
PrintArguments[tv: tv, put: put, breakBetweenItems: TRUE];
put.PutRope["\nVariables:\n"];
PrintVariables[tv: tv, put: put, breakBetweenItems: TRUE];
};
put.PutRope["\n"];
};
};
program, procedure, signal, error => {
kind: ROPE ← NIL;
name: ROPE ← NIL;
useGlobalName: BOOL ← TRUE;
IF IsNil[tv] THEN {put.PutRope["NIL"]; RETURN};
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;
put.PutRope[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];
put.PutChar['.];
EXITS oops => put.PutRope["??."];
};
QPutName[name];
};
unspecified, cardinal => {
lc: LONG CARDINAL = TVToCardinal[tv];
PrintOctal[put, lc];
put.PutRope[Rope.Cat[" (", IO.PutR[IO.card[lc]], ")"]];
};
integer =>
put.Put[IO.int[TVToInteger[tv]]];
character =>
PutCharLit[TVToCharacter[tv]];
longInteger =>
put.Put[IO.int[TVToLI[tv]]];
longCardinal => {
lc: LONG CARDINAL = TVToLC[tv];
PrintOctal[put, lc];
put.PutRope[Rope.Cat[" (", IO.PutR[IO.card[lc]], ")"]];
};
real => put.Put[IO.real[TVToReal[tv]]];
ENDCASE => ERROR