<> <> <> <> 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 = { <> initLocalsSize: CARDINAL = 20; maxlenLimit: CARDINAL = LAST[CARDINAL]; <> zone: UNCOUNTED ZONE = TJaMStorage.Zone[]; undeflv: name TJaMBasic.Object; lfacmd: command TJaMBasic.Object; <> 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] = { <> 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] = { <> 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]; }; <> LoadLocal: PUBLIC PROC[frame: TJaMInternal.Frame, key: TJaMBasic.Object] RETURNS[TJaMBasic.Object] = { <> 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[ioldmax 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]; }; <> 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] = { <> locals: TJaMInternal.Locals _ frame.locals; TJaMOps.PushCardinal[frame.opstk, locals.maxlen]; }; LvLength: PROC[frame: TJaMInternal.Frame] = { <> locals: TJaMInternal.Locals _ frame.locals; TJaMOps.PushCardinal[frame.opstk, locals.curlen]; }; LvGrow: PROC[frame: TJaMInternal.Frame] = { <> 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] = { <> <> <> locals: TJaMInternal.Locals _ frame.locals; ob: TJaMBasic.Object _ TJaMOps.Pop[frame.opstk]; <> TJaMOps.MarkLoop[frame]; TJaMOps.Push[frame.execstk, ob]; <> TJaMOps.PushCardinal[frame.execstk, locals.curlen]; <> 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]; <> TJaMOps.Push[frame.opstk,tuple.key]; TJaMOps.Push[frame.opstk,tuple.value]; <> TJaMOps.PushCardinal[frame.execstk, i]; TJaMOps.Push[frame.execstk, lfacmd]; TJaMOps.Push[frame.execstk, ob]; <> } ELSE { [] _ TJaMOps.Pop[frame.execstk]; -- remove object TJaMOps.UnmarkLoop[frame]; -- remove mark }; }; <> InstallLocal: PROC[why: TJaMOps.InstallReason, frame: TJaMInternal.Frame] = { SELECT why FROM register => { undeflv _ TJaMOps.MakeName[".undeflv"L]; lfacmd _ TJaMOps.RegisterInternal["@lvforall"L, LvFAProc]; <> 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]; }.