From 90829edc9ee5d0488ade9b8fedb74e91b74fabde Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 26 Nov 2003 18:36:35 +0000 Subject: [PATCH] new infrastructure for static clauses: they are now valid references they don't have the try_me block jump_on_var now uses expand git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@936 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 1 - C/amasm.c | 17 ++- C/cdmgr.c | 385 +++++++++++++++++++++++-------------------------- C/dbase.c | 36 ++++- C/exec.c | 21 +-- C/index.c | 79 ++++------ C/init.c | 4 - C/iopreds.c | 40 ----- C/tracer.c | 1 - H/clause.h | 8 +- H/rheap.h | 16 +- pl/boot.yap | 61 ++------ pl/checker.yap | 17 +-- pl/consult.yap | 59 ++++---- pl/init.yap | 3 + pl/modules.yap | 1 - pl/preds.yap | 23 ++- 17 files changed, 351 insertions(+), 421 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 6ef64d2c8..314e16c25 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -6572,7 +6572,6 @@ Yap_absmi(int inp) /* same as retry */ BOp(retry_killed, ld); - retry_label: CACHE_Y(B); restore_yaam_regs(NEXTOP(PREG, ld)); restore_at_least_one_arg(PREG->u.ld.s); diff --git a/C/amasm.c b/C/amasm.c index c9eef3fe6..a11d44bed 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -1016,7 +1016,7 @@ a_igl(op_numbers opcode) { if (pass_no) { code_p->opc = emit_op(opcode); - code_p->u.l.l = emit_a(cpc->rnd1); + code_p->u.l.l = emit_ilabel(cpc->rnd1); } GONEXT(l); } @@ -2048,7 +2048,6 @@ do_pass(void) if (pass_no) { cl_u->luc.Id = FunctorDBRef; cl_u->luc.ClFlags = LogUpdMask; - cl_u->luc.Owner = Yap_ConsultingFile(); cl_u->luc.ClRefCount = 0; cl_u->luc.ClPred = CurrentPred; if (clause_has_blobs) { @@ -2065,7 +2064,6 @@ do_pass(void) } else if (dynamic) { if (pass_no) { cl_u->ic.ClFlags = DynamicMask; - cl_u->ic.Owner = Yap_ConsultingFile(); if (clause_has_blobs) { cl_u->ic.ClFlags |= HasBlobsMask; } @@ -2081,7 +2079,7 @@ do_pass(void) if (pass_no) { cl_u->sc.Id = FunctorDBRef; cl_u->sc.ClFlags = StaticMask; - cl_u->sc.Owner = Yap_ConsultingFile(); + cl_u->sc.ClNext = NULL; if (clause_has_blobs) { cl_u->sc.ClFlags |= HasBlobsMask; } @@ -2090,7 +2088,7 @@ do_pass(void) } IPredArity = cpc->rnd2; /* number of args */ entry_code = code_p; - if (!log_update) { + if (dynamic) { #ifdef YAPOR a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, 1, 0); #else @@ -2687,8 +2685,15 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact) } H = h0; cl = (StaticClause *)((CODEADDR)x-(UInt)size); - cl->usc.ClSource = x; code_addr = (yamop *)cl; + entry_code = do_pass(); + /* make sure we copy after second pass */ + cl->usc.ClSource = x; + YAPLeaveCriticalSection(); +#ifdef LOW_PROF + Yap_prof_end=code_p; +#endif + return entry_code; } else { while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) { if (!Yap_growheap(TRUE, size)) { diff --git a/C/cdmgr.c b/C/cdmgr.c index 569b33136..786ed86ba 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -231,11 +231,8 @@ RemoveMainIndex(PredEntry *ap) ap->PredFlags &= ~IndexedPredFlag; if (First == NULL) { ap->cs.p_code.TrueCodeOfPred = FAILCODE; - } else if (First != ap->cs.p_code.LastClause || - ap->PredFlags & LogUpdatePredFlag) { + } else { ap->cs.p_code.TrueCodeOfPred = First; - } else { - ap->cs.p_code.TrueCodeOfPred = NEXTOP(First,ld); } if (First != NULL && spied) { ap->OpcodeOfPred = Yap_opcode(_spy_pred); @@ -578,7 +575,6 @@ Yap_RemoveIndexation(PredEntry *ap) static void retract_all(PredEntry *p, int in_use) { - int multifile_pred = p->PredFlags & MultiFileFlag; yamop *fclause = NULL, *lclause = NULL; yamop *q; @@ -588,48 +584,25 @@ retract_all(PredEntry *p, int in_use) LogUpdClause *cl = ClauseCodeToLogUpdClause(q); do { LogUpdClause *ncl = cl->ClNext; - if (multifile_pred && cl->Owner != YapConsultingFile()) { - yamop *q1 = cl->ClCode; - - if (fclause == NULL) { - fclause = q1; - } else { - yamop *clp = (yamop *)lclause; - clp->u.ld.d = q1; - } - lclause = q1; - } else { - Yap_ErLogUpdCl(cl); - } + Yap_ErLogUpdCl(cl); cl = ncl; } while (cl != NULL); } else { - yamop *q1; + StaticClause *cl = ClauseCodeToStaticClause(q); + do { - StaticClause *cl; - q1 = q; - q = NextClause(q); - cl = ClauseCodeToStaticClause(q1); - if (multifile_pred && cl->Owner != YapConsultingFile()) { - if (fclause == NULL) { - fclause = q1; - } else { - yamop *clp = (yamop *)lclause; - clp->u.ld.d = q1; - } - lclause = q1; + if (cl->ClFlags & HasBlobsMask) { + DeadClause *dcl = (DeadClause *)cl; + dcl->NextCl = DeadClauses; + dcl->ClFlags = 0; + DeadClauses = dcl; } else { - if (cl->ClFlags & HasBlobsMask) { - DeadClause *dcl = (DeadClause *)cl; - dcl->NextCl = DeadClauses; - dcl->ClFlags = 0; - DeadClauses = dcl; - } else { - Yap_FreeCodeSpace((char *)cl); - } - p->cs.p_code.NOfClauses--; + Yap_FreeCodeSpace((char *)cl); } - } while (q1 != p->cs.p_code.LastClause); + p->cs.p_code.NOfClauses--; + if (cl->ClCode == p->cs.p_code.LastClause) break; + cl = cl->ClNext; + } while (TRUE); } } p->cs.p_code.FirstClause = fclause; @@ -645,28 +618,10 @@ retract_all(PredEntry *p, int in_use) p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfRetries = 0; } else { - if (!(p->PredFlags & LogUpdatePredFlag)) { - yamop *cpt = (yamop *)fclause; - cpt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); - if (fclause == lclause) { - p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = NEXTOP(cpt,ld); - p->OpcodeOfPred = NEXTOP(cpt,ld)->opc; - } else { - p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = fclause; - p->OpcodeOfPred = cpt->opc; - if (p->PredFlags & ProfiledPredFlag) { - ((yamop *)lclause)->opc = Yap_opcode(_profiled_trust_me); - } else if (p->PredFlags & CountPredFlag) { - ((yamop *)lclause)->opc = Yap_opcode(_count_trust_me); - } else { - ((yamop *)lclause)->opc = Yap_opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p))); - } - } - } if (p->PredFlags & SpiedPredFlag) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); - } else if ((p->PredFlags & IndexedPredFlag) && p->ArityOfPE) { + } else if (p->PredFlags & IndexedPredFlag) { p->OpcodeOfPred = INDEX_OPCODE; p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } @@ -705,15 +660,11 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag) #endif /* YAPOR */ #ifdef TABLING if (is_tabled(p)) { - pt->u.ld.te = p->TableOfPred; + pt->u.ld.te = p->TableOfPred; XXXXX pt->opc = Yap_opcode(_table_try_me_single); } else #endif /* TABLING */ - pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); - pt->u.ld.d = cp; - pt->u.ld.p = p; - pt = NEXTOP(pt, ld); } p->cs.p_code.TrueCodeOfPred = pt; p->cs.p_code.FirstClause = p->cs.p_code.LastClause = cp; @@ -733,7 +684,9 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag) p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } - if (yap_flags[SOURCE_MODE_FLAG]) { + if ((yap_flags[SOURCE_MODE_FLAG] || + (p->PredFlags & MultiFileFlag)) && + !(p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { p->PredFlags |= SourcePredFlag; } else { p->PredFlags &= ~SourcePredFlag; @@ -824,19 +777,19 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) /* p is already locked */ static void -asserta_stat_clause(PredEntry *p, yamop *cp, int spy_flag) +asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag) { - yamop *q = (yamop *)cp; + StaticClause *cl = ClauseCodeToStaticClause(q); p->cs.p_code.NOfClauses++; if (is_logupd(p)) { LogUpdClause *clp = ClauseCodeToLogUpdClause(p->cs.p_code.FirstClause), - *clq = ClauseCodeToLogUpdClause(cp); + *clq = ClauseCodeToLogUpdClause(q); clq->ClPrev = NULL; clq->ClNext = clp; clp->ClPrev = clq; - p->cs.p_code.FirstClause = cp; + p->cs.p_code.FirstClause = q; if (p->PredFlags & SpiedPredFlag) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); @@ -846,47 +799,17 @@ asserta_stat_clause(PredEntry *p, yamop *cp, int spy_flag) } return; } - q->u.ld.d = p->cs.p_code.FirstClause; - q->u.ld.p = p; + cl->ClNext = ClauseCodeToStaticClause(p->cs.p_code.FirstClause); #ifdef YAPOR PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->cs.p_code.FirstClause)) + 1); #endif /* YAPOR */ #ifdef TABLING - if (is_tabled(p)) + if (is_tabled(p)) XXX q->opc = Yap_opcode(_table_try_me); else #endif /* TABLING */ - q->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); - q = (yamop *)(p->cs.p_code.FirstClause); - if (p->PredFlags & ProfiledPredFlag) { - if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) - q->opc = Yap_opcode(_profiled_trust_me); - else - q->opc = Yap_opcode(_profiled_retry_me); - } else if (p->PredFlags & CountPredFlag) { - if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) - q->opc = Yap_opcode(_count_trust_me); - else - q->opc = Yap_opcode(_count_retry_me); - } else { - if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { -#ifdef TABLING - if (is_tabled(p)) - q->opc = Yap_opcode(_table_trust_me); - else -#endif /* TABLING */ - q->opc = Yap_opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p))); - } else { -#ifdef TABLING - if (is_tabled(p)) - q->opc = Yap_opcode(_table_retry_me); - else -#endif /* TABLING */ - q->opc = Yap_opcode(TRYCODE(_retry_me, _retry_me0, PredArity(p))); - } - } - p->cs.p_code.FirstClause = cp; - p->cs.p_code.TrueCodeOfPred = cp; + p->cs.p_code.FirstClause = q; + p->cs.p_code.TrueCodeOfPred = q; if (p->PredFlags & SpiedPredFlag) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); @@ -894,7 +817,7 @@ asserta_stat_clause(PredEntry *p, yamop *cp, int spy_flag) p->OpcodeOfPred = INDEX_OPCODE; p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } - p->cs.p_code.LastClause->u.ld.d = cp; + p->cs.p_code.LastClause->u.ld.d = q; } /* p is already locked */ @@ -934,6 +857,7 @@ static void assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag) { yamop *pt; + p->cs.p_code.NOfClauses++; pt = p->cs.p_code.LastClause; if (is_logupd(p)) { @@ -954,64 +878,26 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag) } return; } - if (p->PredFlags & ProfiledPredFlag) { - if (p->cs.p_code.FirstClause == pt) { - pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); - p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause; - } else - pt->opc = Yap_opcode(_profiled_retry_me); - } else if (p->PredFlags & CountPredFlag) { - if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { - pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); - p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause; - } else - pt->opc = Yap_opcode(_count_retry_me); - } else { - if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { -#ifdef TABLING - if (is_tabled(p)) - pt->opc = Yap_opcode(_table_try_me); - else -#endif /* TABLING */ - pt->opc = Yap_opcode(TRYCODE(_try_me, _try_me0, PredArity(p))); - p->cs.p_code.TrueCodeOfPred = p->cs.p_code.FirstClause; - if (!(p->PredFlags & SpiedPredFlag) && p->ArityOfPE) { - p->OpcodeOfPred = INDEX_OPCODE; - p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); - } - } else { -#ifdef TABLING - if (is_tabled(p)) - pt->opc = Yap_opcode(_table_retry_me); - else -#endif /* TABLING */ - pt->opc = Yap_opcode(TRYCODE(_retry_me, _retry_me0, PredArity(p))); + if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { + if (!(p->PredFlags & SpiedPredFlag)) { + p->OpcodeOfPred = INDEX_OPCODE; + p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } } - pt->u.ld.d = cp; - p->cs.p_code.LastClause = cp; - pt = (yamop *)cp; - if (p->PredFlags & ProfiledPredFlag) { - pt->opc = Yap_opcode(_profiled_trust_me); - } else if (p->PredFlags & CountPredFlag) { - pt->opc = Yap_opcode(_count_trust_me); - } else { -#ifdef TABLING - if (is_tabled(p)) - pt->opc = Yap_opcode(_table_trust_me); - else -#endif /* TABLING */ - pt->opc = Yap_opcode(TRYCODE(_trust_me, _trust_me0, PredArity(p))); + { + StaticClause *cl = ClauseCodeToStaticClause(pt); + cl->ClNext = ClauseCodeToStaticClause(cp); } - pt->u.ld.d = p->cs.p_code.FirstClause; + p->cs.p_code.LastClause = cp; #ifdef YAPOR { - yamop *code; + StaticClause *cl = ClauseCodeToStaticClause(p->cs.p_code.FirstClause); - code = p->cs.p_code.FirstClause; - while (code != p->cs.p_code.LastClause){ - PUT_YAMOP_LTT((yamop *)code, YAMOP_LTT((yamop *)code) + 1); - code = NextClause(code); + while (TRUE) { + PUT_YAMOP_LTT((yamop *)code, YAMOP_LTT(cl->ClCode) + 1); + if (cl->ClCode == p->cs.p_code.LastClause) + break; + cl = cl->NextCl; } } #endif /* YAPOR */ @@ -1088,12 +974,11 @@ not_was_reconsulted(PredEntry *p, Term t, int mode) expand_consult(); --ConsultSp; ConsultSp->p = p0; - if (ConsultBase[1].mode) /* we are in reconsult mode */ { + if (ConsultBase[1].mode && + !(p->PredFlags & MultiFileFlag)) /* we are in reconsult mode */ { retract_all(p, static_in_use(p,TRUE)); } - if (!(p->PredFlags & MultiFileFlag)) { - p->src.OwnerFile = YapConsultingFile(); - } + p->src.OwnerFile = YapConsultingFile(); } return (TRUE); /* careful */ } @@ -1254,6 +1139,88 @@ Yap_addclause(Term t, yamop *cp, int mode, int mod) { addclause(t, cp, mode, mod); } +void +Yap_EraseStaticClause(StaticClause *cl, SMALLUNSGN mod) { + PredEntry *ap; + + /* ok, first I need to find out the parent predicate */ + if (cl->ClFlags & FactMask) { + ap = cl->usc.ClPred; + } else { + Term t = ArgOfTerm(1,cl->usc.ClSource->Entry); + if (IsAtomTerm(t)) { + Atom at = AtomOfTerm(t); + ap = RepPredProp(Yap_GetPredPropByAtom(at, mod)); + } else { + Functor fun = FunctorOfTerm(t); + ap = RepPredProp(Yap_GetPredPropByFunc(fun, mod)); + } + } + WRITE_LOCK(ap->PRWLock); + if (ap->PredFlags & IndexedPredFlag) + RemoveIndexation(ap); + ap->cs.p_code.NOfClauses--; + if (ap->cs.p_code.FirstClause == cl->ClCode) { + /* got rid of first clause */ + if (ap->cs.p_code.LastClause == cl->ClCode) { + /* got rid of all clauses */ + ap->cs.p_code.LastClause = ap->cs.p_code.FirstClause = NULL; + ap->OpcodeOfPred = UNDEF_OPCODE; + ap->cs.p_code.TrueCodeOfPred = + (yamop *)(&(ap->OpcodeOfPred)); + } else { + yamop *ncl = cl->ClNext->ClCode; + ap->cs.p_code.FirstClause = ncl; + ncl->opc = Yap_opcode(_try_me); + ap->cs.p_code.TrueCodeOfPred = + ncl; + ap->OpcodeOfPred = ncl->opc; + } + } else { + StaticClause *pcl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause), + *ocl = NULL; + + while (pcl != cl) { + ocl = pcl; + pcl = pcl->ClNext; + } + ocl->ClCode->u.ld.d = cl->ClCode->u.ld.d; + ocl->ClNext = cl->ClNext; + if (cl->ClCode == ap->cs.p_code.LastClause) { + ap->cs.p_code.LastClause = ocl->ClCode; + if (ap->cs.p_code.NOfClauses > 1) + ocl->ClCode->opc = Yap_opcode(_trust_me); + } + } + if (ap->cs.p_code.NOfClauses == 1) { + ap->cs.p_code.TrueCodeOfPred = + ap->cs.p_code.FirstClause; + ap->OpcodeOfPred = + ap->cs.p_code.TrueCodeOfPred->opc; + } + WRITE_UNLOCK(ap->PRWLock); + if (cl->ClFlags & HasBlobsMask || static_in_use(ap,TRUE)) { + DeadClause *dcl = (DeadClause *)cl; + dcl->NextCl = DeadClauses; + dcl->ClFlags = 0; + DeadClauses = dcl; + } else { + Yap_FreeCodeSpace((char *)cl); + } + if (ap->cs.p_code.NOfClauses == 0) { + ap->CodeOfPred = + ap->cs.p_code.TrueCodeOfPred; + } else if (ap->cs.p_code.NOfClauses > 1) { + ap->OpcodeOfPred = INDEX_OPCODE; + ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); + } else if (ap->PredFlags & SpiedPredFlag) { + ap->OpcodeOfPred = Yap_opcode(_spy_pred); + ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); + } else { + ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred; + } +} + void Yap_add_logupd_clause(PredEntry *pe, LogUpdClause *cl, int mode) { yamop *cp = cl->ClCode; @@ -1614,14 +1581,9 @@ p_purge_clauses(void) cl = ncl; } while (cl != NULL); } else { - yamop *q1; + StaticClause *cl = ClauseCodeToStaticClause(q); do { - StaticClause *cl; - - q1 = q; - q = NextClause(q); - cl = ClauseCodeToStaticClause(q1); if (cl->ClFlags & HasBlobsMask || in_use) { DeadClause *dcl = (DeadClause *)cl; dcl->NextCl = DeadClauses; @@ -1630,7 +1592,9 @@ p_purge_clauses(void) } else { Yap_FreeCodeSpace((char *)cl); } - } while (q1 != pred->cs.p_code.LastClause); + if (cl->ClCode == pred->cs.p_code.LastClause) break; + cl = cl->ClNext; + } while (TRUE); } } pred->cs.p_code.FirstClause = pred->cs.p_code.LastClause = NULL; @@ -1845,6 +1809,10 @@ p_new_multifile(void) pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity),mod)); WRITE_LOCK(pe->PRWLock); pe->PredFlags |= MultiFileFlag; + if (!(pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { + /* static */ + pe->PredFlags |= SourcePredFlag; + } WRITE_UNLOCK(pe->PRWLock); return (TRUE); } @@ -2120,16 +2088,16 @@ p_kill_dynamic(void) t = Deref(ARG1); if (IsAtomTerm(t)) { Atom at = AtomOfTerm(t); - pe = RepPredProp(PredPropByAtom(at, mod)); + pe = RepPredProp(Yap_GetPredPropByAtom(at, mod)); } else if (IsApplTerm(t)) { Functor funt = FunctorOfTerm(t); - pe = RepPredProp(PredPropByFunc(funt, mod)); + pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod)); } else return (FALSE); if (EndOfPAEntr(pe)) return (TRUE); WRITE_LOCK(pe->PRWLock); - if (!(pe->PredFlags & DynamicPredFlag)) { + if (!(pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) { WRITE_UNLOCK(pe->PRWLock); return (FALSE); } @@ -2175,17 +2143,16 @@ p_compile_mode(void) #if !defined(YAPOR) static yamop *cur_clause(PredEntry *pe, yamop *codeptr) { - yamop *clcode; StaticClause *cl; - clcode = pe->cs.p_code.FirstClause; - cl = ClauseCodeToStaticClause(clcode); + + cl = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause); do { if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) { - return((yamop *)clcode); + return cl->ClCode; } - if (clcode == pe->cs.p_code.LastClause) + if (cl->ClCode == pe->cs.p_code.LastClause) break; - cl = ClauseCodeToStaticClause(clcode = NextClause(clcode)); + cl = cl->ClNext; } while (TRUE); Yap_Error(SYSTEM_ERROR,TermNil,"could not find clause for indexing code"); return(NULL); @@ -2577,15 +2544,11 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { i++; cl = cl->ClNext; } while (cl != NULL); - } else { + } else if (pp->PredFlags & DynamicPredFlag) { do { CODEADDR cl; - if (!(pp->PredFlags & DynamicPredFlag)) { - cl = (CODEADDR)ClauseCodeToStaticClause(clcode); - } else { - cl = (CODEADDR)ClauseCodeToDynamicClause(clcode); - } + cl = (CODEADDR)ClauseCodeToDynamicClause(clcode); if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) { clause_was_found(pp, pat, parity); READ_UNLOCK(pp->PRWLock); @@ -2594,7 +2557,22 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) { if (clcode == pp->cs.p_code.LastClause) break; i++; - clcode = NextClause(clcode); + clcode = NextDynamicClause(clcode); + } while (TRUE); + } else { + StaticClause *cl; + + cl = ClauseCodeToStaticClause(clcode); + do { + if (IN_BLOCK(codeptr,cl,Yap_SizeOfBlock((CODEADDR)cl))) { + clause_was_found(pp, pat, parity); + READ_UNLOCK(pp->PRWLock); + return i; + } + if (cl->ClCode == pp->cs.p_code.LastClause) + break; + i++; + cl = cl->ClNext; } while (TRUE); } } @@ -3012,7 +2990,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, int first_time) { - LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr); + LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr); Term rtn; if (cl == NULL) @@ -3100,7 +3078,7 @@ p_continue_log_update_clause(void) static Int fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time) { - LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr); + LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr); if (cl == NULL) return FALSE; @@ -3173,7 +3151,7 @@ p_continue_log_update_clause0(void) static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time) { - StaticClause *cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NextClause(PredStaticClause->cs.p_code.FirstClause), cp_ptr); + StaticClause *cl = (StaticClause *)Yap_follow_indexing_code(pe, i_code, th, tb, tr, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr); Term rtn; if (cl == NULL) @@ -3199,7 +3177,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr YENV = ASP; YENV[E_CB] = (CELL) B; } - P = NEXTOP(cl->ClCode,ld); + P = cl->ClCode; } return TRUE; } else { @@ -3290,21 +3268,28 @@ add_code_in_pred(PredEntry *pp) { Yap_inform_profiler_of_clause(cl->ClCode, (yamop *)code_end, pp); cl = cl->ClNext; } while (cl != NULL); - } else { + } else if (pp->PredFlags & DynamicPredFlag) { do { CODEADDR cl; char *code_end; - if (!(pp->PredFlags & DynamicPredFlag)) { - cl = (CODEADDR)ClauseCodeToDynamicClause(clcode); - } else { - cl = (CODEADDR)ClauseCodeToStaticClause(clcode); - } + cl = (CODEADDR)ClauseCodeToDynamicClause(clcode); code_end = cl + Yap_SizeOfBlock((CODEADDR)cl); Yap_inform_profiler_of_clause(clcode, (yamop *)code_end, pp); if (clcode == pp->cs.p_code.LastClause) break; - clcode = NextClause(clcode); + clcode = NextDynamicClause(clcode); + } while (TRUE); + } else { + StaticClause *cl = ClauseCodeToStaticClause(clcode); + do { + char *code_end; + + code_end = (char *)cl + Yap_SizeOfBlock((CODEADDR)cl); + Yap_inform_profiler_of_clause(cl->ClCode, (yamop *)code_end, pp); + if (cl->ClCode == pp->cs.p_code.FirstClause) + break; + cl = cl->ClNext; } while (TRUE); } } @@ -3355,17 +3340,15 @@ static Int static_statistics(PredEntry *pe) { UInt sz = 0, cls = 0, isz = 0; - StaticClause *cl; - yamop *ipc = pe->cs.p_code.FirstClause; + StaticClause *cl = ClauseCodeToStaticClause(pe->cs.p_code.FirstClause); - if (ipc != NULL) { + if (pe->cs.p_code.NOfClauses) { do { - cl = ClauseCodeToStaticClause(ipc); cls++; sz += Yap_SizeOfBlock((CODEADDR)cl); - if (ipc == pe->cs.p_code.LastClause) + if (cl->ClCode == pe->cs.p_code.LastClause) break; - ipc = NextClause(ipc); + cl = cl->ClNext; } while (TRUE); } if (pe->cs.p_code.NOfClauses > 1 && diff --git a/C/dbase.c b/C/dbase.c index b16da3b6d..fbf3698c2 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -693,7 +693,9 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, #ifdef IDB_LINK_TABLE lr--; #endif - dbentry->NOfRefsTo++; + if (!(dbentry->Flags & StaticMask)) { + dbentry->NOfRefsTo++; + } *--tofref = dbentry; /* just continue the loop */ ++ pt0; @@ -1807,7 +1809,6 @@ record_lu(PredEntry *pe, Term t, int position) cl->Id = FunctorDBRef; cl->ClFlags = LogUpdMask; cl->ClSource = x; - cl->Owner = AtomUser; cl->ClRefCount = 0; cl->ClPred = pe; cl->ClExt = NULL; @@ -4057,6 +4058,9 @@ EraseEntry(DBRef entryref) if (entryref->Flags & ErasedMask) return; + if (entryref->Flags & StaticMask) { + return; + } if (entryref->Flags & LogUpdMask && !(entryref->Flags & DBClMask)) { EraseLogUpdCl((LogUpdClause *)entryref); @@ -4114,6 +4118,31 @@ p_erase(void) return (TRUE); } +static Int +p_erase_clause(void) +{ + Term t1 = Deref(ARG1); + DBRef entryref; + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR, t1, "erase"); + return (FALSE); + } + if (!IsDBRefTerm(t1)) { + Yap_Error(TYPE_ERROR_DBREF, t1, "erase"); + return (FALSE); + } + entryref = DBRefOfTerm(t1); + if (entryref->Flags & StaticMask) { + if (entryref->Flags & ErasedMask) + return FALSE; + Yap_EraseStaticClause((StaticClause *)entryref, Yap_LookupModule(Deref(ARG2))); + return TRUE; + } + EraseEntry(DBRefOfTerm(t1)); + return TRUE; +} + /* eraseall(+Key) */ static Int p_eraseall(void) @@ -4834,9 +4863,8 @@ Yap_InitDBPreds(void) Yap_InitCPred("$recordzp", 3, p_rcdzp, SyncPredFlag); Yap_InitCPred("$recordap", 4, p_drcdap, SyncPredFlag); Yap_InitCPred("$recordzp", 4, p_drcdzp, SyncPredFlag); - // Yap_InitCPred("$recordaifnot", 3, p_rcdaifnot, SyncPredFlag); - // Yap_InitCPred("$recordzifnot", 3, p_rcdzifnot, SyncPredFlag); Yap_InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$erase_clause", 2, p_erase_clause, SafePredFlag|SyncPredFlag); Yap_InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag); Yap_InitCPred("instance", 2, p_instance, SyncPredFlag); Yap_InitCPred("$instance_module", 2, p_instance_module, SyncPredFlag); diff --git a/C/exec.c b/C/exec.c index 34343f741..240758ec5 100644 --- a/C/exec.c +++ b/C/exec.c @@ -144,12 +144,12 @@ CallClause(PredEntry *pen, Int position) CLAUSECODE->func = pen->FunctorOfPred; while (position > 1) { while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask) - q = NextClause(q); + q = NextDynamicClause(q); position--; - q = NextClause(q); + q = NextDynamicClause(q); } while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask) - q = NextClause(q); + q = NextDynamicClause(q); #if defined(YAPOR) || defined(THREADS) { DynamicClause *cl = ClauseCodeToDynamicClause(q); @@ -166,7 +166,7 @@ CallClause(PredEntry *pen, Int position) *opp |= InUseMask; } #endif - CLAUSECODE->clause = NEXTOP((yamop *)(q),ld); + CLAUSECODE->clause = NEXTOP(q,ld); P = CLAUSECODE->clause; WRITE_UNLOCK(pen->PRWLock); return((CELL)(&(CLAUSECODE->clause))); @@ -178,9 +178,11 @@ CallClause(PredEntry *pen, Int position) WRITE_UNLOCK(pen->PRWLock); return (Unsigned(pen)); } else { + /* static clause */ + LogUpdClause *cl = ClauseCodeToLogUpdClause(q); for (; position > 1; position--) - q = NextClause(q); - P = NEXTOP((yamop *)(q),ld); + cl = cl->ClNext; + P = cl->ClCode; WRITE_UNLOCK(pen->PRWLock); return (Unsigned(pen)); } @@ -1469,7 +1471,8 @@ p_clean_ifcp(void) { static Int JumpToEnv(Term t) { - yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,ld); + yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,ld), + *catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,ld); CELL *env; choiceptr first_func = NULL, B0 = B; @@ -1477,7 +1480,7 @@ JumpToEnv(Term t) { /* find the first choicepoint that may be a catch */ while (B != NULL && B->cp_ap != pos) { /* we are already doing a catch */ - if (B->cp_ap == PredHandleThrow->cs.p_code.LastClause) { + if (B->cp_ap == catchpos) { P = (yamop *)FAILCODE; if (first_func != NULL) { B = first_func; @@ -1511,7 +1514,7 @@ JumpToEnv(Term t) { } while (TRUE); /* step one environment above */ B->cp_cp = (yamop *)env[E_CP]; - B->cp_ap = PredHandleThrow->cs.p_code.LastClause; + B->cp_ap = NEXTOP(PredHandleThrow->CodeOfPred,ld); B->cp_env = (CELL *)env[E_E]; /* cannot recover Heap because of copy term :-( */ B->cp_h = H; diff --git a/C/index.c b/C/index.c index 3d735b109..f47d831dc 100644 --- a/C/index.c +++ b/C/index.c @@ -2650,18 +2650,7 @@ do_var_entries(GroupDef *grp, Term t, PredEntry *ap, UInt argno, int first, int if (!IsVarTerm(t) || t != 0L) { return suspend_indexing(grp->FirstClause, grp->LastClause, ap); } - if (argno == 1 && !(ap->PredFlags & LogUpdatePredFlag)) { - /* in this case we want really to jump to the first clause */ - if (first && clleft == 0) { - /* not protected by a choice-point */ - return (UInt)PREVOP(grp->FirstClause->Code,ld); - } else { - /* this code should never execute */ - return nxtlbl; - } - } else { - return do_var_group(grp, ap, FALSE, first, clleft, nxtlbl, ap->ArityOfPE+1); - } + return do_var_group(grp, ap, FALSE, first, clleft, nxtlbl, ap->ArityOfPE+1); } static UInt @@ -2952,16 +2941,8 @@ do_optims(GroupDef *group, int ngroups, UInt fail_l, ClauseDef *min, PredEntry * sp = Yap_emit_extra_size(if_not_op, Zero, 4*CellSize); sp[0] = (CELL)(group[0].FirstClause->Tag); sp[1] = (CELL)(group[1].FirstClause->Code); - if (group[0].FirstClause->Code == ap->cs.p_code.FirstClause) { - sp[2] = (CELL)PREVOP(group[0].FirstClause->Code,ld); - } else { - sp[2] = do_var_clauses(group[0].FirstClause, group[1].LastClause, FALSE, ap, TRUE, 0, (CELL)FAILCODE, ap->ArityOfPE+1); - } - if (PREVOP(min->Code,ld) == ap->cs.p_code.FirstClause) { - sp[3] = (CELL)(ap->cs.p_code.FirstClause); - } else { - sp[3] = do_var_clauses(min, group[1].LastClause, FALSE, ap, TRUE, 0, (CELL)FAILCODE, ap->ArityOfPE+1); - } + sp[2] = do_var_clauses(group[0].FirstClause, group[1].LastClause, FALSE, ap, TRUE, 0, (CELL)FAILCODE, ap->ArityOfPE+1); + sp[3] = do_var_clauses(min, group[1].LastClause, FALSE, ap, TRUE, 0, (CELL)FAILCODE, ap->ArityOfPE+1); return labl; } return fail_l; @@ -3087,10 +3068,10 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l, } if (ngroups == 1 && group->VarClauses && !found_pvar) { return do_index(min, max, ap, argno+1, fail_l, first, clleft, top); - } else if ((ngroups > 1 || found_pvar) && !(ap->PredFlags & LogUpdatePredFlag)) { + } else if (found_pvar) { Yap_emit(label_op, labl0, Zero); - Yap_emit(jump_v_op, (CELL)PREVOP(min->Code,ld), Zero); labl = new_label(); + Yap_emit(jump_v_op, suspend_indexing(min, max, ap), Zero); } } for (i=0; i < ngroups; i++) { @@ -3266,15 +3247,15 @@ do_blob_index(ClauseDef *min, ClauseDef* max, Term t,PredEntry *ap, UInt argno, static void init_clauses(ClauseDef *cl, PredEntry *ap) { - yamop *codep = ap->cs.p_code.FirstClause; - UInt n = ap->cs.p_code.NOfClauses; + StaticClause *scl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause); - while (n > 0) { - cl->Code = cl->CurrentCode = NEXTOP(codep,ld); - n--; + do { + cl->Code = cl->CurrentCode = scl->ClCode; cl++; - codep = NextClause(codep); - } + if (scl->ClCode == ap->cs.p_code.LastClause) + return; + scl = scl->ClNext; + } while (TRUE); } static void @@ -3450,29 +3431,30 @@ static ClauseDef * install_clauses(ClauseDef *cls, PredEntry *ap, istack_entry *stack, yamop *beg, yamop *end) { istack_entry *sp = stack; + StaticClause *cl = ClauseCodeToStaticClause(beg); if (stack[0].pos == 0) { while (TRUE) { - cls->Code = cls->CurrentCode = NEXTOP(beg,ld); + cls->Code = cls->CurrentCode = cl->ClCode; cls->Tag = 0; cls++; - if (beg == end || beg == NULL) { + if (cl->ClCode == end || cl->ClCode == NULL) { return cls-1; } - beg = NextClause(beg); + cl = cl->ClNext; } } while (TRUE) { - cls->Code = cls->CurrentCode = NEXTOP(beg,ld); + cls->Code = cls->CurrentCode = cl->ClCode; sp = install_clause(cls, ap, stack); /* we reached a matching clause */ if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) { cls++; } - if (beg == end || beg == NULL) { + if (cl->ClCode == end || cl->ClCode == NULL) { return cls-1; } - beg = NextClause(beg); + cl = cl->ClNext; } } @@ -3625,11 +3607,12 @@ count_clauses_left(yamop *cl, PredEntry *ap) return i; } else { yamop *last = ap->cs.p_code.LastClause; + StaticClause *c = ClauseCodeToStaticClause(cl); COUNT i = 1; - while (cl != last) { + while (c->ClCode != last) { i++; - cl = NextClause(cl); + c = c->ClNext; } return i; } @@ -3672,7 +3655,7 @@ expand_index(PredEntry *ap) { if (ap->PredFlags & LogUpdatePredFlag) { first = ClauseCodeToLogUpdClause(ipc->u.ld.d)->ClNext->ClCode; } else { - first = NextClause(PREVOP(ipc->u.ld.d,ld)); + first = ClauseCodeToStaticClause(ipc->u.ld.d)->ClNext->ClCode; } isfirstcl = FALSE; ipc = NEXTOP(ipc,ld); @@ -3681,7 +3664,7 @@ expand_index(PredEntry *ap) { if (ap->PredFlags & LogUpdatePredFlag) { first = ClauseCodeToLogUpdClause(ipc->u.l.l)->ClNext->ClCode; } else { - first = NextClause(PREVOP(ipc->u.l.l,ld)); + first = ClauseCodeToStaticClause(ipc->u.l.l)->ClNext->ClCode; } isfirstcl = FALSE; ipc = NEXTOP(ipc,l); @@ -3746,6 +3729,7 @@ expand_index(PredEntry *ap) { break; case _jump_if_var: if (IsVarTerm(Deref(ARG1))) { + labp = &(ipc->u.l.l); ipc = ipc->u.l.l; } else { ipc = NEXTOP(ipc,l); @@ -3940,7 +3924,7 @@ expand_index(PredEntry *ap) { ipc = NULL; } else { /* backtrack */ - first = PREVOP(alt->u.ld.d,ld); + first = alt->u.ld.d; ipc = alt; alt = NULL; } @@ -3962,10 +3946,9 @@ 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); + last = alt->u.ld.d; } } fail_l = (UInt)alt; @@ -5486,11 +5469,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) { } #endif stack = (path_stack_entry *)TR; - if (ap->PredFlags & LogUpdatePredFlag) { - cl.Code = cl.CurrentCode = beg; - } else { - cl.Code = cl.CurrentCode = NEXTOP(beg,ld); - } + cl.Code = cl.CurrentCode = beg; sp = push_path(stack, NULL, &cl); add_to_index(ap, first, sp, &cl); } @@ -5981,7 +5960,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) { last = (yamop *)((CODEADDR)c+Yap_SizeOfBlock((CODEADDR)c)); } else { StaticClause *c = ClauseCodeToStaticClause(beg); - cl.Code = cl.CurrentCode = NEXTOP(beg,ld); + cl.Code = cl.CurrentCode = beg; last = (yamop *)((CODEADDR)c+Yap_SizeOfBlock((CODEADDR)c)); } sp = push_path(stack, NULL, &cl); diff --git a/C/init.c b/C/init.c index 114e33242..e8b324305 100644 --- a/C/init.c +++ b/C/init.c @@ -460,7 +460,6 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags) cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),sla),e),e)); } cl->ClFlags = 0; - cl->Owner = Yap_LookupAtom("user"); p_code = cl->ClCode; pe->CodeOfPred = p_code; @@ -499,7 +498,6 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),lxx),e)); cl->ClFlags = 0; - cl->Owner = Yap_LookupAtom("user"); p_code = cl->ClCode; if (Arity) pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule)); @@ -536,7 +534,6 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e)); cl->ClFlags = 0; - cl->Owner = Yap_LookupAtom("user"); p_code = cl->ClCode; pe->CodeOfPred = p_code; p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); @@ -611,7 +608,6 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPred return; } cl->ClFlags = 0; - cl->Owner = Yap_LookupAtom("user"); code = cl->ClCode; pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = pe->cs.p_code.FirstClause = pe->cs.p_code.LastClause = code; diff --git a/C/iopreds.c b/C/iopreds.c index 72260af8f..dbec2919f 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -2865,44 +2865,6 @@ p_startline (void) return (Yap_unify_constant (ARG1, MkIntegerTerm (StartLine))); } -static Int -p_inform_of_clause (void) -{ /* '$inform_of_clause'(Func,Mode) */ -#if EMACS - unsigned int arity; - int clause_no; - Atom at; - Prop pred_prop; - if (emacs_mode) - { - Term t1 = Deref (ARG1); - Term t2 = Deref (ARG2); - if (IsVarTerm (t1)) - return (FALSE); - else if (IsAtomTerm (t1)) - { - arity = 0; - at = AtomOfTerm (t1); - } - else if (IsApplTerm (t1)) - { - Functor func = FunctorOfTerm (t1); - arity = ArityOfFunctor (func); - at = NameOfFunctor (func); - } - else - return (FALSE); - if (IsVarTerm (t2) || !IsIntTerm (t2)) - return (FALSE); - fprintf (Yap_stdout, "\001(yap-consult-clause \"%s\" %d %d %d)\002\n", - RepAtom (at)->StrOfAE, arity, - where_new_clause (PredProp (at, arity), (int) (IntOfTerm (t2) % 4)), - first_char); - } -#endif - return (TRUE); -} - /* control the parser error handler */ static Int p_set_read_error_handler(void) @@ -5089,8 +5051,6 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$show_stream_flags", 2, p_show_stream_flags, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$set_stream_position", 2, p_set_stream_position, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$inform_of_clause", 2, p_inform_of_clause, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("$inform_of_clause", 2, p_inform_of_clause, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$user_file_name", 2, p_user_file_name, SafePredFlag|SyncPredFlag), Yap_InitCPred ("$file_name", 2, p_file_name, SafePredFlag|SyncPredFlag), Yap_InitCPred ("$past_eof", 1, p_past_eof, SafePredFlag|SyncPredFlag), diff --git a/C/tracer.c b/C/tracer.c index 36f213e65..4d18a711c 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -115,7 +115,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) /* extern int gc_calls; */ vsc_count++; - return; #ifdef COMMENTED if (port != enter_pred || !pred || diff --git a/H/clause.h b/H/clause.h index ed8a03b83..9a18f268b 100644 --- a/H/clause.h +++ b/H/clause.h @@ -32,7 +32,7 @@ typedef union CONSULT_OBJ { #define ASSEMBLING_CLAUSE 0 #define ASSEMBLING_INDEX 1 -#define NextClause(X) (((yamop *)X)->u.ld.d) +#define NextDynamicClause(X) (((yamop *)X)->u.ld.d) #define PredFirstClause 0 #define PredMiddleClause 1 @@ -75,8 +75,6 @@ typedef struct logic_upd_clause { struct logic_upd_clause *ClPrev, *ClNext; /* parent pointer */ PredEntry *ClPred; - /* file which defined the clause */ - Atom Owner; /* The instructions, at least one of the form sl */ yamop ClCode[MIN_ARRAY]; } LogUpdClause; @@ -89,7 +87,6 @@ typedef struct dynamic_clause { lockvar ClLock; #endif UInt ClRefCount; - Atom Owner; yamop *ClPrevious; /* immediate update clause */ /* The instructions, at least one of the form sl */ yamop ClCode[MIN_ARRAY]; @@ -112,7 +109,7 @@ typedef struct static_clause { DBTerm *ClSource; PredEntry *ClPred; } usc; - Atom Owner; + struct static_clause *ClNext; /* The instructions, at least one of the form sl */ yamop ClCode[MIN_ARRAY]; } StaticClause; @@ -174,6 +171,7 @@ void STD_PROTO(Yap_addclause,(Term,yamop *,int,int)); void STD_PROTO(Yap_add_logupd_clause,(PredEntry *,LogUpdClause *,int)); void STD_PROTO(Yap_kill_iblock,(ClauseUnion *,ClauseUnion *,PredEntry *)); void STD_PROTO(Yap_cleanup_dangling_indices,(yamop *,yamop *,yamop *,yamop *)); +void STD_PROTO(Yap_EraseStaticClause,(StaticClause *, SMALLUNSGN)); ClauseUnion *STD_PROTO(Yap_find_owner_index,(yamop *, PredEntry *)); /* dbase.c */ diff --git a/H/rheap.h b/H/rheap.h index a6e3e9eeb..a173d1868 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -588,18 +588,12 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode) if (cl->ClPrevious != NULL) { cl->ClPrevious = PtoOpAdjust(cl->ClPrevious); } - cl->Owner = AtomAdjust(cl->Owner); } else if (pp->PredFlags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(pc); if (cl->ClFlags & LogUpdRuleMask) { cl->ClExt = PtoOpAdjust(cl->ClExt); } - cl->Owner = AtomAdjust(cl->Owner); - } else { - StaticClause *cl = ClauseCodeToStaticClause(pc); - - cl->Owner = AtomAdjust(cl->Owner); } } do { @@ -1362,13 +1356,21 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp) RestoreClause(cl->ClCode, pp, ASSEMBLING_CLAUSE); cl = cl->ClNext; } + } else if (pp->PredFlags & DynamicPredFlag) { + yamop *cl = First; + + do { + RestoreClause(cl, pp, ASSEMBLING_CLAUSE); + if (cl == Last) return; + cl = NextDynamicClause(cl); + } while (TRUE); } else { yamop *cl = First; do { RestoreClause(cl, pp, ASSEMBLING_CLAUSE); if (cl == Last) return; - cl = NextClause(cl); + cl = ClauseCodeToStaticClause(cl)->ClNext->ClCode; } while (TRUE); } } diff --git a/pl/boot.yap b/pl/boot.yap index d0fc0dae9..16b764c1c 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -360,7 +360,6 @@ repeat :- '$repeat'. % process an input clause '$$compile'(G, G0, L, Mod) :- '$head_and_body'(G,H,_), - '$inform_of_clause'(H,L), '$flags'(H, Mod, Fl, Fl), ( Fl /\ 16'000008 =\= 0 -> '$compile'(G,L,G0,Mod) ; @@ -369,49 +368,7 @@ repeat :- '$repeat'. % process a clause for a static predicate '$$compile_stat'(G,G0,L,H, Mod) :- - '$compile'(G,L,G0,Mod), - % first occurrence of this predicate in this file, - % check if we need to erase the source and if - % it is a multifile procedure. - '$flags'(H,Mod,Fl,Fl), - ( get_value('$abol',true) - -> - ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H, Mod) ; true ), - ( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; true ) - ; - true - ). - -'$store_stat_clause'(G0, H, L, M) :- - '$head_and_body'(G0,H0,B0), - '$record_stat_source'(M:H,(H0:-B0),L,R), - ( '$is_multifile'(H,M) -> - get_value('$consulting_file',F), - functor(H, Na, Ar), - recordz('$multifile'(_,_,_), '$mf'(Na,Ar,M,F,R), _) - ; - true - ). - -'$erase_source'(G, M) :- - '$is_multifile'(G, M), !, - functor(G, Na, Ar), - '$erase_mf_source'(Na, Ar, M). -'$erase_source'(_, _). - -'$erase_mf_source'(Na, Ar, M) :- - get_value('$consulting_file',F), - recorded('$multifile'(_,_,_), '$mf'(Na,Ar,M,F,R), R1), - erase(R1), - erase(R), - fail. -'$erase_mf_source'(Na, Ar, M) :- - get_value('$consulting_file',F), - recorded('$multifile_dynamic'(_,_,_), '$mf'(Na,Ar,M,F,R), R1), - erase(R1), - erase(R), - fail. -'$erase_mf_source'(_,_,_). + '$compile'(G,L,G0,Mod). '$check_if_reconsulted'(N,A) :- recorded('$reconsulted',X,_), @@ -932,9 +889,10 @@ break :- get_value('$break',BL), NBL is BL+1, ), '$loop'(Stream,consult), '$end_consult', - '$cd'(OldD), + '$add_multifile_clauses'(File), set_value('$consulting',Old), set_value('$consulting_file',OldF), + '$cd'(OldD), ( LC == 0 -> prompt(_,' |: ') ; true), '$exec_initialisation_goals', '$current_module'(Mod,OldModule), @@ -1186,3 +1144,16 @@ throw(Ball) :- '$run_toplevel_hooks'. +% add multifile clauses belonging to current file. +'$add_multifile_clauses'(FileName) :- + recorded('$multifile_defs','$defined'(File,Name,Arity,Module),_), + functor(P,Name,Arity), + '$clause'(P,Module,_,Ref), + % check if someone else defines it. + \+ recorded('$mf','$mf_clause'(_,_,_,_,Ref),_), + recordz('$mf','$mf_clause'(FileName,Name,Arity,Module,Ref),R), + fail. +'$add_multifile_clauses'(_). + + + diff --git a/pl/checker.yap b/pl/checker.yap index a042fe0f2..1de23a805 100644 --- a/pl/checker.yap +++ b/pl/checker.yap @@ -192,8 +192,7 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). '$multifile'(Mod:PredSpec, _) :- !, '$multifile'(PredSpec, Mod). '$multifile'(N/A, M) :- - get_value('$consulting_file',F), - recordzifnot('$multifile_defs','$defined'(F,N,A,M),_), + '$add_multifile'(N,A,M), fail. '$multifile'(N/A, M) :- functor(S,N,A), @@ -235,7 +234,6 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). functor(Hd,Na,Ar), NFl is \(16'040000 ) /\ Fl, '$flags'(Hd,M,Fl,NFl), - '$clear_multifile_pred'(Na,Ar,M), '$warn_mfile'(Na,Ar). '$warn_mfile'(F,A) :- @@ -246,18 +244,5 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T). write(user_error,') ]'), nl(user_error). -'$clear_multifile_pred'(Na,Ar,M) :- - recorded('$multifile_defs','$defined'(_,Na,Ar,M),R), - erase(R), - fail. -'$clear_multifile_pred'(Na,Ar,M) :- - recorded('$multifile'(_,_,_),'$mf'(Na,Ar,M,_,_),R), - erase(R), - fail. -'$clear_multifile_pred'(Na,Ar,M) :- - recorded('$multifile_dynamic'(_,_,_),'$mf'(Na,Ar,M,_,_),R), - erase(R), - fail. -'$clear_multifile_pred'(_,_,_). diff --git a/pl/consult.yap b/pl/consult.yap index 8b0b97b75..257228511 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -108,11 +108,13 @@ reconsult(Fs) :- '$current_module'(OldModule), '$start_reconsulting'(F), '$start_consult'(reconsult,File,LC), + '$remove_multifile_clauses'(File), recorda('$initialisation','$',_), '$print_message'(informational, loading(reconsulting, File)), '$loop'(Stream,reconsult), '$end_consult', '$clear_reconsulting', + '$add_multifile_clauses'(File), set_value('$consulting',Old), set_value('$consulting_file',OldF), '$cd'(OldD), @@ -127,36 +129,6 @@ reconsult(Fs) :- recorda('$reconsulted','$',_), recorda('$reconsulting',F,_). -'EMACS_FILE'(F,File0) :- - '$format'('''EMACS_RECONSULT''(~w).~n',[File0]), - '$getcwd'(OldD), - '$open'(F,'$csult',Stream,0), - '$find_in_path'(File0,File,emacs(F)), - '$open'(File,'$csult',Stream0,0), - get_value('$consulting_file',OldF), - '$set_consulting_file'(Stream0), - H0 is heapused, '$cputime'(T0,_), - get_value('$consulting',Old), - set_value('$consulting',false), - '$start_reconsulting'(File), - '$start_consult'(reconsult,File,LC), - '$current_module'(OldModule), - recorda('$initialisation','$',_), - '$print_message'(informational, loading(reconsulting, File)), - '$loop'(Stream,reconsult), - '$end_consult', - '$clear_reconsulting', - set_value('$consulting',Old), - set_value('$consulting_file',OldF), - '$cd'(OldD), - '$exec_initialisation_goals', - '$current_module'(Mod,OldModule), - ( LC == 0 -> prompt(_,' |: ') ; true), - H is heapused-H0, '$cputime'(TF,_), T is TF-T0, - '$print_message'(informational, loaded(reconsulted, File, Mod, T, H)), - !. - - '$initialization'(V) :- var(V), !, '$do_error'(instantiation_error,initialization(V)). @@ -276,3 +248,30 @@ remove_from_path(New) :- '$check_path'(New,Path), '$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A). '$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN). +% add_multifile_predicate when we start consul +'$add_multifile'(Name,Arity,Module) :- + get_value('$consulting_file',File), + '$add_multifile'(File,Name,Arity,Module). + +'$add_multifile'(File,Name,Arity,Module) :- + recordzifnot('$multifile_defs','$defined'(File,Name,Arity,Module),_), !, + fail. +'$add_multifile'(File,Name,Arity,Module) :- + recorded('$mf','$mf_clause'(File,Name,Arity,Module,Ref),R), + erase(R), + erase(Ref), + fail. +'$add_multifile'(_,_,_,_). + +% retract old multifile clauses for current file. +'$remove_multifile_clauses'(FileName) :- + recorded('$multifile_defs','$defined'(FileName,_,_,_),R1), + erase(R1), + fail. +'$remove_multifile_clauses'(FileName) :- + recorded('$mf','$mf_clause'(FileName,_,_,Module,Ref),R), + '$erase_clause'(Ref, Module), + erase(R), + fail. +'$remove_multifile_clauses'(_). + diff --git a/pl/init.yap b/pl/init.yap index b495514a4..c2826c238 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -37,6 +37,9 @@ not(G) :- '$current_module'(Module), '$meta_call'(not(G),Module). :- set_value('$doindex',true). +% force having indexing code for throw. +:- '$handle_throw'(_,_,_), !. + :- ['errors.yap', 'utils.yap', 'arith.yap']. diff --git a/pl/modules.yap b/pl/modules.yap index f9e0f9b87..11cad6008 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -540,7 +540,6 @@ source_module(Mod) :- '$member'(X,[X|_]) :- !. '$member'(X,[_|L]) :- '$member'(X,L). - :- meta_predicate % [:,:], abolish(:), diff --git a/pl/preds.yap b/pl/preds.yap index 5f857543a..b94c94073 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -337,16 +337,22 @@ clause(V,Q,R) :- '$continue_log_update_clause'(A,B,C,D,E). '$do_log_upd_clause'(A,B,C,D,E). +:- '$do_log_upd_clause'(_,_,_,_,_), !. + '$do_log_upd_clause'(_,_,_,_). '$do_log_upd_clause'(A,B,C,D) :- '$continue_log_update_clause'(A,B,C,D). '$do_log_upd_clause'(A,B,C,D). +:- '$do_log_upd_clause'(_,_,_,_), !. + '$do_static_clause'(_,_,_,_,_). '$do_static_clause'(A,B,C,D,E) :- '$continue_static_clause'(A,B,C,D,E). '$do_static_clause'(A,B,C,D,E). +:- '$do_static_clause'(_,_,_,_,_), !. + nth_clause(P,I,R) :- nonvar(R), !, '$nth_instancep'(P,I,R). nth_clause(M:V,I,R) :- !, @@ -608,7 +614,15 @@ abolish(X) :- fail. '$abolish_all_atoms_old'(_,_). -'$abolishd'(T, M) :- '$recordedp'(M:T,_,R), erase(R), fail. +'$abolishd'(T, M) :- + '$is_multifile'(T,M), + functor(T,Name,Arity), + recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R), + erase(R), + erase(Ref), + fail. +'$abolishd'(T, M) :- + '$clause'(T,M,_,R), erase(R), fail. '$abolishd'(T, M) :- '$kill_dynamic'(T,M), fail. '$abolishd'(_, _). @@ -627,6 +641,13 @@ abolish(X) :- '$has_yap_or', !, functor(G,A,N), '$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)). +'$abolishs'(G, M) :- + '$is_multifile'(G,M), !, + functor(G,Name,Arity), + recorded('$mf','$mf_clause'(_,Name,Arity,M,Ref),R), + erase(R), + erase(Ref), + fail. '$abolishs'(G, M) :- '$purge_clauses'(G, M), fail. '$abolishs'(_, _).