<> <> <> <> DIRECTORY FS, Imager USING [Context, DoSave, DoSaveAll, ShowText], ImagerFont USING [MapText, XStringProc], Interpress, IO, IPInterpreter, IPMaster USING [Block, Body, BodyRep, BYTE, GetHeader, GetSkeleton, GetToken, IntFromSequenceData, Node, NodeRep, RealFromSequenceData, SequenceType, Skeleton, SkipBytes, SkipToEndOfBody, Token], RefText USING [ReserveChars], RopeFile, Rope; IPExecImpl: CEDAR PROGRAM IMPORTS FS, IO, Imager, ImagerFont, 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; contextFreeCountMax: INT _ 8; AllocContext: PROC [self: Ref] RETURNS [context: Context] ~ { IF self.contextFreeCount>0 THEN { context _ self.contextFree; self.contextFree _ context.caller; self.contextFreeCount _ self.contextFreeCount-1; } ELSE context _ NEW [ContextRep]; }; FreeContext: PROC [self: Ref, context: Context] ~ { IF self.contextFreeCount { self.context _ context.caller; FreeContext[self, context] }]; IF self.context=context THEN { self.context _ context.caller; FreeContext[self, context] } ELSE ERROR Bug; }; Frame: PUBLIC PROC[self: Ref] RETURNS[Vector] ~ { context: Context ~ self.context; IF context.frame=NIL THEN RETURN[context.initialFrame] ELSE RETURN[VectorFromArray[context.frame]]; }; FGet: PUBLIC PROC[self: Ref, i: Cardinal] RETURNS[Any] ~ { context: Context ~ self.context; IF context.frame=NIL THEN RETURN[Get[context.initialFrame, i]] ELSE { array: Array ~ context.frame; RETURN[array[i-array.lowerBound]] }; }; FSet: PUBLIC PROC[self: Ref, x: Any, i: Cardinal] ~ { context: Context ~ self.context; IF context.frame=NIL THEN context.frame _ ArrayFromVector[context.initialFrame]; { array: Array ~ context.frame; array[i-array.lowerBound] _ x }; }; Env: PUBLIC PROC[self: Ref] RETURNS[Vector] ~ { context: Context ~ self.context; RETURN[context.env]; }; DoSave: PUBLIC PROC[self: Ref, action: PROC] ~ { <> Imager.DoSave[self.imager, action]; }; DoSaveAll: PUBLIC PROC[self: Ref, action: PROC] ~ { <> Imager.DoSaveAll[self.imager, action]; }; 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"]; }; DoCardinal: 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]; }; OpenFileFromStream: PROC [stream: IO.STREAM] RETURNS [FS.OpenFile] ~ { openFile: FS.OpenFile _ FS.nullOpenFile; name: ROPE _ NIL; ok: BOOL _ TRUE; openFile _ FS.OpenFileFromStream[stream ! FS.Error, IO.Error => {ok _ FALSE; CONTINUE}]; <> name _ FS.GetName[openFile ! FS.Error => {ok _ FALSE; CONTINUE}].fullFName; IF ok THEN openFile _ FS.Open[ name: name, wantedCreatedTime: FS.GetInfo[openFile].created, remoteCheck: FALSE ! FS.Error => {ok _ FALSE; CONTINUE} ]; RETURN [IF ok THEN openFile ELSE FS.nullOpenFile] }; smallish: INT _ 30000; maxChunkSize: INT ~ LAST[NAT]-SIZE[TEXT[0]]*2-4; maxRopeStreams: NAT ~ 4; nRopeStreams: NAT _ 3; ropeBuffers: NAT _ 1; pagesPerFileBuffer: NAT _ 10; numberOfFilebuffers: NAT _ 2; ropeFileStreamOptions: FS.StreamOptions ~ [ tiogaRead: FALSE, commitAndReopenTransOnFlush: FALSE, truncatePagesOnClose: FALSE, finishTransOnClose: FALSE, closeFSOpenFileOnClose: FALSE ]; RopeFromRuns: PROC [stream: IO.STREAM, runs: LIST OF Run, sequenceLength: INT] RETURNS [rope: ROPE _ NIL] ~ { size: INT _ 0; openFile: FS.OpenFile ~ IF sequenceLength > smallish THEN OpenFileFromStream[stream] ELSE FS.nullOpenFile; IF openFile # FS.nullOpenFile THEN { <> ropes: ARRAY [0..maxRopeStreams) OF ROPE _ ALL[NIL]; FOR i: NAT IN [0..nRopeStreams) DO ropeFile: ROPE ~ RopeFile.FromStream[stream: FS.StreamFromOpenFile[openFile: openFile, streamOptions: ropeFileStreamOptions, streamBufferParms: [vmPagesPerBuffer: pagesPerFileBuffer, nBuffers: numberOfFilebuffers]], buffers: ropeBuffers]; t: ROPE _ NIL; size _ 0; FOR r: LIST OF Run _ runs, r.rest UNTIL r = NIL DO run: Run ~ r.first; t _ Rope.Concat[t, Rope.Substr[ropeFile, run.start, run.len]]; size _ size + run.len; ENDLOOP; ropes[i] _ t; ENDLOOP; FOR i: NAT IN [0..nRopeStreams) DO start: INT ~ size*i/nRopeStreams; end: INT ~ size*(i+1)/nRopeStreams; rope _ Rope.Concat[rope, Rope.Substr[ropes[i], start, end-start]]; 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 Rope.Size[rope] # sequenceLength THEN ERROR; IF size # sequenceLength THEN ERROR; }; 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 => 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) { 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 => DoCardinal[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 => Apply[self, token.op]; 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]; }; < {>> <> <> <<};>> 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]; }; < {>> <> <> <> <> <> <> <> <> <<};>> ENDCASE => ERROR; }; emptyVec: Vector ~ ZeroVec[0]; topFrame: Vector ~ ZeroVec[topFrameSize]; topEnv: Vector ~ emptyVec; -- empty vector, for now Master: TYPE ~ Interpress.Master; MasterRep: TYPE ~ Interpress.MasterRep; MasterImpl: TYPE ~ REF MasterImplRep; MasterImplRep: PUBLIC TYPE ~ RECORD [ -- exported to Interpress skeleton: IPMaster.Skeleton, interpreter: IPInterpreter.Ref ]; LogProc: TYPE ~ Interpress.LogProc; Error: SIGNAL [class: INT, code: ATOM, explanation: ROPE] ~ CODE; ReportError: PUBLIC PROC [class: INT, code: ATOM, explanation: ROPE] ~ { SIGNAL Error[class: class, code: code, explanation: explanation]; IF class=Interpress.classMasterError THEN ERROR MarkRecovery; }; MasterError: PUBLIC PROC [code: ATOM, explanation: ROPE] ~ { ReportError[class: Interpress.classMasterError, code: code, explanation: explanation]; }; MasterWarning: PUBLIC PROC [code: ATOM, explanation: ROPE _] ~ { ReportError[class: Interpress.classMasterWarning, code: code, explanation: explanation]; }; DoTopAction: PROC [self: Ref, action: PROC, log: LogProc] ~ { protect: PROC ~ { DoWithMarkProtection[self, action] }; call: PROC ~ { Call[self, protect, emptyVec, emptyVec] }; save: PROC ~ { IF self.imager=NIL THEN call[] ELSE DoSaveAll[self, call] }; save[! Error => { IF log#NIL THEN log[class, code, explanation]; RESUME }]; }; DoPreamble: PROC [master: Master, log: LogProc] ~ { impl: MasterImpl ~ master.impl; self: Ref ~ impl.interpreter; block: Block ~ impl.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, log]; }; defaultMaxStackLength: Cardinal ~ 1000; Open: PUBLIC PROC [fileName: ROPE, log: LogProc] RETURNS [Master] ~ { stream: STREAM ~ FS.StreamOpen[fileName]; RETURN [FromStream[stream, log]]; }; FromStream: PUBLIC PROC [stream: STREAM, log: LogProc] RETURNS [Master] ~ { restOfHeader: ROPE ~ IPMaster.GetHeader[stream, "Interpress/Xerox/"]; skeleton: IPMaster.Skeleton ~ IPMaster.GetSkeleton[stream]; self: Ref ~ NEW[Rep _ [stream: stream]]; impl: MasterImpl ~ NEW[MasterImplRep _ [skeleton: skeleton, interpreter: self]]; master: Master ~ NEW[MasterRep _ [pages: skeleton.topBlock.size, impl: impl]]; self.buffer _ NEW[TEXT[200]]; self.stackArray _ NEW[StackArrayRep _ ALL[[zero[]]]]; self.stackCountMax _ defaultMaxStackLength; <> DoPreamble[master, log]; RETURN[master]; }; DoPage: PUBLIC PROC [master: Master, page: INT, context: Imager.Context, log: LogProc] ~ { IF page IN[1..master.pages] THEN { impl: MasterImpl ~ master.impl; block: Block ~ impl.skeleton.topBlock; node: Node ~ block[page-1]; self: Ref ~ impl.interpreter; action: PROC ~ { CallNode[self: self, node: node, frame: self.topFrame, env: self.topEnv] }; self.imager _ context; DoTopAction[self, action, log]; self.imager _ NIL; }; }; END. <<>> <> <> <<};>> <<>> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <1 DO Apply[self, $mergeprop] ENDLOOP;>> <> <<};>> <<};>> <<>> <> <> <> <<>> <> < CONTINUE];>> <> <<>> <> <<>> <> <> <> <> <> <> <> <<};>> <<>>