-- JaMControlImpl.mesa
-- Original version by John Warnock, Feb., 1979.
-- Last changed by Paxton, 14-Jan-82 14:12:03

DIRECTORY
  JaMBasic USING [Object, Root, Tag],
  JaMInternal USING [Frame, FrameRecord],
  JaMOps USING [ACopy, AFind, AGet, APut, Array, Assert, Begin, Def, Dict,
    Error, ForEachInstalled, FreeCache, FreeLocals, FreeStack, Install,
    InstallReason, MakeName, MakeString, NewCache, NewLocals, NewStack, Pop,
    PopCommand, Push, Text, TryToLoad, undefname],
  JaMStorage USING [Prune, Zone],
  JaMVM USING [Check, Flush, GetRoot, PutRoot, Start];

JaMControlImpl: MONITOR
LOCKS lock USING lock: POINTER TO MONITORLOCK
IMPORTS JaMOps, JaMStorage, JaMVM
EXPORTS JaMOps = {
OPEN VM:JaMVM, JaMOps, JaMInternal, JaMBasic;

-- Types and Constants

initCommandSize: CARDINAL = 512;
initNameSize: CARDINAL = 512;

CommandEntry: TYPE = RECORD[SELECT plicit: * FROM
  ex => [proc: PROC[Frame]], im => [proc: PROC[]], ENDCASE];
CommandTable: TYPE = RECORD [len: CARDINAL,
  array: SEQUENCE max: CARDINAL OF CommandEntry];

-- Globals

zone: UNCOUNTED ZONE = JaMStorage.Zone[];

root: PUBLIC LONG POINTER TO Root _ NIL;

defaultFrame: PUBLIC Frame _ NIL; -- the default frame

framelock: MONITORLOCK;
framelist: PUBLIC Frame _ NIL; -- head of list of all frames

commandlock: MONITORLOCK;
commands: LONG POINTER TO CommandTable _ NIL;

unregistered: name Object;

-- Procedures

DoCommand: PUBLIC PROC[frame: Frame, ob: command Object] = {
  entry: CommandEntry _ GetCommand[@commandlock,ob.index];
  WITH e:entry SELECT FROM
    ex => e.proc[frame];
    im => IF frame=defaultFrame THEN e.proc[] ELSE Unregistered[frame];
    ENDCASE;
  };

RegisterExplicit: PUBLIC PROC[frame: Frame, text: Text, proc: PROC[Frame]] = {
  RegisterEntry[frame,MakeName[text],[ex[proc]]] };

RegisterImplicit: PUBLIC PROC[frame: Frame, text: Text, proc: PROC[]] = {
  RegisterEntry[frame,MakeName[text],[im[proc]]] };

RegisterEntry: PROC[frame: Frame, name: name Object, entry: CommandEntry] = {
  known: BOOLEAN; ob: Object; index: CARDINAL;
  [known,ob] _ TryToLoad[frame,name]; -- look up the name
  IF known THEN WITH ob:ob SELECT FROM
    command => index _ ob.index; -- use old command index
    ENDCASE => known _ FALSE; -- not defined as a command
  IF NOT known THEN { index _ NewCommand[@commandlock]; -- acquire a new index
    Def[frame,name,[X,command[index]]] }; -- define in current dictionary context
  PutCommand[@commandlock,index,name,entry]; -- enter in command table and commandArray
  };

NewCommand: ENTRY PROC[lock: POINTER TO MONITORLOCK]
  RETURNS[CARDINAL] = {
  ENABLE UNWIND => NULL;
  index: CARDINAL _ root.commandCount; -- new command index
  array: array Object _ root.commandArray;
  Assert[index=commands.len AND array.length=commands.max]; -- check consistency
  IF NOT index<array.length THEN {
    -- must grow command table and command array
    oldcommands: LONG POINTER TO CommandTable _ commands;
    oldmax: CARDINAL _ array.length;
    newmax: CARDINAL _ oldmax + MIN[oldmax/2,LAST[CARDINAL]-oldmax];
    Assert[index<newmax]; -- 2^16 commands?!
    -- grow the command table
    commands _ zone.NEW[CommandTable[newmax]];
    FOR i: CARDINAL IN[0..oldmax) DO commands[i] _ oldcommands[i] ENDLOOP;
    FOR i: CARDINAL IN[oldmax..newmax) DO commands[i] _ [ex[Unregistered]] ENDLOOP;
    zone.FREE[@oldcommands];
    -- also grow commandArray
    array _ root.commandArray _ ACopy[array,newmax];
    };
  root.commandCount _ commands.len _ index + 1;
  VM.PutRoot[root]; -- update root information in VM
  RETURN[index];
  };

GetCommand: ENTRY PROC[lock: POINTER TO MONITORLOCK,
  i: CARDINAL] RETURNS[CommandEntry] = INLINE {
  RETURN[IF i<commands.len THEN commands[i] ELSE [ex[Unregistered]]] };

PutCommand: ENTRY PROC[lock: POINTER TO MONITORLOCK,
  index: CARDINAL, name: name Object, entry: CommandEntry] = {
  ENABLE UNWIND => NULL;
  Assert[index<root.commandCount];
  commands[index] _ entry; -- put entry in command table
  APut[root.commandArray,index,name]; -- record command name in array
  };

FindCommand: ENTRY PROC[lock: POINTER TO MONITORLOCK,
  name: name Object]
  RETURNS[known: BOOLEAN, index: CARDINAL] = {
  ENABLE UNWIND => NULL;
  [known,index] _ AFind[root.commandArray,name];
  };

CommandName: ENTRY PROC[lock: POINTER TO MONITORLOCK,
  command: command Object] RETURNS[Object] = {
  ENABLE UNWIND => NULL;
  array: array Object _ root.commandArray;
  count: CARDINAL _ root.commandCount;
  i: CARDINAL _ command.index;
  IF i<count AND i<array.length THEN RETURN[AGet[array,i]]
  ELSE RETURN[unregistered];
  };

RegisterInternal: PUBLIC PROC[text: Text, proc: PROC[Frame]]
  RETURNS[command Object] = {
  name: name Object _ MakeName[text];
  known: BOOLEAN; index: CARDINAL;
  [known,index] _ FindCommand[@commandlock,name];
  IF NOT known THEN index _ NewCommand[@commandlock];
  PutCommand[@commandlock,index,name,[ex[proc]]];
  RETURN[[X,command[index]]];
  };

RegisterString: PROC[frame: Frame, name: Text, string: Text] = {
  key: Object _ MakeName[name];
  val: Object _ MakeString[string,X];
  Def[frame,key,val];
  };

RegisterObject: PROC[frame: Frame, name: Text, val: Object] = {
  key: Object _ MakeName[name];
  Def[frame,key,val];
  };

-- Intrinsics

Unregistered: PUBLIC PROC[frame: Frame] = {
  ERROR Error[unregistered];
  };

JCommandName: PROC[frame: Frame] = {
  command: command Object _ PopCommand[frame.opstk];
  name: Object _ CommandName[@commandlock,command];
  Push[frame.opstk, name];
  };

JReRegister: PROC[frame: Frame] = {
  ForEachInstalled[register,frame];
  };

JUndef: PROC[frame: Frame] = {
  ob: Object _ Pop[frame.opstk];
  };

-- Initialization

StartJaM: PUBLIC PROC[vmname: LONG STRING, maxPages: CARDINAL] = {
  -- init everybody
  ForEachInstalled[init,NIL];
  StartVM[vmname,maxPages]; -- fire up the VM
  commands _ zone.NEW[CommandTable[root.commandArray.length] _ [len: 0, array: ]];
  FOR i: CARDINAL IN[0..commands.max) DO commands[i] _ [ex[Unregistered]] ENDLOOP;
  commands.len _ root.commandCount;
  defaultFrame _ NewFrame[]; -- make a new frame **** fix this ****
  Begin[defaultFrame,root.sysDict]; -- push the system dictionary
  -- Register everyone (including Control)
  ForEachInstalled[register,defaultFrame];
  VM.Check[];
  };

StopJaM: PUBLIC PROC = {
  VM.Flush[];
  FreeFrame[defaultFrame]; -- **** fix this ****
  zone.FREE[@commands];
  -- free everybody
  ForEachInstalled[free,NIL];
  JaMStorage.Prune[];
  };

StartVM: PROC[vmname: LONG STRING, maxPages: CARDINAL] = {
  old: BOOLEAN _ VM.Start[vmname,maxPages]; -- fire up the VM
  IF old THEN {
    VM.GetRoot[root];
    root.stamp _ root.stamp + 1;
    }
  ELSE {
    -- initialize root information
    root.stamp _ 0;
    root.sysDict _ Dict[256];
    root.commandCount _ 0;
    root.commandArray _ Array[initCommandSize];
    root.nameCount _ 0;
    root.nameArray _ Array[initNameSize];
    root.nameDict _ Dict[initNameSize];
    };
  VM.PutRoot[root];
  };

NewFrame: PUBLIC PROC RETURNS[Frame] = {
  Link: ENTRY PROC[lock: POINTER TO MONITORLOCK,
    f: Frame] = INLINE { f.link _ framelist; framelist _ f };
  frame: Frame _ zone.NEW[FrameRecord _ [link: NIL, opstk: NIL, execstk: NIL, dictstk: NIL,
    cache: NIL, locals: NIL, abort: FALSE, stepflag: FALSE, astepflag: FALSE]];
  frame.opstk _ NewStack[500];
  frame.execstk _ NewStack[250];
  frame.dictstk _ NewStack[20];
  frame.cache _ NewCache[];
  frame.locals _ NewLocals[];
  Link[@framelock,frame];
  RETURN[frame];
  };

FreeFrame: PUBLIC PROC[frame: Frame] = {
  Unlink: ENTRY PROC[lock: POINTER TO MONITORLOCK,
    f: Frame] = INLINE {
    FOR p: LONG POINTER TO Frame _ @framelist, @p^.link UNTIL p^ = NIL DO
      IF p^=f THEN { p^ _ f.link; EXIT }; ENDLOOP; };
  Unlink[@framelock,frame];
  FreeLocals[frame.locals];
  FreeCache[frame.cache];
  FreeStack[frame.dictstk];
  FreeStack[frame.execstk];
  FreeStack[frame.opstk];
  zone.FREE[@frame];
  };

ForEachFrame: PUBLIC PROC[proc: PROC[Frame]] = {
  ForEach: ENTRY PROC[lock: POINTER TO MONITORLOCK,
    proc: PROC[Frame]] = INLINE {
    FOR f: Frame _ framelist, f.link UNTIL f=NIL DO proc[f] ENDLOOP;
    };
  ForEach[@framelock,proc];
  };

ForEachFrameExcept: PUBLIC PROC[frame: Frame, proc: PROC[Frame]] = {
  ForEachExcept: ENTRY PROC[lock: POINTER TO MONITORLOCK,
    frame: Frame, proc: PROC[Frame]] = INLINE {
    FOR f: Frame _ framelist, f.link UNTIL f=NIL DO IF f#frame THEN proc[f] ENDLOOP;
    };
  ForEachExcept[@framelock,frame,proc];
  };

-- Initialization

InstallControl: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
  init => {
    root _ zone.NEW[Root];
    };
  free => {
    zone.FREE[@root];
    };
  register => {
    unregistered _ MakeName[".unregistered"L];
    RegisterObject[frame, ".sysdict"L, root.sysDict]; -- the system dictionary
    RegisterObject[frame, ".true"L, [L,boolean[TRUE]]];
    RegisterObject[frame, ".false"L, [L,boolean[FALSE]]];
    RegisterExplicit[frame, ".commandname"L, JCommandName];
    RegisterExplicit[frame, ".reregister"L, JReRegister];
    -- Register a default error handler for .undefname
    -- Better be sure that undefname has already been registered.
    RegisterEntry[frame, undefname, [ex[JUndef]]];
    };
  ENDCASE;
  };

Install[InstallControl];

}.


Paxton  20-Oct-81 10:25:38
  made NewFrame and FreeFrame public

Wyatt  22-Oct-81 10:34:08
  add vmname parameter to StartJaM

Wyatt  24-Oct-81 15:18:54
  add maxPages parameter to StartJaM