handle blob overflows.

C/agc.c

@@ -398,13 +398,25 @@ clean_atom_list(AtomHashEntry *HashPtr)
   while (atm != NIL) {
     AtomEntry *at =  RepAtom(atm);
     if (AtomResetMark(at) ||
-	at->PropsOfAE != NIL ||
+	( at->PropsOfAE != NIL && !IsBlob(at) ) ||
 	(GLOBAL_AGCHook != NULL && !GLOBAL_AGCHook(atm))) {
       patm = &(at->NextOfAE);
       atm = at->NextOfAE;
     } else {
       NOfAtoms--;
-      if (IsWideAtom(atm)) {
+      if (IsBlob(atm)) {
+	BlobPropEntry *b = RepBlobProp(at->PropsOfAE);
+	if (b->NextOfPE != NIL) {
+	  patm = &(at->NextOfAE);
+	  atm = at->NextOfAE;
+	  continue;
+	}
+	NOfAtoms++;
+	NOfBlobs--;
+	Yap_FreeCodeSpace((char *)b);
+	GLOBAL_agc_collected += sizeof(BlobPropEntry);
+	GLOBAL_agc_collected += sizeof(AtomEntry)+sizeof(size_t)+at->rep.blob->length;
+      } else if (IsWideAtom(atm)) {
 #ifdef DEBUG_RESTORE3
 	fprintf(stderr, "Purged %p:%S\n", at, at->WStrOfAE);
 #endif
@@ -478,6 +490,7 @@ atom_gc(USES_REGS1)
   mark_stacks(PASS_REGS1);
   restore_codes();
   clean_atoms();
+  NOfBlobsMax = NOfBlobs+(NOfBlobs/2+256< 1024 ? NOfBlobs/2+256 : 1024);
   YAPLeaveCriticalSection();
   agc_time = Yap_cputime()-time_start;
   GLOBAL_tot_agc_time += agc_time;

C/exec.c

@@ -1120,20 +1120,20 @@ Yap_execute_goal(Term t, int nargs, Term mod)
   if (pe == NIL) {
     return(CallMetaCall(mod PASS_REGS));
   }
-  PELOCK(81,ppe);
+  PELOCK(81,RepPredProp(pe));
   if (IsAtomTerm(t)) {
-    CodeAdr = RepPredProp (pe)->CodeOfPred;
+    CodeAdr = ppe->CodeOfPred;
     UNLOCK(ppe->PELock);
     out = do_goal(t, CodeAdr, 0, pt, FALSE PASS_REGS);
   } else {
     Functor f = FunctorOfTerm(t);
-    CodeAdr = RepPredProp (pe)->CodeOfPred;
+    CodeAdr = ppe->CodeOfPred;
     UNLOCK(ppe->PELock);
     out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE PASS_REGS);
   }
 
   if (out == 1) {
-    choiceptr cut_B, old_B;
+    choiceptr cut_B;
     /* we succeeded, let's prune */
     /* restore the old environment */
     /* get to previous environment */
@@ -1162,8 +1162,6 @@ Yap_execute_goal(Term t, int nargs, Term mod)
     }
 #endif /* TABLING */
     B = cut_B;
-    /* find out where we have the old arguments */
-    old_B = ((choiceptr)(ENV-(EnvSizeInCells+nargs+1)))-1;
     CP   = saved_cp;
     P    = saved_p;
     ASP  = ENV;

C/grow.c

@@ -1421,15 +1421,17 @@ Yap_growheap(int fix_code, UInt in_size, void *cip)
 {
   CACHE_REGS
   int res;
+  int blob_overflow = (NOfBlobs > NOfBlobsMax);
 
-  if (NOfAtoms > 2*AtomHashTableSize) {
+  if (NOfAtoms > 2*AtomHashTableSize || blob_overflow) {
     UInt n = NOfAtoms;
     if (GLOBAL_AGcThreshold)
       Yap_atom_gc( PASS_REGS1 );
     /* check if we have a significant improvement from agc */
-    if (n > NOfAtoms+ NOfAtoms/10 ||
+    if (!blob_overflow &&
-	/* +1 = make sure we didn't lose the current atom */
+	(n > NOfAtoms+ NOfAtoms/10 ||
-	NOfAtoms+1 > 2*AtomHashTableSize) {
+	 /* +1 = make sure we didn't lose the current atom */
+	 NOfAtoms+1 > 2*AtomHashTableSize)) {
       res  = growatomtable( PASS_REGS1 );
     } else {
       LOCK(LOCAL_SignalLock);
@@ -1444,7 +1446,12 @@ Yap_growheap(int fix_code, UInt in_size, void *cip)
     if (res)
       return res;
   }
+#if USE_SYSTEM_MALLOC
+  P = Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"malloc failed");
+  res = -1;
+#else
   res=do_growheap(fix_code, in_size, (struct intermediates *)cip, NULL, NULL, NULL PASS_REGS);
+#endif
   LeaveGrowMode(GrowHeapMode);
   return res;
 }

H/dhstruct.h

@@ -302,3 +302,8 @@
 
 #define SWI_BlobTypes Yap_heap_regs->swi_blob_types
 #define SWI_Blobs Yap_heap_regs->swi_blobs
+#define NOfBlobs Yap_heap_regs->nofblobs
+#define NOfBlobsMax Yap_heap_regs->nofblobsmax
+#if defined(YAPOR) || defined(THREADS)
+#define SWI_Blobs_Lock Yap_heap_regs->swi_blobs_lock
+#endif

H/hstruct.h

@@ -302,3 +302,8 @@
 
   struct PL_blob_t  *swi_blob_types;
   struct AtomEntryStruct  *swi_blobs;
+  UInt  nofblobs;
+  UInt  nofblobsmax;
+#if defined(YAPOR) || defined(THREADS)
+  lockvar  swi_blobs_lock;
+#endif

H/ihstruct.h

@@ -302,3 +302,8 @@
 
   SWI_BlobTypes = NULL;
   SWI_Blobs = NULL;
+  NOfBlobs = 0;
+  NOfBlobsMax = 256;
+#if defined(YAPOR) || defined(THREADS)
+  INIT_LOCK(SWI_Blobs_Lock);
+#endif

H/rhstruct.h

@@ -302,3 +302,8 @@
 
   RestoreSWIBlobTypes();
   RestoreSWIBlobs();
+
+
+#if defined(YAPOR) || defined(THREADS)
+  REINIT_LOCK(SWI_Blobs_Lock);
+#endif

library/dialect/swi/fli/blobs.c

@@ -51,11 +51,25 @@ PL_is_blob(term_t t, PL_blob_t **type)
   return TRUE;
 }
 
+void check_chain(void);
+
+void check_chain(void) {
+  AtomEntry *ae, *old;
+    ae = SWI_Blobs;
+    old = NULL;
+    while (ae) {
+      old = ae;
+      ae = RepAtom(ae->NextOfAE);
+    }
+}
+
 static AtomEntry *
 lookupBlob(void *blob, size_t len, PL_blob_t *type)
 {
   BlobPropEntry *b;
   AtomEntry *ae;
+
+  LOCK(SWI_Blobs_Lock);
   if (type->flags & PL_BLOB_UNIQUE) {
     /* just keep a linked chain for now */
     ae = SWI_Blobs;
@@ -63,26 +77,37 @@ lookupBlob(void *blob, size_t len, PL_blob_t *type)
       if (ae->PropsOfAE &&
 	  RepBlobProp(ae->PropsOfAE)->blob_t == type &&
 	  ae->rep.blob->length == len &&
-	  !memcmp(ae->rep.blob->data, blob, len))
+	  !memcmp(ae->rep.blob->data, blob, len)) {
+	UNLOCK(SWI_Blobs_Lock);
 	return ae;
+      }
       ae = RepAtom(ae->NextOfAE);
     }
   }
   b = (BlobPropEntry *)Yap_AllocCodeSpace(sizeof(BlobPropEntry));
-  if (!b)
+  if (!b) {
+    UNLOCK(SWI_Blobs_Lock);
     return NULL;
+  }
   b->NextOfPE = NIL;
   b->KindOfPE = BlobProperty;
   b->blob_t = type;
   ae = (AtomEntry *)Yap_AllocCodeSpace(sizeof(AtomEntry)+len+sizeof(size_t));
-  if (!ae)
+  if (!ae) {
+    UNLOCK(SWI_Blobs_Lock);
     return NULL;
+  }
+  NOfBlobs++;
   INIT_RWLOCK(ae->ARWLock);
   ae->PropsOfAE = AbsBlobProp(b);
   ae->NextOfAE = AbsAtom(SWI_Blobs);
   ae->rep.blob->length = len;
   memcpy(ae->rep.blob->data, blob, len);
   SWI_Blobs = ae;
+  UNLOCK(SWI_Blobs_Lock);
+  if (NOfBlobs > NOfBlobsMax) {
+    Yap_signal(YAP_CDOVF_SIGNAL);
+  }
   return ae;
 }
 

library/dialect/swi/fli/swi.c

@@ -2421,7 +2421,6 @@ X_API int PL_thread_attach_engine(const PL_thread_attr_t *attr)
     /* we do not have an engine */
     if (attr) {
       YAP_thread_attr yapt;
-      int wid; 
 
       yapt.ssize = attr->local_size;
       yapt.tsize = attr->global_size;

misc/HEAPFIELDS

@@ -345,3 +345,8 @@ struct swi_reverse_hash	swi_reverse_hash[N_SWI_HASH] SWI_ReverseHash	void void
 /* SWI blobs */
 struct PL_blob_t	*swi_blob_types	SWI_BlobTypes		=NULL		RestoreSWIBlobTypes()
 struct AtomEntryStruct	*swi_blobs	SWI_Blobs		=NULL		RestoreSWIBlobs()
+UInt   			nofblobs	NOfBlobs		=0
+UInt   			nofblobsmax	NOfBlobsMax		=256
+#if defined(YAPOR) || defined(THREADS)
+lockvar         swi_blobs_lock		SWI_Blobs_Lock		MkLock
+#endif