IPExecImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, November 30, 1984 4:53:40 pm PST
DIRECTORY
FS USING [StreamOpen],
Imager USING [Context, DoSave, DoSaveAll, ShowText],
Interpress USING [],
IO USING [GetIndex, PutF, PutFR, rope, SetIndex, STREAM],
IPImager,
IPInterpreter,
IPMaster USING [Block, Body, BodyRep, BYTE, GetByte, GetHeader, GetInteger, GetRational, GetRope, GetSkeleton, GetText, GetToken, Node, NodeRep, Skeleton, SkipBytes, SkipToEndOfBody, Token],
List USING [AList, Assoc, PutAssoc],
ProcessProps USING [AddPropList, GetPropList],
Rope USING [FromRefText, ROPE];
IPExecImpl: CEDAR PROGRAM
IMPORTS FS, IO, Imager, IPImager, IPInterpreter, IPMaster, List, ProcessProps, Rope
EXPORTS Interpress, IPInterpreter
~ BEGIN OPEN IPInterpreter;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Token: TYPE ~ IPMaster.Token;
Body: TYPE ~ IPMaster.Body;
Block: TYPE ~ IPMaster.Block;
Node: TYPE ~ IPMaster.Node;
NodeRep: TYPE ~ IPMaster.NodeRep;
BYTE: TYPE ~ IPMaster.BYTE;
Error: PUBLIC ERROR ~ CODE;
Bug: PUBLIC ERROR ~ CODE;
stateKey: ATOM ~ $InterpressState;
AddState:
PUBLIC
PROC[state: State, inner:
PROC] ~ {
aList: List.AList ← NIL;
aList ← List.PutAssoc[key: stateKey, val: state, aList: aList];
ProcessProps.AddPropList[aList, inner];
};
GetState:
PUBLIC
PROC
RETURNS[State] ~ {
aList: List.AList ~ ProcessProps.GetPropList[];
value: REF ~ List.Assoc[key: stateKey, aList: aList];
WITH value SELECT FROM state: State => RETURN[state]; ENDCASE;
RETURN[NIL];
};
MasterError:
PUBLIC
PROC[type: MasterErrorType, explanation:
ROPE ←] ~ {
self: State ~ GetState[];
IF self.log#NIL THEN self.log.PutF["Master Error: %g\n", IO.rope[explanation]];
ERROR Error;
};
MasterWarning:
PUBLIC
PROC[type: MasterWarningType, explanation:
ROPE ←] ~ {
self: State ~ GetState[];
IF self.log#NIL THEN self.log.PutF["Master Warning: %g\n", IO.rope[explanation]];
};
GetIdentifier:
PROC[stream:
STREAM, length:
INT]
RETURNS[Identifier] ~ {
rope: ROPE ~ IPMaster.GetRope[stream, length];
RETURN[IdentifierFromRope[rope]];
};
GetLargeVector:
PROC[stream:
STREAM, length:
INT]
RETURNS[Vector] ~ {
IF length>0
THEN {
b: BYTE ~ IPMaster.GetByte[stream]; -- bytes per element
RETURN[IPImager.MakeLargeVector[stream: stream, length: length-1, bytesPerElement: b]];
}
ELSE {
MasterError[$invalidArgs--???--, "invalid largeVector token"];
ERROR Error;
};
};
GetPixelVector:
PROC[stream:
STREAM, length:
INT]
RETURNS[Vector] ~ {
RETURN[IPImager.MakeLargeVector[stream, length, 2]];
};
DoInsertFile:
PROC[self: State, file:
ROPE] ~ {
MasterWarning[$unimplemented, IO.PutFR["Ignoring Insertfile[%g].", IO.rope[file]]];
};
ExecuteToEndOfBody:
PROC[self: State] ~ {
Executes tokens, starting at the current stream index.
Returns when endBody is encountered.
May raise Error.
stream: STREAM ~ self.stream;
DO token: Token ~ IPMaster.GetToken[stream];
self.context.index ← token.index;
SELECT token.type
FROM
$op => IF token.op=$endBody THEN EXIT ELSE Apply[self, token.op];
$number => PushInt[self, token.number];
$integer => PushReal[self, IPMaster.GetInteger[stream, token.length]];
$rational => PushReal[self, IPMaster.GetRational[stream, token.length]];
$identifier => PushIdentifier[self, GetIdentifier[stream, token.length]];
$string => {
string: REF TEXT ← IPMaster.GetText[stream, token.length, self.buffer];
IF self.showVec=
NIL
THEN {
peek: Token ~ IPMaster.GetToken[stream];
self.context.index ← peek.index;
IF peek.op=$show THEN { Imager.ShowText[self.imager, string]; string ← NIL }
ELSE { IO.SetIndex[stream, peek.index]; self.context.index ← token.index };
};
IF string#NIL THEN PushVector[self, VectorFromString[Rope.FromRefText[string]]];
};
$insertFile => DoInsertFile[self, IPMaster.GetRope[stream, token.length]];
$comment => IPMaster.SkipBytes[stream, token.length]; -- shouldn't occur
$largeVector => PushVector[self, GetLargeVector[stream, token.length]];
$packedPixelVector => {
PushVector[self, GetPixelVector[stream, token.length]];
Do[self, IPImager.FindDecompressor[self, "Xerox/packed"]];
};
ENDCASE => {
IPMaster.SkipBytes[stream, token.length];
MasterWarning[$unknownToken, "unrecognized token type"];
};
ENDLOOP;
};
BeginBody:
PROC[stream:
STREAM]
RETURNS[
INT] ~ {
token: Token ~ IPMaster.GetToken[stream];
IF token.op=$beginBody THEN RETURN[token.index];
IO.SetIndex[stream, token.index]; -- back up so we'll read it again
MasterError[$missingBody, "missing {"];
ERROR Error;
};
SkipInlineBody:
PUBLIC
PROC[self: State] ~ {
stream: STREAM ~ self.stream;
index: INT ~ BeginBody[stream];
IPMaster.SkipToEndOfBody[stream];
};
GetInlineBody:
PUBLIC
PROC[self: State]
RETURNS[Body] ~ {
stream: STREAM ~ self.stream;
index: INT ~ BeginBody[stream];
IPMaster.SkipToEndOfBody[stream];
RETURN[NEW[IPMaster.BodyRep ← [index: index, length: IO.GetIndex[stream]-index]]];
};
ExecuteInlineBody:
PROC[self: State] ~ {
stream: STREAM ~ self.stream;
self.context.index ← BeginBody[stream];
DO error:
BOOL ←
FALSE;
ExecuteToEndOfBody[self !
Error => { IO.SetIndex[stream, self.context.index]; error ← TRUE; CONTINUE };
];
IF error
THEN {
-- mark recovery
marker: Marker ~ PopToActiveMark[self];
IF marker=self.context.marker
THEN
DO
token: Token ~ IPMaster.GetToken[stream];
SELECT token.op
FROM
$unmark0 => { Unmark0[self]; EXIT };
$beginBody => IPMaster.SkipToEndOfBody[stream];
$endBody => ERROR Error;
ENDCASE => IPMaster.SkipBytes[stream, token.length];
ENDLOOP
ELSE { IPMaster.SkipToEndOfBody[stream]; ERROR Error };
}
ELSE EXIT;
ENDLOOP;
};
PopToActiveMark:
PROC[self: State]
RETURNS[Marker] ~ {
DO marker: Marker ~ PopToMark[self];
-- this leaves a mark on top of the stack
FOR context: Context ← self.context, context.caller
UNTIL context=
NIL
DO
IF context.marker=marker THEN RETURN[marker]; -- context still exists
ENDLOOP;
RemoveMark[self, marker]; -- remove orphaned mark and try again
ENDLOOP;
};
Call:
PUBLIC
PROC[self: State, action:
PROC, frame: Vector, pool: Pool, env: Vector] ~ {
caller: Context ~ self.context;
context: Context ~
NEW[ContextRep ← [caller: caller, marker: self.lastMarker+1,
index: 0, initialFrame: frame, frame: NIL, pool: pool, env: env]];
self.context ← context;
self.lastMarker ← context.marker;
action[! UNWIND => self.context ← caller];
self.context ← caller;
};
CallInlineBody:
PUBLIC
PROC[self: State,
frame: Vector ← NIL, pool: Pool ← NIL, env: Vector ← NIL] ~ {
execute: PROC ~ { ExecuteInlineBody[self] };
Call[self: self, action: execute,
frame: IF frame=NIL THEN Frame[self] ELSE frame,
pool: IF pool=NIL THEN noPool ELSE pool,
env: IF env=NIL THEN Env[self] ELSE env];
};
CallBody:
PROC[self: State, body: Body, frame: Vector, pool: Pool, env: Vector] ~ {
stream: STREAM ~ self.stream;
next: INT ~ IO.GetIndex[stream];
IO.SetIndex[stream, body.index];
CallInlineBody[self: self, frame: frame, pool: pool, env: env
! UNWIND => IO.SetIndex[stream, next]];
IO.SetIndex[stream, next];
};
Frame:
PUBLIC
PROC[self: State]
RETURNS[Vector] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN RETURN[context.initialFrame]
ELSE RETURN[VectorFromArray[context.frame]];
};
FGet:
PUBLIC
PROC[self: State, j: Integer]
RETURNS[Any] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN RETURN[Get[context.initialFrame, j]]
ELSE { array: Array ~ context.frame; RETURN[array[j-array.l]] };
};
FSet:
PUBLIC
PROC[self: State, x: Any, j: Integer] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN context.frame ← ArrayFromVector[context.initialFrame];
{ array: Array ~ context.frame; array[j-array.l] ← x };
};
PoolOp:
PUBLIC
PROC[self: State]
RETURNS[Pool] ~ {
RETURN[self.context.pool] };
PGet:
PUBLIC
PROC[self: State, j: Integer]
RETURNS[Any] ~ {
context: Context ~ self.context;
array: Array ~ context.pool.array;
RETURN[array[j-array.l]];
};
PSet:
PUBLIC
PROC[self: State, x: Any, j: Integer] ~ {
context: Context ~ self.context;
array: Array ~ context.pool.array;
-- SavePool[self, pool, ...]; --
array[j-array.l] ← x;
};
Env:
PUBLIC
PROC[self: State]
RETURNS[Vector] ~ {
RETURN[self.context.env];
};
MakePool:
PUBLIC
PROC[v: Vector, persistent:
BOOL]
RETURNS[Pool] ~ {
RETURN[NEW[PoolRep ← [persistent: persistent, array: ArrayFromVector[v]]]];
};
MakeNullVec:
PROC[shape: VectorShape]
RETURNS[Vector] ~ {
null: PROC RETURNS[Any] ~ { RETURN[NIL] };
RETURN[MakeVec[shape, null]];
};
emptyVec: Vector ~ MakeNullVec[shape: [l: 0, n: 0]];
noPool: Pool ~ MakePool[v: emptyVec, persistent: FALSE];
NoPool:
PUBLIC
PROC
RETURNS[Pool] ~ {
RETURN[noPool] };
VectorFromPool:
PUBLIC
PROC[pool: Pool]
RETURNS[Vector] ~ {
RETURN[VectorFromArray[pool.array]];
};
poolClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $Pool, do: PoolDo]];
PoolDo:
PROC[op: Operator, state: State] ~ {
pool: Pool ~ NARROW[op.data];
PushVector[state, VectorFromPool[pool]];
};
OperatorFromPool:
PUBLIC
PROC[pool: Pool]
RETURNS[Operator] ~ {
RETURN[NEW[OperatorRep ← [class: poolClass, data: pool]]];
};
PoolFromOperator:
PUBLIC
PROC[op: Operator]
RETURNS[Pool] ~ {
IF op.class.type=$Pool
THEN
WITH op.data
SELECT
FROM
pool: Pool => RETURN[pool];
ENDCASE => ERROR Bug;
MasterError[$wrongType, "Operator is not a Pool."];
ERROR Error;
};
composedClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $Composed, do: ComposedDo]];
ComposedData: TYPE ~ REF ComposedDataRep;
ComposedDataRep:
TYPE ~
RECORD[
frame: Vector, -- initial frame
pool: Pool, -- shared pool
env: Vector, -- environment
body: Body -- body of the operator
];
ComposedDo:
PROC[op: Operator, state: State] ~ {
data: ComposedData ~ NARROW[op.data];
CallBody[self: state, body: data.body, frame: data.frame, pool: data.pool, env: data.env];
};
MakeCO:
PUBLIC
PROC[frame: Vector, pool: Pool, env: Vector, body: Body]
RETURNS[Operator] ~ {
data: ComposedData ~
NEW[ComposedDataRep ← [
frame: frame, pool: pool, env: env, body: body]];
RETURN[NEW[OperatorRep ← [class: composedClass, data: data]]];
};
compiledImageClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $CompiledImage, do: CompiledImageDo]];
CompiledImageData: TYPE ~ REF CompiledImageDataRep;
CompiledImageDataRep:
TYPE ~
RECORD[frame: Vector, env: Vector, body: Body];
CompiledImageDo:
PROC[op: Operator, state: State] ~ {
data: CompiledImageData ~ NARROW[op.data];
CallBody[self: state, body: data.body, frame: data.frame, pool: noPool, env: data.env];
};
MakeCompiledImage:
PUBLIC
PROC[frame: Vector, env: Vector, body: Body]
RETURNS[Operator] ~ {
data: CompiledImageData ~
NEW[CompiledImageDataRep ← [
frame: frame, env: env, body: body]];
RETURN[NEW[OperatorRep ← [class: compiledImageClass, data: data]]];
};
Do:
PUBLIC
PROC[self: State, op: Operator] ~ { op.class.do[op, self] };
DoSave:
PUBLIC
PROC[self: State, action:
PROC] ~ {
Eventually, this should worry about pools other than the Imager pool
showVec: Vector ~ self.showVec;
Imager.DoSave[self.imager, action ! UNWIND => self.showVec ← showVec];
self.showVec ← showVec;
};
DoSaveAll:
PUBLIC
PROC[self: State, action:
PROC] ~ {
Eventually, this should worry about pools other than the Imager pool
showVec: Vector ~ self.showVec;
Imager.DoSaveAll[self.imager, action ! UNWIND => self.showVec ← showVec];
self.showVec ← showVec;
};
DoProtected:
PUBLIC
PROC[self: State, action:
PROC] ~ {
error: BOOL ← FALSE;
Mark[self, 0];
action[! Error => { error ← TRUE; CONTINUE}];
IF error
THEN {
-- do mark recovery
marker: Marker ~ PopToActiveMark[self];
IF marker#self.context.marker THEN ERROR Error;
};
Unmark0[self];
};
CallPreamble:
PROC[self: State, node: Node, frame: Vector, env: Vector] ~ {
WITH node
SELECT
FROM
node:
REF NodeRep.body => {
preamble:
PROC ~ {
Mark[self, 0];
ExecuteInlineBody[self];
IF Count[self]<1 THEN Apply[self, $env];
IF Count[self]<2 THEN Apply[self, $frame];
Unmark[self, 2];
};
IO.SetIndex[self.stream, node.body.index];
Call[self: self, action: preamble, frame: frame, pool: noPool, env: env];
};
node: REF NodeRep.block => {
MasterError[$unimplemented, "Preamble cannot be a block."];
ERROR Error;
};
ENDCASE => ERROR;
};
CallNode:
PROC[self: State, node: Node, frame: Vector, env: Vector] ~ {
WITH node
SELECT
FROM
node:
REF NodeRep.body => {
body: Body ~ node.body;
IO.SetIndex[self.stream, body.index];
CallInlineBody[self: self, frame: frame, pool: noPool, env: env];
};
node: REF NodeRep.block => {
block: Block ~ node.block;
pageFrame, pageEnv: Vector;
CallPreamble[self, block.preamble, frame, env];
pageFrame ← PopVector[self];
pageEnv ← PopVector[self];
FOR i: NAT IN[0..block.size) DO
CallNode[self, block[i], pageFrame, pageEnv];
ENDLOOP;
};
ENDCASE => ERROR;
};
topFrameSize: Integer ~ 50;
topFrame: Vector ~ MakeNullVec[[l: 0, n: topFrameSize]];
topEnv: Vector ~ MakeNullVec[[l: 0, n: 0]]; -- empty vector, for now
DoTopAction:
PROC[self: State, action:
PROC] ~ {
protect: PROC ~ { DoProtected[self, action] };
call: PROC ~ { Call[self, protect, emptyVec, noPool, emptyVec] };
save: PROC ~ { IF self.imager=NIL THEN call ELSE DoSaveAll[self, call] };
AddState[self, save];
};
Rep: PUBLIC TYPE ~ StateRep; -- exported to Interpress
DoPreamble:
PROC[self: State] ~ {
block: Block ~ self.skeleton.topBlock;
action:
PROC ~ {
CallPreamble[self: self, node: block.preamble, frame: topFrame, env: topEnv];
self.topFrame ← PopVector[self];
self.topEnv ← PopVector[self];
};
DoTopAction[self, action];
};
defaultMaxStackLength: Integer ~ 1000;
Open:
PUBLIC
PROC[fileName:
ROPE]
RETURNS[State] ~ {
stream: STREAM ~ FS.StreamOpen[fileName];
suffix: ROPE ~ IPMaster.GetHeader[stream];
skeleton: IPMaster.Skeleton ~ IPMaster.GetSkeleton[stream];
self: State ~ NEW[StateRep ← [stream: stream, skeleton: skeleton]];
self.stack ← NewStack[defaultMaxStackLength];
self.buffer ← NEW[TEXT[200]];
self.imager ← imager; -- dummy imager context
DoPreamble[self];
RETURN[self];
};
Pages:
PUBLIC
PROC[self: State]
RETURNS[
NAT] ~ {
block: Block ~ self.skeleton.topBlock;
RETURN[block.size];
};
DoPage:
PUBLIC
PROC[self: State, page:
NAT, context: Imager.Context, log:
IO.
STREAM] ~ {
block: Block ~ self.skeleton.topBlock;
IF page
IN[1..block.size]
THEN {
node: Node ~ block[page-1];
action:
PROC ~ {
CallNode[self: self, node: node, frame: self.topFrame, env: self.topEnv];
};
self.imager ← context; self.log ← log;
DoTopAction[self, action];
self.imager ← NIL; self.log ← NIL;
};
};
END.
ObtainExternalInstructions: PROC[self: State] RETURNS[Vector] ~ {
RETURN[VectorFromAny[GetP[Env[self], $externalInstructions]]];
};
AddInstructionDefaults: PROC[self: State, computedInstructions, externalInstructions: Vector]
RETURNS[Vector] ~ {
RETURN[computedInstructions]
};
ExecuteInstructionsBody: PROC[self: State, externalInstructions: Vector] RETURNS[Vector] ~ {
body: Index ~ self.skeleton.preamble.instructions;
IF body=nullIndex THEN RETURN[externalInstructions]
ELSE {
reader: Reader ~ NARROW[self.reader];
PushVector[self, externalInstructions];
reader.SetIndex[body];
DoBody[self, NoPool[], initialTopFrame, $saveAll];
WHILE Count[self]>1 DO Apply[self, $mergeprop] ENDLOOP;
RETURN[PopVector[self]];
};
};
ComputePrintingInstructions: PROC[self: State] ~ {
externalInstructions: Vector ~ ObtainExternalInstructions[self];
instructions: Vector ← emptyVector;
Mark[self, 0];
instructions ← ExecuteInstructionsBody[self, externalInstructions ! Error => CONTINUE];
Unmark0[self];
instructions ← AddInstructionDefaults[self, instructions, externalInstructions];
self.media ← GetP[instructions, $media];
self.copySelect ← GetP[instructions, $copySelect];
self.pageSelect ← GetP[instructions, $pageSelect];
self.onSimplex ← GetP[instructions, $onSimplex];
self.mediaSelect ← GetP[instructions, $mediaSelect];
self.copyName ← GetP[instructions, $copyName];
self.instructions ← instructions;
};