snapshot

C/c_interface.c

@@ -1954,7 +1954,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
   }
   // should we catch the exception or pass it through?
   // We'll pass it through
-  Yap_RaiseException();
+  // Yap_RaiseException();
   if (out) {
     choiceptr cut_pt, ob;
 

C/errors.c

@@ -201,10 +201,11 @@ bool Yap_Warning(const char *s, ...) {
   Term ts[2];
   const char *fmt;
   char tmpbuf[MAXPATHLEN];
+  yap_error_number err;
 
   LOCAL_DoingUndefp = true;
-  if (LOCAL_PrologMode & InErrorMode) {
+  if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) {
-    fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_Error_TYPE, tmpbuf);
+    fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", s, Yap_errorClassName( Yap_errorClass(err)), Yap_errorName(err));
     Yap_RestartYap(1);
   }
   LOCAL_PrologMode |= InErrorMode;
@@ -504,6 +505,7 @@ void Yap_pushErrorContext(yap_error_descriptor_t *new_error) {
   memset(new_error, 0, sizeof(yap_error_descriptor_t));
   new_error->top_error = LOCAL_ActiveError;
   LOCAL_ActiveError = new_error;
+  LOCAL_PrologMode = UserMode;
 }
 
 /* static void */
@@ -524,6 +526,10 @@ yap_error_descriptor_t *Yap_popErrorContext(bool pass) {
            sizeof(yap_error_descriptor_t));
   yap_error_descriptor_t *new_error = LOCAL_ActiveError;
   LOCAL_ActiveError = LOCAL_ActiveError->top_error;
+  if (LOCAL_ActiveError == YAP_NO_ERROR)
+    LOCAL_PrologMode = UserMode;
+  else
+    LOCAL_PrologMode = InErrorMode;
   return new_error;
 }
 
@@ -590,10 +596,11 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function, int linen
     va_list ap;
     char *fmt;
     char s[MAXPATHLEN];
+        yap_error_number err;
 
     /* disallow recursive error handling */
-    if (LOCAL_PrologMode & InErrorMode) {
+    if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) {
-        fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_Error_TYPE, tmpbuf);
+	fprintf(stderr, "%% ERROR %s %s WITHIN ERROR %s %s\n", Yap_errorClassName( Yap_errorClass(type)), Yap_errorName(type), Yap_errorClassName( Yap_errorClass(err)), Yap_errorName(err));
         Yap_RestartYap(1);
     }
     if (LOCAL_DoingUndefp && type == EVALUATION_ERROR_UNDEFINED) {

C/exec.c

@@ -1385,7 +1385,7 @@ static Int execute_depth_limit(USES_REGS1) {
 #endif
 
 static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
-  int lval, out;
+  int lval = 0, out;
   Int OldBorder = LOCAL_CBorder;
   LOCAL_CBorder = LCL0 - ENV;
 
@@ -2031,9 +2031,11 @@ bool is_cleanup_cp(choiceptr cp_b) {
   // DBTerm *dbt = Yap_RefToException();
   while (handler
 	 && Yap_PredForChoicePt(handler, NULL) != PredDollarCatch
-	 // && LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE
+	 //&& LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE
-	 // && handler->cp_b != NULL
+	 //&& handler->cp_b != NULL
 	 ) {
+    if (handler->cp_ap != NOCODE)
+      handler->cp_ap = TRUSTFAILCODE;
     handler = handler->cp_b;
   }
   pop_text_stack(1);
@@ -2041,7 +2043,7 @@ bool is_cleanup_cp(choiceptr cp_b) {
     Yap_signal(YAP_FAIL_SIGNAL);
   }
 
-  B = handler;
+  //B = handler;
   P = FAILCODE;
   return true;
 }

C/utilpreds.c

@@ -1649,28 +1649,38 @@ Yap_TermVariables( Term t, UInt arity USES_REGS )	/* variables in term t		 */
   return out;
 }
 
+typedef struct att_rec {
+  CELL *beg, *end;
+  CELL oval;
+} att_rec_t;
+
 static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS)
 {
-
+  int lvl = push_text_stack();
-  register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
+  att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t));
+  att_rec_t *to_visit_max;
   register tr_fr_ptr TR0 = TR;
   CELL *InitialH = HR;
   CELL output = AbsPair(HR);
 
   to_visit0 = to_visit;
