call the garbage collector the right way

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@902 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-10-17 02:11:21 +00:00
parent 76160f72a8
commit 526ec2e50f
12 changed files with 172 additions and 70 deletions

View File

@ -1185,7 +1185,14 @@ Yap_absmi(int inp)
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG); LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
Term t; Term t;
t = Yap_FetchTermFromDB(cl->ClSource, 3); saveregs();
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (!Yap_gc(3, ENV, CP)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
FAIL();
}
}
setregs();
if (!Yap_IUnify(ARG2, t)) { if (!Yap_IUnify(ARG2, t)) {
FAIL(); FAIL();
} }

View File

@ -376,9 +376,10 @@ a_cle(op_numbers opcode)
inline static void inline static void
a_e(op_numbers opcode) a_e(op_numbers opcode)
{ {
if (pass_no) if (pass_no) {
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
GONEXT(e); }
GONEXT(e);
} }
inline static void inline static void
@ -1199,6 +1200,27 @@ a_ifnot(op_numbers opcode)
GONEXT(clll); GONEXT(clll);
} }
/*
static void
a_cut_e(void)
{
if (pass_no) {
code_p->opc = emit_op(_cut_e);
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE
* (cpc->rnd2));
code_p->u.sla.sla_u.m_num = cpc->rnd3;
if (cpc->rnd2) {
code_p->u.sla.bmap = emit_bmlabel(cpc->rnd1);
} else {
// there is no bitmap as there are no variables in the environment
code_p->u.sla.bmap = NULL;
}
code_p->u.sla.p0 = CurrentPred;
}
GONEXT(sla);
}
*/
static void static void
a_cut(void) a_cut(void)
{ {

View File

@ -259,7 +259,12 @@ AccessNamedArray(Atom a, Int indx)
READ_UNLOCK(ptr->ArRWLock); READ_UNLOCK(ptr->ArRWLock);
if (ref != NULL) { if (ref != NULL) {
TRef = Yap_FetchTermFromDB(ref,3); while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
if (!Yap_gc(3, ENV, CP)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(TermNil);
}
}
} else { } else {
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
TRef = TermNil; TRef = TermNil;
@ -1917,7 +1922,12 @@ p_static_array_to_term(void)
Term TRef; Term TRef;
if (ref != NULL) { if (ref != NULL) {
TRef = Yap_FetchTermFromDB(ref,3); while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
if (!Yap_gc(3, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(TermNil);
}
}
} else { } else {
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
TRef = TermNil; TRef = TermNil;
@ -1960,6 +1970,6 @@ Yap_InitArrayPreds(void)
Yap_InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag); Yap_InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag);
Yap_InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag); Yap_InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag);
Yap_InitCPred("$static_array_properties", 3, p_static_array_properties, SafePredFlag); Yap_InitCPred("$static_array_properties", 3, p_static_array_properties, SafePredFlag);
Yap_InitCPred("static_array_to_term", 2, p_static_array_to_term, SafePredFlag); Yap_InitCPred("static_array_to_term", 2, p_static_array_to_term, 0L);
} }

21
C/bb.c
View File

