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, Token, Op],
IPVector USING [Vector, VectorShape, Cardinal, Any],
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 ~ IPVector.Any;

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 ~ IPVector.Cardinal;

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 ~ IPVector.VectorShape; -- Upper bound "u" = lowerBound+size-1.
Vector: TYPE ~ IPVector.Vector;

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[
rope: ROPE _ NIL, -- the rope containing the encoding to be interpreted
index: INT _ 0, -- current position in the rope
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
Allan H. Wax November 25, 1986 5:32:51 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]
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™Kš
œ4™4K™š
ฯk	˜	Kšœžœžœ*˜>Kšœžœ@˜LKšœžœ˜Kšœžœ!˜1Kšžœ
žœžœ˜Kšœ	žœ˜!Kšœ	žœ&˜4Kšœ	žœ ˜.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˜Kšœ
žœ '˜QKšœžœ˜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šœžœžœ 5˜GKšœžœ ˜/Kšœžœ
žœžœ  ˜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šžœ
˜—…—"ฆ6€