- loop:
+  to_visit_max = to_visit0+1024;
+ restart:
+  do {
   while (pt0 < pt0_end) {
     register CELL d0;
     register CELL *ptd0;
     ++ pt0;
     ptd0 = pt0;
     d0 = *ptd0;
+        printf("%p--%p -> %lx\n", ptd0, pt0_end, d0);
+	//Yap_DebugPlWriteln(d0);
 
     deref_head(d0, attvars_in_term_unk);
   attvars_in_term_nvar:
     {
       if (IsPairTerm(d0)) {
-        if (to_visit + 1024 >= (CELL **)AuxSp) {
+        if (to_visit + 32 >= to_visit_max) {
           goto aux_overflow;
         }
         {
@@ -1682,10 +1692,10 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
           }
         }
 #ifdef RATIONAL_TREES
-	to_visit[0] = pt0;
+	to_visit->beg = pt0;
-	to_visit[1] = pt0_end;
+	to_visit->end = pt0_end;
-	to_visit[2] = (CELL *)*pt0;
+	to_visit->oval = *pt0;
-	to_visit += 3;
+	to_visit ++;
 	*pt0 = TermNil;
 #else
 	if (pt0 < pt0_end) {
@@ -1697,8 +1707,8 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
 	pt0 = RepPair(d0) - 1;
           pt0_end = pt0+2;
       } else if (IsApplTerm(d0)) {
-	register Functor f;
+        Functor f;
-	register CELL *ap2;
+	 CELL *ap2;
 	/* store the terms to visit */
 	ap2 = RepAppl(d0);
 	f = (Functor)(*ap2);
@@ -1706,14 +1716,14 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
 	  continue;
 	}
 	/* store the terms to visit */
-	if (to_visit + 1024 >= (CELL **)AuxSp) {
+	if (to_visit + 1024 >= to_visit_max) {
 	  goto aux_overflow;
 	}
 #ifdef RATIONAL_TREES
-	to_visit[0] = pt0;
+	to_visit->beg = pt0;
-	to_visit[1] = pt0_end;
+	to_visit->end = pt0_end;
-	to_visit[2] = (CELL *)*pt0;
+	to_visit->oval = *pt0;
-	to_visit += 3;
+	to_visit ++;
 	*pt0 = TermNil;
 #else
 	if (pt0 < pt0_end) {
@@ -1722,9 +1732,10 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
 	  to_visit += 2;
 	}
 #endif
-	d0 = ArityOfFunctor(f);
+	arity_t a = ArityOfFunctor(f);
+	printf("%p %d %p\n", f, a, ap2);
 	pt0 = ap2;
-	pt0_end = ap2 + d0;
+	pt0_end = ap2 + a;
       }
       continue;
     }
@@ -1750,15 +1761,16 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
       HR += 2;
       HR[-2] = (CELL)ptd0;
       /* store the terms to visit */
-      if (to_visit + 1024 >= (CELL **)AuxSp) {
+      if (to_visit + 32 >= to_visit_max) {
 	goto aux_overflow;
       }
 #ifdef RATIONAL_TREES
-      to_visit[0] = pt0;
+      
-      to_visit[1] = pt0_end;
+	to_visit->beg = pt0;
-      to_visit[2] = (CELL *)*pt0;
+	to_visit->end = pt0_end;
-      to_visit += 3;
+	to_visit->oval = *pt0;
-      *pt0 = TermNil;
+	to_visit ++;
+	*pt0 = TermNil;
 #else
       if (pt0 < pt0_end) {
 	to_visit[0] = pt0;
@@ -1769,24 +1781,25 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
       pt0 = &RepAttVar(ptd0)->Value;
       pt0_end = &RepAttVar(ptd0)->Atts;
     }
+    continue;
   }
   /* Do we still have compound terms to visit */
-  if (to_visit > to_visit0) {
+  if (to_visit == to_visit0)
+    break;
 #ifdef RATIONAL_TREES
-    to_visit -= 3;
+    to_visit --;
-    pt0 = to_visit[0];
+    pt0 = to_visit->beg;
-    pt0_end = to_visit[1];
+    pt0_end = to_visit->end;
     *pt0 = (CELL)to_visit[2];
 #else
     to_visit -= 2;
     pt0 = to_visit[0];
     pt0_end = to_visit[1];
 #endif
-    goto loop;
+  } while(true);
-  }
 
   clean_tr(TR0 PASS_REGS);
-  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+ pop_text_stack(lvl);
   if (HR != InitialH) {
     /* close the list */
     Term t2 = Deref(inp);
@@ -1812,24 +1825,20 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
   LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
   LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
   clean_tr(TR0 PASS_REGS);
-  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+ pop_text_stack(lvl);
   HR = InitialH;
   return 0L;
 
  aux_overflow:
-  LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **);
+  {
-#ifdef RATIONAL_TREES
+  size_t d1 = to_visit-to_visit0;
-  while (to_visit > to_visit0) {
+  size_t d2 = to_visit_max-to_visit0;
-    to_visit -= 3;
+  to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024);
-    pt0 = to_visit[0];
+  to_visit = to_visit0+d1;
-    *pt0 = (CELL)to_visit[2];
+  to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **);
-  }
+}
-#endif
+pt0--;
-  LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
+goto restart;
-  clean_tr(TR0 PASS_REGS);
-  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
-  HR = InitialH;
-  return 0L;
 
  global_overflow:
 #ifdef RATIONAL_TREES
@@ -1840,7 +1849,7 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end,
   }
 #endif
   clean_tr(TR0 PASS_REGS);
-  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+pop_text_stack(lvl);
   HR = InitialH;
   LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
   LOCAL_Error_Size = (ASP-HR)*sizeof(CELL);
@@ -1866,6 +1875,8 @@ p_term_attvars( USES_REGS1 )	/* variables in term t		 */
     }
     else {
       Functor f = FunctorOfTerm(t);
+      if (IsExtensionFunctor(f))
+	return Yap_unify(TermNil, ARG2);
       out = attvars_in_complex_term(RepAppl(t),
 				 RepAppl(t)+
 				 ArityOfFunctor(f), TermNil PASS_REGS);

H/YapHeap.h

@@ -263,7 +263,7 @@ INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void);
 
 INLINE_ONLY EXTERN inline ADDR Yap_PreAllocCodeSpace(void) {
   CACHE_REGS
-  return AuxBase;
+    return AuxBase;
 }
 
 #endif /* HEAP_H */

pl/top.yap

@@ -936,6 +936,7 @@ catch(G, C, A) :-
 	'$catch'(M:G,C,A).
 
 '$catch'(MG,_,_) :-
+    writeln(MG),
 	'$$save_by'(CP0),
 	'$execute'(MG),
 	'$$save_by'(CP1),