Moved thread_exit/1 back to C after adding detection that it may work.

SWI-Prolog · Oct 2, 2024 · 5d8b8d9 · 5d8b8d9
1 parent 9d51756
commit 5d8b8d9
Show file tree

Hide file tree

Showing 5 changed files with 32 additions and 13 deletions.
diff --git a/boot/threads.pl b/boot/threads.pl
@@ -33,19 +33,10 @@
 */
 
 :- module('$threads',
-          [ thread_exit/1               % +Term
+          [
           ]).
 
 /** <module> Thread related system predicates
 
 @tbd Move more code here
 */
-
-%!  thread_exit(+Term)
-
-thread_exit(Term) :-
-    thread_self(main),
-    !,
-    '$permission_error'(thread_exit(Term), thread, main).
-thread_exit(Term) :-
-    throw(unwind(thread_exit(Term))).
diff --git a/man/threads.doc b/man/threads.doc
@@ -245,6 +245,9 @@ pthread_exit() function, the implementation is safe from the Prolog
 point of view.  However, it is limited by the semantics of the
 \jargon{unwind exceptions}.  See \secref{unwind-exceptions} for details.
 
+This predicate raises a \const{permission_error} if it is known
+that the thread cannot handle this case.
+
     \predicate{thread_initialization}{1}{:Goal}
 Run \arg{Goal} when thread is started.  This predicate is similar to
 initialization/1, but is intended for initialization operations of

diff --git a/src/SWI-Prolog.h b/src/SWI-Prolog.h
@@ -417,6 +417,7 @@ PL_EXPORT(const atom_t) *_PL_atoms(void); /* base of reserved (meta-)atoms */
 #define PL_Q_EXCEPT_HALT	0x0080	/* Handles unwind(halt(Status)) */
 #ifdef PL_KERNEL
 #define PL_Q_DETERMINISTIC	0x0100	/* call was deterministic */
+#define PL_Q_EXCEPT_THREAD_EXIT	0x0200	/* Handles unwind(thread_exit(Term)) */
 #endif
 
 					/* PL_Q_EXT_STATUS return codes */

diff --git a/src/pl-thread.c b/src/pl-thread.c
@@ -2095,7 +2095,9 @@ start_thread(void *closure)
       { rval = raiseStackOverflow(GLOBAL_OVERFLOW);
 	ex = exception_term;
       } else
-      { rval  = callProlog(info->module, goal, PL_Q_CATCH_EXCEPTION, &ex);
+      { rval  = callProlog(info->module, goal,
+			   PL_Q_CATCH_EXCEPTION|PL_Q_EXCEPT_THREAD_EXIT,
+			   &ex);
       }
     }
 
@@ -2845,6 +2847,27 @@ PRED_IMPL("thread_detach", 1, thread_detach, 0)
   succeed;
 }
 
+static
+PRED_IMPL("thread_exit", 1, thread_exit, 0)
+{ PRED_LD
+
+  if ( handles_unwind(NULL, PL_Q_EXCEPT_THREAD_EXIT) )
+  { term_t ex;
+
+    return ( (ex=PL_new_term_ref()) &&
+	     PL_unify_term(ex, PL_FUNCTOR, FUNCTOR_unwind1,
+			         PL_FUNCTOR, FUNCTOR_thread_exit1,
+			           PL_TERM, A1) &&
+	     PL_raise_exception(ex) );
+  } else
+  { term_t tid;
+
+    return ( (tid=PL_new_term_ref()) &&
+	     unify_thread_id(tid, LD->thread.info) &&
+	     PL_permission_error("exit", "thread", tid) );
+  }
+}
+
 #endif /*O_PLMT*/
 
 
@@ -8408,6 +8431,7 @@ BeginPredDefs(thread)
   PRED_DEF("thread_alias",           1, thread_alias,	       0)
   PRED_DEF("thread_detach",	     1,	thread_detach,	       PL_FA_ISO)
   PRED_DEF("thread_join",	     2,	thread_join,	       0)
+  PRED_DEF("thread_exit",            1, thread_exit,           0)
   PRED_DEF("thread_statistics",	     3,	thread_statistics,     0)
   PRED_DEF("is_thread",		     1,	is_thread,	       0)
   PRED_DEF("$thread_sigwait",	     1, thread_sigwait,	       0)

diff --git a/src/pl-wam.c b/src/pl-wam.c
@@ -2099,7 +2099,7 @@ print_unhandled_exception(DECL_LD qid_t qid, term_t ex)
 
   if ( exclass == EXCEPT_ABORT )
     return false;
-  if ( exclass == EXCEPT_THREAD_EXIT && PL_thread_self() <= 1 )
+  if ( exclass == EXCEPT_THREAD_EXIT && handles_unwind(qid, PL_Q_EXCEPT_THREAD_EXIT) )
     return false;
   if ( exclass == EXCEPT_HALT && handles_unwind(qid, PL_Q_EXCEPT_HALT) )
     return false;
@@ -2738,7 +2738,7 @@ PL_open_query(Module ctx, int flags, Procedure proc, term_t args)
     flags = PL_Q_NORMAL;
   else if ( flags == false )
     flags = PL_Q_NODEBUG;
-  flags &= 0xff;			/* mask reserved flags */
+  flags &= ~PL_Q_DETERMINISTIC;		/* mask reserved flags */
 
   qf->magic		= QID_MAGIC;
   qf->foreign_frame	= 0;