From dbe8a2da18837a64eb5921be67feedf51949fca5 Mon Sep 17 00:00:00 2001 From: Jan Wielemaker Date: Wed, 2 Oct 2024 20:28:56 +0200 Subject: [PATCH] CLEANUP: Removed `'$aborted'` --- boot/init.pl | 10 +++++----- boot/messages.pl | 2 -- boot/toplevel.pl | 2 +- library/debug.pl | 2 -- library/wasm.pl | 4 ++-- man/builtin.doc | 18 +++++++++--------- man/foreign.doc | 10 +--------- src/ATOMS | 1 - src/pl-alloc.c | 2 +- src/pl-fli.c | 6 ++---- src/pl-incl.h | 2 +- src/pl-pro.c | 7 ++++--- src/pl-trace.c | 5 +---- src/pl-vmi.c | 2 +- src/pl-wam.c | 3 +-- 15 files changed, 29 insertions(+), 47 deletions(-) diff --git a/boot/init.pl b/boot/init.pl index 51b4b4eb7a..cb05139bdd 100644 --- a/boot/init.pl +++ b/boot/init.pl @@ -649,11 +649,11 @@ %! '$recover_and_rethrow'(:Goal, +Term) % -% This goal is used to wrap the catch/3 recover handler if the -% exception is not supposed to be `catchable'. An example of an -% uncachable exception is '$aborted', used by abort/0. Note that -% we cut to ensure that the exception is not delayed forever -% because the recover handler leaves a choicepoint. +% This goal is used to wrap the catch/3 recover handler if the +% exception is not supposed to be `catchable'. This applies to +% exceptions of the shape unwind(Term). Note that we cut to ensure +% that the exception is not delayed forever because the recover +% handler leaves a choicepoint. :- public '$recover_and_rethrow'/2. diff --git a/boot/messages.pl b/boot/messages.pl index 3ef257cea4..fabda20e0f 100644 --- a/boot/messages.pl +++ b/boot/messages.pl @@ -144,8 +144,6 @@ swi_extra(SWI). translate_message2(unwind(Term)) --> unwind_message(Term). -translate_message2('$aborted') --> - [ 'Execution Aborted' ]. translate_message2(message_lines(Lines), L, T) :- % deal with old C-warning() make_message_lines(Lines, L, T). translate_message2(format(Fmt, Args)) --> diff --git a/boot/toplevel.pl b/boot/toplevel.pl index c07af7442e..f2d0804d99 100644 --- a/boot/toplevel.pl +++ b/boot/toplevel.pl @@ -556,7 +556,7 @@ '$initialise' :- catch(initialise_prolog, E, initialise_error(E)). -initialise_error('$aborted') :- !. +initialise_error(unwind(abort)) :- !. initialise_error(E) :- print_message(error, initialization_exception(E)), fail. diff --git a/library/debug.pl b/library/debug.pl index 730472ec1a..9eba79b433 100644 --- a/library/debug.pl +++ b/library/debug.pl @@ -397,8 +397,6 @@ assertion_failed. assertion_rethrow(time_limit_exceeded). -assertion_rethrow('$aborted'). - /******************************* * EXPANSION * diff --git a/library/wasm.pl b/library/wasm.pl index 889b18c3b9..c84822435e 100644 --- a/library/wasm.pl +++ b/library/wasm.pl @@ -74,10 +74,10 @@ %! wasm_abort % -% Execution aborted by userthe +% Execution aborted by user. wasm_abort :- - print_message(error, '$aborted'), + print_message(error, unwind(abort)), abort. with_heartbeat(Goal) :- diff --git a/man/builtin.doc b/man/builtin.doc index cdee19952e..072d7529f4 100644 --- a/man/builtin.doc +++ b/man/builtin.doc @@ -3004,9 +3004,7 @@ Raising an exception fails due to lack of resources, e.g., lack of stack space to store the exception. In this case a resource exception is raised. If that too fails the system tries to raise a resource exception without (stack) context. If that fails it will raise the exception -\verb='$aborted'=, also raised by abort/0. As no stack space is -required for processing this atomic exception, this should always -succeed. +\term{unwind}{abort}, also raised by abort/0. \item Certain \jargon{callback} operations raise an exception while processing another exception or a previous callback already raised an exception @@ -3022,7 +3020,9 @@ If the most urgent exceptions needs to be preserved, the following exception ordering is respected, preserving the topmost matching error. \begin{enumerate} - \item \verb='$aborted'= (abort/0) + \item \verb=unwind(halt(_))= (halt/1) + \item \verb=unwind(thread_exit(_))= (thread_exit/1) + \item \verb=unwind(abort)= (abort/0) \item \verb$time_limit_exceeded$ (call_with_time_limit/2) \item \term{error}{\term{resource_error}{Resource}, Context} \item \term{error}{Formal, Context} @@ -11277,11 +11277,11 @@ Abort the Prolog execution and restart the top level. If the restarted instead of entering the default interactive top level. Aborting is implemented by throwing the reserved exception -\verb='$aborted'=. This exception can be caught using catch/3, but the -recovery goal is wrapped with a predicate that prunes the choice points -of the recovery goal (i.e., as once/1) and re-throws the exception. -This is illustrated in the example below, where we press control-C -and `a'. See also \secref{urgentexceptions}. +\term{unwind}{abort}. This exception can be caught using catch/3, but +the recovery goal is wrapped with a predicate that prunes the choice +points of the recovery goal (i.e., as once/1) and re-throws the +exception. This is illustrated in the example below, where we press +control-C and `a'. See also \secref{urgentexceptions}. \begin{code} ?- catch((repeat,fail), E, true). diff --git a/man/foreign.doc b/man/foreign.doc index ef671ec93a..32a41ae36c 100644 --- a/man/foreign.doc +++ b/man/foreign.doc @@ -3682,15 +3682,7 @@ print_message/2 through the C interface. Generate an exception (as throw/1) and return \const{FALSE}. If there is already a pending exception, the most urgent exception is kept; and if both are of the same urgency, the new exception is kept. Urgency -of exceptions is defined as - -\begin{enumerate} - \item abort (\verb|'$aborted'|). - \item \const{time_limit_exceeded} (see call_with_time_limit/2). - \item \const{resource_error} exceptions. - \item Other \term{error}{Formal, ImplDef} exceptions. - \item Other exceptions. -\end{enumerate} +of exceptions is described in secref{urgentexceptions}. This function is rarely used directly. Instead, errors are typically diff --git a/src/ATOMS b/src/ATOMS index 0b2f1e8325..a6d667020c 100644 --- a/src/ATOMS +++ b/src/ATOMS @@ -15,7 +15,6 @@ A ISO_8859_1 "ISO-8859-1" A dollar "$" A abi "abi" A abort "abort" -A aborted "$aborted" A abs "abs" A abstract "abstract" A access "access" diff --git a/src/pl-alloc.c b/src/pl-alloc.c index a48ca558a8..27ec91caff 100644 --- a/src/pl-alloc.c +++ b/src/pl-alloc.c @@ -711,7 +711,7 @@ outOfStack(void *stack, stack_overflow_action how) } else { Sdprintf("ERROR: Out of global-stack.\n" "ERROR: No room for exception term. Aborting.\n"); - *valTermRef(LD->exception.bin) = ATOM_aborted; + *valTermRef(LD->exception.bin) = ATOM_abort; } exception_term = exception_bin; diff --git a/src/pl-fli.c b/src/pl-fli.c index c6d04b8b87..f50eeafb3a 100644 --- a/src/pl-fli.c +++ b/src/pl-fli.c @@ -4625,7 +4625,7 @@ copy_exception(DECL_LD term_t ex, term_t bin) } Sdprintf("WARNING: mapped exception to abort due to stack overflow\n"); - PL_put_atom(bin, ATOM_aborted); + PL_put_atom(bin, ATOM_abort); return true; } @@ -4636,9 +4636,7 @@ classify_exception_p(DECL_LD Word p) if ( isVar(*p) ) { return EXCEPT_NONE; } else if ( isAtom(*p) ) - { if ( *p == ATOM_aborted ) - return EXCEPT_ABORT; - if ( *p == ATOM_time_limit_exceeded ) + { if ( *p == ATOM_time_limit_exceeded ) return EXCEPT_TIMEOUT; } else if ( hasFunctor(*p, FUNCTOR_error2) ) { p = argTermP(*p, 0); diff --git a/src/pl-incl.h b/src/pl-incl.h index f397cd75e7..fca415708e 100644 --- a/src/pl-incl.h +++ b/src/pl-incl.h @@ -1935,7 +1935,7 @@ typedef enum except_class EXCEPT_RESOURCE, /* ISO error(resource_error(_), _) */ EXCEPT_TIMEOUT, /* time_limit_exceeded */ EXCEPT_UNWIND, /* unwind(Term) */ - EXCEPT_ABORT, /* '$aborted' or unwind(abort) */ + EXCEPT_ABORT, /* unwind(abort) */ EXCEPT_THREAD_EXIT, /* unwind(thread_exit(Term)) */ EXCEPT_HALT /* unwind(halt(Code) */ } except_class; diff --git a/src/pl-pro.c b/src/pl-pro.c index 4063d8f7f8..399975832e 100644 --- a/src/pl-pro.c +++ b/src/pl-pro.c @@ -103,7 +103,8 @@ restore_after_exception(term_t except) debugmode(DBG_OFF, NULL); if ( classify_exception(except) == EXCEPT_ABORT ) { rc = ( callEventHook(PLEV_ABORT) && - printMessage(ATOM_informational, PL_ATOM, ATOM_aborted) ); + printMessage(ATOM_informational, PL_FUNCTOR, FUNCTOR_unwind1, + PL_ATOM, ATOM_abort) ); } return rc; @@ -570,11 +571,11 @@ abortProlog(void) LD->exception.processing = true; /* allow using spare stack */ if ( (fid = PL_open_foreign_frame()) && - (ex = PL_new_term_ref()) ) + (ex = PL_new_term_ref()) && + PL_unify_term(ex, PL_FUNCTOR, FUNCTOR_unwind1, PL_ATOM, ATOM_abort) ) { clearSegStack(&LD->cycle.lstack); /* can do no harm */ clearSegStack(&LD->cycle.vstack); - PL_put_atom(ex, ATOM_aborted); rc = PL_raise_exception(ex); PL_close_foreign_frame(fid); } diff --git a/src/pl-trace.c b/src/pl-trace.c index 6934373d25..3da46b5c5a 100644 --- a/src/pl-trace.c +++ b/src/pl-trace.c @@ -404,10 +404,7 @@ tracePort(DECL_LD LocalFrame frame, Choice bfr, int port, Code PC) return ACTION_CONTINUE; if ( port == EXCEPTION_PORT ) /* do not trace abort */ - { Word p = valTermRef(LD->exception.pending); - - deRef(p); - if ( *p == ATOM_aborted ) + { if ( classify_exception(LD->exception.pending) >= EXCEPT_ABORT ) return ACTION_CONTINUE; } diff --git a/src/pl-vmi.c b/src/pl-vmi.c index b1a008c4bb..b506b5ad1a 100644 --- a/src/pl-vmi.c +++ b/src/pl-vmi.c @@ -5080,7 +5080,7 @@ VMH(b_throw, 0, (), ()) }); if ( debugstatus.suspendTrace == false && !rewritten++ && - !uncachableException(exception_term) && /* e.g., $aborted */ + !uncachableException(exception_term) && /* unwind(_) */ !resourceException(exception_term) ) { int rc; diff --git a/src/pl-wam.c b/src/pl-wam.c index 96b273d7c0..e555ea149a 100644 --- a/src/pl-wam.c +++ b/src/pl-wam.c @@ -2081,8 +2081,7 @@ uncachableException(DECL_LD term_t t) { Word p = valTermRef(t); deRef(p); - if ( hasFunctor(*p, FUNCTOR_unwind1) || - *p == ATOM_aborted ) /* compat */ + if ( hasFunctor(*p, FUNCTOR_unwind1) ) return *p; return 0;