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: 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: PROC[frame: Frame] = {
ob: Object _ Pop[frame.opstk];
MarkScope[frame,anon,ob];
Push[frame.execstk, ob];
};


If: PROC[frame: Frame] = {
ob: Object _ Pop[frame.opstk];
bool: BOOLEAN _ PopBoolean[frame.opstk];
IF bool THEN Push[frame.execstk,ob];
};


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: 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: 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: 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: PROC[frame: Frame] = {
UnwindExecStk[frame,TRUE];
IF Top[frame.execstk].type#exec THEN UnmarkLoop[frame];
};


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



	¦JaMExecImpl.mesa
Original version by John Warnock, January, 1978.
Bill Paxton, 29-Jan-82 15:45:10
Doug Wyatt, 22-Oct-81 12:40:34
Russ Atkinson, July 22, 1983 6:12 pm
Globals
Errors
The main execution procedure
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.
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.
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.
To execute a name, look it up in the appropriate context
to execute a command, call the corresponding procedure
restore the opstk if an error occurs (and only Pops have been done)
"Stop" clears the execution stack and returns to the caller
of the outermost instance of Execute.
"Exec" Moves the top of the operand stack to the top of the execution stack.
"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.
"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.
"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).
"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. 
"Loop" is the "loop forever" instruction. One operand is required:
The Object is executed until an ".exit" command is executed.
"Exit" pops the execution stack until the innermost loop is 
terminated. (until a mark is encountered).
"SingleStep" Sets stepflag in the execution module.
Each token is put on the operand stack
and ".step" is executed followed by the token.
Initialization
Errors
Known names
Internal commands
Execution commands
�Ê
j˜š
œ™Jš
œ0™0Jš
œ™Jš
œ™J™$—J˜š
Ïk	˜	Jšœ	�œ
˜Jšœ�œ˜/šœ�˜Jš
œÓ˜Ó—Jšœ�œ	˜J˜—šœ
�˜Jš�œ˜Jš�œ˜Jš�œ˜#J˜—š
œ™J˜Jšœ%�œÏc˜NJšœ-ž˜AJ˜!J˜AJ˜—š
œ™J˜Jšœ�œ
�œ�œ
˜*Jšœ�œ
�œ�œ
˜1Jšœ�œ
�œ�œ
˜Jšœ�œ�œ
˜J˜—šÏnœ�œ�œ˜IJ˜4J˜8J˜3J˜7š�œ�˜Jšœ�œ˜!Jšœ�œ
˜$Jš�œ�œ˜—J˜J˜—šŸ
œ�œ�œ�œ˜<šŸœ�œ
�œ
�œ˜+š�œ�œ
�˜Jš	œ
�œ�œ
�œ
�œ˜'J˜J˜$Jš�œ
˜—Jš�œ
�œ˜—Jšœ;�œ˜AJ˜J˜—Jš
œ™šŸœ�œ
�œ˜2Jšœ�œ˜*š�œ�œ˜)Jšœ:�œ˜BJšœ)�œ˜4Jš�œ˜—Jš�œ˜J˜J˜—šŸœ�œ"˜4Jšœ�
œž.˜NJšœž!˜=š
�˜Jšœ!ž!˜BJš�œ�
œ
�œž-˜Sš�œ˜š�œ˜Jšœž˜2Jšœž˜,Jš�œž˜—šŸ	œ�œ�œ˜5Jš	œ�œ	�
œ
�œ
�œ˜BJ˜—š�œ�œ
�˜Jšœ�œž˜%Jšœ=ž˜N˜Jš
œH™HJš
œD™DJš
œ@™@Jšœ
�œ˜"J˜ J˜)Jš�œ�œ1˜>Jš�œ˜Jš�œ�œ˜,J˜—˜Jš
œH™HJš
œK™KJš
œJ™JJšœ
�œ"˜6J˜.š�œ�œ˜Jš�œ�œ˜-J˜—Jš�œ�œ˜,J˜—˜
Jš
œ?™?Jš
œ>™>Jš
œE™EJšœ�œ!˜/J˜š�œ�œ˜Jš�œ�œ˜-J˜—J˜—šœ�œ˜(Jš
œ8™8Jš�œ
�œ)˜<Jš�œ%˜)š�œ�œ˜Jšœž!˜<J˜—Jš�œ9˜=J˜—˜Jš
œ6™6Jš
œC™CJ˜"J˜9J˜—Jšœ�œž˜)Jšœ�œž+˜>J˜$Jš�œ�œ˜—J˜—Jš�œ
�œ0�œ˜KJ˜Jš�œ
˜—J˜J˜—JšŸœ�œ
�œ�œ
�œ�œ˜OJšŸœ�œ
�œ�œ˜LJ˜Jš
œ;™;Jš
œ%™%J˜šŸœ�œ
�œ˜#Jš�œ˜J˜J˜—šŸœ�œ˜,J˜J˜J˜J˜J˜J˜—šŸœ�œ
�œ˜'Jšœ�
œ˜!J˜—šŸ
œ�œ
�œ˜)J˜8J˜—šŸ	œ�œ0�œ˜Gš	�œ�
œ
�œ
�œ	�˜$˜Jšœ�œ˜$Jšœ�
œ˜-—Jš�œ
˜—J˜J˜—šŸ	œ�œ˜!J˜š�œ�œ
�˜Jšœ�
œ˜+Jš�œ�œ˜ —J˜J˜—Jš
œL™LJ˜šŸœ�œ˜J˜J˜J˜J˜J˜—Jš
œ6™6Jš
œ:™:Jš
œ:™:Jš
œ™J˜šŸœ�œ˜J˜Jšœ�œ˜(Jš�œ�œ˜$J˜J˜—Jš
œC™CJš
œJ™JJš
œE™EJš
œ	™	J˜šŸœ�œ˜J˜J˜Jšœ�œ˜(Jšœ�œ�œ�œ˜0J˜J˜—Jš
œF™FJš
œ?™?Jš
œ4™4J˜šŸœ�œ˜J˜Jšœ�œ
�œ˜*J˜J˜J˜J˜J˜J˜—šŸœ�œ˜Jšœ�œ
�œ˜,J˜ š�œ�œ˜J˜J˜J˜—š�œ˜J˜J˜J˜—J˜J˜—Jš
œF™FJš
œ=™=Jš
œI™IJš
œ™J˜šŸœ�œ˜J˜Jšœ�œ
�œ˜*Jšœ�œ
�œ˜*Jšœ�œ
�œ˜*J˜J˜J˜J˜J˜J˜J˜J˜—šŸœ�œ˜Jšœ�œ
�œ˜,Jšœ�œ
�œ˜,Jšœ�œ
�œ˜,J˜ š
�œ�œ�œ�œ�œ˜$J˜J˜—š�œ˜J˜J˜J˜ J˜J˜J˜—J˜J˜—Jš
œB™BJš
œ<™<J˜šŸœ�œ˜J˜J˜J˜J˜J˜J˜—šŸœ�œ˜J˜ J˜J˜J˜J˜—Jš
œ<™<Jš
œ*™*J˜šŸœ�œ˜Jšœ�œ˜Jš�œ�œ˜7J˜J˜—Jš
œ3™3Jš
œ&™&Jš
œ.™.J˜JšŸ
œ�œ6�œ˜MJšŸœ�œ6�œ˜KJšŸœ�œ6˜GJšŸœ�œ$�œ˜:J˜Jš
œ™J˜šŸœ�œ'�œ�˜G˜
Jš
œ™J˜"J˜ J˜$J˜"J˜$J˜$J˜&Jš
œ™J˜J˜$Jšœ!ž(˜IJš
œ™J˜8J˜2J˜5J˜/J˜,J˜)J˜,Jš
œ™J˜2J˜$J˜,J˜(J˜&J˜(J˜(J˜(J˜-J˜(J˜4J˜.J˜—Jš�œ
˜J˜J˜—J˜J˜J˜J˜šœ�˜ J˜1J˜—šœ�˜ J˜J˜—šœ�˜ J˜J˜—˜J˜J˜—˜J˜+J˜—˜J˜J˜J˜J˜——…—$,8<