-- JaMExecImpl.mesa
-- Original version by John Warnock, January, 1978.
-- Last changed by Bill Paxton, January 21, 1981  3:25 PM
-- Last changed by Doug Wyatt, 19-Feb-82 10:55:12

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],
  JaMVM USING [Check],
  Process USING [Yield];

JaMExecImpl: PROGRAM
IMPORTS JaMOps, JaMVM, Process
EXPORTS JaMOps = {
OPEN JaMOps, JaMInternal, JaMBasic;

-- Globals

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;

-- Errors

Error: PUBLIC ERROR[error: Object, restore: BOOLEAN _ TRUE] = 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];
  };

-- The main execution procedure
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 => {
	  -- To execute a stream Object: get characters from the stream until a token
	  -- is recognized or end of stream is encountered. If a token was found,
	  -- push the stream object back onto the stack, then push the token.
	  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 => {
	  -- To execute a string Object: take characters from the front of the string
	  -- until a token is recognized or the string is emptied. If a token was found,
	  -- push the remainder of the string back onto the stack, then push the token.
	  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 => {
	  -- To execute an array Object: take the first element of the array
	  -- as a token if the array is not empty. If a token was obtained,
	  -- push the remaining subarray back onto the stack, then push the token.
	  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;
	  -- To execute a name, look it up in the appropriate context
	  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 => {
	  -- to execute a command, call the corresponding procedure
	  -- restore the opstk if an error occurs (and only Pops have been done)
	  mark: Node _ GetMark[frame.opstk];
	  DoCommand[frame,ob ! Error => IF restore THEN 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
-- of the outermost instance of Execute.

Stop: PUBLIC PROC[frame: Frame] = {
  JaMVM.Check[];
  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.
--Two operands are required: an Object and a Boolean. If the
--Boolean is TRUE then the object is executed otherwise the 
--object is popped.

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
--instruction. Three operands are required: Object1,Object2, and a  Boolean.
-- If the Boolean is TRUE then Object2 is executed otherwise Object1 is 
--executed.

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:
-- an integer and an Object. The Object is executed for the number
-- of times indicated by the integer. (0 for Negative).

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.
-- Four operands are required: three IntegerTypes and an Object.
-- The Object is executed for each iteration, with the current loop index on
--  the operand stack. 

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<k) THEN {
    [] _ Pop[frame.execstk];
    UnmarkLoop[frame] }
  ELSE {
    PushInteger[frame.execstk, k];
    PushInteger[frame.execstk, j];
    PushInteger[frame.execstk, i+j];
    Push[frame.execstk, forcmd];
    PushInteger[frame.opstk, i];
    Push[frame.execstk, ob] };
  };

--"Loop" is the "loop forever" instruction. One operand is required:
-- The Object is executed until an ".exit" command is executed.

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 
-- terminated. (until a mark is encountered).

Exit: PROC[frame: Frame] = {
  UnwindExecStk[frame,TRUE];
  IF Top[frame.execstk].type#exec THEN UnmarkLoop[frame];
  };

--"SingleStep" Sets stepflag in the execution module.
-- Each token is put on the operand stack
--  and ".step" is executed followed by the token.

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 };

-- Initialization

InstallExec: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
  register => {
    -- Errors
    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];
    -- Known names
    step _ MakeName[".step"L];
    interrupt _ MakeName[".interrupt"L];
    anon _ MakeName["(anonymous)"L]; -- name for anonymous arrays and strings
    -- Internal commands
    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];
    -- Execution commands
    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

Wyatt  19-Feb-82 10:54:50
	add restore parameter to Error