From 5493bd29f9fcb64e4b05d9ffe3bff292d24e8e27 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 9 Mar 2005 06:35:52 +0000 Subject: [PATCH] fix nth_instance fix Makefile.in for multi-threading git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1262 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/dbase.c | 151 +++++++++++++++++++++++++++++++++++++------------- configure | 14 ++--- configure.in | 14 ++--- console/yap.c | 6 +- 4 files changed, 131 insertions(+), 54 deletions(-) diff --git a/C/dbase.c b/C/dbase.c index aa59d57b2..d591db9dc 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -2822,11 +2822,27 @@ FetchDBPropFromKey(Term twork, int flag, int new, char *error_mssg) } -static DBRef -nth_recorded_log(LogUpdDBProp AtProp, Int Count) +static Int +lu_nth_recorded(PredEntry *pe, Int Count) { - Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); - return NULL; + LogUpdClause *cl; + + XREGS[2] = MkVarTerm(); + cl = Yap_NthClause(pe, Count); + if (cl == NULL) + return FALSE; +#if defined(YAPOR) || defined(THREADS) + LOCK(cl->ClLock); + TRAIL_CLREF(cl); /* So that fail will erase it */ + INC_CLREF_COUNT(cl); + UNLOCK(cl->ClLock); +#else + if (!(cl->ClFlags & InUseMask)) { + cl->ClFlags |= InUseMask; + TRAIL_CLREF(cl); /* So that fail will erase it */ + } +#endif + return Yap_unify(MkDBRefTerm((DBRef)cl),ARG3); } @@ -2837,15 +2853,18 @@ nth_recorded(DBProp AtProp, Int Count) Register DBRef ref; READ_LOCK(AtProp->DBRWLock); - if (AtProp->KindOfPE & 0x1) { - ref = nth_recorded_log((LogUpdDBProp)AtProp, Count); - if (ref == NULL) { - READ_UNLOCK(AtProp->DBRWLock); - return FALSE; - } - } else { - ref = AtProp->First; + ref = AtProp->First; + Count--; + while (ref != NULL + && DEAD_REF(ref)) + ref = NextDBRef(ref); + if (ref == NULL) { + READ_UNLOCK(AtProp->DBRWLock); + return FALSE; + } + while (Count) { Count--; + ref = NextDBRef(ref); while (ref != NULL && DEAD_REF(ref)) ref = NextDBRef(ref); @@ -2853,17 +2872,6 @@ nth_recorded(DBProp AtProp, Int Count) READ_UNLOCK(AtProp->DBRWLock); return FALSE; } - while (Count) { - Count--; - ref = NextDBRef(ref); - while (ref != NULL - && DEAD_REF(ref)) - ref = NextDBRef(ref); - if (ref == NULL) { - READ_UNLOCK(AtProp->DBRWLock); - return FALSE; - } - } } #if defined(YAPOR) || defined(THREADS) LOCK(ref->lock); @@ -2887,6 +2895,7 @@ p_nth_instance(void) DBProp AtProp; Term TCount; Int Count; + PredEntry *pe; Term t3 = Deref(ARG3); if (!IsVarTerm(t3)) { @@ -2895,30 +2904,90 @@ p_nth_instance(void) return FALSE; } else { DBRef ref = DBRefOfTerm(t3); - LOCK(ref->lock); - if (ref == NULL - || DEAD_REF(ref) - || !UnifyDBKey(ref,0,ARG1) - || !UnifyDBNumber(ref,ARG2)) { - UNLOCK(ref->lock); - return(FALSE); + if (ref->Flags & LogUpdMask) { + LogUpdClause *cl = (LogUpdClause *)ref; + PredEntry *pe; + LogUpdClause *ocl; + UInt pred_arity, icl = 0; + Functor pred_f; + Term tpred; + Term pred_module; + + LOCK(cl->ClLock); + if (cl->ClFlags & ErasedMask) { + UNLOCK(cl->ClLock); + return FALSE; + } + pe = cl->ClPred; + READ_LOCK(pe->PRWLock); + ocl = ClauseCodeToLogUpdClause(pe->cs.p_code.FirstClause); + pred_module = pe->ModuleOfPred; + if (pred_module != IDB_MODULE) { + pred_f = pe->FunctorOfPred; + pred_arity = pe->ArityOfPE; + } else { + if (pe->PredFlags & NumberDBPredFlag) { + pred_f = (Functor)MkIntegerTerm(pe->src.IndxId); + pred_arity = 0; + } else { + pred_f = pe->FunctorOfPred; + if (pe->PredFlags & AtomDBPredFlag) { + pred_arity = 0; + } else { + pred_arity = ArityOfFunctor(pred_f); + } + } + } + do { + icl++; + if (cl == ocl) break; + ocl = ocl->ClNext; + } while (ocl != NULL); + READ_UNLOCK(pe->PRWLock); + UNLOCK(cl->ClLock); + if (ocl == NULL) { + return FALSE; + } + if (!Yap_unify(ARG2,MkIntegerTerm(icl))) { + return FALSE; + } + if (pred_arity) { + tpred = Yap_MkNewApplTerm(pred_f,pred_arity); + } else { + tpred = MkAtomTerm((Atom)pred_f); + } + if (pred_module == IDB_MODULE) { + return Yap_unify(ARG1,tpred); + } else { + Term ttpred, ts[2]; + ts[0] = pred_module; + ts[1] = tpred; + ttpred = Yap_MkApplTerm(FunctorModule,pred_arity,ts); + return Yap_unify(ARG1,ttpred); + } } else { - UNLOCK(ref->lock); - return(TRUE); + LOCK(ref->lock); + if (ref == NULL + || DEAD_REF(ref) + || !UnifyDBKey(ref,0,ARG1) + || !UnifyDBNumber(ref,ARG2)) { + UNLOCK(ref->lock); + return FALSE; + } else { + UNLOCK(ref->lock); + return TRUE; + } } } } - if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) { - return(FALSE); - } TCount = Deref(ARG2); if (IsVarTerm(TCount)) { Yap_Error(INSTANTIATION_ERROR, TCount, "nth_instance/3"); - return (FALSE); + return FALSE; } if (!IsIntegerTerm(TCount)) { Yap_Error(TYPE_ERROR_INTEGER, TCount, "nth_instance/3"); - return (FALSE); + return FALSE; } Count = IntegerOfTerm(TCount); if (Count <= 0) { @@ -2926,7 +2995,13 @@ p_nth_instance(void) Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, TCount, "nth_instance/3"); else Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_instance/3"); - return (FALSE); + return FALSE; + } + if ((pe = find_lu_entry(Deref(ARG1))) != NULL) { + return lu_nth_recorded(pe,Count); + } + if (EndOfPAEntr(AtProp = FetchDBPropFromKey(Deref(ARG1), 0, FALSE, "nth_instance/3"))) { + return FALSE; } return nth_recorded(AtProp,Count); } diff --git a/configure b/configure index 45601d3f0..7785e0a31 100755 --- a/configure +++ b/configure @@ -5407,13 +5407,7 @@ M4="m4" MERGE_DLL_OBJS="#" IN_UNIX="" -if test "$dynamic_loading" = "yes" -then - YAP_EXTRAS="$SHLIB_CFLAGS $YAP_EXTRAS" - YAPLIB=libYap"$SHLIB_SUFFIX" -else - YAPLIB="libYap.a" -fi +YAPLIB="libYap.a" case "$target_os" in *linux*) @@ -5832,6 +5826,12 @@ fi ;; esac +if test "$dynamic_loading" = "yes" +then + YAP_EXTRAS="$SHLIB_CFLAGS $YAP_EXTRAS" + YAPLIB=libYap"$SHLIB_SUFFIX" +fi + if test "$coroutining" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DCOROUTINING=1" diff --git a/configure.in b/configure.in index 94e1c037e..a76397622 100644 --- a/configure.in +++ b/configure.in @@ -477,13 +477,7 @@ MERGE_DLL_OBJS="#" IN_UNIX="" dnl This has to be before $target_os -if test "$dynamic_loading" = "yes" -then - YAP_EXTRAS="$SHLIB_CFLAGS $YAP_EXTRAS" - YAPLIB=libYap"$SHLIB_SUFFIX" -else - YAPLIB="libYap.a" -fi +YAPLIB="libYap.a" case "$target_os" in *linux*) @@ -663,6 +657,12 @@ dnl Linux has both elf and a.out, in this case we found elf ;; esac +if test "$dynamic_loading" = "yes" +then + YAP_EXTRAS="$SHLIB_CFLAGS $YAP_EXTRAS" + YAPLIB=libYap"$SHLIB_SUFFIX" +fi + if test "$coroutining" = "yes" then YAP_EXTRAS="$YAP_EXTRAS -DCOROUTINING=1" diff --git a/console/yap.c b/console/yap.c index 604b514f9..ec6102d17 100644 --- a/console/yap.c +++ b/console/yap.c @@ -468,7 +468,9 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap) /* init memory */ if (BootMode == YAP_BOOT_FROM_PROLOG || BootMode == YAP_FULL_BOOT_FROM_PROLOG) { - BootMode = YAP_Init(iap); + int NewBootMode = YAP_Init(iap); + if (NewBootMode != YAP_BOOT_FROM_PROLOG && BootMode != YAP_FULL_BOOT_FROM_PROLOG) + BootMode = NewBootMode; } else { BootMode = YAP_Init(iap); } @@ -476,7 +478,7 @@ init_standard_system(int argc, char *argv[], YAP_init_args *iap) /* boot failed */ YAP_Error(iap->ErrorNo,0L,iap->ErrorCause); } - return(BootMode); + return BootMode; }