IPContextImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, November 22, 1985 3:54:08 pm PST
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<contextCountMax THEN ContextOverflow[];
self.contextFree ← NEW[ContextRep];
self.contextCount ← self.contextCount+1;
};
context ← self.contextFree;
self.contextFree ← context.caller;
context.token ← [];
context.frameV ← frame;
context.frameA ← NIL;
context.env ← env;
context.marker ← self.lastMarker ← self.lastMarker+1;
context.caller ← self.context;
self.context ← context;
};
PopContext:
PROC [self: Ref] ~ {
context: Context ~ self.context;
self.context ← context.caller;
context.frameV ← NIL;
context.frameA ← NIL;
context.env ← NIL;
context.caller ← self.contextFree;
self.contextFree ← context;
};
Call:
PUBLIC
PROC [self: Ref, action:
PROC, frame: Vector, env: Vector] ~ {
PushContext[self: self, frame: frame, env: env];
action[! UNWIND => 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] ~ {
Someday this might worry about pools other than the Imager pool
Imager.DoSave[self.imager, action];
};
DoSaveAll:
PUBLIC
PROC [self: Ref, action:
PROC] ~ {
Someday this might worry about pools other than the Imager pool
Imager.DoSaveAll[self.imager, action];
};
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;
};
END.