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

call the garbage collector the right way

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
C/absmi.c
View File

@ -1185,7 +1185,14 @@ Yap_absmi(int inp)
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
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)) {
FAIL();
}

26
C/amasm.c
View File

@ -376,9 +376,10 @@ a_cle(op_numbers opcode)
inline static void
a_e(op_numbers opcode)
{
if (pass_no)
if (pass_no) {
code_p->opc = emit_op(opcode);
GONEXT(e);
}
GONEXT(e);
}
inline static void
@ -1199,6 +1200,27 @@ a_ifnot(op_numbers opcode)
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
a_cut(void)
{

16
C/arrays.c
View File

@ -259,7 +259,12 @@ AccessNamedArray(Atom a, Int indx)
READ_UNLOCK(ptr->ArRWLock);
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 {
P = (yamop *)FAILCODE;
TRef = TermNil;
@ -1917,7 +1922,12 @@ p_static_array_to_term(void)
Term TRef;
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 {
P = (yamop *)FAILCODE;
TRef = TermNil;
@ -1960,6 +1970,6 @@ Yap_InitArrayPreds(void)
Yap_InitCPred("$compile_array_refs", 0, p_compile_array_refs, 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_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)
return(FALSE);
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);
return(Yap_unify(ARG2,out));
}
@ -286,7 +291,12 @@ p_bb_delete(void)
p = FetchBBProp(t1, "bb_delete/2", CurrentModule);
if (p == NULL || p->Element == NULL)
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);
Yap_ReleaseTermFromDB(p->Element);
p->Element = NULL;
@ -305,7 +315,12 @@ p_bb_update(void)
if (p == NULL || p->Element == NULL)
return(FALSE);
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)) {
WRITE_UNLOCK(p->BBRWLock);
return(FALSE);

60
C/cdmgr.c
View File

@ -2918,7 +2918,7 @@ get_pred(Term t1, Term tmod, char *command)
}
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);
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)
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);
#if defined(OR) || defined(THREADS)
LOCK(cl->ClLock);
@ -2959,7 +2971,7 @@ p_log_update_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
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) */
@ -2968,18 +2980,30 @@ p_continue_log_update_clause(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
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
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);
Term t;
if (cl == NULL)
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) {
return(Yap_unify(th, ArgOfTerm(1,t)) &&
Yap_unify(tb, ArgOfTerm(2,t)));
@ -2998,7 +3022,7 @@ p_log_update_clause0(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
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) */
@ -3007,18 +3031,30 @@ p_continue_log_update_clause0(void)
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
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
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);
Term t;
if (cl == NULL)
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 (!(Yap_unify(th, ArgOfTerm(1,t)) &&
Yap_unify(tb, ArgOfTerm(2,t))))
@ -3041,7 +3077,7 @@ p_log_update_retract(void)
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);
return fetch_next_lu_retract(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
}
static Int /* $hidden_predicate(P) */
@ -3050,7 +3086,7 @@ 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);
return fetch_next_lu_retract(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
}
#ifdef LOW_PROF

33
C/compiler.c
View File

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

38
C/corout.c
View File

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

30
C/dbase.c
View File

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

2
H/YapOpcodes.h
View File

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

2
m4/Yatom.h.m4
View File

@ -487,7 +487,7 @@ int STD_PROTO(Yap_RemoveIndexation,(PredEntry *));
/* dbase.c */
void STD_PROTO(Yap_ErDBE,(DBRef));
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 *));
/* init.c */

2
pl/corout.yap
View File

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

3
pl/preds.yap
View File

@ -293,9 +293,8 @@ clause(V,Q) :-
'$clause'(P,M,Q,_).
clause(P,Q,R) :- db_reference(R), !,
'$instance_module'(R, M),
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'(P,M,Q,R).
clause(V,Q,R) :-