@ -271,7 +271,12 @@ p_bb_get(void)
if (p == NULL || p->Element == NULL) if (p == NULL || p->Element == NULL)
return(FALSE); return(FALSE);
READ_LOCK(p->BBRWLock); READ_LOCK(p->BBRWLock);
out = Yap_FetchTermFromDB(p->Element,3); while ((out = Yap_FetchTermFromDB(p->Element)) == 0L) {
if (!Yap_gc(2, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(TermNil);
}
}
READ_UNLOCK(p->BBRWLock); READ_UNLOCK(p->BBRWLock);
return(Yap_unify(ARG2,out)); return(Yap_unify(ARG2,out));
} }
@ -286,7 +291,12 @@ p_bb_delete(void)
p = FetchBBProp(t1, "bb_delete/2", CurrentModule); p = FetchBBProp(t1, "bb_delete/2", CurrentModule);
if (p == NULL || p->Element == NULL) if (p == NULL || p->Element == NULL)
return(FALSE); return(FALSE);
out = Yap_FetchTermFromDB(p->Element,3); while ((out = Yap_FetchTermFromDB(p->Element)) == 0L) {
if (!Yap_gc(2, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(TermNil);
}
}
WRITE_LOCK(p->BBRWLock); WRITE_LOCK(p->BBRWLock);
Yap_ReleaseTermFromDB(p->Element); Yap_ReleaseTermFromDB(p->Element);
p->Element = NULL; p->Element = NULL;
@ -305,7 +315,12 @@ p_bb_update(void)
if (p == NULL || p->Element == NULL) if (p == NULL || p->Element == NULL)
return(FALSE); return(FALSE);
WRITE_LOCK(p->BBRWLock); WRITE_LOCK(p->BBRWLock);
out = Yap_FetchTermFromDB(p->Element,3); while ((out = Yap_FetchTermFromDB(p->Element)) == 0L) {
if (!Yap_gc(3, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(TermNil);
}
}
if (!Yap_unify(ARG2,out)) { if (!Yap_unify(ARG2,out)) {
WRITE_UNLOCK(p->BBRWLock); WRITE_UNLOCK(p->BBRWLock);
return(FALSE); return(FALSE);

View File

@ -2918,7 +2918,7 @@ get_pred(Term t1, Term tmod, char *command)
} }
static Int static Int
fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr) 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); LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr);
Term t; Term t;
@ -2926,7 +2926,19 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
if (cl == NULL) if (cl == NULL)
return FALSE; return FALSE;
t = Yap_FetchTermFromDB(cl->ClSource, 4); 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); rtn = MkDBRefTerm((DBRef)cl);
#if defined(OR) || defined(THREADS) #if defined(OR) || defined(THREADS)
LOCK(cl->ClLock); LOCK(cl->ClLock);
@ -2959,7 +2971,7 @@ p_log_update_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3"); pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4,P); return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
} }
static Int /* $hidden_predicate(P) */ static Int /* $hidden_predicate(P) */
@ -2968,18 +2980,30 @@ p_continue_log_update_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2); yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap); return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
} }
static Int static Int
fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr) 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); LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr);
Term t; Term t;
if (cl == NULL) if (cl == NULL)
return FALSE; return FALSE;
t = Yap_FetchTermFromDB(cl->ClSource, 4); 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) { if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) {
return(Yap_unify(th, ArgOfTerm(1,t)) && return(Yap_unify(th, ArgOfTerm(1,t)) &&
Yap_unify(tb, ArgOfTerm(2,t))); Yap_unify(tb, ArgOfTerm(2,t)));
@ -2998,7 +3022,7 @@ p_log_update_clause0(void)
pe = get_pred(t1, Deref(ARG2), "clause/3"); pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P); return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
} }
static Int /* $hidden_predicate(P) */ static Int /* $hidden_predicate(P) */
@ -3007,18 +3031,30 @@ p_continue_log_update_clause0(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2); yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap); return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
} }
static Int static Int
fetch_next_lu_retract(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr) 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); LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdRetract->cs.p_code.FirstClause), cp_ptr);
Term t; Term t;
if (cl == NULL) if (cl == NULL)
return FALSE; return FALSE;
t = Yap_FetchTermFromDB(cl->ClSource, 4); 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 (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert) {
if (!(Yap_unify(th, ArgOfTerm(1,t)) && if (!(Yap_unify(th, ArgOfTerm(1,t)) &&
Yap_unify(tb, ArgOfTerm(2,t)))) Yap_unify(tb, ArgOfTerm(2,t))))
@ -3041,7 +3077,7 @@ p_log_update_retract(void)
pe = get_pred(t1, Deref(ARG2), "retract/2"); pe = get_pred(t1, Deref(ARG2), "retract/2");
if (pe == NULL || EndOfPAEntr(pe)) if (pe == NULL || EndOfPAEntr(pe))
return FALSE; return FALSE;
return fetch_next_lu_retract(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P); return fetch_next_lu_retract(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
} }
static Int /* $hidden_predicate(P) */ static Int /* $hidden_predicate(P) */
@ -3050,7 +3086,7 @@ p_continue_log_update_retract(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1)); PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
yamop *ipc = (yamop *)IntegerOfTerm(ARG2); yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
return fetch_next_lu_retract(pe, ipc, Deref(ARG3), ARG4, B->cp_ap); return fetch_next_lu_retract(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
} }
#ifdef LOW_PROF #ifdef LOW_PROF

