Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

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/c_interface.c

@@ -455,8 +455,8 @@ X_API Term    STD_PROTO(YAP_NBufferToDiffList, (char *, Term, size_t));
 X_API Term    STD_PROTO(YAP_WideBufferToDiffList, (wchar_t *, Term));
 X_API Term    STD_PROTO(YAP_NWideBufferToDiffList, (wchar_t *, Term, size_t));
 X_API void    STD_PROTO(YAP_Error,(int, Term, char *, ...));
-X_API Term    STD_PROTO(YAP_RunGoal,(Term));
+X_API Int     STD_PROTO(YAP_RunGoal,(Term));
-X_API Term    STD_PROTO(YAP_RunGoalOnce,(Term));
+X_API Int     STD_PROTO(YAP_RunGoalOnce,(Term));
 X_API int     STD_PROTO(YAP_RestartGoal,(void));
 X_API int     STD_PROTO(YAP_ShutdownGoal,(int));
 X_API int     STD_PROTO(YAP_EnterGoal,(PredEntry *, Term *, YAP_dogoalinfo *));
@@ -1930,25 +1930,26 @@ YAP_StringToBuffer(Term t, char *buf, unsigned int bufsize)
       return(FALSE);
     } else if (!IsIntTerm(Head)) {
       Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
-      return(FALSE);		
+      return FALSE;		
     }
     i = IntOfTerm(Head);
     if (i < 0 || i > 255) {
       Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,Head,"user defined procedure");
-      return(FALSE);		
+      return FALSE;		
     }
-    buf[j++] = i;
+    if (j == bufsize) {
-    if (j > bufsize) {
+      buf[bufsize-1] = '\0';
-      buf[j-1] = '\0';
+      return FALSE;
-      return(FALSE);
+    } else {
+      buf[j++] = i;
     }
     t = TailOfTerm(t);
     if (IsVarTerm(t)) {
       Yap_Error(INSTANTIATION_ERROR,t,"user defined procedure");
-      return(FALSE);
+      return FALSE;
     } else if (!IsPairTerm(t) && t != TermNil) {
       Yap_Error(TYPE_ERROR_LIST, t, "user defined procedure");
-      return(FALSE);
+      return FALSE;
     }
   }
   buf[j] = '\0';
@@ -2364,7 +2365,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
   return TRUE;
 }
 
-X_API Term
+X_API Int
 YAP_RunGoal(Term t)
 {
   CACHE_REGS
@@ -2388,7 +2389,7 @@ YAP_RunGoal(Term t)
   }
   
   RECOVER_MACHINE_REGS();
-  return(out);
+  return out;
 }
 
 X_API Term
@@ -2450,7 +2451,7 @@ YAP_OpaqueObjectFromTerm(Term t)
   return ExternalBlobFromTerm (t);
 }
 
-X_API Term
+X_API Int
 YAP_RunGoalOnce(Term t)
 {
   CACHE_REGS
@@ -2502,7 +2503,7 @@ YAP_RunGoalOnce(Term t)
   CP = old_CP;
   LOCAL_AllowRestart = FALSE;
   RECOVER_MACHINE_REGS();
-  return(out);
+  return out;
 }
 
 X_API int

C/exec.c

@@ -941,7 +941,7 @@ p_pred_goal_expansion_on( USES_REGS1 ) {
 }
 
 
-static int
+static Int
 exec_absmi(int top USES_REGS)
 {
   int lval, out;
@@ -1052,11 +1052,11 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
   CP = YESCODE;
 }
 
-static Term
+static Int
 do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
 {
   choiceptr saved_b = B;
-  Term out = 0L;
+  Int out;
 
   init_stack(arity, pt, top, saved_b PASS_REGS);
   P = (yamop *) CodeAdr;
@@ -1070,7 +1070,7 @@ do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS)
   return out;
 }
 
-int
+Int
 Yap_exec_absmi(int top)
 {
   CACHE_REGS
@@ -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;
@@ -1287,7 +1285,7 @@ Yap_RunTopGoal(Term t)
   }
 #endif
   goal_out = do_goal(t, CodeAdr, arity, pt, TRUE PASS_REGS);
-  return(goal_out);
+  return goal_out;
 }
 
 static void

C/grow.c

@@ -1361,9 +1361,13 @@ static int
 growatomtable( USES_REGS1 )
 {
   AtomHashEntry *ntb;
-  UInt nsize = 4*AtomHashTableSize-1;
+  UInt diff = 3*AtomHashTableSize-1, nsize;
   UInt start_growth_time = Yap_cputime(), growth_time;
   int gc_verbose = Yap_is_gc_verbose();
+  if (diff > 4*1024*1024)
+    diff =  4*1024*1024+7919;
+  else
+    nsize =  nsize+7919;
 
   LOCK(LOCAL_SignalLock);
   if (LOCAL_ActiveSignals == YAP_CDOVF_SIGNAL) {
@@ -1421,15 +1425,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 +1450,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/Yapproto.h

@@ -177,7 +177,7 @@ Int	STD_PROTO(Yap_JumpToEnv,(Term));
 Term	STD_PROTO(Yap_RunTopGoal,(Term));
 void	STD_PROTO(Yap_ResetExceptionTerm,(void));
 Int	STD_PROTO(Yap_execute_goal,(Term, int, Term));
-int	STD_PROTO(Yap_exec_absmi,(int));
+Int	STD_PROTO(Yap_exec_absmi,(int));
 void	STD_PROTO(Yap_trust_last,(void));
 Term	STD_PROTO(Yap_GetException,(void));
 

H/dhstruct.h

@@ -305,3 +305,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

@@ -305,3 +305,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

@@ -305,3 +305,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

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

docs/yap.tex

@@ -16664,7 +16664,7 @@ There are several ways to call Prolog code from C-code. By default, the
 has been initialised before:
 
 @example
-  YAP_RunGoal(YAP_Term Goal)
+  YAP_Int YAP_RunGoal(YAP_Term Goal)
 @end example
 Execute query @var{Goal} and return 1 if the query succeeds, and 0
 otherwise. The predicate returns 0 if failure, otherwise it will return
@@ -16673,7 +16673,7 @@ an @var{YAP_Term}.
 Quite often, one wants to run a query once. In this case you should use
 @var{Goal}:
 @example
-  YAP_RunGoalOnce(YAP_Term Goal)
+  YAP_Int YAP_RunGoalOnce(YAP_Term Goal)
 @end example
 The  @code{YAP_RunGoal()} function makes sure to recover stack space at
 the end of execution.

include/YapInterface.h

@@ -272,10 +272,10 @@ extern X_API void *PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
 extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *));
 
 /*  int YAP_RunGoal(YAP_Term) */
-extern X_API YAP_Term PROTO(YAP_RunGoal,(YAP_Term));
+extern X_API YAP_Int PROTO(YAP_RunGoal,(YAP_Term));
 
 /*  int YAP_RunGoalOnce(YAP_Term) */
-extern X_API YAP_Term PROTO(YAP_RunGoalOnce,(YAP_Term));
+extern X_API YAP_Int PROTO(YAP_RunGoalOnce,(YAP_Term));
 
 /*  int YAP_RestartGoal(void) */
 extern X_API YAP_Bool PROTO(YAP_RestartGoal,(void));

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

@@ -348,3 +348,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

packages/YapR

@@ -1 +1 @@
-Subproject commit 27b398187116aaa5c6b687d1abe79b0a270381bb
+Subproject commit 42e5df3a03d961bcf779ceaebf3649c26415da8e