change throw mechanism to fit better with cleanup mechanism:

- balls are now stored off line and recovered by Prolog code when everything
is safe.
- if a ball exists, throw uses the *existing* one (be careful not to have one
laying around).
- Jump routine cleans up every cp except ones for setup_call handling, backtracking simply calls setup handlers.

C/c_interface.c

@@ -1940,6 +1940,7 @@ YAP_GoalHasException(Term *t)
 X_API void
 YAP_ClearExceptions(void)
 {
+  Yap_DeleteGlobal(AtomCatch);
   EX = 0L;
   UncaughtThrow = FALSE;
 }

C/exec.c

@@ -1428,227 +1428,116 @@ p_cut_up_to_next_disjunction(void) {
   return TRUE;
 }
 
-static int
+static int is_cleanup_cp(choiceptr cp_b)
-suspended_on_current_execution(Term t, Term t0)
 {
-  attvar_record *susp = (attvar_record *)VarOfTerm(t);
+  PredEntry *pe;
-  Term t1 = susp->Atts;
+
-  /* should be prolog(_,Something) */
+  if (cp_b->cp_ap->opc != ORLAST_OPCODE)
-  if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorPrologConstraint)
     return FALSE;
-  t1 = ArgOfTerm(2, t1);
+#ifdef YAPOR
-  /* Something = [Goal] */
+  pe = cp_b->cp_ap->u.Osblp.p;
-  if (IsVarTerm(t1) || !IsPairTerm(t1))
-    return FALSE;
-  if (TailOfTerm(t1) != TermNil)
-    return FALSE;
-  t1 = HeadOfTerm(t1);
-  /* Goal = $redo_freeze(_,_,Suspended) */
-  if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorRedoFreeze)
-    return FALSE;
-  t1 = ArgOfTerm(3,t1);
-  /* Suspended = Mod:Cod */
-  if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorModule)
-    return FALSE;
-  t1 = ArgOfTerm(2,t1);
-  /* Cod = $clean_call(t0,_) */
-  if(IsVarTerm(t1) || !IsApplTerm(t1) || FunctorOfTerm(t1) != FunctorCleanCall)
-    return FALSE;
-  /* we found what was on the cp */
-  return t0 == ArgOfTerm(1, t1);
-}
-
-static Term
-build_error(void)
-{
-  Term ti[1], nt[2];
-  ti[0] = MkAtomTerm(AtomStack);
-  nt[0] = Yap_MkApplTerm(FunctorResourceError, 1, ti);
-  nt[1] = MkAtomTerm(AtomInStackExpansion);
-  return Yap_MkApplTerm(FunctorError, 2, nt);
-}
-
-
-static Term
-get_term(DBTerm *dbt, Term t)
-{
-  if (dbt) {
-    while (!(t = Yap_PopTermFromDB(dbt))) {
-      if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
-	Yap_Error_TYPE = YAP_NO_ERROR;
-	if (!Yap_growglobal(NULL)) {
-	  t = build_error();
-	  break;
-	}
-      } else {
-	Yap_Error_TYPE = YAP_NO_ERROR;
-	if (!Yap_growstack(dbt->NOfCells*CellSize)) {
-	  t = build_error();
-	  break;
-	}
-      }
-    }
-    if (t) {
-      B->cp_h = H;
-    }
-  }
-  return t;
-}
-
-
-static Term
-clean_trail(Term t, DBTerm *dbt, Term t0)
-{
-  tr_fr_ptr pt1, pbase;
-
-#ifdef SHADOW_HB
-  register CELL *HBREG = HB;
-#endif /* SHADOW_HB */
-
-  pbase = B->cp_tr;
-  pt1 = TR - 1;
-  while (pt1 >= pbase) {
-    Term d1 = TrailTerm(pt1);
-    if (IsVarTerm(d1)) {
-#if defined(SBA) && defined(YAPOR)
-      /* clean up the trail when we backtrack */
-      if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
-	  Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
-	RESET_VARIABLE(STACK_TO_SBA(d1));
-      } else
-#endif
-	/* normal variable */
-	RESET_VARIABLE(d1);
-      RESET_VARIABLE(&TrailTerm(pt1));
-      pt1--;
-    } else if (IsPairTerm(d1)) {
-      CELL *pt = RepPair(d1);
-      if ((ADDR) pt >= Yap_TrailBase && (ADDR)pt < Yap_TrailTop) {
-	/* skip, this is a problem because we lose information,
-	   namely active references */
-	pt1 = (tr_fr_ptr)pt;
-      } else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
-	CELL val = Deref(*pt);
-	if (IsVarTerm(val)) {
-	  if (suspended_on_current_execution(val, t0)) {
-	    RESET_VARIABLE(&TrailTerm(pt1));
-	  } else {
-	    TR = pt1+1;
-	    t = get_term(dbt, t);
-	    Bind(pt, t);
-	    Yap_WakeUp(pt);
-	    return t;
-	  }
-	}
-      }
-      pt1--;
-    } else if (IsApplTerm(d1)) {
-      CELL *pt = RepAppl(d1);
-      /* AbsAppl means */
-      /* multi-assignment variable */
-      /* so the next cell is the old value */ 
-#ifdef FROZEN_STACKS
-      RESET_VARIABLE(&TrailTerm(pt1));
-      --pt1;
-      pt[0] = TrailVal(pt1);
-      RESET_VARIABLE(&TrailTerm(pt1));
-      --pt1;
 #else
-      pt[0] = TrailTerm(pt1-1);
+  pe = cp_b->cp_ap->u.p.p;
-      RESET_VARIABLE(&TrailTerm(pt1));
+#endif	/* YAPOR */
-      RESET_VARIABLE(&TrailTerm(pt1-1));
+  return (pe == PredSafeCallCleanup);
-      RESET_VARIABLE(&TrailTerm(pt1-2));
-      pt1 -= 3;
-#endif /* FROZEN_STACKS */
-    }
-  }
-  TR = pt1+1;
-  t = get_term(dbt, t);
-  return t;
 }
 
