bug fixes on memory overflows and on clauses :- fail being ignored by clause.

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

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.61 2004-10-26 20:15:47 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.62 2004-10-27 15:56:32 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -494,23 +494,39 @@ FreeCodeSpace(char *p)
   FreeBlock(((BlockHeader *) (p - sizeof(YAP_SEG_SIZE))));
 }
 
+#if DEBUG_ALLOC
+int vsc_mem_trace;
+#endif
+
 /* If you need to dinamically allocate space from the heap, this is
  * the macro you should use */
 void
 Yap_FreeCodeSpace(char *p)
 {
+#if DEBUG_ALLOC
+  if (vsc_mem_trace)
+    printf("-%p\n",p);
+#endif
   FreeCodeSpace(p);
 }
 
 char *
 Yap_AllocAtomSpace(unsigned int size)
 {
-  return (AllocHeap(size));
+  char *out = AllocHeap(size);
+#if DEBUG_ALLOC
+  if (vsc_mem_trace) printf("+%p/%d\n",out,size);
+#endif
+  return out;
 }
 
 void
 Yap_FreeAtomSpace(char *p)
 {
+#if DEBUG_ALLOC
+  if (vsc_mem_trace)
+    printf("-%p\n",p);
+#endif
   FreeCodeSpace(p);
 }
 
@@ -525,7 +541,11 @@ AllocCodeSpace(unsigned int size)
 char *
 Yap_AllocCodeSpace(unsigned int size)
 {
-  return AllocCodeSpace(size);
+  char *out = AllocCodeSpace(size);
+#if DEBUG_ALLOC
+  if (vsc_mem_trace) printf("+%p/%d\n",out,size);
+#endif
+  return out;
 }
 
 ADDR

C/dbase.c

@@ -265,6 +265,44 @@ STATIC_PROTO(DBProp find_int_key, (Int));
 }
 #endif
 
+static int
+recover_from_record_error(int nargs)
+{
+  switch(Yap_Error_TYPE) {
+  case OUT_OF_STACK_ERROR:
+    if (!Yap_gc(nargs, ENV, P)) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+      return FALSE;
+    }
+    goto recover_record;
+  case OUT_OF_TRAIL_ERROR:
+    if (!Yap_growtrail(64 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
+  case OUT_OF_HEAP_ERROR:
+    if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
+      Yap_Error(OUT_OF_HEAP_ERROR, Yap_Error_Term, Yap_ErrorMessage);
+      return FALSE;
+    }
+    goto recover_record;
+  case OUT_OF_AUXSPACE_ERROR:
+    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
+      Yap_Error(OUT_OF_AUXSPACE_ERROR, Yap_Error_Term, Yap_ErrorMessage);
+      return FALSE;
+    }
+    goto recover_record;
+  default:
+    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
+    return FALSE;
+  }
+ recover_record:
+  Yap_Error_Size = 0;
+  Yap_Error_TYPE = YAP_NO_ERROR;
+  return TRUE;
+}
+
 
 #ifdef SUPPORT_HASH_TABLES
 /* related property and hint on number of entries */
@@ -990,7 +1028,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   return(CodeMax);
 
  error:
-  Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
+  Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
   Yap_Error_Size = 1024+((char *)AuxSp-(char *)CodeMaxBase);
   *vars_foundp = vars_found;
 #ifdef RATIONAL_TREES
@@ -1525,7 +1563,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
       CodeAbs += CellPtr(dbg->lr) - CellPtr(dbg->LinkAr);
       if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
 	Yap_Error_Size = (UInt)DBLength(CodeAbs);
-	Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
+	Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
 	return(NULL);
       }
@@ -1545,9 +1583,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
       CodeAbs += (TmpRefBase - dbg->tofref) + 1;
       if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
 	Yap_Error_Size = (UInt)DBLength(CodeAbs);
-	Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
+	Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR;
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
-	return(NULL);
+	return NULL;
       }
       flag |= DBWithRefs;
     }
