-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.

prim c_++ {
#ifdef INDEXED_FIELDS
#include "error.h"
#else
extern "C++" {
#include "error.h"
}
#endif
#include "selectors.h"
};

--DOC The `handle_system_errors' method executes its argument
--DOC closure. Any Cecil errors (e.g., `error' or `exit' calls) caused
--DOC during evaluation of the closure are caught and suppressed.  The
--DOC boolean return value indicates whether an error occurred.
method handle_system_errors(cl:&():void):bool (** sends(eval([cl])),
					          return_type(true,false),
					          formals_escape(f) **) {
    prim c_++: " {

  // install a new longjump handler to catch any errors
  jmp_buf saved_buf;
  memcpy(saved_buf, errorJumpLocation, sizeof(saved_buf));
  bool saved_set = errorLocationSet;
  errorLocationSet = true;

  // mark this frame as one calling Cecil,
  // and remember where the ooplists are so we can cut them back upon error
  FrameMarker frame_marker(CallingCecilFrame);
  OOP dummy = 0;
  RegisteredOOP oop_marker(dummy);
  OOPList0 dummy_list;
  RegisteredOOPList ooplist_marker(&dummy_list, 0);

  // evaluate the argument closure, catching errors
  OOP had_error;
  OOP res;
  ReturnCode nlr_target;
  OOP nlr_arg;
  if (setjmp(errorJumpLocation)) {
    // we handled an error: stop propagating
    printf(\"Recovering from error\\n\");
    // cut back the stacks of remembered oops, etc.
    cleanupAfterLongjmp(&frame_marker, &oop_marker, &ooplist_marker);
    // convert to a regular return
    had_error = BASE(true);
    nlr_target = NRM_RET;	// to disable thinking it's an nlr
  } else {
    // send eval to the closure argument
#ifdef DISPATCHERS
    SEND_NO_PROP(res, nlr_target, nlr_arg, eval, 0, 1, (cl), \"1#handle_system_errors(a)\")
#else
    SEND_NO_PROP(res, nlr_target, eval, 0, 1, (cl), \"1#handle_system_errors(a)\")
    nlr_arg = res;
#endif
    // if we get here, then the closure returned without error (but maybe NLR)
    had_error = BASE(false);
  }

  // un-install the longjump handler
  errorLocationSet = saved_set;
  memcpy(errorJumpLocation, saved_buf, sizeof(saved_buf));

  // now propagate nlr's, if there was one
  if (nlr_target != NRM_RET) {
     NLRBP(nlr_arg, nlr_target);
  }

  // return whether there was an error
#ifdef DISPATCHERS
  RETURN(had_error);
#else
  BP(had_error);
#endif
} " }


(--DOC
  The `unwind_protect' method allows a "clean up" closure to be
  executed whenever control returns through the `unwind_protect' method
  call, either normally, via a non-local return, or via a Cecil
  error. The `cl' closure is invoked. When control returns from this
  invocation, the `on_return' closure is invoked. When this closure
  completes, the returning of the `cl' closure is resumed. If the `cl'
  closure returned normally, the result of this closure is returned as
  the result of the `unwind_protect method'; otherwise it continues to
  throw whatever exception the body did.  (`unwind_protect' is similar
  to the like-named construct in Common Lisp.)
--)
method unwind_protect(cl:&():`T, on_return:&():void):T
                     (** sends(r1 = eval([cl]), eval([on_return])),
		         return_type(r1),
		         formals_escape(f,f) **) {
    prim c_++: " {

  // install a new longjump handler to catch any errors
  jmp_buf saved_buf;
  memcpy(saved_buf, errorJumpLocation, sizeof(saved_buf));
  bool saved_set = errorLocationSet;
  errorLocationSet = true;

  // mark this frame as one calling Cecil,
  // and remember where the ooplists are so we can cut them back upon error
  FrameMarker frame_marker(CallingCecilFrame);
  OOP dummy = 0;
  RegisteredOOP oop_marker(dummy);
  OOPList0 dummy_list;
  RegisteredOOPList ooplist_marker(&dummy_list, 0);

  // evaluate regular closure argumnt
  OOP res;
  ReturnCode nlr_target;
  OOP nlr_arg;
  bool had_error;
  if (setjmp(errorJumpLocation)) {
    // we caught an error.
    // cut back the stacks of remembered oops, etc.
    cleanupAfterLongjmp(&frame_marker, &oop_marker, &ooplist_marker);
    // remember we need to re-raise error after evaluating clean-up closure
    had_error = true;
  } else {
    // send eval to the closure argument
#ifdef DISPATCHERS
    SEND_NO_PROP(res, nlr_target, nlr_arg, eval, 0, 1, (cl), \"1#unwind_protect(a,b)\")
#else
    SEND_NO_PROP(res, nlr_target, eval, 0, 1, (cl), \"1#unwind_protect(a,b)\")
    nlr_arg = res;
#endif
    // if we get here, then the closure returned without error (but maybe NLR)
    had_error = false;
  }

  // restore error handler; errors in on_return get propagated
  errorLocationSet = saved_set;
  memcpy(errorJumpLocation, saved_buf, sizeof(saved_buf));

  // evaluate unwind closure (if has an error or nlr, supercede body's return)
  RegisteredOOP res_(res);	// save this value
  RegisteredOOP nlr_arg_(nlr_arg);	// save this value
  OOP ignored_result;
  SEND(ignored_result, eval, 0, 1, (on_return), \"2#unwind_protect(a,b)\");

  // unwind closure returned normally;
  // now continue the original closure's result
  if (had_error) {
    // need to reraise the error raised during the original closure
    longjmp(errorJumpLocation, 1);
  } else {
    // do whatever the original closure's result was to do
    if (nlr_target != NRM_RET) {
      NLRBP(nlr_arg, nlr_target)
    } else {
#ifdef DISPATCHERS
      RETURN(res);
#else
      BP(res);
#endif
    }
  }
} " }