%-----------------------------------------------------------------------------% % Copyright (C) 1997-2004 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% % File: exception.m. % Main author: fjh. % Stability: medium % This file defines the Mercury interface for exception handling. % Note that throwing an exception across the C interface won't work. % That is, if a Mercury procedure that is exported to C using `pragma export' % throws an exception which is not caught within that procedure, then % you will get undefined behaviour. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- module exception. :- interface. :- import_module std_util, list, io, store. % % throw(Exception): % Throw the specified exception. % :- pred throw(T). :- mode throw(in) is erroneous. :- func throw(T) = _. :- mode throw(in) = out is erroneous. % The following types are used by try/3 and try/5. :- type exception_result(T) ---> succeeded(T) ; failed ; exception(univ). :- inst cannot_fail ---> succeeded(ground) ; exception(ground). % % try(Goal, Result): % Operational semantics: % Call Goal(R). % If Goal(R) fails, succeed with Result = failed. % If Goal(R) succeeds, succeed with Result = succeeded(R). % If Goal(R) throws an exception E, succeed with Result = exception(E). % Declarative semantics: % try(Goal, Result) <=> % ( Goal(R), Result = succeeded(R) % ; not Goal(_), Result = failed % ; Result = exception(_) % ). % :- pred try(pred(T), exception_result(T)). :- mode try(pred(out) is det, out(cannot_fail)) is cc_multi. :- mode try(pred(out) is semidet, out) is cc_multi. :- mode try(pred(out) is cc_multi, out(cannot_fail)) is cc_multi. :- mode try(pred(out) is cc_nondet, out) is cc_multi. % % try_io(Goal, Result, IO_0, IO): % Operational semantics: % Call Goal(R, IO_0, IO_1). % If it succeeds, succeed with Result = succeeded(R) and IO = IO_1. % If it throws an exception E, succeed with Result = exception(E) % and with the final IO state being whatever state resulted % from the partial computation from IO_0. % Declarative semantics: % try_io(Goal, Result, IO_0, IO) <=> % ( Goal(R, IO_0, IO), Result = succeeded(R) % ; Result = exception(_) % ). % :- pred try_io(pred(T, io__state, io__state), exception_result(T), io__state, io__state). :- mode try_io(pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi. :- mode try_io(pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi. % % try_store(Goal, Result, Store_0, Store): % Just like try_io, but for stores rather than io__states. % :- pred try_store(pred(T, store(S), store(S)), exception_result(T), store(S), store(S)). :- mode try_store(pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi. :- mode try_store(pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi. % % try_all(Goal, ResultList): % Operational semantics: % Try to find all solutions to Goal(R), using backtracking. % Collect the solutions found in the ResultList, until % the goal either throws an exception or fails. % If it throws an exception, put that exception at the end of % the ResultList. % Declaratively: % try_all(Goal, ResultList) <=> % (if % list__reverse(ResultList, [Last | AllButLast]), % Last = exception(_) % then % all [M] (list__member(M, AllButLast) => % (M = succeeded(R), Goal(R))), % else % all [M] (list__member(M, ResultList) => % (M = succeeded(R), Goal(R))), % all [R] (Goal(R) => % list__member(succeeded(R), ResultList)), % ). :- pred try_all(pred(T), list(exception_result(T))). :- mode try_all(pred(out) is det, out(try_all_det)) is cc_multi. :- mode try_all(pred(out) is semidet, out(try_all_semidet)) is cc_multi. :- mode try_all(pred(out) is multi, out(try_all_multi)) is cc_multi. :- mode try_all(pred(out) is nondet, out(try_all_nondet)) is cc_multi. :- inst [] ---> []. :- inst try_all_det ---> [cannot_fail]. :- inst try_all_semidet ---> [] ; [cannot_fail]. :- inst try_all_multi ---> [cannot_fail | try_all_nondet]. :- inst try_all_nondet == list_skel(cannot_fail). % % incremental_try_all(Goal, AccumulatorPred, Acc0, Acc): % Same as % try_all(Goal, Results), % std_util__unsorted_aggregate(Results, AccumulatorPred, Acc0, Acc) % except that operationally, the execution of try_all % and std_util__unsorted_aggregate is interleaved. :- pred incremental_try_all(pred(T), pred(exception_result(T), A, A), A, A). :- mode incremental_try_all(pred(out) is nondet, pred(in, di, uo) is det, di, uo) is cc_multi. :- mode incremental_try_all(pred(out) is nondet, pred(in, in, out) is det, in, out) is cc_multi. % % rethrow(ExceptionResult): % Rethrows the specified exception result % (which should be of the form `exception(_)', % not `succeeded(_)' or `failed'.). % :- pred rethrow(exception_result(T)). :- mode rethrow(in(bound(exception(ground)))) is erroneous. :- func rethrow(exception_result(T)) = _. :- mode rethrow(in(bound(exception(ground)))) = out is erroneous. % % finally(P, PRes, Cleanup, CleanupRes, IO0, IO). % Call P and ensure that Cleanup is called afterwards, % no matter whether P succeeds or throws an exception. % PRes is bound to the output of P. % CleanupRes is bound to the output of Cleanup. % A exception thrown by P will be rethrown after Cleanup % is called, unless Cleanup throws an exception. % This predicate performs the same function as the `finally' % clause (`try {...} finally {...}') in languages such as Java. :- pred finally(pred(T, io__state, io__state), T, pred(io__res, io__state, io__state), io__res, io__state, io__state). :- mode finally(pred(out, di, uo) is det, out, pred(out, di, uo) is det, out, di, uo) is det. :- mode finally(pred(out, di, uo) is cc_multi, out, pred(out, di, uo) is cc_multi, out, di, uo) is cc_multi. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module string, require. :- pred try(determinism, pred(T), exception_result(T)). :- mode try(in(bound(det)), pred(out) is det, out(cannot_fail)) is cc_multi. :- mode try(in(bound(semidet)), pred(out) is semidet, out) is cc_multi. :- mode try(in(bound(cc_multi)), pred(out) is cc_multi, out(cannot_fail)) is cc_multi. :- mode try(in(bound(cc_nondet)), pred(out) is cc_nondet, out) is cc_multi. :- pred try_io(determinism, pred(T, io__state, io__state), exception_result(T), io__state, io__state). :- mode try_io(in(bound(det)), pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi. :- mode try_io(in(bound(cc_multi)), pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi. :- pred try_store(determinism, pred(T, store(S), store(S)), exception_result(T), store(S), store(S)). :- mode try_store(in(bound(det)), pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi. :- mode try_store(in(bound(cc_multi)), pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi. :- pred try_all(determinism, pred(T), list(exception_result(T))). :- mode try_all(in(bound(det)), pred(out) is det, out(try_all_det)) is cc_multi. :- mode try_all(in(bound(semidet)), pred(out) is semidet, out(try_all_semidet)) is cc_multi. :- mode try_all(in(bound(multi)), pred(out) is multi, out(try_all_multi)) is cc_multi. :- mode try_all(in(bound(nondet)), pred(out) is nondet, out(try_all_nondet)) is cc_multi. :- type determinism ---> det ; semidet ; cc_multi ; cc_nondet ; multi ; nondet ; erroneous ; failure. :- pred get_determinism(pred(T), determinism). :- mode get_determinism(pred(out) is det, out(bound(det))) is cc_multi. :- mode get_determinism(pred(out) is semidet, out(bound(semidet))) is cc_multi. :- mode get_determinism(pred(out) is multi, out(bound(multi))) is cc_multi. :- mode get_determinism(pred(out) is nondet, out(bound(nondet))) is cc_multi. :- mode get_determinism(pred(out) is cc_multi, out(bound(cc_multi))) is cc_multi. :- mode get_determinism(pred(out) is cc_nondet, out(bound(cc_nondet))) is cc_multi. :- pred get_determinism_2(pred(T, S, S), determinism). :- mode get_determinism_2(pred(out, di, uo) is det, out(bound(det))) is cc_multi. :- mode get_determinism_2(pred(out, di, uo) is cc_multi, out(bound(cc_multi))) is cc_multi. % The calls to error/1 here are needed to ensure that the % declarative semantics of each clause is equivalent, % but operationally they are unreachable; % since each mode has determinism cc_multi, % it will pick the first disjunct and discard the call to error/1. % This relies on --no-reorder-disj. :- pragma promise_pure(get_determinism/2). get_determinism(_Pred::(pred(out) is det), Det::out(bound(det))) :- ( cc_multi_equal(det, Det) ; error("get_determinism") ). get_determinism(_Pred::(pred(out) is semidet), Det::out(bound(semidet))) :- ( cc_multi_equal(semidet, Det) ; error("get_determinism") ). get_determinism(_Pred::(pred(out) is cc_multi), Det::out(bound(cc_multi))) :- ( cc_multi_equal(cc_multi, Det) ; error("get_determinism") ). get_determinism(_Pred::(pred(out) is cc_nondet), Det::out(bound(cc_nondet))) :- ( cc_multi_equal(cc_nondet, Det) ; error("get_determinism") ). get_determinism(_Pred::(pred(out) is multi), Det::out(bound(multi))) :- ( cc_multi_equal(multi, Det) ; error("get_determinism") ). get_determinism(_Pred::(pred(out) is nondet), Det::out(bound(nondet))) :- ( cc_multi_equal(nondet, Det) ; error("get_determinism") ). :- pragma promise_pure(get_determinism_2/2). get_determinism_2( _Pred::pred(out, di, uo) is det, Det::out(bound(det))) :- ( cc_multi_equal(det, Det) ; error("get_determinism_2") ). get_determinism_2( _Pred::pred(out, di, uo) is cc_multi, Det::out(bound(cc_multi))) :- ( cc_multi_equal(cc_multi, Det) ; error("get_determinism_2") ). % These are not worth inlining, since they will % (presumably) not be called frequently, and so % any increase in speed from inlining is not worth % the increase in code size. :- pragma no_inline(throw/1). :- pragma no_inline(rethrow/1). % The termination analyzer can infer termination % of throw/1 itself but declaring it to be terminating % here means that all of the standard library will % treat it as terminating as well. :- pragma terminates(throw/1). throw(Exception) :- type_to_univ(Exception, Univ), throw_impl(Univ). throw(Exception) = _ :- throw(Exception). rethrow(exception(Univ)) :- throw_impl(Univ). rethrow(ExceptionResult) = _ :- rethrow(ExceptionResult). :- pragma promise_pure(finally/6). finally(P::(pred(out, di, uo) is det), PRes::out, Cleanup::(pred(out, di, uo) is det), CleanupRes::out, !.IO::di, !:IO::uo) :- promise_only_solution_io( (pred(Res::out, !.IO::di, !:IO::uo) is cc_multi :- finally_2(P, Cleanup, Res, !IO) ), {PRes, CleanupRes}, !IO). finally(P::(pred(out, di, uo) is cc_multi), PRes::out, Cleanup::(pred(out, di, uo) is cc_multi), CleanupRes::out, !.IO::di, !:IO::uo) :- finally_2(P, Cleanup, {PRes, CleanupRes}, !IO). :- pred finally_2(pred(T, io__state, io__state), pred(io__res, io__state, io__state), {T, io__res}, io__state, io__state). :- mode finally_2(pred(out, di, uo) is det, pred(out, di, uo) is det, out, di, uo) is cc_multi. :- mode finally_2(pred(out, di, uo) is cc_multi, pred(out, di, uo) is cc_multi, out, di, uo) is cc_multi. :- pragma promise_pure(finally_2/5). finally_2(P, Cleanup, {PRes, CleanupRes}, !IO) :- try_io(P, ExcpResult, !IO), ( ExcpResult = succeeded(PRes), Cleanup(CleanupRes, !IO) ; ExcpResult = exception(_), Cleanup(_, !IO), % The io__state resulting from Cleanup can't % possibly be used, so we have to trick the % compiler into not removing the call. ( semidet_succeed, impure use(!.IO) -> rethrow(ExcpResult) ; error("exception.finally_2") ) ). :- impure pred use(T). :- mode use(in) is det. :- pragma foreign_proc("C", use(_T::in), [will_not_call_mercury, thread_safe], ";"). :- pragma foreign_proc("C#", use(_T::in), [will_not_call_mercury, thread_safe], ";"). :- pragma foreign_proc("Java", use(_T::in), [will_not_call_mercury, thread_safe], ";"). %-----------------------------------------------------------------------------% :- pred wrap_success(pred(T), exception_result(T)) is det. :- mode wrap_success(pred(out) is det, out) is det. :- mode wrap_success(pred(out) is semidet, out) is semidet. :- mode wrap_success(pred(out) is multi, out) is multi. :- mode wrap_success(pred(out) is nondet, out) is nondet. :- mode wrap_success(pred(out) is cc_multi, out) is cc_multi. :- mode wrap_success(pred(out) is cc_nondet, out) is cc_nondet. wrap_success(Goal, succeeded(R)) :- Goal(R). :- pred wrap_success_or_failure(pred(T), exception_result(T)) is det. :- mode wrap_success_or_failure(pred(out) is det, out) is det. :- mode wrap_success_or_failure(pred(out) is semidet, out) is det. %:- mode wrap_success_or_failure(pred(out) is multi, out) is multi. (unused) %:- mode wrap_success_or_failure(pred(out) is nondet, out) is multi. (unused) :- mode wrap_success_or_failure(pred(out) is cc_multi, out) is cc_multi. :- mode wrap_success_or_failure(pred(out) is cc_nondet, out) is cc_multi. wrap_success_or_failure(Goal, Result) :- (if Goal(R) then Result = succeeded(R) else Result = failed). /********************* % This doesn't work, due to % bash$ mmc exception.m % Software error: sorry, not implemented: taking address of pred % `wrap_success_or_failure/2' with multiple modes. % Instead, we need to switch on the Detism argument. try(_Detism, Goal, Result) :- builtin_catch(wrap_success_or_failure(Goal), wrap_exception, Result). *********************/ try(Goal, Result) :- get_determinism(Goal, Detism), try(Detism, Goal, Result). try(det, Goal, Result) :- catch_impl((pred(R::out) is det :- wrap_success_or_failure(Goal, R)), wrap_exception, Result0), cc_multi_equal(Result0, Result). try(semidet, Goal, Result) :- catch_impl((pred(R::out) is det :- wrap_success_or_failure(Goal, R)), wrap_exception, Result0), cc_multi_equal(Result0, Result). try(cc_multi, Goal, Result) :- catch_impl( (pred(R::out) is cc_multi :- wrap_success_or_failure(Goal, R) ), wrap_exception, Result). try(cc_nondet, Goal, Result) :- catch_impl((pred(R::out) is cc_multi :- wrap_success_or_failure(Goal, R)), wrap_exception, Result). /********** % This doesn't work, due to % bash$ mmc exception.m % Software error: sorry, not implemented: taking address of pred % `wrap_success_or_failure/2' with multiple modes. % Instead, we need to switch on the Detism argument. try_all(Goal, ResultList) :- unsorted_solutions(builtin_catch(wrap_success(Goal), wrap_exception), ResultList). **********/ try_all(Goal, ResultList) :- get_determinism(Goal, Detism), try_all(Detism, Goal, ResultList). try_all(det, Goal, [Result]) :- try(det, Goal, Result). try_all(semidet, Goal, ResultList) :- try(semidet, Goal, Result), ( Result = failed, ResultList = [] ; Result = succeeded(_), ResultList = [Result] ; Result = exception(_), ResultList = [Result] ). try_all(multi, Goal, ResultList) :- unsorted_solutions((pred(Result::out) is multi :- catch_impl((pred(R::out) is multi :- wrap_success(Goal, R)), wrap_exception, Result)), ResultList). try_all(nondet, Goal, ResultList) :- unsorted_solutions((pred(Result::out) is nondet :- catch_impl((pred(R::out) is nondet :- wrap_success(Goal, R)), wrap_exception, Result)), ResultList). incremental_try_all(Goal, AccPred, Acc0, Acc) :- unsorted_aggregate((pred(Result::out) is nondet :- catch_impl((pred(R::out) is nondet :- wrap_success(Goal, R)), wrap_exception, Result)), AccPred, Acc0, Acc). % We need to switch on the Detism argument % for the same reason as above. try_store(StoreGoal, Result) --> { get_determinism_2(StoreGoal, Detism) }, try_store(Detism, StoreGoal, Result). % Store0 is not really unique in the calls to unsafe_promise_unique % below, since it is also used in the calls to handle_store_result. % But it is safe to treat it as if it were unique, because the % other reference is only used in the case when an exception is % thrown, and in that case the declarative semantics of this % predicate say that the final store returned is unspecified. try_store(det, StoreGoal, Result, Store0, Store) :- Goal = (pred({R, S}::out) is det :- unsafe_promise_unique(Store0, S0), StoreGoal(R, S0, S)), try(det, Goal, Result0), handle_store_result(Result0, Result, Store0, Store). try_store(cc_multi, StoreGoal, Result, Store0, Store) :- Goal = (pred({R, S}::out) is cc_multi :- unsafe_promise_unique(Store0, S0), StoreGoal(R, S0, S)), try(cc_multi, Goal, Result0), handle_store_result(Result0, Result, Store0, Store). :- pred handle_store_result(exception_result({T, store(S)})::in(cannot_fail), exception_result(T)::out(cannot_fail), store(S)::in, store(S)::uo) is det. handle_store_result(Result0, Result, Store0, Store) :- ( Result0 = succeeded({Res, S1}), Result = succeeded(Res), % S1 is now unique because the only other reference to the % store was from Store0, which we're throwing away here unsafe_promise_unique(S1, Store) ; Result0 = exception(E0), % We need to make a copy of the exception object, in case % it contains a value returned from store__extract_ref_value. % See tests/hard_coded/exceptions/tricky_try_store.m. copy(E0, E), Result = exception(E), % Store0 is now unique because the only other reference to % the store was from the goal which just threw an exception. unsafe_promise_unique(Store0, Store) ). try_io(IO_Goal, Result) --> { get_determinism_2(IO_Goal, Detism) }, try_io(Detism, IO_Goal, Result). % We'd better not inline try_io/5, since it uses a horrible hack % with unsafe_perform_io (see below) that might confuse the compiler. :- pragma no_inline(try_io/5). try_io(det, IO_Goal, Result) --> { Goal = (pred(R::out) is det :- very_unsafe_perform_io(IO_Goal, R)) }, { try(det, Goal, Result) }. try_io(cc_multi, IO_Goal, Result) --> { Goal = (pred(R::out) is cc_multi :- very_unsafe_perform_io(IO_Goal, R)) }, { try(cc_multi, Goal, Result) }. :- pred very_unsafe_perform_io(pred(T, io__state, io__state), T). :- mode very_unsafe_perform_io(pred(out, di, uo) is det, out) is det. :- mode very_unsafe_perform_io(pred(out, di, uo) is cc_multi, out) is cc_multi. % Mercury doesn't support impure higher-order pred terms, so if we want % to form a closure from unsafe_perform_io, as we need to do above, % then we must (falsely!) promise that it is pure. :- pragma promise_pure(very_unsafe_perform_io/2). % XXX this is a lie very_unsafe_perform_io(Goal, Result) :- impure make_io_state(IOState0), Goal(Result, IOState0, IOState), impure consume_io_state(IOState). :- impure pred make_io_state(io__state::uo) is det. :- pragma foreign_proc("C", make_io_state(_IO::uo), [will_not_call_mercury, thread_safe], ""). :- pragma foreign_proc("C#", make_io_state(_IO::uo), [will_not_call_mercury, thread_safe], ""). :- pragma foreign_proc("Java", make_io_state(_IO::uo), [will_not_call_mercury, thread_safe], ""). :- impure pred consume_io_state(io__state::di) is det. :- pragma foreign_proc("C", consume_io_state(_IO::di), [will_not_call_mercury, thread_safe], ""). :- pragma foreign_proc("C#", consume_io_state(_IO::di), [will_not_call_mercury, thread_safe], ""). :- pragma foreign_proc("Java", consume_io_state(_IO::di), [will_not_call_mercury, thread_safe], ""). :- pred wrap_exception(univ::in, exception_result(T)::out) is det. wrap_exception(Exception, exception(Exception)). %-----------------------------------------------------------------------------% :- pred throw_impl(univ). :- mode throw_impl(in) is erroneous. :- type handler(T) == pred(univ, T). :- inst handler == (pred(in, out) is det). % % catch_impl/3 is actually impure. But we don't declare it as impure, % because the code for try_all/3 takes its address (to pass to % unsorted_solutions/2), and Mercury does not (yet?) support % impure higher-order pred terms. % :- pragma promise_pure(catch_impl/3). :- /* impure */ pred catch_impl(pred(T), handler(T), T). :- mode catch_impl(pred(out) is det, in(handler), out) is det. :- mode catch_impl(pred(out) is semidet, in(handler), out) is semidet. :- mode catch_impl(pred(out) is cc_multi, in(handler), out) is cc_multi. :- mode catch_impl(pred(out) is cc_nondet, in(handler), out) is cc_nondet. :- mode catch_impl(pred(out) is multi, in(handler), out) is multi. :- mode catch_impl(pred(out) is nondet, in(handler), out) is nondet. % by default we call the external implementation, but specific backends % can provide their own definition using foreign_proc. throw_impl(Univ::in) :- builtin_throw(Univ). catch_impl(Pred::(pred(out) is det), Handler::in(handler), T::out) :- builtin_catch(Pred, Handler, T). catch_impl(Pred::(pred(out) is semidet), Handler::in(handler), T::out) :- builtin_catch(Pred, Handler, T). catch_impl(Pred::(pred(out) is cc_multi), Handler::in(handler), T::out) :- builtin_catch(Pred, Handler, T). catch_impl(Pred::(pred(out) is cc_nondet), Handler::in(handler), T::out) :- builtin_catch(Pred, Handler, T). catch_impl(Pred::(pred(out) is multi), Handler::in(handler), T::out) :- builtin_catch(Pred, Handler, T). catch_impl(Pred::(pred(out) is nondet), Handler::in(handler), T::out) :- builtin_catch(Pred, Handler, T). % builtin_throw and builtin_catch are implemented below using % hand-coded low-level C code. % :- pragma terminates(builtin_throw/1). :- pred builtin_throw(univ). :- mode builtin_throw(in) is erroneous. :- /* impure */ pred builtin_catch(pred(T), handler(T), T). :- mode builtin_catch(pred(out) is det, in(handler), out) is det. :- mode builtin_catch(pred(out) is semidet, in(handler), out) is semidet. :- mode builtin_catch(pred(out) is cc_multi, in(handler), out) is cc_multi. :- mode builtin_catch(pred(out) is cc_nondet, in(handler), out) is cc_nondet. :- mode builtin_catch(pred(out) is multi, in(handler), out) is multi. :- mode builtin_catch(pred(out) is nondet, in(handler), out) is nondet. :- external(builtin_throw/1). :- external(builtin_catch/3). %-----------------------------------------------------------------------------% % % The --high-level-code implementation % :- pragma foreign_decl("C", " /* protect against multiple inclusion */ #ifndef ML_HLC_EXCEPTION_GUARD #define ML_HLC_EXCEPTION_GUARD #ifdef MR_HIGHLEVEL_CODE #ifdef MR_USE_GCC_NESTED_FUNCTIONS #define MR_CONT_PARAMS MR_NestedCont cont #define MR_CONT_PARAM_TYPES MR_NestedCont #define MR_CONT_ARGS cont #else #define MR_CONT_PARAMS MR_Cont cont, void *cont_env #define MR_CONT_PARAM_TYPES MR_Cont, void * #define MR_CONT_ARGS cont, cont_env #endif /* det */ void MR_CALL mercury__exception__builtin_catch_3_p_0(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output); /* semidet */ MR_bool MR_CALL mercury__exception__builtin_catch_3_p_1(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output); /* cc_multi */ void MR_CALL mercury__exception__builtin_catch_3_p_2(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output); /* cc_nondet */ MR_bool MR_CALL mercury__exception__builtin_catch_3_p_3(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output); /* multi */ void MR_CALL mercury__exception__builtin_catch_3_p_4(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_CONT_PARAMS); /* nondet */ void MR_CALL mercury__exception__builtin_catch_3_p_5(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_CONT_PARAMS); #ifndef MR_AVOID_MACROS /* det ==> model_det */ #define mercury__exception__builtin_catch_3_p_0 \ mercury__exception__builtin_catch_model_det /* semidet ==> model_semi */ #define mercury__exception__builtin_catch_3_p_1 \ mercury__exception__builtin_catch_model_semi /* cc_multi ==> model_det */ #define mercury__exception__builtin_catch_3_p_2 \ mercury__exception__builtin_catch_model_det /* cc_nondet ==> model_semi */ #define mercury__exception__builtin_catch_3_p_3 \ mercury__exception__builtin_catch_model_semi /* multi ==> model_non */ #define mercury__exception__builtin_catch_3_p_4 \ mercury__exception__builtin_catch_model_non /* nondet ==> model_non */ #define mercury__exception__builtin_catch_3_p_5 \ mercury__exception__builtin_catch_model_non #endif /* !MR_AVOID_MACROS */ void MR_CALL mercury__exception__builtin_throw_1_p_0(MR_Univ exception); void MR_CALL mercury__exception__builtin_catch_model_det( MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output); MR_bool MR_CALL mercury__exception__builtin_catch_model_semi( MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output); void MR_CALL mercury__exception__builtin_catch_model_non( MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_CONT_PARAMS); #endif /* MR_HIGHLEVEL_CODE */ #endif /* ML_HLC_EXCEPTION_GUARD */ "). :- pragma foreign_code("C", " #ifdef MR_HIGHLEVEL_CODE /* ** We also need to provide definitions of these builtins ** as functions rather than as macros. This is needed ** (a) in case we take their address, and (b) for the ** GCC back-end interface. */ #undef mercury__exception__builtin_catch_3_p_0 #undef mercury__exception__builtin_catch_3_p_1 #undef mercury__exception__builtin_catch_3_p_2 #undef mercury__exception__builtin_catch_3_p_3 #undef mercury__exception__builtin_catch_3_p_4 #undef mercury__exception__builtin_catch_3_p_5 /* det ==> model_det */ void MR_CALL mercury__exception__builtin_catch_3_p_0(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output) { mercury__exception__builtin_catch_model_det(type_info, pred, handler_pred, output); } /* semidet ==> model_semi */ MR_bool MR_CALL mercury__exception__builtin_catch_3_p_1(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output) { return mercury__exception__builtin_catch_model_semi(type_info, pred, handler_pred, output); } /* cc_multi ==> model_det */ void MR_CALL mercury__exception__builtin_catch_3_p_2(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output) { mercury__exception__builtin_catch_model_det(type_info, pred, handler_pred, output); } /* cc_nondet ==> model_semi */ MR_bool MR_CALL mercury__exception__builtin_catch_3_p_3(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output) { return mercury__exception__builtin_catch_model_semi(type_info, pred, handler_pred, output); } /* multi ==> model_non */ void MR_CALL mercury__exception__builtin_catch_3_p_4(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_CONT_PARAMS) { mercury__exception__builtin_catch_model_non(type_info, pred, handler_pred, output, MR_CONT_ARGS); } /* multi ==> model_non */ void MR_CALL mercury__exception__builtin_catch_3_p_5(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_CONT_PARAMS) { mercury__exception__builtin_catch_model_non(type_info, pred, handler_pred, output, MR_CONT_ARGS); } /*---------------------------------------------------------------------------*/ static void ML_call_goal_det_handcoded(MR_Mercury_Type_Info type_info, MR_Pred closure, MR_Box *result) { typedef void MR_CALL DetFuncType(void *, MR_Box *); DetFuncType *code = (DetFuncType *) MR_field(MR_mktag(0), closure, (MR_Integer) 1); (*code)((void *) closure, result); } static MR_bool ML_call_goal_semi_handcoded(MR_Mercury_Type_Info type_info, MR_Pred closure, MR_Box *result) { typedef MR_bool MR_CALL SemidetFuncType(void *, MR_Box *); SemidetFuncType *code = (SemidetFuncType *) MR_field(MR_mktag(0), closure, (MR_Integer) 1); return (*code)((void *) closure, result); } static void ML_call_goal_non_handcoded(MR_Mercury_Type_Info type_info, MR_Pred closure, MR_Box *result, MR_CONT_PARAMS) { typedef void MR_CALL NondetFuncType(void *, MR_Box *, MR_CONT_PARAM_TYPES); NondetFuncType *code = (NondetFuncType *) MR_field(MR_mktag(0), closure, (MR_Integer) 1); (*code)((void *) closure, result, MR_CONT_ARGS); } /*---------------------------------------------------------------------------*/ static void ML_call_handler_det_handcoded(MR_Mercury_Type_Info type_info, MR_Pred closure, MR_Univ exception, MR_Box *result) { typedef void MR_CALL HandlerFuncType(void *, MR_Box, MR_Box *); HandlerFuncType *code = (HandlerFuncType *) MR_field(MR_mktag(0), closure, (MR_Integer) 1); (*code)((void *) closure, (MR_Box) exception, result); } /*---------------------------------------------------------------------------*/ #include #include typedef struct ML_ExceptionHandler_struct { struct ML_ExceptionHandler_struct *prev; jmp_buf handler; MR_Univ exception; } ML_ExceptionHandler; #ifndef MR_THREAD_SAFE ML_ExceptionHandler *ML_exception_handler; #endif #ifdef MR_THREAD_SAFE #define ML_GET_EXCEPTION_HANDLER() MR_GETSPECIFIC(MR_exception_handler_key) #define ML_SET_EXCEPTION_HANDLER(val) \ pthread_setspecific(MR_exception_handler_key, (val)) #else /* !MR_THREAD_SAFE */ #define ML_GET_EXCEPTION_HANDLER() ML_exception_handler #define ML_SET_EXCEPTION_HANDLER(val) ML_exception_handler = (val) #endif /* !MR_THREAD_SAFE */ void MR_CALL mercury__exception__builtin_throw_1_p_0(MR_Univ exception) { ML_ExceptionHandler *exception_handler = ML_GET_EXCEPTION_HANDLER(); if (exception_handler == NULL) { ML_report_uncaught_exception((MR_Word) exception); exit(EXIT_FAILURE); } else { #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""throw longjmp %p\\n"", exception_handler->handler); #endif exception_handler->exception = exception; longjmp(exception_handler->handler, 1); } } #ifdef MR_NATIVE_GC /* ** The following code is needed to trace the local variables ** in the builtin_catch_* functions for accurate GC. */ struct mercury__exception__builtin_catch_locals { /* fixed fields, from struct MR_StackChain */ struct MR_StackChain *prev; void (*trace)(void *this_frame); /* locals for this function */ MR_Mercury_Type_Info type_info; MR_Pred handler_pred; }; static void mercury__exception__builtin_catch_gc_trace(void *frame) { struct mercury__exception__builtin_catch_locals *agc_locals = frame; /* ** Construct a type_info for the type `pred(univ, T)', ** which is the type of the handler_pred. */ MR_VAR_ARITY_TYPEINFO_STRUCT(s, 2) type_info_for_handler_pred; type_info_for_handler_pred.MR_ti_type_ctor_info = &mercury__builtin__builtin__type_ctor_info_pred_0; type_info_for_handler_pred.MR_ti_var_arity_arity = 2; type_info_for_handler_pred.MR_ti_var_arity_arg_typeinfos[0] = (MR_TypeInfo) &mercury__std_util__std_util__type_ctor_info_univ_0; type_info_for_handler_pred.MR_ti_var_arity_arg_typeinfos[1] = (MR_TypeInfo) agc_locals->type_info; /* ** Call gc_trace/1 to trace the two local variables in this frame. */ mercury__private_builtin__gc_trace_1_p_0( (MR_Word) &mercury__type_desc__type_desc__type_ctor_info_type_desc_0, (MR_Word) &agc_locals->type_info); mercury__private_builtin__gc_trace_1_p_0( (MR_Word) &type_info_for_handler_pred, (MR_Word) &agc_locals->handler_pred); } #define ML_DECLARE_AGC_HANDLER \ struct mercury__exception__builtin_catch_locals agc_locals; #define ML_INSTALL_AGC_HANDLER(TYPE_INFO, HANDLER_PRED) \ do { \ agc_locals.prev = mercury__private_builtin__stack_chain; \ agc_locals.trace = mercury__exception__builtin_catch_gc_trace; \ agc_locals.type_info = (TYPE_INFO); \ agc_locals.handler_pred = (HANDLER_PRED); \ mercury__private_builtin__stack_chain = &agc_locals; \ } while(0) #define ML_UNINSTALL_AGC_HANDLER() \ do { \ mercury__private_builtin__stack_chain = agc_locals.prev; \ } while (0) #define ML_AGC_LOCAL(NAME) (agc_locals.NAME) #else /* !MR_NATIVE_GC */ /* If accurate GC is not enabled, we define all of these as NOPs. */ #define ML_DECLARE_AGC_HANDLER #define ML_INSTALL_AGC_HANDLER(type_info, handler_pred) #define ML_UNINSTALL_AGC_HANDLER() #define ML_AGC_LOCAL(name) (name) #endif /* !MR_NATIVE_GC */ void MR_CALL mercury__exception__builtin_catch_model_det(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output) { ML_ExceptionHandler this_handler; ML_DECLARE_AGC_HANDLER this_handler.prev = ML_GET_EXCEPTION_HANDLER(); ML_SET_EXCEPTION_HANDLER(&this_handler); ML_INSTALL_AGC_HANDLER(type_info, handler_pred); #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""detcatch setjmp %p\\n"", this_handler.handler); #endif if (setjmp(this_handler.handler) == 0) { ML_call_goal_det_handcoded(type_info, pred, output); ML_SET_EXCEPTION_HANDLER(this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); } else { #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""detcatch caught jmp %p\\n"", this_handler.handler); #endif ML_SET_EXCEPTION_HANDLER(this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); ML_call_handler_det_handcoded( ML_AGC_LOCAL(type_info), ML_AGC_LOCAL(handler_pred), this_handler.exception, output); } } MR_bool MR_CALL mercury__exception__builtin_catch_model_semi(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output) { ML_ExceptionHandler this_handler; ML_DECLARE_AGC_HANDLER this_handler.prev = ML_GET_EXCEPTION_HANDLER(); ML_SET_EXCEPTION_HANDLER(&this_handler); ML_INSTALL_AGC_HANDLER(type_info, handler_pred); #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""semicatch setjmp %p\\n"", this_handler.handler); #endif if (setjmp(this_handler.handler) == 0) { MR_bool result = ML_call_goal_semi_handcoded(type_info, pred, output); ML_SET_EXCEPTION_HANDLER(this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); return result; } else { #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""semicatch caught jmp %p\\n"", this_handler.handler); #endif ML_SET_EXCEPTION_HANDLER(this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); ML_call_handler_det_handcoded( ML_AGC_LOCAL(type_info), ML_AGC_LOCAL(handler_pred), this_handler.exception, output); return MR_TRUE; } } #ifdef MR_USE_GCC_NESTED_FUNCTIONS void MR_CALL mercury__exception__builtin_catch_model_non(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_NestedCont cont) { ML_ExceptionHandler this_handler; ML_DECLARE_AGC_HANDLER auto void MR_CALL success_cont(void); void MR_CALL success_cont(void) { /* ** If we reach here, it means that ** the nondet goal has succeeded, so we ** need to restore the previous exception ** handler before calling its continuation */ ML_SET_EXCEPTION_HANDLER(this_handler.prev); (*cont)(); /* ** If we get here, it means that the continuation ** has failed, and so we are about to redo the ** nondet goal. Thus we need to re-establish ** its exception handler. */ ML_SET_EXCEPTION_HANDLER(&this_handler); } this_handler.prev = ML_GET_EXCEPTION_HANDLER(); ML_SET_EXCEPTION_HANDLER(&this_handler); ML_INSTALL_AGC_HANDLER(type_info, handler_pred); #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""noncatch setjmp %p\\n"", this_handler.handler); #endif if (setjmp(this_handler.handler) == 0) { ML_call_goal_non_handcoded(type_info, pred, output, success_cont); ML_SET_EXCEPTION_HANDLER(this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); } else { #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""noncatch caught jmp %p\\n"", this_handler.handler); #endif ML_SET_EXCEPTION_HANDLER(this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); ML_call_handler_det_handcoded( ML_AGC_LOCAL(type_info), ML_AGC_LOCAL(handler_pred), this_handler.exception, output); (*cont)(); } } #else /* ! MR_USE_GCC_NESTED_FUNCTIONS */ struct ML_catch_env { ML_ExceptionHandler this_handler; MR_Cont cont; void *cont_env; }; static void MR_CALL ML_catch_success_cont(void *env_ptr) { struct ML_catch_env *env = (struct ML_catch_env *) env_ptr; /* ** If we reach here, it means that ** the nondet goal has succeeded, so we ** need to restore the previous exception ** handler before calling its continuation */ ML_SET_EXCEPTION_HANDLER(env->this_handler.prev); (*env->cont)(env->cont_env); /* ** If we get here, it means that the continuation ** has failed, and so we are about to redo the ** nondet goal. Thus we need to re-establish ** its exception handler. */ ML_SET_EXCEPTION_HANDLER(&env->this_handler); } void MR_CALL mercury__exception__builtin_catch_model_non(MR_Mercury_Type_Info type_info, MR_Pred pred, MR_Pred handler_pred, MR_Box *output, MR_Cont cont, void *cont_env) { ML_DECLARE_AGC_HANDLER struct ML_catch_env locals; locals.cont = cont; locals.cont_env = cont_env; locals.this_handler.prev = ML_GET_EXCEPTION_HANDLER(); ML_SET_EXCEPTION_HANDLER(&locals.this_handler); ML_INSTALL_AGC_HANDLER(type_info, handler_pred); #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""noncatch setjmp %p\\n"", locals.this_handler.handler); #endif if (setjmp(locals.this_handler.handler) == 0) { ML_call_goal_non_handcoded(type_info, pred, output, ML_catch_success_cont, &locals); /* ** If we reach here, it means that ** the nondet goal has failed, so we ** need to restore the previous exception ** handler */ ML_SET_EXCEPTION_HANDLER(locals.this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); return; } else { /* ** We caught an exception. ** Restore the previous exception handler, ** and then invoke the handler predicate ** for this handler. */ #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""noncatch caught jmp %p\\n"", locals.this_handler.handler); #endif ML_SET_EXCEPTION_HANDLER(locals.this_handler.prev); ML_UNINSTALL_AGC_HANDLER(); ML_call_handler_det_handcoded( ML_AGC_LOCAL(type_info), ML_AGC_LOCAL(handler_pred), locals.this_handler.exception, output); cont(cont_env); } } #endif /* ! MR_USE_GCC_NESTED_FUNCTIONS */ #endif /* MR_HIGHLEVEL_CODE */ "). % For the .NET backend we override throw_impl as it is easier to % implement these things using foreign_proc. :- pragma foreign_decl("C#", " namespace mercury { namespace runtime { public class Exception : System.Exception { public Exception(object[] data) { mercury_exception = data; } public object[] mercury_exception; }; } } "). :- pragma foreign_proc("C#", throw_impl(T::in), [will_not_call_mercury, promise_pure], " throw new mercury.runtime.Exception(T); "). :- pragma foreign_proc("C#", catch_impl(Pred::pred(out) is det, Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " try { mercury.exception.mercury_code.ML_call_goal_det( TypeInfo_for_T, Pred, ref T); } catch (mercury.runtime.Exception ex) { mercury.exception.mercury_code.ML_call_handler_det( TypeInfo_for_T, Handler, ex.mercury_exception, ref T); } "). :- pragma foreign_proc("C#", catch_impl(Pred::pred(out) is cc_multi, Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " try { mercury.exception.mercury_code.ML_call_goal_det( TypeInfo_for_T, Pred, ref T); } catch (mercury.runtime.Exception ex) { mercury.exception.mercury_code.ML_call_handler_det( TypeInfo_for_T, Handler, ex.mercury_exception, ref T); } "). /* % We can't implement these until we implement semidet procedures % for the C# interface. :- pragma foreign_proc("C#", catch_impl(Pred::pred(out) is semidet, Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " mercury.runtime.Errors.SORRY(""foreign code for this function""); "). :- pragma foreign_proc("C#", catch_impl(Pred::pred(out) is cc_nondet, Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " mercury.runtime.Errors.SORRY(""foreign code for this function""); "). % We can't implement these because nondet C# foreign_proc for C# % is not possible. :- pragma foreign_proc("C#", catch_impl(_Pred::pred(out) is multi, _Handler::in(handler), _T::out), [will_not_call_mercury, promise_pure], local_vars(""), first_code(""), retry_code(""), common_code(" mercury.runtime.Errors.SORRY(""foreign code for this function""); ") ). :- pragma foreign_proc("C#", catch_impl(_Pred::pred(out) is nondet, _Handler::in(handler), _T::out), [will_not_call_mercury, promise_pure], local_vars(""), first_code(""), retry_code(""), common_code(" mercury.runtime.Errors.SORRY(""foreign code for this function""); ") ). */ :- pred call_goal(pred(T), T). :- mode call_goal(pred(out) is det, out) is det. :- mode call_goal(pred(out) is semidet, out) is semidet. %:- mode call_goal(pred(out) is nondet, out) is nondet. % see comments below call_goal(Goal, Result) :- Goal(Result). :- pred call_handler(pred(univ, T), univ, T). :- mode call_handler(pred(in, out) is det, in, out) is det. %:- mode call_handler(pred(in, out) is semidet, in, out) is semidet. % unused %:- mode call_handler(pred(in, out) is nondet, in, out) is nondet. % unused call_handler(Handler, Exception, Result) :- Handler(Exception, Result). :- pragma export(call_goal(pred(out) is det, out), "ML_call_goal_det"). :- pragma export(call_goal(pred(out) is semidet, out), "ML_call_goal_semidet"). % This causes problems because the LLDS back-end % does not let you export code with determinism `nondet'. % Instead for C backends we hand-code it... see below. % Hand-coding it also avoids the casting needed to use MR_Word % (which `pragma export' procedures use for polymorphically % typed arguments) rather than MR_Box. % % XXX for .NET backend we don't yet implement nondet exception handling. % :- pragma export(call_goal(pred(out) is nondet, out), "ML_call_goal_nondet"). :- pragma export(call_handler(pred(in, out) is det, in, out), "ML_call_handler_det"). /* *******/ :- pragma foreign_proc("Java", throw_impl(_T::in), [will_not_call_mercury, promise_pure], " throw new java.lang.Error(""throw_impl not yet implemented""); "). :- pragma foreign_proc("Java", catch_impl(_Pred::pred(out) is det, _Handler::in(handler), _T::out), [will_not_call_mercury, promise_pure], " { // the shenanigans with `if (always)' are to avoid errors from // the Java compiler about unreachable code. boolean always = true; if (always) { throw new java.lang.Error(""catch_impl not yet implemented""); } } "). :- pragma foreign_proc("Java", catch_impl(_Pred::pred(out) is semidet, _Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " { // the shenanigans with `if (always)' are to avoid errors from // the Java compiler about unreachable code. boolean always = true; if (always) { throw new java.lang.Error(""catch_impl not yet implemented""); } T = null; } "). :- pragma foreign_proc("Java", catch_impl(_Pred::pred(out) is cc_multi, _Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " { // the shenanigans with `if (always)' are to avoid errors from // the Java compiler about unreachable code. boolean always = true; if (always) { throw new java.lang.Error(""catch_impl not yet implemented""); } T = null; } "). :- pragma foreign_proc("Java", catch_impl(_Pred::pred(out) is cc_nondet, _Handler::in(handler), T::out), [will_not_call_mercury, promise_pure], " { // the shenanigans with `if (always)' are to avoid errors from // the Java compiler about unreachable code. boolean always = true; if (always) { throw new java.lang.Error(""catch_impl not yet implemented""); } T = null; } "). :- pragma foreign_proc("Java", catch_impl(_Pred::pred(out) is multi, _Handler::in(handler), _T::out), [will_not_call_mercury, promise_pure], " throw new java.lang.Error(""catch_impl not yet implemented""); "). :- pragma foreign_proc("Java", catch_impl(_Pred::pred(out) is nondet, _Handler::in(handler), _T::out), [will_not_call_mercury, promise_pure], " throw new java.lang.Error(""catch_impl not yet implemented""); "). %-----------------------------------------------------------------------------% % % The --no-high-level-code implementation % :- pragma foreign_decl("C", " #ifndef MR_HIGHLEVEL_CODE #include #include #include ""mercury_deep_copy.h"" #include ""mercury_trace_base.h"" #include ""mercury_stack_trace.h"" #include ""mercury_layout_util.h"" #include ""mercury_deep_profiling_hand.h"" MR_DECLARE_TYPE_CTOR_INFO_STRUCT( \ mercury_data_std_util__type_ctor_info_univ_0); #endif "). :- pragma foreign_code("C", " /* forward decls, to suppress gcc -Wmissing-decl warnings */ void mercury_sys_init_exceptions_init(void); void mercury_sys_init_exceptions_init_type_tables(void); #ifdef MR_DEEP_PROFILING void mercury_sys_init_exceptions_write_out_proc_statics(FILE *fp); #endif #ifndef MR_HIGHLEVEL_CODE /* ** MR_trace_throw(): ** Unwind the stack as far as possible, until we reach a frame ** with an exception handler. As we go, invoke ** `MR_trace(..., MR_PORT_EXCEPTION, ...)' for each stack frame, ** to signal to the debugger that that procedure has exited via ** an exception. This allows to user to use the `retry' command ** to restart a goal which exited via an exception. ** ** Note that if MR_STACK_TRACE is not defined, then we may not be ** able to traverse the stack all the way; in that case, we just ** print a warning and then continue. It might be better to just ** `#ifdef' out all this code (and the code in builtin_throw which ** calls it) if MR_STACK_TRACE is not defined. */ #define WARNING(msg) \\ do { \\ fflush(stdout); \\ fprintf(stderr, ""mdb: warning: %s\\n"" \\ ""This may result in some exception events\\n"" \\ ""being omitted from the trace.\\n"", (msg)); \\ } while (0) /* ** base_sp and base_curfr always hold MR_sp and MR_curfr. They exist ** only because we cannot take the addresses of MR_sp and MR_curfr. */ static MR_Code * ML_trace_throw(MR_Code *success_pointer, MR_Word *base_sp, MR_Word *base_curfr) { const MR_Internal *label; const MR_Label_Layout *return_label_layout; /* ** Find the layout info for the stack frame pointed to by MR_succip */ label = MR_lookup_internal_by_addr(success_pointer); if (label == NULL) { WARNING(""internal label not found\\n""); return NULL; } return_label_layout = label->i_layout; while (return_label_layout != NULL) { const MR_Proc_Layout *entry_layout; MR_Code *MR_jumpaddr; MR_Stack_Walk_Step_Result result; const char *problem; /* ** check if we've reached a frame with an exception handler */ entry_layout = return_label_layout->MR_sll_entry; if (!MR_DETISM_DET_STACK(entry_layout->MR_sle_detism) && MR_redoip_slot(base_curfr) == MR_ENTRY(MR_exception_handler_do_fail)) { return NULL; } /* ** invoke MR_trace() to trace the exception */ if (return_label_layout->MR_sll_port != MR_PORT_EXCEPTION) { MR_fatal_error(""return layout port is not exception""); } MR_jumpaddr = MR_trace(return_label_layout); if (MR_jumpaddr != NULL) { return MR_jumpaddr; } /* ** unwind the stacks back to the previous stack frame */ result = MR_stack_walk_step(entry_layout, &return_label_layout, &base_sp, &base_curfr, &problem); if (result != MR_STEP_OK) { WARNING(problem); return NULL; } MR_restore_transient_registers(); MR_sp = base_sp; MR_curfr = base_curfr; MR_save_transient_registers(); } return NULL; } /* swap the heap with the solutions heap */ #define swap_heaps() \\ { \\ /* save the current heap */ \\ MR_Word *swap_heaps_temp_hp; \\ MR_MemoryZone *swap_heaps_temp_hp_zone; \\ \\ swap_heaps_temp_hp = MR_hp; \\ swap_heaps_temp_hp_zone = MR_ENGINE(MR_eng_heap_zone); \\ \\ /* set heap to solutions heap */ \\ MR_hp = MR_sol_hp; \\ MR_ENGINE(MR_eng_heap_zone) = \\ MR_ENGINE(MR_eng_solutions_heap_zone); \\ \\ /* set the solutions heap to be the old heap */ \\ MR_sol_hp = swap_heaps_temp_hp; \\ MR_ENGINE(MR_eng_solutions_heap_zone) = swap_heaps_temp_hp_zone;\\ } MR_define_extern_entry(mercury__exception__builtin_catch_3_0); /* det */ MR_define_extern_entry(mercury__exception__builtin_catch_3_1); /* semidet */ MR_define_extern_entry(mercury__exception__builtin_catch_3_2); /* cc_multi */ MR_define_extern_entry(mercury__exception__builtin_catch_3_3); /* cc_nondet */ MR_define_extern_entry(mercury__exception__builtin_catch_3_4); /* multi */ MR_define_extern_entry(mercury__exception__builtin_catch_3_5); /* nondet */ MR_define_extern_entry(mercury__exception__builtin_throw_1_0); /* the following is defined in runtime/mercury_ho_call.c */ MR_declare_entry(mercury__do_call_closure_compact); /* the following is defined in runtime/mercury_trace_base.c */ MR_declare_entry(MR_do_trace_redo_fail); #ifdef MR_DEEP_PROFILING MR_declare_label(mercury__exception__builtin_catch_3_0_i1); MR_declare_label(mercury__exception__builtin_catch_3_1_i1); MR_declare_label(mercury__exception__builtin_catch_3_2_i1); MR_declare_label(mercury__exception__builtin_catch_3_3_i1); MR_declare_label(mercury__exception__builtin_catch_3_4_i1); MR_declare_label(mercury__exception__builtin_catch_3_5_i1); #endif MR_declare_label(mercury__exception__builtin_catch_3_0_i2); MR_declare_label(mercury__exception__builtin_catch_3_1_i2); MR_declare_label(mercury__exception__builtin_catch_3_2_i2); MR_declare_label(mercury__exception__builtin_catch_3_3_i2); MR_declare_label(mercury__exception__builtin_catch_3_4_i2); MR_declare_label(mercury__exception__builtin_catch_3_5_i2); #ifdef MR_DEEP_PROFILING MR_declare_label(mercury__exception__builtin_catch_3_0_i3); MR_declare_label(mercury__exception__builtin_catch_3_1_i3); MR_declare_label(mercury__exception__builtin_catch_3_2_i3); MR_declare_label(mercury__exception__builtin_catch_3_3_i3); MR_declare_label(mercury__exception__builtin_catch_3_4_i3); MR_declare_label(mercury__exception__builtin_catch_3_5_i3); MR_declare_label(mercury__exception__builtin_catch_3_4_i4); MR_declare_label(mercury__exception__builtin_catch_3_5_i4); MR_declare_label(mercury__exception__builtin_catch_3_4_i5); MR_declare_label(mercury__exception__builtin_catch_3_5_i5); #endif #if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING) MR_declare_label(mercury__exception__builtin_catch_3_4_i6); MR_declare_label(mercury__exception__builtin_catch_3_5_i6); #endif #ifdef MR_DEEP_PROFILING MR_declare_label(mercury__exception__builtin_catch_3_4_i7); MR_declare_label(mercury__exception__builtin_catch_3_5_i7); #endif #ifdef MR_DEEP_PROFILING MR_declare_label(mercury__exception__builtin_catch_3_0_i8); MR_declare_label(mercury__exception__builtin_catch_3_1_i8); MR_declare_label(mercury__exception__builtin_catch_3_2_i8); MR_declare_label(mercury__exception__builtin_catch_3_3_i8); MR_declare_label(mercury__exception__builtin_catch_3_4_i8); MR_declare_label(mercury__exception__builtin_catch_3_5_i8); #endif MR_declare_label(mercury__exception__builtin_throw_1_0_i1); /* ** MR_MAKE_PROC_LAYOUT(entry, detism, slots, succip_locn, pred_or_func, ** module, name, arity, mode) */ /* ** The various procedures of builtin_catch all allocate their stack frames ** on the nondet stack, so for the purposes of doing stack traces we say ** they have MR_DETISM_NON, even though they are not actually nondet. */ MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_0, MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 0); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_1, MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 1); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_2, MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 2); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_3, MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 3); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_4, MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 4); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_5, MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 5); #ifdef MR_DEEP_PROFILING MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 1); #endif MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 2); #ifdef MR_DEEP_PROFILING MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 3); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 3); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 3); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 3); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 3); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 3); #endif #ifdef MR_DEEP_PROFILING MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 4); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 4); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 5); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 5); #endif #if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING) MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 6); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 6); #endif #ifdef MR_DEEP_PROFILING MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 7); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 7); #endif #ifdef MR_DEEP_PROFILING MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 8); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 8); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 8); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 8); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 8); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 8); #endif MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_throw_1_0, MR_DETISM_DET, 1, MR_LONG_LVAL_STACKVAR(1), MR_PREDICATE, ""exception"", ""builtin_throw"", 1, 0); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_throw_1_0, 1); #ifdef MR_DEEP_PROFILING /* XXX the 0s are fake line numbers */ MR_proc_static_user_ho(exception, builtin_catch, 3, 0, ""exception.m"", 0, MR_TRUE); MR_proc_static_user_ho(exception, builtin_catch, 3, 1, ""exception.m"", 0, MR_TRUE); MR_proc_static_user_ho(exception, builtin_catch, 3, 2, ""exception.m"", 0, MR_TRUE); MR_proc_static_user_ho(exception, builtin_catch, 3, 3, ""exception.m"", 0, MR_TRUE); MR_proc_static_user_ho(exception, builtin_catch, 3, 4, ""exception.m"", 0, MR_TRUE); MR_proc_static_user_ho(exception, builtin_catch, 3, 5, ""exception.m"", 0, MR_TRUE); /* ** XXX Builtin_throw will eventually be able to make calls in deep profiling ** grades. In the meantime, we need its proc_static structure for its callers. */ MR_proc_static_user_empty(exception, builtin_throw, 1, 0, ""exception.m"", 0, MR_FALSE); #endif MR_BEGIN_MODULE(exceptions_module) MR_init_entry_sl(mercury__exception__builtin_catch_3_0); MR_init_entry_sl(mercury__exception__builtin_catch_3_1); MR_init_entry_sl(mercury__exception__builtin_catch_3_2); MR_init_entry_sl(mercury__exception__builtin_catch_3_3); MR_init_entry_sl(mercury__exception__builtin_catch_3_4); MR_init_entry_sl(mercury__exception__builtin_catch_3_5); #ifdef MR_DEEP_PROFILING MR_init_label(mercury__exception__builtin_catch_3_0_i1); MR_init_label(mercury__exception__builtin_catch_3_1_i1); MR_init_label(mercury__exception__builtin_catch_3_2_i1); MR_init_label(mercury__exception__builtin_catch_3_3_i1); MR_init_label(mercury__exception__builtin_catch_3_4_i1); MR_init_label(mercury__exception__builtin_catch_3_5_i1); #endif MR_init_label_sl(mercury__exception__builtin_catch_3_0_i2); MR_init_label_sl(mercury__exception__builtin_catch_3_1_i2); MR_init_label_sl(mercury__exception__builtin_catch_3_2_i2); MR_init_label_sl(mercury__exception__builtin_catch_3_3_i2); MR_init_label_sl(mercury__exception__builtin_catch_3_4_i2); MR_init_label_sl(mercury__exception__builtin_catch_3_5_i2); #ifdef MR_DEEP_PROFILING MR_init_label_sl(mercury__exception__builtin_catch_3_0_i3); MR_init_label_sl(mercury__exception__builtin_catch_3_1_i3); MR_init_label_sl(mercury__exception__builtin_catch_3_2_i3); MR_init_label_sl(mercury__exception__builtin_catch_3_3_i3); MR_init_label_sl(mercury__exception__builtin_catch_3_4_i3); MR_init_label_sl(mercury__exception__builtin_catch_3_5_i3); #endif #ifdef MR_DEEP_PROFILING MR_init_label_sl(mercury__exception__builtin_catch_3_4_i4); MR_init_label_sl(mercury__exception__builtin_catch_3_5_i4); MR_init_label_sl(mercury__exception__builtin_catch_3_4_i5); MR_init_label_sl(mercury__exception__builtin_catch_3_5_i5); #endif #if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING) MR_init_label_sl(mercury__exception__builtin_catch_3_4_i6); MR_init_label_sl(mercury__exception__builtin_catch_3_5_i6); #endif #ifdef MR_DEEP_PROFILING MR_init_label_sl(mercury__exception__builtin_catch_3_4_i7); MR_init_label_sl(mercury__exception__builtin_catch_3_5_i7); #endif #ifdef MR_DEEP_PROFILING MR_init_label(mercury__exception__builtin_catch_3_0_i8); MR_init_label(mercury__exception__builtin_catch_3_1_i8); MR_init_label(mercury__exception__builtin_catch_3_2_i8); MR_init_label(mercury__exception__builtin_catch_3_3_i8); MR_init_label(mercury__exception__builtin_catch_3_4_i8); MR_init_label(mercury__exception__builtin_catch_3_5_i8); #endif MR_init_entry_sl(mercury__exception__builtin_throw_1_0); MR_init_label_sl(mercury__exception__builtin_throw_1_0_i1); MR_BEGIN_CODE /* ** builtin_catch(Goal, Handler, Result) ** call Goal(R). ** if succeeds, set Result = R. ** if fails, fail. ** if throws an exception, call Handler(Exception, Result). ** ** On entry, we have a type_info (which we don't use) in MR_r1, ** the Goal to execute in MR_r2 and the Handler in MR_r3. ** On exit, we should put Result in MR_r1. ** ** There are slight differences between the versions of the code ** for the different determinisms. */ #define save_r1 do { \ MR_framevar(1) = MR_r1; \ } while (0) #define save_r1r2 do { \ MR_framevar(1) = MR_r1; \ MR_framevar(2) = MR_r2; \ } while (0) #define restore_r1 do { \ MR_r1 = MR_framevar(1); \ } while (0) #define restore_r1r2 do { \ MR_r1 = MR_framevar(1); \ MR_r2 = MR_framevar(2); \ } while (0) /* mercury__exception__builtin_catch_3_0: the det version */ #define proc_label mercury__exception__builtin_catch_3_0 #define proc_static MR_proc_static_user_name(exception, \ builtin_catch, 3, 0) #define excp_handler MR_MODEL_DET_HANDLER #define model ""[model det]"" #define save_results() save_r1 #define restore_results() restore_r1 #define handle_ticket_on_exit() do { \ MR_prune_ticket(); \ } while (0) #include ""mercury_exception_catch_body.h"" #undef proc_static #undef proc_label /* mercury__exception__builtin_catch_3_2: the cc_multi version */ /* identical to mercury__exception__builtin_catch_3_0 except for label names */ #define proc_label mercury__exception__builtin_catch_3_2 #define proc_static MR_proc_static_user_name(exception, \ builtin_catch, 3, 2) #include ""mercury_exception_catch_body.h"" #undef handle_ticket_on_exit #undef restore_results #undef save_results #undef model #undef excp_handler #undef proc_static #undef proc_label /* mercury__exception__builtin_catch_3_1: the semidet version */ #define proc_label mercury__exception__builtin_catch_3_1 #define proc_static MR_proc_static_user_name(exception, \ builtin_catch, 3, 1) #define excp_handler MR_MODEL_SEMI_HANDLER #define model ""[model semi]"" #define save_results() save_r1r2 #define restore_results() restore_r1r2 #define handle_ticket_on_exit() do { \ if (MR_r1) { \ MR_prune_ticket(); \ } else { \ MR_discard_ticket(); \ } \ } while (0) #include ""mercury_exception_catch_body.h"" #undef proc_static #undef proc_label /* mercury__exception__builtin_catch_3_3: the cc_nondet version */ /* identical to mercury__exception__builtin_catch_3_1 except for label names */ #define proc_label mercury__exception__builtin_catch_3_3 #define proc_static MR_proc_static_user_name(exception, \ builtin_catch, 3, 3) #include ""mercury_exception_catch_body.h"" #undef handle_ticket_on_exit #undef restore_results #undef save_results #undef model #undef excp_handler #undef proc_static #undef proc_label /* mercury__exception__builtin_catch_3_4: the multi version */ #define proc_label mercury__exception__builtin_catch_3_4 #define proc_static MR_proc_static_user_name(exception, \ builtin_catch, 3, 4) #define excp_handler MR_MODEL_NON_HANDLER #define model ""[model non]"" #define save_results() save_r1 #define restore_results() restore_r1 #define version_model_non MR_TRUE #define handle_ticket_on_exit() ((void) 0) #define handle_ticket_on_fail() do { \ MR_prune_ticket(); \ } while (0) #include ""mercury_exception_catch_body.h"" #undef proc_static #undef proc_label /* mercury__exception__builtin_catch_3_5: the nondet version */ /* identical to mercury__exception__builtin_catch_3_4 except for label names */ #define proc_label mercury__exception__builtin_catch_3_5 #define proc_static MR_proc_static_user_name(exception, \ builtin_catch, 3, 5) #include ""mercury_exception_catch_body.h"" #undef handle_ticket_on_fail #undef handle_ticket_on_exit #undef version_model_non #undef restore_results #undef save_results #undef model #undef excp_handler #undef proc_static #undef proc_label /* ** builtin_throw(Exception): ** Throw the specified exception. ** That means unwinding the nondet stack until we find a handler, ** unwinding all the other Mercury stacks, and then ** calling longjmp() to unwind the C stack. ** The longjmp() will branch to builtin_catch which will then ** call Handler(Exception, Result). ** ** On entry, we have Exception in MR_r1. */ MR_define_entry(mercury__exception__builtin_throw_1_0); { MR_Word exception; MR_Word handler; enum MR_HandlerCodeModel catch_code_model; MR_bool trace_from_full; MR_Word *orig_curfr; MR_Unsigned exception_event_number; exception = MR_r1; exception_event_number = MR_trace_event_number; /* ** let the debugger trace exception throwing */ if (MR_trace_enabled) { MR_Code *MR_jumpaddr; MR_trace_set_exception_value(exception); MR_save_transient_registers(); MR_jumpaddr = ML_trace_throw(MR_succip, MR_sp, MR_curfr); MR_restore_transient_registers(); if (MR_jumpaddr != NULL) MR_GOTO(MR_jumpaddr); } /* ** Search the nondet stack for an exception handler, ** i.e. a frame whose redoip is `MR_exception_handler_do_fail' ** (one created by `builtin_catch'). ** N.B. We search down the `succfr' chain, not the `prevfr' chain; ** this ensures that we only find handlers installed by our callers, ** not handlers installed by procedures that we called but which ** are still on the nondet stack because they left choice points ** behind. */ orig_curfr = MR_curfr; while (MR_redoip_slot(MR_curfr) != MR_ENTRY(MR_exception_handler_do_fail)) { MR_curfr = MR_succfr_slot(MR_curfr); if (MR_curfr < MR_CONTEXT(MR_ctxt_nondetstack_zone)->min) { MR_Word *save_succip; /* ** There was no exception handler. ** ** We restore the original value of MR_curfr, ** print out some diagnostics, ** and then terminate execution. ** ** We need to save the registers to the fake_reg ** array using MR_save_registers() before calling ** ML_report_uncaught_exception, since that is ** Mercury code and the C->Mercury interface expects ** the registers to be saved. ** We also need to save & restore the MR_succip ** across that call, since any call to Mercury code ** may clobber MR_succip (and also the Mercury ** registers MR_r1, MR_r2, MR_r3, etc., but for those ** we don't care, since we don't use them). ** Note that the MR_save_registers() alone is not ** sufficient since the Mercury code may clobber the ** copy of MR_succip in the fake_reg. */ MR_curfr = orig_curfr; fflush(stdout); save_succip = MR_succip; MR_save_registers(); ML_report_uncaught_exception(exception); MR_succip = save_succip; MR_trace_report(stderr); if (exception_event_number > 0) { if (MR_standardize_event_details) { fprintf(stderr, ""Last trace event before "" ""the unhandled exception was "" ""event #E%ld.\\n"", (long) MR_standardize_event_num( exception_event_number)); } else { fprintf(stderr, ""Last trace event before "" ""the unhandled exception was "" ""event #%ld.\\n"", (long) exception_event_number); } } if (MR_trace_enabled) { /* ** The stack has already been unwound ** by ML_trace_throw(), so we can't dump it. ** (In fact, if we tried to dump the now-empty ** stack, we'd get incorrect results, since ** ML_trace_throw() does not restore MR_succip ** to the appropriate value.) */ } else { MR_dump_stack(MR_succip, MR_sp, MR_curfr, MR_FALSE); } MR_perform_registered_exception_cleanups(); exit(1); } } /* ** Save the handler we found */ catch_code_model = MR_EXCEPTION_STRUCT->MR_excp_code_model; handler = MR_EXCEPTION_STRUCT->MR_excp_handler; trace_from_full = (MR_bool) MR_EXCEPTION_STRUCT->MR_excp_full_trace; /* ** Reset the success ip (i.e. return address). ** This ensures that when we return from this procedure, ** we will return to the caller of `builtin_catch'. */ MR_succip = MR_succip_slot(MR_curfr); /* ** Reset the det stack. */ MR_sp = MR_EXCEPTION_STRUCT->MR_excp_stack_ptr; #ifdef MR_USE_TRAIL /* ** Reset the trail. */ MR_reset_ticket(MR_EXCEPTION_STRUCT->MR_excp_trail_ptr, MR_exception); MR_discard_tickets_to(MR_EXCEPTION_STRUCT->MR_excp_ticket_counter); #endif #ifdef MR_RECLAIM_HP_ON_FAILURE /* ** Reset the heap. But we need to be careful to preserve the ** thrown exception object. ** ** The following algorithm uses the `solutions heap', and will work ** with non-conservative gc. We copy the exception object to the ** solutions_heap, reset the heap pointer, and then copy it back. ** ** An improvement to this would be to copy the exception object to the ** solutions heap, but have deep_copy add an offset to the pointers ** (at least, those that would otherwise point to the solutions heap), ** so that, when finished, a block move of the solutions heap back to ** the real heap will leave all the pointers in the correct place. */ { MR_Word * saved_solns_heap_ptr; /* switch to the solutions heap */ if (MR_ENGINE(MR_eng_heap_zone) == MR_EXCEPTION_STRUCT->MR_excp_heap_zone) { swap_heaps(); } saved_solns_heap_ptr = MR_hp; /* ** MR_deep_copy() the exception to the solutions heap. ** Note that we need to save/restore the hp register, if it ** is transient, before/after calling MR_deep_copy(). */ assert(MR_EXCEPTION_STRUCT->MR_excp_heap_ptr <= MR_EXCEPTION_STRUCT->MR_excp_heap_zone->top); MR_save_transient_registers(); exception = MR_deep_copy(exception, (MR_TypeInfo) &mercury_data_std_util__type_ctor_info_univ_0, MR_EXCEPTION_STRUCT->MR_excp_heap_ptr, MR_EXCEPTION_STRUCT->MR_excp_heap_zone->top); MR_restore_transient_registers(); /* switch back to the ordinary heap */ swap_heaps(); /* reset the heap */ assert(MR_EXCEPTION_STRUCT->MR_excp_heap_ptr <= MR_hp); MR_hp = MR_EXCEPTION_STRUCT->MR_excp_heap_ptr; /* MR_deep_copy the exception back to the ordinary heap */ assert(MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr <= MR_ENGINE(MR_eng_solutions_heap_zone)->top); MR_save_transient_registers(); exception = MR_deep_copy(exception, (MR_TypeInfo) &mercury_data_std_util__type_ctor_info_univ_0, saved_solns_heap_ptr, MR_ENGINE(MR_eng_solutions_heap_zone)->top); MR_restore_transient_registers(); /* reset the solutions heap */ assert(MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr <= saved_solns_heap_ptr); assert(saved_solns_heap_ptr <= MR_sol_hp); if (catch_code_model == MR_MODEL_NON_HANDLER) { /* ** If the code inside the try (catch) was nondet, ** then its caller (which may be solutions/2) may ** have put some more stuff on the solutions-heap ** after the goal succeeded; the goal may have ** only thrown after being re-entered on backtracking. ** Thus we can only reset the solutions heap to ** where it was before copying the exception object to it. */ MR_sol_hp = saved_solns_heap_ptr; } else { /* ** If the code inside the try (catch) was det or semidet, ** we can safely reset the solutions heap to where ** it was when it try (catch) was entered. */ MR_sol_hp = MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr; } } #endif /* !defined(MR_CONSERVATIVE_GC) */ /* ** Pop the final exception handler frame off the nondet stack, ** and reset the nondet stack top. (This must be done last, ** since it invalidates all the framevars.) */ MR_maxfr = MR_prevfr_slot(MR_curfr); MR_curfr = MR_succfr_slot(MR_curfr); /* ** Now longjmp to the catch, which will invoke the handler ** that we found. */ #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""throw catch_code_model %d\\n"", catch_code_model); #endif if (catch_code_model == MR_C_LONGJMP_HANDLER) { #ifdef MR_DEBUG_JMPBUFS fprintf(stderr, ""throw longjmp %p\\n"", *(MR_ENGINE(MR_eng_jmp_buf))); #endif MR_ENGINE(MR_eng_exception) = (MR_Word *) exception; MR_save_registers(); longjmp(*(MR_ENGINE(MR_eng_jmp_buf)), 1); } /* ** Otherwise, the handler is a Mercury closure. ** Invoke the handler as `Handler(Exception, Result)'. */ #ifdef MR_DEEP_PROFILING MR_fatal_error(""builtin_throw cannot (yet) invoke Mercury handlers in deep profiling grades""); #endif MR_r1 = handler; /* get the Handler closure */ MR_r2 = 1; /* One additional input argument */ MR_r3 = exception; /* This is our one input argument */ /* ** Restore the value of MR_trace_from_full that we saved at the ** start of builtin_catch. */ MR_trace_from_full = trace_from_full; /* ** If the catch was semidet, we need to set the success indicator ** MR_r1 to MR_TRUE and return the result in MR_r2; otherwise, we return ** the result in MR_r1, which is where mercury__do_call_closure_compact ** puts it, so we can do a tailcall. */ if (catch_code_model != MR_MODEL_SEMI_HANDLER) { MR_tailcall(MR_ENTRY(mercury__do_call_closure_compact), MR_ENTRY(mercury__exception__builtin_throw_1_0)); } MR_incr_sp_push_msg(1, ""pred builtin_throw/1""); MR_stackvar(1) = (MR_Word) MR_succip; MR_call(MR_ENTRY(mercury__do_call_closure_compact), MR_LABEL(mercury__exception__builtin_throw_1_0_i1), MR_ENTRY(mercury__exception__builtin_throw_1_0)); } MR_define_label(mercury__exception__builtin_throw_1_0_i1); MR_update_prof_current_proc( MR_LABEL(mercury__exception__builtin_throw_1_0)); /* we've just returned from mercury__do_call_closure_compact */ MR_r2 = MR_r1; MR_r1 = MR_TRUE; MR_succip = (MR_Code *) MR_stackvar(1); MR_decr_sp_pop_msg(1); MR_proceed(); /* return to the caller of `builtin_catch' */ MR_END_MODULE #endif /* ! MR_HIGHLEVEL_CODE */ /* Ensure that the initialization code for the above module gets run. */ /* INIT mercury_sys_init_exceptions */ void mercury_sys_init_exceptions_init(void) { #ifndef MR_HIGHLEVEL_CODE exceptions_module(); #endif } void mercury_sys_init_exceptions_init_type_tables(void) { /* no types to register */ } #ifdef MR_DEEP_PROFILING void mercury_sys_init_exceptions_write_out_proc_statics(FILE *fp) { MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_catch, 3, 0)); MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_catch, 3, 1)); MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_catch, 3, 2)); MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_catch, 3, 3)); MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_catch, 3, 4)); MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_catch, 3, 5)); MR_write_out_proc_static(fp, (MR_ProcStatic *) &MR_proc_static_user_name(exception, builtin_throw, 1, 0)); } #endif "). %-----------------------------------------------------------------------------% :- pragma export(report_uncaught_exception(in, di, uo), "ML_report_uncaught_exception"). :- pred report_uncaught_exception(univ, io__state, io__state). :- mode report_uncaught_exception(in, di, uo) is cc_multi. report_uncaught_exception(Exception) --> try_io(report_uncaught_exception_2(Exception), Result), ( { Result = succeeded(_) } ; { Result = exception(_) } % if we got a further exception while trying to report % the uncaught exception, just ignore it ). :- pred report_uncaught_exception_2(univ, unit, io__state, io__state). :- mode report_uncaught_exception_2(in, out, di, uo) is det. report_uncaught_exception_2(Exception, unit) --> io__flush_output, io__stderr_stream(StdErr), io__write_string(StdErr, "Uncaught Mercury exception:\n"), ( { univ_to_type(Exception, software_error(Message)) } -> io__format(StdErr, "Software Error: %s\n", [s(Message)]) ; io__write(StdErr, univ_value(Exception)), io__nl(StdErr) ), io__flush_output(StdErr). %-----------------------------------------------------------------------------%