DIRECTORY Imager USING [DoSave, DoSaveAll], IPInterpreter USING [Any, Array, ArrayFromVector, Cardinal, Context, ContextRep, Get, MasterError, Ref, Vector, VectorFromArray]; IPContextImpl: CEDAR PROGRAM IMPORTS Imager, IPInterpreter EXPORTS IPInterpreter ~ BEGIN OPEN IPInterpreter; contextCountMax: Cardinal _ 100; ContextOverflow: PROC ~ { MasterError[$contextOverflow, "Execution contexts nested too deeply"]; }; PushContext: PROC [self: Ref, frame: Vector, env: Vector] ~ { context: Context _ NIL; IF self.contextFree=NIL THEN { IF NOT self.contextCount PopContext[self]]; PopContext[self]; }; AGet: PROC [a: Array, i: Cardinal] RETURNS [Any] ~ INLINE { RETURN[a[i-a.lowerBound]] }; ASet: PROC [a: Array, i: Cardinal, x: Any] ~ INLINE { a[i-a.lowerBound] _ x }; Frame: PUBLIC PROC [self: Ref] RETURNS [Vector] ~ { context: Context ~ self.context; IF context.frameV=NIL THEN context.frameV _ VectorFromArray[context.frameA]; RETURN[context.frameV]; }; FGet: PUBLIC PROC [self: Ref, i: Cardinal] RETURNS [Any] ~ { context: Context ~ self.context; IF context.frameA#NIL THEN RETURN[AGet[context.frameA, i]] ELSE RETURN[Get[context.frameV, i]]; }; FSet: PUBLIC PROC [self: Ref, x: Any, i: Cardinal] ~ { context: Context ~ self.context; IF context.frameA=NIL THEN context.frameA _ ArrayFromVector[context.frameV]; context.frameV _ NIL; ASet[context.frameA, i, 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]; }; END. šIPContextImpl.mesa Copyright c 1984, 1985 by Xerox Corporation. All rights reserved. Doug Wyatt, November 22, 1985 3:54:08 pm PST Someday this might worry about pools other than the Imager pool Someday this might worry about pools other than the Imager pool PoolOp: PUBLIC PROC [self: Ref] RETURNS [Pool] ~ { context: Context ~ self.context; RETURN[context.pool]; }; PGet: PUBLIC PROC [self: Ref, i: Cardinal] RETURNS [Any] ~ { context: Context ~ self.context; array: Array ~ context.pool.array; RETURN[array[i-array.lowerBound]]; }; PSet: PUBLIC PROC [self: Ref, x: Any, i: Cardinal] ~ { context: Context ~ self.context; array: Array ~ context.pool.array; -- SavePool[self, pool, ...]; -- array[i-array.lowerBound] _ x; }; emptyVec: Vector ~ ZeroVec[0]; MakePool: PUBLIC PROC [v: Vector, persistent: BOOL] RETURNS [Pool] ~ { RETURN[NEW[PoolRep _ [persistent: persistent, array: ArrayFromVector[v]]]]; }; 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: Ref] ~ { 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 NOT op.class.type=$Pool THEN MasterError[$wrongType, "Operator is not a Pool"]; WITH op.data SELECT FROM pool: Pool => RETURN[pool]; ENDCASE => ERROR Bug; }; Κϋ˜codešœ™Kšœ Οmœ7™BKšœ,™,—K˜šΟk ˜ Kšœžœ˜!Kšœžœn˜—K˜KšΠbl œžœž˜Kšžœ˜Kšžœ˜Kšœžœžœ˜K˜K˜ K˜šΟnœžœ˜KšœF˜FKšœ˜K˜—š  œžœ,˜=Kšœžœ˜šžœžœžœ˜Kšžœžœ#žœ˜@Kšœžœ ˜#Kšœ(˜(K˜—Kšœ˜K˜"Kšœ˜Kšœ˜Kšœžœ˜Kšœ˜Kšœ5˜5Kšœ˜K˜K˜K˜—š  œžœ˜ Kšœ ˜ K˜Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœ"˜"Kšœ˜K˜K˜—š œžœžœžœ!˜KK˜0Kšœ žœ˜%K˜K˜K˜—K˜š  œžœžœ žœžœ˜XK˜—š œžœ#žœ˜NK˜—š œžœžœ žœ ˜3K˜ Kšžœžœžœ2˜LKšžœ˜K˜K˜—š œžœžœžœ ˜