fix number of overflows (comments by Bart Demoen).

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1857 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/compiler.c

@@ -11,8 +11,11 @@
 * File:		compiler.c						 *
 * comments:	Clause compiler						 *
 *									 *
-* Last rev:     $Date: 2007-03-26 15:18:43 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-03-27 13:48:51 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.83  2007/03/26 15:18:43  vsc
+* debugging and clause/3 over tabled predicates would kill YAP.
+*
 * Revision 1.82  2006/11/06 18:35:03  vsc
 * 1estranha
 *
@@ -210,7 +213,7 @@ STATIC_PROTO(void c_arg, (Int, Term, unsigned int, unsigned int, compiler_struct
 STATIC_PROTO(void c_args, (Term, unsigned int, compiler_struct *));
 STATIC_PROTO(void c_eq, (Term, Term, compiler_struct *));
 STATIC_PROTO(void c_test, (Int, Term, compiler_struct *));
-STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, int, compiler_struct *));
+STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, Term, int, compiler_struct *));
 STATIC_PROTO(void c_goal, (Term, int, compiler_struct *));
 STATIC_PROTO(void c_body, (Term, int, compiler_struct *));
 STATIC_PROTO(void c_head, (Term, compiler_struct *));
@@ -840,7 +843,7 @@ bip_cons	   Op,Xk,Ri,C
 
  */
 static void
-c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
+c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, int mod, compiler_struct *cglobs)
 {
   /* compile Z = X Op Y  arithmetic function */
   /* first we fetch the arguments */
@@ -990,7 +993,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
 	    RESET_VARIABLE(H+1);
 	    H += 2;
 	    c_eq(AbsPair(H-2),t3, cglobs);
-	  } else if (i2 < 16) {
+	  } else if (i2 < 256) {
 	    *H++ = (CELL)Yap_MkFunctor(AtomOfTerm(t1),i2);
 	    for (i=0; i < i2; i++) {
 	      if (H >= (CELL *)cglobs->cint.freep0) {
@@ -1002,6 +1005,20 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
 	      H++;	    
 	    }
 	    c_eq(AbsAppl(hi),t3, cglobs);
+	  } else {
+	    /* compile as default */
+	    Functor f = FunctorOfTerm(Goal);
+	    Prop p0 = PredPropByFunc(f, mod);
+
+	    if (profiling)
+	      Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
+	    else if (call_counting)
+	      Yap_emit(count_call_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint);
+	    c_args(Goal, 0, cglobs);
+	    Yap_emit(safe_call_op, (CELL)p0 , Zero, &cglobs->cint);
+	    Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint);
+	    Yap_emit(restore_tmps_and_skip_op, Zero, Zero, &cglobs->cint);
+	    return;
 	  }
 	}
       } else if (Op == _arg) {
@@ -1207,7 +1224,7 @@ c_functor(Term Goal, int mod, compiler_struct *cglobs)
   Term t3 = ArgOfTerm(3, Goal);
 
   if (IsVarTerm(t1) && IsNewVar(t1)) {
-    c_bifun(_functor, t2, t3, t1, mod, cglobs);
+    c_bifun(_functor, t2, t3, t1, Goal, mod, cglobs);
   } else if (IsNonVarTerm(t1)) {
     /* just split the structure */
     if (IsAtomicTerm(t1)) {
@@ -1656,6 +1673,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 		  ArgOfTerm(1, Goal),
 		  ArgOfTerm(2, Goal),
 		  ArgOfTerm(3, Goal),
+		  Goal,
 		  mod,
 		  cglobs);
 	}

C/inlines.c

@@ -713,7 +713,7 @@ p_functor(void)			/* functor(?,?,?) */
     if (pt1+d1 > ENV - CreepFlag) {
       if (!Yap_gcl((1+d1)*sizeof(CELL), 3, ENV, P)) {
 	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	return(FALSE);
+	return FALSE;
       }
       goto restart;
     }

C/utilpreds.c

@@ -223,6 +223,12 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
 	  to_visit = bp[0];
 	  HB = HLow;
 	  ptf++;
+	  if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
+	    /* Trail overflow */
+	    if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	      goto trail_overflow;
+	    }
+	  }
 	  Bind_Global(ptd0, ptf[-1]);
 	}
       } else {
@@ -276,6 +282,30 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
   reset_trail(TR0);
   return -1;
 
+trail_overflow:
+  /* oops, we're in trouble */
+  H = HLow;
+  /* we've done it */
+  /* restore our nice, friendly, term to its original state */
+  HB = HB0;
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 4;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+    ptf = to_visit[2];
+    *pt0 = (CELL)to_visit[3];
+  }
+#endif
+  {
+    tr_fr_ptr oTR =  TR;
+    reset_trail(TR0);
+    if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), FALSE)) {
+      return -4;
+    }
+    return -2;
+  }
+
  heap_overflow:
   /* oops, we're in trouble */
   H = HLow;
@@ -292,7 +322,32 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, CELL *ptf, CELL *H
   }
 #endif
   reset_trail(TR0);
