DIRECTORY
Basics USING [BITAND, BoundsCheckHighHalf, LowHalf, RawWords],
Imager USING [Context],
ImagerFont USING [XCharProc, XStringProc],
IO USING [STREAM],
IPMaster USING [Body, Op, Token],
PrincOps USING [BitAddress, DstFunc, SrcFunc],
Rope USING [ROPE];

IPInterpreter: CEDAR DEFINITIONS
IMPORTS Basics
~ BEGIN
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;

Body: TYPE ~ IPMaster.Body;

maxCardinal: INT ~ 77777777B; -- 2^24 - 1 = 16777215
maxVecSize: NAT ~ 32000; -- for result of MakeVec or MakeVecLU
topFrameSize: NAT ~ 50;

Any: TYPE ~ REF;

TypeCode: TYPE ~ MACHINE DEPENDENT {
null(0), 
number(1), identifier(2), vector(3), operator(4), -- Base types
transformation(5), pixelArray(6), color(7), trajectory(8), outline(9), -- Image types
font(10), clipper(11), -- more Image types
(CARDINAL.LAST) -- room for lots more
};

Cardinal: TYPE ~ INT--[0..maxCardinal]--;

BoundsCheckCardinal: PROC [i: INT] RETURNS [Cardinal]
~ INLINE { RETURN[Basics.BoundsCheckHighHalf[value: i, bound: 400B]] };
Even: PROC [i: INT] RETURNS [BOOL]
~ INLINE { RETURN[Basics.BITAND[Basics.LowHalf[LOOPHOLE[i]], 1]=0] };

Number: TYPE ~ REF NumberRep;
NumberRep: TYPE ~ RECORD [
SELECT tag: * FROM
zero => [zero: Cardinal _ 0],
int => [int: INT],
real => [real: REAL],
rational => [n, d: INTEGER],
ENDCASE
];

Identifier: TYPE ~ ROPE;

Marker: TYPE ~ LONG CARDINAL; -- a unique mark value associated with a context
nullMarker: Marker ~ 0;

VectorShape: TYPE ~ RECORD [lowerBound: Cardinal, size: INT--[0..maxCardinal+1]--];
Vector: TYPE ~ REF VectorRep;
VectorRep: TYPE ~ RECORD [class: VectorClass, data: REF];

VectorClass: TYPE ~ REF VectorClassRep;
VectorClassRep: TYPE ~ RECORD [
type: ATOM, -- $Array, $Merged, $String, ...
shape: PROC [v: Vector] RETURNS [VectorShape],
get: PROC [v: Vector, i: Cardinal] RETURNS [Any],
getCardinal: PROC [v: Vector, i: Cardinal] RETURNS [Cardinal]
];

Operator: TYPE ~ REF OperatorRep;
OperatorRep: TYPE ~ RECORD [class: OperatorClass, data: REF];

OperatorClass: TYPE ~ REF OperatorClassRep;
OperatorClassRep: TYPE ~ RECORD [
type: ATOM, -- $Composed, $Char, $Decompressor, $ColorOperator, ...
do: PROC [op: Operator, state: Ref]
];

Array: TYPE ~ REF ArrayRep; -- a mutable array of values, such as a frame
ArrayRep: TYPE ~ RECORD [
lowerBound: Cardinal, -- lower bound, as in VectorShape
array: SEQUENCE size: [0..maxVecSize] OF Any
];



Context: TYPE ~ REF ContextRep; -- an execution context
ContextRep: TYPE ~ RECORD [
caller: Context, -- caller's context
marker: Marker, -- unique mark for this context
token: IPMaster.Token, -- token currently being executed
frameV: Vector, -- frame vector (if NIL, use frameA)
frameA: Array, -- frame array (if NIL, use frameV)
env: Vector -- environment
];

stackArraySize: NAT ~ 8;
StackArray: TYPE ~ REF StackArrayRep;
StackArrayRep: TYPE ~ ARRAY [0..stackArraySize) OF NumberRep;
StackList: TYPE ~ LIST OF Any;

MarkItem: TYPE ~ RECORD [count: Cardinal, marker: Marker];
MarkArray: TYPE ~ REF MarkArrayRep;
MarkArrayRep: TYPE ~ RECORD [size: NAT, seq: SEQUENCE max: NAT OF MarkItem];

