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