a few more simple fixes
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@935 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
f5edbc8aa7
commit
2fc4750456
51
C/absmi.c
51
C/absmi.c
@ -1470,8 +1470,9 @@ Yap_absmi(int inp)
|
||||
yamop *ipc = PREG;
|
||||
|
||||
while (go_on) {
|
||||
go_on = FALSE;
|
||||
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
|
||||
|
||||
go_on = FALSE;
|
||||
switch (opnum) {
|
||||
#ifdef TABLING
|
||||
case _table_answer_resolution:
|
||||
@ -6569,11 +6570,8 @@ Yap_absmi(int inp)
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
/* same as retry */
|
||||
BOp(retry_killed, ld);
|
||||
goto retry_label;
|
||||
ENDBOp();
|
||||
|
||||
BOp(retry, ld);
|
||||
retry_label:
|
||||
CACHE_Y(B);
|
||||
restore_yaam_regs(NEXTOP(PREG, ld));
|
||||
@ -6590,12 +6588,51 @@ Yap_absmi(int inp)
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
BOp(retry, ld);
|
||||
CACHE_Y(B);
|
||||
restore_yaam_regs(NEXTOP(PREG, ld));
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
#else
|
||||
set_cut(S_YREG, B_YREG->cp_b);
|
||||
#endif /* FROZEN_STACKS */
|
||||
SET_BB(B_YREG);
|
||||
ENDCACHE_Y();
|
||||
PREG = PREG->u.ld.d;
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
/* same as trust */
|
||||
BOp(trust_killed, ld);
|
||||
goto trust_label;
|
||||
CACHE_Y(B);
|
||||
#ifdef YAPOR
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
SCH_last_alternative(PREG, B_YREG);
|
||||
restore_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B->cp_b);
|
||||
}
|
||||
else
|
||||
#endif /* YAPOR */
|
||||
{
|
||||
pop_yaam_regs();
|
||||
pop_at_least_one_arg(PREG->u.ld.s);
|
||||
#ifdef FROZEN_STACKS
|
||||
B_YREG = PROTECT_FROZEN_B(B_YREG);
|
||||
#endif /* FROZEN_STACKS */
|
||||
set_cut(S_YREG, B);
|
||||
}
|
||||
SET_BB(B_YREG);
|
||||
ENDCACHE_Y();
|
||||
PREG = PREG->u.ld.d;
|
||||
JMPNext();
|
||||
ENDBOp();
|
||||
|
||||
BOp(trust, ld);
|
||||
trust_label:
|
||||
CACHE_Y(B);
|
||||
#ifdef YAPOR
|
||||
if (SCH_top_shared_cp(B)) {
|
||||
|
@ -2080,7 +2080,7 @@ do_pass(void)
|
||||
/* static clause */
|
||||
if (pass_no) {
|
||||
cl_u->sc.Id = FunctorDBRef;
|
||||
cl_u->sc.ClFlags = 0;
|
||||
cl_u->sc.ClFlags = StaticMask;
|
||||
cl_u->sc.Owner = Yap_ConsultingFile();
|
||||
if (clause_has_blobs) {
|
||||
cl_u->sc.ClFlags |= HasBlobsMask;
|
||||
@ -2687,7 +2687,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
|
||||
}
|
||||
H = h0;
|
||||
cl = (StaticClause *)((CODEADDR)x-(UInt)size);
|
||||
cl->ClSource = x;
|
||||
cl->usc.ClSource = x;
|
||||
code_addr = (yamop *)cl;
|
||||
} else {
|
||||
while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {
|
||||
|
49
C/cdmgr.c
49
C/cdmgr.c
@ -396,16 +396,16 @@ kill_static_child_indxs(StaticIndex *indx)
|
||||
}
|
||||
|
||||
static void
|
||||
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
|
||||
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
|
||||
{
|
||||
LogUpdIndex *ncl = c->ChildIndex;
|
||||
|
||||
if (cl != NULL &&
|
||||
if (parent != NULL &&
|
||||
!(c->ClFlags & ErasedMask)) {
|
||||
if (c == cl->ChildIndex) {
|
||||
cl->ChildIndex = c->SiblingIndex;
|
||||
if (c == parent->ChildIndex) {
|
||||
parent->ChildIndex = c->SiblingIndex;
|
||||
} else {
|
||||
LogUpdIndex *tcl = cl->ChildIndex;
|
||||
LogUpdIndex *tcl = parent->ChildIndex;
|
||||
while (tcl->SiblingIndex != c) {
|
||||
tcl = tcl->SiblingIndex;
|
||||
}
|
||||
@ -421,32 +421,35 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
|
||||
}
|
||||
c->ClRefCount--;
|
||||
/* check if we are still the main index */
|
||||
if (cl == NULL &&
|
||||
if (parent == NULL &&
|
||||
ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
|
||||
RemoveMainIndex(ap);
|
||||
}
|
||||
if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
|
||||
if (cl != NULL) {
|
||||
cl->ClRefCount--;
|
||||
if (cl->ClFlags & ErasedMask && cl->ClRefCount == 0) {
|
||||
if (parent != NULL) {
|
||||
parent->ClRefCount--;
|
||||
if (parent->ClFlags & ErasedMask &&
|
||||
!(parent->ClFlags & InUseMask) &&
|
||||
parent->ClRefCount == 0) {
|
||||
/* cool, I can erase the father too. */
|
||||
if (cl->ClFlags & SwitchRootMask) {
|
||||
kill_first_log_iblock(cl, NULL, ap);
|
||||
if (parent->ClFlags & SwitchRootMask) {
|
||||
kill_first_log_iblock(parent, NULL, ap);
|
||||
} else {
|
||||
kill_first_log_iblock(cl, cl->u.ParentIndex, ap);
|
||||
kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
|
||||
}
|
||||
}
|
||||
}
|
||||
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
|
||||
#ifdef DEBUG
|
||||
{
|
||||
LogUpdIndex *cl = DBErasedIList, *c0 = NULL;
|
||||
while (cl != NULL) {
|
||||
if (c == cl) {
|
||||
LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
|
||||
while (parent != NULL) {
|
||||
if (c == parent) {
|
||||
if (c0) c0->SiblingIndex = c->SiblingIndex;
|
||||
else DBErasedIList = c->SiblingIndex;
|
||||
}
|
||||
cl = cl->SiblingIndex;
|
||||
c0 = parent;
|
||||
parent = parent->SiblingIndex;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
@ -458,11 +461,11 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
|
||||
#endif
|
||||
c->ClFlags |= ErasedMask;
|
||||
/* try to move up, so that we don't hold an index */
|
||||
if (cl != NULL &&
|
||||
cl->ClFlags & SwitchTableMask) {
|
||||
c->u.ParentIndex = cl->u.ParentIndex;
|
||||
cl->u.ParentIndex->ClRefCount++;
|
||||
cl->ClRefCount--;
|
||||
if (parent != NULL &&
|
||||
parent->ClFlags & SwitchTableMask) {
|
||||
c->u.ParentIndex = parent->u.ParentIndex;
|
||||
parent->u.ParentIndex->ClRefCount++;
|
||||
parent->ClRefCount--;
|
||||
}
|
||||
c->ChildIndex = NULL;
|
||||
}
|
||||
@ -1203,7 +1206,7 @@ addclause(Term t, yamop *cp, int mode, int mod)
|
||||
if (IsAtomTerm(t) ||
|
||||
FunctorOfTerm(t) != FunctorAssert) {
|
||||
clp->ClFlags |= FactMask;
|
||||
clp->ClSource = NULL;
|
||||
clp->usc.ClPred = p;
|
||||
}
|
||||
}
|
||||
if (compile_mode)
|
||||
@ -3202,7 +3205,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
|
||||
} else {
|
||||
Term t;
|
||||
|
||||
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
||||
while ((t = Yap_FetchTermFromDB(cl->usc.ClSource)) == 0L) {
|
||||
if (first_time) {
|
||||
if (!Yap_gc(4, YENV, P)) {
|
||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||
|
51
C/dbase.c
51
C/dbase.c
@ -4201,12 +4201,55 @@ p_erased(void)
|
||||
return (DBRefOfTerm(t)->Flags & ErasedMask);
|
||||
}
|
||||
|
||||
static Int
|
||||
static_instance(StaticClause *cl)
|
||||
{
|
||||
if (cl->ClFlags & ErasedMask) {
|
||||
return FALSE;
|
||||
}
|
||||
if (cl->ClFlags & FactMask) {
|
||||
PredEntry *ap = cl->usc.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;
|
||||
}
|
||||
} else {
|
||||
Term TermDB;
|
||||
|
||||
while ((TermDB = GetDBTerm(cl->usc.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);
|
||||
return(FALSE);
|
||||
}
|
||||
}
|
||||
return Yap_unify(ARG2, TermDB);
|
||||
}
|
||||
}
|
||||
|
||||
/* instance(+Ref,?Term) */
|
||||
static Int
|
||||
p_instance(void)
|
||||
{
|
||||
Term TermDB;
|
||||
Term t1 = Deref(ARG1);
|
||||
DBRef dbr;
|
||||
|
||||
@ -4222,7 +4265,9 @@ p_instance(void)
|
||||
} else {
|
||||
dbr = DBRefOfTerm(t1);
|
||||
}
|
||||
if (dbr->Flags & LogUpdMask) {
|
||||
if (dbr->Flags & StaticMask) {
|
||||
return static_instance((StaticClause *)dbr);
|
||||
} else if (dbr->Flags & LogUpdMask) {
|
||||
op_numbers opc;
|
||||
LogUpdClause *cl = (LogUpdClause *)dbr;
|
||||
|
||||
@ -4259,6 +4304,7 @@ p_instance(void)
|
||||
if (opc == _unify_idb_term) {
|
||||
return Yap_unify(ARG2, cl->ClSource->Entry);
|
||||
} else {
|
||||
Term TermDB;
|
||||
while ((TermDB = GetDBTerm(cl->ClSource)) == 0L) {
|
||||
/* oops, we are in trouble, not enough stack space */
|
||||
if (!Yap_gc(2, ENV, P)) {
|
||||
@ -4269,6 +4315,7 @@ p_instance(void)
|
||||
return Yap_unify(ARG2, TermDB);
|
||||
}
|
||||
} else {
|
||||
Term TermDB;
|
||||
while ((TermDB = GetDBTermFromDBEntry(dbr)) == 0L) {
|
||||
/* oops, we are in trouble, not enough stack space */
|
||||
if (!Yap_gc(2, ENV, P)) {
|
||||
|
@ -3962,6 +3962,7 @@ expand_index(PredEntry *ap) {
|
||||
}
|
||||
} else {
|
||||
op_numbers op = Yap_op_from_opcode(alt->opc);
|
||||
fprintf(stderr,"hello, %d\n", op);
|
||||
if (op == _retry ||
|
||||
op == _trust) {
|
||||
last = PREVOP(alt->u.ld.d,ld);
|
||||
|
@ -115,10 +115,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
/* extern int gc_calls; */
|
||||
|
||||
vsc_count++;
|
||||
if (vsc_count == 121085)
|
||||
vsc_xstop = 1;
|
||||
if (vsc_count < 121000LL)
|
||||
return;
|
||||
return;
|
||||
#ifdef COMMENTED
|
||||
if (port != enter_pred ||
|
||||
!pred ||
|
||||
|
@ -108,7 +108,10 @@ typedef struct static_clause {
|
||||
/* A set of flags describing info on the clause */
|
||||
Functor Id;
|
||||
CELL ClFlags;
|
||||
DBTerm *ClSource;
|
||||
union {
|
||||
DBTerm *ClSource;
|
||||
PredEntry *ClPred;
|
||||
} usc;
|
||||
Atom Owner;
|
||||
/* The instructions, at least one of the form sl */
|
||||
yamop ClCode[MIN_ARRAY];
|
||||
|
Reference in New Issue
Block a user