ENHANCED: halt/1: use the unwind(halt(Status)) if possible.

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

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),
 

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

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);

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:

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);
     }

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

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