-
 static Int
 JumpToEnv(Term t) {
   yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,l),
     *catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,l);
-  CELL *env;
+  CELL *env, *env1;
-  choiceptr first_func = NULL, B0 = B;
+  choiceptr handler, previous = NULL;
-  DBTerm *dbt;
 
-  if (!(dbt = Yap_StoreTermInDB(t, -1))) {
+  /* throws cannot interrupt throws */
-    if (!(t = Yap_SaveTerm(t)))
+  if (EX)
-      return FALSE;
+    return FALSE;
+  /* just keep the throwed object away, we don't need to care about it */
+  if (!(t = Yap_SetGlobalVal(AtomCatch, t))) {
+    /* fat chance */
+    siglongjmp(Yap_RestartEnv,1);
   }
+  /* careful, previous step may have caused a stack shift, 
+     so get pointers here */
+  handler = B;
+  env1 = ENV;
   do {
     /* find the first choicepoint that may be a catch */
-    while (B != NULL && B->cp_ap != pos) {
+    while (handler != NULL && handler->cp_ap != pos) {
       /* we are already doing a catch */
-      if (B->cp_ap == catchpos) {
+      if (handler->cp_ap == catchpos) {
 	P = (yamop *)FAILCODE;
-	if (first_func != NULL) {
+	return TRUE;
-	  B = first_func;
-	}
-	return(FALSE);
       }
-      if (B->cp_ap == NOCODE) {
+      /* we have a cleanup handler in the middle */
+      if (is_cleanup_cp(handler)) {
+	/* keep it around */
+	if (previous == NULL)
+	  B = handler;
+	else 
+	  previous->cp_b = handler;
+	previous = handler;
+#ifdef TABLING
+      } else {
+	abolish_incomplete_subgoals(handler);
+#endif /* TABLING */
+      }
+      /* we reached C-Code */
+      if (handler->cp_ap == NOCODE) {
 	/* up to the C-code to deal with this! */
 	UncaughtThrow = TRUE;
-	B->cp_h = H;
+	if (previous == NULL)
+	  B = handler;
+	else 
+	  previous->cp_b = handler;
 	EX = t;
-	return FALSE;
+	P = (yamop *)FAILCODE;
+	HB = B->cp_h;
+	return TRUE;
       }
-      B = B->cp_b;
+      handler = handler->cp_b;
     }
     /* uncaught throw */
-    if (B == NULL) {
+    if (handler == NULL) {
       UncaughtThrow = TRUE;
-      B = B0;
 #if PUSH_REGS
       restore_absmi_regs(&Yap_standard_regs);
 #endif
       siglongjmp(Yap_RestartEnv,1);
     }
     /* is it a continuation? */
-    env = B->cp_env;
+    env = handler->cp_env;
-    while (env > ENV) {
+    while (env > env1) {
-      ENV = ENV_Parent(ENV);
+      env1 = ENV_Parent(env1);
     }
     /* yes, we found it ! */
     //    while (env < ENV)
     //      env = ENV_Parent(env);
-    if (env == ENV) {
+    if (env == env1) {
       break;
     }
     /* oops, try next */
-    B = B->cp_b;
+    handler = handler->cp_b;
   } while (TRUE);
   /* step one environment above, otherwise we'll redo the original goal */
-  B->cp_cp = (yamop *)env[E_CP];
+  if (previous == NULL) {
-  B->cp_env = (CELL *)env[E_E];
+    B = handler;
-  B->cp_ap = NEXTOP(PredHandleThrow->CodeOfPred,l);
+  } else {
+    //    EX = t;
+    previous->cp_b = handler;
+  }
+  handler->cp_cp = (yamop *)env[E_CP];
+  handler->cp_env = (CELL *)env[E_E];
+  handler->cp_ap = NEXTOP(PredHandleThrow->CodeOfPred,l);
   /* can recover Heap thanks to copy term :-( */
   /* B->cp_h = H; */
   /* I could backtrack here, but it is easier to leave the unwinding
      to the emulator */
   P = (yamop *)FAILCODE;
+  HB = B->cp_h;
   /* try to recover space */
   /* can only do that when we recover space */
-  /* H = B->cp_h; */
+  /* first, simulate backtracking */
-  t = clean_trail(t, dbt, B->cp_a1);
-  B->cp_a3 = t;
-  B->cp_tr = TR;
-  if (first_func != NULL) {
-    B = first_func;
-  }
-#ifdef TABLING
-  if (B != B0) {
-    while (B0->cp_b < B) {
-      B0 = B0->cp_b;
-    }
-    abolish_incomplete_subgoals(B0);
-  }
-#endif /* TABLING */
   /* so that I will execute op_fail */
   return TRUE;
 }
@@ -1694,6 +1583,7 @@ Yap_InitYaamRegs(void)
   Yap_regp = &Yap_standard_regs;
 #endif
 #endif /* PUSH_REGS */
+  Yap_DeleteGlobal (AtomCatch);
   Yap_PutValue (AtomBreak, MkIntTerm (0));
   TR = (tr_fr_ptr)Yap_TrailBase;
   if (Yap_AttsSize > (Yap_LocalBase-Yap_GlobalBase)/8)
@@ -1795,6 +1685,13 @@ p_debug_on(void)
   return TRUE;
 }
 
+static Int
+p_reset_exception(void)
+{
+  EX = 0L;
+  return TRUE;
+}
+
 void 
 Yap_InitExecFs(void)
 {
@@ -1848,6 +1745,7 @@ Yap_InitExecFs(void)
   Yap_InitCPred("$creep_allowed", 0, p_creep_allowed, HiddenPredFlag);
   Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, HiddenPredFlag);
   Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, HiddenPredFlag);
+  Yap_InitCPred("$reset_exception", 0, p_reset_exception, HiddenPredFlag);
 }
 
 

C/globals.c

@@ -1300,22 +1300,15 @@ p_nb_getval(void)
   return Yap_unify(ARG2, to);
 }
 
-static Int
+
-p_nb_delete(void)
+static Int 
+nbdelete(Atom at)
 {
-  Term t = Deref(ARG1);
   GlobalEntry *ge, *g;
   AtomEntry *ae;
   Prop gp, g0;
 
-  if (IsVarTerm(t)) {
+  ge = FindGlobalEntry(at);
-    Yap_Error(INSTANTIATION_ERROR,t,"nb_delete");
-    return FALSE;
-  } else if (!IsAtomTerm(t)) {
-    Yap_Error(TYPE_ERROR_ATOM,t,"nb_delete");
-    return FALSE;
-  }
-  ge = FindGlobalEntry(AtomOfTerm(t));
   if (!ge)
     return FALSE;
   WRITE_LOCK(ge->GRWLock);
@@ -1344,6 +1337,27 @@ p_nb_delete(void)
   return TRUE;
 }
 
+Int
+Yap_DeleteGlobal(Atom at)
+{
+  return nbdelete(at);
+}
+
+static Int
+p_nb_delete(void)
+{
+  Term t = Deref(ARG1);
+
+  if (IsVarTerm(t)) {
+    Yap_Error(INSTANTIATION_ERROR,t,"nb_delete");
+    return FALSE;
+  } else if (!IsAtomTerm(t)) {
+    Yap_Error(TYPE_ERROR_ATOM,t,"nb_delete");
+    return FALSE;
+  }
+  return nbdelete(AtomOfTerm(t));
+}
+
 static Int
 p_nb_create(void)
 {

C/tracer.c

@@ -269,7 +269,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
       printf("\n");
  }
 #endif
-  fprintf(Yap_stderr,"%lld ",vsc_count);
+  fprintf(Yap_stderr,"%lld %p ", vsc_count, TR);
 #if defined(THREADS) || defined(YAPOR)
   fprintf(Yap_stderr,"(%d)", worker_id);
 #endif

H/Yapproto.h

@@ -192,6 +192,7 @@ Term	STD_PROTO(Yap_NewArena,(UInt,CELL *));
 void	STD_PROTO(Yap_InitGlobals,(void));
 Term	STD_PROTO(Yap_SaveTerm, (Term));
 Term	STD_PROTO(Yap_SetGlobalVal, (Atom, Term));
+Int	STD_PROTO(Yap_DeleteGlobal, (Atom));
 void	STD_PROTO(Yap_AllocateDefaultArena, (Int, Int));
 
 /* grow.c */

H/dhstruct.h

@@ -85,6 +85,7 @@
 #define FAIL_OPCODE Yap_heap_regs->fail_op
 #define INDEX_OPCODE Yap_heap_regs->index_op
 #define LOCKPRED_OPCODE Yap_heap_regs->lockpred_op
+#define ORLAST_OPCODE Yap_heap_regs->orlast_op
 #define UNDEF_OPCODE Yap_heap_regs->undef_op
 
 #define NOfAtoms Yap_heap_regs->n_of_atoms
@@ -148,6 +149,7 @@
 #define PredThrow Yap_heap_regs->pred_throw
 #define PredHandleThrow Yap_heap_regs->pred_handle_throw
 #define PredIs Yap_heap_regs->pred_is
+#define PredSafeCallCleanup Yap_heap_regs->pred_safe_call_cleanup
 #ifdef YAPOR
 #define PredGetwork Yap_heap_regs->pred_getwork
 #define PredGetworkSeq Yap_heap_regs->pred_getwork_seq

H/hstruct.h

@@ -85,6 +85,7 @@
   OPCODE  fail_op;
   OPCODE  index_op;
   OPCODE  lockpred_op;
+  OPCODE  orlast_op;
   OPCODE  undef_op;
 
   UInt  n_of_atoms;
@@ -148,6 +149,7 @@
   struct pred_entry  *pred_throw;
   struct pred_entry  *pred_handle_throw;
   struct pred_entry  *pred_is;
+  struct pred_entry  *pred_safe_call_cleanup;
 #ifdef YAPOR
   struct pred_entry  *pred_getwork;
   struct pred_entry  *pred_getwork_seq;

H/iatoms.h

@@ -223,6 +223,7 @@
   AtomRetryCounter = Yap_LookupAtom("retry_counter");
   AtomRTree = Yap_LookupAtom("rtree");
   AtomSafe = Yap_FullLookupAtom("$safe");
+  AtomSafeCallCleanup = Yap_FullLookupAtom("$safe_call_cleanup");
   AtomSame = Yap_LookupAtom("==");
   AtomSemic = Yap_LookupAtom(";");
   AtomShiftCountOverflow = Yap_LookupAtom("shift_count_overflow");
@@ -384,6 +385,7 @@
   FunctorRestoreRegs = Yap_MkFunctor(AtomRestoreRegs,2);
   FunctorRestoreRegs1 = Yap_MkFunctor(AtomRestoreRegs,1);
   FunctorSafe = Yap_MkFunctor(AtomSafe,1);
+  FunctorSafeCallCleanup = Yap_MkFunctor(AtomSafeCallCleanup,4);
   FunctorSame = Yap_MkFunctor(AtomSame,2);
   FunctorSlash = Yap_MkFunctor(AtomSlash,2);
   FunctorStaticClause = Yap_MkFunctor(AtomStaticClause,1);

H/ihstruct.h

@@ -85,6 +85,7 @@
   Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
   Yap_heap_regs->index_op = Yap_opcode(_index_pred);
   Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
+  Yap_heap_regs->orlast_op = Yap_opcode(_or_last);
   Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
 
 
@@ -148,6 +149,7 @@
   Yap_heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,PROLOG_MODULE));
   Yap_heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(FunctorHandleThrow,PROLOG_MODULE));
   Yap_heap_regs->pred_is = RepPredProp(PredPropByFunc(FunctorIs,PROLOG_MODULE));
