extend arrays with nb_terms so that we can implement nb_ builtins

correctly.


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

C/arrays.c

@@ -141,6 +141,62 @@ STATIC_PROTO(Int  p_close_static_array, (void));
 STATIC_PROTO(Int  p_access_array, (void));
 STATIC_PROTO(Int  p_assign_static, (void));
 
+static Term
+GetTermFromArray(DBTerm *ref)
+{
+  if (ref != NULL) {
+    Term TRef;
+
+    while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
+      if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
+	Yap_Error_TYPE = YAP_NO_ERROR;
+	if (!Yap_growglobal(NULL)) {
+	  Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
+	  return TermNil;
+	}
+      } else {
+	Yap_Error_TYPE = YAP_NO_ERROR;
+	if (!Yap_gc(3, ENV, CP)) {
+	  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	  return TermNil;
+	}
+      }
+    }
+    return TRef;
+  } else {
+    P = (yamop *)FAILCODE;
+    return TermNil;
+  }
+}
+
+static Term
+GetNBTerm(live_term *ar, Int indx)
+{
+  /* The object is now in use */
+  Term livet = ar[indx].tlive;
+  Term termt = ar[indx].tstore;
+
+  if (!IsVarTerm(livet)
+      || !IsUnboundVar(&(ar[indx].tlive))) {
+    return livet;
+  }
+  if (IsVarTerm(termt)) {
+    Term livet = MkVarTerm();
+    Bind(&(ar[indx].tlive), livet);
+    return livet;
+  } else if (IsAtomicTerm(termt)) {
+    Bind(&(ar[indx].tlive), termt);
+    return termt;
+  } else {
+    DBTerm *ref = (DBTerm *)RepAppl(termt);
+    if ((livet = GetTermFromArray(ref)) == TermNil) {
+      return TermNil;
+    }
+    Bind(&(ar[indx].tlive), livet);
+    return livet;
+  }
+}
+
 static Term
 AccessNamedArray(Atom a, Int indx)
 {
@@ -263,36 +319,23 @@ AccessNamedArray(Atom a, Int indx)
 	    P = (yamop *)FAILCODE;
 	    TRef = TermNil;
 	  }
-	  return (TRef);
+	  return TRef;
+	}
+      case array_of_nb_terms:
+	{
+	  /* The object is now in use */
+	  Term out = GetNBTerm(ptr->ValueOfVE.lterms, indx);
+
+	  READ_UNLOCK(ptr->ArRWLock);
+	  return out;
 	}
       case array_of_terms:
 	{
 	  /* The object is now in use */
 	  DBTerm *ref = ptr->ValueOfVE.terms[indx];
-	  Term TRef;
 
 	  READ_UNLOCK(ptr->ArRWLock);
-	  if (ref != NULL) {
+	  return GetTermFromArray(ref);
-	    while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
-	      if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
-		Yap_Error_TYPE = YAP_NO_ERROR;
-		if (!Yap_growglobal(NULL)) {
-		  Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
-		  return TermNil;
-		}
-	      } else {
-		Yap_Error_TYPE = YAP_NO_ERROR;
-		if (!Yap_gc(3, ENV, CP)) {
-		  Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-		  return(TermNil);
-		}
-	      }
-	    }
-	  } else {
-	    P = (yamop *)FAILCODE;
-	    TRef = TermNil;
-	  }
-	  return (TRef);
 	}
       default:
 	READ_UNLOCK(ptr->ArRWLock);
@@ -461,11 +504,12 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
   case array_of_ptrs:
     asize = array_size*sizeof(AtomEntry *);
     break;
-  case array_of_dbrefs:
   case array_of_atoms:
-    asize = array_size*sizeof(Term);
-    break;
   case array_of_terms:
+  case array_of_nb_terms:
+    asize = array_size*sizeof(live_term);
+    break;
+  case array_of_dbrefs:
     asize = array_size*sizeof(DBRef);
     break;
   }
@@ -535,6 +579,12 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
       for (i = 0; i < dim; i++)
 	p->ValueOfVE.terms[i] = NULL;
       break;
