mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-14 05:12:33 +00:00
Code Issues Projects Releases Wiki Activity
Files
853622ad8788209e55f3adfbc92e76075d65e32c
mercury/library/exception.m
Julien Fischer 853622ad87 Shift most of the STM runtime into the Mercury runtime. 
Estimated hours taken: 12
Branches: main

Shift most of the STM runtime into the Mercury runtime.
Rename a lot of the types and functions used by the STM runtime.
Various other fixes and improvements to the STM runtime.

library/exception.m:
	Add a new version of try_stm/4 that is intended for use within
	atomic blocks by user code.  This version filters out and rethrows
	rollback exceptions.

	Rename the existing try_stm/4 to unsafe_try_stm/4.

library/stm_builtin.m:
	Move all the STM runtime support from this module into the
	Mercury runtime.  The foreign_procs in this module now just
	forward their work to the appropriate function or macro there.

	Rename most of the types and functions associated with STM
	so that they better conform to our coding standards.

	Add a unit dummy type for use with atomic blocks that have no
	outputs, for example atomically swapping the values of two
	transaction variables.  This is needed because the call to
	unsafe_try_stm introduced by the source-to-source transformation
	still has to return a value if it succeeds.

runtime/mercury_stm.h:
runtime/mercury_stm.c:
	New files containing the runtime support for STM that was in
	library/stm_builtin.m

	Define thread identity for the low-level C grades.  In such
	grades it just the context address.

	Add a macro that returns the identity of the (Mercury) thread that
	is currently executing.  (The implementation of wait queues will
	need this information.)

runtime/mercury_context.c:
	At program startup initialise the STM lock.

runtime/mercury_conf_param.h:
	Document the macro MR_STM_DEBUG which will be used to
	enable low-level debugging of the STM runtime.

runtime/Mmakefile:
	Add the new files.
2007-09-13 04:40:52 +00:00