Ref: TYPE ~ REF Rep; -- an Interpress interpreter instance
Rep: TYPE ~ RECORD [
stream: STREAM _ NIL, -- input stream on the master being interpreted
buffer: REF TEXT _ NIL, -- buffer for short sequence data
topFrame: Vector _ NIL, -- initial frame for the top level block
topEnv: Vector _ NIL, -- environment for the top level block
lastMarker: Marker _ nullMarker, -- last mark value used
context: Context _ NIL, -- the current execution context
contextFree: Context _ NIL, -- list of free execution contexts
contextCount: Cardinal _ 0, -- number of contexts allocated
stackCount: Cardinal _ 0, -- number of stack elements above the top mark
stackCountMax: Cardinal _ 0, -- maximum count permitted above the top mark
stackArray: StackArray _ NIL, -- a few numbers on top of the stack
stackArrayCount: [0..stackArraySize] _ 0, -- number of elements in stackArray
stackList: StackList _ NIL, -- the rest of the stack
markArray: MarkArray _ NIL, -- marks on the stack
imager: Imager.Context _ NIL -- imager state
];

Bug: ERROR;
MarkRecovery: ERROR;

masterErrorCode: Cardinal ~ 0;
masterWarningCode: Cardinal ~ 10;
appearanceErrorCode: Cardinal ~ 50;
appearanceWarningCode: Cardinal ~ 60;
commentCode: Cardinal ~ 100;

ReportError: PROC [code: Cardinal, atom: ATOM, message: ROPE];
MasterError: PROC [atom: ATOM, message: ROPE];
MasterWarning: PROC [atom: ATOM, message: ROPE];

CardinalFromReal: PROC [REAL] RETURNS [Cardinal];
CardinalFromNum: PROC [NumberRep] RETURNS [Cardinal];
RealFromNum: PROC [NumberRep] RETURNS [REAL];
NumberFromCardinal: PROC [Cardinal] RETURNS [Number];
NumberFromReal: PROC [REAL] RETURNS [Number];
NumberFromNum: PROC [NumberRep] RETURNS [Number];

CardinalFromAny: PROC [Any] RETURNS [Cardinal];
RealFromAny: PROC [Any] RETURNS [REAL];
NumberFromAny: PROC [Any] RETURNS [Number];
IdentifierFromAny: PROC [Any] RETURNS [Identifier];
VectorFromAny: PROC [Any] RETURNS [Vector];
OperatorFromAny: PROC [Any] RETURNS [Operator];

Eq: PROC [a, b: Any] RETURNS [BOOL];
EqName: PROC [a, b: Any] RETURNS [BOOL];
Type: PROC [a: Any] RETURNS [TypeCode];

Get: PROC [v: Vector, i: Cardinal] RETURNS [Any];
GetCardinal: PROC [v: Vector, i: Cardinal] RETURNS [Cardinal];
GetReal: PROC [v: Vector, i: Cardinal] RETURNS [REAL];
Shape: PROC [v: Vector] RETURNS [VectorShape];

ZeroVec: PROC [n: Cardinal] RETURNS [Vector];

MakeVec: PROC [n: Cardinal, pop: PROC RETURNS [Any]] RETURNS [Vector];
MakeVecLU: PROC [l, u: Cardinal, pop: PROC RETURNS [Any]] RETURNS [Vector];
MergeProp: PROC [v1, v2: Vector] RETURNS [Vector];

PropProc: TYPE ~ PROC [v: Vector, j: Cardinal] RETURNS [quit: BOOL _ FALSE];
MapProp: PROC [v: Vector, action: PropProc] RETURNS [BOOL];

GetProp: PROC [v: Vector, propName: Any] RETURNS [found: BOOL, value: Any];
GetP: PROC [v: Vector, propName: Any] RETURNS [Any];
GetPropR: PROC [v: Vector, rope: ROPE] RETURNS [found: BOOL, value: Any];
GetPR: PROC [v: Vector, rope: ROPE] RETURNS [Any];
GetPropC: PROC [v: Vector, card: Cardinal] RETURNS [found: BOOL, value: Any];
GetPC: PROC [v: Vector, card: Cardinal] RETURNS [Any];

RunSize: PROC [r: Vector] RETURNS [Cardinal];
RunGet: PROC [r: Vector, i: Cardinal] RETURNS [Any];

