TJaMExecImpl.mesa
Copyright Ó 1985, 1986, 1991, 1992 by Xerox Corporation. All rights reserved.
Original version by John Warnock, January, 1978.
Bill Paxton, 29-Jan-82 15:45:10
Maureen Stone February 6, 1984 5:13:11 pm PST
Michael Plass, August 18, 1988 1:41:16 pm PDT
Doug Wyatt, December 27, 1992 1:46 pm PST
DIRECTORY
TJaM,
TJaMPrivate;
TJaMExecImpl: CEDAR PROGRAM
IMPORTS TJaM
EXPORTS TJaM
~ BEGIN OPEN TJaM, TJaMPrivate;
FrameImplRep: PUBLIC TYPE ~ TJaMPrivate.FrameImplRep;
RecursiveError: PUBLIC ERROR[error: ATOM] ~ CODE;
Error: PUBLIC ERROR[error: ATOM] ~ CODE;
Exit: PUBLIC SIGNAL ~ CODE;
Stop: PUBLIC ERROR ~ CODE;
ErrorAtom: TYPE ~ ATOM ¬; -- no default
ErrorArray: TYPE ~ ARRAY ErrorType OF ErrorAtom;
atomFromErrorType:
REF ErrorArray ~
NEW[ErrorArray ¬ [
nil: AtomFromRope[".nil"],
undefinedKey: AtomFromRope[".undefkey"],
wrongType: AtomFromRope[".typechk"],
boundsFault: AtomFromRope[".rangechk"],
invalidArgs: AtomFromRope[".badargs"],
numericOverflow: AtomFromRope[".overflow"],
stackUnderflow: AtomFromRope[".stkundflw"],
stackOverflow: AtomFromRope[".stkovrflw"],
dictionaryUnderflow: AtomFromRope[".dictundflw"],
dictionaryOverflow: AtomFromRope[".dictovrflw"],
attachmentCycle: AtomFromRope[".attachmentcycle"],
notAttached: AtomFromRope[".notattached"],
syntaxError: AtomFromRope[".syntaxerr"],
endOfStream: AtomFromRope[".endofstream"],
bug: AtomFromRope[".bug"]
]];
ProduceError:
PUBLIC
PROC[type: ErrorType] ~ {
atom: ATOM ~ atomFromErrorType[type];
ERROR Error[atom];
};
Execute:
PUBLIC
PROC[frame: Frame, x: Any] ~ {
impl: FrameImpl ~ frame.impl;
errorAtom: ATOM ¬ NIL;
IF impl.abort THEN { impl.abort ¬ FALSE; ERROR Stop };
{
ENABLE Error => { errorAtom ¬ error; CONTINUE };
WITH x
SELECT
FROM
atom: ATOM => ExecuteAtom[frame, atom];
cmd: Cmd => cmd.proc[frame, cmd];
ob: Ob =>
SELECT ob.tag
FROM
literal => Push[frame, ob.body];
executable => ExecuteBody[frame, ob.body];
ENDCASE => ProduceError[bug];
ENDCASE => Push[frame, x];
};
IF errorAtom#
NIL
THEN {
Push[frame, x];
ExecuteAtom[frame, errorAtom !
Error => IF error=errorAtom THEN ERROR RecursiveError[errorAtom]
];
};
};
undefName: ATOM ~ AtomFromRope[".undefname"];
ExecuteAtom:
PUBLIC
PROC[frame: Frame, atom:
ATOM] ~ {
found: BOOL; val: Any;
[found, val] ¬ TryToLoad[frame, atom];
IF found THEN { Execute[frame, val]; RETURN };
[found, val] ¬ TryToLoad[frame, undefName];
IF found THEN { PushAtom[frame, atom]; Execute[frame, val] };
};
ExecuteArray:
PUBLIC
PROC[frame: Frame, array: Array] ~ {
FOR i: NAT IN[0..array.len) DO Execute[frame, AGet[array, i]] ENDLOOP;
};
ExecuteBody:
PROC[frame: Frame, x: Any] ~ {
WITH x
SELECT
FROM
array: Array => ExecuteArray[frame, array];
rope: ROPE => ExecuteRope[frame, rope];
stream: STREAM => ExecuteStream[frame, stream];
ENDCASE => Execute[frame, x];
};
GetAbort:
PUBLIC
PROC[frame: Frame]
RETURNS[
BOOL] ~ {
impl: FrameImpl ~ frame.impl;
RETURN[impl.abort];
};
SetAbort:
PUBLIC
PROC[frame: Frame, b:
BOOL] ~ {
impl: FrameImpl ~ frame.impl;
impl.abort ¬ b;
};
ApplyStop: CommandProc ~ {
ERROR Stop;
};
ApplyExec: CommandProc ~ {
x: Any ~ Pop[frame];
Execute[frame, x];
};
ApplyIf: CommandProc ~ {
x: Any ~ Pop[frame];
b: BOOL ~ PopBool[frame];
IF b THEN Execute[frame, x];
};
ApplyIfElse: CommandProc ~ {
xF: Any ~ Pop[frame];
xT: Any ~ Pop[frame];
b: BOOL ~ PopBool[frame];
Execute[frame, IF b THEN xT ELSE xF];
};
ApplyRept: CommandProc ~ {
x: Any ~ Pop[frame];
n: INT ~ PopInt[frame];
THROUGH [0..n) DO Execute[frame, x ! Exit => EXIT] ENDLOOP;
};
ApplyFor: CommandProc ~ {
x: Any ~ Pop[frame];
k: INT ~ PopInt[frame];
j: INT ~ PopInt[frame];
i: INT ~ PopInt[frame];
IF j>=0
THEN
FOR n:
INT ¬ i, n+j
UNTIL n>k
DO
PushInt[frame, n]; Execute[frame, x ! Exit => EXIT];
ENDLOOP
ELSE
FOR n:
INT ¬ i, n+j
UNTIL n<k
DO
PushInt[frame, n]; Execute[frame, x ! Exit => EXIT];
ENDLOOP;
};
ApplyLoop: CommandProc ~ {
x: Any ~ Pop[frame];
DO Execute[frame, x ! Exit => EXIT] ENDLOOP;
};
ApplyExit: CommandProc ~ {
SIGNAL Exit;
};
RegisterPrimitive[".if", ApplyIf];
RegisterPrimitive[".ifelse", ApplyIfElse];
RegisterPrimitive[".rept", ApplyRept];
RegisterPrimitive[".for", ApplyFor];
RegisterPrimitive[".loop", ApplyLoop];
RegisterPrimitive[".exit", ApplyExit];
RegisterPrimitive[".stop", ApplyStop];
RegisterPrimitive[".interrupt", ApplyStop];
RegisterPrimitive[".exec", ApplyExec];
END.