DIRECTORY
Basics USING [BITAND, BoundsCheckHighHalf, LowHalf, RawWords],
Imager USING [Context],
ImagerColorDefs USING [Color],
ImagerFont USING [Font, XChar, XCharProc, XStringProc],
ImagerPath USING [Outline, Trajectory],
ImagerPixelArrayDefs USING [PixelArray],
ImagerTransformation USING [Transformation],
IO USING [STREAM],
IPMaster USING [Body, ErrorClass, ImagerVariable, Op, Token],
PrincOps USING [BitAddress, DstFunc, SrcFunc],
Rope USING [ROPE],
Vector2 USING [VEC];

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

Op: TYPE ~ IPMaster.Op;
ImagerVariable: TYPE ~ IPMaster.ImagerVariable;
Body: TYPE ~ IPMaster.Body;

maxInteger: INT ~ 77777777B; -- 2^24 - 1 = 16777215
maxVecSize: NAT ~ 30000; -- 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
(CARDINAL.LAST) -- room for lots more
};

Integer: TYPE ~ INT--[0..maxInteger]--;

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

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

Identifier: TYPE ~ REF IdentifierRep;
IdentifierRep: TYPE ~ RECORD[atom: ATOM, rope: ROPE];

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

VectorShape: TYPE ~ RECORD[lowerBound: Integer, size: INT--[0..maxInteger+1]--];
Vector: TYPE ~ REF VectorRep;
VectorRep: TYPE ~ RECORD[class: VectorClass, data: REF, font: Font _ NIL];

VectorClass: TYPE ~ REF VectorClassRep;
VectorClassRep: TYPE ~ RECORD[
type: ATOM, -- $Array, $Merged, $Font, $String, ...
shape: PROC [v: Vector] RETURNS [VectorShape],
get: PROC [v: Vector, i: Integer] RETURNS [Any],
getInteger: PROC [v: Vector, i: Integer] RETURNS [Integer],
getProp: PROC [v: Vector, propName: Any] RETURNS [found: BOOL, value: Any] _ NIL
];

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

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

VEC: TYPE ~ Vector2.VEC;
Transformation: TYPE ~ ImagerTransformation.Transformation;
PixelArray: TYPE ~ ImagerPixelArrayDefs.PixelArray;
Color: TYPE ~ ImagerColorDefs.Color;
Trajectory: TYPE ~ ImagerPath.Trajectory;
Outline: TYPE ~ ImagerPath.Outline;

Font: TYPE ~ ImagerFont.Font;
XChar: TYPE ~ ImagerFont.XChar;
XCharProc: TYPE ~ ImagerFont.XCharProc;
XStringProc: TYPE ~ ImagerFont.XStringProc;

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

Pool: TYPE ~ REF PoolRep; -- a pool operator, from MAKEPOOL or NOPOOL
PoolRep: TYPE ~ RECORD[
persistent: BOOL,
level: NAT _ 0,
array: Array
];

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
initialFrame: Vector, -- initial frame
frame: Array, -- current frame (NIL if unchanged from initial frame)
pool: Pool, -- shared pool
env: Vector -- environment
];

stackArraySize: NAT ~ 8;
StackArray: TYPE ~ REF StackArrayRep;
StackArrayRep: TYPE ~ ARRAY[0..stackArraySize) OF NumberRep;
StackList: TYPE ~ LIST OF Any;
StackMark: TYPE ~ RECORD[count: INT _ 0, marker: Marker _ nullMarker];
StackMarkList: TYPE ~ LIST OF StackMark;

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, -- text buffer for 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 context
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
stackCount: INT _ 0, -- number of stack elements above the top mark
stackCountMax: INT _ 0, -- maximum count permitted above the top mark
stackMarkList: StackMarkList _ NIL, -- marks on the stack
imager: Imager.Context _ NIL, -- imager state
showVec: Vector _ NIL -- current showVec
];

Bug: ERROR;
MarkRecovery: ERROR;

ErrorClass: TYPE ~ IPMaster.ErrorClass;

ReportError: PROC [class: ErrorClass, code: ATOM, explanation: ROPE];

MasterError: PROC [code: ATOM, explanation: ROPE];

MasterWarning: PROC [code: ATOM, explanation: ROPE];