+    case array_of_nb_terms:
+      for (i = 0; i < dim; i++) {
+	RESET_VARIABLE(&(p->ValueOfVE.lterms[i].tlive));
+	p->ValueOfVE.lterms[i].tstore = TermNil;
+      }
+      break;
     }
   } else {
     /* external array */
@@ -614,6 +664,17 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
     for (i = mindim; i<dim; i++)
       pp->ValueOfVE.terms[i] = NULL;
     break;
+  case array_of_nb_terms:
+    for (i = 0; i <mindim; i++) {
+      Term tlive = pp->ValueOfVE.lterms[i].tlive;
+      if (IsVarTerm(tlive) && IsUnboundVar(&(pp->ValueOfVE.lterms[i].tlive))) {
+	RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
+      } else {
+	pp->ValueOfVE.lterms[i].tlive = tlive;
+      }
+      pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore;
+    }
+    break;
   }
   WRITE_UNLOCK(pp->ArRWLock);
 }
@@ -767,6 +828,8 @@ p_create_static_array(void)
       props = array_of_uchars;
     else if (!strcmp(atname, "term"))
       props = array_of_terms;
+    else if (!strcmp(atname, "nb_term"))
+      props = array_of_nb_terms;
     else {
       Yap_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array");
       return(FALSE);
@@ -862,6 +925,8 @@ p_static_array_properties(void)
 	return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("unsigned char"))));
       case array_of_terms:
 	return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("term"))));
+      case array_of_nb_terms:
+	return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("nb_term"))));
       case array_of_atoms:
 	return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("atom"))));
       }
@@ -1622,6 +1687,31 @@ p_assign_static(void)
     }
     break;
 
+  case array_of_nb_terms:
+
+    RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tlive));
+    {
+      Term told = ptr->ValueOfVE.lterms[indx].tstore;
+      Term tnew = Deref(ARG3);
+      /* recover space */
+      if (IsApplTerm(told)) {
+	Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
+      }
+      if (IsVarTerm(tnew)) {
+	RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore));
+      } else if (IsAtomicTerm(tnew)) {
+	ptr->ValueOfVE.lterms[indx].tstore = tnew;
+      } else {
+	DBTerm *new = Yap_StoreTermInDB(tnew,3);
+	if (!new) {
+	  WRITE_UNLOCK(ptr->ArRWLock);
+	  return FALSE;
+	}
+	ptr->ValueOfVE.lterms[indx].tstore = AbsAppl((CELL *)new);
+      }
+    }
+    break;
+
   case array_of_terms:
     {
       
@@ -1633,7 +1723,7 @@ p_assign_static(void)
       ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(Deref(ARG3),3);
       if (ptr->ValueOfVE.terms[indx] == NULL){
 	WRITE_UNLOCK(ptr->ArRWLock);
-	return(FALSE);
+	return FALSE;
       }
     }
     break;
@@ -1986,32 +2076,33 @@ p_static_array_to_term(void)
 	  for (indx=0; indx < dim; indx++) {
 	    /* The object is now in use */
 	    DBTerm *ref = pp->ValueOfVE.terms[indx];
-	    Term TRef;
 
-	    if (ref != NULL) {
+	    Term TRef = GetTermFromArray(ref);
-	      while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
+
-		if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
+	    if (P == FAILCODE) {
-		  Yap_Error_TYPE = YAP_NO_ERROR;
+	      return FALSE;
-		  if (!Yap_growglobal(NULL)) {
-		    Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
-		    return TermNil;
-		  }
-		} else {
-		  Yap_Error_TYPE = YAP_NO_ERROR;
-		  if (!Yap_gc(3, YENV, P)) {
-		    Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-		    return TermNil;
-		  }
-		}
-	      }
-	    } else {
-	      P = (yamop *)FAILCODE;
-	      TRef = TermNil;
 	    }
+
 	    *sptr++ = TRef;
 	  }
 	}
 	break;
+      case array_of_nb_terms:
+	{
+	  CELL *sptr = H;
+	  H += dim;
+	  for (indx=0; indx < dim; indx++) {
+	    /* The object is now in use */
+	    Term To = GetNBTerm(pp->ValueOfVE.lterms, indx);
+
+	    if (P == FAILCODE) {
+	      return FALSE;
+	    }
+
+	    *sptr++ = To;
+	  }
+	}
+	break;
       case array_of_atoms:
 	for (indx=0; indx < dim; indx++) {
 	  Term out;
@@ -2026,7 +2117,7 @@ p_static_array_to_term(void)
       return Yap_unify(AbsAppl(base),ARG2);
     }
   }
