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

compact source mode.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@934 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-11-21 16:56:20 +00:00
parent 8d3f30de9c
commit f5edbc8aa7
16 changed files with 254 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
C/amasm.c
View File

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

2
C/c_interface.c
View File

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

195
C/cdmgr.c
View File

@ -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,24 +3027,26 @@ 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) {
Functor f = FunctorOfTerm(th);
UInt arity = ArityOfFunctor(f), i;
CELL *pt = RepAppl(th)+1;
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) || if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
!Yap_unify(tr, rtn)) !Yap_unify(tr, rtn))
return FALSE; return FALSE;
for (i=0; i<arity; i++) { if (pe->ArityOfPE) {
XREGS[i+1] = pt[i]; 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 = cl->ClCode;
} }
/* don't need no ENV */
if (first_time) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
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,28 +3097,30 @@ 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) {
Functor f = FunctorOfTerm(th);
UInt arity = ArityOfFunctor(f), i;
CELL *pt = RepAppl(th)+1;
if (!Yap_unify(tb, MkAtomTerm(AtomTrue))) if (!Yap_unify(tb, MkAtomTerm(AtomTrue)))
return FALSE; return FALSE;
for (i=0; i<arity; i++) { if (pe->ArityOfPE) {
XREGS[i+1] = pt[i]; 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 = cl->ClCode;
} }
/* don't need no ENV */
if (first_time) {
CP = P;
ENV = YENV;
YENV = ASP;
YENV[E_CB] = (CELL) B;
}
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);
} }

4
C/compiler.c
View File

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

40
C/index.c
View File

@ -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 */
@ -6068,7 +6084,7 @@ Yap_follow_lu_indexing_code(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr
XREGS[i] = tar[i]; XREGS[i] = tar[i];
} }
} }
/* try to refine the interval using the indexing code */ /* try to refine the interval using the indexing code */
while (ipc != NULL) { while (ipc != NULL) {
op_numbers op = Yap_op_from_opcode(ipc->opc); op_numbers op = Yap_op_from_opcode(ipc->opc);
@ -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);
return lu_clause(ipc->u.ld.d); if (lu_pred)
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);
return lu_clause(ipc->u.ld.d); if (lu_pred)
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;
return lu_clause(ipc->u.ld.d); if (lu_pred)
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 */
} }
return lu_clause(ipc); if (lu_pred)
return lu_clause(ipc);
else
return static_clause(ipc);
} }
} }
if (b0) { if (b0) {

2
C/init.c
View File

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

4
C/tracer.c
View File

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

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

4
H/Yapproto.h
View File

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

4
H/clause.h
View File

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

4
H/rheap.h
View File

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

8
pl/boot.yap
View File

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

7
pl/debug.yap
View File

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

2
pl/errors.yap
View File

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

10
pl/listing.yap
View File

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

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