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
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;
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] = 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 => 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] = {
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