2751 lines
98 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2007 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 module 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 foreign_export' throws an exception which is not caught within that
% procedure, then you will get undefined behaviour.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module exception.
:- interface.
:- import_module io.
:- import_module list.
:- import_module maybe.
:- import_module store.
:- import_module univ.
%-----------------------------------------------------------------------------%
% Exceptions of this type are used by many parts of the Mercury
% implementation to indicate an internal error.
%
:- type software_error
---> software_error(string).
% throw(Exception):
% Throw the specified exception.
%
:- func throw(T) = _ is erroneous.
:- pred throw(T::in) is erroneous.
% The following type and inst 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, io), exception_result(T), io, io).
:- 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, MaybeException, Solutions):
%
% Operational semantics:
% Try to find all solutions to Goal(S), using backtracking.
% Collect the solutions found in Solutions, until the goal
% either throws an exception or fails. If it throws an
% exception E then MaybeException = yes(E), otherwise
% MaybeException = no.
%
% Declaratively it is equivalent to:
% all [S] (list.member(S, Solutions) => Goal(S)),
% (
% MaybeException = yes(_)
% ;
% MaybeException = no,
% all [S] (Goal(S) => list.member(S, Solutions))
% ).
%
:- pred try_all(pred(T), maybe(univ), list(T)).
:- mode try_all(pred(out) is det, out, out(nil_or_singleton_list))
is cc_multi.
:- mode try_all(pred(out) is semidet, out, out(nil_or_singleton_list))
is cc_multi.
:- mode try_all(pred(out) is multi, out, out) is cc_multi.
:- mode try_all(pred(out) is nondet, out, out) is cc_multi.
:- inst [] ---> [].
:- inst nil_or_singleton_list ---> [] ; [ground].
% incremental_try_all(Goal, AccumulatorPred, Acc0, Acc):
%
% Declaratively it is equivalent to:
% try_all(Goal, MaybeException, Solutions),
% list.map(wrap_success, Solutions, Results),
% list.foldl(AccumulatorPred, Results, Acc0, Acc1),
% (
% MaybeException = no,
% Acc = Acc1
% ;
% MaybeException = yes(Exception),
% AccumulatorPred(exception(Exception), Acc1, Acc)
% )
%
% where (wrap_success(S, R) <=> R = succeeded(S)).
%
% Operationally, however, incremental_try_all/5 will call
% AccumulatorPred for each solution as it is obtained, rather than
% first building a list of the solutions.
%
:- 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, io), T, pred(io.res, io, io), io.res, io, io).
:- 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.
% throw_if_near_stack_limits checks if the program is near
% the limits of the Mercury stacks, and throws an exception
% (near_stack_limits) if this is the case.
%
% This predicate works only in low level C grades; in other grades,
% it never throws an exception.
%
% The predicate is impure instead of semipure because its effect
% depends not only on the execution of other impure predicates,
% but all calls.
%
:- type near_stack_limits
---> near_stack_limits.
:- impure pred throw_if_near_stack_limits is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
%-----------------------------------------------------------------------------%
:- interface.
:- import_module stm_builtin.
% XXX Once STM is stable this predicate should be moved into the
% documented interface of this module.
%
:- pred try_stm(pred(A, stm, stm), exception_result(A), stm, stm).
:- mode try_stm(in(pred(out, di, uo) is det),
out(cannot_fail), di, uo) is cc_multi.
:- mode try_stm(in(pred(out, di, uo) is cc_multi),
out(cannot_fail), di, uo) is cc_multi.
% This is the version is called by code introduced by the source-to-source
% transformation for atomic scopes. This predicate should not be called
% by user code.
%
% It is unsafe in the sense that it does not guarantee that rollback
% exceptions are always rethrown.
%
:- pred unsafe_try_stm(pred(A, stm, stm),
exception_result(A), stm, stm).
:- mode unsafe_try_stm(in(pred(out, di, uo) is det),
out(cannot_fail), di, uo) is cc_multi.
:- mode unsafe_try_stm(in(pred(out, di, uo) is cc_multi),
out(cannot_fail), di, uo) is cc_multi.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module solutions.
:- import_module string.
:- import_module unit.
%-----------------------------------------------------------------------------%
:- pred try_det(exp_determinism, pred(T), exception_result(T)).
:- mode try_det(in(bound(exp_detism_det)), pred(out) is det,
out(cannot_fail)) is cc_multi.
:- mode try_det(in(bound(exp_detism_semidet)), pred(out) is semidet,
out) is cc_multi.
:- mode try_det(in(bound(exp_detism_cc_multi)), pred(out) is cc_multi,
out(cannot_fail)) is cc_multi.
:- mode try_det(in(bound(exp_detism_cc_nondet)), pred(out) is cc_nondet,
out) is cc_multi.
:- pred try_io_det(exp_determinism, pred(T, io, io), exception_result(T),
io, io).
:- mode try_io_det(in(bound(exp_detism_det)),
pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi.
:- mode try_io_det(in(bound(exp_detism_cc_multi)),
pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi.
:- pred try_store_det(exp_determinism, pred(T, store(S), store(S)),
exception_result(T), store(S), store(S)).
:- mode try_store_det(in(bound(exp_detism_det)),
pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi.
:- mode try_store_det(in(bound(exp_detism_cc_multi)),
pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi.
:- pred try_all_det(exp_determinism, pred(T), maybe(univ), list(T)).
:- mode try_all_det(in(bound(exp_detism_det)), pred(out) is det, out,
out(nil_or_singleton_list)) is cc_multi.
:- mode try_all_det(in(bound(exp_detism_semidet)), pred(out) is semidet, out,
out(nil_or_singleton_list)) is cc_multi.
:- mode try_all_det(in(bound(exp_detism_multi)), pred(out) is multi, out,
out) is cc_multi.
:- mode try_all_det(in(bound(exp_detism_nondet)), pred(out) is nondet, out,
out) is cc_multi.
:- type exp_determinism
---> exp_detism_det
; exp_detism_semidet
; exp_detism_cc_multi
; exp_detism_cc_nondet
; exp_detism_multi
; exp_detism_nondet
; exp_detism_erroneous
; exp_detism_failure.
:- pred get_determinism(pred(T), exp_determinism).
:- mode get_determinism(pred(out) is det,
out(bound(exp_detism_det))) is cc_multi.
:- mode get_determinism(pred(out) is semidet,
out(bound(exp_detism_semidet))) is cc_multi.
:- mode get_determinism(pred(out) is multi,
out(bound(exp_detism_multi))) is cc_multi.
:- mode get_determinism(pred(out) is nondet,
out(bound(exp_detism_nondet))) is cc_multi.
:- mode get_determinism(pred(out) is cc_multi,
out(bound(exp_detism_cc_multi))) is cc_multi.
:- mode get_determinism(pred(out) is cc_nondet,
out(bound(exp_detism_cc_nondet))) is cc_multi.
:- pred get_determinism_2(pred(T, S, S), exp_determinism).
:- mode get_determinism_2(pred(out, di, uo) is det,
out(bound(exp_detism_det))) is cc_multi.
:- mode get_determinism_2(pred(out, di, uo) is cc_multi,
out(bound(exp_detism_cc_multi))) is cc_multi.
% The calls to throw/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.
%
% NOTE: since there is no guarantee that modules that opt import these
% predicates will be compiled with `--no-reorder-disj' we need to make
% sure they are not inlined in other modules.
:- pragma no_inline(get_determinism/2).
:- pragma promise_equivalent_clauses(get_determinism/2).
get_determinism(_Pred::(pred(out) is det),
Det::out(bound(exp_detism_det))) :-
( cc_multi_equal(exp_detism_det, Det)
; throw(software_error("get_determinism"))
).
get_determinism(_Pred::(pred(out) is semidet),
Det::out(bound(exp_detism_semidet))) :-
( cc_multi_equal(exp_detism_semidet, Det)
; throw(software_error("get_determinism"))
).
get_determinism(_Pred::(pred(out) is cc_multi),
Det::out(bound(exp_detism_cc_multi))) :-
( cc_multi_equal(exp_detism_cc_multi, Det)
; throw(software_error("get_determinism"))
).
get_determinism(_Pred::(pred(out) is cc_nondet),
Det::out(bound(exp_detism_cc_nondet))) :-
( cc_multi_equal(exp_detism_cc_nondet, Det)
; throw(software_error("get_determinism"))
).
get_determinism(_Pred::(pred(out) is multi),
Det::out(bound(exp_detism_multi))) :-
( cc_multi_equal(exp_detism_multi, Det)
; throw(software_error("get_determinism"))
).
get_determinism(_Pred::(pred(out) is nondet),
Det::out(bound(exp_detism_nondet))) :-
( cc_multi_equal(exp_detism_nondet, Det)
; throw(software_error("get_determinism"))
).
:- pragma no_inline(get_determinism_2/2).
:- pragma promise_equivalent_clauses(get_determinism_2/2).
get_determinism_2(_Pred::pred(out, di, uo) is det,
Det::out(bound(exp_detism_det))) :-
( cc_multi_equal(exp_detism_det, Det)
; throw(software_error("get_determinism_2"))
).
get_determinism_2(_Pred::pred(out, di, uo) is cc_multi,
Det::out(bound(exp_detism_cc_multi))) :-
( cc_multi_equal(exp_detism_cc_multi, Det)
; throw(software_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_equivalent_clauses(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_equivalent_solutions [!:IO, PRes, CleanupRes] (
finally_2(P, Cleanup, 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, io), pred(io.res, io, io), T, io.res,
io, io).
:- mode finally_2(pred(out, di, uo) is det,
pred(out, di, uo) is det, out, out, di, uo) is cc_multi.
:- mode finally_2(pred(out, di, uo) is cc_multi,
pred(out, di, uo) is cc_multi, out, out, di, uo) is cc_multi.
:- pragma promise_pure(finally_2/6).
finally_2(P, Cleanup, PRes, CleanupRes, !IO) :-
try_io(P, ExcpResult, !IO),
(
ExcpResult = succeeded(PRes),
Cleanup(CleanupRes, !IO)
;
ExcpResult = exception(_),
Cleanup(_, !IO),
% The I/O state resulting from Cleanup cannot possibly be used, so we
% have to trick the compiler into not removing the call.
(
semidet_succeed,
impure use(!.IO)
->
rethrow(ExcpResult)
;
throw(software_error("exception.finally_2"))
)
).
:- impure pred use(T::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],
";").
:- pragma foreign_proc("Erlang",
use(_T::in),
[will_not_call_mercury, thread_safe],
"void").
%-----------------------------------------------------------------------------%
:- 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_det(Detism, Goal, Result).
try_det(exp_detism_det, Goal, Result) :-
WrappedGoal = (pred(R::out) is det :-
wrap_success_or_failure(Goal, R)
),
catch_impl(WrappedGoal, wrap_exception, Result0),
cc_multi_equal(Result0, Result).
try_det(exp_detism_semidet, Goal, Result) :-
WrappedGoal = (pred(R::out) is det :-
wrap_success_or_failure(Goal, R)
),
catch_impl(WrappedGoal, wrap_exception, Result0),
cc_multi_equal(Result0, Result).
try_det(exp_detism_cc_multi, Goal, Result) :-
WrappedGoal = (pred(R::out) is cc_multi :-
wrap_success_or_failure(Goal, R)
),
catch_impl(WrappedGoal, wrap_exception, Result).
try_det(exp_detism_cc_nondet, Goal, Result) :-
WrappedGoal = (pred(R::out) is cc_multi :-
wrap_success_or_failure(Goal, R)
),
catch_impl(WrappedGoal, wrap_exception, Result).
% We switch on the Detism argument for a similar reason to above.
try_all(Goal, MaybeException, Solutions) :-
get_determinism(Goal, Detism),
try_all_det(Detism, Goal, MaybeException, Solutions).
try_all_det(exp_detism_det, Goal, MaybeException, Solutions) :-
try_det(exp_detism_det, Goal, Result),
(
Result = succeeded(Solution),
Solutions = [Solution],
MaybeException = no
;
Result = exception(Exception),
Solutions = [],
MaybeException = yes(Exception)
).
try_all_det(exp_detism_semidet, Goal, MaybeException, Solutions) :-
try_det(exp_detism_semidet, Goal, Result),
(
Result = failed,
Solutions = [],
MaybeException = no
;
Result = succeeded(Solution),
Solutions = [Solution],
MaybeException = no
;
Result = exception(Exception),
Solutions = [],
MaybeException = yes(Exception)
).
try_all_det(exp_detism_multi, Goal, MaybeException, Solutions) :-
WrappedGoal = (pred(R::out) is multi :-
wrap_success(Goal, R)
),
TryOneSoln = (pred(Result::out) is multi :-
catch_impl(WrappedGoal, wrap_exception, Result)
),
unsorted_solutions(TryOneSoln, ResultList),
list.foldl2(process_one_exception_result, ResultList,
no, MaybeException, [], Solutions).
try_all_det(exp_detism_nondet, Goal, MaybeException, Solutions) :-
WrappedGoal = (pred(R::out) is nondet :-
wrap_success(Goal, R)
),
TryOneSoln = (pred(Result::out) is nondet :-
catch_impl(WrappedGoal, wrap_exception, Result)
),
unsorted_solutions(TryOneSoln, ResultList),
list.foldl2(process_one_exception_result, ResultList,
no, MaybeException, [], Solutions).
:- pred process_one_exception_result(exception_result(T)::in,
maybe(univ)::in, maybe(univ)::out, list(T)::in, list(T)::out) is det.
process_one_exception_result(exception(E), !MaybeException, !Solutions) :-
% Ignore all but the last exception that is in the list. This is
% okay since there should never be more than one.
!.MaybeException = _,
!:MaybeException = yes(E).
process_one_exception_result(succeeded(S), !MaybeException, !Solutions) :-
!:Solutions = [S | !.Solutions].
process_one_exception_result(failed, !MaybeException, !Solutions) :-
throw(software_error("process_one_exception_result: unexpected failure")).
incremental_try_all(Goal, AccPred, !Acc) :-
WrappedGoal = (pred(R::out) is nondet :-
wrap_success(Goal, R)
),
TryOneSoln = (pred(Result::out) is nondet :-
catch_impl(WrappedGoal, wrap_exception, Result)
),
unsorted_aggregate(TryOneSoln, AccPred, !Acc).
% We need to switch on the Detism argument for the same reason as above.
try_store(StoreGoal, Result, !Store) :-
get_determinism_2(StoreGoal, Detism),
try_store_det(Detism, StoreGoal, Result, !Store).
% 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(exp_detism_det, StoreGoal, Result, !Store) :-
Goal = (pred({R, S}::out) is det :-
unsafe_promise_unique(!.Store, S0),
StoreGoal(R, S0, S)
),
try_det(exp_detism_det, Goal, Result0),
handle_store_result(Result0, Result, !Store).
try_store_det(exp_detism_cc_multi, StoreGoal, Result, !Store) :-
Goal = (pred({R, S}::out) is cc_multi :-
unsafe_promise_unique(!.Store, S0),
StoreGoal(R, S0, S)
),
try_det(exp_detism_cc_multi, Goal, Result0),
handle_store_result(Result0, Result, !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, !Store) :-
(
Result0 = succeeded({Res, NewStore}),
Result = succeeded(Res),
% NewStore is now unique because the only other reference to
% the store was from !.Store, which we're throwing away here.
unsafe_promise_unique(NewStore, !: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(!Store)
).
try_io(IO_Goal, Result, !IO) :-
get_determinism_2(IO_Goal, Detism),
try_io_det(Detism, IO_Goal, Result, !IO).
% 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_det/5).
try_io_det(exp_detism_det, IO_Goal, Result, !IO) :-
Goal = (pred(R::out) is det :-
very_unsafe_perform_io(IO_Goal, R)
),
try_det(exp_detism_det, Goal, Result).
try_io_det(exp_detism_cc_multi, IO_Goal, Result, !IO) :-
Goal = (pred(R::out) is cc_multi :-
very_unsafe_perform_io(IO_Goal, R)
),
try_det(exp_detism_cc_multi, Goal, Result).
:- pred very_unsafe_perform_io(pred(T, io, io), 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(IO0),
Goal(Result, IO0, IO),
impure consume_io_state(IO).
:- impure pred make_io_state(io::uo) is det.
:- pragma foreign_proc("C", make_io_state(_IO::uo),
[will_not_call_mercury, thread_safe, will_not_modify_trail], "").
:- 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], "").
:- pragma foreign_proc("Erlang", make_io_state(_IO::uo),
[will_not_call_mercury, thread_safe], "void").
:- impure pred consume_io_state(io::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], "").
:- pragma foreign_proc("Erlang",
consume_io_state(_IO::di),
[will_not_call_mercury, thread_safe], "void").
:- pred wrap_exception(univ::in, exception_result(T)::out) is det.
wrap_exception(Exception, exception(Exception)).
%-----------------------------------------------------------------------------%
try_stm(Goal, Result, !STM) :-
unsafe_try_stm(Goal, Result0, !STM),
(
Result0 = succeeded(_),
Result = Result0
;
Result0 = exception(Exception),
% If the exception is an STM rollback exception rethrow it since
% the handler at the beginning of the atomic scope should deal with
% it; otherwise let the user deal with it.
( Exception = univ(stm_builtin.rollback_exception) ->
rethrow(Result0)
;
Result = Result0
)
).
:- pragma promise_equivalent_clauses(unsafe_try_stm/4).
unsafe_try_stm(TransactionGoal::in(pred(out, di, uo) is det),
Result::out(cannot_fail), STM0::di, STM::uo) :-
get_determinism_2(TransactionGoal, Detism),
try_stm_det(Detism, TransactionGoal, Result, STM0, STM).
unsafe_try_stm(TransactionGoal::in(pred(out, di, uo) is cc_multi),
Result::out(cannot_fail), STM0::di, STM::uo) :-
get_determinism_2(TransactionGoal, Detism),
try_stm_cc_multi(Detism, TransactionGoal, Result, STM0, STM).
:- pred try_stm_det(exp_determinism, pred(T, stm, stm),
exception_result(T), stm, stm).
:- mode try_stm_det(in(bound(exp_detism_det)),
pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi.
try_stm_det(exp_detism_det, TransactionGoal, Result, !STM) :-
Goal = (pred({R, S}::out) is det :-
unsafe_promise_unique(!.STM, S0),
TransactionGoal(R, S0, S)
),
try_det(exp_detism_det, Goal, Result0),
handle_stm_result(Result0, Result, !STM).
:- pred try_stm_cc_multi(exp_determinism, pred(T, stm, stm),
exception_result(T), stm, stm).
:- mode try_stm_cc_multi(in(bound(exp_detism_cc_multi)),
pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi.
try_stm_cc_multi(exp_detism_cc_multi, TransactionGoal, Result, !STM) :-
Goal = (pred({R, S}::out) is cc_multi :-
unsafe_promise_unique(!.STM, S0),
TransactionGoal(R, S0, S)
),
try_det(exp_detism_cc_multi, Goal, Result0),
handle_stm_result(Result0, Result, !STM).
:- pred handle_stm_result(exception_result({T, stm})::in(cannot_fail),
exception_result(T)::out(cannot_fail), stm::in, stm::uo) is det.
handle_stm_result(Result0, Result, !STM) :-
(
Result0 = succeeded({Res, NewSTM}),
Result = succeeded(Res),
unsafe_promise_unique(NewSTM, !:STM)
;
Result0 = exception(E0),
copy(E0, E),
Result = exception(E),
unsafe_promise_unique(!STM)
).
%-----------------------------------------------------------------------------%
:- pred throw_impl(univ::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.
% NOTE: The subterm dependency tracking algorithm in the declarative
% debugger expects builtin_catch to only be called from catch_impl.
% If catch_impl is modified for a backend that supports debugging,
% or builtin_catch is called from somewhere else, then
% the code in browser/declarative_tree.m will need to be modified.
%
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::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.
%
% IMPORTANT: any changes or additions to external predicates should be
% reflected in the definition of pred_is_external in
% mdbcomp/program_representation.m. The debugger needs to know what predicates
% are defined externally, so that it knows not to expect events for those
% predicates.
%
:- 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 <stdlib.h>
#include <setjmp.h>
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__univ__univ__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, ordinary_despite_detism],
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, ordinary_despite_detism],
local_vars(""),
first_code(""),
retry_code(""),
common_code("
mercury.runtime.Errors.SORRY(""foreign code for this function"");
")
).
*/
:- pragma foreign_proc("Erlang",
throw_impl(T::in),
[will_not_call_mercury, promise_pure],
"
throw({'ML_exception', T})
").
:- pragma foreign_code("Erlang", "
% det ==> model_det
builtin_catch_3_p_0(TypeInfo, WrappedGoal, Handler) ->
T = try
WrappedGoal()
catch
throw: {'ML_exception', Excp} ->
Handler(Excp)
end.
% semidet ==> model_semi
builtin_catch_3_p_1(_TypeInfo, _WrappedGoal, _Handler) ->
% This function is not called anywhere in this module.
mercury__private_builtin:sorry_1_p_0(
""builtin_catch_3_p_1 not implemented"").
% cc_multi ==> model_det
builtin_catch_3_p_2(TypeInfo, WrappedGoal, Handler) ->
try
WrappedGoal()
catch
throw: {'ML_exception', Excp} ->
Handler(Excp)
end.
% cc_nondet ==> model_semi
builtin_catch_3_p_3(_TypeInfo, _Pred, _Handler) ->
% This function is not called anywhere in this module.
mercury__private_builtin:sorry_1_p_0(
""builtin_catch_3_p_3 not implemented"").
% multi ==> model_non
builtin_catch_3_p_4(_TypeInfo_for_T, Pred, Handler, Succeed) ->
try
Pred(Succeed)
catch
throw: {'ML_exception', Excp} ->
Result = Handler(Excp),
Succeed(Result)
end.
% multi ==> model_non
builtin_catch_3_p_5(_TypeInfo_for_T, Pred, Handler, Succeed) ->
try
Pred(Succeed)
catch
throw: {'ML_exception', Excp} ->
Result = Handler(Excp),
Succeed(Result)
end.
").
:- 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 foreign_export("C", call_goal(pred(out) is det, out),
"ML_call_goal_det").
:- pragma foreign_export("IL", call_goal(pred(out) is det, out),
"ML_call_goal_det").
:- pragma foreign_export("C", call_goal(pred(out) is semidet, out),
"ML_call_goal_semidet").
:- pragma foreign_export("IL", 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 foreign_export("C", call_handler(pred(in, out) is det, in, out),
"ML_call_handler_det").
:- pragma foreign_export("IL", 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, ordinary_despite_detism],
"
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, ordinary_despite_detism],
"
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 <assert.h>
#include <stdio.h>
#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_univ__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 *deep_fp,
FILE *procrep_fp);
#endif
#ifndef MR_HIGHLEVEL_CODE
/*
** MR_throw_walk_stack():
** Unwind the stack as far as possible, until we reach a frame
** with an exception handler. As we go, invoke either or both
** of two actions.
**
** (1) If MR_debug_enabled is set, then 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.
**
** (2) In deep profiling grades, execute the actions appropriate for
** execution leaving the procedure invocation via the exception port.
** (Deep profiling grades always set MR_STACK_TRACE, so in such grades
** we *will* be able to traverse the stack all the way.)
**
** The arguments 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.
*/
#ifdef MR_DEEP_PROFILING
#define WARNING(msg) \\
do { \\
MR_fatal_error(""cannot update exception counts: %s\\n"", \\
msg); \\
} while (0)
#else
#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)
#endif
static MR_Code *
ML_throw_walk_stack(MR_Code *success_pointer, MR_Word *base_sp,
MR_Word *base_curfr)
{
const MR_Internal *label;
const MR_LabelLayout *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->MR_internal_layout;
while (return_label_layout != NULL) {
const MR_ProcLayout *entry_layout;
MR_Code *MR_jumpaddr;
MR_StackWalkStepResult result;
const char *problem;
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
const MR_ProcLayout *pl;
MR_ProcStatic *ps;
MR_ProcStatic *proc_static;
int top_csd_slot;
int middle_csd_slot;
MR_CallSiteDynamic *top_csd;
MR_CallSiteDynamic *middle_csd;
#ifndef MR_USE_ACTIVATION_COUNTS
int old_outermost_slot;
MR_ProcDynamic *old_outermost;
#endif
#endif
/*
** 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;
}
#ifdef MR_DEEP_PROFILING
/*
** The following code is based on the logic of
** runtime/mercury_deep_leave_port_body.h, differing
** in getting its parameters directly from stack frames
** guided by RTTI data and in having the additional error
** handling required by this. Any changes here may need to be
** reflected there and vice versa.
*/
#ifdef MR_EXEC_TRACE
if (! MR_disable_deep_profiling_in_debugger) {
/* The matching parenthesis is near the end of the loop */
#endif
MR_enter_instrumentation();
proc_static = entry_layout->MR_sle_proc_static;
top_csd_slot = proc_static->MR_ps_cur_csd_stack_slot;
middle_csd_slot = proc_static->MR_ps_next_csd_stack_slot;
if (top_csd_slot <= 0) {
MR_fatal_error(""builtin_throw: no top csd slot"");
}
if (middle_csd_slot <= 0) {
MR_fatal_error(""builtin_throw: no middle csd slot"");
}
#ifndef MR_USE_ACTIVATION_COUNTS
old_outermost_slot = proc_static->MR_ps_old_outermost_stack_slot;
if (old_outermost_slot <= 0) {
MR_fatal_error(""builtin_throw: no old_outer slot"");
}
#endif
if (MR_DETISM_DET_STACK(entry_layout->MR_sle_detism)) {
top_csd = (MR_CallSiteDynamic *)
MR_based_stackvar(base_sp, top_csd_slot);
middle_csd = (MR_CallSiteDynamic *)
MR_based_stackvar(base_sp, middle_csd_slot);
#ifndef MR_USE_ACTIVATION_COUNTS
old_outermost = (MR_ProcDynamic *)
MR_based_stackvar(base_sp, old_outermost_slot);
#endif
} else {
top_csd = (MR_CallSiteDynamic *)
MR_based_framevar(base_curfr, top_csd_slot);
middle_csd = (MR_CallSiteDynamic *)
MR_based_framevar(base_curfr, middle_csd_slot);
#ifndef MR_USE_ACTIVATION_COUNTS
old_outermost = (MR_ProcDynamic *)
MR_based_framevar(base_curfr, old_outermost_slot);
#endif
}
csd = middle_csd;
MR_deep_assert(csd, NULL, NULL, csd == MR_current_call_site_dynamic);
#ifdef MR_DEEP_PROFILING_PORT_COUNTS
csd->MR_csd_own.MR_own_excps++;
#endif
MR_deep_assert(csd, NULL, NULL, csd->MR_csd_callee_ptr != NULL);
pl = csd->MR_csd_callee_ptr->MR_pd_proc_layout;
MR_deep_assert(csd, pl, NULL, pl != NULL);
ps = pl->MR_sle_proc_static;
MR_deep_assert(csd, pl, ps, ps != NULL);
#ifdef MR_USE_ACTIVATION_COUNTS
/* decrement activation count */
ps->MR_ps_activation_count--;
MR_deep_assert(csd, pl, ps, ps->MR_ps_activation_count >= 0);
#else
/* set outermost activation pointer */
ps->MR_ps_outermost_activation_ptr = old_outermost;
#endif
/* set current csd */
MR_current_call_site_dynamic = top_csd;
MR_leave_instrumentation();
#ifdef MR_EXEC_TRACE
/* The matching parenthesis is near the start of the loop */
}
#endif
#endif
if (MR_debug_enabled) {
/* 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_word = (MR_Word) base_sp;
MR_curfr_word = (MR_Word) 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_word = (MR_Word) 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);
#define MR_DUMMY_LINE 0
MR_call_sites_user_one_ho(exception, builtin_catch, 3, 0, MR_DUMMY_LINE);
MR_proc_static_user_one_site(exception, builtin_catch, 3, 0,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
MR_call_sites_user_one_ho(exception, builtin_catch, 3, 1, MR_DUMMY_LINE);
MR_proc_static_user_one_site(exception, builtin_catch, 3, 1,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
MR_call_sites_user_one_ho(exception, builtin_catch, 3, 2, MR_DUMMY_LINE);
MR_proc_static_user_one_site(exception, builtin_catch, 3, 2,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
MR_call_sites_user_one_ho(exception, builtin_catch, 3, 3, MR_DUMMY_LINE);
MR_proc_static_user_one_site(exception, builtin_catch, 3, 3,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
MR_call_sites_user_one_ho(exception, builtin_catch, 3, 4, MR_DUMMY_LINE);
MR_proc_static_user_one_site(exception, builtin_catch, 3, 4,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
MR_call_sites_user_one_ho(exception, builtin_catch, 3, 5, MR_DUMMY_LINE);
MR_proc_static_user_one_site(exception, builtin_catch, 3, 5,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
/*
** 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.
**
** The fields of the MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT macro are
** the following:
**
** MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(detism, slots, succip_locn,
** pred_or_func, module, name, arity, mode)
**
** We must use MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT instead of the
** MR_STATIC_USER_PROC_STATIC_PROC_LAYOUT version, because with intermodule
** optimization, the caller of builtin_catch may be inlined in other modules
** (e.g. browser/declarative_debugger.m), and deep profiling may therefore
** need the address of the proc_layout structure for the call's
** call_site_static structure.
**
** Additionally, the compiler generated declaration for the proc_layout
** structure will be declared extern if the address is required in other
** modules. GCC 4 and above consider a static definition and a non-static
** declaration to be an error.
*/
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, -1,
MR_PREDICATE, exception, builtin_catch, 3, 0);
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, -1,
MR_PREDICATE, exception, builtin_catch, 3, 1);
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, -1,
MR_PREDICATE, exception, builtin_catch, 3, 2);
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, -1,
MR_PREDICATE, exception, builtin_catch, 3, 3);
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, -1,
MR_PREDICATE, exception, builtin_catch, 3, 4);
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, -1,
MR_PREDICATE, exception, builtin_catch, 3, 5);
#ifdef MR_DEEP_PROFILING
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 0, 1);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 1, 1);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 2, 1);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 3, 1);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 1);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 1);
#endif
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 0, 2);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 1, 2);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 2, 2);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 3, 2);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 2);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 2);
#ifdef MR_DEEP_PROFILING
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 0, 3);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 1, 3);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 2, 3);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 3, 3);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 3);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 3);
#endif
#ifdef MR_DEEP_PROFILING
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 4);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 4);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 5);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 5);
#endif
#if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING)
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 6);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 6);
#endif
#ifdef MR_DEEP_PROFILING
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 7);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 7);
#endif
#ifdef MR_DEEP_PROFILING
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 0, 8);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 1, 8);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 2, 8);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 3, 8);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 4, 8);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_catch, 3, 5, 8);
#endif
MR_proc_static_user_no_site(exception, builtin_throw, 1, 0,
""exception.m"", MR_DUMMY_LINE, MR_TRUE);
/*
** See the above comments regarding builtin_catch for the reason we
** must use MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT instead of
** MR_STATIC_USER_PROC_STATIC_PROC_LAYOUT here.
*/
MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(
MR_DETISM_DET, 1, MR_LONG_LVAL_STACKVAR_INT(1),
MR_PREDICATE, exception, builtin_throw, 1, 0);
MR_MAKE_USER_INTERNAL_LAYOUT(exception, builtin_throw, 1, 0, 1);
MR_BEGIN_MODULE(hand_written_exception_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_layout MR_proc_layout_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_layout
#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_layout MR_proc_layout_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_layout
#undef proc_label
/* mercury__exception__builtin_catch_3_1: the semidet version */
#define proc_label mercury__exception__builtin_catch_3_1
#define proc_layout MR_proc_layout_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_layout
#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_layout MR_proc_layout_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_layout
#undef proc_label
/* mercury__exception__builtin_catch_3_4: the multi version */
#define proc_label mercury__exception__builtin_catch_3_4
#define proc_layout MR_proc_layout_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_layout
#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_layout MR_proc_layout_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_layout
#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;
MR_bool walk_stack;
exception = MR_r1;
exception_event_number = MR_trace_event_number;
/*
** Let the debugger and/or the deep profiler trace exception throwing.
*/
#ifdef MR_DEEP_PROFILING
walk_stack = MR_TRUE;
#else
walk_stack = MR_debug_enabled;
#endif
if (walk_stack) {
MR_Code *MR_jumpaddr;
MR_trace_set_exception_value(exception);
MR_save_transient_registers();
MR_jumpaddr = ML_throw_walk_stack(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_word = MR_succfr_slot_word(MR_curfr);
if (MR_curfr < MR_CONTEXT(MR_ctxt_nondetstack_zone)->MR_zone_min) {
MR_Word save_succip_word;
/*
** 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_word = (MR_Word) orig_curfr;
fflush(stdout);
save_succip_word = MR_succip_word;
MR_save_registers();
ML_report_uncaught_exception(exception);
MR_succip_word = save_succip_word;
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 (walk_stack) {
/*
** The stack has already been unwound by ML_throw_walk_stack(),
** so we can't dump it. (In fact, if we tried to dump the
** now-empty stack, we'd get incorrect results, since
** ML_throw_walk_stack() 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_word = MR_succip_slot_word(MR_curfr);
/*
** Reset the det stack.
*/
MR_sp_word = (MR_Word) 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->MR_zone_top);
MR_save_transient_registers();
exception = MR_deep_copy(exception,
(MR_TypeInfo) &mercury_data_univ__type_ctor_info_univ_0,
MR_EXCEPTION_STRUCT->MR_excp_heap_ptr,
MR_EXCEPTION_STRUCT->MR_excp_heap_zone->MR_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_word = (MR_Word) 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)->MR_zone_top);
MR_save_transient_registers();
exception = MR_deep_copy(exception,
(MR_TypeInfo) &mercury_data_univ__type_ctor_info_univ_0,
saved_solns_heap_ptr,
MR_ENGINE(MR_eng_solutions_heap_zone)->MR_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_word = MR_prevfr_slot_word(MR_curfr);
MR_curfr_word = MR_succfr_slot_word(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_succip_word;
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_word = 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
hand_written_exception_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 *deep_fp,
FILE *procrep_fp)
{
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_catch, 3, 0));
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_catch, 3, 1));
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_catch, 3, 2));
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_catch, 3, 3));
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_catch, 3, 4));
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_catch, 3, 5));
MR_write_out_user_proc_static(deep_fp, procrep_fp,
&MR_proc_layout_user_name(exception, builtin_throw, 1, 0));
}
#endif
").
%-----------------------------------------------------------------------------%
:- pragma foreign_export("C", report_uncaught_exception(in, di, uo),
"ML_report_uncaught_exception").
:- pragma foreign_export("IL", report_uncaught_exception(in, di, uo),
"ML_report_uncaught_exception").
:- pragma foreign_export("Erlang", report_uncaught_exception(in, di, uo),
"ML_report_uncaught_exception").
:- pred report_uncaught_exception(univ::in, io::di, io::uo) is cc_multi.
report_uncaught_exception(Exception, !IO) :-
try_io(report_uncaught_exception_2(Exception), Result, !IO),
(
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::in, unit::out,
io::di, io::uo) is det.
report_uncaught_exception_2(Exception, unit, !IO) :-
io.flush_output(!IO),
io.stderr_stream(StdErr, !IO),
io.write_string(StdErr, "Uncaught Mercury exception:\n", !IO),
( univ_to_type(Exception, software_error(Message)) ->
io.format(StdErr, "Software Error: %s\n", [s(Message)], !IO)
;
io.write(StdErr, univ_value(Exception), !IO),
io.nl(StdErr, !IO)
),
io.flush_output(StdErr, !IO).
%-----------------------------------------------------------------------------%
:- pragma no_inline(throw_if_near_stack_limits/0).
throw_if_near_stack_limits :-
( impure now_near_stack_limits ->
throw(near_stack_limits)
;
true
).
:- impure pred now_near_stack_limits is semidet.
:- pragma no_inline(now_near_stack_limits/0).
:- pragma foreign_proc("C",
now_near_stack_limits,
[will_not_call_mercury],
"
#ifdef MR_HIGHLEVEL_CODE
/*
** In high level code grades, I don't know of any portable way
** to check whether we are near the limits of the C stack.
*/
SUCCESS_INDICATOR = MR_FALSE;
#else
int slack = 1024;
if (((MR_maxfr + slack) <
MR_CONTEXT(MR_ctxt_nondetstack_zone)->MR_zone_top)
&& ((MR_sp + slack) <
MR_CONTEXT(MR_ctxt_detstack_zone)->MR_zone_top))
{
SUCCESS_INDICATOR = MR_FALSE;
} else {
SUCCESS_INDICATOR = MR_TRUE;
}
#endif
").
now_near_stack_limits :-
semidet_fail.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink