JaMLocalImpl.mesa
Doug Wyatt, 7-Oct-81 17:14:10
Russ Atkinson, July 22, 1983 6:20 pm
DIRECTORY
Basics USING [LowHalf],
JaMBasic USING [Object, Tuple],
JaMInternal USING [Frame, Locals, LocalsRecord, Node, Stack, TupleSequence],
JaMOps USING
[Assert, Equal, Error, Install, InstallReason, KeyName, limitchk, Load, MakeName, MarkLoop, nullOb, Pop, PopCardinal, PopInteger, Push, PushBoolean, PushCardinal, rangechk, RegisterExplicit, RegisterInternal, Store, Top, UnmarkLoop],
JaMStorage USING [Zone];
JaMLocalImpl: PROGRAM
IMPORTS Basics, JaMOps, JaMStorage
EXPORTS JaMOps = {
OPEN JaMOps, JaMInternal, JaMBasic;
Constants
initLocalsSize: CARDINAL = 20;
maxlenLimit: CARDINAL = LAST[CARDINAL];
Globals
zone: UNCOUNTED ZONE = JaMStorage.Zone[];
undeflv: name Object;
lfacmd: command Object;
Procedures for local/global variables
IsLocal: PROC[key: Object] RETURNS[BOOLEAN] = INLINE {
RETURN[WITH key:key SELECT FROM name => key.id.local, ENDCASE => FALSE] };
Fetch: PROC[frame: Frame] = {
does load local or dictionary load
key: Object ← Pop[frame.opstk];
val: Object ← IF IsLocal[key] THEN LoadLocal[frame,key] ELSE Load[frame,key];
Push[frame.opstk,val];
};
Assign: PROC[frame: Frame] = {
does store local or dictionary store
val: Object ← Pop[frame.opstk];
key: Object ← Pop[frame.opstk];
IF IsLocal[key] THEN StoreLocal[frame,key,val] ELSE Store[frame,key,val];
};
Procedures for local variables
LoadLocal: PUBLIC PROC[frame: Frame, key: Object] RETURNS[Object] = {
generates undeflv if not known
known: BOOLEAN; ob: Object;
[known, ob] ← TryToLoadLocal[frame, key];
IF known THEN RETURN[ob] ELSE ERROR Error[undeflv];
};
TryToLoadLocal: PUBLIC PROC[frame: Frame, key: Object] RETURNS[BOOLEAN,Object] = {
locals: Locals ← frame.locals;
name: Object ← KeyName[key];
FOR i: CARDINAL DECREASING IN[0..locals.curlen) DO
tuple: Tuple ← locals.array[i];
IF Equal[tuple.key,name] THEN RETURN[TRUE,tuple.value];
ENDLOOP;
RETURN[FALSE,nullOb];
};
DefineLocal: PUBLIC PROC[frame: Frame, key,value: Object] = {
locals: Locals ← frame.locals;
tuple: Tuple ← [KeyName[key],value];
i: CARDINAL ← locals.curlen;
IF i>=locals.maxlen THEN GrowLocals[locals,locals.maxlen/2];
Assert[i<locals.maxlen]; locals.array[i] ← tuple;
locals.curlen ← i + 1;
};
StoreLocal: PUBLIC PROC[frame: Frame, key,value: Object] = {
locals: Locals ← frame.locals;
name: Object ← KeyName[key];
FOR i: CARDINAL DECREASING IN[0..locals.curlen) DO
tuple: Tuple ← locals.array[i];
IF Equal[tuple.key,name] THEN { locals.array[i].value ← value; RETURN };
ENDLOOP;
DefineLocal[frame,name,value];
};
NewLocals: PUBLIC PROC RETURNS[Locals] = {
n: CARDINAL = initLocalsSize;
array: LONG POINTER TO TupleSequence ← zone.NEW[TupleSequence[n]];
locals: Locals ← zone.NEW[LocalsRecord ← [curlen: 0, maxlen: n, array: array]];
RETURN[locals];
};
FreeLocals: PUBLIC PROC[locals: Locals] = {
zone.FREE[@locals.array];
zone.FREE[@locals];
};
GrowLocals: PROC[locals: Locals, grow: CARDINAL] = {
old: LONG POINTER TO TupleSequence ← locals.array;
new: LONG POINTER TO TupleSequence ← NIL;
oldmax: CARDINAL ← locals.maxlen;
newmax: CARDINAL;
IF grow = 0 THEN grow ← oldmax/2;
newmax ← oldmax + MIN[grow,maxlenLimit-oldmax];
IF NOT newmax>oldmax THEN ERROR Error[limitchk];
new ← zone.NEW[TupleSequence[newmax]];
FOR i: CARDINAL IN[0..oldmax) DO new[i] ← old[i] ENDLOOP;
locals.array ← new; locals.maxlen ← newmax;
zone.FREE[@old];
};
Intrinsics
LvLoad: PROC[frame: Frame] = {
key: Object ← Pop[frame.opstk];
val: Object ← LoadLocal[frame,key];
Push[frame.opstk,val];
};
LvKnown: PROC[frame: Frame] = {
key: Object ← Pop[frame.opstk];
known: BOOLEAN;
[known,] ← TryToLoadLocal[frame,key];
PushBoolean[frame.opstk, known];
};
LvDefine: PROC[frame: Frame] = {
val: Object ← Pop[frame.opstk];
key: Object ← Pop[frame.opstk];
DefineLocal[frame,key,val];
};
LvStore: PROC[frame: Frame] = {
val: Object ← Pop[frame.opstk];
key: Object ← Pop[frame.opstk];
StoreLocal[frame,key,val];
};
LvMaxLength: PROC[frame: Frame] = {
pushes current max available for locals
locals: Locals ← frame.locals;
PushCardinal[frame.opstk, locals.maxlen];
};
LvLength: PROC[frame: Frame] = {
pushes current number of locals
locals: Locals ← frame.locals;
PushCardinal[frame.opstk, locals.curlen];
};
LvGrow: PROC[frame: Frame] = {
increases max available for locals by amount from opstk
inc: LONG INTEGER ← PopInteger[frame.opstk];
IF inc <= 0 THEN RETURN;
IF inc>LAST[CARDINAL] THEN ERROR Error[rangechk];
GrowLocals[frame.locals, Basics.LowHalf[inc]];
};
LvForAll: PUBLIC PROC[frame: Frame] = {
Expects opstk: (object)
For each pair in locals put (name)(value) onto opstk and execute object
Returns opstk: ()
locals: Locals ← frame.locals;
ob: Object ← Pop[frame.opstk];
save them on exec stack
MarkLoop[frame];
Push[frame.execstk, ob];
prime state
PushCardinal[frame.execstk, locals.curlen];
start it
LvFAProc[frame];
};
LvFAProc: PROC[frame: Frame] = {
lv: CARDINAL ← PopCardinal[frame.execstk];
ob: Object ← Top[frame.execstk];
locals: Locals ← frame.locals;
IF (lv ← MIN[lv,locals.maxlen])>0 THEN {
i: CARDINAL ← lv - 1;
tuple: Tuple ← locals.array[i];
set up opstk
Push[frame.opstk,tuple.key];
Push[frame.opstk,tuple.value];
set up execstk
PushCardinal[frame.execstk, i];
Push[frame.execstk, lfacmd];
Push[frame.execstk, ob];
and let it happen
}
ELSE {
[] ← Pop[frame.execstk]; -- remove object
UnmarkLoop[frame]; -- remove mark
};
};
Initialization
InstallLocal: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
register => {
undeflv ← MakeName[".undeflv"L];
lfacmd ← RegisterInternal["@lvforall"L, LvFAProc];
Local variable commands
RegisterExplicit[frame, ".lvload"L, LvLoad];
RegisterExplicit[frame, ".lvknown"L, LvKnown];
RegisterExplicit[frame, ".lv"L, LvDefine];
RegisterExplicit[frame, ".lvstore"L, LvStore];
RegisterExplicit[frame, ".lvforall"L, LvForAll];
RegisterExplicit[frame, ".lvlength"L, LvLength];
RegisterExplicit[frame, ".lvmaxlength"L, LvMaxLength];
RegisterExplicit[frame, ".lvgrow"L, LvGrow];
RegisterExplicit[frame, ".fetch"L, Fetch];
RegisterExplicit[frame, ".assign"L, Assign];
};
ENDCASE;
};
Install[InstallLocal];
}.