IPExecImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Michael Plass, June 7, 1985 3:32:30 pm PDT
Doug Wyatt, January 28, 1986 2:14:32 pm PST
DIRECTORY
FS,
Imager USING [Context, ShowText],
ImagerFont USING [MapText, XStringProc],
Interpress USING [AddMaster, LogProc, OpenMaster, OpenMasterRep],
IO,
IPInterpreter,
IPMaster USING [Block, Body, BodyRep, BYTE, EncodingValue, GetHeader, GetOpFromEv, GetSkeleton, GetToken, IntFromSequenceData, Node, NodeRep, Op, OpFromEv, RealFromSequenceData, SequenceType, Skeleton, SkipBytes, SkipToEndOfBody, Token],
RefText USING [ReserveChars],
RopeFile,
Rope;
IPExecImpl: CEDAR PROGRAM
IMPORTS FS, IO, Imager, ImagerFont, Interpress, IPInterpreter, IPMaster, RefText, Rope, RopeFile
EXPORTS Interpress, IPInterpreter
~ BEGIN OPEN IPInterpreter, IPMaster;
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;
MarkRecovery: PUBLIC ERROR ~ CODE;
Bug: PUBLIC ERROR ~ CODE;
Run: TYPE ~ RECORD[start, len: INT];
RunList: TYPE ~ LIST OF Run;
DoString:
PROC [self: Ref, text:
REF
TEXT] ~ {
string: ImagerFont.XStringProc ~ { ImagerFont.MapText[text: text, charAction: charAction] };
PushVector[self, VectorFromString[string]];
};
DoIdentifier:
PROC [self: Ref, text:
REF
TEXT] ~ {
len: NAT ~ text.length;
warn: BOOL ← FALSE;
FOR i:
NAT
IN[0..len)
DO
char: CHAR ~ text[i];
SELECT char
FROM
IN['a..'z], IN['A..'Z] => NULL;
IN['0..'9], '- => IF i=0 THEN warn ← TRUE;
ENDCASE => warn ← TRUE;
ENDLOOP;
IF len=0 THEN warn ← TRUE;
PushIdentifier[self, Rope.FromRefText[text]];
IF warn THEN MasterWarning[$invalidEncoding, "Invalid Identifier"];
};
DoInteger:
PROC [self: Ref, text:
REF
TEXT] ~ {
len: NAT ~ text.length;
IF len<=4
THEN {
val: INT ~ IPMaster.IntFromSequenceData[text];
PushNum[self, [int[val]]];
}
ELSE {
val: REAL ~ IPMaster.RealFromSequenceData[text];
PushNum[self, [real[val]]];
};
};
DoRational:
PROC [self: Ref, text:
REF
TEXT] ~ {
len: NAT ~ text.length;
half: NAT ~ len/2;
IF half<=4
THEN {
n: INT ~ IPMaster.IntFromSequenceData[text: text, start: 0, len: half];
d: INT ~ IPMaster.IntFromSequenceData[text: text, start: half, len: half];
IF n IN INTEGER AND d IN INTEGER THEN PushNum[self, [rational[n: n, d: d]]]
ELSE PushNum[self, [real[REAL[n]/REAL[d]]]];
}
ELSE {
n: REAL ~ IPMaster.RealFromSequenceData[text: text, start: 0, len: half];
d: REAL ~ IPMaster.RealFromSequenceData[text: text, start: half, len: half];
PushNum[self, [real[n/d]]];
};
IF (half+half)#len THEN MasterWarning[$invalidEncoding,
IO.PutFR1["Invalid sequenceRational (length=%g)", IO.int[len]]];
};
DoInsertFile:
PROC [self: Ref, text:
REF
TEXT] ~ {
MasterWarning[$unimplemented, "Not implemented: sequenceInsertFile"];
};
Fetch16:
PROC [rope:
ROPE, startByte:
INT]
RETURNS [
CARDINAL] ~ {
b0: CARDINAL ~ Rope.Fetch[rope, startByte]-'\000;
b1: CARDINAL ~ Rope.Fetch[rope, startByte+1]-'\000;
RETURN [b0*256+b1];
};
NameOfFileForStream:
PROC [stream:
IO.
STREAM]
RETURNS [rope:
ROPE ←
NIL] ~ {
openFile: FS.OpenFile;
ok: BOOL ← TRUE;
openFile ← FS.OpenFileFromStream[stream ! FS.Error, IO.Error => {ok ← FALSE; CONTINUE}];
IF ok THEN rope ← FS.GetName[openFile! FS.Error => CONTINUE].fullFName;
};
smallish: INT ← 10000;
maxChunkSize: INT ~ LAST[NAT]-SIZE[TEXT[0]]*2-4;
RopeFromRuns:
PROC [stream:
IO.
STREAM, runs:
LIST
OF Run, sequenceLength:
INT]
RETURNS [rope:
ROPE ←
NIL] ~ {
size: INT ← 0;
filename: ROPE ← NIL;
IF sequenceLength > smallish
AND (filename ← NameOfFileForStream[stream]) #
NIL
THEN {
ropeFile: ROPE ~ RopeFile.Create[name: filename, buffers: 1, raw: TRUE];
FOR r:
LIST
OF Run ← runs, r.rest
UNTIL r =
NIL
DO
run: Run ~ r.first;
rope ← Rope.Concat[rope, Rope.Substr[ropeFile, run.start, run.len]];
size ← size + run.len;
ENDLOOP;
}
ELSE {
saveIndex: INT ~ IO.GetIndex[stream];
FOR r:
LIST
OF Run ← runs, r.rest
UNTIL r =
NIL
DO
run: Run ← r.first;
UNTIL run.len = 0
DO
chunkSize: NAT ~ MIN[run.len, maxChunkSize];
text: Rope.Text ~ Rope.NewText[chunkSize];
zero: [0..0];
IO.SetIndex[stream, run.start];
TRUSTED {zero ← IO.GetBlock[stream, LOOPHOLE[text], 0, chunkSize]-chunkSize};
rope ← Rope.Concat[rope, text];
size ← size + chunkSize;
run.start ← run.start + chunkSize;
run.len ← run.len - chunkSize;
ENDLOOP;
ENDLOOP;
IO.SetIndex[stream, saveIndex];
};
IF size # sequenceLength THEN ERROR;
};
opFromEncodingValue: IPMaster.OpFromEv ~ IPMaster.GetOpFromEv[];
InvalidEncodingValue:
PROC [ev: IPMaster.EncodingValue] ~ {
MasterWarning[$invalidEncoding,
IO.PutFR1["Invalid encoding value (%g)", IO.int[ORD[ev]]]];
};
ExecuteToEndOfBody:
PROC [self: Ref] ~ {
stream: STREAM ~ self.stream;
sequenceData: {nil, text, runs, skip} ← nil;
sequenceType: SequenceType ← nil;
sequenceLength: INT ← 0;
sequenceRuns: INT ← 0;
text: REF TEXT ← NIL;
buffer: REF TEXT ~ self.buffer;
runsHead, runsTail: LIST OF Run ← NIL;
BeginSequence:
PROC [seq: SequenceType] ~ {
SELECT sequenceType ← seq
FROM
sequenceString, sequenceIdentifier, sequenceInsertFile, sequenceComment,
sequenceInteger, sequenceRational, sequenceReal => sequenceData ← text;
sequenceLargeVector, sequencePackedPixelVector, sequenceCompressedPixelVector, sequenceAdaptivePixelVector => sequenceData ← runs;
ENDCASE => sequenceData ← skip;
SELECT sequenceData
FROM
text => { text ← buffer; text.length ← 0 };
runs => { runsHead ← runsTail ← NIL };
ENDCASE;
sequenceLength ← 0;
};
ExtendSequence:
PROC [length:
INT] ~ {
SELECT sequenceData
FROM
nil => {
MasterWarning[$invalidEncoding, "Misplaced sequenceContinued"];
SkipBytes[stream, length];
};
text => {
len: NAT ~ length;
nBytesRead: NAT ← 0;
IF (text.maxLength-text.length)<len THEN text ← RefText.ReserveChars[text, len];
nBytesRead ← IO.GetBlock[self: stream, block: text, startIndex: text.length, count: len];
IF nBytesRead#len THEN ERROR IO.EndOfStream[stream];
};
runs => {
prevTail: LIST OF Run ~ runsTail;
runsTail ← LIST[[start: IO.GetIndex[stream], len: length]];
IF prevTail=NIL THEN runsHead ← runsTail ELSE prevTail.rest ← runsTail;
SkipBytes[stream, length];
};
skip => SkipBytes[stream, length];
ENDCASE => ERROR;
sequenceRuns ← sequenceRuns+1;
sequenceLength ← sequenceLength+length;
};
FinishSequence:
PROC ~ {
SELECT sequenceType
FROM
sequenceString => DoString[self, text];
sequenceIdentifier => DoIdentifier[self, text];
sequenceInteger => DoInteger[self, text];
sequenceRational => DoRational[self, text];
sequenceInsertFile => DoInsertFile[self, text];
sequenceComment => NULL;
sequenceLargeVector => {
rope: ROPE ~ RopeFromRuns[self.stream, runsHead, sequenceLength];
b: NAT ~ Rope.Fetch[rope, 0]-'\000;
vector: Vector ~ VectorFromBytes[bytes: Rope.Substr[rope, 1], bytesPerElement: b, signed: TRUE];
PushVector[self, vector];
};
sequencePackedPixelVector => {
rope: ROPE ~ RopeFromRuns[self.stream, runsHead, sequenceLength];
bitsPerSample: [1..1] ~ Fetch16[rope, 0]; -- only one bit per sample supported here
scanLength: NAT ~ Fetch16[rope, 2];
dataBitsPerLine: NAT ~ bitsPerSample*scanLength;
padBitsPerLine: NAT ~ NAT[32 - (dataBitsPerLine MOD 32)] MOD 32;
vector: Vector ~ VectorFromBits[bytes: Rope.Substr[rope, 4], dataBitsPerLine: dataBitsPerLine, padBitsPerLine: padBitsPerLine];
PushVector[self, vector];
};
sequenceCompressedPixelVector => MasterWarning[$unimplemented,
"Not implemented: sequenceCompressedPixelVector"];
sequenceAdaptivePixelVector => MasterWarning[$unimplemented,
"Not implemented: sequenceAdaptivePixelVector"];
sequenceContinued => MasterWarning[$invalidEncoding,
"Misplaced sequenceContinued"];
ENDCASE => MasterWarning[$invalidEncoding,
IO.PutFR1["Invalid sequence type (%g)", IO.int[ORD[sequenceType]]]];
sequenceData ← nil;
sequenceType ← nil;
};
DO
-- for each Token
token: Token ~ GetToken[stream: self.stream, flushComments: FALSE];
IF token.seq=sequenceContinued THEN { ExtendSequence[token.len]; LOOP };
self.context.token ← token;
IF sequenceType=sequenceString
THEN {
done: BOOL ← TRUE;
SELECT token.op
FROM
show => Imager.ShowText[context: self.imager, text: text];
showandxrel => Imager.ShowText[context: self.imager, text: text, xrel: TRUE];
ENDCASE => done ← FALSE;
IF done THEN { sequenceData ← nil; LOOP };
};
IF sequenceData#nil THEN FinishSequence[];
IF token.op=endBody THEN EXIT;
SELECT token.type
FROM
op => {
ev: IPMaster.EncodingValue ~ token.op;
op: IPMaster.Op ~ opFromEncodingValue[ev];
IF op#nil THEN Apply[self, op] ELSE InvalidEncodingValue[ev];
};
num => PushNum[self, [int[token.num]]];
seq => { BeginSequence[token.seq]; ExtendSequence[token.len] };
ENDCASE => ERROR;
ENDLOOP;
};
BeginBody:
PROC [self: Ref]
RETURNS [
INT] ~ {
token: Token ~ IPMaster.GetToken[self.stream];
self.context.token ← token;
IF NOT token.op=beginBody THEN MasterError[$missingBody, "Missing body"];
RETURN[token.index];
};
SkipInlineBody:
PUBLIC
PROC [self: Ref] ~ {
index: INT ~ BeginBody[self];
IPMaster.SkipToEndOfBody[self.stream];
};
GetInlineBody:
PUBLIC
PROC [self: Ref]
RETURNS [Body] ~ {
start, stop: INT ← 0;
start ← BeginBody[self];
IPMaster.SkipToEndOfBody[self.stream];
stop ← IO.GetIndex[self.stream];
RETURN[NEW[IPMaster.BodyRep ← [index: start, length: stop-start]]];
};
ExecuteInlineBody:
PROC [self: Ref] ~ {
index: INT ~ BeginBody[self];
DO error:
BOOL ←
FALSE;
ExecuteToEndOfBody[self ! MarkRecovery => { error ← TRUE; CONTINUE }];
IF error
THEN {
-- do mark recovery
marker: Marker ~ PopToActiveMark[self];
IF marker=self.context.marker
THEN {
IO.SetIndex[self.stream, self.context.token.index];
DO token: Token ~ IPMaster.GetToken[self.stream];
SELECT token.op
FROM
endBody => ERROR MarkRecovery; -- end of body
beginBody => IPMaster.SkipToEndOfBody[self.stream]; -- skip body literal
unmark0 => { IO.SetIndex[self.stream, token.index]; EXIT }; -- found UNMARK0
ENDCASE;
IF token.type=seq THEN IPMaster.SkipBytes[self.stream, token.len];
ENDLOOP;
}
ELSE ERROR MarkRecovery; -- not this context's marker
}
ELSE EXIT; -- normal completion
ENDLOOP;
};
CallInlineBody:
PUBLIC
PROC [self: Ref, frame: Vector, env: Vector] ~ {
action: PROC ~ { ExecuteInlineBody[self] };
Call[self: self, action: action, frame: frame, env: env];
};
CallBody:
PROC [self: Ref, body: Body, frame: Vector, env: Vector] ~ {
stream: STREAM ~ self.stream;
next: INT ~ IO.GetIndex[stream];
IO.SetIndex[stream, body.index];
CallInlineBody[self: self, frame: frame, env: env ! UNWIND => IO.SetIndex[stream, next]];
IO.SetIndex[stream, next];
};
DoWithMarkProtection:
PUBLIC
PROC [self: Ref, action:
PROC] ~ {
error: BOOL ← FALSE;
inner: PROC ~ { Mark[self, 0]; action[]; Unmark[self, 0] };
inner[! MarkRecovery => { error ← TRUE; CONTINUE}];
IF error
THEN {
-- do mark recovery
marker: Marker ~ PopToActiveMark[self];
IF marker=self.context.marker THEN Unmark[self, 0]
ELSE ERROR MarkRecovery;
};
};
Do: PUBLIC PROC [self: Ref, op: Operator] ~ { op.class.do[op, self] };
composedClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $Composed, do: ComposedDo]];
ComposedData: TYPE ~ REF ComposedDataRep;
ComposedDataRep:
TYPE ~
RECORD[
frame: Vector, -- initial frame
env: Vector, -- environment
body: Body -- body of the operator
];
ComposedDo:
PROC [op: Operator, state: Ref] ~ {
data: ComposedData ~ NARROW[op.data];
CallBody[self: state, body: data.body, frame: data.frame, env: data.env];
};
MakeCO:
PUBLIC
PROC [frame: Vector, env: Vector, body: Body]
RETURNS [Operator] ~ {
data: ComposedData ~ NEW[ComposedDataRep ← [frame: frame, env: env, body: body]];
RETURN[NEW[OperatorRep ← [class: composedClass, data: data]]];
};
CallPreamble:
PROC [self: Ref, 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 PushVector[self, Env[self]];
IF Count[self]<2 THEN PushVector[self, Frame[self]];
Unmark[self, 2];
};
IO.SetIndex[self.stream, node.body.index];
Call[self: self, action: preamble, frame: frame, env: env];
};
node: REF NodeRep.block => {
MasterError[$unimplemented, "Preamble cannot be a block."];
ERROR Error;
};
ENDCASE => ERROR;
};
CallNode:
PROC [self: Ref, 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, 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;
};
emptyVec: Vector ~ ZeroVec[0];
topFrame: Vector ~ ZeroVec[topFrameSize];
topEnv: Vector ~ emptyVec; -- empty vector, for now
OpenMaster: TYPE ~ Interpress.OpenMaster;
OpenMasterRep: TYPE ~ Interpress.OpenMasterRep;
OpenMasterImplRep: PUBLIC TYPE ~ IPInterpreter.Rep; -- exported to Interpress
LogProc: TYPE ~ Interpress.LogProc;
DoTopAction:
PROC [master: OpenMaster, action:
PROC] ~ {
self: Ref ~ master.impl;
protect: PROC ~ { DoWithMarkProtection[self, action] };
call: PROC ~ { Call[self, protect, emptyVec, emptyVec] };
save: PROC ~ { IF self.imager=NIL THEN call ELSE DoSaveAll[self, call] };
Interpress.AddMaster[master, save];
};
DoPreamble:
PROC [master: OpenMaster] ~ {
self: Ref ~ master.impl;
block: Block ~ master.skeleton.topBlock;
action:
PROC ~ {
CallPreamble[self: self, node: block.preamble, frame: topFrame, env: topEnv];
self.topFrame ← PopVector[self];
self.topEnv ← PopVector[self];
};
DoTopAction[master, action];
};
defaultMaxStackLength: Cardinal ~ 1000;
Open:
PUBLIC
PROC [fileName:
ROPE, logProc: LogProc, logData:
REF ←
NIL]
RETURNS [OpenMaster] ~ {
stream: STREAM ~ FS.StreamOpen[fileName];
RETURN [FromStream[stream, logProc, logData]];
};
FromStream:
PUBLIC
PROC [stream:
STREAM, logProc: LogProc, logData:
REF ←
NIL]
RETURNS [OpenMaster] ~ {
restOfHeader: ROPE ~ IPMaster.GetHeader[stream, "Interpress/Xerox/"];
skeleton: IPMaster.Skeleton ~ IPMaster.GetSkeleton[stream];
self: Ref ~ NEW[Rep ← [stream: stream]];
master: OpenMaster ~ NEW[OpenMasterRep ← [
pages: skeleton.topBlock.size, skeleton: skeleton,
logProc: logProc, logData: logData, impl: self]];
self.buffer ← NEW[TEXT[200]];
self.stackArray ← NEW[StackArrayRep ← ALL[[zero[]]]];
self.stackCountMax ← defaultMaxStackLength;
self.markArray ← NEW[MarkArrayRep[4] ← [size: 0, seq: ]];
self.imager ← imager; -- dummy imager context
DoPreamble[master];
RETURN[master];
};
DoPage:
PUBLIC
PROC [master: OpenMaster, page:
INT, context: Imager.Context] ~ {
IF page
IN[1..master.pages]
THEN {
block: Block ~ master.skeleton.topBlock;
node: Node ~ block[page-1];
self: Ref ~ master.impl;
action: PROC ~ { CallNode[self: self, node: node, frame: self.topFrame, env: self.topEnv] };
self.imager ← context;
DoTopAction[master, action];
self.imager ← NIL;
};
};
END.
ObtainExternalInstructions: PROC [self: Ref] RETURNS [Vector] ~ {
RETURN[VectorFromAny[GetP[Env[self], $externalInstructions]]];
};
AddInstructionDefaults: PROC [self: Ref, computedInstructions, externalInstructions: Vector]
RETURNS [Vector] ~ {
RETURN[computedInstructions]
};
ExecuteInstructionsBody: PROC [self: Ref, 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: Ref] ~ {
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;
};