From 9d517567f75dc0a8e87d885354b0b2d9e723df46 Mon Sep 17 00:00:00 2001 From: Jan Wielemaker Date: Wed, 2 Oct 2024 21:15:36 +0200 Subject: [PATCH] ENHANCED: halt/1: use the unwind(halt(Status)) if possible. --- src/SWI-Prolog.h | 1 + src/pl-ext.c | 1 - src/pl-prims.c | 19 ++++++++++++++++--- src/pl-prims.h | 1 - src/pl-pro.c | 2 +- src/pl-vmi.c | 13 +++---------- src/pl-wam.c | 35 +++++++++++++++++++++++++++++++++++ src/pl-wam.h | 2 ++ 8 files changed, 58 insertions(+), 16 deletions(-) diff --git a/src/SWI-Prolog.h b/src/SWI-Prolog.h index 75a5a49b51..a115bf1deb 100644 --- a/src/SWI-Prolog.h +++ b/src/SWI-Prolog.h @@ -414,6 +414,7 @@ PL_EXPORT(const atom_t) *_PL_atoms(void); /* base of reserved (meta-)atoms */ #define PL_Q_PASS_EXCEPTION 0x0010 /* pass to parent environment */ #define PL_Q_ALLOW_YIELD 0x0020 /* Support I_YIELD */ #define PL_Q_EXT_STATUS 0x0040 /* Return extended status */ +#define PL_Q_EXCEPT_HALT 0x0080 /* Handles unwind(halt(Status)) */ #ifdef PL_KERNEL #define PL_Q_DETERMINISTIC 0x0100 /* call was deterministic */ #endif diff --git a/src/pl-ext.c b/src/pl-ext.c index 2b9f82706a..adc8c62467 100644 --- a/src/pl-ext.c +++ b/src/pl-ext.c @@ -104,7 +104,6 @@ static const PL_extension foreigns[] = { FRG("win_module_file", 2, pl_win_module_file, 0), #endif - FRG("halt", 1, pl_halt, ISO), FRG("sub_atom", 5, pl_sub_atom, NDET|ISO), FRG("break", 0, pl_break, 0), diff --git a/src/pl-prims.c b/src/pl-prims.c index 31ce9a130f..7cfbd60077 100644 --- a/src/pl-prims.c +++ b/src/pl-prims.c @@ -5226,11 +5226,12 @@ pl_true() /* just to define it */ { succeed; } -foreign_t -pl_halt(term_t code) -{ GET_LD +static +PRED_IMPL("halt", 1, halt, 0) +{ PRED_LD int status; atom_t a; + term_t code = A1; if ( PL_get_atom(code, &a) ) { if ( a == ATOM_abort ) @@ -5245,6 +5246,17 @@ pl_halt(term_t code) { return false; } + if ( handles_unwind(NULL, PL_Q_EXCEPT_HALT) ) + { term_t ex; + + DEBUG(MSG_CLEANUP, Sdprintf("Halt using exception\n")); + if ( (ex=PL_new_term_ref()) && + PL_unify_term(ex, PL_FUNCTOR, FUNCTOR_unwind1, + PL_FUNCTOR, FUNCTOR_halt1, + PL_INT, status) ) + return PL_raise_exception(ex); + } + PL_halt(status); fail; /* exception? */ } @@ -6327,4 +6339,5 @@ BeginPredDefs(prims) PRED_DEF("$seek_list", 4, seek_list, 0) PRED_DEF("throw", 1, throw, PL_FA_ISO) PRED_DEF("$urgent_exception", 3, urgent_exception, 0) + PRED_DEF("halt", 1, halt, 0) EndPredDefs diff --git a/src/pl-prims.h b/src/pl-prims.h index f8ed68d4e0..87132f7e5b 100644 --- a/src/pl-prims.h +++ b/src/pl-prims.h @@ -78,7 +78,6 @@ foreign_t pl_sub_atom(term_t atom, foreign_t pl_repeat(control_t h); foreign_t pl_fail(void); foreign_t pl_true(void); -foreign_t pl_halt(term_t code); int pl_statistics_ld(term_t k, term_t value, PL_local_data_t *ld); int set_pl_option(const char *name, const char *value); diff --git a/src/pl-pro.c b/src/pl-pro.c index 399975832e..ae33efc972 100644 --- a/src/pl-pro.c +++ b/src/pl-pro.c @@ -166,7 +166,7 @@ query_loop(atom_t goal, int loop) p = PL_pred(PL_new_functor(goal, 0), MODULE_system); - if ( (qid = PL_open_query(MODULE_system, PL_Q_NORMAL, p, 0)) ) + if ( (qid=PL_open_query(MODULE_system, PL_Q_NORMAL|PL_Q_EXCEPT_HALT, p, 0)) ) { rc = PL_next_solution(qid); } else { error: diff --git a/src/pl-vmi.c b/src/pl-vmi.c index b506b5ad1a..a2bea5a1f5 100644 --- a/src/pl-vmi.c +++ b/src/pl-vmi.c @@ -5116,9 +5116,7 @@ VMH(b_throw, 0, (), ()) LOAD_REGISTERS(QID); if ( !rc ) /* uncaught exception */ - { except_class exclass; - - SAVE_REGISTERS(QID); + { SAVE_REGISTERS(QID); if ( PL_is_functor(exception_term, FUNCTOR_error2) && truePrologFlag(PLFLAG_DEBUG_ON_ERROR) ) { DEBUG(MSG_THROW, @@ -5137,13 +5135,8 @@ VMH(b_throw, 0, (), ()) } PL_put_term(exception_printed, exception_term); } - } else if ( (exclass=classify_exception(exception_term)) != EXCEPT_ABORT || - (exclass == EXCEPT_THREAD_EXIT && PL_thread_self() <= 1) ) - { int rc = printMessage(ATOM_error, - PL_FUNCTOR_CHARS, "unhandled_exception", 1, - PL_TERM, exception_term); - (void)rc; - PL_put_term(exception_printed, exception_term); + } else if ( print_unhandled_exception(QID, exception_term) ) + { PL_put_term(exception_printed, exception_term); } LOAD_REGISTERS(QID); } diff --git a/src/pl-wam.c b/src/pl-wam.c index e555ea149a..ae89f39011 100644 --- a/src/pl-wam.c +++ b/src/pl-wam.c @@ -2074,6 +2074,41 @@ isCaughtInOuterQuery(DECL_LD qid_t qid, term_t ball) return 0; } +bool +handles_unwind(DECL_LD qid_t qid, unsigned int flags) +{ if ( HAS_LD ) + { if ( !qid ) + qid = LD->query->qid; + if ( qid ) + { for(QueryFrame qf = QueryFromQid(qid); qf; qf=qf->parent) + { if ( ison(qf, flags) ) + return true; + } + } + } + + return false; +} + +#define print_unhandled_exception(qid, ball) \ + LDFUNC(print_unhandled_exception, qid, ball) + +static bool +print_unhandled_exception(DECL_LD qid_t qid, term_t ex) +{ except_class exclass = classify_exception(ex); + + if ( exclass == EXCEPT_ABORT ) + return false; + if ( exclass == EXCEPT_THREAD_EXIT && PL_thread_self() <= 1 ) + return false; + if ( exclass == EXCEPT_HALT && handles_unwind(qid, PL_Q_EXCEPT_HALT) ) + return false; + + return printMessage(ATOM_error, + PL_FUNCTOR_CHARS, "unhandled_exception", 1, + PL_TERM, ex); +} + #define uncachableException(t) LDFUNC(uncachableException, t) static word diff --git a/src/pl-wam.h b/src/pl-wam.h index 08fd2c5531..ffa29d2499 100644 --- a/src/pl-wam.h +++ b/src/pl-wam.h @@ -53,6 +53,7 @@ #define foreignWakeup(ex) LDFUNC(foreignWakeup, ex) #define existingChoice(ch) LDFUNC(existingChoice, ch) #define grow_trail_ptr(p) LDFUNC(grow_trail_ptr, p) +#define handles_unwind(qid, flags) LDFUNC(handles_unwind, qid, flags) #endif /*USE_LD_MACROS*/ #define LDFUNC_DECLARATIONS @@ -77,6 +78,7 @@ Module contextModule(LocalFrame fr); void setContextModule(LocalFrame fr, Module context); int existingChoice(Choice ch); int grow_trail_ptr(Word p); +bool handles_unwind(qid_t qid, unsigned int flags); #ifdef O_DEBUG char * chp_chars(Choice ch); #endif