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 {
|
||||
/* static clause */
|
||||
if (pass_no) {
|
||||
cl_u->sc.Id = FunctorDBRef;
|
||||
cl_u->sc.ClFlags = 0;
|
||||
cl_u->sc.Owner = Yap_ConsultingFile();
|
||||
if (clause_has_blobs) {
|
||||
@ -2441,7 +2442,7 @@ do_pass(void)
|
||||
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));
|
||||
label_offset[cpc->rnd1] = (CELL) code_p;
|
||||
}
|
||||
@ -2650,15 +2651,44 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
|
||||
!is_fact) {
|
||||
DBTerm *x;
|
||||
LogUpdClause *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 = (LogUpdClause *)((CODEADDR)x-(UInt)size);
|
||||
cl->ClSource = x;
|
||||
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 {
|
||||
while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {
|
||||
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();
|
||||
YAPLeaveCriticalSection();
|
||||
#ifdef LOW_PROF
|
||||
|
@ -843,7 +843,7 @@ YAP_CompileClause(Term t)
|
||||
|
||||
Yap_ErrorMessage = NULL;
|
||||
ARG1 = t;
|
||||
codeaddr = Yap_cclause (t,0, mod);
|
||||
codeaddr = Yap_cclause (t,0, mod, t);
|
||||
if (codeaddr != NULL) {
|
||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||
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
|
||||
addclause(Term t, yamop *cp, int mode, int mod, Term src)
|
||||
addclause(Term t, yamop *cp, int mode, int mod)
|
||||
/*
|
||||
*
|
||||
mode
|
||||
@ -1201,8 +1201,10 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src)
|
||||
StaticClause *clp = ClauseCodeToStaticClause(cp);
|
||||
clp->ClFlags |= StaticMask;
|
||||
if (IsAtomTerm(t) ||
|
||||
FunctorOfTerm(t) != FunctorAssert)
|
||||
FunctorOfTerm(t) != FunctorAssert) {
|
||||
clp->ClFlags |= FactMask;
|
||||
clp->ClSource = NULL;
|
||||
}
|
||||
}
|
||||
if (compile_mode)
|
||||
p->PredFlags = pflags | CompiledPredFlag | FastPredFlag;
|
||||
@ -1246,7 +1248,7 @@ addclause(Term t, yamop *cp, int mode, int mod, Term src)
|
||||
|
||||
void
|
||||
Yap_addclause(Term t, yamop *cp, int mode, int mod) {
|
||||
addclause(t, cp, mode, mod, t);
|
||||
addclause(t, cp, mode, mod);
|
||||
}
|
||||
|
||||
void
|
||||
@ -1408,11 +1410,11 @@ p_compile(void)
|
||||
if (IsVarTerm(t3) || !IsAtomTerm(t3))
|
||||
return (FALSE);
|
||||
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 */
|
||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||
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 (IntOfTerm(t1) & 4) {
|
||||
Yap_Error(Yap_Error_TYPE, Yap_Error_Term,
|
||||
@ -1441,13 +1443,13 @@ p_compile_dynamic(void)
|
||||
old_optimize = optimizer_on;
|
||||
optimizer_on = FALSE;
|
||||
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 */
|
||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||
if (!Yap_ErrorMessage) {
|
||||
|
||||
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 {
|
||||
if (IntOfTerm(t1) & 4) {
|
||||
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);
|
||||
}
|
||||
|
||||
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
|
||||
p_is_dynamic(void)
|
||||
{ /* '$is_dynamic'(+P) */
|
||||
@ -2980,7 +3009,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_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;
|
||||
|
||||
if (cl == NULL)
|
||||
@ -2998,13 +3027,14 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
|
||||
}
|
||||
#endif
|
||||
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;
|
||||
|
||||
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
|
||||
!Yap_unify(tr, rtn))
|
||||
return FALSE;
|
||||
for (i=0; i<arity; 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;
|
||||
}
|
||||
P = cl->ClCode;
|
||||
}
|
||||
return TRUE;
|
||||
} else {
|
||||
Term t;
|
||||
@ -3048,6 +3079,9 @@ p_log_update_clause(void)
|
||||
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_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
|
||||
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)
|
||||
return FALSE;
|
||||
if (cl->ClFlags & FactMask) {
|
||||
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
|
||||
return FALSE;
|
||||
if (pe->ArityOfPE) {
|
||||
Functor f = FunctorOfTerm(th);
|
||||
UInt arity = ArityOfFunctor(f), i;
|
||||
CELL *pt = RepAppl(th)+1;
|
||||
|
||||
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
|
||||
return FALSE;
|
||||
for (i=0; i<arity; 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;
|
||||
}
|
||||
P = cl->ClCode;
|
||||
}
|
||||
return TRUE;
|
||||
} else {
|
||||
Term t;
|
||||
@ -3116,6 +3152,9 @@ p_log_update_clause0(void)
|
||||
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_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);
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
static void
|
||||
@ -3302,6 +3419,7 @@ Yap_InitCdMgr(void)
|
||||
Yap_InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag);
|
||||
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_source", 2, p_is_source, 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("$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("$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("$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);
|
||||
}
|
||||
|
||||
|
@ -2703,7 +2703,7 @@ c_optimize(PInstr *pc)
|
||||
}
|
||||
|
||||
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 */
|
||||
/* returns address of code for clause */
|
||||
Term head, body;
|
||||
@ -2868,7 +2868,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod)
|
||||
Yap_ShowCode();
|
||||
#endif
|
||||
/* 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 */
|
||||
|
30
C/index.c
30
C/index.c
@ -6010,6 +6010,21 @@ lu_clause(yamop *ipc)
|
||||
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
|
||||
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 *
|
||||
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);
|
||||
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;
|
||||
choiceptr b0 = NULL;
|
||||
yamop **jlbl = NULL;
|
||||
int lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
||||
|
||||
if (ap->ModuleOfPred != 2) {
|
||||
/* 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);
|
||||
else
|
||||
update_clause_choice_point(NEXTOP(ipc,ld), ap_pc);
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
else
|
||||
return static_clause(ipc->u.ld.d);
|
||||
case _try_me:
|
||||
case _try_me1:
|
||||
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 _count_retry:
|
||||
update_clause_choice_point(NEXTOP(ipc,ld),ap_pc);
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
else
|
||||
return static_clause(ipc->u.ld.d);
|
||||
case _retry_me:
|
||||
case _retry_me1:
|
||||
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);
|
||||
#endif /* TABLING */
|
||||
b0 = B;
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc->u.ld.d);
|
||||
else
|
||||
return static_clause(ipc->u.ld.d);
|
||||
case _profiled_trust_me:
|
||||
case _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 */
|
||||
/* I did a trust */
|
||||
}
|
||||
if (lu_pred)
|
||||
return lu_clause(ipc);
|
||||
else
|
||||
return static_clause(ipc);
|
||||
}
|
||||
}
|
||||
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_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_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_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));
|
||||
|
@ -115,6 +115,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||
/* extern int gc_calls; */
|
||||
|
||||
vsc_count++;
|
||||
if (vsc_count == 121085)
|
||||
vsc_xstop = 1;
|
||||
if (vsc_count < 121000LL)
|
||||
return;
|
||||
#ifdef COMMENTED
|
||||
if (port != enter_pred ||
|
||||
!pred ||
|
||||
|
6
H/Heap.h
6
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* 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 */
|
||||
@ -293,7 +293,7 @@ typedef struct various_codes {
|
||||
struct pred_entry *pred_recorded_with_key;
|
||||
struct pred_entry *pred_log_upd_clause;
|
||||
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_handle_throw;
|
||||
struct array_entry *dyn_array_list;
|
||||
@ -533,7 +533,7 @@ typedef struct various_codes {
|
||||
#define PredRecordedWithKey heap_regs->pred_recorded_with_key
|
||||
#define PredLogUpdClause heap_regs->pred_log_upd_clause
|
||||
#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 PredHandleThrow heap_regs->pred_handle_throw
|
||||
#define DynArrayList heap_regs->dyn_array_list
|
||||
|
@ -10,7 +10,7 @@
|
||||
* File: Yap.proto *
|
||||
* mods: *
|
||||
* 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 */
|
||||
@ -118,7 +118,7 @@ int STD_PROTO(Yap_compare_terms,(Term,Term));
|
||||
void STD_PROTO(Yap_InitCmpPreds,(void));
|
||||
|
||||
/* compiler.c */
|
||||
yamop *STD_PROTO(Yap_cclause,(Term, int, int));
|
||||
yamop *STD_PROTO(Yap_cclause,(Term, int, int, Term));
|
||||
|
||||
/* computils.c */
|
||||
|
||||
|
@ -106,7 +106,9 @@ typedef struct static_index {
|
||||
|
||||
typedef struct static_clause {
|
||||
/* A set of flags describing info on the clause */
|
||||
Functor Id;
|
||||
CELL ClFlags;
|
||||
DBTerm *ClSource;
|
||||
Atom Owner;
|
||||
/* The instructions, at least one of the form sl */
|
||||
yamop ClCode[MIN_ARRAY];
|
||||
@ -185,7 +187,7 @@ yamop *STD_PROTO(Yap_ExpandIndex,(PredEntry *));
|
||||
yamop *STD_PROTO(Yap_CleanUpIndex,(struct logic_upd_index *));
|
||||
void STD_PROTO(Yap_AddClauseToIndex,(PredEntry *,yamop *,int));
|
||||
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
|
||||
/* profiling */
|
||||
|
@ -309,6 +309,10 @@ restore_codes(void)
|
||||
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_recorded_with_key);
|
||||
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 =
|
||||
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_throw);
|
||||
heap_regs->pred_handle_throw =
|
||||
|
@ -380,13 +380,6 @@ repeat :- '$repeat'.
|
||||
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Mod,Fl) ; 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) :-
|
||||
@ -404,7 +397,6 @@ repeat :- '$repeat'.
|
||||
'$is_multifile'(G, M), !,
|
||||
functor(G, Na, Ar),
|
||||
'$erase_mf_source'(Na, Ar, M).
|
||||
'$erase_source'(G, M) :- '$recordedp'(M:G,_,R), erase(R), fail.
|
||||
'$erase_source'(_, _).
|
||||
|
||||
'$erase_mf_source'(Na, Ar, M) :-
|
||||
|
@ -393,16 +393,11 @@ debugging :-
|
||||
'$execute0'(G, M).
|
||||
'$spycall'(G,M) :-
|
||||
'$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
|
||||
'$clause'(G, M, Cl),
|
||||
CP is '$last_choice_pt',
|
||||
'$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) :-
|
||||
'$continue_debugging',
|
||||
'$execute0'(G, M).
|
||||
|
@ -177,8 +177,6 @@ print_message(Level, Mss) :-
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$ensure_loaded',_,prolog,ClNo,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) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$spycall_stdpred',_,prolog,ClNo,Gs,I,NGs) :- !,
|
||||
|
@ -55,16 +55,8 @@ listing(V) :-
|
||||
'$funcspec'(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) :-
|
||||
( '$recordedp'(M:Pred,_,_) -> nl(Stream) ),
|
||||
fail.
|
||||
'$list_clauses'(Stream, M, Pred) :-
|
||||
'$recordedp'(M:Pred,(Pred:-Body),_),
|
||||
'$clause'(Pred, M, Body),
|
||||
'$portray_clause'(Stream,(Pred:-Body)),
|
||||
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)).
|
||||
'$clause'(M:P,_,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) :-
|
||||
'$is_log_updatable'(P, M), !,
|
||||
'$log_update_clause'(P,M,Q,R).
|
||||
@ -339,10 +342,10 @@ clause(V,Q,R) :-
|
||||
'$continue_log_update_clause'(A,B,C,D).
|
||||
'$do_log_upd_clause'(A,B,C,D).
|
||||
|
||||
'$do_log_upd_retract'(_,_,_,_).
|
||||
'$do_log_upd_retract'(A,B,C,D) :-
|
||||
'$continue_log_update_retract'(A,B,C,D).
|
||||
'$do_log_upd_retract'(A,B,C,D).
|
||||
'$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).
|
||||
|
||||
nth_clause(P,I,R) :- nonvar(R), !,
|
||||
'$nth_instancep'(P,I,R).
|
||||
@ -625,8 +628,7 @@ abolish(X) :-
|
||||
functor(G,A,N),
|
||||
'$do_error'(permission_error(modify,static_procedure,A/N),abolish(Module:G)).
|
||||
'$abolishs'(G, M) :-
|
||||
'$purge_clauses'(G, M),
|
||||
'$recordedp'(M:G,_,R), erase(R), fail.
|
||||
'$purge_clauses'(G, M), fail.
|
||||
'$abolishs'(_, _).
|
||||
|
||||
%
|
||||
@ -776,7 +778,8 @@ predicate_property(Pred,Prop) :-
|
||||
'$predicate_property'(P,M,_,built_in) :-
|
||||
'$system_predicate'(P,M), !.
|
||||
'$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) :-
|
||||
'$is_dynamic'(P,M).
|
||||
'$predicate_property'(P,M,_,static) :-
|
||||
|
Reference in New Issue
Block a user