From 18190a4633aff2c695189e6ee4064713e21e7f1f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 13 Dec 2011 23:09:05 +0000 Subject: [PATCH 1/4] fix types for return absmi and friends. --- C/c_interface.c | 12 ++++++------ C/exec.c | 10 +++++----- H/Yapproto.h | 2 +- docs/yap.tex | 4 ++-- include/YapInterface.h | 4 ++-- 5 files changed, 16 insertions(+), 16 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 32fe2d040..7728c439d 100644 --- a/C/c_interface.c +++ b/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 Term STD_PROTO(YAP_RunGoalOnce,(Term)); +X_API Int STD_PROTO(YAP_RunGoal,(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 *)); @@ -2364,7 +2364,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi) return TRUE; } -X_API Term +X_API Int YAP_RunGoal(Term t) { CACHE_REGS @@ -2388,7 +2388,7 @@ YAP_RunGoal(Term t) } RECOVER_MACHINE_REGS(); - return(out); + return out; } X_API Term @@ -2450,7 +2450,7 @@ YAP_OpaqueObjectFromTerm(Term t) return ExternalBlobFromTerm (t); } -X_API Term +X_API Int YAP_RunGoalOnce(Term t) { CACHE_REGS @@ -2502,7 +2502,7 @@ YAP_RunGoalOnce(Term t) CP = old_CP; LOCAL_AllowRestart = FALSE; RECOVER_MACHINE_REGS(); - return(out); + return out; } X_API int diff --git a/C/exec.c b/C/exec.c index 4a3f91cbb..3d1d6e52c 100644 --- a/C/exec.c +++ b/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 @@ -1287,7 +1287,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 diff --git a/H/Yapproto.h b/H/Yapproto.h index 5e34805c4..4428d7af1 100644 --- a/H/Yapproto.h +++ b/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)); diff --git a/docs/yap.tex b/docs/yap.tex index f36829186..f1e78292f 100644 --- a/docs/yap.tex +++ b/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. diff --git a/include/YapInterface.h b/include/YapInterface.h index 069fdfd0c..c60e34de1 100644 --- a/include/YapInterface.h +++ b/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)); From 551df1c70a65551e7f1a2a8e19883e7a65fa8806 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 22 Dec 2011 10:27:56 +0000 Subject: [PATCH 2/4] handle blob overflows. --- C/agc.c | 17 +++++++++++++++-- C/exec.c | 10 ++++------ C/grow.c | 15 +++++++++++---- H/dhstruct.h | 5 +++++ H/hstruct.h | 5 +++++ H/ihstruct.h | 5 +++++ H/rhstruct.h | 5 +++++ library/dialect/swi/fli/blobs.c | 31 ++++++++++++++++++++++++++++--- library/dialect/swi/fli/swi.c | 1 - misc/HEAPFIELDS | 5 +++++ 10 files changed, 83 insertions(+), 16 deletions(-) diff --git a/C/agc.c b/C/agc.c index a52e40b8b..990be69db 100644 --- a/C/agc.c +++ b/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; diff --git a/C/exec.c b/C/exec.c index 4a3f91cbb..a172bfa23 100644 --- a/C/exec.c +++ b/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; diff --git a/C/grow.c b/C/grow.c index 3539a4b50..eed3d652e 100644 --- a/C/grow.c +++ b/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 || - /* +1 = make sure we didn't lose the current atom */ - NOfAtoms+1 > 2*AtomHashTableSize) { + if (!blob_overflow && + (n > NOfAtoms+ NOfAtoms/10 || + /* +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; } diff --git a/H/dhstruct.h b/H/dhstruct.h index 53b5a56e2..a993249fd 100644 --- a/H/dhstruct.h +++ b/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 diff --git a/H/hstruct.h b/H/hstruct.h index d137ae7fe..07f01c48e 100644 --- a/H/hstruct.h +++ b/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 diff --git a/H/ihstruct.h b/H/ihstruct.h index ee1f6366a..69f9c37ec 100644 --- a/H/ihstruct.h +++ b/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 diff --git a/H/rhstruct.h b/H/rhstruct.h index e1a8af4a3..0668229ed 100644 --- a/H/rhstruct.h +++ b/H/rhstruct.h @@ -302,3 +302,8 @@ RestoreSWIBlobTypes(); RestoreSWIBlobs(); + + +#if defined(YAPOR) || defined(THREADS) + REINIT_LOCK(SWI_Blobs_Lock); +#endif diff --git a/library/dialect/swi/fli/blobs.c b/library/dialect/swi/fli/blobs.c index ef38a0041..2b8e688bd 100644 --- a/library/dialect/swi/fli/blobs.c +++ b/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; } diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index f3f635f56..4afb4b381 100644 --- a/library/dialect/swi/fli/swi.c +++ b/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; diff --git a/misc/HEAPFIELDS b/misc/HEAPFIELDS index 5d7ab05d4..d463768e7 100644 --- a/misc/HEAPFIELDS +++ b/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 From 1fde83d27803bc19323613a7312e6afd82b28e95 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 22 Dec 2011 11:42:26 +0000 Subject: [PATCH 3/4] fix overflows --- C/c_interface.c | 17 +++++++++-------- C/grow.c | 6 +++++- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 32fe2d040..61015ce05 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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) { - buf[j-1] = '\0'; - return(FALSE); + if (j == bufsize) { + buf[bufsize-1] = '\0'; + 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'; diff --git a/C/grow.c b/C/grow.c index eed3d652e..40370c9f9 100644 --- a/C/grow.c +++ b/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) { From d01eec1dbe297b6494dde7650b31868dc6886bf5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 22 Dec 2011 11:43:30 +0000 Subject: [PATCH 4/4] iupdate changes. --- packages/YapR | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/YapR b/packages/YapR index 27b398187..42e5df3a0 160000 --- a/packages/YapR +++ b/packages/YapR @@ -1 +1 @@ -Subproject commit 27b398187116aaa5c6b687d1abe79b0a270381bb +Subproject commit 42e5df3a03d961bcf779ceaebf3649c26415da8e