JaMControlImpl.mesa
Original version by John Warnock, Feb., 1979.
Paxton, 30-Jan-82 8:49:24
Russ Atkinson, July 22, 1983 7:27 pm
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 [Zone],
JaMVM USING [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;
commands: array Object ← root.commandArray;
commands.length ← root.commandCount; -- limit search
[known,index] ← AFind[commands,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 = {
init everybody
ForEachInstalled[init,NIL];
StartVM; -- 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];
};
StartVM:
PROC = {
VM.Start[]; -- fire up the VM
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];
IF MakeName["##nullName##"].id.index # 0 THEN ERROR; -- must reserve this index
};
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];
}.