-- JaMExec.mesa
-- Written by John Warnock, January, 1978.
-- Last changed by Doug Wyatt, December 8, 1980 12:54 PM

DIRECTORY
JaMExecDefs,
JaMMasterDefs
USING [CommandArray, Frame, Object, StackLink],
JaMArrayDefs
USING [ArrayAtom],
JaMControlDefs
USING [GetCommandArray, GetCurrentFrame, NotifyCommand,
NotifyStringObject, RegisterIntCommand],
JaMDictionaryDefs
USING [Load],
JaMFnsDefs
USING [PopBoolean],
JaMScannerDefs
USING [StreamToken, StringToken],
JaMStackDefs
USING [ClrStk, FreeLoc, MoveStkOps, Pop, Push, RestoreStk, Top],
JaMTypeChkDefs
USING [DescIntegerType],
JaMVMDefs
USING [CheckVM];

JaMExec: PROGRAM
IMPORTS JaMArrayDefs,JaMControlDefs,JaMDictionaryDefs,JaMFnsDefs,
JaMScannerDefs,JaMStackDefs,JaMTypeChkDefs,JaMVMDefs
EXPORTS JaMExecDefs =
BEGIN OPEN JaMStackDefs,JaMMasterDefs;

-- The following routines provide for the control of execution. It is
-- assumed that the current stack is the execution stack.

--"Execute" executes the undiscriminated object.

Execute: PUBLIC PROCEDURE =
BEGIN
-- Some Definitions:
SingStep: PROCEDURE [ob:Object] =
BEGIN
Push[ob,frame.opstk];
Push[asstep,frame.execstk];
Push[step,frame.execstk];
Push[arfree,frame.execstk];
END;
ob:Object;

-- Procedure Starts here.
frame:Frame ← JaMControlDefs.GetCurrentFrame[];

UNTIL frame.execstk↑ = NIL
DO ENABLE JaMError =>
BEGIN
Push[execute,frame.execstk];
RETRY;
END;
IF WakeUpFlag THEN
BEGIN
Push[Interrupt,frame.execstk];
WakeUpFlag ← FALSE;
END;
ob← Pop[frame.execstk];
IF ob.litflag = lit THEN
BEGIN
Push[ob,frame.opstk];
IF stepflag THEN SingStep[ob];
LOOP;
END;
WITH discrimob:ob SELECT FROM
IntegerType,
LongIntegerType,
RealType,
BooleanType,
DictType =>
BEGIN
Push[ob,frame.opstk];
IF stepflag THEN SingStep[ob];
END;
StreamType =>
BEGIN
dob:StreamType Object ←discrimob;
IF JaMScannerDefs.StreamToken[dob,frame.execstk ! JaMError =>
BEGIN
Push[dob,frame.opstk];
Push[execute,frame.execstk];
LOOP;
END] THEN
BEGIN
obj: Object = Pop[frame.execstk];
Push[JaMDictionaryDefs.Load[frame.dictstk,obj
! JaMError =>
BEGIN
Push[obj,frame.opstk];
Push[execute,frame.execstk];
LOOP;
END],
frame.execstk];
IF stepflag THEN SingStep[obj];
END;
END;
StringType =>
BEGIN
dob:StringType Object ←discrimob;
IF JaMScannerDefs.StringToken[dob,frame.execstk !JaMError =>
BEGIN
Push[dob,frame.opstk];
Push[execute,frame.execstk];
LOOP;
END] THEN
BEGIN
obj: Object = Pop[frame.execstk];
Push[JaMDictionaryDefs.Load[frame.dictstk,obj !JaMError =>
BEGIN
Push[obj,frame.opstk];
Push[execute,frame.execstk];
LOOP;
END],
frame.execstk];
IF stepflag THEN SingStep[obj];
END;
END;
CommandType =>
BEGIN
freemark:StackLink ← FreeLoc[];
commandarrayptr[discrimob.Command][!JaMError =>
BEGIN
IF restore THEN RestoreStk[freemark,frame.opstk];
Push[discrimob,frame.opstk];
Push[execute,frame.execstk];
LOOP;
END];
END;
ArrayType =>
BEGIN
dob:ArrayType Object ← discrimob;
[]←JaMArrayDefs.ArrayAtom[dob,frame.execstk];
END;
StackType => NULL;
FrameType => NULL;
ENDCASE;
ENDLOOP;