-  return -2;
+  return -3;
+}
+
+
+static Term
+handle_cp_overflow(int res, UInt arity, Term t)
+{
+  XREGS[arity+1] = t;
+  switch(res) {
+  case -1:
+    if (!Yap_gcl((ASP-H)*sizeof(CELL), arity+1, ENV, P)) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+      return 0L;
+    }
+    return Deref(XREGS[arity+1]);
+  case -2:
+    return Deref(XREGS[arity+1]);
+  case -3:
+    if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
+      Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
+      return 0L;
+    }
+    return Deref(XREGS[arity+1]);
+  default:
+    return 0L;
+  }
 }
 
 static Term
@@ -310,23 +365,10 @@ CopyTerm(Term inp, UInt arity) {
       Hi = H+1;
       H += 2;
       if ((res = copy_complex_term(Hi-2, Hi-1, Hi, Hi)) < 0) {
-	XREGS[arity+1] = t;
 	H = Hi-1;
-	if (res == -1) { /* handle overflow */
+	if ((t = handle_cp_overflow(res,arity,t))== 0L)
-	  if (!Yap_gcl((ASP-H)*sizeof(CELL), arity+1, ENV, P)) {
-	    Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
 	  return FALSE;
-	  }
-	  t = Deref(XREGS[arity+1]);
 	goto restart_attached;
-	} else { /* handle overflow */
-	  if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
-	    Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
-	    return FALSE;
-	  }
-	  t = Deref(XREGS[arity+1]);
-	  goto restart_attached;
-	}
       }
       return Hi[0];
     }
@@ -348,22 +390,9 @@ CopyTerm(Term inp, UInt arity) {
       int res;
       if ((res = copy_complex_term(ap-1, ap+1, Hi, Hi)) < 0) {
 	H = Hi;
-	XREGS[arity+1] = t;
+	if ((t = handle_cp_overflow(res,arity,t))== 0L)
-	if (res == -1) { /* handle overflow */
-	  if (!Yap_gcl((ASP-H)*sizeof(CELL), arity+1, ENV, P)) {
-	    Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
 	  return FALSE;
-	  }
-	  t = Deref(XREGS[arity+1]);
 	goto restart_list;
-	} else { /* handle overflow */
-	  if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
-	    Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
-	    return FALSE;
-	  }
-	  t = Deref(XREGS[arity+1]);
-	  goto restart_list;
-	}
       }
     }
     return tf;
@@ -381,34 +410,18 @@ CopyTerm(Term inp, UInt arity) {
     H[0] = (CELL)f;
     H += 1+ArityOfFunctor(f);
     if (H > ASP-128) {
-      H -= 1+ArityOfFunctor(f);
+      H = HB0;
-      if (!Yap_gcl((ASP-H)*sizeof(CELL),arity+1, ENV, P)) {
+      if ((t = handle_cp_overflow(-1,arity,t))== 0L)
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
 	return FALSE;
-      }
-      t = Deref(XREGS[arity+1]);
       goto restart_appl;
     } else {
       int res;
 
       if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0)) < 0) {
 	H = HB0;
-	XREGS[arity+1] = t;
+	if ((t = handle_cp_overflow(res,arity,t))== 0L)
-	if (res == -1) {
-	  if (!Yap_gcl((ASP-H)*sizeof(CELL),arity+1, ENV, P)) {
-	    Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
 	  return FALSE;
-	  }
-	  t = Deref(XREGS[arity+1]);
 	goto restart_appl;
-	} else { /* handle overflow */
-	  if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
-	    Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
-	    return FALSE;
-	  }
-	  t = Deref(XREGS[arity+1]);
-	  goto restart_appl;
-	}
       }
     }
     return tf;
@@ -553,6 +566,12 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
     } else {
       /* first time we met this term */
       RESET_VARIABLE(ptf);
+      if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
+	/* Trail overflow */
+	if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	  goto trail_overflow;
+	}
+      }
       Bind_Global(ptd0, (CELL)ptf);
       ptf++;
     }
@@ -598,6 +617,30 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
   clean_tr(TR0);
   return(-1);
 
+trail_overflow:
+  /* oops, we're in trouble */
+  H = HLow;
+  /* we've done it */
+  /* restore our nice, friendly, term to its original state */
+  HB = HB0;
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 4;
+    pt0 = to_visit[0];
+    pt0_end = to_visit[1];
+    ptf = to_visit[2];
+    *pt0 = (CELL)to_visit[3];
+  }
+#endif
+  {
+    tr_fr_ptr oTR =  TR;
+    reset_trail(TR0);
+    if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), FALSE)) {
+      return -4;
+    }
+    return -2;
+  }
+
  heap_overflow:
   /* oops, we're in trouble */
   H = HLow;
@@ -614,7 +657,7 @@ static int copy_complex_term_no_delays(register CELL *pt0, register CELL *pt0_en
   }
 #endif
   clean_tr(TR0);
-  return(-2);
+  return(-3);
 }
 
 static Term
