change array semantics to allow creating same array several times.

implement SWI style global variables.


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

C/arrays.c

@@ -149,7 +149,12 @@ AccessNamedArray(Atom a, Int indx)
 
   READ_LOCK(ae->ARWLock);
   pp = RepArrayProp(ae->PropsOfAE);
-  while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
+  while (!EndOfPAEntr(pp) &&
+	 pp->KindOfPE != ArrayProperty
+#if THREADS
+	 && pp->owner_id != worker_id
+#endif
+	 )
     pp = RepArrayProp(pp->NextOfPE);
   READ_UNLOCK(ae->ARWLock);
 
@@ -427,7 +432,9 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae)
   p->NextOfPE = ae->PropsOfAE;
   INIT_RWLOCK(p->ArRWLock);
   ae->PropsOfAE = AbsArrayProp(p);
-
+#if THREADS
+  p->owner_id = worker_id;
+#endif
   InitNamedArray(p, dim);
   p->NextArrayE = DynArrayList;
   DynArrayList = p;
@@ -668,7 +675,12 @@ p_create_array(void)
 
     WRITE_LOCK(ae->ARWLock);
     pp = RepProp(ae->PropsOfAE);
-    while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
+    while (!EndOfPAEntr(pp) &&
+	   pp->KindOfPE != ArrayProperty
+#if THREADS
+	   && pp->owner_id != worker_id
+#endif	   
+	   )
       pp = RepProp(pp->NextOfPE);
     if (EndOfPAEntr(pp)) {
       if (H+1+size > ASP-1024) {
@@ -686,10 +698,13 @@ p_create_array(void)
       ArrayEntry *app = (ArrayEntry *) pp;
 
       WRITE_UNLOCK(ae->ARWLock);
-      if (!IsVarTerm(app->ValueOfVE) || !IsUnboundVar(&app->ValueOfVE))
+      if (!IsVarTerm(app->ValueOfVE)
+	  || !IsUnboundVar(&app->ValueOfVE)) {
+	if (size == app->ArrayEArity)
+	  return TRUE;
 	Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"create_array",
 	      ae->StrOfAE);
-      else {
+      } else {
 	if (H+1+size > ASP-1024) {
 	  if (!Yap_gc(2, ENV, P)) {
 	    Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@@ -790,15 +805,18 @@ p_create_static_array(void)
 	return (TRUE);
       } else {
 	Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"cannot create static array over dynamic array");
-	return (FALSE);
+	return FALSE;
       }
     } else {
+      if (pp->ArrayEArity  == -size &&
+	  pp->ArrayType == props)
+	  return TRUE;
       Yap_Error(PERMISSION_ERROR_CREATE_ARRAY,t,"cannot create static array over static array");
-      return (FALSE);
+      return FALSE;
     }
   }
   Yap_Error(TYPE_ERROR_ATOM,t,"create static array");
-  return (FALSE);
+  return FALSE;
 }
 
 /* has a static array associated (+Name) */

C/utilpreds.c

@@ -855,6 +855,29 @@ p_term_variables(void)	/* variables in term t		 */
   return Yap_unify(ARG2,out);
 }
 
+static Int 
+p_term_variables3(void)	/* variables in term t		 */
+{
+  Term t = Deref(ARG1);
+  Term out;
+
+  if (IsVarTerm(t)) {
+    return Yap_unify(MkPairTerm(t,ARG3), ARG2);
+  }  else if (IsPrimitiveTerm(t)) {
+    return Yap_unify(ARG2, ARG3);
+  } else if (IsPairTerm(t)) {
+    out = vars_in_complex_term(RepPair(t)-1,
+			       RepPair(t)+1, ARG3);
+  }
+  else {
+    Functor f = FunctorOfTerm(t);
+    out = vars_in_complex_term(RepAppl(t),
+			       RepAppl(t)+
+			       ArityOfFunctor(f), ARG3);
+  }
+  return Yap_unify(ARG2,out);
+}
+
 static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end)
 {
 
@@ -1923,6 +1946,7 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag|HiddenPredFlag);
   CurrentModule = TERMS_MODULE;
   Yap_InitCPred("term_variables", 2, p_term_variables, SafePredFlag);
+  Yap_InitCPred("term_variables", 3, p_term_variables3, SafePredFlag);
   Yap_InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
   Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
   Yap_InitCPred("variant", 2, p_variant, 0);

H/Atoms.h

@@ -1,10 +1,3 @@
-
-
-
-
-
-
-
 /*************************************************************************
 *									 *
 *	 YAP Prolog   %W% %G%

H/Yatom.h

@@ -942,6 +942,9 @@ typedef struct array_entry
   rwlock_t ArRWLock;		/* a read-write lock to protect the entry */
 #endif
   struct array_entry *NextArrayE;	/* Pointer to the actual array               */
+#if THREADS
+  unsigned int owner_id;
+#endif
   Term ValueOfVE;		/* Pointer to the actual array          */
 } ArrayEntry;
 

library/swi.yap

@@ -1,14 +1,20 @@
 
 :- module(swi, [
-	absolute_file_name/3,
-	concat_atom/3,
-	setenv/2,
-	nth1/3,
-	forall/2,
-	between/3,
-	term_to_atom/2,
-	concat_atom/2,
-	volatile/1]).
+		absolute_file_name/3,
+		concat_atom/3,
+		setenv/2,
+		nth1/3,
+		forall/2,
+		between/3,
+		term_to_atom/2,
+		concat_atom/2,
+		volatile/1,
+		b_setval/2,
+		b_getval/2,
+		nb_setval/2,
+		nb_getval/2,
+		nb_current/2,
+		nb_delete/1]).
 
 
 :- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]).
@@ -101,3 +107,24 @@ between(I0,I,J) :- I0 < I,
 	I1 is I0+1,
 	between(I1,I,J).
 
+b_getval(GlobalVariable,Value) :-
+	array_element(GlobalVariable,0,Value).
+
+b_setval(GlobalVariable,Value) :-
+	array(GlobalVariable,1),
+	update_array(GlobalVariable,0,Value).
+
+nb_getval(GlobalVariable,Value) :-
+	array_element(GlobalVariable,0,Value).
+
+nb_setval(GlobalVariable,Value) :-
+	static_array(GlobalVariable,1,term),
+	update_array(GlobalVariable,0,Value).
+
+nb_delete(GlobalVariable) :-
+	close_static_array(GlobalVariable).
+
+nb_current(GlobalVariable,Val) :-
+	static_array_properties(GlobalVariable,1,term),
+	array_element(GlobalVariable,0,Val).
+

library/terms.yap

@@ -19,6 +19,7 @@
 	term_hash/2,
 	term_hash/4,
 	term_variables/2,
+	term_variables/3,
 	variant/2,
 	subsumes/2,
 	subsumes_chk/2,