END;


--"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: PUBLIC PROCEDURE=
BEGIN
frame:Frame ← JaMControlDefs.GetCurrentFrame[];
ob:Object ← Pop[frame.opstk];
IF JaMFnsDefs.PopBoolean[] THEN Push[ob,frame.execstk];
END;

--"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: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
obF: Object ← Pop[frame.opstk];
obT: Object ← Pop[frame.opstk];
Push[IF JaMFnsDefs.PopBoolean[] THEN obT ELSE obF,frame.execstk];
END;

--"Rept" is the "loop for count" instruction. Two operands are required:
-- an IntegerType and an Object. The Object is executed for the number
-- of times indicated by the Integer. (0 for Negative).

Rept: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
ob: Object ← Pop[frame.opstk];
i: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.opstk]];
m: MarkType Object ← [nolit,MarkType[]];
Push[m,frame.execstk];
Push[ob,frame.execstk];
Push[i,frame.execstk];
Push[reptc,frame.execstk];
END;


CRept: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
i: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.execstk]];
ob: Object ← Top[frame.execstk];
IF i.IntegerVal > 0 THEN
BEGIN
i.IntegerVal ← i.IntegerVal -1;
Push[i,frame.execstk];
Push[reptc,frame.execstk];
Push[ob,frame.execstk];
END
ELSE
BEGIN
[]←Pop[frame.execstk];
[]←Pop[frame.execstk];
END;
END;

--"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: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
ob: Object ← Pop[frame.opstk];
k: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.opstk]];
j: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.opstk]];
i: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.opstk]];
m: MarkType Object←[nolit,MarkType[]];
i.IntegerVal ← i.IntegerVal - j.IntegerVal; --back up one
Push[m,frame.execstk];
Push[ob,frame.execstk];
Push[k,frame.execstk];
Push[j,frame.execstk];
Push[i,frame.execstk];
Push[forc,frame.execstk];
END;


CFor: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
i: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.execstk]];
j: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.execstk]];
k: IntegerType Object ← JaMTypeChkDefs.DescIntegerType[Pop[frame.execstk]];
ob: Object ← Top[frame.execstk];
i.IntegerVal ← i.IntegerVal + j.IntegerVal;
IF (IF j.IntegerVal > 0 THEN i.IntegerVal > k.IntegerVal
ELSE i.IntegerVal < k.IntegerVal)
THEN BEGIN
[] ← Pop[frame.execstk];
[] ← Pop[frame.execstk];
END
ELSE BEGIN
Push[k,frame.execstk];
Push[j,frame.execstk];
Push[i,frame.execstk];
Push[forc,frame.execstk];
Push[i,frame.opstk];
Push[ob,frame.execstk];
END;
END;

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

Loop: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
ob: Object ← Pop[frame.opstk];
m: MarkType Object ← [nolit,MarkType[]];
Push[m,frame.execstk];
Push[ob,frame.execstk];
Push[loopc,frame.execstk];
END;


CLoop: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
ob: Object ← Top[frame.execstk];
Push[loopc,frame.execstk];
Push[ob,frame.execstk];
END;

-- "Exec" Moves the top of the operand stack to the top of the execution stack.

Exec: PUBLIC PROCEDURE =
BEGIN
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
JaMStackDefs.MoveStkOps[frame.opstk,frame.execstk,1];
END;

-- "Stop" clears the execution stack.

Stop: PUBLIC PROCEDURE =
BEGIN
frame:Frame ← JaMControlDefs.GetCurrentFrame[];
JaMVMDefs.CheckVM[];
ClrStk[frame.execstk];
END;


