DIRECTORY
Basics USING [BITAND, BoundsCheckHighHalf, LowHalf, RawWords],
Imager USING [Color, Context, Font, PixelArray, Trajectory, Transformation],
ImagerBackdoor USING [Clipper],
ImagerFont USING [XChar, 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;

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

maxCardinal: 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
font(10), clipper(11) -- more Image types
};

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

BoundsCheckCardinal: PROC [i: INT] RETURNS [Cardinal]
~ INLINE { RETURN[Basics.BoundsCheckHighHalf[value: i, bound: 400B]] };
Even: PROC [i: Cardinal] RETURNS [BOOL]
~ INLINE { RETURN[Basics.BITAND[Basics.LowHalf[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],
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, $Char, $Decompressor, $ColorOperator, ...
do: PROC [op: Operator, state: Ref]
];

Transformation: TYPE ~ Imager.Transformation;
PixelArray: TYPE ~ Imager.PixelArray;
Color: TYPE ~ Imager.Color;
Trajectory: TYPE ~ Imager.Trajectory;
Outline: TYPE ~ REF OutlineRep;
OutlineRep: TYPE ~ RECORD [oddWrap: BOOL, seq: SEQUENCE size: NAT OF Trajectory];
Font: TYPE ~ Imager.Font;
Clipper: TYPE ~ ImagerBackdoor.Clipper;

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

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

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
contextFree: Context _ NIL, -- list of a few free contexts
contextFreeCount: INT _ 0, -- number of contexts on free list
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
stackMark: StackMark _ NIL, -- the top mark on the stack
stackMarkFree: StackMark _ NIL, -- list of a few free marks
stackMarkFreeCount: INT _ 0, -- number of marks on free list
imager: Imager.Context _ NIL -- imager state
];

Bug: ERROR;
MarkRecovery: ERROR;

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

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

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


CardinalFromReal: PROC [REAL] RETURNS [Cardinal];
CardinalFromNum: PROC [NumberRep] RETURNS [Cardinal];
RealFromNum: PROC [NumberRep] RETURNS [REAL];
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: XStringProc] RETURNS [Vector];
StringFromVector: PROC [v: Vector, charAction: 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: Op];
Do: PROC [self: Ref, op: Operator];

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


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

END.
ΚIPInterpreter.mesa
Copyright c 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
Michael Plass, June 5, 1985 11:23:59 am PDT
Doug Wyatt, October 14, 1986 5:09:27 pm PDT

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.

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

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
œ=™HK™+Kš
œ+™+—K™Kš
œ4™4K™š
Οk	˜	Kšœžœžœ*˜>Kšœžœ@˜LKšœžœ˜Kšœžœ!˜1Kšžœ
žœžœ˜Kšœ	žœ˜!Kšœ	žœ ˜.Kšœžœžœ˜—K˜KšΠbl
œžœ
ž˜ Kšžœ˜Kšœž˜
head™Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜K˜Kšœžœ˜Kšœžœ˜K˜Kšœ
žœΟc˜4Kšœžœ
 %˜>Kšœžœ˜K˜Kšœžœžœ
˜K˜šœ
žœžœ
ž	œ˜$Kš
œ	˜	Kšœ2 
˜?KšœG ˜UKšœ ˜)Kš
œ˜K˜—Kšœ
žœž œ
˜)K˜šΟnœžœžœžœ˜5Kšœžœžœ6˜GKšžœžœžœ
žœžœ
žœ™KK™—š‘œžœžœžœ
˜'Kšœžœžœžœ˜;Kšžœžœ™—K˜Kšœžœžœ˜šœžœžœ
˜šžœž˜K˜Kšœ
žœ˜Kšœžœ˜Kšœžœ˜Kš
ž˜—K˜—K˜Kšœžœžœ
˜K˜Kšœžœžœ
žœ 0˜NK˜K˜šœ
žœžœž œ˜RKš
œ$™$K™—Kšœžœžœ˜šœžœžœžœ˜8K˜—Kšœ
žœžœ˜'šœžœžœ
˜Kšœžœ  ˜,Kšœžœ
žœ˜.Kšœžœžœ˜1Kšœ
žœžœ˜>Kšœ	žœžœ	žœž˜PK˜—K˜Kšœ
žœžœ
˜!šœ
žœžœžœ˜<K˜—Kšœžœžœ˜+šœžœžœ
˜ Kšœžœ 7˜CKšœžœ˜#Kš
œ˜—K˜Kšœžœ˜-Kšœžœ˜%Kšœžœ˜Kšœžœ˜%šœ	žœžœ˜Kš
œžœžœžœžœžœ
žœ
˜Q—Kšœžœ˜Kšœ	žœ˜'K˜Kšœžœ˜Kšœžœ˜'Kšœ
žœ˜+K˜Kšœžœžœ -˜Išœ
žœžœ
˜Kšœ !˜7Kšœžœžœ˜,K˜—K˜K˜Kšœ	žœžœ
 ˜7šœžœžœ
˜Kšœ ˜$Kšœ ˜/Kšœ !˜8Kšœ ˜&Kšœ 6˜DKšœ ˜K˜—K˜Kšœžœ˜Kšœžœžœ˜%Kšœžœžœžœ˜<Kšœžœžœ
žœ˜Kšœžœžœ˜#šœžœžœ˜Kšœžœ
˜Kšœžœ˜Kš
œ˜Kš
œ˜—K˜Kšœžœžœ %˜:šœžœžœ
˜Kšœžœžœ /˜EKšœžœ
žœžœ  ˜8Kšœžœ (˜@Kšœžœ &˜<Kšœ! ˜8Kšœžœ ˜.Kšœžœ ˜:Kšœžœ "˜=Kšœžœ $˜BKšœ* #˜MKšœžœ ˜4Kšœžœ .˜CKšœžœ -˜EKšœžœ ˜8Kšœžœ ˜;Kšœžœ ˜<Kšœžœ
 ˜,K˜K˜——™
Kšœžœ
˜Kšœžœ
˜K˜š
‘œžœ	žœžœžœ˜>K˜—š‘œžœžœžœ˜2K˜—š‘
œžœžœžœ˜4K˜—K˜Kš‘œžœžœžœ˜1Kš‘œžœ
žœ˜5Kš‘œžœ
žœžœ˜-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˜—K˜š‘œžœžœ
˜>K™=K™—š‘œžœ$˜:Kš
œ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š‘œžœ˜2Kš‘
œžœ˜*Kš‘œžœ˜.K˜Kš‘œžœ
žœ˜'Kš‘œžœ
žœ
˜-Kš‘œžœ
žœžœ˜)Kš‘œžœ
žœ˜1Kš‘œžœ
žœžœ˜)Kš‘
œžœ
žœ˜5Kš‘	œžœ
žœ
˜-Kš‘œžœ
žœ˜1K˜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˜š‘
œžœ
žœ˜/K™9K™—š‘œžœ
˜!K™ K™—š‘œžœ)˜=K™!K˜—K˜Kš‘œžœ*žœ˜I—K˜Kšžœ
˜—…—#ά8<