diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

don't keep source for log update facts, just execute them to find out the

Browse Source 
arguments.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@932 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-11-18 19:24:46 +00:00
parent 9851882dc7
commit ff20288236
6 changed files with 130 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
C/cdmgr.c
View File

@ -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,11 +2981,45 @@ 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;
rtn = MkDBRefTerm((DBRef)cl);
#if defined(OR) || defined(THREADS)
LOCK(cl->ClLock);
TRAIL_CLREF(cl); /* So that fail will erase it */
INC_DBREF_COUNT(cl);
UNLOCK(cl->ClLock);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); /* So that fail will erase it */
}
#endif
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; i<arity; i++) {
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
P = cl->ClCode;
return TRUE;
} else {
Term t;
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (first_time) {
if (!Yap_gc(4, YENV, P)) {
@ -2989,26 +3033,9 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
}
}
}
rtn = MkDBRefTerm((DBRef)cl);
#if defined(OR) || defined(THREADS)
LOCK(cl->ClLock);
TRAIL_CLREF(cl); /* So that fail will erase it */
INC_DBREF_COUNT(cl);
UNLOCK(cl->ClLock);
#else
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl); /* So that fail will erase it */
}
#endif
if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) {
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,10 +3064,31 @@ 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;
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; i<arity; i++) {
XREGS[i+1] = pt[i];
}
/* don't need no ENV */
if (first_time) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
P = cl->ClCode;
return TRUE;
} else {
Term t;
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (first_time) {
if (!Yap_gc(4, YENV, P)) {
@ -3054,12 +3102,8 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
}
}
}
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);
}

2
C/compiler.c
View File

@ -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 */

46
C/dbase.c
View File

@ -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,6 +4229,32 @@ 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; i<arity; i++) {
XREGS[i+1] = ptr[i];
}
CP = P;
YENV = ASP;
YENV[E_CB] = (CELL) B;
P = cl->ClCode;
return TRUE;
}
}
opc = Yap_op_from_opcode(cl->ClCode->opc);
if (opc == _unify_idb_term) {
return Yap_unify(ARG2, cl->ClSource->Entry);
@ -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)

4
C/index.c
View File

@ -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;

2
H/compile.h
View File

@ -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));

2
m4/Yatom.h.m4
View File

@ -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 *));