-- JaMLocalImpl.mesa
-- Last changed by Doug Wyatt,  7-Oct-81 17:14:10

DIRECTORY
  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],
  Inline USING [LowHalf];

JaMLocalImpl: PROGRAM
IMPORTS JaMOps, JaMStorage, Inline
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, Inline.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];

}.