+  Yap_heap_regs->pred_safe_call_cleanup = RepPredProp(PredPropByFunc(FunctorSafeCallCleanup,PROLOG_MODULE));
 #ifdef YAPOR
   Yap_heap_regs->pred_getwork = RepPredProp(PredPropByAtom(AtomGetwork,PROLOG_MODULE));
   Yap_heap_regs->pred_getwork_seq = RepPredProp(PredPropByAtom(AtomGetworkSeq,PROLOG_MODULE));

H/ratoms.h

@@ -225,6 +225,7 @@
   AtomRetryCounter = AtomAdjust(AtomRetryCounter);
   AtomRTree = AtomAdjust(AtomRTree);
   AtomSafe = AtomAdjust(AtomSafe);
+  AtomSafeCallCleanup = AtomAdjust(AtomSafeCallCleanup);
   AtomSame = AtomAdjust(AtomSame);
   AtomSemic = AtomAdjust(AtomSemic);
   AtomShiftCountOverflow = AtomAdjust(AtomShiftCountOverflow);
@@ -386,6 +387,7 @@
   FunctorRestoreRegs = FuncAdjust(FunctorRestoreRegs);
   FunctorRestoreRegs1 = FuncAdjust(FunctorRestoreRegs1);
   FunctorSafe = FuncAdjust(FunctorSafe);
