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 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 { 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]; }. ìJaMControlImpl.mesa Original version by John Warnock, Feb., 1979. Paxton, 30-Jan-82 8:49:24 Russ Atkinson, July 22, 1983 7:27 pm Types and Constants Globals Procedures must grow command table and command array grow the command table also grow commandArray Intrinsics Initialization init everybody Register everyone (including Control) initialize root information Initialization Register a default error handler for .undefname Better be sure that undefname has already been registered. Ê 1˜šœ™Jšœ-™-Jšœ™J™$—J˜šÏk ˜ Jšœ œ˜#Jšœ œ˜'šœ˜ Jšœ÷˜÷—Jšœ œ˜Jšœœ˜J˜—šœ˜Jš œœœœ ˜-Jšœ˜!Jšœ ˜Jšœœ&˜-J˜—šœ™J˜Jšœœ˜ Jšœœ˜J˜šœœœ˜šœ ˜Jšœ œ ˜Jšœ œ˜Jšœ˜ ——šœœœ˜Jšœœ˜Jšœœœœ˜/J˜——šœ™J˜Jšœ œœ˜)J˜Jš œœœœœœ˜(J˜Jšœœ œÏc˜6J˜Jšœ œ˜Jšœ œ œž˜