diff --git a/C/absmi.c b/C/absmi.c index 3691d1f73..6ef64d2c8 100644 --- a/C/absmi.c +++ b/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)) { diff --git a/C/amasm.c b/C/amasm.c index 19764850b..c9eef3fe6 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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) { diff --git a/C/cdmgr.c b/C/cdmgr.c index 7c55c6b22..569b33136 100644 --- a/C/cdmgr.c +++ b/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); diff --git a/C/dbase.c b/C/dbase.c index 7e7b2ae0c..b16da3b6d 100644 --- a/C/dbase.c +++ b/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; iClCode; + 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)) { diff --git a/C/index.c b/C/index.c index 26e89a362..3d735b109 100644 --- a/C/index.c +++ b/C/index.c @@ -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); diff --git a/C/tracer.c b/C/tracer.c index 70dd3917b..36f213e65 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -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 || diff --git a/H/clause.h b/H/clause.h index e3bf8a04d..ed8a03b83 100644 --- a/H/clause.h +++ b/H/clause.h @@ -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];