+  FunctorSafeCallCleanup = FuncAdjust(FunctorSafeCallCleanup);
   FunctorSame = FuncAdjust(FunctorSame);
   FunctorSlash = FuncAdjust(FunctorSlash);
   FunctorStaticClause = FuncAdjust(FunctorStaticClause);

H/rhstruct.h

@@ -85,6 +85,7 @@
   Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
   Yap_heap_regs->index_op = Yap_opcode(_index_pred);
   Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
+  Yap_heap_regs->orlast_op = Yap_opcode(_or_last);
   Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
 
 
@@ -148,6 +149,7 @@
   Yap_heap_regs->pred_throw = PtoPredAdjust(Yap_heap_regs->pred_throw);
   Yap_heap_regs->pred_handle_throw = PtoPredAdjust(Yap_heap_regs->pred_handle_throw);
   Yap_heap_regs->pred_is = PtoPredAdjust(Yap_heap_regs->pred_is);
+  Yap_heap_regs->pred_safe_call_cleanup = PtoPredAdjust(Yap_heap_regs->pred_safe_call_cleanup);
 #ifdef YAPOR
   Yap_heap_regs->pred_getwork = PtoPredAdjust(Yap_heap_regs->pred_getwork);
   Yap_heap_regs->pred_getwork_seq = PtoPredAdjust(Yap_heap_regs->pred_getwork_seq);

