<> <> <> <> <> DIRECTORY JaMBasic USING [Object], JaMInternal USING [Frame, Locals, Node, Stack], JaMOps USING [AAtom, ArrayFromStack, Assert, Bug, ClearStack, DoCommand, Empty, GetLocalsTop, GetMark, GetStream, Install, InstallReason, KillStream, MakeName, Pop, PopBoolean, PopInteger, Push, PushInteger, RegisterExplicit, RegisterInternal, Restore, SetLocalsTop, StackForAll, StreamHandle, StreamToken, StringToken, Top, TryToLoad, TryToLoadLocal], Process USING [Yield]; JaMExecImpl: PROGRAM IMPORTS JaMOps, Process EXPORTS JaMOps = { OPEN JaMOps, JaMInternal, JaMBasic; <> rangechk,typechk,undefname,limitchk: PUBLIC name Object; -- public error names syntaxerr,stkovrflw,execovrflw: name Object; -- local error names step,interrupt,anon: name Object; asstep,arfree,sstep,rfree,reptcmd,forcmd,loopcmd: command Object; <> Error: PUBLIC ERROR[error: Object] = CODE; StackOverflow: PUBLIC ERROR[stack: Stack] = CODE; Bug: PUBLIC ERROR = CODE; StopExecution: ERROR = CODE; HandleStackOverflow: PROC[frame: Frame, stack: Stack] RETURNS[Object] = { oparray: array Object _ ArrayFromStack[frame.opstk]; execarray: array Object _ ArrayFromStack[frame.execstk]; ClearStack[frame.opstk]; ClearStack[frame.execstk]; Push[frame.opstk,oparray]; Push[frame.opstk,execarray]; SELECT stack FROM frame.opstk => RETURN[stkovrflw]; frame.execstk => RETURN[execovrflw]; ENDCASE => ERROR Bug; }; UnwindExecStk: PROC[frame: Frame, exit: BOOLEAN _ FALSE] = { Proc: PROC[ob: Object] RETURNS[BOOLEAN] = { WITH ob:ob SELECT FROM exec,loop => IF exit THEN RETURN[TRUE]; stream => KillStream[ob]; scope => SetLocalsTop[frame,ob.top]; ENDCASE; RETURN[FALSE] }; [] _ StackForAll[stack: frame.execstk, proc: Proc, unwind: TRUE]; }; <> Execute: PUBLIC PROC[frame: Frame, ob: Object] = { outermost: BOOLEAN _ Empty[frame.execstk]; IF outermost THEN InnerExecute[frame,ob ! StackOverflow => { ob _ HandleStackOverflow[frame,stack]; RETRY }; StopExecution => { UnwindExecStk[frame]; CONTINUE }; UNWIND => UnwindExecStk[frame]] ELSE InnerExecute[frame,ob]; }; InnerExecute: PROC[frame: Frame, object: Object] = { Push[frame.execstk,[X,exec[]]]; -- mark base of stack for this call on Execute Push[frame.execstk,object]; -- push the object to be executed DO ob: Object _ Pop[frame.execstk]; -- pop next object to be executed IF ob.tag=L THEN Push[frame.opstk,ob] -- to execute a literal, push it on the opstk ELSE { ENABLE Error => { Push[frame.opstk,ob]; -- push the offending object Push[frame.execstk,error]; -- push the error CONTINUE }; -- and press on PushToken: PROC[frame: Frame, tok: Object] = INLINE { stack: Stack _ (IF tok.tag=L THEN frame.opstk ELSE frame.execstk); Push[stack,tok] }; WITH ob:ob SELECT FROM null => NULL; -- what did you expect? integer,real,boolean,dict,mark,user => Push[frame.opstk,ob]; -- always literal stream => { <> <> <> found,error: BOOLEAN; tok: Object; s: StreamHandle _ GetStream[ob]; [found,error,tok] _ StreamToken[frame,s]; IF found THEN { Push[frame.execstk,ob]; PushToken[frame,tok] } ELSE KillStream[ob]; IF error THEN Push[frame.execstk,syntaxerr]; }; string => { <> <> <> found,error: BOOLEAN; tok: Object; rem: string Object; [found,error,tok,rem] _ StringToken[frame,ob]; IF found THEN { IF rem.length>0 THEN Push[frame.execstk,rem]; PushToken[frame,tok] }; IF error THEN Push[frame.execstk,syntaxerr]; }; array => { <> <> <> found: BOOLEAN; tok: Object; rem: array Object; [found,tok,rem] _ AAtom[ob]; IF found THEN { IF rem.length>0 THEN Push[frame.execstk,rem]; PushToken[frame,tok] }; }; name => { found: BOOLEAN; value: Object; <> IF ob.id.local THEN [found,value] _ TryToLoadLocal[frame,ob] ELSE [found,value] _ TryToLoad[frame,ob]; IF found THEN { MarkScope[frame,ob,value]; -- mark scope for array or string PushToken[frame,value] } ELSE { Push[frame.opstk,ob]; Push[frame.execstk,undefname] }; }; command => { <> <> mark: Node _ GetMark[frame.opstk]; DoCommand[frame,ob ! Error => Restore[frame.opstk,mark]]; }; exec => EXIT; -- back to where we started loop => ERROR Bug; -- should have been removed by loop control scope => SetLocalsTop[frame,ob.top]; ENDCASE => ERROR Bug; }; IF frame.abort THEN { Push[frame.execstk,interrupt]; frame.abort _ FALSE }; Process.Yield[]; ENDLOOP; }; GetAbort: PUBLIC PROC[frame: Frame] RETURNS[BOOLEAN] = { RETURN[frame.abort] }; SetAbort: PUBLIC PROC[frame: Frame, flag: BOOLEAN] = { frame.abort _ flag }; <<"Stop" clears the execution stack and returns to the caller>> <> Stop: PUBLIC PROC[frame: Frame] = { ERROR StopExecution; }; SingStep: PROC[frame: Frame, ob: Object] = { Push[frame.opstk, ob]; Push[frame.execstk, asstep]; Push[frame.execstk, step]; Push[frame.execstk, arfree]; }; MarkLoop: PUBLIC PROC[frame: Frame] = { Push[frame.execstk,[X,loop[]]] }; UnmarkLoop: PUBLIC PROC[frame: Frame] = { ob: Object _ Pop[frame.execstk]; Assert[ob.type=loop] }; MarkScope: PROC[frame: Frame, name: name Object, ob: Object] = INLINE { IF ob.tag=X THEN SELECT ob.type FROM array,string => { top: CARDINAL _ GetLocalsTop[frame]; Push[frame.execstk,[X,scope[top,name.id]]] }; ENDCASE; }; ScopeName: PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; WITH ob:ob SELECT FROM scope => Push[frame.opstk,[L,name[ob.id]]]; ENDCASE => ERROR Error[typechk]; }; <<"Exec" Moves the top of the operand stack to the top of the execution stack.>> Exec: PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; MarkScope[frame,anon,ob]; Push[frame.execstk, ob]; }; <<"If" is the implementation of the testing instruction.>> <> <> <> If: PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; bool: BOOLEAN _ PopBoolean[frame.opstk]; IF bool THEN Push[frame.execstk,ob]; }; <<"IfElse" is the implementation of the two way conditional execution>> <> <> <> IfElse: PROC[frame: Frame] = { obF: Object _ Pop[frame.opstk]; obT: Object _ Pop[frame.opstk]; bool: BOOLEAN _ PopBoolean[frame.opstk]; Push[frame.execstk,(IF bool THEN obT ELSE obF)]; }; <<"Rept" is the "loop for count" instruction. Two operands are required:>> <> <> Rept: PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; i: LONG INTEGER _ PopInteger[frame.opstk]; MarkLoop[frame]; Push[frame.execstk, ob]; PushInteger[frame.execstk, i]; Push[frame.execstk, reptcmd]; }; CRept: PROC[frame: Frame] = { i: LONG INTEGER _ PopInteger[frame.execstk]; ob: Object _ Top[frame.execstk]; IF i > 0 THEN { PushInteger[frame.execstk,i-1]; Push[frame.execstk, reptcmd]; Push[frame.execstk, ob] } ELSE { [] _ Pop[frame.execstk]; UnmarkLoop[frame]; }; }; <<"For" is based on the Algol "for i _ i step j until k do" instruction.>> <> <> <> For: PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; k: LONG INTEGER _ PopInteger[frame.opstk]; j: LONG INTEGER _ PopInteger[frame.opstk]; i: LONG INTEGER _ PopInteger[frame.opstk]; MarkLoop[frame]; Push[frame.execstk, ob]; PushInteger[frame.execstk, k]; PushInteger[frame.execstk, j]; PushInteger[frame.execstk, i]; Push[frame.execstk, forcmd]; }; CFor: PROC[frame: Frame] = { i: LONG INTEGER _ PopInteger[frame.execstk]; j: LONG INTEGER _ PopInteger[frame.execstk]; k: LONG INTEGER _ PopInteger[frame.execstk]; ob: Object _ Top[frame.execstk]; IF (IF j>0 THEN i>k ELSE i> <> Loop: PROC[frame: Frame] = { ob: Object _ Pop[frame.opstk]; MarkLoop[frame]; Push[frame.execstk, ob]; Push[frame.execstk, loopcmd]; }; CLoop: PROC[frame: Frame] = { ob: Object _ Top[frame.execstk]; Push[frame.execstk, loopcmd]; Push[frame.execstk, ob]; }; <<"Exit" pops the execution stack until the innermost loop is >> <> Exit: PROC[frame: Frame] = { UnwindExecStk[frame,TRUE]; IF Top[frame.execstk].type#exec THEN UnmarkLoop[frame]; }; <<"SingleStep" Sets stepflag in the execution module.>> <> <> SingleStep: PROC[frame: Frame] = { frame.astepflag _ frame.stepflag _ TRUE }; FreeRun: PROC[frame: Frame] = { frame.astepflag _ frame.stepflag _ FALSE }; ASingleStep: PROC[frame: Frame] = { frame.stepflag _ frame.astepflag }; AFreeRun: PROC[frame: Frame] = { frame.stepflag _ FALSE }; <> InstallExec: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM register => { <> rangechk _ MakeName[".rangechk"L]; typechk _ MakeName[".typechk"L]; undefname _ MakeName[".undefname"L]; limitchk _ MakeName[".limitchk"L]; syntaxerr _ MakeName[".syntaxerr"L]; stkovrflw _ MakeName[".stkovrflw"L]; execovrflw _ MakeName[".execovrflw"L]; <> step _ MakeName[".step"L]; interrupt _ MakeName[".interrupt"L]; anon _ MakeName["(anonymous)"L]; -- name for anonymous arrays and strings <> asstep _ RegisterInternal["@asinglestep"L, ASingleStep]; arfree _ RegisterInternal["@arunfree"L, AFreeRun]; sstep _ RegisterInternal["@singlestep"L, SingleStep]; rfree _ RegisterInternal["@runfree"L, FreeRun]; reptcmd _ RegisterInternal["@rept"L, CRept]; forcmd _ RegisterInternal["@for"L, CFor]; loopcmd _ RegisterInternal["@loop"L, CLoop]; <> RegisterExplicit[frame, ".scopename"L, ScopeName]; RegisterExplicit[frame, ".if"L, If]; RegisterExplicit[frame, ".ifelse"L, IfElse]; RegisterExplicit[frame, ".rept"L, Rept]; RegisterExplicit[frame, ".for"L, For]; RegisterExplicit[frame, ".loop"L, Loop]; RegisterExplicit[frame, ".exit"L, Exit]; RegisterExplicit[frame, ".stop"L, Stop]; RegisterExplicit[frame, ".interrupt"L, Stop]; RegisterExplicit[frame, ".exec"L, Exec]; RegisterExplicit[frame, ".singlestep"L, SingleStep]; RegisterExplicit[frame, ".runfree"L, FreeRun]; }; ENDCASE; }; Install[InstallExec]; }. Paxton January 7, 1981 2:28 PM use ArraySpread in exec loop instead of ArrayAtom Paxton January 7, 1981 3:42 PM change for name strings Paxton January 9, 1981 4:19 PM add local variables Wyatt 16-Apr-81 12:57:31 Pilot conversion Wyatt 24-Aug-81 12:33:02 add Process.Yield at bottom of Execute loop Wyatt 16-Sep-81 12:51:59 Rewrite