compact source mode.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@934 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
8d3f30de9c
commit
f5edbc8aa7
33
C/amasm.c
33
C/amasm.c
@ -2079,6 +2079,7 @@ do_pass(void)
|
|||||||
} else {
|
} else {
|
||||||
/* static clause */
|
/* static clause */
|
||||||
if (pass_no) {
|
if (pass_no) {
|
||||||
|
cl_u->sc.Id = FunctorDBRef;
|
||||||
cl_u->sc.ClFlags = 0;
|
cl_u->sc.ClFlags = 0;
|
||||||
cl_u->sc.Owner = Yap_ConsultingFile();
|
cl_u->sc.Owner = Yap_ConsultingFile();
|
||||||
if (clause_has_blobs) {
|
if (clause_has_blobs) {
|
||||||
@ -2441,7 +2442,7 @@ do_pass(void)
|
|||||||
longjmp(Yap_CompilerBotch, 3);
|
longjmp(Yap_CompilerBotch, 3);
|
||||||
}
|
}
|
||||||
|
|
||||||
if ( (char *)(label_offset+cpc->rnd1) > freep)
|
if ( (char *)(label_offset+cpc->rnd1) >= freep)
|
||||||
freep = (char *)(label_offset+(cpc->rnd1+1));
|
freep = (char *)(label_offset+(cpc->rnd1+1));
|
||||||
label_offset[cpc->rnd1] = (CELL) code_p;
|
label_offset[cpc->rnd1] = (CELL) code_p;
|
||||||
}
|
}
|
||||||
@ -2650,15 +2651,44 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
|
|||||||
!is_fact) {
|
!is_fact) {
|
||||||
DBTerm *x;
|
DBTerm *x;
|
||||||
LogUpdClause *cl;
|
LogUpdClause *cl;
|
||||||
|
CELL *h0 = H;
|
||||||
|
|
||||||
|
H = (CELL *)freep;
|
||||||
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
|
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
|
||||||
|
H = h0;
|
||||||
if (!Yap_growheap(TRUE, size)) {
|
if (!Yap_growheap(TRUE, size)) {
|
||||||
Yap_Error_TYPE = SYSTEM_ERROR;
|
Yap_Error_TYPE = SYSTEM_ERROR;
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
h0 = H;
|
||||||
|
H = (CELL *)freep;
|
||||||
}
|
}
|
||||||
|
H = h0;
|
||||||
cl = (LogUpdClause *)((CODEADDR)x-(UInt)size);
|
cl = (LogUpdClause *)((CODEADDR)x-(UInt)size);
|
||||||
cl->ClSource = x;
|
cl->ClSource = x;
|
||||||
code_addr = (yamop *)cl;
|
code_addr = (yamop *)cl;
|
||||||
|
} else if (mode == ASSEMBLING_CLAUSE &&
|
||||||
|
(ap->PredFlags & SourcePredFlag ||
|
||||||
|
(!ap->cs.p_code.NOfClauses && yap_flags[SOURCE_MODE_FLAG])) &&
|
||||||
|
!is_fact) {
|
||||||
|
DBTerm *x;
|
||||||
|
StaticClause *cl;
|
||||||
|
CELL *h0 = H;
|
||||||
|
|
||||||
|
H = (CELL *)freep;
|
||||||
|
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
|
||||||
|
H = h0;
|
||||||
|
if (!Yap_growheap(TRUE, size)) {
|
||||||
|
Yap_Error_TYPE = SYSTEM_ERROR;
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
h0 = H;
|
||||||
|
H = (CELL *)freep;
|
||||||
|
}
|
||||||
|
H = h0;
|
||||||
|
cl = (StaticClause *)((CODEADDR)x-(UInt)size);
|
||||||
|
cl->ClSource = x;
|
||||||
|
code_addr = (yamop *)cl;
|
||||||
} else {
|
} else {
|
||||||
while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {
|
while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {
|
||||||
if (!Yap_growheap(TRUE, size)) {
|
if (!Yap_growheap(TRUE, size)) {
|
||||||
@ -2667,7 +2697,6 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
// fprintf(stderr,"vsc: asking for %p\n",code_addr);
|
|
||||||
entry_code = do_pass();
|
entry_code = do_pass();
|
||||||
YAPLeaveCriticalSection();
|
YAPLeaveCriticalSection();
|
||||||
#ifdef LOW_PROF
|
#ifdef LOW_PROF
|
||||||
|
@ -843,7 +843,7 @@ YAP_CompileClause(Term t)
|
|||||||
|
|
||||||
Yap_ErrorMessage = NULL;
|
Yap_ErrorMessage = NULL;
|
||||||
ARG1 = t;
|
ARG1 = t;
|
||||||
codeaddr = Yap_cclause (t,0, mod);
|
codeaddr = Yap_cclause (t,0, mod, t);
|
||||||
if (codeaddr != NULL) {
|
if (codeaddr != NULL) {
|
||||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||||
Yap_addclause (t, codeaddr, TRUE, mod);
|
Yap_addclause (t, codeaddr, TRUE, mod);
|
||||||
|
149
C/cdmgr.c
149
C/cdmgr.c
@ -1133,7 +1133,7 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
|
|||||||
|
|
||||||
|
|
||||||
static Term
|
static Term
|
||||||
addclause(Term t, yamop *cp, int mode, int mod, Term src)
|
addclause(Term t, yamop *cp, int mode, int mod)
|
||||||
/*
|
/*
|
||||||
*
|
*
|
||||||
mode
|
mode
|
||||||
@ -1201,8 +1201,10 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src)
|
|||||||
StaticClause *clp = ClauseCodeToStaticClause(cp);
|
StaticClause *clp = ClauseCodeToStaticClause(cp);
|
||||||
clp->ClFlags |= StaticMask;
|
clp->ClFlags |= StaticMask;
|
||||||
if (IsAtomTerm(t) ||
|
if (IsAtomTerm(t) ||
|
||||||
FunctorOfTerm(t) != FunctorAssert)
|
FunctorOfTerm(t) != FunctorAssert) {
|
||||||
clp->ClFlags |= FactMask;
|
clp->ClFlags |= FactMask;
|
||||||
|
clp->ClSource = NULL;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
if (compile_mode)
|
if (compile_mode)
|
||||||
p->PredFlags = pflags | CompiledPredFlag | FastPredFlag;
|
p->PredFlags = pflags | CompiledPredFlag | FastPredFlag;
|
||||||
@ -1246,7 +1248,7 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src)
|
|||||||
|
|
||||||
void
|
void
|
||||||
Yap_addclause(Term t, yamop *cp, int mode, int mod) {
|
Yap_addclause(Term t, yamop *cp, int mode, int mod) {
|
||||||
addclause(t, cp, mode, mod, t);
|
addclause(t, cp, mode, mod);
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
@ -1408,11 +1410,11 @@ p_compile(void)
|
|||||||
if (IsVarTerm(t3) || !IsAtomTerm(t3))
|
if (IsVarTerm(t3) || !IsAtomTerm(t3))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
mod = Yap_LookupModule(t3);
|
mod = Yap_LookupModule(t3);
|
||||||
codeadr = Yap_cclause(t, 2, mod); /* vsc: give the number of arguments
|
codeadr = Yap_cclause(t, 2, mod, Deref(ARG3)); /* vsc: give the number of arguments
|
||||||
to cclause in case there is overflow */
|
to cclause in case there is overflow */
|
||||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||||
if (!Yap_ErrorMessage)
|
if (!Yap_ErrorMessage)
|
||||||
addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod, Deref(ARG3));
|
addclause(t, codeadr, (int) (IntOfTerm(t1) & 3), mod);
|
||||||
if (Yap_ErrorMessage) {
|
if (Yap_ErrorMessage) {
|
||||||
if (IntOfTerm(t1) & 4) {
|
if (IntOfTerm(t1) & 4) {
|
||||||
Yap_Error(Yap_Error_TYPE, Yap_Error_Term,
|
Yap_Error(Yap_Error_TYPE, Yap_Error_Term,
|
||||||
@ -1441,13 +1443,13 @@ p_compile_dynamic(void)
|
|||||||
old_optimize = optimizer_on;
|
old_optimize = optimizer_on;
|
||||||
optimizer_on = FALSE;
|
optimizer_on = FALSE;
|
||||||
mod = Yap_LookupModule(t3);
|
mod = Yap_LookupModule(t3);
|
||||||
code_adr = Yap_cclause(t, 3, mod); /* vsc: give the number of arguments to
|
code_adr = Yap_cclause(t, 3, mod, Deref(ARG3)); /* vsc: give the number of arguments to
|
||||||
cclause() in case there is a overflow */
|
cclause() in case there is a overflow */
|
||||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||||
if (!Yap_ErrorMessage) {
|
if (!Yap_ErrorMessage) {
|
||||||
|
|
||||||
optimizer_on = old_optimize;
|
optimizer_on = old_optimize;
|
||||||
t = addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod, Deref(ARG3));
|
t = addclause(t, code_adr, (int) (IntOfTerm(t1) & 3), mod);
|
||||||
} else {
|
} else {
|
||||||
if (IntOfTerm(t1) & 4) {
|
if (IntOfTerm(t1) & 4) {
|
||||||
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage);
|
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, "line %d, %s", Yap_FirstLineInParse(), Yap_ErrorMessage);
|
||||||
@ -1902,6 +1904,33 @@ p_is_log_updatable(void)
|
|||||||
return(out);
|
return(out);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_is_source(void)
|
||||||
|
{ /* '$is_dynamic'(+P) */
|
||||||
|
PredEntry *pe;
|
||||||
|
Term t = Deref(ARG1);
|
||||||
|
Term t2 = Deref(ARG2);
|
||||||
|
Int out;
|
||||||
|
SMALLUNSGN mod = Yap_LookupModule(t2);
|
||||||
|
|
||||||
|
if (IsVarTerm(t)) {
|
||||||
|
return (FALSE);
|
||||||
|
} else if (IsAtomTerm(t)) {
|
||||||
|
Atom at = AtomOfTerm(t);
|
||||||
|
pe = RepPredProp(PredPropByAtom(at, mod));
|
||||||
|
} else if (IsApplTerm(t)) {
|
||||||
|
Functor fun = FunctorOfTerm(t);
|
||||||
|
pe = RepPredProp(PredPropByFunc(fun, mod));
|
||||||
|
} else
|
||||||
|
return (FALSE);
|
||||||
|
if (pe == NIL)
|
||||||
|
return (FALSE);
|
||||||
|
READ_LOCK(pe->PRWLock);
|
||||||
|
out = (pe->PredFlags & SourcePredFlag);
|
||||||
|
READ_UNLOCK(pe->PRWLock);
|
||||||
|
return(out);
|
||||||
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_is_dynamic(void)
|
p_is_dynamic(void)
|
||||||
{ /* '$is_dynamic'(+P) */
|
{ /* '$is_dynamic'(+P) */
|
||||||
@ -2980,7 +3009,7 @@ get_pred(Term t1, Term tmod, char *command)
|
|||||||
static Int
|
static Int
|
||||||
fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
|
fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, yamop *cp_ptr, int first_time)
|
||||||
{
|
{
|
||||||
LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr);
|
LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, tr, NextClause(PredLogUpdClause->cs.p_code.FirstClause), cp_ptr);
|
||||||
Term rtn;
|
Term rtn;
|
||||||
|
|
||||||
if (cl == NULL)
|
if (cl == NULL)
|
||||||
@ -2998,13 +3027,14 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
|
|||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
if (cl->ClFlags & FactMask) {
|
if (cl->ClFlags & FactMask) {
|
||||||
|
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
|
||||||
|
!Yap_unify(tr, rtn))
|
||||||
|
return FALSE;
|
||||||
|
if (pe->ArityOfPE) {
|
||||||
Functor f = FunctorOfTerm(th);
|
Functor f = FunctorOfTerm(th);
|
||||||
UInt arity = ArityOfFunctor(f), i;
|
UInt arity = ArityOfFunctor(f), i;
|
||||||
CELL *pt = RepAppl(th)+1;
|
CELL *pt = RepAppl(th)+1;
|
||||||
|
|
||||||
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
|
|
||||||
!Yap_unify(tr, rtn))
|
|
||||||
return FALSE;
|
|
||||||
for (i=0; i<arity; i++) {
|
for (i=0; i<arity; i++) {
|
||||||
XREGS[i+1] = pt[i];
|
XREGS[i+1] = pt[i];
|
||||||
}
|
}
|
||||||
@ -3016,6 +3046,7 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
|
|||||||
YENV[E_CB] = (CELL) B;
|
YENV[E_CB] = (CELL) B;
|
||||||
}
|
}
|
||||||
P = cl->ClCode;
|
P = cl->ClCode;
|
||||||
|
}
|
||||||
return TRUE;
|
return TRUE;
|
||||||
} else {
|
} else {
|
||||||
Term t;
|
Term t;
|
||||||
@ -3048,6 +3079,9 @@ p_log_update_clause(void)
|
|||||||
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
||||||
if (pe == NULL || EndOfPAEntr(pe))
|
if (pe == NULL || EndOfPAEntr(pe))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
|
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||||
|
IPred(pe);
|
||||||
|
}
|
||||||
return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
|
return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -3063,17 +3097,18 @@ p_continue_log_update_clause(void)
|
|||||||
static Int
|
static Int
|
||||||
fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
|
fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_ptr, int first_time)
|
||||||
{
|
{
|
||||||
LogUpdClause *cl = Yap_follow_lu_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr);
|
LogUpdClause *cl = Yap_follow_indexing_code(pe, i_code, th, tb, TermNil, NextClause(PredLogUpdClause0->cs.p_code.FirstClause), cp_ptr);
|
||||||
|
|
||||||
if (cl == NULL)
|
if (cl == NULL)
|
||||||
return FALSE;
|
return FALSE;
|
||||||
if (cl->ClFlags & FactMask) {
|
if (cl->ClFlags & FactMask) {
|
||||||
|
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
|
||||||
|
return FALSE;
|
||||||
|
if (pe->ArityOfPE) {
|
||||||
Functor f = FunctorOfTerm(th);
|
Functor f = FunctorOfTerm(th);
|
||||||
UInt arity = ArityOfFunctor(f), i;
|
UInt arity = ArityOfFunctor(f), i;
|
||||||
CELL *pt = RepAppl(th)+1;
|
CELL *pt = RepAppl(th)+1;
|
||||||
|
|
||||||
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
|
|
||||||
return FALSE;
|
|
||||||
for (i=0; i<arity; i++) {
|
for (i=0; i<arity; i++) {
|
||||||
XREGS[i+1] = pt[i];
|
XREGS[i+1] = pt[i];
|
||||||
}
|
}
|
||||||
@ -3085,6 +3120,7 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
|
|||||||
YENV[E_CB] = (CELL) B;
|
YENV[E_CB] = (CELL) B;
|
||||||
}
|
}
|
||||||
P = cl->ClCode;
|
P = cl->ClCode;
|
||||||
|
}
|
||||||
return TRUE;
|
return TRUE;
|
||||||
} else {
|
} else {
|
||||||
Term t;
|
Term t;
|
||||||
@ -3116,6 +3152,9 @@ p_log_update_clause0(void)
|
|||||||
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
||||||
if (pe == NULL || EndOfPAEntr(pe))
|
if (pe == NULL || EndOfPAEntr(pe))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
|
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||||
|
IPred(pe);
|
||||||
|
}
|
||||||
return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
|
return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -3128,6 +3167,84 @@ p_continue_log_update_clause0(void)
|
|||||||
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
|
return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
Term rtn;
|
||||||
|
|
||||||
|
if (cl == NULL)
|
||||||
|
return FALSE;
|
||||||
|
rtn = MkDBRefTerm((DBRef)cl);
|
||||||
|
if (cl->ClFlags & FactMask) {
|
||||||
|
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
|
||||||
|
!Yap_unify(tr, rtn))
|
||||||
|
return FALSE;
|
||||||
|
|
||||||
|
if (pe->ArityOfPE) {
|
||||||
|
Functor f = FunctorOfTerm(th);
|
||||||
|
UInt arity = ArityOfFunctor(f), i;
|
||||||
|
CELL *pt = RepAppl(th)+1;
|
||||||
|
|
||||||
|
for (i=0; i<arity; i++) {
|
||||||
|
XREGS[i+1] = pt[i];
|
||||||
|
}
|
||||||
|
/* don't need no ENV */
|
||||||
|
if (first_time) {
|
||||||
|
CP = P;
|
||||||
|
ENV = YENV;
|
||||||
|
YENV = ASP;
|
||||||
|
YENV[E_CB] = (CELL) B;
|
||||||
|
}
|
||||||
|
P = NEXTOP(cl->ClCode,ld);
|
||||||
|
}
|
||||||
|
return TRUE;
|
||||||
|
} else {
|
||||||
|
Term t;
|
||||||
|
|
||||||
|
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
||||||
|
if (first_time) {
|
||||||
|
if (!Yap_gc(4, YENV, P)) {
|
||||||
|
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if (!Yap_gc(5, ENV, CP)) {
|
||||||
|
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return(Yap_unify(th, ArgOfTerm(1,t)) &&
|
||||||
|
Yap_unify(tb, ArgOfTerm(2,t)) &&
|
||||||
|
Yap_unify(tr, rtn));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int /* $hidden_predicate(P) */
|
||||||
|
p_static_clause(void)
|
||||||
|
{
|
||||||
|
PredEntry *pe;
|
||||||
|
Term t1 = Deref(ARG1);
|
||||||
|
|
||||||
|
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
||||||
|
if (pe == NULL || EndOfPAEntr(pe))
|
||||||
|
return FALSE;
|
||||||
|
if(pe->OpcodeOfPred == INDEX_OPCODE) {
|
||||||
|
IPred(pe);
|
||||||
|
}
|
||||||
|
return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int /* $hidden_predicate(P) */
|
||||||
|
p_continue_static_clause(void)
|
||||||
|
{
|
||||||
|
PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
|
||||||
|
yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
|
||||||
|
|
||||||
|
return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
|
||||||
|
}
|
||||||
|
|
||||||
#ifdef LOW_PROF
|
#ifdef LOW_PROF
|
||||||
|
|
||||||
static void
|
static void
|
||||||
@ -3302,6 +3419,7 @@ Yap_InitCdMgr(void)
|
|||||||
Yap_InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$is_dynamic", 2, p_is_dynamic, TestPredFlag | SafePredFlag);
|
Yap_InitCPred("$is_dynamic", 2, p_is_dynamic, TestPredFlag | SafePredFlag);
|
||||||
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag);
|
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag);
|
||||||
|
Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag);
|
||||||
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
|
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
|
||||||
Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag);
|
Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag);
|
||||||
@ -3333,7 +3451,8 @@ Yap_InitCdMgr(void)
|
|||||||
Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$log_update_clause", 3, p_log_update_clause0, SyncPredFlag);
|
Yap_InitCPred("$log_update_clause", 3, p_log_update_clause0, SyncPredFlag);
|
||||||
Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$continue_log_update_clause", 4, p_continue_log_update_clause0, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$static_clause", 4, p_static_clause, SyncPredFlag);
|
||||||
|
Yap_InitCPred("$continue_static_clause", 5, p_continue_static_clause, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
|
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2703,7 +2703,7 @@ c_optimize(PInstr *pc)
|
|||||||
}
|
}
|
||||||
|
|
||||||
yamop *
|
yamop *
|
||||||
Yap_cclause(Term inp_clause, int NOfArgs, int mod)
|
Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
|
||||||
{ /* compile a prolog clause, copy of clause myst be in ARG1 */
|
{ /* compile a prolog clause, copy of clause myst be in ARG1 */
|
||||||
/* returns address of code for clause */
|
/* returns address of code for clause */
|
||||||
Term head, body;
|
Term head, body;
|
||||||
@ -2868,7 +2868,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod)
|
|||||||
Yap_ShowCode();
|
Yap_ShowCode();
|
||||||
#endif
|
#endif
|
||||||
/* phase 3: assemble code */
|
/* phase 3: assemble code */
|
||||||
acode = Yap_assemble(ASSEMBLING_CLAUSE, inp_clause, CurrentPred, body == MkAtomTerm(AtomTrue));
|
acode = Yap_assemble(ASSEMBLING_CLAUSE, src, CurrentPred, body == MkAtomTerm(AtomTrue));
|
||||||
|
|
||||||
|
|
||||||
/* check first if there was space for us */
|
/* check first if there was space for us */
|
||||||
|
30
C/index.c
30
C/index.c
@ -6010,6 +6010,21 @@ lu_clause(yamop *ipc)
|
|||||||
return c;
|
return c;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static LogUpdClause *
|
||||||
|
static_clause(yamop *ipc)
|
||||||
|
{
|
||||||
|
StaticClause *c;
|
||||||
|
CELL *p = (CELL *)ipc;
|
||||||
|
|
||||||
|
if (ipc == FAILCODE)
|
||||||
|
return NULL;
|
||||||
|
while ((c = ClauseCodeToStaticClause(p))->Id != FunctorDBRef ||
|
||||||
|
(c->ClFlags & (LogUpdMask|IndexMask|DynamicMask|SwitchTableMask|SwitchRootMask))) {
|
||||||
|
p--;
|
||||||
|
}
|
||||||
|
return (LogUpdClause *)c;
|
||||||
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc, PredEntry *pe, yamop *ap_pc, yamop *cp_pc)
|
store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc, PredEntry *pe, yamop *ap_pc, yamop *cp_pc)
|
||||||
{
|
{
|
||||||
@ -6052,7 +6067,7 @@ update_clause_choice_point(yamop *ipc, yamop *ap_pc)
|
|||||||
}
|
}
|
||||||
|
|
||||||
LogUpdClause *
|
LogUpdClause *
|
||||||
Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc)
|
Yap_follow_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yamop *ap_pc, yamop *cp_pc)
|
||||||
{
|
{
|
||||||
CELL *tar = RepAppl(t1);
|
CELL *tar = RepAppl(t1);
|
||||||
UInt i;
|
UInt i;
|
||||||
@ -6061,6 +6076,7 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
|
|||||||
yamop *start_pc = ipc;
|
yamop *start_pc = ipc;
|
||||||
choiceptr b0 = NULL;
|
choiceptr b0 = NULL;
|
||||||
yamop **jlbl = NULL;
|
yamop **jlbl = NULL;
|
||||||
|
int lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
||||||
|
|
||||||
if (ap->ModuleOfPred != 2) {
|
if (ap->ModuleOfPred != 2) {
|
||||||
/* makes no sense for IDB, as ArityOfPE means nothing */
|
/* makes no sense for IDB, as ArityOfPE means nothing */
|
||||||
@ -6082,7 +6098,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
|
|||||||
store_clause_choice_point(t1, tb, tr, NEXTOP(ipc,ld), ap, ap_pc, cp_pc);
|
store_clause_choice_point(t1, tb, tr, NEXTOP(ipc,ld), ap, ap_pc, cp_pc);
|
||||||
else
|
else
|
||||||
update_clause_choice_point(NEXTOP(ipc,ld), ap_pc);
|
update_clause_choice_point(NEXTOP(ipc,ld), ap_pc);
|
||||||
|
if (lu_pred)
|
||||||
return lu_clause(ipc->u.ld.d);
|
return lu_clause(ipc->u.ld.d);
|
||||||
|
else
|
||||||
|
return static_clause(ipc->u.ld.d);
|
||||||
case _try_me:
|
case _try_me:
|
||||||
case _try_me1:
|
case _try_me1:
|
||||||
case _try_me2:
|
case _try_me2:
|
||||||
@ -6099,7 +6118,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
|
|||||||
case _retry_profiled:
|
case _retry_profiled:
|
||||||
case _count_retry:
|
case _count_retry:
|
||||||
update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
|
update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
|
||||||
|
if (lu_pred)
|
||||||
return lu_clause(ipc->u.ld.d);
|
return lu_clause(ipc->u.ld.d);
|
||||||
|
else
|
||||||
|
return static_clause(ipc->u.ld.d);
|
||||||
case _retry_me:
|
case _retry_me:
|
||||||
case _retry_me1:
|
case _retry_me1:
|
||||||
case _retry_me2:
|
case _retry_me2:
|
||||||
@ -6119,7 +6141,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
|
|||||||
abolish_incomplete_subgoals(B);
|
abolish_incomplete_subgoals(B);
|
||||||
#endif /* TABLING */
|
#endif /* TABLING */
|
||||||
b0 = B;
|
b0 = B;
|
||||||
|
if (lu_pred)
|
||||||
return lu_clause(ipc->u.ld.d);
|
return lu_clause(ipc->u.ld.d);
|
||||||
|
else
|
||||||
|
return static_clause(ipc->u.ld.d);
|
||||||
case _profiled_trust_me:
|
case _profiled_trust_me:
|
||||||
case _trust_me:
|
case _trust_me:
|
||||||
case _count_trust_me:
|
case _count_trust_me:
|
||||||
@ -6363,7 +6388,10 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
|
|||||||
#endif /* TABLING */
|
#endif /* TABLING */
|
||||||
/* I did a trust */
|
/* I did a trust */
|
||||||
}
|
}
|
||||||
|
if (lu_pred)
|
||||||
return lu_clause(ipc);
|
return lu_clause(ipc);
|
||||||
|
else
|
||||||
|
return static_clause(ipc);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (b0) {
|
if (b0) {
|
||||||
|
2
C/init.c
2
C/init.c
@ -979,7 +979,7 @@ InitCodes(void)
|
|||||||
heap_regs->pred_recorded_with_key = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded_with_key"),3),0));
|
heap_regs->pred_recorded_with_key = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded_with_key"),3),0));
|
||||||
heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),5),0));
|
heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),5),0));
|
||||||
heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),4),0));
|
heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),4),0));
|
||||||
heap_regs->pred_log_upd_retract = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_retract"),4),0));
|
heap_regs->pred_static_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_static_clause"),5),0));
|
||||||
heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,0));
|
heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,0));
|
||||||
heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$handle_throw"),3),0));
|
heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$handle_throw"),3),0));
|
||||||
heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("goal_expansion"),3),1));
|
heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("goal_expansion"),3),1));
|
||||||
|
@ -115,6 +115,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||||||
/* extern int gc_calls; */
|
/* extern int gc_calls; */
|
||||||
|
|
||||||
vsc_count++;
|
vsc_count++;
|
||||||
|
if (vsc_count == 121085)
|
||||||
|
vsc_xstop = 1;
|
||||||
|
if (vsc_count < 121000LL)
|
||||||
|
return;
|
||||||
#ifdef COMMENTED
|
#ifdef COMMENTED
|
||||||
if (port != enter_pred ||
|
if (port != enter_pred ||
|
||||||
!pred ||
|
!pred ||
|
||||||
|
6
H/Heap.h
6
H/Heap.h
@ -10,7 +10,7 @@
|
|||||||
* File: Heap.h *
|
* File: Heap.h *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Heap Init Structure *
|
* comments: Heap Init Structure *
|
||||||
* version: $Id: Heap.h,v 1.47 2003-11-12 12:33:31 vsc Exp $ *
|
* version: $Id: Heap.h,v 1.48 2003-11-21 16:56:20 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
/* information that can be stored in Code Space */
|
/* information that can be stored in Code Space */
|
||||||
@ -293,7 +293,7 @@ typedef struct various_codes {
|
|||||||
struct pred_entry *pred_recorded_with_key;
|
struct pred_entry *pred_recorded_with_key;
|
||||||
struct pred_entry *pred_log_upd_clause;
|
struct pred_entry *pred_log_upd_clause;
|
||||||
struct pred_entry *pred_log_upd_clause0;
|
struct pred_entry *pred_log_upd_clause0;
|
||||||
struct pred_entry *pred_log_upd_retract;
|
struct pred_entry *pred_static_clause;
|
||||||
struct pred_entry *pred_throw;
|
struct pred_entry *pred_throw;
|
||||||
struct pred_entry *pred_handle_throw;
|
struct pred_entry *pred_handle_throw;
|
||||||
struct array_entry *dyn_array_list;
|
struct array_entry *dyn_array_list;
|
||||||
@ -533,7 +533,7 @@ typedef struct various_codes {
|
|||||||
#define PredRecordedWithKey heap_regs->pred_recorded_with_key
|
#define PredRecordedWithKey heap_regs->pred_recorded_with_key
|
||||||
#define PredLogUpdClause heap_regs->pred_log_upd_clause
|
#define PredLogUpdClause heap_regs->pred_log_upd_clause
|
||||||
#define PredLogUpdClause0 heap_regs->pred_log_upd_clause0
|
#define PredLogUpdClause0 heap_regs->pred_log_upd_clause0
|
||||||
#define PredLogUpdRetract heap_regs->pred_log_upd_retract
|
#define PredStaticClause heap_regs->pred_static_clause
|
||||||
#define PredThrow heap_regs->pred_throw
|
#define PredThrow heap_regs->pred_throw
|
||||||
#define PredHandleThrow heap_regs->pred_handle_throw
|
#define PredHandleThrow heap_regs->pred_handle_throw
|
||||||
#define DynArrayList heap_regs->dyn_array_list
|
#define DynArrayList heap_regs->dyn_array_list
|
||||||
|
@ -10,7 +10,7 @@
|
|||||||
* File: Yap.proto *
|
* File: Yap.proto *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Function declarations for YAP *
|
* comments: Function declarations for YAP *
|
||||||
* version: $Id: Yapproto.h,v 1.40 2003-11-12 12:33:31 vsc Exp $ *
|
* version: $Id: Yapproto.h,v 1.41 2003-11-21 16:56:20 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
/* prototype file for Yap */
|
/* prototype file for Yap */
|
||||||
@ -118,7 +118,7 @@ int STD_PROTO(Yap_compare_terms,(Term,Term));
|
|||||||
void STD_PROTO(Yap_InitCmpPreds,(void));
|
void STD_PROTO(Yap_InitCmpPreds,(void));
|
||||||
|
|
||||||
/* compiler.c */
|
/* compiler.c */
|
||||||
yamop *STD_PROTO(Yap_cclause,(Term, int, int));
|
yamop *STD_PROTO(Yap_cclause,(Term, int, int, Term));
|
||||||
|
|
||||||
/* computils.c */
|
/* computils.c */
|
||||||
|
|
||||||
|
@ -106,7 +106,9 @@ typedef struct static_index {
|
|||||||
|
|
||||||
typedef struct static_clause {
|
typedef struct static_clause {
|
||||||
/* A set of flags describing info on the clause */
|
/* A set of flags describing info on the clause */
|
||||||
|
Functor Id;
|
||||||
CELL ClFlags;
|
CELL ClFlags;
|
||||||
|
DBTerm *ClSource;
|
||||||
Atom Owner;
|
Atom Owner;
|
||||||
/* The instructions, at least one of the form sl */
|
/* The instructions, at least one of the form sl */
|
||||||
yamop ClCode[MIN_ARRAY];
|
yamop ClCode[MIN_ARRAY];
|
||||||
@ -185,7 +187,7 @@ yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *));
|
|||||||
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
|
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
|
||||||
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
|
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
|
||||||
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
|
void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
|
||||||
LogUpdClause *STD_PROTO(Yap_follow_lu_indexing_code,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
|
LogUpdClause *STD_PROTO(Yap_follow_indexing_code,(PredEntry *,yamop *,Term,Term,Term, yamop *,yamop *));
|
||||||
|
|
||||||
#if LOW_PROF
|
#if LOW_PROF
|
||||||
/* profiling */
|
/* profiling */
|
||||||
|
@ -309,6 +309,10 @@ restore_codes(void)
|
|||||||
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_recorded_with_key);
|
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_recorded_with_key);
|
||||||
heap_regs->pred_log_upd_clause =
|
heap_regs->pred_log_upd_clause =
|
||||||
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_log_upd_clause);
|
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_log_upd_clause);
|
||||||
|
heap_regs->pred_log_upd_clause0 =
|
||||||
|
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_log_upd_clause0);
|
||||||
|
heap_regs->pred_static_clause =
|
||||||
|
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_static_clause);
|
||||||
heap_regs->pred_throw =
|
heap_regs->pred_throw =
|
||||||
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_throw);
|
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_throw);
|
||||||
heap_regs->pred_handle_throw =
|
heap_regs->pred_handle_throw =
|
||||||
|
@ -380,13 +380,6 @@ repeat :- '$repeat'.
|
|||||||
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; true )
|
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; true )
|
||||||
;
|
;
|
||||||
true
|
true
|
||||||
),
|
|
||||||
( Fl /\ 16'400000 =:= 0 -> % is this procedure in source mode?
|
|
||||||
% no, just ignore
|
|
||||||
true
|
|
||||||
;
|
|
||||||
% and store our clause
|
|
||||||
'$store_stat_clause'(G0, H, L, Mod)
|
|
||||||
).
|
).
|
||||||
|
|
||||||
'$store_stat_clause'(G0, H, L, M) :-
|
'$store_stat_clause'(G0, H, L, M) :-
|
||||||
@ -404,7 +397,6 @@ repeat :- '$repeat'.
|
|||||||
'$is_multifile'(G, M), !,
|
'$is_multifile'(G, M), !,
|
||||||
functor(G, Na, Ar),
|
functor(G, Na, Ar),
|
||||||
'$erase_mf_source'(Na, Ar, M).
|
'$erase_mf_source'(Na, Ar, M).
|
||||||
'$erase_source'(G, M) :- '$recordedp'(M:G,_,R), erase(R), fail.
|
|
||||||
'$erase_source'(_, _).
|
'$erase_source'(_, _).
|
||||||
|
|
||||||
'$erase_mf_source'(Na, Ar, M) :-
|
'$erase_mf_source'(Na, Ar, M) :-
|
||||||
|
@ -393,16 +393,11 @@ debugging :-
|
|||||||
'$execute0'(G, M).
|
'$execute0'(G, M).
|
||||||
'$spycall'(G,M) :-
|
'$spycall'(G,M) :-
|
||||||
'$flags'(G,M,F,F),
|
'$flags'(G,M,F,F),
|
||||||
F /\ 16'2008 =\= 0, !, % dynamic procedure, or logical semantics
|
F /\ 16'402008 =\= 0, !, % dynamic procedure, logical semantics, or source
|
||||||
% use the interpreter
|
% use the interpreter
|
||||||
'$clause'(G, M, Cl),
|
'$clause'(G, M, Cl),
|
||||||
CP is '$last_choice_pt',
|
CP is '$last_choice_pt',
|
||||||
'$do_spy'(Cl, M, CP).
|
'$do_spy'(Cl, M, CP).
|
||||||
'$spycall'(G,M) :-
|
|
||||||
'$some_recordedp'(M:G), !,
|
|
||||||
'$clause'(G, M, Cl),
|
|
||||||
CP is '$last_choice_pt',
|
|
||||||
'$do_spy'(Cl, M, CP).
|
|
||||||
'$spycall'(G,M) :-
|
'$spycall'(G,M) :-
|
||||||
'$continue_debugging',
|
'$continue_debugging',
|
||||||
'$execute0'(G, M).
|
'$execute0'(G, M).
|
||||||
|
@ -177,8 +177,6 @@ print_message(Level, Mss) :-
|
|||||||
'$preprocess_stack'(Gs, I, NGs).
|
'$preprocess_stack'(Gs, I, NGs).
|
||||||
'$beautify_hidden_goal'('$ensure_loaded',_,prolog,ClNo,Gs,I,NGs) :- !,
|
'$beautify_hidden_goal'('$ensure_loaded',_,prolog,ClNo,Gs,I,NGs) :- !,
|
||||||
'$preprocess_stack'(Gs, I, NGs).
|
'$preprocess_stack'(Gs, I, NGs).
|
||||||
'$beautify_hidden_goal'('$recordedp',_,prolog,ClNo,Gs,I,NGs) :- !,
|
|
||||||
'$preprocess_stack'(Gs, I, NGs).
|
|
||||||
'$beautify_hidden_goal'('$continue_with_command',_,prolog,ClNo,Gs,I,NGs) :- !,
|
'$beautify_hidden_goal'('$continue_with_command',_,prolog,ClNo,Gs,I,NGs) :- !,
|
||||||
'$preprocess_stack'(Gs, I, NGs).
|
'$preprocess_stack'(Gs, I, NGs).
|
||||||
'$beautify_hidden_goal'('$spycall_stdpred',_,prolog,ClNo,Gs,I,NGs) :- !,
|
'$beautify_hidden_goal'('$spycall_stdpred',_,prolog,ClNo,Gs,I,NGs) :- !,
|
||||||
|
@ -55,16 +55,8 @@ listing(V) :-
|
|||||||
'$funcspec'(Name,_,_) :-
|
'$funcspec'(Name,_,_) :-
|
||||||
'$do_error'(domain_error(predicate_spec,Name),listing(Name)).
|
'$do_error'(domain_error(predicate_spec,Name),listing(Name)).
|
||||||
|
|
||||||
'$list_clauses'(Stream, Mod, Pred) :-
|
|
||||||
'$is_log_updatable'(Pred, Mod), !,
|
|
||||||
'$log_update_clause'(Pred,Mod,Body),
|
|
||||||
'$portray_clause'(Stream,(Pred:-Body)),
|
|
||||||
fail.
|
|
||||||
'$list_clauses'(Stream, M, Pred) :-
|
'$list_clauses'(Stream, M, Pred) :-
|
||||||
( '$recordedp'(M:Pred,_,_) -> nl(Stream) ),
|
'$clause'(Pred, M, Body),
|
||||||
fail.
|
|
||||||
'$list_clauses'(Stream, M, Pred) :-
|
|
||||||
'$recordedp'(M:Pred,(Pred:-Body),_),
|
|
||||||
'$portray_clause'(Stream,(Pred:-Body)),
|
'$portray_clause'(Stream,(Pred:-Body)),
|
||||||
fail.
|
fail.
|
||||||
|
|
||||||
|
17
pl/preds.yap
17
pl/preds.yap
@ -314,6 +314,9 @@ clause(V,Q,R) :-
|
|||||||
'$do_error'(type_error(callable,R),M:clause(R,Q)).
|
'$do_error'(type_error(callable,R),M:clause(R,Q)).
|
||||||
'$clause'(M:P,_,Q,R) :- !,
|
'$clause'(M:P,_,Q,R) :- !,
|
||||||
'$clause'(P,M,Q,R).
|
'$clause'(P,M,Q,R).
|
||||||
|
'$clause'(P,M,Q,R) :-
|
||||||
|
'$is_source'(P, M), !,
|
||||||
|
'$static_clause'(P,M,Q,R).
|
||||||
'$clause'(P,M,Q,R) :-
|
'$clause'(P,M,Q,R) :-
|
||||||
'$is_log_updatable'(P, M), !,
|
'$is_log_updatable'(P, M), !,
|
||||||
'$log_update_clause'(P,M,Q,R).
|
'$log_update_clause'(P,M,Q,R).
|
||||||
@ -339,10 +342,10 @@ clause(V,Q,R) :-
|
|||||||
'$continue_log_update_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'(A,B,C,D).
|
||||||
|
|
||||||
'$do_log_upd_retract'(_,_,_,_).
|
'$do_static_clause'(_,_,_,_,_).
|
||||||
'$do_log_upd_retract'(A,B,C,D) :-
|
'$do_static_clause'(A,B,C,D,E) :-
|
||||||
'$continue_log_update_retract'(A,B,C,D).
|
'$continue_static_clause'(A,B,C,D,E).
|
||||||
'$do_log_upd_retract'(A,B,C,D).
|
'$do_static_clause'(A,B,C,D,E).
|
||||||
|
|
||||||
nth_clause(P,I,R) :- nonvar(R), !,
|
nth_clause(P,I,R) :- nonvar(R), !,
|
||||||
'$nth_instancep'(P,I,R).
|
'$nth_instancep'(P,I,R).
|
||||||
@ -625,8 +628,7 @@ abolish(X) :-
|
|||||||
functor(G,A,N),
|
functor(G,A,N),
|
||||||
'$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)).
|
'$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)).
|
||||||
'$abolishs'(G, M) :-
|
'$abolishs'(G, M) :-
|
||||||
'$purge_clauses'(G, M),
|
'$purge_clauses'(G, M), fail.
|
||||||
'$recordedp'(M:G,_,R), erase(R), fail.
|
|
||||||
'$abolishs'(_, _).
|
'$abolishs'(_, _).
|
||||||
|
|
||||||
%
|
%
|
||||||
@ -776,7 +778,8 @@ predicate_property(Pred,Prop) :-
|
|||||||
'$predicate_property'(P,M,_,built_in) :-
|
'$predicate_property'(P,M,_,built_in) :-
|
||||||
'$system_predicate'(P,M), !.
|
'$system_predicate'(P,M), !.
|
||||||
'$predicate_property'(P,M,_,source) :-
|
'$predicate_property'(P,M,_,source) :-
|
||||||
( '$recordedp'(M:P,_,_) -> true ; false).
|
'$flags'(G,M,F,F),
|
||||||
|
( F /\ 16'400000 =\= 0 -> true ; false).
|
||||||
'$predicate_property'(P,M,_,dynamic) :-
|
'$predicate_property'(P,M,_,dynamic) :-
|
||||||
'$is_dynamic'(P,M).
|
'$is_dynamic'(P,M).
|
||||||
'$predicate_property'(P,M,_,static) :-
|
'$predicate_property'(P,M,_,static) :-
|
||||||
|
Reference in New Issue
Block a user