H/tatoms.h

@@ -452,6 +452,8 @@
 #define AtomRTree Yap_heap_regs->AtomRTree_
   Atom AtomSafe_;
 #define AtomSafe Yap_heap_regs->AtomSafe_
+  Atom AtomSafeCallCleanup_;
+#define AtomSafeCallCleanup Yap_heap_regs->AtomSafeCallCleanup_
   Atom AtomSame_;
 #define AtomSame Yap_heap_regs->AtomSame_
   Atom AtomSemic_;
@@ -774,6 +776,8 @@
 #define FunctorRestoreRegs1 Yap_heap_regs->FunctorRestoreRegs1_
   Functor FunctorSafe_;
 #define FunctorSafe Yap_heap_regs->FunctorSafe_
+  Functor FunctorSafeCallCleanup_;
+#define FunctorSafeCallCleanup Yap_heap_regs->FunctorSafeCallCleanup_
   Functor FunctorSame_;
 #define FunctorSame Yap_heap_regs->FunctorSame_
   Functor FunctorSlash_;

misc/ATOMS

@@ -234,6 +234,7 @@ A	RestoreRegs		F	"$restore_regs"
 A	RetryCounter		N	"retry_counter"
 A	RTree			N	"rtree"
 A	Safe			F	"$safe"