View File

@ -1184,20 +1184,20 @@ c_goal(Term Goal, int mod)
#ifdef TABLING #ifdef TABLING
READ_LOCK(CurrentPred->PRWLock); READ_LOCK(CurrentPred->PRWLock);
if (is_tabled(CurrentPred)) { if (is_tabled(CurrentPred)) {
Yap_emit(cut_op, Zero, Zero); Yap_emit_3ops(cut_op, Zero, Zero, Zero);
Yap_emit(table_new_answer_op, Zero, CurrentPred->ArityOfPE); Yap_emit(table_new_answer_op, Zero, CurrentPred->ArityOfPE);
} }
else else
#endif /* TABLING */ #endif /* TABLING */
{ {
Yap_emit(cutexit_op, Zero, Zero); Yap_emit_3ops(cutexit_op, Zero, Zero, Zero);
} }
#ifdef TABLING #ifdef TABLING
READ_UNLOCK(CurrentPred->PRWLock); READ_UNLOCK(CurrentPred->PRWLock);
#endif #endif
} }
else { else {
Yap_emit(cut_op, Zero, Zero); Yap_emit_3ops(cut_op, Zero, Zero, Zero);
/* needs to adjust previous commits */ /* needs to adjust previous commits */
adjust_current_commits(); adjust_current_commits();
} }
@ -1611,10 +1611,9 @@ c_goal(Term Goal, int mod)
&& !(p->PredFlags & SyncPredFlag) && !(p->PredFlags & SyncPredFlag)
#endif /* YAPOR */ #endif /* YAPOR */
) { ) {
if (onlast)
Yap_emit(deallocate_op, Zero, Zero);
Yap_emit(safe_call_op, (CELL) p0, Zero); Yap_emit(safe_call_op, (CELL) p0, Zero);
if (onlast) { if (onlast) {
Yap_emit(deallocate_op, Zero, Zero);
#ifdef TABLING #ifdef TABLING
READ_LOCK(CurrentPred->PRWLock); READ_LOCK(CurrentPred->PRWLock);
if (is_tabled(CurrentPred)) if (is_tabled(CurrentPred))
@ -1842,6 +1841,8 @@ AssignPerm(PInstr *pc)
} }
#endif #endif
pc->rnd2 = nperm; pc->rnd2 = nperm;
} else if (pc->op == cut_op || pc->op == cutexit_op) {
pc->rnd2 = nperm;
} }
opc = pc; opc = pc;
pc = npc; pc = npc;
@ -2054,6 +2055,14 @@ CheckUnsafe(PInstr *pc)
pc->rnd1 = (CELL)labelno; pc->rnd1 = (CELL)labelno;
add_bvarray_op(pc, vstat, pc->rnd2); add_bvarray_op(pc, vstat, pc->rnd2);
break; break;
case cut_op:
case cutexit_op:
/* just get ourselves a label describing how
many permanent variables are alive */
Yap_emit(label_op, ++labelno, Zero);
pc->rnd1 = (CELL)labelno;
add_bvarray_op(pc, vstat, pc->rnd2);
break;
case call_op: case call_op:
Yap_emit(label_op, ++labelno, Zero); Yap_emit(label_op, ++labelno, Zero);
pc->ops.opseqt[1] = (CELL)labelno; pc->ops.opseqt[1] = (CELL)labelno;
@ -2490,6 +2499,18 @@ c_layout(void)
for (rn = 1; rn < MaxCTemps; ++rn) for (rn = 1; rn < MaxCTemps; ++rn)
*up++ = *cop++ = NIL; *up++ = *cop++ = NIL;
break; break;
case cut_op:
case cutexit_op:
{
int i, max;
max = 0;
for (i = 1; i < MaxCTemps; ++i) {
if (Contents[i]) max = i;
}
cpc->ops.opseqt[1] = max;
}
break;
case restore_tmps_and_skip_op: case restore_tmps_and_skip_op:
case restore_tmps_op: case restore_tmps_op:
/* /*
@ -2497,7 +2518,7 @@ c_layout(void)
how many temporaries are live right now. It is also useful when how many temporaries are live right now. It is also useful when
waking up goals before an either or ! instruction. waking up goals before an either or ! instruction.
*/ */
{ {
PInstr *mycpc = cpc, *oldCodeStart = CodeStart; PInstr *mycpc = cpc, *oldCodeStart = CodeStart;
int i, max; int i, max;

View File

@ -964,23 +964,25 @@ can_unify(Term t1, Term t2, Term *Vars)
{ {
t1 = Deref(t1); t1 = Deref(t1);
t2 = Deref(t2); t2 = Deref(t2);
if (t1 == t2) if (t1 == t2) {
return (TRUE); *Vars = TermNil;
return TRUE;
}
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
/* we know for sure they can't be different */ /* we know for sure they can't be different */
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
/* we need to suspend on both variables because otherwise /* we need to suspend on both variables because otherwise
Y = susp(_) would not wakeup susp ! */ Y = susp(_) would not wakeup susp ! */
*Vars = MkPairTerm(t1,MkPairTerm(t2,TermNil)); *Vars = MkPairTerm(t1,MkPairTerm(t2,TermNil));
return(TRUE); return TRUE;
} else { } else {
*Vars = MkPairTerm(t1,TermNil); *Vars = MkPairTerm(t1,TermNil);
return(TRUE); return TRUE;
} }
} else if (IsVarTerm(t2)) { } else if (IsVarTerm(t2)) {
/* wait until t2 is bound */ /* wait until t2 is bound */
*Vars = MkPairTerm(t2,TermNil); *Vars = MkPairTerm(t2,TermNil);
return(TRUE); return TRUE;
} }
/* Two standard terms at last! */ /* Two standard terms at last! */
if (IsAtomOrIntTerm(t1) || IsAtomOrIntTerm(t2)) { if (IsAtomOrIntTerm(t1) || IsAtomOrIntTerm(t2)) {
@ -988,44 +990,44 @@ can_unify(Term t1, Term t2, Term *Vars)
the same. If they are, $eq succeeds without further ado. the same. If they are, $eq succeeds without further ado.
*/ */
if (t1 != t2) if (t1 != t2)
return(FALSE); return FALSE;
else { else {
*Vars = TermNil; *Vars = TermNil;
return(TRUE); return TRUE;
} }
} else if (IsPairTerm(t1)) { } else if (IsPairTerm(t1)) {
if (IsPairTerm(t2)) { if (IsPairTerm(t2)) {
return(can_unify_complex(RepPair(t1)-1, RepPair(t1)+1, return(can_unify_complex(RepPair(t1)-1, RepPair(t1)+1,
RepPair(t2)-1, Vars)); RepPair(t2)-1, Vars));
} else return(FALSE); } else return FALSE;
} else { } else {
Functor f = FunctorOfTerm(t1); Functor f = FunctorOfTerm(t1);
if (f != FunctorOfTerm(t2)) if (f != FunctorOfTerm(t2))
return (FALSE); return FALSE;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
switch((CELL)f) { switch((CELL)f) {
case (CELL)FunctorDBRef: case (CELL)FunctorDBRef:
if (t1 == t2) return(FALSE); if (t1 == t2) return(FALSE);
return(FALSE); return FALSE;
case (CELL)FunctorLongInt: case (CELL)FunctorLongInt:
if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE); if (RepAppl(t1)[1] == RepAppl(t2)[1]) return(TRUE);
return(FALSE); return FALSE;
case (CELL)FunctorDouble: case (CELL)FunctorDouble:
if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE); if (FloatOfTerm(t1) == FloatOfTerm(t2)) return(TRUE);
return(FALSE); return FALSE;
#ifdef USE_GMP #ifdef USE_GMP
case (CELL)FunctorBigInt: case (CELL)FunctorBigInt:
if (mpz_cmp(Yap_BigIntOfTerm(t1),Yap_BigIntOfTerm(t2)) == 0) return(TRUE); if (mpz_cmp(Yap_BigIntOfTerm(t1),Yap_BigIntOfTerm(t2)) == 0) return(TRUE);
return(FALSE); return(FALSE);
#endif /* USE_GMP */ #endif /* USE_GMP */
default: default:
return(FALSE); return FALSE;
} }
} }
/* Two complex terms with the same functor */ /* Two complex terms with the same functor */
return(can_unify_complex(RepAppl(t1), return can_unify_complex(RepAppl(t1),
RepAppl(t1)+ArityOfFunctor(f), RepAppl(t1)+ArityOfFunctor(f),
RepAppl(t2), Vars)); RepAppl(t2), Vars);
} }
} }
@ -1164,10 +1166,10 @@ static Int p_can_unify(void)
#ifdef COROUTINING #ifdef COROUTINING
Term r = TermNil; Term r = TermNil;
if (!can_unify(ARG1, ARG2, &r)) if (!can_unify(ARG1, ARG2, &r))
return(FALSE); return FALSE;
return (Yap_unify(ARG3, r)); return Yap_unify(ARG3, r);
#else #else
return(FALSE); return FALSE;
#endif #endif
} }

