SELECT code
FROM
definition => {
name: CHAR ~ GetChar[ts, i.SUCC];
IF defs[name] # INT.FIRST THEN Malformed[i, "double def"];
defs[name] ¬ i+2;
to.PutF1["T%g", [cardinal[name.ORD]] ];
RETURN PrintType[IO.noWhereStream, defs, ts, i+2]};
name => {
name: CHAR ~ GetChar[ts, i.SUCC];
IF defs[name] = INT.FIRST THEN Malformed[i, "undefined name"];
to.PutF1["T%g", [cardinal[name.ORD]] ];
RETURN [i+2]};
boolean => {to.PutRope["BOOL"]; RETURN [i.SUCC]};
enumerated => {
j: INT ¬ i+2; first: BOOL ¬ TRUE;
PrintEnum:
PROC ~ {
to.PutRope["{"];
UNTIL GetChar[ts, j].
ORD =
TS.Code.rightParen.
ORD
DO
name: ROPE; j2, j3: INT; rep: CARD;
[name, j2] ¬ GetName[ts, j];
[rep, j3] ¬ GetCard[ts, j2];
IF first THEN first ¬ FALSE ELSE {to.PutChar[',]; SS.Bp[to, lookLeft, 3, " "]};
to.PutF["%g(%g)", [rope[name]], [cardinal[rep]] ];
j ¬ j3; ENDLOOP;
to.PutRope["}"]};
IF GetChar[ts, i.
SUCC].
ORD #
TS.Code.leftParen.
ORD
THEN
ERROR Malformed[i, "enumerated not followed by leftParen"];
PrintObj[to, PrintEnum];
RETURN [j.SUCC];
};
paint => RETURN PrintPaint[to, ts, i.SUCC, FALSE];
text => {to.PutRope["TEXT"]; RETURN [i.SUCC]};
stringBody => {to.PutRope["StringBody"]; RETURN [i.SUCC]};
leftParen => {
PrintRecord:
PROC ~ {first:
BOOL ¬
TRUE;
i ¬ i.SUCC;
UNTIL GetChar[ts, i].
ORD =
TS.Code.rightParen.
ORD
DO
IF first THEN first ¬ FALSE ELSE {to.PutChar[',]; SS.Bp[to, united, 0, " "]};
i ¬ PrintField[to, defs, ts, i];
ENDLOOP;
to.PutRope["]"]};
to.PutRope["["];
PrintObj[to, PrintRecord];
RETURN [i.SUCC];
};
union => RETURN PrintPaint[to, ts, i.SUCC, FALSE];
packed => {to.PutRope["PACKED "]; RETURN PrintType[to, defs, ts, i.SUCC]};
array => RETURN PrintBinary[to, defs, ts, i.SUCC, "ARRAY ", "OF ", FALSE];
sequence => {
i2, i3: INT ¬ 0;
SeqObj:
PROC ~ {
to.PutRope["SEQUENCE "];
i2 ¬ PrintField[to, defs, ts, i.SUCC];
SS.Bp[to, united, 2, " "];
to.PutRope["OF "];
i3 ¬ PrintType[to, defs, ts, i2]};
PrintObj[to, SeqObj];
RETURN [i3];
};
subrange => {
SubObj:
PROC ~ {
first, last: CARD ¬ 0;
i2: INT ¬ i.SUCC;
next: BYTE = GetChar[ts, i2].ORD;
signed: BOOL ¬ FALSE;
maybeByte: BOOL ¬ FALSE;
integerCode: BYTE = TS.Code[integer].ORD;
cardinalCode: BYTE = TS.Code[cardinal].ORD;
SELECT next
FROM
integerCode, cardinalCode => i ¬ i2.SUCC;
ENDCASE => i ¬ PrintType[to, defs, ts, i2];
[first, i] ¬ GetCard[ts, i];
[last, i] ¬ GetCard[ts, i];
IF next = cardinalCode
THEN {
IF first = 0
THEN
SELECT last
FROM
BYTE.LAST => {IO.PutRope[to, "BYTE"]; RETURN};
NAT15.LAST => {IO.PutRope[to, "NAT15"]; RETURN};
CARD16.LAST => {IO.PutRope[to, "CARD16"]; RETURN};
ENDCASE;
IO.PutRope[to, "CARDINAL"];
RETURN;
};
IF next = integerCode
AND
LOOPHOLE[first,
INTEGER] =
INT16.
FIRST
AND
LOOPHOLE[last,
INTEGER] =
INT16.
LAST
THEN {
IO.PutRope[to, "INT16"];
RETURN;
};
IF next = integerCode
THEN IO.PutF1[to, "[%g", [integer[LOOPHOLE[first, INTEGER]]]]
ELSE IO.PutF1[to, "[%g", [cardinal[first]]];
IF next = integerCode
THEN IO.PutF1[to, "..%g]", [integer[LOOPHOLE[last, INTEGER]]]]
ELSE IO.PutF1[to, "..%g]", [cardinal[last]]];
};
PrintObj[to, SubObj];
RETURN [i];
};
atomRec => {to.PutRope["AtomRec"]; RETURN [i.SUCC]};
opaque => RETURN PrintPaint[to, ts, i.SUCC, TRUE];
mds => RETURN PrintUnary[to, defs, ts, i.SUCC, "MDS"];
countedZone => {to.PutRope["CountedZone"]; RETURN [i.SUCC]};
uncountedZone => {to.PutRope["UncountedZone"]; RETURN [i.SUCC]};
ordered => RETURN PrintUnary[to, defs, ts, i.SUCC, "ORDERED"];
readOnly => RETURN PrintUnary[to, defs, ts, i.SUCC, "READONLY"];
list => RETURN PrintUnary[to, defs, ts, i.SUCC, "LIST OF"];
relativeRef => RETURN PrintBinary[to, defs, ts, i.SUCC, NIL, "RELATIVE"];
refAny => {to.PutRope["REF"]; RETURN [i.SUCC]};
ref => RETURN PrintUnary[to, defs, ts, i.SUCC, "REF"];
var => RETURN PrintUnary[to, defs, ts, i.SUCC, "VAR"];
pointer => RETURN PrintUnary[to, defs, ts, i.SUCC, "POINTER TO"];
longPointer => RETURN PrintUnary[to, defs, ts, i.SUCC, "LONG POINTER TO"];
descriptor => RETURN PrintUnary[to, defs, ts, i.SUCC, "DESCRIPTOR FOR"];
longDescriptor => RETURN PrintUnary[to, defs, ts, i.SUCC, "LONG DESCRIPTOR FOR"];
procedure => RETURN PrintTransfer[to, defs, ts, i.SUCC, "UNSAFE PROC "];
safeProc => RETURN PrintTransfer[to, defs, ts, i.SUCC, "SAFE PROC "];
safe => RETURN PrintUnary[to, defs, ts, i.SUCC, "SAFE"];
port => RETURN PrintTransfer[to, defs, ts, i.SUCC, "PORT "];
program => RETURN PrintTransfer[to, defs, ts, i.SUCC, "PROGRAM "];
signal => RETURN PrintTransfer[to, defs, ts, i.SUCC, "SIGNAL "];
error => RETURN PrintTransfer[to, defs, ts, i.SUCC, "ERROR "];
process => RETURN PrintUnary[to, defs, ts, i.SUCC, "PROCESS RETURNS"];
cardinal => {to.PutRope["CARDINAL"]; RETURN [i.SUCC]};
integer => {to.PutRope["INTEGER"]; RETURN [i.SUCC]};
character => {to.PutRope["CHAR"]; RETURN [i.SUCC]};
longInteger => {to.PutRope["INT"]; RETURN [i.SUCC]};
longCardinal => {to.PutRope["CARD"]; RETURN [i.SUCC]};
real => {to.PutRope["REAL"]; RETURN [i.SUCC]};
type => {to.PutRope["TYPE"]; RETURN [i.SUCC]};
any => {to.PutRope["ANY"]; RETURN [i.SUCC]};
unspecified => {to.PutRope["UNSPECIFIED"]; RETURN [i.SUCC]};
longUnspecified => {to.PutRope["LONG UNSPECIFIED"]; RETURN [i.SUCC]};
dcard => {to.PutRope["DCARD"]; RETURN [i.SUCC]};
dint => {to.PutRope["DINT"]; RETURN [i.SUCC]};
dreal => {to.PutRope["DREAL"]; RETURN [i.SUCC]};
globalFrame, localFrame => Malformed[i, "got a frame"];
ENDCASE => Malformed[i, "unrecognized code"]};