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

new infrastructure for static clauses:

Browse Source 
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
This commit is contained in:
vsc 2003-11-26 18:36:35 +00:00
parent 2fc4750456
commit 90829edc9e
17 changed files with 351 additions and 421 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
C/absmi.c
View File

@ -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);

17
C/amasm.c
View File

@ -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)) {

385
C/cdmgr.c
View File

@ -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 &&

36
C/dbase.c
View File

@ -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);

21
C/exec.c
View File

@ -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;

79
C/index.c
View File

@ -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);

4
C/init.c
View File

@ -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;

40
C/iopreds.c
View File

@ -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),

1
C/tracer.c
View File

@ -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 ||

8
H/clause.h
View File

@ -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 */

16
H/rheap.h
View File

@ -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);
}
}

61
pl/boot.yap
View File

@ -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'(_).

17
pl/checker.yap
View File

@ -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'(_,_,_).

59
pl/consult.yap
View File

@ -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'(_).

3
pl/init.yap
View File

@ -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'].

1
pl/modules.yap
View File

@ -540,7 +540,6 @@ source_module(Mod) :-
'$member'(X,[X|_]) :- !.
'$member'(X,[_|L]) :- '$member'(X,L).
:- meta_predicate
% [:,:],
abolish(:),

23
pl/preds.yap
View File

@ -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'(_, _).