View File

@ -257,7 +257,6 @@ STATIC_PROTO(PredEntry *new_lu_entry, (Term));
STATIC_PROTO(PredEntry *new_lu_int_key, (Int)); STATIC_PROTO(PredEntry *new_lu_int_key, (Int));
STATIC_PROTO(PredEntry *find_lu_entry, (Term)); STATIC_PROTO(PredEntry *find_lu_entry, (Term));
STATIC_PROTO(DBProp find_int_key, (Int)); STATIC_PROTO(DBProp find_int_key, (Int));
STATIC_PROTO(Term FetchTermFromDB, (DBTerm *, int));
#if OS_HANDLES_TR_OVERFLOW #if OS_HANDLES_TR_OVERFLOW
#define db_check_trail(x) #define db_check_trail(x)
@ -4021,7 +4020,7 @@ p_instance(void)
if (opc == _unify_idb_term) { if (opc == _unify_idb_term) {
return Yap_unify(ARG2, cl->ClSource->Entry); return Yap_unify(ARG2, cl->ClSource->Entry);
} else { } else {
while ((TermDB = FetchTermFromDB(cl->ClSource, 2)) == TermNil) { while ((TermDB = GetDBTerm(cl->ClSource)) == 0L) {
/* oops, we are in trouble, not enough stack space */ /* oops, we are in trouble, not enough stack space */
if (!Yap_gc(2, ENV, P)) { if (!Yap_gc(2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
@ -4031,7 +4030,7 @@ p_instance(void)
return Yap_unify(ARG2, TermDB); return Yap_unify(ARG2, TermDB);
} }
} else { } else {
while ((TermDB = GetDBTermFromDBEntry(dbr)) == (CELL)0) { while ((TermDB = GetDBTermFromDBEntry(dbr)) == 0L) {
/* oops, we are in trouble, not enough stack space */ /* oops, we are in trouble, not enough stack space */
if (!Yap_gc(2, ENV, P)) { if (!Yap_gc(2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
@ -4250,24 +4249,10 @@ cont_current_key_integer(void)
return(Yap_unify(term,ARG1) && Yap_unify(term,ARG2)); return(Yap_unify(term,ARG1) && Yap_unify(term,ARG2));
} }
static Term
FetchTermFromDB(DBTerm *ref, int args)
{
Term TDB;
while ((TDB = GetDBTerm(ref)) == (CELL)0) {
/* oops, we are in trouble, not enough stack space */
if (!Yap_gc(args, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(TermNil);
}
}
return(TDB);
}
Term Term
Yap_FetchTermFromDB(DBTerm *ref, int args) Yap_FetchTermFromDB(DBTerm *ref)
{ {
return FetchTermFromDB(ref,args); return GetDBTerm(ref);
} }
static DBTerm * static DBTerm *
@ -4433,7 +4418,12 @@ p_dequeue(void)
else else
father_key->FirstInQueue = cur_instance->next; father_key->FirstInQueue = cur_instance->next;
WRITE_UNLOCK(father_key->QRWLock); WRITE_UNLOCK(father_key->QRWLock);
TDB = FetchTermFromDB(cur_instance->DBT, 2); while ((TDB = GetDBTerm(cur_instance->DBT)) == 0L) {
if (!Yap_gc(2, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
}
/* release space for cur_instance */ /* release space for cur_instance */
keepdbrefs(cur_instance->DBT); keepdbrefs(cur_instance->DBT);
ErasePendingRefs(cur_instance->DBT); ErasePendingRefs(cur_instance->DBT);

View File

@ -138,7 +138,7 @@
OPCODE(call_bfunc_yx ,lxy), OPCODE(call_bfunc_yx ,lxy),
OPCODE(call_bfunc_yy ,lyy), OPCODE(call_bfunc_yy ,lyy),
OPCODE(cut_t ,e), OPCODE(cut_t ,e),
OPCODE(cut_e ,e), OPCODE(cut_e ,sla),
OPCODE(try_clause ,ld), OPCODE(try_clause ,ld),
OPCODE(retry ,ld), OPCODE(retry ,ld),
OPCODE(trust ,ld), OPCODE(trust ,ld),

View File

@ -487,7 +487,7 @@ int STD_PROTO(Yap_RemoveIndexation,(PredEntry *));
/* dbase.c */ /* dbase.c */
void STD_PROTO(Yap_ErDBE,(DBRef)); void STD_PROTO(Yap_ErDBE,(DBRef));
DBTerm *STD_PROTO(Yap_StoreTermInDB,(Term,int)); DBTerm *STD_PROTO(Yap_StoreTermInDB,(Term,int));
Term STD_PROTO(Yap_FetchTermFromDB,(DBTerm *,int)); Term STD_PROTO(Yap_FetchTermFromDB,(DBTerm *));
void STD_PROTO(Yap_ReleaseTermFromDB,(DBTerm *)); void STD_PROTO(Yap_ReleaseTermFromDB,(DBTerm *));
/* init.c */ /* init.c */

View File

@ -163,7 +163,7 @@ freeze(_, G) :-
% whether that is in fact the case. % whether that is in fact the case.
% %
dif(X, Y) :- '$can_unify'(X, Y, LVars), !, dif(X, Y) :- '$can_unify'(X, Y, LVars), !,
LVars = [_|_], LVars = [_|_],
'$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)). '$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)).
dif(_, _). dif(_, _).

View File

@ -293,9 +293,8 @@ clause(V,Q) :-
'$clause'(P,M,Q,_). '$clause'(P,M,Q,_).
clause(P,Q,R) :- db_reference(R), !, clause(P,Q,R) :- db_reference(R), !,
'$instance_module'(R, M),
instance(R,T), instance(R,T),
( T = (H :- B) -> P = M:H, Q = B ; P=M:T, Q = true). ( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
clause(M:P,Q,R) :- !, clause(M:P,Q,R) :- !,
'$clause'(P,M,Q,R). '$clause'(P,M,Q,R).
clause(V,Q,R) :- clause(V,Q,R) :-