+A	SafeCallCleanup		F	"$safe_call_cleanup"
 A	Same			N	"=="
 A	Semic			N	";"
 A	ShiftCountOverflow	N	"shift_count_overflow"
@@ -395,6 +396,7 @@ F	ResourceError		ResourceError	1
 F	RestoreRegs		RestoreRegs	2
 F	RestoreRegs1		RestoreRegs	1
 F	Safe			Safe		1
+F	SafeCallCleanup		SafeCallCleanup	4
 F	Same			Same		2
 F	Slash			Slash		2
 F	StaticClause		StaticClause	1

misc/HEAPFIELDS

@@ -90,6 +90,7 @@ OPCODE		expand_op_code		EXPAND_OP_CODE		MkOp _expand_index
 OPCODE		fail_op			FAIL_OPCODE		MkOp _op_fail
 OPCODE		index_op		INDEX_OPCODE		MkOp _index_pred
 OPCODE		lockpred_op		LOCKPRED_OPCODE		MkOp _lock_pred
+OPCODE		orlast_op		ORLAST_OPCODE		MkOp _or_last
 OPCODE		undef_op		UNDEF_OPCODE		MkOp _undef_p
 
 /* atom tables */
@@ -161,6 +162,7 @@ struct pred_entry *pred_static_clause	PredStaticClause	MkPred FunctorDoStaticCla
 struct pred_entry *pred_throw		PredThrow		MkPred FunctorThrow PROLOG_MODULE
 struct pred_entry *pred_handle_throw	PredHandleThrow		MkPred FunctorHandleThrow PROLOG_MODULE
 struct pred_entry *pred_is		PredIs			MkPred FunctorIs PROLOG_MODULE
+struct pred_entry *pred_safe_call_cleanup PredSafeCallCleanup	MkPred FunctorSafeCallCleanup PROLOG_MODULE
 #ifdef YAPOR
 struct pred_entry *pred_getwork		PredGetwork		MkPred AtomGetwork 0 PROLOG_MODULE
 struct pred_entry *pred_getwork_seq	PredGetworkSeq		MkPred AtomGetworkSeq 0 PROLOG_MODULE

packages/chr

@@ -1 +1 @@
-Subproject commit f6a79007615bf46dc79712c41d61289834f28ba3
+Subproject commit c325e4564bb8d4e32c27f2061df85f13d315974e

packages/jpl

@@ -1 +1 @@
-Subproject commit eb6d27251c2548c25e6d37fff2a27a014caaa7aa
+Subproject commit a2d2f03107eecd45462cd61a678035132cf06326

packages/plunit/examples/simple.pl

@@ -1,6 +1,7 @@
-:- module(ex_simple, []).
 :- use_module(library(plunit)).
 
+:- module(ex_simple, []).
+
 :- begin_tests(lists).
 
 test(true) :-

pl/boot.yap

@@ -1163,6 +1163,12 @@ catch(G, C, A) :-
 %
 % throw has to be *exactly* after system catch!
 %
+throw(_Ball) :-
+	% use existing ball
+	nb_getval('$catch',Ball),
+	nb_delete('$catch'),
+	!,
+	'$jump_env_and_store_ball'(Ball).
 throw(Ball) :-
 	% get current jump point
 	'$jump_env_and_store_ball'(Ball).
@@ -1173,7 +1179,10 @@ throw(Ball) :-
 '$catch'(_,_,_) :- fail.
 
 '$handle_throw'(_, _, _).
-'$handle_throw'(C, A, Ball) :-
+'$handle_throw'(C, A, _Ball) :-
+	nb_getval('$catch',Ball),
+	nb_delete('$catch'),
+	'$reset_exception',
         % reset info
 	('catch_ball'(Ball, C) ->
 	    '$execute'(A)

pl/control.yap

@@ -123,9 +123,13 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
 % The first argument is used by JumpEnv to verify if a throw
 % is going to be handled by the cleanup catcher. If it is so,
 % clean_call will not be called from JumpToEnv.
-'$clean_call'(_,Cleanup) :-
+'$clean_call'(_, Cleanup) :-
 	'$execute'(Cleanup), !.
-'$clean_call'(_,_).
+'$clean_call'(_, _).
+
+'$cc_check_throw' :-
+	nb_getval('$catch',Ball),
+	throw(Ball).	
 
 %%% The unknown predicate,
 %	informs about what the user wants to be done when