-- "Exit" pops the execution stack until the innermost loop is
-- terminated. (until a mark is encountered).

Exit: PUBLIC PROCEDURE =
BEGIN
ob: Object;
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
DO
ob ← Pop[frame.execstk];
WITH dob:ob SELECT FROM
MarkType => RETURN;
ENDCASE;
ENDLOOP;
END;

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

SingleStep: PUBLIC PROCEDURE =
BEGIN
astepflag ← TRUE;
stepflag ← TRUE;
END;


--"FreeRun" Resets stepflag in the execution module.

FreeRun: PUBLIC PROCEDURE =
BEGIN
astepflag ← FALSE;
stepflag ← FALSE;
END;

--"ASingleStep" Sets astepflag in the execution module.

ASingleStep: PUBLIC PROCEDURE =
BEGIN
stepflag ← TRUE AND astepflag;
END;


--"AFreeRun" Resets stepflag in the execution module.

AFreeRun: PUBLIC PROCEDURE =
BEGIN
stepflag ← FALSE;
END;

--"JaMError" is an error that is caught by execution control. The
-- restore parameter is used to indicate to execution control if it
-- is safe to restore the operand stack. execute is the StringType Object
-- that will be pushed onto the execution stack.

JaMError: PUBLIC ERROR [execute:StringType Object,restore:BOOLEAN]=CODE;


WakeUpFlag: BOOLEAN ← FALSE;
SetWakeUp: PUBLIC PROCEDURE[flag: BOOLEAN] = BEGIN WakeUpFlag←flag END;
GetWakeUp: PUBLIC PROCEDURE RETURNS[BOOLEAN] = BEGIN RETURN[WakeUpFlag] END;

--this is module initialization code.

commandarrayptr: POINTER TO CommandArray ←
JaMControlDefs.GetCommandArray[];

stepflag: BOOLEAN ← FALSE;
astepflag: BOOLEAN ← FALSE;

step: StringType Object;
Interrupt: StringType Object;

asstep: CommandType Object;
arfree: CommandType Object;
sstep: CommandType Object;
rfree: CommandType Object;
reptc: CommandType Object;
forc: CommandType Object;
loopc: CommandType Object;

StartExec: PROCEDURE =
BEGIN OPEN JaMControlDefs;

asstep ← RegisterIntCommand[ASingleStep];
arfree ← RegisterIntCommand[AFreeRun];
sstep ← RegisterIntCommand[SingleStep];
rfree ← RegisterIntCommand[FreeRun];
reptc ← RegisterIntCommand[CRept];
forc ← RegisterIntCommand[CFor];
loopc ← RegisterIntCommand[CLoop];

NotifyStringObject[@step, ".step"L];
NotifyStringObject[@Interrupt, ".interrupt"L];

NotifyCommand[".if"L,If];
NotifyCommand[".ifelse"L,IfElse];
NotifyCommand[".rept"L,Rept];
NotifyCommand[".for"L,For];
NotifyCommand[".loop"L,Loop];
NotifyCommand[".exit"L,Exit];
NotifyCommand[".stop"L,Stop];
NotifyCommand[".interrupt"L,Stop];
NotifyCommand[".exec"L,Exec];
NotifyCommand[".singlestep"L,SingleStep];
NotifyCommand[".runfree"L,FreeRun];
END;

-- initialization
StartExec;

END.

DKW March 28, 1980 4:45 PM
added StartExec

DKW March 29, 1980 3:54 PM
in Execute, replaced CONTINUE everywhere by LOOP. Is this right???

DKW April 1, 1980 3:19 PM
now uses NotifyCommand, NotifyStringObject

DKW April 1, 1980 11:32 PM
Stop no longer updates commandindexcount; JaMControl takes care of it

DKW September 29, 1980 11:51 AM
changed WakeUp to SetWakeUp, added GetWakeUp

DKW December 8, 1980 12:53 PM
cleaned up CRept, CLoop