-- 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
(600)\1013b7B2405b2B404b6B419b4B334b7B661b3B588b6B867b4B235b7B253b4B179b4B242b4B350b10B127b7B133b11B124b8B314b8B96b9B63b9B496b9B