IntegerFromReal: PROC [REAL] RETURNS [Integer];
IntegerFromNum: PROC [NumberRep] RETURNS [Integer];
RealFromNum: PROC [NumberRep] RETURNS [REAL];
IntegerFromAny: PROC [Any] RETURNS [Integer];
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];
TransformationFromAny: PROC [Any] RETURNS [Transformation];
PixelArrayFromAny: PROC [Any] RETURNS [PixelArray];
ColorFromAny: PROC [Any] RETURNS [Color];
TrajectoryFromAny: PROC [Any] RETURNS [Trajectory];
OutlineFromAny: PROC [Any] RETURNS [Outline];

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: Integer] RETURNS [Any];
GetInteger: PROC [v: Vector, i: Integer] RETURNS [Integer];
GetReal: PROC [v: Vector, i: Integer] RETURNS [REAL];
Shape: PROC [v: Vector] RETURNS [VectorShape];

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

MakeVec: PROC [n: Integer, pop: PROC RETURNS [Any]] RETURNS [Vector];
MakeVecLU: PROC [l, u: Integer, pop: PROC RETURNS [Any]] RETURNS [Vector];
MergeProp: PROC [v1, v2: Vector] RETURNS [Vector];
GetProp: PROC [v: Vector, propName: Any] RETURNS [found: BOOL, value: Any];
GetP: PROC [v: Vector, propName: Any] RETURNS [Any];

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

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


VectorFromString: PROC [string: XStringProc] RETURNS [Vector];
StringFromVector: PROC [v: Vector, charAction: XCharProc];
VectorFromRope: PROC [ROPE] RETURNS [Vector];
RopeFromVector: 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];
PushInteger: PROC [self: Ref, val: Integer];
PushReal: PROC [self: Ref, val: REAL];
PushVec: PROC [self: Ref, val: VEC];
PushIdentifier: PROC [self: Ref, val: Identifier];
PushVector: PROC [self: Ref, val: Vector];
PushOperator: PROC [self: Ref, val: Operator];
PushTransformation: PROC [self: Ref, val: Transformation];
PushPixelArray: PROC [self: Ref, val: PixelArray];
PushColor: PROC [self: Ref, val: Color];
PushTrajectory: PROC [self: Ref, val: Trajectory];
PushOutline: PROC [self: Ref, val: Outline];

PopAny: PROC [self: Ref] RETURNS [Any];
PopNum: PROC [self: Ref] RETURNS [NumberRep];
PopBool: PROC [self: Ref] RETURNS [BOOL];
PopInteger: PROC [self: Ref] RETURNS [Integer];
PopReal: PROC [self: Ref] RETURNS [REAL];
PopVec: PROC [self: Ref] RETURNS [VEC];
PopIdentifier: PROC [self: Ref] RETURNS [Identifier];
PopVector: PROC [self: Ref] RETURNS [Vector];
PopOperator: PROC [self: Ref] RETURNS [Operator];
PopTransformation: PROC [self: Ref] RETURNS [Transformation];
PopPixelArray: PROC [self: Ref] RETURNS [PixelArray];
PopColor: PROC [self: Ref] RETURNS [Color];
PopTrajectory: PROC [self: Ref] RETURNS [Trajectory];
PopOutline: PROC [self: Ref] RETURNS [Outline];

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

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

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

Frame: PROC [self: Ref] RETURNS [Vector];
FGet: PROC [self: Ref, i: Integer] RETURNS [Any];
FSet: PROC [self: Ref, x: Any, i: Integer];
PoolOp: PROC [self: Ref] RETURNS [Pool];
PGet: PROC [self: Ref, i: Integer] RETURNS [Any];
PSet: PROC [self: Ref, x: Any, i: Integer];
Env: PROC [self: Ref] RETURNS [Vector];

MakePool: PROC [v: Vector, persistent: BOOL] RETURNS [Pool];
NoPool: PROC RETURNS [Pool];
PoolFromOperator: PROC [Operator] RETURNS [Pool];
OperatorFromPool: PROC [Pool] RETURNS [Operator];
VectorFromPool: PROC [Pool] 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: Op];
Do: PROC [self: Ref, op: Operator];

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


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

END.
¦IPInterpreter.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Doug Wyatt, May 31, 1985 11:55:49 am PDT
Michael Plass, June 5, 1985 11:23:59 am PDT

