obliqrt/src/ObEval.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE ObEval;
IMPORT Text, SynLocation, ObTree, ObValue, ObLib, ObBuiltIn,
NetObj, Thread;

  PROCEDURE Setup() =
    BEGIN
    END Setup;

  PROCEDURE LookupIde(name: ObTree.IdeName; place: ObTree.IdePlace;
    lValue: BOOLEAN; env: ObValue.Env; glob: ObValue.GlobalEnv;
    loc: SynLocation.T) : ObValue.Val RAISES {ObValue.Exception} =
  VAR i: INTEGER; val: ObValue.Val;
  BEGIN
    TYPECASE place OF
    | ObTree.IdePlaceGlobal(node) =>
      val := glob^[node.index-1];
    | ObTree.IdePlaceLocal(node) =>
      i := node.index;
      LOOP
	    (* IF i<0 THEN ObErr.Fault("Eval.LookupIde") END; *)
	    TYPECASE env OF
            (*
	    | NULL =>
	        ObErr.Fault("Eval.LookupIde: Unbound var: "
	          & ObTree.FmtIde(name, place, NIL));
            *)
	    | ObValue.LocalEnv(node) =>
	        IF i=1 THEN
	          (*
	          IF NOT ObTree.SameIdeName(name, node.name) THEN
		        ObErr.Fault("Eval.LookupIde");
	          END;
                  *)
	          val := node.val;
              EXIT;
	        ELSE
	          DEC(i);
	          env := node.rest;
	        END;
        ELSE <*ASSERT FALSE*>
	    END;
      END;
    ELSE <*ASSERT FALSE*>
    END;
    IF lValue THEN RETURN val;
    ELSE
      TYPECASE val OF
      | ObValue.ValVar(node) =>
        TRY RETURN node.remote.Get();
        EXCEPT NetObj.Error(atoms) =>
          ObValue.RaiseNetException(
            "on remote access to variable '" & name.text & "'", atoms, loc);
		  <*ASSERT FALSE*>
        END;
      ELSE RETURN val;
      END;
    END;
  END LookupIde;

  PROCEDURE TermBindingSeq(binding: ObTree.TermBinding; var: BOOLEAN;
      initEnv, env: ObValue.Env; glob: ObValue.GlobalEnv;
      mySelf: ObValue.RemObj): ObValue.Env
      RAISES {ObValue.Error, ObValue.Exception} =
    VAR val: ObValue.Val; env1: ObValue.Env;
    BEGIN
      TYPECASE binding OF
      | NULL => RETURN env;
      | ObTree.TermBinding(node) =>
          env1 := initEnv;
	  val:=Term(node.term, (*in-out*)env1, glob, mySelf);
	  IF var THEN val := ObValue.NewVar(val)  END;
	  RETURN
	    TermBindingSeq(node.rest, var, initEnv,
	      NEW(ObValue.LocalEnv, name:=node.binder, val:=val, rest:=env),
	      glob, mySelf);
      END;
    END TermBindingSeq;

  PROCEDURE TermBindingRec(binding: ObTree.TermBinding; var: BOOLEAN;
    env: ObValue.LocalEnv; glob: ObValue.GlobalEnv;
      mySelf: ObValue.RemObj): ObValue.Env
      RAISES {ObValue.Error, ObValue.Exception} =
  (* Executes definitions backwards, but it's ok since they are all
     functions. *)
    VAR val: ObValue.Val; dumFun: ObValue.ValFun; recEnv,recEnv1: ObValue.Env;
    BEGIN
      TYPECASE binding OF
      | NULL => RETURN env;
      | ObTree.TermBinding(node) =>
	  dumFun:=NEW(ObValue.ValFun, fun:=NIL, global:=NIL);
	  IF var
	  THEN val := ObValue.NewVar(dumFun);
          ELSE val:=dumFun;
	  END;
	  recEnv :=
	    TermBindingRec(node.rest, var,
	      NEW(ObValue.LocalEnv, name:=node.binder, val:=val, rest:=env),
              glob, mySelf);
          recEnv1 := recEnv;
          TYPECASE Term(node.term, (*in-out*)recEnv1, glob, mySelf) OF
          | ObValue.ValFun(valFun) =>
            dumFun.fun := valFun.fun;
            dumFun.global := valFun.global;
          ELSE ObValue.RaiseError("Recursive definition of a non-function",
                 binding.location);
          END;
          RETURN recEnv;
      END;
    END TermBindingRec;

  PROCEDURE Term(term: ObTree.Term;
      VAR (*in-out*)env: ObValue.Env; glob: ObValue.GlobalEnv;
      mySelf: ObValue.RemObj): ObValue.Val
      RAISES {ObValue.Error, ObValue.Exception} =
    TYPE Vals = REF ARRAY OF ObValue.Val;
    VAR  result: ObValue.Val;
    BEGIN
      IF interrupt THEN
        interrupt := FALSE;
        ObValue.RaiseError("Interrupt", term.location);
      END;
      TYPECASE term OF
      (* | NULL => ObErr.Fault("Eval.Term NIL"); *)
      | ObTree.TermIde(node) =>
	  result :=
            LookupIde(node.name, node.place, FALSE, env, glob, term.location);
      | ObTree.TermOk =>
	  result := ObValue.valOk;
      | ObTree.TermBool(node) =>
	  IF node.cache=NIL THEN
	    node.cache := NEW(ObValue.ValBool, bool:=node.bool);
	  END;
	  result := node.cache;
      | ObTree.TermChar(node) =>
	  IF node.cache=NIL THEN
	    node.cache := NEW(ObValue.ValChar, char:=node.char);
	  END;
	  result := node.cache;
      | ObTree.TermText(node) =>
	  IF node.cache=NIL THEN
	    node.cache := ObValue.NewText(node.text);
	  END;
	  result := node.cache;
      | ObTree.TermInt(node) =>
	  IF node.cache=NIL THEN
	    node.cache := NEW(ObValue.ValInt, int:=node.int, temp:=FALSE);
	  END;
	  result := node.cache;
      | ObTree.TermReal(node) =>
	  IF node.cache=NIL THEN
	    node.cache := NEW(ObValue.ValReal, real:=node.real, temp:=FALSE);
	  END;
	  result := node.cache;
      | ObTree.TermOption(node) =>
          VAR
            env1: ObValue.Env;
          BEGIN
            env1 := env;
	    result :=
              NEW(ObValue.ValOption,
                tag:=node.tag.text,
                val:=Term(node.term, (*in-out*)env1, glob, mySelf));
          END;
      | ObTree.TermAlias(node) =>
          VAR
            env1: ObValue.Env; val: ObValue.Val;
          BEGIN
            env1 := env;
            val := Term(node.term, (*in-out*)env1, glob, mySelf);
            TYPECASE val OF
            | ObValue.ValObj(obj) =>
              result := ObValue.NewAlias(obj, node.label.text, term.location);
            ELSE ObValue.RaiseError("Aliasing must operate on an object",
                    term.location);
            END;
          END;
      | ObTree.TermArray(node) =>
          VAR
            vals := NEW(Vals, node.elemsNo);
            argList := node.elems;
            env1: ObValue.Env;
          BEGIN
            FOR i := 0 TO node.elemsNo-1 DO
              env1 := env;
              vals[i]:=Term(argList.first, (*in-out*)env1, glob, mySelf);
              argList := argList.rest;
            END;
            result := ObValue.NewArrayFromVals(vals);
          END;
      | ObTree.TermOp(node) =>
        VAR
          argList := node.args;
          opCode := NARROW(node.opCode, ObLib.OpCode);
          argArray: ObValue.ArgArray;
          env1: ObValue.Env;
          msg: TEXT;
        BEGIN
          IF (opCode.arity >= -1) AND (node.argsNo # opCode.arity) THEN
            IF opCode.arity = -1 THEN
              msg := "Not expecting an argument list for procedure: " &
                         node.pkg.text & "_" & node.op.text;
            ELSIF node.argsNo = -1 THEN
              msg := "Expecting an argument list for procedure: " &
                         node.pkg.text & "_" & node.op.text;
            ELSE
              msg := ObValue.BadArgsNoMsg(opCode.arity, node.argsNo,
                         "procedure", node.pkg.text & "_" & node.op.text);
            END;
            ObValue.RaiseError(msg, term.location);
          END;
          IF node.argsNo > NUMBER(argArray) THEN
            ObValue.RaiseError("Too many arguments", term.location);
          END;
          FOR i:=1 TO node.argsNo DO
            env1 := env;
            argArray[i]:=Term(argList.first, (*in-out*)env1, glob, mySelf);
            argList := argList.rest;
          END;
          result :=
            NARROW(node.package, ObLib.T)
              .Eval(opCode, node.argsNo, argArray, node.temp, term.location);
        END;
      | ObTree.TermFun(node) =>
          VAR
            newGlob := NEW(ObValue.GlobalEnv, node.globalsNo);
            globals := node.globals;
          BEGIN
            FOR i:=0 TO node.globalsNo-1 DO
              newGlob^[i] :=
                LookupIde(globals.name, globals.place, TRUE, env, glob,
                  term.location);
              globals := globals.rest;
            END;
	    result := NEW(ObValue.ValFun, fun:=node, global:=newGlob);
          END;
      | ObTree.TermMeth(node) =>
          VAR
            newGlob := NEW(ObValue.GlobalEnv, node.globalsNo);
            globals := node.globals;
          BEGIN
            FOR i:=0 TO node.globalsNo-1 DO
              newGlob^[i] :=
                LookupIde(globals.name, globals.place, TRUE, env, glob,
                  term.location);
              globals := globals.rest;
            END;
	    result := NEW(ObValue.ValMeth, meth:=node, global:=newGlob);
          END;
      | ObTree.TermAppl(node) =>
        VAR
          env1, newEnv: ObValue.Env;
          newGlob: ObValue.GlobalEnv;
          binderList: ObTree.IdeList;
          argList: ObTree.TermList;
          val: ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.fun, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValFun(clos) =>
              IF node.argsNo # clos.fun.bindersNo THEN
                ObValue.RaiseError(ObValue.BadArgsNoMsg(clos.fun.bindersNo,
                  node.argsNo, "", ""), term.location);
              END;
              newGlob := clos.global;
              newEnv := NIL;
              binderList := clos.fun.binders;
              argList := node.args;
              FOR i:=1 TO node.argsNo DO
                env1 := env;
                newEnv :=
	          NEW(ObValue.LocalEnv,
	            name:=binderList.first,
	            val:=Term(argList.first, (*in-out*)env1, glob, mySelf),
	            rest:=newEnv);
	        binderList := binderList.rest;
                argList := argList.rest;
              END;
	      result := Term(clos.fun.body, (*in-out*)newEnv, newGlob, mySelf);
          | ObValue.ValEngine(engine) =>
              IF node.argsNo # 1 THEN
                ObValue.RaiseError(ObValue.BadArgsNoMsg(1,
                  node.argsNo, "", ""), term.location);
              END;
              env1 := env;
	      val:=Term(node.args.first, (*in-out*)env1, glob, mySelf);
	      TRY result := engine.remote.Eval(val, mySelf);
              EXCEPT
              | ObValue.ServerError(msg) =>
                  ObValue.RaiseError(msg, term.location);
              | NetObj.Error(atoms) =>
                  ObValue.RaiseNetException(
                    "on remote engine execution", atoms, term.location);
              END;
          ELSE ObValue.RaiseError("Application of a non-procedure",
                  term.location);
          END;
        END;
      | ObTree.TermObj(node) =>
        VAR
          sync: ObValue.Sync;
          fields := NEW(REF ObValue.ObjFields, node.fieldsNo);
          fieldList := node.fields;
          env1: ObValue.Env;
        BEGIN
          CASE node.sync OF
          | ObTree.Sync.None =>
            sync:=NIL;
          | ObTree.Sync.Monitored =>
            sync := NEW(ObValue.Sync, mutex := NEW(Thread.Mutex));
          ELSE <*ASSERT FALSE*>
          END;
          FOR i:=0 TO node.fieldsNo-1 DO
            env1:=env;
            fields^[i].label := fieldList.label.text;
            fields^[i].field:=
              Term(fieldList.term, (*in-out*)env1, glob, mySelf);
            fieldList := fieldList.rest;
          END;
          result := ObValue.NewObjectFromFields(fields, "",
              node.protected, sync);
        END;
      | ObTree.TermClone(node) =>
        VAR
          env1: ObValue.Env;
          objs: ObTree.TermList;
          remObjs: REF ARRAY OF ObValue.RemObj;
        BEGIN
          TRY
            IF node.objsNo=1 THEN
              env1 := env;
              TYPECASE Term(node.objs.first, (*in-out*)env1, glob, mySelf) OF
              | ObValue.ValObj(obj) =>
                  result := ObValue.ObjClone1(obj.remote, mySelf);
              ELSE ObValue.RaiseError("Arguments of clone must be objects",
                     term.location);
              END;
            ELSE
              objs := node.objs;
              remObjs := NEW(REF ARRAY OF ObValue.RemObj, node.objsNo);
              FOR i:=0 TO node.objsNo-1 DO
                env1 := env;
                TYPECASE Term(objs.first, (*in-out*)env1, glob, mySelf) OF
                | ObValue.ValObj(obj) =>
                    remObjs^[i] := obj.remote;
                ELSE ObValue.RaiseError("Arguments of clone must be objects",
                       term.location);
                END;
                objs := objs.rest;
              END;
              result := ObValue.ObjClone((*readonly*) remObjs^, mySelf);
            END;
          EXCEPT
          | ObValue.ServerError(msg) =>
              ObValue.RaiseError(msg, term.location);
          | NetObj.Error(atoms) =>
              ObValue.RaiseNetException(
                "on remote object cloning", atoms, term.location);
          END;
        END;
      | ObTree.TermRedirect(node) =>
        VAR
          env1: ObValue.Env;
          toObj: ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValObj(obj) =>
              env1 := env;
              toObj:=Term(node.toObj, (*in-out*)env1, glob, mySelf);
              TRY
                obj.remote.Redirect(toObj, obj.remote=mySelf);
              EXCEPT
              | ObValue.ServerError(msg) =>
                  ObValue.RaiseError(msg, term.location);
              | NetObj.Error(atoms) =>
                  ObValue.RaiseNetException(
                      "on remote object invocation", atoms, term.location);
              END;
              result := ObValue.valOk;
          ELSE ObValue.RaiseError("Redirection must operate on an object",
                  term.location);
          END;
        END;
      | ObTree.TermSelect(node) =>
        VAR
          env1: ObValue.Env;
          argList: ObTree.TermList;
          argArray: ObValue.ArgArray;
        BEGIN
          IF node.argsNo > NUMBER(argArray) THEN
            ObValue.RaiseError("Too many arguments.", term.location);
          END;
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValObj(obj) =>
              argList := node.args;
              FOR i:=1 TO node.argsNo DO
                env1 := env;
                argArray[i]:=Term(argList.first, (*in-out*)env1, glob, mySelf);
                argList := argList.rest;
              END;
              TRY
                IF node.invoke THEN
                  FOR i:=node.argsNo+1 TO NUMBER(argArray) DO
                    argArray[i] := NIL; (* Clear for transmission *)
                  END;
                  result := obj.remote.Invoke(node.label.text,
                    node.argsNo, argArray, obj.remote=mySelf,
                      (*var*) node.labelIndexHint);
                ELSE
                  result :=
                    obj.remote.Select(node.label.text, obj.remote=mySelf,
                       (*var*) node.labelIndexHint);
                END;
              EXCEPT
              | ObValue.ServerError(msg) =>
                  ObValue.RaiseError(msg, term.location);
              | NetObj.Error(atoms) =>
                  ObValue.RaiseNetException(
                      "on remote object invocation", atoms, term.location);
              END;
          ELSE ObValue.RaiseError("Selection must operate on an object",
                  term.location);
          END;
        END;
      | ObTree.TermUpdate(node) =>
        VAR
          env1: ObValue.Env;
          val: ObValue.Val;
        BEGIN
          env1 := env;
          TYPECASE Term(node.obj, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValObj(obj) =>
              env1 := env;
              val := Term(node.term, (*in-out*)env1, glob, mySelf);
              TRY
                obj.remote.Update(node.label.text, val, obj.remote=mySelf,
                  (*var*) node.labelIndexHint);
              EXCEPT
              | ObValue.ServerError(msg) =>
                  ObValue.RaiseError(msg, term.location);
              | NetObj.Error(atoms) =>
                  ObValue.RaiseNetException(
                      "on remote object update", atoms, term.location);
              END;
              result := ObValue.valOk;
          ELSE ObValue.RaiseError("Update must operate on an object",
                 term.location);
          END;
        END;
      | ObTree.TermSeq =>
        VAR
          term1 := term;
          env1 := env;
        BEGIN
          LOOP
            TYPECASE term1 OF
            | ObTree.TermSeq(seq) =>
              EVAL Term(seq.before, (*in-out*) env1, glob, mySelf);
              term1 := seq.after;
            ELSE
              result := Term(term1, (*in-out*) env1, glob, mySelf);
              EXIT;
            END;
          END;
        END;
      | ObTree.TermLet(node) =>
          IF node.rec THEN
            env :=
              TermBindingRec(node.binding, node.var, env, glob, mySelf);
          ELSE
            env :=
              TermBindingSeq(node.binding, node.var, env, env, glob, mySelf);
          END;
          result := ObValue.valOk;
      | ObTree.TermAssign(node) =>
        VAR
          env1: ObValue.Env;
          val: ObValue.Val;
        BEGIN
          TYPECASE LookupIde(node.name, node.place, TRUE, env, glob,
                             term.location) OF
          | ObValue.ValVar(var) =>
            env1 := env;
            val := Term(node.val, (*in-out*)env1, glob, mySelf);
            TRY var.remote.Set(val);
            EXCEPT NetObj.Error(atoms) =>
              ObValue.RaiseNetException(
                  "on remote assigment to variable '" & node.name.text & "'",
                  atoms, term.location);
            END;
          ELSE ObValue.RaiseError("Assigment must operate on a variable",
                 term.location);
          END;
          result := ObValue.valOk;
        END;
      | ObTree.TermIf(node) =>
        VAR
          env1: ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.test, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValBool(bool) =>
              IF bool.bool THEN
                env1 := env;
                result := Term(node.ifTrue, (*in-out*)env1, glob, mySelf);
              ELSIF node.ifFalse=NIL THEN
                result := ObValue.valOk;
              ELSE
                env1 := env;
                result := Term(node.ifFalse, (*in-out*)env1, glob, mySelf);
              END;
          ELSE ObValue.RaiseError("Conditional test must be a boolean",
                 term.location);
          END;
        END;
      | ObTree.TermCase(node) =>
        VAR
          env1: ObValue.Env;
          caseList: ObTree.TermCaseList;
        BEGIN
          env1 := env;
          TYPECASE Term(node.option, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValOption(option) =>
              caseList := node.caseList;
              LOOP
                IF caseList = NIL THEN
                  ObValue.RaiseError("No case branch applies to tag: " &
                    option.tag, term.location);
                END;
                IF caseList.tag = NIL THEN (* "else" case *)
                  env1 := env;
                  result := Term(caseList.body, (*in-out*)env1, glob, mySelf);
                  EXIT;
                END;
                IF Text.Equal(option.tag, caseList.tag.text) THEN
                  IF caseList.binder = NIL THEN
                    env1 := env;
                  ELSE
                    env1 := NEW(ObValue.LocalEnv, name:=caseList.binder,
	              val:=option.val, rest:=env);
                  END;
                  result := Term(caseList.body, (*in-out*)env1, glob, mySelf);
                  EXIT;
                END;
                caseList := caseList.rest;
             END;
          ELSE
            ObValue.RaiseError("Case over a non-option value", term.location);
          END;
        END;
      | ObTree.TermLoop(node) =>
        VAR
          env1: ObValue.Env;
        BEGIN
          TRY
            LOOP
              env1 := env;
              EVAL Term(node.loop, (*in-out*)env1, glob, mySelf);
            END;
          EXCEPT
          | ObValue.Error(pkt) =>
              IF NOT Text.Equal(pkt.msg, "exit") THEN
                RAISE ObValue.Error(pkt);
              END;
          END;
          result := ObValue.valOk;
        END;
      | ObTree.TermExit(node) =>
          RAISE
            ObValue.Error(
              NEW(ObValue.ErrorPacket,
                  msg:="exit", location:=node.location));
      | ObTree.TermFor(node) =>
        VAR
          env1: ObValue.Env;
          forEnv: ObValue.LocalEnv;
          lbVal, ubVal: ObValue.Val;
          i, ub: INTEGER;
        BEGIN
          env1 := env;
          lbVal := Term(node.lb, (*in-out*)env1, glob, mySelf);
          TYPECASE lbVal OF | ObValue.ValInt(node) => i:=node.int;
          ELSE ObValue.RaiseError("Lower bound of 'for' must be an integer",
                 term.location);
          END;
          env1 := env;
          ubVal := Term(node.ub, (*in-out*)env1, glob, mySelf);
          TYPECASE ubVal OF | ObValue.ValInt(node) => ub:=node.int;
          ELSE ObValue.RaiseError("Upper bound of 'for' must be an integer",
                 term.location);
          END;
          forEnv :=
            NEW(ObValue.LocalEnv, name:=node.binder, val:=NIL, rest:=env);
          TRY
            LOOP
              IF i>ub THEN EXIT END;
              forEnv.val := NEW(ObValue.ValInt, int:=i, temp:=FALSE);
              env1 := forEnv;
              EVAL Term(node.body, (*in-out*)env1, glob, mySelf);
              INC(i);
            END;
          EXCEPT
          | ObValue.Error(pkt) =>
              IF NOT Text.Equal(pkt.msg, "exit") THEN
                RAISE ObValue.Error(pkt);
              END;
          END;
          result := ObValue.valOk;
        END;
      | ObTree.TermForeach(node) =>
        VAR
          env1: ObValue.Env;
          forEnv: ObValue.LocalEnv;
          val, rangeVal: ObValue.Val;
          vals, oldVals, array1: Vals;
          i, ub: INTEGER;
        BEGIN
          env1 := env;
          rangeVal := Term(node.range, (*in-out*)env1, glob, mySelf);
          TYPECASE rangeVal OF
          | ObValue.ValArray(node) =>
            TRY array1:=node.remote.Obtain();
            EXCEPT NetObj.Error(atoms) =>
              ObValue.RaiseNetException(
                  "on remote array access", atoms, term.location);
            END;
          ELSE ObValue.RaiseError("Range of 'for' must be an array",
                 term.location);
          END;
          i := 0;
          forEnv :=
            NEW(ObValue.LocalEnv, name:=node.binder, val:=NIL, rest:=env);
          TRY
            ub := NUMBER(array1^);
            IF node.map THEN
              vals := NEW(Vals, ub);
            END;
            LOOP
              IF i>=ub THEN EXIT END;
              forEnv.val := array1^[i];
              env1 := forEnv;
              val := Term(node.body, (*in-out*)env1, glob, mySelf);
              IF node.map THEN vals^[i] := val END;
              INC(i);
            END;
          EXCEPT
          | ObValue.Error(pkt) =>
              IF NOT Text.Equal(pkt.msg, "exit") THEN
                RAISE ObValue.Error(pkt);
              ELSIF node.map THEN
                oldVals := vals;
                vals:=NEW(Vals, i);
                vals^ := SUBARRAY(oldVals^,0,i);
              END;
          | NetObj.Error(atoms) =>
               ObValue.RaiseNetException("for", atoms, node.location);
          END;
          IF node.map THEN
            result := ObValue.NewArrayFromVals(vals);
          ELSE
            result := ObValue.valOk;
          END;
        END;
      | ObTree.TermException(node) =>
        VAR
          env1: ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.name, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValText(str) =>
            result := NEW(ObValue.ValException, name:=str.text);
          ELSE ObValue.RaiseError("Argument of exception must be a text",
                 term.location);
          END;
        END;
      | ObTree.TermRaise(node) =>
        VAR
          env1: ObValue.Env;
        BEGIN
          env1 := env;
          TYPECASE Term(node.exception, (*in-out*)env1, glob, mySelf) OF
          | ObValue.ValException(exc) =>
              ObValue.RaiseException(exc, "", node.location);
          ELSE ObValue.RaiseError("Argument of raise must be an exception",
                 term.location);
          END;
        END;
      | ObTree.TermTry(node) =>
        VAR
          env1: ObValue.Env;
          tryList: ObTree.TermTryList;
        BEGIN
          TRY
            env1 := env;
            result := Term(node.body, (*in-out*)env1, glob, mySelf);
          EXCEPT
          | ObValue.Exception(packet) =>
             tryList := node.tryList;
             LOOP
               IF tryList = NIL THEN RAISE ObValue.Exception(packet) END;
               IF tryList.exception = NIL THEN (* "else" case *)
                 env1 := env;
                 result := Term(tryList.recover, (*in-out*)env1, glob, mySelf);
                 EXIT;
               END;
               env1 := env;
               TYPECASE Term(tryList.exception, (*in-out*)env1, glob, mySelf) OF
               | ObValue.ValException(exc) =>
                   IF ObValue.SameException(exc, packet.exception) THEN
                     env1 := env;
                     result :=
                       Term(tryList.recover, (*in-out*)env1, glob, mySelf);
                     EXIT;
                   END;
                   tryList := tryList.rest;
               ELSE ObValue.RaiseError("Guard of try must be an exception",
                   term.location);
               END;
             END;
          | ObValue.Error(packet) =>
             tryList := node.tryList;
             LOOP
               IF tryList = NIL THEN RAISE ObValue.Error(packet);END;
               IF tryList.exception = NIL THEN (* "else" case *)
                 env1 := env;
                 result := Term(tryList.recover, (*in-out*)env1, glob, mySelf);
                 EXIT;
               END;
               tryList := tryList.rest;
             END;
          END;
        END;
      | ObTree.TermTryFinally(node) =>
        VAR
          env1: ObValue.Env;
        BEGIN
          TRY
            env1 := env;
            result := Term(node.body, (*in-out*)env1, glob, mySelf);
          FINALLY
            env1 := env;
            result := Term(node.finally, (*in-out*)env1, glob, mySelf);
          END;
        END;
      | ObTree.TermWatch(node) =>
        VAR
          env1: ObValue.Env;
          myLocalSelf: ObValue.RemObjServer;
        BEGIN
          TYPECASE mySelf OF
          | NULL => myLocalSelf := NIL;
          | ObValue.RemObjServer(remObjServer) =>
              myLocalSelf := remObjServer;
          ELSE ObValue.RaiseError(
            "watch-until does not work on remote objects", term.location);
          END;
          env1 := env;
          TYPECASE Term(node.condition, (*in-out*)env1, glob, mySelf) OF
          | ObBuiltIn.ValCondition(cond) =>
              IF myLocalSelf=NIL THEN
                ObValue.RaiseError("watch-until must be used inside a method",
                  term.location);
              ELSIF myLocalSelf.sync=NIL THEN
                ObValue.RaiseError(
                  "watch-until must be used inside a protected object",
                  term.location);
              ELSE
                LOOP
                  env1 := env;
                  TYPECASE Term(node.guard, (*in-out*)env1, glob, mySelf) OF
                  | ObValue.ValBool(guard) =>
                      IF guard.bool THEN EXIT
                      ELSE Thread.Wait(myLocalSelf.sync.mutex, cond.condition);
                      END;
                  ELSE ObValue.RaiseError(
                    "Argument 2 of watch-until must be a boolean",
                     term.location);
                  END;
                END;
                result := ObValue.valOk;
              END;
          ELSE ObValue.RaiseError(
            "Argument 1 of watch-until must be a condition",
             term.location);
          END;
        END;
      ELSE <*ASSERT FALSE*>
      END;
      RETURN result;
    END Term;

  PROCEDURE Call(clos: ObValue.ValFun;
    READONLY args: ObValue.Vals; loc: SynLocation.T:=NIL): ObValue.Val
    RAISES {ObValue.Error, ObValue.Exception} =
  VAR env: ObValue.Env; binders: ObTree.IdeList;
  BEGIN
        IF clos.fun.bindersNo # NUMBER(args) THEN
          ObValue.RaiseError(ObValue.BadArgsNoMsg(clos.fun.bindersNo,
            NUMBER(args), "", ""), loc);
        END;
        env := NIL;
        binders := clos.fun.binders;
        FOR i := 0 TO NUMBER(args)-1 DO
          env := NEW(ObValue.LocalEnv,
                name := binders.first, val := args[i],
                rest := env);
          binders := binders.rest;
        END;
        RETURN Term(clos.fun.body, (*in-out*)env, clos.global, NIL);
  END Call;

  PROCEDURE CallEngine(engine: ObValue.ValEngine; arg: ObValue.Val;
    loc: SynLocation.T:=NIL): ObValue.Val
    RAISES {ObValue.Error, ObValue.Exception} =
   BEGIN
	      TRY RETURN engine.remote.Eval(arg, NIL);
              EXCEPT
              | ObValue.ServerError(msg) =>
                  ObValue.RaiseError(msg, loc); <*ASSERT FALSE*>
              | NetObj.Error(atoms) =>
                  ObValue.RaiseNetException(
                    "on remote engine execution", atoms, loc); <*ASSERT FALSE*>
              END;
  END CallEngine;

BEGIN
END ObEval.