<> <> <> <> 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; <> 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]; <> 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; <> 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> oldcommands: LONG POINTER TO CommandTable _ commands; oldmax: CARDINAL _ array.length; newmax: CARDINAL _ oldmax + MIN[oldmax/2,LAST[CARDINAL]-oldmax]; Assert[index> 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]; <> 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 NULL; Assert[index 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> 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]; }; <> StartJaM: PUBLIC PROC = { <> 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 <> ForEachInstalled[register,defaultFrame]; }; StartVM: PROC = { VM.Start[]; -- fire up the VM <> 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]; }; <> 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]; <> <> RegisterEntry[frame, undefname, [ex[JUndef]]]; }; ENDCASE; }; Install[InstallControl]; }.