Types and operations for the Interpress interpreter.

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

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

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

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, pool, and environment.
Executes the action, then restores non-persistent pools.

Executes the action, then restores all pools.

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

Executes a primitive.

Executes an 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.
Κβ˜
codeš
œ™Kšœ
Οm
œ7™BKš
œ(™(K™+—K™Kš
œ4™4K™š
Οk	˜	Kšœžœžœ*˜>Kšœžœ˜Kšœžœ	˜Kšœžœ'˜7Kšœžœ˜'Kšœžœ˜(Kšœžœ˜,Kšžœ
žœžœ˜Kšœ	žœ/˜=Kšœ	žœ ˜.Kšœžœžœ˜Kšœžœžœ˜—K˜KšΠbl
œžœ
ž˜ Kšžœ˜Kšœž˜
head™Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜K˜Kšœžœ˜Kšœžœ˜/Kšœžœ˜K˜KšœžœΟc˜3Kšœžœ
 %˜>Kšœžœ˜K˜Kšœžœžœ
˜K˜šœ
žœžœ
ž	œ˜$Kš
œ	˜	Kšœ2 
˜?KšœG ˜UKšœ
žœ
žœ ˜%Kš
œ˜K˜—Kšœ	žœž œ
˜'K˜šΟnœžœžœžœ
˜3Kšœžœžœ6˜GKšžœžœžœ
žœžœ
žœ™JK™—š‘œžœžœžœ
˜&Kšœžœžœžœ˜;Kšžœžœ™—K˜Kšœžœžœ˜šœžœžœ
˜šžœž˜K˜Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kš
ž˜—K˜—K˜Kšœžœžœ˜%Kš	œžœžœžœžœ˜5K˜Kšœžœžœ
žœ 0˜NK˜K˜šœ
žœžœž œ˜PKš
œ$™$K™—Kšœžœžœ˜š	œžœžœžœžœ˜JK˜—Kšœ
žœžœ˜'šœžœžœ
˜Kšœžœ '˜3Kšœžœ
žœ˜.Kšœžœžœ˜0Kšœžœžœ˜;Kšœ	žœžœ	žœž˜PK˜—K˜Kšœ
žœžœ
˜!šœ
žœžœžœ˜<K˜—Kšœžœžœ˜+šœžœžœ
˜ Kšœžœ >˜JKšœžœ˜#Kš
œ˜—K˜Kšžœžœžœ
˜Kšœžœ'˜;Kšœžœ#˜3Kšœžœ˜$Kšœžœ˜)Kšœ	žœ˜#K˜Kšœžœ˜Kšœžœ˜Kšœžœ˜'Kšœ
žœ˜+K˜Kšœžœžœ 5˜Qšœ
žœžœ
˜Kšœ !˜6Kšœžœžœ˜,K˜—K˜Kš	œžœžœ
 ž ž˜Ešœ	žœžœ
˜Kšœžœ
˜Kšœžœ˜K˜K˜—K˜Kšœ	žœžœ
 ˜7šœžœžœ
˜Kšœ ˜$Kšœ ˜/Kšœ !˜8Kšœ ˜&Kšœ 6˜DKšœ ˜Kšœ ˜K˜—K˜Kšœžœ˜Kšœžœžœ˜%Kšœžœžœžœ˜<Kšœžœžœ
žœ˜Kšœžœžœžœ#˜FKšœžœžœ
žœ˜(K˜Kšœžœžœ %˜:šœžœžœ
˜Kšœžœžœ /˜EKšœžœ
žœžœ  ˜8Kšœžœ (˜@Kšœžœ &˜<Kšœ! ˜8Kšœžœ ˜.Kšœžœ $˜BKšœ* #˜MKšœžœ ˜4Kšœžœ .˜CKšœžœ -˜EKšœžœ ˜9Kšœžœ ˜-Kšœžœ
 ˜(K˜K˜——™
Kšœžœ
˜Kšœžœ
˜K˜šœžœ˜'K˜—š‘œžœžœžœ˜EK˜—š‘œžœžœžœ˜2K˜—š‘
œžœžœžœ˜4K˜—K˜Kš‘œžœžœžœ˜/Kš‘œžœ
žœ˜3Kš‘œžœ
žœžœ˜-Kš‘œžœžœ˜-Kš‘œžœžœžœ˜'Kš‘
œžœžœ
˜+Kš‘œžœžœ˜3Kš‘
œžœžœ
˜+Kš‘œžœžœ˜/Kš‘œžœžœ˜;Kš‘œžœžœ˜3Kš‘œžœžœ	˜)Kš‘œžœžœ˜3Kš‘œžœžœ˜-K˜Kš‘œžœ
žœžœ˜$Kš‘œžœ
žœžœ˜(Kš‘œžœ
žœ˜'K˜Kš‘œžœžœ˜0Kš‘
œžœžœ˜;Kš‘œžœžœžœ˜5Kš‘œžœ
žœ˜.K˜š‘œžœžœ
˜,K™+K˜—Kš
‘œžœžœ
žœžœ
˜Eš
‘	œžœžœ
žœžœ
˜JK™*K™@—K™Kš‘	œžœžœ
˜2Kš‘œžœžœ	žœ˜KKš‘œžœžœ˜4K˜Kš‘œžœ
žœ˜,Kš‘œžœžœ˜3K˜š‘œžœ	žœ
˜/Kš
œ?™?Kš
œH™HK™—š‘œžœ
žœ	˜/K™@K™EK˜—K˜š‘œžœžœ
˜>K™<K™—š‘œžœ$˜:Kš
œ0™0K™=K™—Kš‘œžœžœžœ
˜-š‘œžœ
žœžœ˜-Kš
œU™UK™GK™—Kš‘œžœ	žœžœ
žœžœ
˜YKš
‘œžœ	žœ#žœžœ
˜Zš‘œžœ
žœžœ
žœ
žœžœ	žœ˜qK™—š
‘
œžœ
žœ3žœ	žœF˜’
Kš
œ™—K˜Kš‘œžœ˜$Kš‘œžœ˜*Kš‘œžœžœ˜&Kš‘œžœ˜,Kš‘œžœžœ˜&Kš‘œžœžœ˜$Kš‘œžœ˜2Kš‘
œžœ˜*Kš‘œžœ˜.Kš‘œžœ"˜:Kš‘œžœ˜2Kš‘	œžœ˜(Kš‘œžœ˜2š‘œžœ˜,K™#—K˜Kš‘œžœ
žœ˜'Kš‘œžœ
žœ
˜-Kš‘œžœ
žœžœ˜)Kš‘
œžœ
žœ˜/Kš‘œžœ
žœžœ˜)Kš‘œžœ
žœžœ˜'Kš‘
œžœ
žœ˜5Kš‘	œžœ
žœ
˜-Kš‘œžœ
žœ˜1Kš‘œžœ
žœ˜=Kš‘
œžœ
žœ˜5Kš‘œžœ
žœ	˜+Kš‘
œžœ
žœ˜5š‘
œžœ
žœ˜/K™$—K˜Kš‘œžœ
žœ˜-Kš‘œžœ
˜Kš‘œžœ˜'Kš‘œžœ(˜2K˜Kš‘œžœ˜#Kš‘œžœ˜%Kš‘œžœ
žœ˜*Kš‘œžœ
žœ
˜3K˜š‘œžœžœ*˜MK™Q—K˜Kš‘œžœ
žœ
˜)Kš‘œžœžœ˜1Kš‘œžœ!˜+Kš‘œžœ
žœ˜(Kš‘œžœžœ˜1Kš‘œžœ!˜+Kš‘œžœ
žœ
˜'K˜Kš‘œžœžœžœ˜<Kš‘œžœ
žœ˜Kš‘œžœžœ˜1Kš‘œžœžœ˜1Kš‘œžœžœ
˜-K˜š‘œžœžœ˜'K™8K™—š‘	œžœžœ˜*K™-K™—š‘œžœžœ˜5K™DK™—K˜š‘œžœ˜ K™K™—š‘œžœ˜#K™K™—K˜š‘
œžœ
žœ˜/K™9K™—š‘œžœ
˜!K™ K™—š‘œžœ5˜IK™!K˜—K˜Kš‘œžœ6žœ˜UKš‘œžœ*žœ˜T—K˜Kšžœ
˜—…—'ΰ=h