-- JaMExec.mesa
-- Written by John Warnock, January, 1978.
-- Last changed by Doug Wyatt, February 10, 1981  7:21 PM

DIRECTORY
	JaMExecDefs,
	JaMMasterDefs USING [Frame, Object, StackLink],
	JaMArrayDefs USING [ArrayAtom],
	JaMControlDefs USING [DoCommand, GetCurrentFrame,
		RegisterCommand, RegisterIntCommand],
	JaMDictionaryDefs USING [Load],
	JaMFnsDefs USING [PopBoolean],
	JaMLiteralDefs USING [MakeStringObject],
	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,
	JaMLiteralDefs,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[];
		JaMControlDefs.DoCommand[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;

WakeUpFlag: BOOLEAN _ FALSE;
SetWakeUp: PUBLIC PROCEDURE[flag: BOOLEAN] = BEGIN WakeUpFlag_flag END;
GetWakeUp: PUBLIC PROCEDURE RETURNS[BOOLEAN] = BEGIN RETURN[WakeUpFlag] 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;

-- Standard errors are defined here and exported

badbcdfile, badname, commandovrflw, dictfull, longname, nostream,
 overflow, rangechk, sizechk, stkovrflw, stkundflw, syntaxerr,
 typechk, undefkey, unregistered: PUBLIC StringType Object;

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;

-- Initialization

{ OPEN JaMControlDefs;
asstep _ RegisterIntCommand[ASingleStep];
arfree _ RegisterIntCommand[AFreeRun];
sstep  _ RegisterIntCommand[SingleStep];
rfree  _ RegisterIntCommand[FreeRun];
reptc  _ RegisterIntCommand[CRept];
forc   _ RegisterIntCommand[CFor];
loopc  _ RegisterIntCommand[CLoop];
};

STOP;

{ OPEN JaMLiteralDefs;
step _ MakeStringObject[".step"L];
Interrupt _ MakeStringObject[".interrupt"L];
-- Errors..
badbcdfile _ MakeStringObject[".badbcdfile"L];
badname _ MakeStringObject[".badname"L];
commandovrflw _ MakeStringObject[".commandovrflw"L];
dictfull _ MakeStringObject[".dictfull"L];
longname _ MakeStringObject[".longname"L];
nostream _ MakeStringObject[".nostream"L];
overflow _ MakeStringObject[".overflow"L];
rangechk _ MakeStringObject[".rangechk"L];
sizechk _ MakeStringObject[".sizechk"L];
stkovrflw _ MakeStringObject[".stkovrflw"L];
stkundflw _ MakeStringObject[".stkundflw"L];
syntaxerr _ MakeStringObject[".syntaxerr"L];
typechk _ MakeStringObject[".typechk"L];
undefkey _ MakeStringObject[".undefkey"L];
unregistered _ MakeStringObject[".unregistered"L];
};

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

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

DKW  February 10, 1981  2:26 PM
	now uses JaMControlDefs.DoCommand
(670)