<> <> <> 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] ~ { <> <> <> 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 => {>> <> <> <<};>> 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] ~ { <> showVec: Vector ~ self.showVec; Imager.DoSave[self.imager, action ! UNWIND => self.showVec _ showVec]; self.showVec _ showVec; }; DoSaveAll: PUBLIC PROC[self: State, action: PROC] ~ { <> 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]; }; < {>> <> <> <<};>> 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]; }; < {>> <> <> <> <> <> <> <> <> <<};>> 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]]; <> 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. <<>> <> <> <<};>> <<>> <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <1 DO Apply[self, $mergeprop] ENDLOOP;>> <> <<};>> <<};>> <<>> <> <> <> <<>> <> < CONTINUE];>> <> <<>> <> <<>> <> <> <> <> <> <> <> <<};>> <<>>