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:
parent
76160f72a8
commit
526ec2e50f
@ -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();
|
||||||
}
|
}
|
||||||
|
26
C/amasm.c
26
C/amasm.c
@ -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)
|
||||||
{
|
{
|
||||||
|
16
C/arrays.c
16
C/arrays.c
@ -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
21
C/bb.c
@ -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);
|
||||||
|
60
C/cdmgr.c
60
C/cdmgr.c
@ -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
|
||||||
|
33
C/compiler.c
33
C/compiler.c
@ -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;
|
||||||
|
|
||||||
|
38
C/corout.c
38
C/corout.c
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
30
C/dbase.c
30
C/dbase.c
@ -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);
|
||||||
|
@ -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),
|
||||||
|
@ -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 */
|
||||||
|
@ -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(_, _).
|
||||||
|
|
||||||
|
@ -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) :-
|
||||||
|
Reference in New Issue
Block a user