-  return(FALSE);
+  return FALSE;
 }
 
 static Int

H/Yatom.h

@@ -960,9 +960,16 @@ typedef enum
   array_of_ptrs,
   array_of_atoms,
   array_of_dbrefs,
+  array_of_nb_terms,
   array_of_terms
 } static_array_types;
 
+typedef  struct {
+  Term tlive;
+  Term tstore;
+} live_term;
+
+
 typedef union
 {
   Int *ints;
@@ -973,6 +980,7 @@ typedef union
   Term *atoms;
   Term *dbrefs;
   DBTerm **terms;
+  live_term *lterms;
 } statarray_elements;
 
 /* next, the actual data structure */

H/rheap.h

@@ -11,8 +11,11 @@
 * File:		rheap.h							 *
 * comments:	walk through heap code					 *
 *									 *
-* Last rev:     $Date: 2005-09-09 17:24:39 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-10-19 19:00:48 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.54  2005/09/09 17:24:39  vsc
+* a new and hopefully much better implementation of atts.
+*
 * Revision 1.53  2005/08/01 15:40:38  ricroc
 * TABLING NEW: better support for incomplete tabling
 *
@@ -545,7 +548,9 @@ RestoreDBEntry(DBRef dbr)
     fprintf(stderr, " a var\n");
 #endif
   RestoreDBTerm(&(dbr->DBT));
-  dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
+  if (dbr->Parent) {
+    dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
+  }
   if (dbr->Code != NULL)
     dbr->Code = PtoOpAdjust(dbr->Code);
   if (dbr->Prev != NULL)
@@ -836,6 +841,49 @@ restore_static_array(StaticArrayEntry *ae)
       }
     }
   return;
+  case array_of_nb_terms:
+    {
+      live_term *base = (live_term *)AddrAdjust((ADDR)(ae->ValueOfVE.lterms));
+      Int i;
+
+      ae->ValueOfVE.lterms = base;
+      if (ae != 0L) {
+	for (i=0; i < sz; i++,base++) {
+	  Term reg = base->tlive;
+	  if (IsVarTerm(reg)) {
+	    CELL *var = (CELL *)reg;
+
+	    if (IsOldGlobalPtr(var)) {
+	      base->tlive = (CELL)PtoGloAdjust(var);
+	    } else {
+	      base->tlive = (CELL)PtoHeapCellAdjust(var);
+	    }
+	  } else if (IsAtomTerm(reg)) {
+	    base->tlive = AtomTermAdjust(reg);
+	  } else if (IsApplTerm(reg)) {
+	    CELL *db = RepAppl(reg);
+	    db = PtoGloAdjust(db);
+	    base->tlive = AbsAppl(db);
+	  } else if (IsApplTerm(reg)) {
+	    CELL *db = RepPair(reg);
+	    db = PtoGloAdjust(db);
+	    base->tlive = AbsPair(db);
+	  }
+
+	  reg = base->tstore;
+	  if (IsVarTerm(reg)) {
+	    base->tstore = (Term)GlobalAddrAdjust((ADDR)reg);
+	  } else if (IsAtomTerm(reg)) {
+	    base->tstore = AtomTermAdjust(reg);
+	  } else {
+	    DBTerm *db = (DBTerm *)RepAppl(reg);
+	    db = DBTermAdjust(db);
+	    RestoreDBTerm(db);
+	    base->tstore = AbsAppl((CELL *)db);
+	  }
+	}
+      }
+    }
   case array_of_terms:
     {
       DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms));

library/swi.yap

@@ -114,7 +114,7 @@ prolog:nb_getval(GlobalVariable,Value) :-
 	array_element(GlobalVariable,0,Value).
 
 prolog:nb_setval(GlobalVariable,Value) :-
-	static_array(GlobalVariable,1,term),
+	static_array(GlobalVariable,1,nb_term),
 	update_array(GlobalVariable,0,Value).
 
 prolog:nb_delete(GlobalVariable) :-