@@ -1872,8 +1910,8 @@ p_rcda(void)
   if (!IsVarTerm(Deref(ARG3)))
     return (FALSE);
   pe = find_lu_entry(t1);
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   if (pe) {
     LogUpdClause *cl;
     cl = record_lu(pe, t2, MkFirst);
@@ -1891,35 +1929,15 @@ p_rcda(void)
   } else { 
     TRef = MkDBRefTerm(record(MkFirst, t1, t2, Unsigned(0)));
   }
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(3)) {
-    return (Yap_unify(ARG3, TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if (!Yap_growtrail(64 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
-  t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* '$recordap'(+Functor,+Term,-Ref) */
@@ -1930,38 +1948,20 @@ p_rcdap(void)
 
   if (!IsVarTerm(Deref(ARG3)))
     return FALSE;
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, Unsigned(0)));
-  switch(Yap_Error_TYPE) {
+
-  case YAP_NO_ERROR:
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-    return Yap_unify(ARG3, TRef);
+    if (recover_from_record_error(3)) {
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return FALSE;
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* recorda_at(+Functor,+Term,-Ref) */
@@ -1981,38 +1981,19 @@ p_rcda_at(void)
       Yap_Error(TYPE_ERROR_DBREF, t1, "recorda_at/3");
       return(FALSE);
   }
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(3)) {
-    return (Yap_unify(ARG3, TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* recordz(+Functor,+Term,-Ref) */
@@ -2025,8 +2006,8 @@ p_rcdz(void)
   if (!IsVarTerm(Deref(ARG3)))
     return (FALSE);
   pe = find_lu_entry(t1);
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   if (pe) {
     LogUpdClause *cl = record_lu(pe, t2, MkLast);
     if (cl != NULL) {
@@ -2043,35 +2024,16 @@ p_rcdz(void)
   } else { 
     TRef = MkDBRefTerm(record(MkLast, t1, t2, Unsigned(0)));
   }
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(3)) {
-    return (Yap_unify(ARG3, TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* recordz(+Functor,+Term,-Ref) */
@@ -2081,43 +2043,23 @@ Yap_Recordz(Atom at, Term t2)
   PredEntry *pe;
 
   pe = find_lu_entry(MkAtomTerm(at));
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   if (pe) {
     record_lu(pe, t2, MkLast);
   } else { 
     record(MkLast, MkAtomTerm(at), t2, Unsigned(0));
   }
-  if (YAP_NO_ERROR == Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-    return TRUE;
-  }
     ARG1 = t2;
-  switch(Yap_Error_TYPE) {
+    if (recover_from_record_error(1)) {
-  case OUT_OF_STACK_ERROR:
+      t2 = ARG1;
-    if (!Yap_gc(1, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
-  t2 = Deref(ARG1);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return TRUE;
 }
 
 /* '$recordzp'(+Functor,+Term,-Ref) */
@@ -2128,38 +2070,19 @@ p_rcdzp(void)
 
   if (!IsVarTerm(Deref(ARG3)))
     return (FALSE);
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, Unsigned(0)));
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(3)) {
-    return (Yap_unify(ARG3, TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* recordz_at(+Functor,+Term,-Ref) */
@@ -2179,38 +2102,19 @@ p_rcdz_at(void)
       Yap_Error(TYPE_ERROR_DBREF, t1, "recordz_at/3");
       return(FALSE);
   }
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   TRef = MkDBRefTerm(record_at(MkLast, DBRefOfTerm(t1), t2, Unsigned(0)));
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(3)) {
-    return (Yap_unify(ARG3, TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* '$record_stat_source'(+Functor,+Term) */
@@ -2226,41 +2130,23 @@ p_rcdstatp(void)
   if (IsVarTerm(t3) || !IsIntTerm(t3))
     return (FALSE);
   mk_first = ((IntOfTerm(t3) % 4) == 2);
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   if (mk_first)
     TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, MkIntTerm(0)));
   else
     TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, MkIntTerm(0)));
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(4)) {
-    return (Yap_unify(ARG4,TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(3, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
+      t3 = Deref(ARG3);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG4, TRef);
 }
 
 /* '$recordap'(+Functor,+Term,-Ref,+CRef) */
@@ -2273,40 +2159,21 @@ p_drcdap(void)
     return (FALSE);
   if (IsVarTerm(t4) || !IsIntegerTerm(t4))
     return (FALSE);
- restart_record:
   Yap_Error_Size = 0;
+ restart_record:
   TRef = MkDBRefTerm(record(MkFirst | MkCode | WithRef,
 			    t1, t2, t4));
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(4)) {
-    return (Yap_unify(ARG3, TRef));
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(4, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       t4 = Deref(ARG4);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 /* '$recordzp'(+Functor,+Term,-Ref,+CRef) */
@@ -2323,36 +2190,17 @@ p_drcdzp(void)
   Yap_Error_Size = 0;
   TRef = MkDBRefTerm(record(MkLast | MkCode | WithRef,
 			    t1, t2, t4));
-  switch(Yap_Error_TYPE) {
+  if (Yap_Error_TYPE != YAP_NO_ERROR) {
-  case YAP_NO_ERROR:
+    if (recover_from_record_error(4)) {
-    return Yap_unify(ARG3, TRef);
-  case OUT_OF_STACK_ERROR:
-    if (!Yap_gc(4, ENV, P)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return(FALSE);
-    }
-    goto recover_record;
-  case OUT_OF_TRAIL_ERROR:
-    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return FALSE;
-    }
-    goto recover_record;
-  case OUT_OF_HEAP_ERROR:
-    if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
-      return FALSE;
-    }
-    goto recover_record;
-  default:
-    Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-    return(FALSE);
-  }
- recover_record:
-  Yap_Error_TYPE = YAP_NO_ERROR;
       t1 = Deref(ARG1);
       t2 = Deref(ARG2);
       t4 = Deref(ARG4);
       goto restart_record;
+    } else {
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG3, TRef);
 }
 
 static Int
@@ -4893,40 +4741,15 @@ StoreTermInDB(Term t, int nargs)
   Yap_Error_Size = 0;
   while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL,
 			  InQueue, &needs_vars, 0, &dbg)) == NULL) {
-    switch(Yap_Error_TYPE) {
+    if (Yap_Error_TYPE == YAP_NO_ERROR) {
-    case YAP_NO_ERROR:
-#ifdef DEBUG
-      Yap_Error(SYSTEM_ERROR, TermNil, "no error but null return in enqueue/2");
-#endif
       break;
-    case OUT_OF_STACK_ERROR:
-      XREGS[nargs+1] = t;
-      if (!Yap_gc(nargs+1, ENV, P)) {
-	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-	return(FALSE);
     } else {
-	t = Deref(XREGS[nargs+1]);
-	break;
-      }
-    case OUT_OF_TRAIL_ERROR:
       XREGS[nargs+1] = t;
-      if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      if (recover_from_record_error(nargs+1)) {	
-	Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+	t = Deref(XREGS[nargs+1]);
-	return FALSE;
       } else {
-	t = Deref(XREGS[nargs+1]);
-	break;
-      }      
-    case OUT_OF_HEAP_ERROR:
-      XREGS[nargs+1] = t;
-      if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
 	return FALSE;
       }
-      t = Deref(XREGS[nargs+1]);
-      break;
-    default:
-      Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
-      return(FALSE);
     }
   }
   return(x);

C/errors.c

@@ -907,7 +907,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
 
       dump_stack();
       i = strlen(tmpbuf);
-      nt[0] = MkAtomTerm(Yap_LookupAtom("out_of_stack_error"));
+      nt[0] = MkAtomTerm(Yap_LookupAtom("out_of_heap_error"));
       tp = tmpbuf+i;
       psize -= i;
       fun = Yap_MkFunctor(Yap_LookupAtom("error"),2);
@@ -940,6 +940,19 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case OUT_OF_AUXSPACE_ERROR:
+    {
+      int i;
+
+      dump_stack();
+      i = strlen(tmpbuf);
+      nt[0] = MkAtomTerm(Yap_LookupAtom("out_of_auxspace_error"));
+      tp = tmpbuf+i;
+      psize -= i;
+      fun = Yap_MkFunctor(Yap_LookupAtom("error"),2);
+      serious = TRUE;
+    }
+    break;
   case OUT_OF_TRAIL_ERROR:
     {
       int i;

C/heapgc.c

@@ -94,14 +94,35 @@ static cont *cont_top0;
 #endif
 static cont *cont_top;
 
+static int
+gc_growtrail(int committed)
+{
+#if USE_SYSTEM_MALLOC
+  TR = Yap_old_TR;
+#endif
+  if (!Yap_growtrail(64 * 1024L)) {
+    /* could not find more trail */
+    longjmp(Yap_gc_restore, 2);
+  }
+#if USE_SYSTEM_MALLOC
+#if !GC_NO_TAGS
+  if (committed) {
+    longjmp(Yap_gc_restore, 2);
+  }
+#endif
+  longjmp(Yap_gc_restore, 1);
+#endif
+}
+
 inline static void
 PUSH_CONTINUATION(CELL *v, int nof) {
   cont *x;
   if (nof == 0) return;
   x = cont_top;
   x++;
-  if ((ADDR)x > Yap_TrailTop-1024)
+  if ((ADDR)x > Yap_TrailTop-1024) {
-    Yap_growtrail(64 * 1024L);
+    gc_growtrail(TRUE);
+  }
   x->v = v;
   x->nof = nof;
   cont_top = x;
@@ -277,7 +298,7 @@ GC_ALLOC_NEW_MASPACE(void)
 {
   gc_ma_hash_entry *new = gc_ma_h_top;
   if ((char *)gc_ma_h_top > Yap_TrailTop-1024)
-    Yap_growtrail(64 * 1024L);
+    gc_growtrail(FALSE);
   gc_ma_h_top++;
   cont_top = (cont *)gc_ma_h_top;
 #ifdef EASY_SHUNTING
@@ -493,10 +514,7 @@ RBMalloc(UInt size)
 
   db_vec += size; 
   if ((ADDR)db_vec > Yap_TrailTop-1024) {
-    Yap_growtrail(64 * 1024L);
+    gc_growtrail(FALSE);
-#if USE_SYSTEM_MALLOC
-    /* TODO */
-#endif    
   }
   return (rb_red_blk_node *)new;
 }
@@ -655,7 +673,7 @@ TreeInsertHelp(rb_red_blk_node* z) {
   x=db_root->left;
   while( x != nil) {
     y=x;
-    if (x->key > z->key) { /* x.key > z.key */
+    if (x->key < z->key) { /* x.key > z.key */
       x=x->left;
     } else { /* x,key <= z.key */
       x=x->right;
@@ -663,7 +681,7 @@ TreeInsertHelp(rb_red_blk_node* z) {
   }
   z->parent=y;
   if ( (y == db_root) ||
-       (y->key > z->key)) { /* y.key > z.key */
+       (y->key < z->key)) { /* y.key > z.key */
     y->left=z;
   } else {
     y->right=z;
@@ -3297,25 +3315,32 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
 static Int
 do_gc(Int predarity, CELL *current_env, yamop *nextop)
 {
-  Int		heap_cells = H-H0;
+  Int		heap_cells;
-  int		gc_verbose = is_gc_verbose();
+  int		gc_verbose;
-  tr_fr_ptr     old_TR;
+  tr_fr_ptr     old_TR = NULL;
   UInt		m_time, c_time, time_start, gc_time;
-#if COROUTINING
+  CELL *max;
-  CELL *max = (CELL *)Yap_ReadTimedVar(DelayedVars);
+  Int           effectiveness;
-#else
+  int           gc_trace;
-  CELL *max = NULL;
-#endif
-  Int           effectiveness = 0;
-  int           gc_trace = FALSE;
 
+  if (setjmp(Yap_gc_restore) == 2) {
+    /* we cannot recover, fail system */
+    Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"could not expand trail during garbage collection");
+  }
+  heap_cells = H-H0;
+  gc_verbose = is_gc_verbose();
+  effectiveness = 0;
+  gc_trace = FALSE;
 #if COROUTINING
+  max = (CELL *)Yap_ReadTimedVar(DelayedVars);
   if (H0 - max < 1024+(2*NUM_OF_ATTS)) {
     if (!Yap_growglobal(&current_env)) {
       Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
       return 0;
     }
   }
+#else
+  max = NULL;
 #endif
 #ifdef INSTRUMENT_GC
   {
@@ -3354,7 +3379,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
   }
 #endif
   if (gc_trace) {
-    fprintf(Yap_stderr, "[gc]\n");
+    fprintf(Yap_stderr, "%% gc\n");
   } else if (gc_verbose) {
     fprintf(Yap_stderr, "%% Start of garbage collection %d:\n", GcCalls);
 #ifndef EARLY_RESET
@@ -3403,7 +3428,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
 #endif
   /* get the number of active registers */
   YAPEnterCriticalSection();
-  old_TR = TR;
+  Yap_old_TR = old_TR = TR;
   push_registers(predarity, nextop);
   marking_phase(old_TR, current_env, nextop, max);
   m_time = Yap_cputime();

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2004-10-22 16:53:19 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-10-27 15:56:33 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.103  2004/10/22 16:53:19  vsc
+* bug fixes
+*
 * Revision 1.102  2004/10/04 18:56:19  vsc
 * fixes for thread support
 * fix indexing bug (serious)
@@ -7835,11 +7838,6 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
       Terms[1] = XREGS[ap->ArityOfPE+4];
       Terms[2] = XREGS[ap->ArityOfPE+5];
       break;
-    case _op_fail:
-      /*
-	ipc = (yamop *)IntegerOfTerm(B->cp_args[1]);
-	break;
-      */
     case _undef_p:
       return NULL;
     case _lock_lu:
@@ -7873,6 +7871,9 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
       Terms[1] = XREGS[ap->ArityOfPE+4];
       Terms[2] = XREGS[ap->ArityOfPE+5];
       break;
+    case _op_fail:
+      if (ipc == FAILCODE)
+	return NULL;
     default:
       if (b0) {
 #ifdef YAPOR

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.68 2004-10-10 00:23:54 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.69 2004-10-27 15:56:34 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -64,6 +64,8 @@ typedef struct worker_local_struct {
   unsigned int      gc_calls;	/* number of times GC has been called */ 
   Int      tot_gc_time; /* total time spent in GC */
   Int      tot_gc_recovered; /* number of heap objects in all garbage collections */
+  jmp_buf  gc_restore; /* where to jump if garbage collection crashes */
+  struct trail_frame *old_TR;
 } worker_local;
 
 #ifdef THREADS
@@ -672,6 +674,8 @@ struct various_codes *heap_regs;
 #define  GcCalls                  heap_regs->wl[worker_id].gc_calls
 #define  TotGcTime                heap_regs->wl[worker_id].tot_gc_time
 #define  TotGcRecovered           heap_regs->wl[worker_id].tot_gc_recovered
+#define  Yap_gc_restore           heap_regs->wl[worker_id].gc_restore
+#define  Yap_old_TR               heap_regs->wl[worker_id].old_TR
 #else
 #define  ActiveSignals            heap_regs->wl.active_signals
 #define  DelayedTrace	          heap_regs->wl.delayed_trace
@@ -687,6 +691,8 @@ struct various_codes *heap_regs;
 #define  GcCalls                  heap_regs->wl.gc_calls
 #define  TotGcTime                heap_regs->wl.tot_gc_time
 #define  TotGcRecovered           heap_regs->wl.tot_gc_recovered
+#define  Yap_gc_restore           heap_regs->wl.gc_restore
+#define  Yap_old_TR               heap_regs->wl.old_TR
 #endif
 #define  profiling                heap_regs->compiler_profiling
 #define  call_counting            heap_regs->compiler_call_counting

m4/Yap.h.m4

@@ -10,7 +10,7 @@
 * File:		Yap.h.m4						 *
 * mods:									 *
 * comments:	main header file for YAP				 *
-* version:      $Id: Yap.h.m4,v 1.72 2004-10-14 22:14:53 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.73 2004-10-27 15:56:34 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -467,6 +467,7 @@ typedef enum {
   OUT_OF_STACK_ERROR,
   OUT_OF_TRAIL_ERROR,
   OUT_OF_ATTVARS_ERROR,
+  OUT_OF_AUXSPACE_ERROR,
   PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE,
   PERMISSION_ERROR_NEW_ALIAS_FOR_STREAM,
   PERMISSION_ERROR_CREATE_ARRAY,

pl/errors.yap

@@ -11,8 +11,12 @@
 * File:		errors.yap						 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2004-10-04 18:56:20 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-10-27 15:56:34 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.56  2004/10/04 18:56:20  vsc
+* fixes for thread support
+* fix indexing bug (serious)
+*
 * Revision 1.55  2004/09/17 19:34:53  vsc
 * simplify frozen/2
 *
@@ -476,7 +480,7 @@ print_message(Level, Mss) :-
 	format(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
 	[Where]).
 '$output_error_message'(out_of_heap_error, Where) :-
-	format(user_error,'% OUT OF HEAP SPACE ERROR- ~w~n',
+	format(user_error,'% OUT OF DATABASE SPACE ERROR- ~w~n',
 	[Where]).
 '$output_error_message'(out_of_stack_error, Where) :-
 	format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
@@ -487,6 +491,9 @@ print_message(Level, Mss) :-
 '$output_error_message'(out_of_attvars_error, Where) :-
 	format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
 	[Where]).
+'$output_error_message'(out_of_auxspace_error, Where) :-
+	format(user_error,'% OUT OF AUXILIARY STACK SPACE ERROR- ~w~n',
+	[Where]).
 '$output_error_message'(permission_error(access,private_procedure,P), Where) :-
 	format(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
 	[Where,P]).