diff --git a/C/cdmgr.c b/C/cdmgr.c index 23d5c3932..6b3a23e26 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1147,16 +1147,19 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src) Atom at; UInt Arity; CELL pflags; + Term tf; if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) - t = ArgOfTerm(1, t); - if (IsAtomTerm(t)) { - at = AtomOfTerm(t); + tf = ArgOfTerm(1, t); + else + tf = t; + if (IsAtomTerm(tf)) { + at = AtomOfTerm(tf); p = RepPredProp(PredPropByAtom(at, mod)); Arity = 0; } else { - Functor f = FunctorOfTerm(t); + Functor f = FunctorOfTerm(tf); Arity = ArityOfFunctor(f); at = NameOfFunctor(f); p = RepPredProp(PredPropByFunc(f, mod)); @@ -1189,10 +1192,17 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src) if (pflags & LogUpdatePredFlag) { LogUpdClause *clp = ClauseCodeToLogUpdClause(cp); clp->ClFlags |= LogUpdMask; - clp->ClSource = Yap_StoreTermInDB(src, 4); + if (IsAtomTerm(t) || + FunctorOfTerm(t) != FunctorAssert) { + clp->ClFlags |= FactMask; + clp->ClSource = NULL; + } } else { StaticClause *clp = ClauseCodeToStaticClause(cp); clp->ClFlags |= StaticMask; + if (IsAtomTerm(t) || + FunctorOfTerm(t) != FunctorAssert) + clp->ClFlags |= FactMask; } if (compile_mode) p->PredFlags = pflags | CompiledPredFlag | FastPredFlag; @@ -2971,24 +2981,10 @@ static Int fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) { LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr); - Term t; Term rtn; if (cl == NULL) return FALSE; - while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { - if (first_time) { - if (!Yap_gc(4, YENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return FALSE; - } - } else { - if (!Yap_gc(5, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return FALSE; - } - } - } rtn = MkDBRefTerm((DBRef)cl); #if defined(OR) || defined(THREADS) LOCK(cl->ClLock); @@ -3001,14 +2997,45 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya TRAIL_CLREF(cl); /* So that fail will erase it */ } #endif - if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) { + if (cl->ClFlags & FactMask) { + Functor f = FunctorOfTerm(th); + UInt arity = ArityOfFunctor(f), i; + CELL *pt = RepAppl(th)+1; + + if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) || + !Yap_unify(tr, rtn)) + return FALSE; + for (i=0; iClCode; + return TRUE; + } else { + Term t; + + while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { + if (first_time) { + if (!Yap_gc(4, YENV, P)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } else { + if (!Yap_gc(5, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } + } return(Yap_unify(th, ArgOfTerm(1,t)) && Yap_unify(tb, ArgOfTerm(2,t)) && Yap_unify(tr, rtn)); - } else { - return(Yap_unify(th, t) && - Yap_unify(tb, MkAtomTerm(AtomTrue)) && - Yap_unify(tr, rtn)); } } @@ -3037,29 +3064,46 @@ static Int fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time) { LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr); - Term t; if (cl == NULL) return FALSE; - while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { + if (cl->ClFlags & FactMask) { + Functor f = FunctorOfTerm(th); + UInt arity = ArityOfFunctor(f), i; + CELL *pt = RepAppl(th)+1; + + if (!Yap_unify(tb, MkAtomTerm(AtomTrue))) + return FALSE; + for (i=0; iClCode; + return TRUE; + } else { + Term t; + + while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { + if (first_time) { + if (!Yap_gc(4, YENV, P)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } else { + if (!Yap_gc(5, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } } } - } - if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) { return(Yap_unify(th, ArgOfTerm(1,t)) && Yap_unify(tb, ArgOfTerm(2,t))); - } else { - return(Yap_unify(th, t) && - Yap_unify(tb, MkAtomTerm(AtomTrue))); } } @@ -3084,61 +3128,6 @@ p_continue_log_update_clause0(void) return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE); } -static Int -fetch_next_lu_retract(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time) -{ - LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdRetract->cs.p_code.FirstClause), cp_ptr); - Term t; - - if (cl == NULL) - return FALSE; - while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) { - if (first_time) { - if (!Yap_gc(3, YENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return FALSE; - } - } else { - if (!Yap_gc(4, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return FALSE; - } - } - } - if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) { - if (!(Yap_unify(th, ArgOfTerm(1,t)) && - Yap_unify(tb, ArgOfTerm(2,t)))) - return FALSE; - } else { - if (!(Yap_unify(th, t) && - Yap_unify(tb, MkAtomTerm(AtomTrue)))) - return FALSE; - } - Yap_ErLogUpdCl(cl); - return TRUE; -} - -static Int /* $hidden_predicate(P) */ -p_log_update_retract(void) -{ - PredEntry *pe; - Term t1 = Deref(ARG1); - - pe = get_pred(t1, Deref(ARG2), "retract/2"); - if (pe == NULL || EndOfPAEntr(pe)) - return FALSE; - return fetch_next_lu_retract(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE); -} - -static Int /* $hidden_predicate(P) */ -p_continue_log_update_retract(void) -{ - PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); - yamop *ipc = (yamop *)IntegerOfTerm(ARG2); - - return fetch_next_lu_retract(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE); -} - #ifdef LOW_PROF static void @@ -3344,8 +3333,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, SafePredFlag|SyncPredFlag); Yap_InitCPred("$log_update_clause", 3, p_log_update_clause0, SyncPredFlag); Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$log_update_retract", 3, p_log_update_retract, SyncPredFlag); - Yap_InitCPred("$continue_log_update_retract", 4, p_continue_log_update_retract, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag); Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag); } diff --git a/C/compiler.c b/C/compiler.c index 7e9f23d4c..dae9fe051 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -2868,7 +2868,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod) Yap_ShowCode(); #endif /* phase 3: assemble code */ - acode = Yap_assemble(ASSEMBLING_CLAUSE); + acode = Yap_assemble(ASSEMBLING_CLAUSE, inp_clause, CurrentPred, body == MkAtomTerm(AtomTrue)); /* check first if there was space for us */ diff --git a/C/dbase.c b/C/dbase.c index 88ade8ac1..7e7b2ae0c 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -3486,10 +3486,6 @@ lu_statistics(PredEntry *pe) while (x != NULL) { cls++; sz += Yap_SizeOfBlock((CODEADDR)x); - if (pe->ModuleOfPred != 2 && - x->ClSource != NULL) { - sz += Yap_SizeOfBlock((CODEADDR)(x->ClSource)); - } x = x->ClNext; } } @@ -3770,7 +3766,11 @@ p_jump_to_next_dynamic_clause(void) static void complete_lu_erase(LogUpdClause *clau) { - DBRef *cp = clau->ClSource->DBRefs; + DBRef *cp; + if (clau->ClSource) + cp = clau->ClSource->DBRefs; + else + cp = NULL; if (CL_IN_USE(clau)) { return; } @@ -3778,8 +3778,6 @@ complete_lu_erase(LogUpdClause *clau) clau->ClExt->u.EC.ClRefs > 0) { return; } - if (clau->ClPred->ModuleOfPred != 2) - ReleaseTermFromDB(clau->ClSource); #ifdef DEBUG if (clau->ClNext) clau->ClNext->ClPrev = clau->ClPrev; @@ -4231,10 +4229,36 @@ p_instance(void) if (cl->ClFlags & ErasedMask) { return FALSE; } + if (cl->ClSource == NULL) { + PredEntry *ap = cl->ClPred; + if (ap->ArityOfPE == 0) { + return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred)); + } else { + Functor f = ap->FunctorOfPred; + UInt arity = ArityOfFunctor(ap->FunctorOfPred), i; + Term t2 = Deref(ARG2); + CELL *ptr; + + if (IsVarTerm(t2)) { + Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity))); + } else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) { + return FALSE; + } + ptr = RepAppl(t2)+1; + for (i=0; iClCode; + return TRUE; + } + } opc = Yap_op_from_opcode(cl->ClCode->opc); if (opc == _unify_idb_term) { return Yap_unify(ARG2, cl->ClSource->Entry); - } else { + } else { while ((TermDB = GetDBTerm(cl->ClSource)) == 0L) { /* oops, we are in trouble, not enough stack space */ if (!Yap_gc(2, ENV, P)) { @@ -4519,6 +4543,14 @@ Yap_StoreTermInDB(Term t, int nargs) { return StoreTermInDB(t, nargs); } +DBTerm * +Yap_StoreTermInDBPlusExtraSpace(Term t, UInt extra_size) { + int needs_vars; + + return (DBTerm *)CreateDBStruct(t, (DBProp)NULL, + InQueue, &needs_vars, extra_size); +} + static Int p_init_queue(void) diff --git a/C/index.c b/C/index.c index 7c79e7086..baac300d8 100644 --- a/C/index.c +++ b/C/index.c @@ -3357,7 +3357,7 @@ Yap_PredIsIndexable(PredEntry *ap) CurrentPred = ap; IPredArity = ap->ArityOfPE; if (CodeStart) { - if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NULL) { + if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE)) == NULL) { if (!Yap_growheap(FALSE, Yap_Error_Size)) { Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); return NULL; @@ -4121,7 +4121,7 @@ ExpandIndex(PredEntry *ap) { CurrentPred = ap; IPredArity = ap->ArityOfPE; if (CodeStart) { - if ((indx_out = Yap_assemble(ASSEMBLING_INDEX)) == NULL) { + if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE)) == NULL) { if (!Yap_growheap(FALSE, Yap_Error_Size)) { Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); return NULL; diff --git a/H/compile.h b/H/compile.h index b5644c374..bb4968609 100644 --- a/H/compile.h +++ b/H/compile.h @@ -232,7 +232,7 @@ typedef struct CEXPENTRY { #define Two 2 -yamop *STD_PROTO(Yap_assemble,(int)); +yamop *STD_PROTO(Yap_assemble,(int,Term,struct pred_entry *,int)); void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL)); void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL)); void STD_PROTO(Yap_emit_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL)); diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index 28470f7a3..70effb8e7 100644 --- a/m4/Yatom.h.m4 +++ b/m4/Yatom.h.m4 @@ -254,6 +254,7 @@ Inline(IsPredProperty, PropFlags, int, flags, (flags == PEProp) ) /* Flags for code or dbase entry */ /* There are several flags for code and data base entries */ typedef enum { + FactMask = 0x100000, /* informs this is a fact */ SwitchRootMask= 0x80000, /* informs this is the root for the index tree */ SwitchTableMask=0x40000, /* informs this is a switch table */ HasBlobsMask = 0x20000, /* informs this has blobs which may be in use */ @@ -487,6 +488,7 @@ int STD_PROTO(Yap_RemoveIndexation,(PredEntry *)); /* dbase.c */ void STD_PROTO(Yap_ErDBE,(DBRef)); DBTerm *STD_PROTO(Yap_StoreTermInDB,(Term,int)); +DBTerm *STD_PROTO(Yap_StoreTermInDBPlusExtraSpace,(Term,UInt)); Term STD_PROTO(Yap_FetchTermFromDB,(DBTerm *)); void STD_PROTO(Yap_ReleaseTermFromDB,(DBTerm *));