IPInterpreter.mesa
Copyright © 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.
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
Types
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]] };
IF i IN[0..maxInteger] THEN RETURN[i] ELSE ERROR RuntimeError.BoundsFault;
Even: PROC [i: Integer] RETURNS [BOOL]
~ INLINE { RETURN[Basics.BITAND[Basics.LowHalf[i], 1]=0] };
RETURN[(i MOD 2)=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]--];
Upper bound "u" = lowerBound+size-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: STREAMNIL, -- input stream on the master being interpreted
buffer: REF TEXTNIL, -- 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
];
Operations
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];
Creates a Vector with n elements, all zero.
MakeVec: PROC [n: Integer, pop: PROC RETURNS [Any]] RETURNS [Vector];
MakeVecLU: PROC [l, u: Integer, pop: PROC RETURNS [Any]] RETURNS [Vector];
Creates a Vector with the specified shape.
Calls pop shape.n times to get the elements, last element first.
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];
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.
ArrayFromVector: PROC [Vector] RETURNS [Array];
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.
VectorFromString: PROC [string: XStringProc] RETURNS [Vector];
Makes a Vector of Integer from the characters of the string.
StringFromVector: PROC [v: Vector, charAction: XCharProc];
Calls charAction for each element of v in order.
Error if any element is not an integer that fits in an XChar.
VectorFromRope: PROC [ROPE] RETURNS [Vector];
RopeFromVector: PROC [Vector] RETURNS [ROPE];
These use VectorFromString and StringFromVector to convert between Vectors and ROPEs.
The rope uses the encoding scheme in the Xerox Character Code Standard.
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];
No sign extension is done.
UnsafeGetBits: UNSAFE PROC [vector: Vector, dst: PrincOps.BitAddress, start: INT, count: NAT, srcFunc: PrincOps.SrcFunc ← null, dstFunc: PrincOps.DstFunc ← null];
start and count deal in bits
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];
These push an element on the stack.
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];
These pop an element from the stack.
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];
Executes the action in a new context with specified frame, pool, and environment.
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];
Executes the action, then restores non-persistent pools.
DoSaveAll: PROC [self: Ref, action: PROC];
Executes the action, then restores all pools.
DoWithMarkProtection: PROC [self: Ref, action: PROC];
Executes < 0 MARK action UNMARK0 >, with mark recovery if necessary.
Apply: PROC [self: Ref, op: Op];
Executes a primitive.
Do: PROC [self: Ref, op: Operator];
Executes an Operator.
GetInlineBody: PROC [self: Ref] RETURNS [Body];
Reads a body from the master, recording it for later use.
SkipInlineBody: PROC [self: Ref];
Skips over a body in the master.
CallInlineBody: PROC [self: Ref, frame: Vector, pool: Pool, env: Vector];
Executes a body in a new context.
MakeCO: PROC [frame: Vector, pool: Pool, env: Vector, body: Body] RETURNS [Operator];
MakeCompiledImage: PROC [frame: Vector, env: Vector, body: Body] RETURNS [Operator];
END.