VectorFromArray: PROC [Array] RETURNS [Vector];
ArrayFromVector: PROC [Vector] RETURNS [Array];

VectorFromString: PROC [string: ImagerFont.XStringProc] RETURNS [Vector];
StringFromVector: PROC [v: Vector, charAction: ImagerFont.XCharProc];
VectorFromRope: PROC [ROPE] RETURNS [Vector];
RopeFromVector: PROC [Vector] RETURNS [ROPE];
VectorFromName: PROC [ROPE] RETURNS [Vector];
NameFromVector: PROC [Vector] RETURNS [ROPE];
VectorFromBytes: PROC [bytes: ROPE, bytesPerElement: NAT, signed: BOOL] RETURNS [Vector];
VectorFromBits: PROC [bytes: ROPE, dataBitsPerLine, padBitsPerLine: NAT] RETURNS [Vector];
UnsafeGetElements: UNSAFE PROC [vector: Vector, buffer: LONG POINTER TO Basics.RawWords, start: INT, count: NAT];
UnsafeGetBits: UNSAFE PROC [vector: Vector, dst: PrincOps.BitAddress, start: INT, count: NAT, srcFunc: PrincOps.SrcFunc _ null, dstFunc: PrincOps.DstFunc _ null];


PushAny: PROC [self: Ref, val: Any];
PushNum: PROC [self: Ref, val: NumberRep];
PushBool: PROC [self: Ref, val: BOOL];
PushCardinal: PROC [self: Ref, val: Cardinal];
PushReal: PROC [self: Ref, val: REAL];
PushIdentifier: PROC [self: Ref, val: Identifier];
PushVector: PROC [self: Ref, val: Vector];
PushOperator: PROC [self: Ref, val: Operator];

PopAny: PROC [self: Ref] RETURNS [Any];
PopNum: PROC [self: Ref] RETURNS [NumberRep];
PopBool: PROC [self: Ref] RETURNS [BOOL];
PopCardinal: PROC [self: Ref] RETURNS [Cardinal];
PopReal: PROC [self: Ref] RETURNS [REAL];
PopIdentifier: PROC [self: Ref] RETURNS [Identifier];
PopVector: PROC [self: Ref] RETURNS [Vector];
PopOperator: PROC [self: Ref] RETURNS [Operator];

TopType: PROC [self: Ref] RETURNS [TypeCode];
Pop: PROC [self: Ref];
Copy: PROC [self: Ref, depth: Cardinal];
Roll: PROC [self: Ref, depth, moveFirst: Cardinal];

Mark: PROC [self: Ref, n: Cardinal];
Unmark: PROC [self: Ref, n: Cardinal];
Count: PROC [self: Ref] RETURNS [Cardinal];
PopToActiveMark: PROC [self: Ref] RETURNS [Marker];

Call: PROC [self: Ref, action: PROC, frame: Vector, env: Vector];

Frame: PROC [self: Ref] RETURNS [Vector];
FGet: PROC [self: Ref, i: Cardinal] RETURNS [Any];
FSet: PROC [self: Ref, x: Any, i: Cardinal];
Env: PROC [self: Ref] RETURNS [Vector];

DoSave: PROC [self: Ref, action: PROC];
DoSaveAll: PROC [self: Ref, action: PROC];
DoWithMarkProtection: PROC [self: Ref, action: PROC];

Apply: PROC [self: Ref, op: IPMaster.Op];
Do: PROC [self: Ref, op: Operator];

MakeCO: PROC [frame: Vector, env: Vector, body: Body] RETURNS [Operator];

GetInlineBody: PROC [self: Ref] RETURNS [Body];
SkipInlineBody: PROC [self: Ref];
CallInlineBody: PROC [self: Ref, frame: Vector, env: Vector];


END.
τIPInterpreter.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Michael Plass, June 5, 1985 11:23:59 am PDT
Doug Wyatt, November 22, 1985 2:48:11 pm PST

Types and operations for the Interpress interpreter.

Types
IF i IN[0..maxCardinal] THEN RETURN[i] ELSE ERROR RuntimeError.BoundsFault;

RETURN[(i MOD 2)=0]
Upper bound "u" = lowerBound+size-1.

