
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.
  @  
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

Э╩э  Ц(cedarcode) styleХNewlineDelimiter
Щ codeЪЬЩKЪЬ
╧eЬCЩNKЪЬ0Щ0KЪЬЩKЩ-KЩ-KЩ)ЧKШ Ъ╧k	Ш	KЪЬШKЪЬШЧKШ KЪ╨blЬЮЬЮШKЪЮЬШKЪЮЬШKЪЬЮЬЮЬШKШ KЪЬЮЬЮЬШ5KШ KЪ
╧nЬЮЬЮЬЮЬЮЬШ1KЪ
аЬЮЬЮЬЮЬЮЬШ(KЪаЬЮЬЮЬЮЬШKЪаЬЮЬЮЬЮЬШKШ KЪЬЮЬЮЬ╧cШ'KЪЬЮЬЮЬЮЬШ0ЪЬЮЬЮЬШ6KЪЬШKЪЬ(Ш(KЪЬ$Ш$KЪЬ'Ш'KЪЬ&Ш&KЪЬ+Ш+KЪЬ+Ш+KЪЬ*Ш*KЪЬ1Ш1KЪЬ0Ш0KЪЬ2Ш2KЪЬ*Ш*KЪЬ(Ш(KЪЬ*Ш*KЪЬШKЪЬШЧKШ ЪаЬЮЬЮЬШ.KЪЬЮЬШ%KЪЮЬШKШKШ ЧЪаЬЮЬЮЬШ.KШKЪЬЮЬЮЬШKЪЮЬЮЬЮЬЮЬШ6KЪЬШKЪЮЬЮЬШ0ЪЮЬЮЬЮШKЪЬЮЬШ'KШ!ЪЬ
ЮЬЮШKЪЬ Ш KЪЬ*Ш*KЪЮЬШЧKЪЮЬШЧKШЪЮЬЮЬЮЬШKШЪЬШKЪЬ	ЮЬЮЬЮЬШ@KЪЬШЧKШЧKШKШ ЧKЪЬЮЬШ-KШ ЪаЬЮЬЮЬЮЬШ6KЪЬЮЬШKШ&KЪЮЬЮЬЮЬШ.KЪЬ+Ш+KЪЮЬЮЬ0Ш=KЪЬШKШ ЧЪаЬЮЬЮЬ Ш9KЪ
ЮЬЮЬЮЬЮЬ ЮЬШFKШKШ ЧЪаЬЮЬШ+ЪЮЬЮЬЮШKШ+KЪЬЮЬШ'KЪЬЮЬ!Ш/KЪЮЬШЧKШKШ ЧKЩ Ъ
аЬЮЬЮЬЮЬЮЬШ5KШKЪЮЬШKЪЬШKШ ЧЪаЬЮЬЮЬЮЬШ0KШKЪЬШKЪЬШЧKШ Ъа	ЬШKЪЮЬШKШKШ ЧЪа	ЬШKЪЬШKЪЬШKШKШ ЧЪаЬШKЪЬШKЪЬЮЬШKЪЮЬЮЬШKШKШ ЧЪаЬШKЪЬШKЪЬШKЪЬЮЬШKЪЬЮЬЮЬЮЬШ%KШKШ ЧЪа	ЬШKЪЬШKЪЬЮЬШKЪЮЬЮЬЮЬЮЬШ;KШKШ ЧЪаЬШKЪЬШKЪЬЮЬШKЪЬЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮЬ
ЮЬЮШ-KЪЬ.ЮЬШ4KЪЮШЧЪ	ЮЬЮЬЮЬ
ЮЬЮШ%KЪЬ.ЮЬШ4KЪЮЬШЧKШKШ ЧЪа	ЬШKЪЬШKЪЮЬЮЬЮЬШ,KШKШ ЧЪа	ЬШKЪЮЬШKШKШ ЧKШ"KШ*KШ&KШ$KШ&KШ&KШ&KШ+KШ&KШ KЪЮЬШЧ ЕЧ    ╢  у  