be more careful about error handling when storing DB terms

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

C/arrays.c

@@ -1534,6 +1534,10 @@ p_assign_static(void)
 	ReleaseTermFromDB(ref);
       }
       ptr->ValueOfVE.terms[indx] = StoreTermInDB(3,3);
+      if (ptr->ValueOfVE.terms[indx]){
+	WRITE_UNLOCK(ptr->ArRWLock);
+	return(FALSE);
+      }
     }
     break;
   }

C/bb.c

@@ -313,9 +313,8 @@ p_bb_update(void)
 
   ReleaseTermFromDB(p->Element);
   p->Element = StoreTermInDB(3,3);
-
   WRITE_UNLOCK(p->BBRWLock);
-  return(TRUE);
+  return(p->Element != NULL);
 }
 
 static Int

C/dbase.c

@@ -3968,6 +3968,8 @@ p_enqueue(void)
   } else
     father_key = (db_queue *)DBRefOfTerm(Father);
   x = StoreTermInDB(2, 2);
+  if (x == NULL)
+    return(FALSE);
   x->Parent = NULL;
   WRITE_LOCK(father_key->QRWLock);
   if (father_key->LastInQueue != NULL)

C/utilpreds.c

@@ -666,7 +666,6 @@ p_variables_in_term(void)	/* variables in term t		 */
   return(unify(ARG3,out));
 }
 