Source: TYPE ~ REF SourceRep; -- a source of tokens
SourceRep: TYPE ~ RECORD [
caller: Source, -- calling source
stream: STREAM
];

Operations
Conversion between Number representations.
Type narrowing operations.
Creates a Vector with n elements, all zero.
Creates a Vector with the specified shape.
Calls pop shape.n times to get the elements, last element first.

Creates a Vector with the same shape and elements as the Array.
The result contains a copy of the Array; it does not share the original.

Creates an Array with the same shape and elements as the Vector.
The result is a new, mutable copy; it shares nothing with the Vector.
Makes a Vector of Cardinal from the characters of the string.

Calls charAction for each element of v in order.
Error if any element is not an integer that fits in an XChar.

These use VectorFromString and StringFromVector to convert between Vectors and ROPEs.
The rope uses the encoding scheme in the Xerox Character Code Standard.

Conversion between slash-notation names (like "a/b/c") and Vectors of Identifiers.

No sign extension is done.
start and count deal in bits
These push an element on the stack.
These pop an element from the stack.
Executes the action in a new context with specified frame and environment.
Executes the action, then restores non-persistent imager variables.

Executes the action, then restores all imager variables.

Executes < 0 MARK action UNMARK0 >, with mark recovery if necessary.

Executes a primitive.

Executes an Operator.

Makes a composed operator.
Reads a body from the master, recording it for later use.

Skips over a body in the master.

Executes a body in a new context.
Κ
Q˜
codeš
œ™Kšœ
Οm
œ7™BK™+Kš
œ,™,—K™Kš
œ4™4K™š
Οk	˜	Kšœžœžœ*˜>Kšœžœ˜Kšœžœ˜*Kšžœ
žœžœ˜Kšœ	žœ˜!Kšœ	žœ ˜.Kšœžœžœ˜—K˜KšΠbl
œžœ
ž˜ Kšžœ˜Kšœž˜
head™Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜K˜Kšœžœ˜K˜Kšœ
žœΟc˜4Kšœžœ
 %˜>Kšœžœ˜K˜Kšœžœžœ
˜K˜šœ
žœžœ
ž	œ˜$Kš
œ	˜	Kšœ2 
˜?KšœG ˜UKšœ ˜*Kšœ
žœ
žœ ˜%Kš
œ˜K˜—Kšœ
žœž œ
˜)K˜šΟnœžœžœžœ˜5Kšœžœžœ6˜GKšžœžœžœ
žœžœ
žœ™KK™—š
‘œžœžœžœžœ
˜"Kš	œžœžœžœžœ˜EKšžœžœ™—K˜Kšœžœžœ˜šœžœžœ˜šžœž˜K˜Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kš
ž˜—K˜—K˜Kšœžœžœ
˜K˜Kšœžœžœ
žœ 0˜NK˜K˜šœ
žœžœž œ˜SKš
œ$™$K™—Kšœžœžœ˜šœžœžœžœ˜9K˜—Kšœ
žœžœ˜'šœžœžœ˜Kšœžœ  ˜,Kšœžœ
žœ˜.Kšœžœžœ˜1Kšœ
žœžœ˜=K˜—K˜Kšœ
žœžœ
˜!šœ
žœžœžœ˜=K˜—Kšœžœžœ˜+šœžœžœ˜!Kšœžœ 7˜CKšœžœ˜#Kš
œ˜—K˜Kšœžœžœ -˜Išœ
žœžœ˜Kšœ !˜7Kšœžœžœ˜,K˜K˜—K˜Kšœžœžœ ™3šœžœžœ™Kšœ ™!Kšœž™K™K™—K˜Kšœ	žœžœ
 ˜7šœžœžœ˜Kšœ ˜$Kšœ ˜/Kšœ !˜8Kšœ $˜4Kšœ #˜2Kšœ ˜K˜—K˜Kšœžœ˜Kšœžœžœ˜%Kšœžœžœžœ˜=Kšœžœžœ
