fix pruning bug

make DL_MALLOC less enthusiastic about walking through buckets.


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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2005-02-08 18:04:17 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-03-01 22:25:07 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.157  2005/02/08 18:04:17  vsc
+* library_directory may not be deterministic (usually it isn't).
+*
 * Revision 1.156  2005/01/13 05:47:25  vsc
 * lgamma broke arithmetic optimisation
 * integer_y has type y
@@ -2003,7 +2006,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	CUT_prune_to((choiceptr) d0);
 #else
-	while (B->cp_b != (choiceptr)d0) {
+	while (B->cp_b < (choiceptr)d0) {
 	  B = B->cp_b;
 	}
       trim_trail:
@@ -2083,7 +2086,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	CUT_prune_to((choiceptr) d0);
 #else
-	while (B->cp_b != (choiceptr)d0) {
+	while (B->cp_b < (choiceptr)d0) {
 	  B = B->cp_b;
 	}
 #endif	/* YAPOR */
@@ -2124,7 +2127,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	CUT_prune_to((choiceptr) d0);
 #else
-	while (B->cp_b != (choiceptr)d0) {
+	while (B->cp_b < (choiceptr)d0) {
 	  B = B->cp_b;
 	}
 #endif	/* YAPOR */
@@ -2182,7 +2185,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	  CUT_prune_to(pt0);
 #else
-	  while (B->cp_b != pt0) {
+	  while (B->cp_b < pt0) {
 	    B = B->cp_b;
 	  }
 #endif	/* YAPOR */
@@ -2215,7 +2218,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	  CUT_prune_to(pt0);
 #else
-	  while (B->cp_b != pt0) {
+	  while (B->cp_b < pt0) {
 	    B = B->cp_b;
 	  }
 #endif	/* YAPOR */
@@ -8479,7 +8482,7 @@ Yap_absmi(int inp)
     float_y_nvar:
       /* non variable */
       if (IsFloatTerm(d0)) {
-	PREG = NEXTOP(PREG, xF);
+	PREG = NEXTOP(PREG, yF);
 	GONext();
       }
       PREG = PREG->u.yF.F;
@@ -8517,7 +8520,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	CUT_prune_to(pt0);
 #else
-	while (B->cp_b != pt0) {
+	while (B->cp_b < pt0) {
 	  B = B->cp_b;
 	}
 #endif /* YAPOR */
@@ -8562,7 +8565,7 @@ Yap_absmi(int inp)
 #ifdef YAPOR
 	CUT_prune_to(pt1);
 #else
-	while (B->cp_b != pt1) {
+	while (B->cp_b < pt1) {
 	  B = B->cp_b;
 	}
 #endif /* YAPOR */

C/adtdefs.c

@@ -176,6 +176,8 @@ LookupAtom(char *atom)
   NOfAtoms++;
   /* add new atom to start of chain */
   ae = (AtomEntry *) Yap_AllocAtomSpace((sizeof *ae) + strlen(atom) + 1);
+  if (ae == NULL)
+    return NIL;
   na = AbsAtom(ae);
   ae->PropsOfAE = NIL;
   if (ae->StrOfAE != atom)
@@ -193,7 +195,7 @@ LookupAtom(char *atom)
 Atom
 Yap_LookupAtom(char *atom)
 {				/* lookup atom in atom table            */
-  return(LookupAtom(atom));
+  return LookupAtom(atom);
 }
 
 Atom
@@ -222,7 +224,7 @@ Yap_LookupAtomWithAddress(char *atom, AtomEntry *ae)
   a = HashChain[hash].Entry;
   /* search atom in chain */
   if (SearchAtom(p, a) != NIL) {
-    Yap_Error(FATAL_ERROR,TermNil,"repeated initialisation for atom %s", ae);
+    Yap_Error(INTERNAL_ERROR,TermNil,"repeated initialisation for atom %s", ae);
     WRITE_UNLOCK(HashChain[hash].AERWLock);
     return;
   }
@@ -842,7 +844,7 @@ Yap_GetName(char *s, UInt max, Term t)
   register Int i;
 
   if (IsVarTerm(t) || !IsPairTerm(t))
-    return (FALSE);
+    return FALSE;
   while (IsPairTerm(t)) {
     Head = HeadOfTerm(t);
     if (!IsNumTerm(Head))
@@ -857,7 +859,7 @@ Yap_GetName(char *s, UInt max, Term t)
     }
   }
   *s = '\0';
-  return (TRUE);
+  return TRUE;
 }
 
 #ifdef SFUNC

C/arith0.c

@@ -211,6 +211,10 @@ Yap_InitConstExps(void)
 
   for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
     AtomEntry *ae = RepAtom(Yap_LookupAtom(InitConstTab[i].OpName));
+    if (ae == NULL) {
+      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitConstExps");
+      return;
+    }
     WRITE_LOCK(ae->ARWLock);
     if (Yap_GetExpPropHavingLock(ae, 0)) {
       WRITE_UNLOCK(ae->ARWLock);

C/arith1.c

@@ -2072,6 +2072,10 @@ Yap_InitUnaryExps(void)
 
   for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
     AtomEntry *ae = RepAtom(Yap_LookupAtom(InitUnTab[i].OpName));
+    if (ae == NULL) {
+      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitUnaryExps");
+      return;
+    }
     WRITE_LOCK(ae->ARWLock);
     if (Yap_GetExpPropHavingLock(ae, 1)) {
       WRITE_UNLOCK(ae->ARWLock);
@@ -2099,6 +2103,10 @@ Yap_ReInitUnaryExps(void)
   for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
     AtomEntry *ae = RepAtom(Yap_FullLookupAtom(InitUnTab[i].OpName));
 
+    if (ae == NULL) {
+      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at ReInitUnaryExps");
+      return FALSE;
+    }
     WRITE_LOCK(ae->ARWLock);
     if ((p = Yap_GetExpPropHavingLock(ae, 1)) == NULL) {
       WRITE_UNLOCK(ae->ARWLock);
@@ -2107,6 +2115,6 @@ Yap_ReInitUnaryExps(void)
     RepExpProp(p)->FOfEE.unary = InitUnTab[i].f;
     WRITE_UNLOCK(ae->ARWLock);
   }
-  return(TRUE);
+  return TRUE;
 }
 

C/c_interface.c

@@ -10,8 +10,11 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2005-02-08 18:04:47 $,$Author: vsc $						 *
+* Last rev:	$Date: 2005-03-01 22:25:08 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.60  2005/02/08 18:04:47  vsc
+* library_directory may not be deterministic (usually it isn't).
+*
 * Revision 1.59  2004/12/08 00:56:35  vsc
 * missing ;
 *
@@ -388,13 +391,18 @@ YAP_AtomName(Atom a)
 X_API Atom
 YAP_LookupAtom(char *c)
 {
-  Atom a = Yap_LookupAtom(c);
+  Atom a;
-  if (ActiveSignals & YAP_CDOVF_SIGNAL) {
+
+  while (TRUE) {
+    a = Yap_LookupAtom(c);
+    if (a == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
       if (!Yap_growheap(FALSE, 0, NULL)) {
 	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
       }
-  }
+    } else {
       return a;
+    }
+  }
 }
 
 X_API Atom
@@ -402,13 +410,16 @@ YAP_FullLookupAtom(char *c)
 {
   Atom at;
 
+  while (TRUE) {
     at = Yap_FullLookupAtom(c);
-  if (ActiveSignals & YAP_CDOVF_SIGNAL) {
+    if (at == NIL || (ActiveSignals & YAP_CDOVF_SIGNAL)) {
       if (!Yap_growheap(FALSE, 0, NULL)) {
 	Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage);
       }
+    } else {
+      return at;
+    }
   }
-  return(at);
 }
 
 X_API Term

C/dlmalloc.c

@@ -264,8 +264,8 @@ static int largebin_index(unsigned int sz) {
        -1 - no bins sorted (not recommended!)
 */
 
-#define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE 
+/*#define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE */
-/* #define FIRST_SORTED_BIN_SIZE 65536 */
+#define FIRST_SORTED_BIN_SIZE 2056
 
 /*
   Unsorted chunks

C/errors.c

@@ -372,7 +372,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
   int psize = YAP_BUF_SIZE;
 
 #if DEBUG
-  fprintf(stderr,"***** Processing Error %d (%x,%x) ***\n", type, ActiveSignals,Yap_PrologMode);
+  /*  fprintf(stderr,"***** Processing Error %d (%x,%x) %s***\n", type, ActiveSignals,Yap_PrologMode,format);*/
 #endif
   if (type == INTERRUPT_ERROR) {
     fprintf(stderr,"%% YAP exiting: cannot handle signal %d\n",
@@ -399,6 +399,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
   }
   /* must do this here */
   if (type == FATAL_ERROR
+      || type == INTERNAL_ERROR
 #if USE_SYSTEM_MALLOC 
       || !Yap_heap_regs
 #else
@@ -425,7 +426,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
     error_exit_yap (1);
   }
   if (P == (yamop *)(FAILCODE))
-   return(P);
+   return P;
   /* PURE_ABORT may not have set where correctly, BootMode may not have the data terms ready */
   if (type == PURE_ABORT || Yap_PrologMode & BootMode) {
     where = TermNil;

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2005-02-25 00:09:06 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-03-01 22:25:08 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.117  2005/02/25 00:09:06  vsc
+* fix fix, otherwise I'd remove two choice-points :-(.
+*
 * Revision 1.116  2005/02/24 21:46:39  vsc
 * Improve error handling routine, trying to make it more robust.
 * Improve hole handling in stack expansion
@@ -5560,7 +5563,7 @@ kill_clause(yamop *ipc, yamop *bg, yamop *lt, path_stack_entry *sp0, PredEntry *
 	  codep = NEXTOP(codep, p);
 	  break;
 	default:
-	  Yap_Error(FATAL_ERROR, TermNil, "Invalid Opcode %d", op);
+	  Yap_Error(INTERNAL_ERROR, TermNil, "Invalid Opcode %d", op);
 	  return sp;
 	}
       }
@@ -5777,7 +5780,7 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
       ocodep = NEXTOP(ocodep, p);
       break;
     default:
-      Yap_Error(FATAL_ERROR, TermNil, "Invalid Opcode");
+      Yap_Error(INTERNAL_ERROR, TermNil, "Invalid Opcode");
     }
   }
   if (flag == RECORDZ) {

C/scanner.c

@@ -745,7 +745,15 @@ Yap_tokenizer(int inp_stream)
       *charp++ = '\0';
       if (!isvar) {
 	/* don't do this in iso */
-	t->TokInfo = Unsigned(Yap_LookupAtom(TokImage));
+	Atom ae = Yap_LookupAtom(TokImage);
+	if (ae == NIL) {
+	  Yap_ErrorMessage = "Code Space Overflow";
+	  if (p)
+	    p->TokInfo = eot_tok;
+	  /* serious error now */
+	  return l;
+	}
+	t->TokInfo = Unsigned(ae);
 	Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
 	if (ch == '(')
 	  solo_flag = FALSE;

C/stdpreds.c

@@ -11,8 +11,12 @@
 * File:		stdpreds.c						 *
 * comments:	General-purpose C implemented system predicates		 *
 *									 *
-* Last rev:     $Date: 2005-02-21 16:50:04 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-03-01 22:25:09 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.82  2005/02/21 16:50:04  vsc
+* amd64 fixes
+* library fixes
+*
 * Revision 1.81  2005/02/08 04:05:35  vsc
 * fix mess with add clause
 * improves on sigsegv handling
@@ -1005,17 +1009,20 @@ p_name(void)
       NewT = Yap_StringToList(String);
       if (!IsVarTerm(t) && !IsPairTerm(t) && t != TermNil) {
 	Yap_Error(TYPE_ERROR_LIST,ARG2,"name/2");
-	return(FALSE);
+	return FALSE;
       }
-      return (Yap_unify(NewT, ARG2));
+      return Yap_unify(NewT, ARG2);
     } else {
       Yap_Error(TYPE_ERROR_ATOMIC,AtomNameT,"name/2");
       return(FALSE);
     }
   }
   s = String = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
+  if (s == NULL) {
+    return FALSE;
+  }
   if (!IsVarTerm(t) && t == MkAtomTerm(AtomNil)) {
-    return (Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom(""))));
+    return Yap_unify_constant(ARG1, MkAtomTerm(Yap_LookupAtom("")));
   }
   while (!IsVarTerm(t) && IsPairTerm(t)) {
     Term            Head;
@@ -1023,23 +1030,25 @@ p_name(void)
     Head = HeadOfTerm(t);
     if (IsVarTerm(Head)) {
       Yap_Error(INSTANTIATION_ERROR,Head,"name/2");
-      return(FALSE);
+      return FALSE;
     }
     if (!IsIntTerm(Head)) {
       Yap_Error(TYPE_ERROR_INTEGER,Head,"name/2");
-      return(FALSE);
+      return FALSE;
     }
     i = IntOfTerm(Head);
     if (i < 0 || i > 255) {
       if (i<0)
 	Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,Head,"name/2");
-      return(FALSE);
+      return FALSE;
     }
-    if (s+1 == (char *)AuxSp) {
+    if (s+1 >= (char *)AuxSp-1024) {
       char *nString;
       
       *H++ = t;
       nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0, NULL))->StrOfAE;
+      if (!nString)
+	return FALSE;
       t = *--H;
       s = nString+(s-String);
       String = nString;
@@ -1056,10 +1065,10 @@ p_name(void)
     if ((NewT = get_num(String)) == TermNil) {
       NewT = MkAtomTerm(Yap_LookupAtom(String));
     }
-    return (Yap_unify_constant(ARG1, NewT));
+    return Yap_unify_constant(ARG1, NewT);
   } else {
     Yap_Error(TYPE_ERROR_LIST,t,"name/2");
-    return(FALSE);
+    return FALSE;
   }
 }
 

C/sysbits.c

@@ -1170,7 +1170,7 @@ SearchForTrailFault(void)
     /*    my_signal_info(SIGSEGV, HandleSIGSEGV); */
   } else
 #endif /* OS_HANDLES_TR_OVERFLOW */
-    Yap_Error(FATAL_ERROR, TermNil,
+    Yap_Error(INTERNAL_ERROR, TermNil,
 	  "likely bug in YAP, segmentation violation");
 }
 

C/unify.c

@@ -586,7 +586,7 @@ InitReverseLookupOpcode(void)
   if (OP_RTABLE == NULL)
     OP_RTABLE = (opentry *)Yap_AllocCodeSpace(OP_HASH_SIZE*sizeof(struct opcode_tab_entry));
   if (OP_RTABLE == NULL) {
-    Yap_Error(FATAL_ERROR, TermNil,
+    Yap_Error(INTERNAL_ERROR, TermNil,
 	  "Couldn't obtain space for the reverse translation opcode table");
   }
   opeptr = OP_RTABLE;