-
 static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end)
 {
 
@@ -910,10 +909,11 @@ p_ground(void)			/* ground(+T)		 */
 
 static Int var_in_complex_term(register CELL *pt0,
 			       register CELL *pt0_end,
-			       Term t)
+			       Term v)
 {
 
   register CELL **to_visit = (CELL **)(HeapTop + sizeof(CELL));
+  register tr_fr_ptr TR0 = TR;
 
  loop:
   while (pt0 < pt0_end) {
@@ -922,8 +922,8 @@ static Int var_in_complex_term(register CELL *pt0,
     ++ pt0;
     ptd0 = pt0;
     d0 = *ptd0;
-    deref_head(d0, vars_in_term_unk);
+    deref_head(d0, var_in_term_unk);
-  vars_in_term_nvar:
+  var_in_term_nvar:
     {
       if (IsPairTerm(d0)) {
 #ifdef RATIONAL_TREES
@@ -974,18 +974,15 @@ static Int var_in_complex_term(register CELL *pt0,
     }
     
 
-    deref_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
+    deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar);
-    if ((CELL)ptd0 == t) { /* we found it */
+    if ((CELL)ptd0 == v) { /* we found it */
-#ifdef RATIONAL_TREES
+      clean_tr(TR0);
-      while (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
-	to_visit -= 3;
-	pt0 = to_visit[0];
-	pt0_end = to_visit[1];
-	*pt0 = (CELL)to_visit[2];
-      }
-#endif
       return(TRUE);
     }
+    /* do or pt2 are unbound  */
+    *ptd0 = TermNil;
+    /* next make sure noone will see this as a variable again */ 
+    TrailTerm(TR++) = (CELL)ptd0;
   }
   /* Do we still have compound terms to visit */
   if (to_visit > (CELL **)(HeapTop + sizeof(CELL))) {
@@ -1001,16 +998,19 @@ static Int var_in_complex_term(register CELL *pt0,
 #endif
     goto loop;
   }
+  clean_tr(TR0);
   return(FALSE);
 }
  
-Int 
+static Int 
 var_in_term(Term v, Term t)		/* variables in term t		 */
 {
 
-  if (IsPrimitiveTerm(t)) 
+  if (IsVarTerm(t)) {
+    return(v == t);
+  } else if (IsPrimitiveTerm(t)) {
     return(FALSE);
-  else if (IsPairTerm(t)) {
+  } else if (IsPairTerm(t)) {
     return(var_in_complex_term(RepPair(t)-1,
 			       RepPair(t)+1, v));
   }
@@ -1019,6 +1019,12 @@ var_in_term(Term v, Term t)		/* variables in term t		 */
 				  ArityOfFunctor(FunctorOfTerm(t)),v));
 }
 
+static Int
+p_var_in_term(void)
+{
+  return(var_in_term(Deref(ARG2), Deref(ARG1)));
+}
+
 /* The code for TermHash was originally contributed by Gertjen Van Noor */
 
 /* This code with max_depth == -1 will loop for infinite trees */
@@ -1550,6 +1556,7 @@ void InitUtilCPreds(void)
   InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
   InitCPred("ground", 1, p_ground, SafePredFlag);
   InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag);
+  InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
   InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag);
   InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
   InitCPred("variant", 2, p_variant, SafePredFlag);

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.13 2002-02-26 15:51:54 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.14 2002-03-07 05:13:21 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -279,7 +279,6 @@ void	STD_PROTO(InitUserBacks,(void));
 
 /* utilpreds.c */
 Term	STD_PROTO(CopyTerm,(Term));
-Int     STD_PROTO(var_in_term, (Term, Term));
 void	STD_PROTO(InitUtilCPreds,(void));
 
 /* yap.c */

changes4.3.html

@@ -16,6 +16,25 @@
 
 <h2>Yap-4.3.21:</h2>
 <ul>
+	<li>NEW: variable_in_term/2 at library(terms).</li>
+	<li>FIXED: debugger would not step through [-F].</li>
+	<li>FIXED: unix(argv(L)) was doing bad type checking.</li>
+	<li>FIXED: assert((a:- m:[f])) would core dump.</li>
+	<li>FIXED: gc in dexecute should not use current Y, instead if
+	should look at parent's Y (Ines Dutra).</li>
+	<li>FIXED: do not loop on unbound metacalls.</li>
+	<li>FIXED: do not assert clauses if the predicate is active
+	and you had to abolish first.</li>
+	<li>FIXED: always allow asserting over static predicates.</li>
+	<li>FIXED: disable cache when checking whether static was
+	in use.</li>
+	<li>FIXED: heap overflow while storing db term.</li>
+	<li>FIXED: trust_fail should be preceeded by an sla.</li>
+	<li>FIXED: make sla point to current pred, get rid of current
+	pred in bitmap.</li>
+	<li>FIXED: MkVarTerm in c_interface.h (Christophe Billard)</li>
+	<li>FIXED: get rid of unnecessary USE_OFFSETS</li>
+	<li>FIXED: stupid limit on Heap Size with LowTags. (David Page)</li>
 	<li>FIXED: make fileerrors default for SICStus. (Nicos Angelopoulos)</li>
 	<li>FIXED: g(X) :- (Z is 2*X; a(Z)) Z cannot be seen as a free
 	var. (Nicos Angelopoulos).</li>

config.h.in

@@ -251,3 +251,10 @@
 
 /* Is fflush(NULL) clobbering input streams? */
 #undef BROKEN_FFLUSH_NULL
+
+/* sunpro cc */
+#ifdef __SUNPRO_CC
+#ifdef HAVE_GCC
+#undef HAVE_GCC
+#endif
+#endif

configure.in

@@ -42,6 +42,9 @@ AC_ARG_ENABLE(max-performance,
 AC_ARG_ENABLE(debug-yap,
 	[ --enable-debug-yap         enable C-debugging for YAP ],
 	debugyap="$enableval", debugyap=no)
+AC_ARG_ENABLE(cygwin,
+	[ --enable-cygwin            use cygwin library in WIN32 ],
+	cygwin="$enableval", cygwin=no)
 	
 AC_ARG_WITH(gmp,
 	[ --with-gmp[=DIR]           use GNU Multiple Precision in DIR],
@@ -242,18 +245,17 @@ dnl Check for libraries.
 dnl mingw does not get along well with libm
 dnl cygnus and mingw32 also need wsock32 to use sockets.
 dnl
-if test "$target_os" = "cygwin"
+if test "$target_os" = "cygwin" -a "$cygwin" = "no"
 then
-  if test "$CC" = "gcc"
+  CC="gcc  -mno-cygwin"
-  then
+  AC_CHECK_LIB(wsock32,main)
-    CC="gcc  -mno-cygwin"
+  INSTALL_COMMAND=install_mingw32
-    AC_CHECK_LIB(wsock32,main)
+  yap_cv_readline=no
-    INSTALL_COMMAND=install_mingw32
+  YAPLIB="libWYap.a"
-    yap_cv_readline=no
+  prefix="c:/Program\\ Files/Yap"
-  else
+  SHLIB_SUFFIX=".dll"
-    AC_CHECK_LIB(wsock32,main)
+  NEWSHOBJ="dll"
-    AC_CHECK_LIB(cygwin,main) 
+  YAPLIB=yap.dll
-  fi
 else
   INSTALL_COMMAND="install_unix"
   AC_CHECK_LIB(m,sin)
@@ -460,11 +462,6 @@ case $target_os in
         fi
 	;;
       *cyg*)
-        SHLIB_SUFFIX=".dll"
-        NEWSHOBJ="dll"
-	YAPLIB=yap.dll
-	YAPLIB="libWYap.a"
-	prefix="c:/Program\\ Files/Yap"
 	# gcc on cygwin seems to have trouble with longjmp
         # and -fomit-frame-point -DBP_FREE
 	C_PARSER_FLAGS="$C_INTERF_FLAGS"

docs/yap.tex

@@ -1,4 +1,4 @@
-\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
+<\input texinfo @c -*- mode: texinfo; coding: latin-1; -*-
 
 @c %**start of header
 @setfilename yap.info
@@ -7885,6 +7885,18 @@ efficiency. They are available through the
 
 @table @code
 
+@item acyclic_term(?@var{Term})
+@findex cyclic_term/1
+@syindex cyclic_term/1
+@cnindex cyclic_term/1
+Succeed if the argument @var{Term} is an acyclic term.
+
+@item cyclic_term(?@var{Term})
+@findex cyclic_term/1
+@syindex cyclic_term/1
+@cnindex cyclic_term/1
+Succeed if the argument @var{Term} is a cyclic term.
+
 @item term_hash(+@var{Term}, ?@var{Hash})
 @findex  term_hash/2
 @syindex term_hash/2
@@ -7938,6 +7950,13 @@ Succeed if @var{Term1} subsumes @var{Term2}.  Variables in term
 Succeed if @var{Term1} subsumes @var{Term2} but does not bind any
 variable in @var{Term1}.
 
+@item variable_in_term(?@var{Term},?@var{Var})
+@findex variable_in_term/2
+@snindex variable_in_term/2
+@cnindex variable_in_term/2
+Succeed if the second argument @var{Var} is a variable and occurs in
+term @var{Term}.
+
 
 
 @end table

library/terms.yap

@@ -23,7 +23,8 @@
 	subsumes/2,
 	subsumes_chk/2,
         cyclic_term/1,
-        acyclic_term/1
+        acyclic_term/1,
+        variable_in_term/2
     ]).
 
 term_hash(T,H) :-

pl/boot.yap

@@ -887,8 +887,8 @@ break :- '$get_value'('$break',BL), NBL is BL+1,
 '$consult'(X) :-
 	'$find_in_path'(X,Y,consult(X)),
 	'$open'(Y,'$csult',Stream,0), !,
-         '$record_loaded'(Stream),
+        '$record_loaded'(Stream),
-         '$consult'(X,Stream),
+        '$consult'(X,Stream),
 	'$close'(Stream).
 '$consult'(X) :-
 	throw(error(permission_error(input,stream,X),consult(X))).

pl/init.yap

@@ -102,7 +102,8 @@ system_mode(verbose,off) :- '$set_value'('$verbose',off).
    '$set_pred_module'(variant(_,_), terms),
    '$set_pred_module'(subsumes(_,_), terms),
    '$set_pred_module'(cyclic_term(_), terms),
-   '$set_pred_module'(acyclic_term(_,_), terms).
+   '$set_pred_module'(acyclic_term(_,_), terms),
+   '$set_pred_module'(variable_in_term(_,_), terms).
 
 :- '$set_value'('$user_module',user), '$protect'.