žœ˜K˜Kšœ
žœžœ#˜:Kšœžœžœ˜#Kš
œžœžœžœžœžœ
žœ˜LK˜Kšœžœžœ %˜:šœžœžœ˜Kšœžœžœ /˜EKšœžœ
žœžœ !˜9Kšœžœ (˜@Kšœžœ &˜<Kšœ! ˜8Kšœžœ  ˜8Kšœžœ "˜>Kšœ ˜;Kšœ .˜HKšœ -˜JKšœžœ $˜BKšœ* #˜MKšœžœ ˜4Kšœžœ ˜1Kšœžœ
 ˜,K˜K˜——™
Kšœžœ
˜Kšœžœ
˜K˜K˜K˜!K˜#K˜%˜K˜—Kš‘œžœžœžœ˜>Kš‘œžœžœžœ˜.š‘
œžœžœžœ˜0K˜—Kš‘œžœžœžœ˜1Kš‘œžœ
žœ˜5Kš‘œžœ
žœžœ˜-Kš‘œžœžœ
˜5Kš‘œžœžœžœ
˜-š‘
œžœ
žœ
˜1K™*—K˜Kš‘œžœžœ˜/Kš‘œžœžœžœ˜'Kš‘
œžœžœ
˜+Kš‘œžœžœ˜3Kš‘
œžœžœ
˜+š‘œžœžœ˜/K™—K˜Kš‘œžœ
žœžœ˜$Kš‘œžœ
žœžœ˜(Kš‘œžœ
žœ˜'K˜Kš‘œžœžœ˜1Kš‘œžœžœ˜>Kš‘œžœžœžœ˜6Kš‘œžœ
žœ˜.K˜š‘œžœžœ
˜-K™+K˜—Kš
‘œžœžœ
žœžœ
˜Fš
‘	œžœžœ
žœžœ
˜KK™*K™@K™—Kš‘	œžœžœ
˜2K˜Kšœ
žœžœžœžœžœ˜Lš‘œžœžœžœ˜;K˜—Kš‘œžœžœ	žœ˜KKš‘œžœžœ˜4Kš
‘œžœžœžœ	žœ˜IKš‘œžœžœžœ˜2Kš‘œžœžœ	žœ˜MKš‘œžœžœ˜6K˜Kš‘œžœ
žœ˜-Kš‘œžœžœ˜4K˜š‘œžœ	žœ
˜/Kš
œ?™?Kš
œH™HK™—š‘œžœ
žœ	˜/K™@K™EK˜—š‘œžœ"žœ
˜IK™=K™—š‘œžœ/˜EKš
œ0™0K™=K™—Kš‘œžœžœžœ
˜-š‘œžœ
žœžœ˜-Kš
œU™UK™GK™—Kš‘œžœžœžœ
˜-š‘œžœ
žœžœ˜-K™RK™—Kš‘œžœ	žœžœ
žœžœ
˜YKš
‘œžœ	žœ#žœžœ
˜Zš‘œžœ
žœžœ
žœ
žœžœ	žœ˜qK™—š
‘
œžœ
žœ3žœ	žœF˜’
Kš
œ™—K˜K˜Kš‘œžœ˜$Kš‘œžœ˜*Kš‘œžœžœ˜&Kš‘œžœ˜.Kš‘œžœžœ˜&Kš‘œžœ˜2Kš‘
œžœ˜*š‘œžœ˜.K™#—K˜Kš‘œžœ
žœ˜'Kš‘œžœ
žœ
˜-Kš‘œžœ
žœžœ˜)Kš‘œžœ
žœ˜1Kš‘œžœ
žœžœ˜)Kš‘
œžœ
žœ˜5Kš‘	œžœ
žœ
˜-š‘œžœ
žœ˜1K™$—K˜Kš‘œžœ
žœ˜-Kš‘œžœ
˜Kš‘œžœ˜(Kš‘œžœ)˜3K˜Kš‘œžœ˜$Kš‘œžœ˜&Kš‘œžœ
žœ˜+Kš‘œžœ
žœ
˜3K˜š‘œžœžœ˜AK™J—K˜Kš‘œžœ
žœ
˜)Kš‘œžœžœ˜2Kš‘œžœ"˜,Kš‘œžœ
žœ
˜'K˜š‘œžœžœ˜'K™CK™—š‘	œžœžœ˜*K™8K™—š‘œžœžœ˜5K™DK™—K˜š‘œžœ˜)K™K™—š‘œžœ˜#K™K™—K˜š‘œžœ*žœ˜IK™K˜—š‘
œžœ
žœ˜/K™9K™—š‘œžœ
˜!K™ K™—š‘œžœ)˜=K™!K˜——K˜Kšžœ
˜—…—"š7ί