@@ -638,21 +681,9 @@ CopyTermNoDelays(Term inp) {
     res = copy_complex_term_no_delays(ap-1, ap+1, H-2, H-2);
     if (res) {
       H = Hi;
-      if (res == -1) { /* handle overflow */
+      if ((t = handle_cp_overflow(res,2,t))== 0L)
-	if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, P)) {
+	return FALSE;
-	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	  return(FALSE);
-	}
-	t = Deref(ARG1);
       goto restart_list;
-      } else { /* handle overflow */
-	if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
-	  Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
-	  return(FALSE);
-	}
-	t = Deref(ARG1);
-	goto restart_list;
-      }
     }
     return(tf);
   } else {
@@ -671,21 +702,9 @@ CopyTermNoDelays(Term inp) {
     res = copy_complex_term_no_delays(ap, ap+ArityOfFunctor(f), HB0+1, HB0);
     if (res) {
       H = HB0;
-      if (res == -1) {
+      if ((t = handle_cp_overflow(res,2,t))== 0L)
-	if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, P)) {
+	return FALSE;
-	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	  return(FALSE);
-	}
-	t = Deref(ARG1);
       goto restart_appl;
-      } else { /* handle overflow */
-	if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
-	  Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage);
-	  return(FALSE);
-	}
-	t = Deref(ARG1);
-	goto restart_appl;
-      }
     }
     return(tf);
   }
@@ -781,6 +800,12 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
     H += 2;
     H[-2] = (CELL)ptd0;
     /* next make sure noone will see this as a variable again */ 
+    if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
+      /* Trail overflow */
+      if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
+	goto trail_overflow;
+      }
+    }
     TrailTerm(TR++) = (CELL)ptd0;
   }
   /* Do we still have compound terms to visit */
@@ -813,15 +838,61 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
   } else {
     return(inp);
   }
- global_overflow:
+
+ trail_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
+  Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *);
   clean_tr(TR0);
   Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
   H = InitialH;
+  return 0L;
+  
+ global_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
+  clean_tr(TR0);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  Yap_Error_TYPE = OUT_OF_STACK_ERROR;
   Yap_Error_Size = (ASP-H)*sizeof(CELL);
   return 0L;
   
 }
 
+static int
+expand_vts(void)
+{
+  UInt expand = Yap_Error_Size;
+  yap_error_number yap_errno = Yap_Error_TYPE;
+  
+  Yap_Error_Size = 0;
+  Yap_Error_TYPE = YAP_NO_ERROR;
+  if (yap_errno == OUT_OF_TRAIL_ERROR) {
+    /* Trail overflow */
+    if (!Yap_growtrail(expand, FALSE)) {
+      return FALSE;
+    }
+  } else {
+    if (!Yap_gcl(expand, 3, ENV, P)) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
+      return FALSE;
+    }
+  }
+  return TRUE;
+}
+ 
 static Int 
 p_variables_in_term(void)	/* variables in term t		 */
 {
@@ -849,11 +920,9 @@ p_variables_in_term(void)	/* variables in term t		 */
 				 ArityOfFunctor(f), ARG2);
     }
     if (out == 0L) {
-      if (!Yap_gcl(Yap_Error_Size, 3, ENV, P)) {
+      if (!expand_vts())
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
 	return FALSE;
     }
-    }
   } while (out == 0L);
   return(Yap_unify(ARG3,out));
 }
@@ -880,11 +949,9 @@ p_term_variables(void)	/* variables in term t		 */
 				 ArityOfFunctor(f), TermNil);
     }
     if (out == 0L) {
-      if (!Yap_gcl((ASP-H)*sizeof(CELL), 2, ENV, P)) {
+      if (!expand_vts())
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
 	return FALSE;
     }
-    }
   } while (out == 0L);
   return Yap_unify(ARG2,out);
 }
@@ -911,11 +978,9 @@ p_term_variables3(void)	/* variables in term t		 */
 				 ArityOfFunctor(f), ARG3);
     }
     if (out == 0L) {
-      if (!Yap_gcl((ASP-H)*sizeof(CELL), 3, ENV, P)) {
+      if (!expand_vts())
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
 	return FALSE;
     }
-    }
   } while (out == 0L);
 
   return Yap_unify(ARG2,out);
@@ -1035,6 +1100,13 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt
   }
 
  aux_overflow:
+#ifdef RATIONAL_TREES
+  while (to_visit > to_visit0) {
+    to_visit -= 3;
+    pt0 = to_visit[0];
+    *pt0 = (CELL)to_visit[2];
+  }
+#endif
   clean_tr(TR0);
   if (H != InitialH) {
     /* close the list */
@@ -1178,7 +1250,6 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end)
   while (to_visit > to_visit0) {
     to_visit -= 3;
     pt0 = to_visit[0];
-    pt0_end = to_visit[1];
     *pt0 = (CELL)to_visit[2];
   }
 #endif

console/yap.c

@@ -117,7 +117,6 @@ static char *def_value[MAXDEFS];
 static int  def_c=0;
 /* End preprocessor code */
 
-
 #if USE_MYPUTC
 static void
 myputc (int ch)

pl/boot.yap

@@ -1075,4 +1075,3 @@ throw(Ball) :-
 	nb_setval('$system_mode',off),
 	( nb_getval('$trace',on) -> '$creep' ; true).
 	
-