ADDED: catch/3: support constraints on the Ball.

man/builtin.doc

@@ -2882,6 +2882,13 @@ with the argument of throw/1, all choice points generated by \arg{Goal}
 are cut, the system backtracks to the start of catch/3 while preserving
 the thrown exception term, and \arg{Recover} is called as in call/1.
 
+As of version 9.3.13, constraints (attributed variables) in
+\arg{Catcher} are respected.  If evaluating the constraint raises an
+exception, the most urgent exception is preserved (see
+\secref{urgentexceptions}) and searching for a matching catch/3 call
+is continued.  If both exceptions are equally urgent, the exception
+raised by the constraint evaluation is preserved.
+
 The overhead of calling a goal through catch/3 is comparable to
 call/1.  Recovery from an exception is much slower, especially if the
 exception term is large due to the copying thereof or is decorated with

src/Tests/core/test_call.pl

@@ -375,6 +375,16 @@
 	fail.
 test(partial_unification, X == 1) :-
 	t1(X).
+test(attvar, R==true) :-
+	freeze(E, fail),
+	catch(catch(throw(a), E, R=false),
+	      a, R=true).
+test(nested, E2==b) :-
+	freeze(E, throw(b)),
+	catch(catch(throw(a), E, true), E2, true).
+test(urgent, error(instantiation_error)) :-
+	freeze(E, throw(b)),
+	catch(atom_concat(_,_,_), E, true).
 
 t1(X) :- catch(t2(X), f(1,2), X = 1).
 t2(X) :- catch(t3, f(2,1), X = 2).

src/pl-wam.c

@@ -1979,36 +1979,64 @@ reference, so we can deal with relocation of the local stack.
 
 #define findCatcher(fid, fr, ch, ex) LDFUNC(findCatcher, fid, fr, ch, ex)
 static term_t
-findCatcher(DECL_LD fid_t fid, LocalFrame fr, Choice ch, term_t ex)
+findCatcher(DECL_LD fid_t fid, LocalFrame fr, Choice ch, term_t ex0)
 { Definition catch3  = PROCEDURE_catch3->definition;
+  term_t ex = PL_copy_term_ref(ex0);
+  term_t ex2 = 0;
+  wakeup_state wstate;
 
-  for(; fr; fr = fr->parent)
-  { int rc;
-    term_t tref, catcher;
-
-    if ( fr->predicate != catch3 )
-      continue;
-    if ( ison(fr, FR_CATCHED) )
-      continue;				/* thrown from recover */
-    if ( (void*)fr > (void*)ch )
-      continue;				/* call-port of catch/3 */
-
-    tref = consTermRef(fr);
-    catcher = consTermRef(argFrameP(fr, 1));
-    DEBUG(MSG_THROW, Sdprintf("Unify ball for frame %ld\n", (long)tref));
-    rc = PL_unify(catcher, ex);
-    fr = (LocalFrame)valTermRef(tref);
-
-    if ( rc )
-    { DEBUG(MSG_THROW, Sdprintf("Unified for frame %ld\n", (long)tref));
-      set(fr, FR_CATCHED);
-      return consTermRef(fr);
+  if ( !saveWakeup(&wstate, false) )
+  { LD->outofstack = (Stack)&LD->stacks.local;
+    outOfStack(LD->outofstack, STACK_OVERFLOW_THROW);
+    assert(0);
+  }
+
+  while(fr)
+  { if ( fr->predicate == catch3 &&
+	 isoff(fr, FR_CATCHED) &&      /* not thrown from recover */
+	 (void*)fr <= (void*)ch )      /* not call-port of catch/3 */
+    { int rc;
+      term_t tref, catcher;
+
+      tref = consTermRef(fr);
+      catcher = consTermRef(argFrameP(fr, 1));
+      DEBUG(MSG_THROW, Sdprintf("Unify ball for frame %ld\n", (long)tref));
+      rc = PL_unify(catcher, ex);
+      if ( rc )
+      { if ( !ex2 )
+	  ex2 = PL_new_term_ref();
+	rc = foreignWakeup(ex2);
+      }
+      fr = (LocalFrame)valTermRef(tref);
+
+      if ( rc )
+      { DEBUG(MSG_THROW, Sdprintf("Unified for frame %ld\n", (long)tref));
+	restoreWakeup(&wstate);
+	PL_put_term(exception_term, ex);
+	set(fr, FR_CATCHED);
+	return consTermRef(fr);
+      } else
+      { if ( ex2 && !isVar(*valTermRef(ex2)) )
+	{ DEBUG(MSG_THROW, Sdprintf("Exception from foreignWakeup()\n"));
+	  PL_raise_exception(ex2);
+	  PL_put_term(ex, exception_term);
+	  PL_put_variable(ex2);
+	  fr = (LocalFrame)valTermRef(tref);
+	} else if ( exception_term )
+	{ DEBUG(MSG_THROW, Sdprintf("Exception from PL_unify()\n"));
+	  PL_put_term(ex, exception_term);
+	}
+      }
+
+      PL_rewind_foreign_frame(wstate.fid ? wstate.fid : fid);
     }
 
-    if ( fid )
-      PL_rewind_foreign_frame(fid);
+    fr = fr->parent;
   }
 
+  restoreWakeup(&wstate);
+  PL_put_term(exception_term, ex);
+
   return 0;
 }