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

faster access to predicate code from functor

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@167 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-10-03 13:39:16 +00:00
parent c3aa27e76b
commit 4688551043
19 changed files with 304 additions and 434 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/absmi.c
View File

@ -5903,7 +5903,7 @@ absmi(int inp)
READ_UNLOCK(pe->PRWLock); READ_UNLOCK(pe->PRWLock);
d0 = pe->ArityOfPE; d0 = pe->ArityOfPE;
if (d0 == 0) { if (d0 == 0) {
H[1] = MkAtomTerm(((Atom) pe->FunctorOfPred)); H[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
} }
else { else {
H[d0 + 2] = AbsAppl(H); H[d0 + 2] = AbsAppl(H);
@ -5987,7 +5987,7 @@ absmi(int inp)
d0 = pe->ArityOfPE; d0 = pe->ArityOfPE;
/* save S for ModuleName */ /* save S for ModuleName */
if (d0 == 0) { if (d0 == 0) {
H[1] = MkAtomTerm((Atom) pe->FunctorOfPred); H[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
} else { } else {
*H = (CELL) pe->FunctorOfPred; *H = (CELL) pe->FunctorOfPred;
H[d0 + 2] = AbsAppl(H); H[d0 + 2] = AbsAppl(H);

98
C/adtdefs.c
View File

@ -59,7 +59,9 @@ InlinedUnlockedMkFunctor(AtomEntry *ae, unsigned int arity)
p->KindOfPE = FunctorProperty; p->KindOfPE = FunctorProperty;
p->NameOfFE = AbsAtom(ae); p->NameOfFE = AbsAtom(ae);
p->ArityOfFE = arity; p->ArityOfFE = arity;
p->PropsOfFE = NIL;
p->NextOfPE = ae->PropOfAE; p->NextOfPE = ae->PropOfAE;
INIT_RWLOCK(p->FRWLock);
ae->PropOfAE = AbsProp((PropEntry *) p); ae->PropOfAE = AbsProp((PropEntry *) p);
return ((Functor) p); return ((Functor) p);
} }
@ -258,20 +260,48 @@ GetAProp(Atom a, PropFlags kind)
return (out); return (out);
} }
static Prop
UnlockedFunctorGetPredProp(Functor f)
/* get predicate entry for ap/arity; */
{
Prop p0;
FunctorEntry *fe = (FunctorEntry *)f;
PredEntry *p;
p = RepPredProp(p0 = fe->PropsOfFE);
while (p0 && (p->KindOfPE != PEProp ||
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
p = RepPredProp(p0 = p->NextOfPE);
READ_UNLOCK(fe->FRWLock);
return (p0);
}
Prop Prop
GetPredProp(Atom ap, unsigned int arity) GetPredProp(Atom ap, unsigned int arity)
/* get predicate entry for ap/arity; */ /* get predicate entry for ap/arity; */
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(ap); AtomEntry *ae = RepAtom(ap);
PredEntry *p; Functor f;
READ_LOCK(ae->ARWLock); WRITE_LOCK(ae->ARWLock);
p = RepPredProp(p0 = ae->PropOfAE); f = InlinedUnlockedMkFunctor(ae, arity);
while (p0 && (p->KindOfPE != PEProp || p->ArityOfPE != arity || WRITE_UNLOCK(ae->FRWLock);
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule))) READ_LOCK(f->ARWLock);
p = RepPredProp(p0 = p->NextOfPE); p0 = UnlockedFunctorGetPredProp(f);
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(f->FRWLock);
return (p0);
}
Prop
GetPredPropByFunc(Functor f)
/* get predicate entry for ap/arity; */
{
Prop p0;
READ_LOCK(f->ARWLock);
p0 = UnlockedFunctorGetPredProp(f);
READ_UNLOCK(f->FRWLock);
return (p0); return (p0);
} }
@ -281,12 +311,12 @@ LockedGetPredProp(Atom ap, unsigned int arity)
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(ap); AtomEntry *ae = RepAtom(ap);
PredEntry *p; Functor f;
p = RepPredProp(p0 = ae->PropOfAE); f = InlinedUnlockedMkFunctor(ae, arity);
while (p0 && (p->KindOfPE != PEProp || p->ArityOfPE != arity || READ_LOCK(f->ARWLock);
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule))) p0 = UnlockedFunctorGetPredProp(f);
p = RepPredProp(p0 = p->NextOfPE); READ_UNLOCK(f->FRWLock);
return (p0); return (p0);
} }
@ -320,27 +350,28 @@ LockedGetExpProp(AtomEntry *ae, unsigned int arity)
} }
Prop Prop
PredProp(Atom ap, unsigned int arity) PredPropByFunc(Functor f)
/* get predicate entry for ap/arity; create it if neccessary. */ /* get predicate entry for ap/arity; create it if neccessary. */
{ {
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(ap); FunctorEntry *fe = (FunctorEntry *)f;
PredEntry *p; PredEntry *p;
WRITE_LOCK(ae->ARWLock); WRITE_LOCK(fe->FRWLock);
p = RepPredProp(p0 = RepAtom(ap)->PropOfAE); p = RepPredProp(p0 = fe->PropsOfFE);
while (p0 && (p->KindOfPE != 0 || p->ArityOfPE != arity ||
while (p0 && (p->KindOfPE != 0 ||
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule))) (p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
p = RepPredProp(p0 = p->NextOfPE); p = RepPredProp(p0 = p->NextOfPE);
if (p0 != NIL) { if (p0 != NIL) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(f->FRWLock);
return (p0); return (p0);
} }
p = (PredEntry *) AllocAtomSpace(sizeof(*p)); p = (PredEntry *) AllocAtomSpace(sizeof(*p));
INIT_RWLOCK(p->PRWLock); INIT_RWLOCK(p->PRWLock);
p->KindOfPE = PEProp; p->KindOfPE = PEProp;
p->ArityOfPE = arity; p->ArityOfPE = fe->ArityOfFE;
p->FirstClause = p->LastClause = NIL; p->FirstClause = p->LastClause = NIL;
p->PredFlags = 0L; p->PredFlags = 0L;
p->StateOfPred = 0; p->StateOfPred = 0;
@ -348,6 +379,8 @@ PredProp(Atom ap, unsigned int arity)
p->OpcodeOfPred = UNDEF_OPCODE; p->OpcodeOfPred = UNDEF_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->ModuleOfPred = CurrentModule; p->ModuleOfPred = CurrentModule;
p->NextPredOfModule = ModulePred[CurrentModule];
ModulePred[CurrentModule] = p;
INIT_LOCK(p->StatisticsForPred.lock); INIT_LOCK(p->StatisticsForPred.lock);
p->StatisticsForPred.NOfEntries = 0; p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfHeadSuccesses = 0;
@ -356,17 +389,28 @@ PredProp(Atom ap, unsigned int arity)
p->TableOfPred = NULL; p->TableOfPred = NULL;
#endif /* TABLING */ #endif /* TABLING */
/* careful that they don't cross MkFunctor */ /* careful that they don't cross MkFunctor */
p->NextOfPE = ae->PropOfAE; p->NextOfPE = fe->PropsOfFE;
ae->PropOfAE = p0 = AbsPredProp(p); fe->PropsOfFE = p0 = AbsPredProp(p);
if (arity == 0) p->FunctorOfPred = f;
p->FunctorOfPred = (Functor) ap; WRITE_UNLOCK(fe->FRWLock);
else {
p->FunctorOfPred = InlinedUnlockedMkFunctor(ae, arity);
}
WRITE_UNLOCK(ae->ARWLock);
return (p0); return (p0);
} }
Prop
PredProp(Atom ap, unsigned int arity)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(ap);
Functor f;
WRITE_LOCK(ae->ARWLock);
f = InlinedUnlockedMkFunctor(ae, arity);
p0 = PredPropByFunc(f);
WRITE_UNLOCK(ae->ARWLock);
return(p0);
}
Term Term
GetValue(Atom a) GetValue(Atom a)
{ {

131
C/cdmgr.c
View File

@ -1171,9 +1171,7 @@ p_endconsult(void)
static Int static Int
p_purge_clauses(void) p_purge_clauses(void)
{ /* '$purge_clauses'(+Func) */ { /* '$purge_clauses'(+Func) */
Atom at;
PredEntry *pred; PredEntry *pred;
unsigned int arity;
Term t = Deref(ARG1); Term t = Deref(ARG1);
CODEADDR q, q1; CODEADDR q, q1;
@ -1181,15 +1179,13 @@ p_purge_clauses(void)
if (IsVarTerm(t)) if (IsVarTerm(t))
return (FALSE); return (FALSE);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
arity = 0; pred = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun); pred = RepPredProp(PredPropByFunc(fun));
arity = ArityOfFunctor(fun);
} else } else
return (FALSE); return (FALSE);
pred = RepPredProp(PredProp(at, arity));
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
if (pred->PredFlags & StandardPredFlag) { if (pred->PredFlags & StandardPredFlag) {
WRITE_UNLOCK(pred->PRWLock); WRITE_UNLOCK(pred->PRWLock);
@ -1232,8 +1228,6 @@ p_setspy(void)
{ /* '$set_spy'(+Fun) */ { /* '$set_spy'(+Fun) */
Atom at; Atom at;
PredEntry *pred; PredEntry *pred;
unsigned int arity;
Functor fun;
CELL fg; CELL fg;
Term t; Term t;
@ -1244,16 +1238,14 @@ p_setspy(void)
if (IsVarTerm(t)) if (IsVarTerm(t))
return (FALSE); return (FALSE);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
arity = 0; pred = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun); pred = RepPredProp(PredPropByFunc(fun));
arity = ArityOfFunctor(fun);
} else { } else {
return (FALSE); return (FALSE);
} }
pred = RepPredProp(PredProp(at, arity));
restart_spy: restart_spy:
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
if (pred->PredFlags & (CPredFlag | SafePredFlag)) { if (pred->PredFlags & (CPredFlag | SafePredFlag)) {
@ -1286,10 +1278,8 @@ p_setspy(void)
static Int static Int
p_rmspy(void) p_rmspy(void)
{ /* '$rm_spy'(+T) */ { /* '$rm_spy'(+T) */
unsigned int arity;
Atom at; Atom at;
PredEntry *pred; PredEntry *pred;
Functor fun;
Term t; Term t;
t = Deref(ARG1); t = Deref(ARG1);
@ -1297,14 +1287,12 @@ p_rmspy(void)
return (FALSE); return (FALSE);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
at = AtomOfTerm(t); at = AtomOfTerm(t);
arity = 0; pred = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun); pred = RepPredProp(PredPropByFunc(fun));
arity = ArityOfFunctor(fun);
} else } else
return (FALSE); return (FALSE);
pred = RepPredProp(PredProp(at, arity));
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
if (!(pred->PredFlags & SpiedPredFlag)) { if (!(pred->PredFlags & SpiedPredFlag)) {
WRITE_UNLOCK(pred->PRWLock); WRITE_UNLOCK(pred->PRWLock);
@ -1336,22 +1324,19 @@ static Int
p_number_of_clauses(void) p_number_of_clauses(void)
{ /* '$number_of_clauses'(Predicate,N) */ { /* '$number_of_clauses'(Predicate,N) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
unsigned int arity;
int ncl = 0; int ncl = 0;
Prop pe; Prop pe;
Atom a;
CODEADDR q; CODEADDR q;
int testing; int testing;
if (IsAtomTerm(t)) if (IsAtomTerm(t)) {
arity = 0, a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
else if (IsApplTerm(t)) { pe = PredProp(a, 0);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t); register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f); pe = PredPropByFunc(f);
a = NameOfFunctor(f);
} else } else
return (FALSE); return (FALSE);
pe = PredProp(a, arity);
q = RepPredProp(pe)->FirstClause; q = RepPredProp(pe)->FirstClause;
READ_LOCK(RepPredProp(pe)->PRWLock); READ_LOCK(RepPredProp(pe)->PRWLock);
if (q != NIL) { if (q != NIL) {
@ -1378,21 +1363,18 @@ static Int
p_find_dynamic(void) p_find_dynamic(void)
{ /* '$find_dynamic'(+G,+N,-C) */ { /* '$find_dynamic'(+G,+N,-C) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
int arity;
Prop pe; Prop pe;
Atom a;
CODEADDR q; CODEADDR q;
int position; int position;
if (IsAtomTerm(t)) if (IsAtomTerm(t)) {
arity = 0, a = AtomOfTerm(t); Atom a = AtomOfTerm(t);
else if (IsApplTerm(t)) { pe = PredProp(a, 0);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t); register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f); pe = PredPropByFunc(f);
a = NameOfFunctor(f);
} else } else
return (FALSE); return (FALSE);
pe = PredProp(a, arity);
q = RepPredProp(pe)->FirstClause; q = RepPredProp(pe)->FirstClause;
t = Deref(ARG2); t = Deref(ARG2);
if (IsVarTerm(t) || !IsIntTerm(t)) if (IsVarTerm(t) || !IsIntTerm(t))
@ -1433,25 +1415,21 @@ static Int
p_next_dynamic(void) p_next_dynamic(void)
{ /* '$next_dynamic'(+G,+C,-N) */ { /* '$next_dynamic'(+G,+C,-N) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
int arity;
Prop pe; Prop pe;
Atom a;
CODEADDR q, oldq; CODEADDR q, oldq;
int position; int position;
if (IsAtomTerm(t)) {
arity = 0;
a = AtomOfTerm(t);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
} else
return (FALSE);
t = Deref(ARG2); t = Deref(ARG2);
if (IsVarTerm(t) || !IsIntegerTerm(t)) if (IsVarTerm(t) || !IsIntegerTerm(t))
return (FALSE); return (FALSE);
pe = PredProp(a, arity); if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredProp(a, 0);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
pe = PredPropByFunc(f);
} else
return (FALSE);
q = RepPredProp(pe)->FirstClause; q = RepPredProp(pe)->FirstClause;
READ_LOCK(RepPredProp(pe)->PRWLock); READ_LOCK(RepPredProp(pe)->PRWLock);
if (!(RepPredProp(pe)->PredFlags & DynamicPredFlag)) if (!(RepPredProp(pe)->PredFlags & DynamicPredFlag))
@ -1473,8 +1451,6 @@ p_next_dynamic(void)
static Int static Int
p_in_use(void) p_in_use(void)
{ /* '$in_use'(+P) */ { /* '$in_use'(+P) */
Atom at;
int arity;
Term t = Deref(ARG1); Term t = Deref(ARG1);
PredEntry *pe; PredEntry *pe;
Int out; Int out;
@ -1482,15 +1458,13 @@ p_in_use(void)
if (IsVarTerm(t)) if (IsVarTerm(t))
return (FALSE); return (FALSE);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
arity = 0; pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun); pe = RepPredProp(PredPropByFunc(fun));
arity = ArityOfFunctor(fun);
} else } else
return (FALSE); return (FALSE);
pe = RepPredProp(PredProp(at, arity));
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
out = static_in_use(pe,TRUE); out = static_in_use(pe,TRUE);
READ_UNLOCK(pe->PRWLock); READ_UNLOCK(pe->PRWLock);
@ -1591,8 +1565,6 @@ p_is_logical_updatable(void)
static Int static Int
p_is_dynamic(void) p_is_dynamic(void)
{ /* '$is_dynamic'(+P) */ { /* '$is_dynamic'(+P) */
Atom at;
int arity;
PredEntry *pe; PredEntry *pe;
Term t = Deref(ARG1); Term t = Deref(ARG1);
Int out; Int out;
@ -1600,15 +1572,13 @@ p_is_dynamic(void)
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
return (FALSE); return (FALSE);
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
arity = 0; pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t); Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun); pe = RepPredProp(PredPropByFunc(fun));
arity = ArityOfFunctor(fun);
} else } else
return (FALSE); return (FALSE);
pe = RepPredProp(PredProp(at, arity));
if (pe == NIL) if (pe == NIL)
return (FALSE); return (FALSE);
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
@ -1647,8 +1617,6 @@ p_set_pred_module(void)
static Int static Int
p_undefined(void) p_undefined(void)
{ /* '$undefined'(P) */ { /* '$undefined'(P) */
Atom at;
int arity;
PredEntry *pe; PredEntry *pe;
Term t; Term t;
@ -1661,8 +1629,8 @@ p_undefined(void)
return(FALSE); return(FALSE);
} }
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
arity = 0; pe = RepPredProp(GetPredProp(at,0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor funt = FunctorOfTerm(t); Functor funt = FunctorOfTerm(t);
if (funt == FunctorModule) { if (funt == FunctorModule) {
@ -1673,13 +1641,11 @@ p_undefined(void)
goto restart_undefined; goto restart_undefined;
} }
} }
at = NameOfFunctor(funt); pe = RepPredProp(GetPredPropByFunc(funt));
arity = ArityOfFunctor(funt);
} else { } else {
*CurrentModulePtr = MkIntTerm(omod); *CurrentModulePtr = MkIntTerm(omod);
return (FALSE); return (FALSE);
} }
pe = RepPredProp(GetPredProp(at, arity));
*CurrentModulePtr = MkIntTerm(omod); *CurrentModulePtr = MkIntTerm(omod);
if (pe == RepPredProp(NIL)) if (pe == RepPredProp(NIL))
return (TRUE); return (TRUE);
@ -1704,21 +1670,18 @@ p_undefined(void)
static Int static Int
p_kill_dynamic(void) p_kill_dynamic(void)
{ /* '$kill_dynamic'(P) */ { /* '$kill_dynamic'(P) */
Atom at;
int arity;
PredEntry *pe; PredEntry *pe;
Term t; Term t;
t = Deref(ARG1); t = Deref(ARG1);
if (IsAtomTerm(t)) if (IsAtomTerm(t)) {
at = AtomOfTerm(t), arity = 0; Atom at = AtomOfTerm(t);
else if (IsApplTerm(t)) { pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
Functor funt = FunctorOfTerm(t); Functor funt = FunctorOfTerm(t);
at = NameOfFunctor(funt); pe = RepPredProp(PredPropByFunc(funt));
arity = ArityOfFunctor(funt);
} else } else
return (FALSE); return (FALSE);
pe = RepPredProp(PredProp(at, arity));
if (pe == NIL) if (pe == NIL)
return (TRUE); return (TRUE);
WRITE_LOCK(pe->PRWLock); WRITE_LOCK(pe->PRWLock);
@ -1907,23 +1870,19 @@ p_search_for_static_predicate_in_use(void)
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
return(FALSE); return(FALSE);
#else #else
Atom at;
int arity;
PredEntry *pe; PredEntry *pe;
Term t; Term t;
Int out; Int out;
t = Deref(ARG1); t = Deref(ARG1);
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
at = AtomOfTerm(t); Atom at = AtomOfTerm(t);
arity = 0; pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor funt = FunctorOfTerm(ARG1); Functor funt = FunctorOfTerm(ARG1);
at = NameOfFunctor(funt); pe = RepPredProp(PredPropByFunc(funt));
arity = ArityOfFunctor(funt);
} else } else
return(FALSE); return(FALSE);
pe = RepPredProp(PredProp(at, arity));
/* do nothing if we are in consult */ /* do nothing if we are in consult */
if (STATIC_PREDICATES_MARKED) if (STATIC_PREDICATES_MARKED)
return (pe->StateOfPred & InUseMask); return (pe->StateOfPred & InUseMask);

14
C/compiler.c
View File

@ -1095,7 +1095,7 @@ c_functor(Term Goal)
c_var(t3,f_flag,(unsigned int)_functor); c_var(t3,f_flag,(unsigned int)_functor);
} else { } else {
Functor f = FunctorOfTerm(Goal); Functor f = FunctorOfTerm(Goal);
Prop p0 = PredProp(NameOfFunctor(f), ArityOfFunctor(f)); Prop p0 = PredPropByFunc(f);
if (profiling) if (profiling)
emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero); emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
c_args(Goal); c_args(Goal);
@ -1260,7 +1260,7 @@ c_goal(Term Goal)
} }
else { else {
f = FunctorOfTerm(Goal); f = FunctorOfTerm(Goal);
p = RepPredProp(p0 = PredProp(NameOfFunctor(f), ArityOfFunctor(f))); p = RepPredProp(p0 = PredPropByFunc(f));
if (f == FunctorOr) { if (f == FunctorOr) {
CELL l = ++labelno; CELL l = ++labelno;
CELL m = ++labelno; CELL m = ++labelno;
@ -2849,18 +2849,14 @@ cclause(Term inp_clause, int NOfArgs)
ErrorMessage = "clause should be atom or term"; ErrorMessage = "clause should be atom or term";
return (0); return (0);
} else { } else {
int Arity;
Atom ap;
/* find out which predicate we are compiling for */ /* find out which predicate we are compiling for */
if (IsAtomTerm(head)) { if (IsAtomTerm(head)) {
Arity = 0; Atom ap = AtomOfTerm(head);
ap = AtomOfTerm(head); CurrentPred = RepPredProp(PredProp(ap, 0));
} else { } else {
ap = NameOfFunctor(FunctorOfTerm(head)), CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head)));
Arity = ArityOfFunctor(FunctorOfTerm(head));
} }
CurrentPred = RepPredProp(PredProp(ap, Arity));
/* insert extra instructions to count calls */ /* insert extra instructions to count calls */
READ_LOCK(CurrentPred->PRWLock); READ_LOCK(CurrentPred->PRWLock);
if ((CurrentPred->PredFlags & ProfiledPredFlag) || if ((CurrentPred->PredFlags & ProfiledPredFlag) ||

20
C/computils.c
View File

@ -70,26 +70,24 @@ AllocCMem (int size)
int int
is_a_test_pred (Term arg) is_a_test_pred (Term arg)
{ {
Atom At;
int arity;
if (IsVarTerm (arg)) if (IsVarTerm (arg))
return (FALSE); return (FALSE);
else if (IsAtomTerm (arg)) else if (IsAtomTerm (arg))
{ {
At = AtomOfTerm (arg); Atom At = AtomOfTerm (arg);
arity = 0; if (RepPredProp (PredProp (At, 0)) == NULL)
return (FALSE);
return (RepPredProp (PredProp (At, 0))->PredFlags & TestPredFlag);
} }
else if (IsApplTerm (arg)) else if (IsApplTerm (arg))
{ {
Functor f = FunctorOfTerm (arg); Functor f = FunctorOfTerm (arg);
At = NameOfFunctor (f); if (RepPredProp (PredPropByFunc (f)) == NULL)
arity = ArityOfFunctor (f); return (FALSE);
return (RepPredProp (PredPropByFunc (f))->PredFlags & TestPredFlag);
} }
else else
return (FALSE); return (FALSE);
if (RepPredProp (PredProp (At, arity)) == NULL)
return (FALSE);
return (RepPredProp (PredProp (At, arity))->PredFlags & TestPredFlag);
} }
void void
@ -301,8 +299,6 @@ ShowOp (f)
Functor f = p->FunctorOfPred; Functor f = p->FunctorOfPred;
plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0); plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0);
DebugPutc (c_output_stream,':'); DebugPutc (c_output_stream,':');
if (p->ArityOfPE == 0)
f = MkFunctor ((Atom) f, 0);
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0); plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
DebugPutc (c_output_stream,'/'); DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0); plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0);
@ -314,8 +310,6 @@ ShowOp (f)
Functor f = p->FunctorOfPred; Functor f = p->FunctorOfPred;
plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0); plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0);
DebugPutc (c_output_stream,':'); DebugPutc (c_output_stream,':');
if (p->ArityOfPE == 0)
f = MkFunctor ((Atom) f, 0);
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0); plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
DebugPutc (c_output_stream,'/'); DebugPutc (c_output_stream,'/');
plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0); plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0);

33
C/dbase.c
View File

@ -3092,8 +3092,6 @@ MyEraseClause(Clause *clau)
DBRef next, previous; DBRef next, previous;
DBProp father; DBProp father;
PredEntry *pred; PredEntry *pred;
unsigned int arity;
Atom name;
#endif #endif
SMALLUNSGN clmask; SMALLUNSGN clmask;
@ -3121,12 +3119,13 @@ MyEraseClause(Clause *clau)
previous_code->u.ld.d = next->Code; previous_code->u.ld.d = next->Code;
} else { } else {
father = ref->Parent; father = ref->Parent;
if ((arity = father->ArityOfDB) == 0) if ((arity = father->ArityOfDB) == 0) {
name = (Atom) father->FunctorOfDB; Atom name = (Atom) father->FunctorOfDB;
else pred = RepPredProp(PredProp(name, 0));
name = NameOfFunctor(father->FunctorOfDB); } else {
pred = RepPredProp(PredPropByFunc(father->FunctorOfDB));
}
DBModule = father->ModuleOfDB; DBModule = father->ModuleOfDB;
pred = RepPredProp(PredProp(name, arity));
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
if (StillInChain((CODEADDR)(clau->ClCode), pred)) { if (StillInChain((CODEADDR)(clau->ClCode), pred)) {
if (previous == NIL && next != NIL) { if (previous == NIL && next != NIL) {
@ -3294,8 +3293,6 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
goal immediately */ goal immediately */
{ {
DBProp father; DBProp father;
Int arity;
Atom name;
PredEntry *pred; PredEntry *pred;
/* first we get the next clause */ /* first we get the next clause */
CODEADDR next = code_p->u.ld.d; CODEADDR next = code_p->u.ld.d;
@ -3316,12 +3313,13 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
predicate entry that a clause left. */ predicate entry that a clause left. */
father = dbr->Parent; father = dbr->Parent;
/* inefficient, but that will do for the moment, sir. */ /* inefficient, but that will do for the moment, sir. */
if ((arity = father->ArityOfDB) == 0) if (father->ArityOfDB == 0) {
name = (Atom) father->FunctorOfDB; Atom name = (Atom) father->FunctorOfDB;
else pred = RepPredProp(PredProp(name, 0));
name = NameOfFunctor(father->FunctorOfDB); } else {
pred = RepPredProp(PredPropByFunc(father->FunctorOfDB));
}
DBModule = father->ModuleOfDB; DBModule = father->ModuleOfDB;
pred = RepPredProp(PredProp(name, arity));
WRITE_LOCK(pred->PRWLock); WRITE_LOCK(pred->PRWLock);
/* got my pred entry, let's have some fun! */ /* got my pred entry, let's have some fun! */
clau_code = (CODEADDR)(clau->ClCode); clau_code = (CODEADDR)(clau->ClCode);
@ -3329,7 +3327,12 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
#ifdef DEBUG #ifdef DEBUG
if (pred->FirstClause != clau_code) { if (pred->FirstClause != clau_code) {
/* sanity check */ /* sanity check */
Error(SYSTEM_ERROR, TermNil, "Prepare to erase clause for %s/%d",RepAtom(name)->StrOfAE,arity); if (father->ArityOfDB == 0) {
Error(SYSTEM_ERROR, TermNil, "Prepare to erase clause for %s/%d",RepAtom((Atom)father->FunctorOfDB)->StrOfAE,0);
} else {
Functor f = father->FunctorOfDB;
Error(SYSTEM_ERROR, TermNil, "Prepare to erase clause for %s/%d",RepAtom(NameOfFunctor(f))->StrOfAE,ArityOfFunctor(f));
}
return; return;
} }
#endif #endif

4
C/errors.c
View File

@ -109,8 +109,6 @@ DumpActiveGoals (void)
Functor f; Functor f;
f = pe->FunctorOfPred; f = pe->FunctorOfPred;
if (pe->KindOfPE == 0 && hidden ((Atom)f))
goto next;
if (pe->KindOfPE && hidden (NameOfFunctor (f))) if (pe->KindOfPE && hidden (NameOfFunctor (f)))
goto next; goto next;
if (first++ == 1) if (first++ == 1)
@ -168,7 +166,7 @@ DumpActiveGoals (void)
plwrite (ModuleName[pe->ModuleOfPred], DebugPutc, 0); plwrite (ModuleName[pe->ModuleOfPred], DebugPutc, 0);
DebugPutc (c_output_stream,':'); DebugPutc (c_output_stream,':');
if (pe->ArityOfPE == 0) { if (pe->ArityOfPE == 0) {
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0); plwrite (MkAtomTerm (NameOfFunctor(f)), DebugPutc, 0);
} else { } else {
Int i = 0, arity = pe->ArityOfPE; Int i = 0, arity = pe->ArityOfPE;
Term *args = &(b_ptr->cp_a1); Term *args = &(b_ptr->cp_a1);

104
C/exec.c
View File

@ -195,15 +195,14 @@ SpecialCallFunctor(Functor f) {
inline static Int inline static Int
CallMetaCall(void) { CallMetaCall(void) {
ARG2 = current_cp_as_integer(); /* p_save_cp */ ARG2 = current_cp_as_integer(); /* p_save_cp */
ARG3 = TermNil; ARG3 = ARG1;
WRITE_LOCK(PredMetaCall->PRWLock); WRITE_LOCK(PredMetaCall->PRWLock);
return (FastCallProlog(PredMetaCall)); return (FastCallProlog(PredMetaCall));
} }
inline static Int inline static Int
EnterCreepMode(PredEntry *pen) { EnterCreepMode(PredEntry *pen) {
Atom a = NameOfFunctor(FunctorSpy); PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy));
PredEntry *PredSpy = RepPredProp(PredProp(a,1));
ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1); ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1);
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
P_before_spy = P; P_before_spy = P;
@ -215,7 +214,6 @@ static Int
p_execute(void) p_execute(void)
{ /* '$execute'(Goal) */ { /* '$execute'(Goal) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
unsigned int arity;
Prop pe; Prop pe;
Atom a; Atom a;
@ -233,6 +231,7 @@ p_execute(void)
register Functor f = FunctorOfTerm(t); register Functor f = FunctorOfTerm(t);
register unsigned int i; register unsigned int i;
register CELL *pt; register CELL *pt;
unsigned int arity;
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
@ -262,9 +261,9 @@ p_execute(void)
a = NameOfFunctor(f); a = NameOfFunctor(f);
if (CurrentModule) if (CurrentModule)
pe = PredProp(a, arity); pe = PredPropByFunc(f);
else { else {
pe = GetPredProp(a, arity); pe = GetPredPropByFunc(f);
if (pe == NIL) { if (pe == NIL) {
return(CallMetaCall()); return(CallMetaCall());
} }
@ -310,13 +309,11 @@ p_execute(void)
return(TRUE); return(TRUE);
else if (a == AtomFail || a == AtomFalse) else if (a == AtomFail || a == AtomFalse)
return(FALSE); return(FALSE);
else
arity = 0;
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (CurrentModule) if (CurrentModule)
pe = PredProp(a, arity); pe = PredProp(a, 0);
else { else {
pe = GetPredProp(a, arity); pe = GetPredProp(a, 0);
if (pe == NIL) { if (pe == NIL) {
ARG1 = t; ARG1 = t;
return(CallMetaCall()); return(CallMetaCall());
@ -325,7 +322,7 @@ p_execute(void)
if (yap_flags[SPY_CREEP_FLAG]) { if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(RepPredProp(pe))); return(EnterCreepMode(RepPredProp(pe)));
} }
return (CallProlog(RepPredProp(pe), arity, (Int) (-1))); return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
} else { } else {
/* Is Pair Term */ /* Is Pair Term */
return(CallMetaCall()); return(CallMetaCall());
@ -391,9 +388,9 @@ p_execute_within(void)
a = NameOfFunctor(f); a = NameOfFunctor(f);
if (CurrentModule) if (CurrentModule)
pe = PredProp(a, arity); pe = PredPropByFunc(f);
else { else {
pe = GetPredProp(a, arity); pe = GetPredPropByFunc(f);
if (pe == NIL) { if (pe == NIL) {
return(CallMetaCallWithin()); return(CallMetaCallWithin());
} }
@ -464,13 +461,11 @@ p_execute_within(void)
return(TRUE); return(TRUE);
} else if (a == AtomFail || a == AtomFalse) } else if (a == AtomFail || a == AtomFalse)
return(FALSE); return(FALSE);
else
arity = 0;
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (CurrentModule) if (CurrentModule)
pe = PredProp(a, arity); pe = PredProp(a, 0);
else { else {
pe = GetPredProp(a, arity); pe = GetPredProp(a, 0);
if (pe == NIL) { if (pe == NIL) {
ARG1 = t; ARG1 = t;
return(CallMetaCallWithin()); return(CallMetaCallWithin());
@ -479,7 +474,7 @@ p_execute_within(void)
if (yap_flags[SPY_CREEP_FLAG]) { if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(RepPredProp(pe))); return(EnterCreepMode(RepPredProp(pe)));
} }
return (CallProlog(RepPredProp(pe), arity, (Int) (-1))); return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
} else { } else {
/* Is Pair Term */ /* Is Pair Term */
return(CallMetaCallWithin()); return(CallMetaCallWithin());
@ -493,11 +488,17 @@ p_execute0(void)
Term t = Deref(ARG1); Term t = Deref(ARG1);
unsigned int arity; unsigned int arity;
Prop pe; Prop pe;
Atom a;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
arity = 0; arity = 0;
a = AtomOfTerm(t); if (CurrentModule)
pe = PredProp(a, arity);
else {
pe = GetPredProp(a, arity);
if (pe == NIL)
return(FALSE);
}
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t); register Functor f = FunctorOfTerm(t);
register unsigned int i; register unsigned int i;
@ -506,7 +507,6 @@ p_execute0(void)
if (IsExtensionFunctor(f)) if (IsExtensionFunctor(f))
return(FALSE); return(FALSE);
arity = ArityOfFunctor(f); arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
@ -523,17 +523,17 @@ p_execute0(void)
#else #else
XREGS[i] = *pt++; XREGS[i] = *pt++;
#endif #endif
if (CurrentModule)
pe = PredPropByFunc(f);
else {
pe = GetPredPropByFunc(f);
if (pe == NIL)
return(FALSE);
}
} else } else
return (FALSE); /* for the moment */ return (FALSE); /* for the moment */
/* N = arity; */ /* N = arity; */
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (CurrentModule)
pe = PredProp(a, arity);
else {
pe = GetPredProp(a, arity);
if (pe == NIL)
return(FALSE);
}
return (CallProlog(RepPredProp(pe), arity, (Int) (-1))); return (CallProlog(RepPredProp(pe), arity, (Int) (-1)));
} }
@ -992,8 +992,6 @@ execute_goal(Term t, int nargs)
Int out; Int out;
CODEADDR CodeAdr; CODEADDR CodeAdr;
yamop *saved_p, *saved_cp; yamop *saved_p, *saved_cp;
int arity;
Atom a;
Prop pe; Prop pe;
PredEntry *ppe; PredEntry *ppe;
CELL *pt; CELL *pt;
@ -1012,9 +1010,9 @@ execute_goal(Term t, int nargs)
saved_cp = CP; saved_cp = CP;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
arity = 0; Atom a = AtomOfTerm(t);
a = AtomOfTerm(t);
pt = NULL; pt = NULL;
pe = GetPredProp(a, 0);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
@ -1022,33 +1020,38 @@ execute_goal(Term t, int nargs)
Error(TYPE_ERROR_CALLABLE,t,"call/1"); Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
pt = RepAppl(t)+1; pt = RepAppl(t)+1;
pe = GetPredPropByFunc(f);
} else { } else {
Error(TYPE_ERROR_CALLABLE,t,"call/1"); Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
pe = GetPredProp(a, arity);
ppe = RepPredProp(pe); ppe = RepPredProp(pe);
if (pe != NIL) { if (pe != NIL) {
READ_LOCK(ppe->PRWLock); READ_LOCK(ppe->PRWLock);
} }
if (pe == NIL || if (pe == NIL ||
ppe->OpcodeOfPred == UNDEF_OPCODE || ppe->OpcodeOfPred == UNDEF_OPCODE ||
ppe->PredFlags & (UserCPredFlag|CPredFlag|BasicPredFlag) ) ppe->PredFlags & (UserCPredFlag|CPredFlag|BasicPredFlag) ) {
{ if (pe != NIL) {
if (pe != NIL) { READ_UNLOCK(ppe->PRWLock);
READ_UNLOCK(ppe->PRWLock);
}
return(CallMetaCall());
} }
CodeAdr = RepPredProp (PredProp (a, arity))->CodeOfPred; return(CallMetaCall());
READ_UNLOCK(ppe->PRWLock); }
out = do_goal(CodeAdr, arity, pt, nargs, FALSE); if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
CodeAdr = RepPredProp (PredProp (at, 0))->CodeOfPred;
READ_UNLOCK(ppe->PRWLock);
out = do_goal(CodeAdr, 0, pt, nargs, FALSE);
} else {
Functor f = FunctorOfTerm(t);
CodeAdr = RepPredProp (PredPropByFunc (f))->CodeOfPred;
READ_UNLOCK(ppe->PRWLock);
out = do_goal(CodeAdr, ArityOfFunctor(f), pt, nargs, FALSE);
}
if (out == 1) { if (out == 1) {
choiceptr old_B; choiceptr old_B;
@ -1161,16 +1164,16 @@ int
RunTopGoal(Term t) RunTopGoal(Term t)
{ {
CODEADDR CodeAdr; CODEADDR CodeAdr;
int arity;
Atom a;
Prop pe; Prop pe;
PredEntry *ppe; PredEntry *ppe;
CELL *pt; CELL *pt;
UInt arity;
if (IsAtomTerm(t)) { if (IsAtomTerm(t)) {
arity = 0; Atom a = AtomOfTerm(t);
a = AtomOfTerm(t);
pt = NULL; pt = NULL;
pe = GetPredProp(a, 0);
arity = 0;
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
@ -1178,17 +1181,16 @@ RunTopGoal(Term t)
Error(TYPE_ERROR_CALLABLE,t,"call/1"); Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
might skip a svar */ might skip a svar */
pe = GetPredPropByFunc(f);
pt = RepAppl(t)+1; pt = RepAppl(t)+1;
arity = ArityOfFunctor(f);
} else { } else {
Error(TYPE_ERROR_CALLABLE,t,"call/1"); Error(TYPE_ERROR_CALLABLE,t,"call/1");
return(FALSE); return(FALSE);
} }
pe = GetPredProp(a, arity);
ppe = RepPredProp(pe); ppe = RepPredProp(pe);
if (pe != NIL) { if (pe != NIL) {
READ_LOCK(ppe->PRWLock); READ_LOCK(ppe->PRWLock);

8
C/heapgc.c
View File

@ -1316,10 +1316,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
/* first condition checks if this was a meta-call */ /* first condition checks if this was a meta-call */
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) { if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
YP_fprintf(YP_stderr,"B %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked); YP_fprintf(YP_stderr,"B %p (%s) with %d,%d\n", gc_B, op_names[opnum], gc_B->cp_h-H0, total_marked);
} else if (pe->ArityOfPE) } else
YP_fprintf(YP_stderr,"B %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked); YP_fprintf(YP_stderr,"B %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
else
YP_fprintf(YP_stderr,"B %p (%s for %s/0) with %d,%d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, gc_B->cp_h-H0, total_marked);
} }
break; break;
#endif #endif
@ -1328,10 +1326,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p; PredEntry *pe = (PredEntry *)gc_B->cp_ap->u.ld.p;
if (pe == NULL) { if (pe == NULL) {
YP_fprintf(YP_stderr,"B %p (%s) with %d\n", gc_B, op_names[opnum], total_marked); YP_fprintf(YP_stderr,"B %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
} else if (pe->ArityOfPE) } else
YP_fprintf(YP_stderr,"B %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked); YP_fprintf(YP_stderr,"B %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
else
YP_fprintf(YP_stderr,"B %p (%s for %s/0) with %d,%d\n", gc_B, op_names[opnum], RepAtom((Atom)(pe->FunctorOfPred))->StrOfAE, gc_B->cp_h-H0, total_marked);
} }
} }
#endif /* CHECK_CHOICEPOINTS */ #endif /* CHECK_CHOICEPOINTS */

5
C/save.c
View File

@ -2408,10 +2408,7 @@ CleanCode(PredEntry *pp)
CODEADDR FirstC, LastC; CODEADDR FirstC, LastC;
/* Init takes care of the first 2 cases */ /* Init takes care of the first 2 cases */
if (pp->ArityOfPE) pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
else
pp->FunctorOfPred = (Functor) AtomAdjust((Atom)(pp->FunctorOfPred));
if (pp->OwnerFile) if (pp->OwnerFile)
pp->OwnerFile = AtomAdjust(pp->OwnerFile); pp->OwnerFile = AtomAdjust(pp->OwnerFile);
pp->OpcodeOfPred = opcode(op_from_opcode(pp->OpcodeOfPred)); pp->OpcodeOfPred = opcode(op_from_opcode(pp->OpcodeOfPred));

158
C/stdpreds.c
View File

@ -62,14 +62,11 @@ STD_PROTO(static Int p_halt, (void));
STD_PROTO(static Int p_halt0, (void)); STD_PROTO(static Int p_halt0, (void));
STD_PROTO(static Int init_current_atom, (void)); STD_PROTO(static Int init_current_atom, (void));
STD_PROTO(static Int cont_current_atom, (void)); STD_PROTO(static Int cont_current_atom, (void));
STD_PROTO(static PredEntry *NextPred, (PropEntry *)); STD_PROTO(static Int init_current_predicate, (void));
STD_PROTO(static Int init_current_pre, (void)); STD_PROTO(static Int cont_current_predicate, (void));
STD_PROTO(static Int cont_current_pre, (void));
STD_PROTO(static OpEntry *NextOp, (OpEntry *)); STD_PROTO(static OpEntry *NextOp, (OpEntry *));
STD_PROTO(static Int init_current_op, (void)); STD_PROTO(static Int init_current_op, (void));
STD_PROTO(static Int cont_current_op, (void)); STD_PROTO(static Int cont_current_op, (void));
STD_PROTO(static Int init_pred_for, (void));
STD_PROTO(static Int cont_pred_for, (void));
#ifdef DEBUG #ifdef DEBUG
STD_PROTO(static Int p_debug, (void)); STD_PROTO(static Int p_debug, (void));
#endif #endif
@ -1362,142 +1359,27 @@ init_current_atom(void)
return (cont_current_atom()); return (cont_current_atom());
} }
#define NotVisibleEntry(pp) (pp->ModuleOfPred && pp->ModuleOfPred!=CurrentModule) static Int
cont_current_predicate(void)
static PredEntry *
NextPred(PropEntry *pp)
{ {
while (!EndOfPAEntr(pp) && PredEntry *pp = (PredEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(2,1));
((pp->KindOfPE & 0x8000) || NotVisibleEntry(((PredEntry *) pp)))) UInt Arity;
pp = RepProp(pp->NextOfPE); Atom name;
return ((PredEntry *)pp);
if (pp == NULL)
cut_fail();
EXTRA_CBACK_ARG(2,1) = (CELL)MkIntegerTerm((Int)(pp->NextPredOfModule));
Arity = pp->ArityOfPE;
name = NameOfFunctor(pp->FunctorOfPred);
return (unify(ARG1,MkAtomTerm(name)) &&
unify(ARG2, MkIntegerTerm(Arity)));
} }
static Int static Int
cont_pred_for(void) init_current_predicate(void)
{ {
unsigned int arity; EXTRA_CBACK_ARG(2,1) = (CELL)MkIntegerTerm((Int)ModulePred[CurrentModule]);
Term out_term, p[MaxArity]; return (cont_current_predicate());
Atom a = AtomOfTerm(EXTRA_CBACK_ARG(2,1));
PredEntry *pp = (PredEntry *) EXTRA_CBACK_ARG(2,2);
if (EndOfPAEntr(pp))
cut_fail();
EXTRA_CBACK_ARG(2,2) = (CELL)NextPred(RepProp(pp->NextOfPE));
arity = pp->ArityOfPE;
if (arity == 0)
out_term = MkAtomTerm(a);
else {
unsigned int j;
for (j = 0; j < arity; j++)
p[j] = MkVarTerm();
out_term = MkApplTerm(MkFunctor(a, arity), arity, p);
}
return (unify(ARG2, out_term));
}
static Int
init_pred_for(void)
{ /* '$pred_defined_for(+Atom,,?Predicate) */
PredEntry *pp;
Atom a;
Term t1 = Deref(ARG1);
AtomEntry *ae;
if (!IsVarTerm(t1) && IsAtomTerm(t1))
a = AtomOfTerm(t1);
else
cut_fail();
ae = RepAtom(a);
READ_LOCK(ae->ARWLock);
pp = NextPred(RepProp(ae->PropOfAE));
READ_UNLOCK(ae->ARWLock);
EXTRA_CBACK_ARG(2,1) = (CELL) t1;
EXTRA_CBACK_ARG(2,2) = (CELL) pp;
return (cont_pred_for());
}
static Int
cont_current_pre(void)
{
unsigned int arity;
Term out_term, p[MaxArity];
Atom a = AtomOfTerm(EXTRA_CBACK_ARG(2,3));
Int i = IntOfTerm(EXTRA_CBACK_ARG(2,2));
Term first = Deref(ARG1);
PredEntry *pp = (PredEntry *)EXTRA_CBACK_ARG(2,1);
if (EndOfPAEntr(pp) && IsAtomTerm(first))
cut_fail();
while (EndOfPAEntr(pp)) {
AtomEntry *ae = RepAtom(a);
READ_LOCK(ae->ARWLock);
a = ae->NextOfAE;
READ_UNLOCK(ae->ARWLock);
if (a == NIL) {
i++;
while (TRUE) {
READ_LOCK(HashChain[i].AERWLock);
a = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
if (a != NIL) {
break;
}
i++;
}
if (i == MaxHash)
cut_fail();
EXTRA_CBACK_ARG(2,2) = (CELL) MkIntTerm(i);
}
READ_LOCK(RepAtom(a)->ARWLock);
if (!EndOfPAEntr(pp = NextPred(RepProp(RepAtom(a)->PropOfAE)))) {
EXTRA_CBACK_ARG(2,3) = (CELL) MkAtomTerm(a);
}
READ_UNLOCK(RepAtom(a)->ARWLock);
}
EXTRA_CBACK_ARG(2,1) = (CELL)NextPred(RepProp(pp->NextOfPE));
if ((arity = pp->ArityOfPE) == 0)
out_term = MkAtomTerm(a);
else {
unsigned int j;
for (j = 0; j < arity; j++)
p[j] = MkVarTerm();
out_term = MkApplTerm(MkFunctor(a, arity), arity, p);
}
return (unify_constant(ARG1, MkAtomTerm(a)) && unify(ARG2, out_term));
}
static Int
init_current_pre(void)
{ /* current_predicate(+Atom,?Predicate) */
Int i = 0;
PredEntry *pp;
Atom a;
Term t1 = Deref(ARG1);
if (!IsVarTerm(t1)) {
if (IsAtomTerm(t1))
a = AtomOfTerm(t1);
else
cut_fail();
} else {
while (TRUE) {
READ_LOCK(HashChain[i].AERWLock);
a = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
if (a != NIL) {
break;
}
i++;
}
}
READ_LOCK(RepAtom(a)->ARWLock);
pp = NextPred(RepProp(RepAtom(a)->PropOfAE));
READ_UNLOCK(RepAtom(a)->ARWLock);
EXTRA_CBACK_ARG(2,3) = (CELL) MkAtomTerm(a);
EXTRA_CBACK_ARG(2,2) = (CELL) MkIntTerm(i);
EXTRA_CBACK_ARG(2,1) = (CELL)pp;
return (cont_current_pre());
} }
static OpEntry * static OpEntry *
@ -2192,9 +2074,7 @@ InitBackCPreds(void)
{ {
InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom, InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom,
SafePredFlag|SyncPredFlag); SafePredFlag|SyncPredFlag);
InitCPredBack("$pred_defined_for", 2, 2, init_pred_for, cont_pred_for, InitCPredBack("$current_predicate", 2, 1, init_current_predicate, cont_current_predicate,
SafePredFlag|SyncPredFlag);
InitCPredBack("$current_predicate", 2, 3, init_current_pre, cont_current_pre,
SafePredFlag|SyncPredFlag); SafePredFlag|SyncPredFlag);
InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op, InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
SafePredFlag|SyncPredFlag); SafePredFlag|SyncPredFlag);

24
C/tracer.c
View File

@ -145,11 +145,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
case enter_pred: case enter_pred:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) { s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$')) /* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */ return; */
send_tracer_message("CALL: ", s, arity, mname, args); send_tracer_message("CALL: ", s, arity, mname, args);
@ -169,11 +165,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
} else { } else {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) { s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$')) /* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */ return; */
send_tracer_message("RETRY PRODUCER: ", s, 0, mname, NULL); send_tracer_message("RETRY PRODUCER: ", s, 0, mname, NULL);
@ -187,11 +179,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
} else { } else {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) { s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$')) /* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */ return; */
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL); send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
@ -200,11 +188,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
case retry_pred: case retry_pred:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) { s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$')) /* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */ return; */
send_tracer_message("FAIL ", NULL, 0, NULL, args); send_tracer_message("FAIL ", NULL, 0, NULL, args);

4
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.8 2001-08-08 21:17:27 vsc Exp $ * * version: $Id: Heap.h,v 1.9 2001-10-03 13:39:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -135,6 +135,7 @@ typedef struct various_codes {
UInt number_of_cpreds; UInt number_of_cpreds;
UInt number_of_cmpfuncs; UInt number_of_cmpfuncs;
Term module_name[MaxModules]; Term module_name[MaxModules];
struct pred_entry *module_pred[MaxModules];
SMALLUNSGN no_of_modules; SMALLUNSGN no_of_modules;
struct clause_struct *dead_clauses; struct clause_struct *dead_clauses;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -326,6 +327,7 @@ typedef struct various_codes {
#define NUMBER_OF_CPREDS heap_regs->number_of_cpreds #define NUMBER_OF_CPREDS heap_regs->number_of_cpreds
#define NUMBER_OF_CMPFUNCS heap_regs->number_of_cmpfuncs #define NUMBER_OF_CMPFUNCS heap_regs->number_of_cmpfuncs
#define ModuleName heap_regs->module_name #define ModuleName heap_regs->module_name
#define ModulePred heap_regs->module_pred
#define PrimitivesModule heap_regs->primitives_module #define PrimitivesModule heap_regs->primitives_module
#define UserModule heap_regs->user_module #define UserModule heap_regs->user_module
#define DBQueues heap_regs->db_queues #define DBQueues heap_regs->db_queues

3
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.2 2001-06-22 17:53:36 vsc Exp $ * * version: $Id: Yapproto.h,v 1.3 2001-10-03 13:39:14 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -52,6 +52,7 @@ CELL STD_PROTO(*ArgsOfSFTerm,(Term));
int STD_PROTO(LookupModule,(Term)); int STD_PROTO(LookupModule,(Term));
Prop STD_PROTO(GetPredProp,(Atom,unsigned int)); Prop STD_PROTO(GetPredProp,(Atom,unsigned int));
Prop STD_PROTO(GetPredPropByFunc,(Functor));
Prop STD_PROTO(LockedGetPredProp,(Atom,unsigned int)); Prop STD_PROTO(LockedGetPredProp,(Atom,unsigned int));
Prop STD_PROTO(GetExpProp,(Atom,unsigned int)); Prop STD_PROTO(GetExpProp,(Atom,unsigned int));
Prop STD_PROTO(LockedGetExpProp,(AtomEntry *,unsigned int)); Prop STD_PROTO(LockedGetExpProp,(AtomEntry *,unsigned int));

3
changes4.3.html
View File

@ -16,6 +16,9 @@
<h2>Yap-4.3.20:</h2> <h2>Yap-4.3.20:</h2>
<ul> <ul>
<li>SPEEDUP: improve predicate access by linking predicates to
functors.</li>
<li>FIXED: listing broke when current_predicate became meta.</li>
<li>FIXED: consult should not erase dynamic clauses (report <li>FIXED: consult should not erase dynamic clauses (report
from James Cussens).</li> from James Cussens).</li>
<li>FIXED: check if we still can do garbage collection (MBIT <li>FIXED: check if we still can do garbage collection (MBIT

3
m4/Atoms.h.m4
View File

@ -96,6 +96,9 @@ typedef struct FunctorEntryStruct {
unsigned int ArityOfFE; /* arity of functor */ unsigned int ArityOfFE; /* arity of functor */
Atom NameOfFE; /* back pointer to owner atom */ Atom NameOfFE; /* back pointer to owner atom */
Prop PropsOfFE; /* pointer to list of properties for this functor */ Prop PropsOfFE; /* pointer to list of properties for this functor */
#if defined(YAPOR) || defined(THREADS)
rwlock_t FRWLock;
#endif
} FunctorEntry; } FunctorEntry;
typedef FunctorEntry *Functor; typedef FunctorEntry *Functor;

36
m4/Yatom.h.m4
View File

@ -199,27 +199,28 @@ typedef struct {
was retried */ was retried */
} profile_data; } profile_data;
typedef struct { typedef struct pred_entry {
Prop NextOfPE; /* used to chain properties */ Prop NextOfPE; /* used to chain properties */
PropFlags KindOfPE; /* kind of property */ PropFlags KindOfPE; /* kind of property */
unsigned int ArityOfPE; /* arity of property */ unsigned int ArityOfPE; /* arity of property */
SMALLUNSGN StateOfPred; /* actual state of predicate */ SMALLUNSGN StateOfPred; /* actual state of predicate */
CODEADDR CodeOfPred; /* code address */ CODEADDR CodeOfPred; /* code address */
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */ CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
Functor FunctorOfPred; /* functor for Predicate */ Functor FunctorOfPred; /* functor for Predicate */
CODEADDR FirstClause, LastClause; CODEADDR FirstClause, LastClause;
CELL PredFlags; CELL PredFlags;
Atom OwnerFile; /* File where the predicate was defined */ Atom OwnerFile; /* File where the predicate was defined */
struct pred_entry *NextPredOfModule; /* next pred for same module */
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
rwlock_t PRWLock; /* a simple lock to protect this entry */ rwlock_t PRWLock; /* a simple lock to protect this entry */
#endif #endif
#ifdef TABLING #ifdef TABLING
tab_ent_ptr TableOfPred; tab_ent_ptr TableOfPred;
#endif /* TABLING */ #endif /* TABLING */
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */ OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
profile_data StatisticsForPred; /* enable profiling for predicate */ profile_data StatisticsForPred; /* enable profiling for predicate */
SMALLUNSGN ModuleOfPred; /* module for this definition */ SMALLUNSGN ModuleOfPred; /* module for this definition */
} PredEntry; } PredEntry;
#define PEProp ((PropFlags)(0x0000)) #define PEProp ((PropFlags)(0x0000))
#if USE_OFFSETS_IN_PROPS #if USE_OFFSETS_IN_PROPS
@ -569,6 +570,7 @@ Atom a; Term v;
Prop STD_PROTO(GetAProp,(Atom,PropFlags)); Prop STD_PROTO(GetAProp,(Atom,PropFlags));
Prop STD_PROTO(LockedGetAProp,(AtomEntry *,PropFlags)); Prop STD_PROTO(LockedGetAProp,(AtomEntry *,PropFlags));
Prop STD_PROTO(PredProp,(Atom,unsigned int)); Prop STD_PROTO(PredProp,(Atom,unsigned int));
Prop STD_PROTO(PredPropByFunc,(Functor));
#endif /* ADTDEFS_C */ #endif /* ADTDEFS_C */

11
pl/listing.yap
View File

@ -20,25 +20,28 @@
*/ */
listing :- listing :-
current_predicate(_,Pred), '$current_predicate_no_modules'(_,Pred),
'$list_clauses'(Pred). '$list_clauses'(Pred).
listing. listing.
listing(V) :- var(V), !. % ignore variables listing(V) :- var(V), !. % ignore variables
listing(M:V) :- !, listing(M:V) :- !,
'$mod_switch'(M,listing(V)). '$mod_switch'(M,'$listing'(V)).
listing([]) :- !. listing([]) :- !.
listing([X|Rest]) :- listing([X|Rest]) :-
!, !,
listing(X), listing(X),
listing(Rest). listing(Rest).
listing(X) :- listing(X) :-
'$listing'(X).
'$listing'(X) :-
'$funcspec'(X,Name,Arity), '$funcspec'(X,Name,Arity),
current_predicate(Name,Pred), '$current_predicate_no_modules'(Name,Pred),
functor(Pred,Name,Arity), functor(Pred,Name,Arity),
'$list_clauses'(Pred). '$list_clauses'(Pred).
listing(_). '$listing'(_).
'$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name). '$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name).
'$funcspec'(Name,Name,_) :- atom(Name), !. '$funcspec'(Name,Name,_) :- atom(Name), !.

75
pl/utils.yap
View File

@ -341,44 +341,45 @@ current_atom(A) :- % check
current_atom(A) :- % generate current_atom(A) :- % generate
'$current_atom'(A). '$current_atom'(A).
current_predicate(A,T) :-
var(T), !,
'$current_predicate2'(A,T).
current_predicate(A,M:T) :- % module specified
atom(M), !,
( '$current_module'(M) ->
current_predicate(A,T)
;
'$mod_switch'(M,current_predicate(A,T))
).
current_predicate(A,M:T) :- % module specified current_predicate(A,M:T) :- % module specified
var(M), !, var(M), !,
current_module(M), current_module(M),
'$current_predicate2'(A,T). M \= prolog,
current_predicate(A,T) :- '$mod_switch'(M,'$current_predicate_no_modules'(A,T)).
'$current_predicate'(A,T). current_predicate(A,M:T) :- % module specified
!,
'$mod_switch'(M,'$current_predicate_no_modules'(A,T)).
current_predicate(A,T) :- % only for the predicate
'$current_predicate_no_modules'(A,T).
'$current_predicate2'(A,T) :- % only for the predicate current_predicate(M:F) :- % module specified
atom(A), !, '$pred_defined_for'(A,T), var(M), !,
'$pred_exists'(T). current_module(M),
'$current_predicate2'(A,T) :- % generate them all M \= prolog,
'$current_predicate'(A,T), '$mod_switch'(M,'$current_predicate3'(F)).
current_predicate(M:F) :- % module specified
!,
'$mod_switch'(M,'$current_predicate3'(F)).
current_predicate(F) :- % only for the predicate
'$current_predicate3'(F).
system_predicate(P) :-
'$mod_switch'(prolog,'$current_predicate_no_modules'(A,T)),
\+ '$hidden'(A).
system_predicate(A,P) :-
'$mod_switch'(prolog,'$current_predicate_no_modules'(A,T)),
\+ '$hidden'(A).
'$current_predicate_no_modules'(A,T) :-
'$current_predicate'(A,Arity),
functor(T,A,Arity),
'$pred_exists'(T). '$pred_exists'(T).
'$system_predicate'(Pred) :- '$current_predicate3'(A/Arity) :-
'$flags'(Pred,Flags,_), '$current_predicate'(A,Arity),
Flags /\ 8'40000 =\= 0. functor(T,A,Arity),
'$pred_exists'(T).
system_predicate(P) :- '$system_predicate'(P).
system_predicate(A,P) :- % check
nonvar(P), !,
'$system_predicate'(P),
functor(P,A,_).
system_predicate(A,P) :- % generate
'$current_predicate2'(A,P),
'$system_predicate'(P).
%%% User interface for statistics %%% User interface for statistics
@ -421,7 +422,6 @@ statistics :-
format(user_error,":~t ~d in use~19+", [TrlInUse]), format(user_error,":~t ~d in use~19+", [TrlInUse]),
TrlFree is TrlSpa-TrlInUse, TrlFree is TrlSpa-TrlInUse,
format(user_error,",~t ~d free~19+~n", [TrlFree]), format(user_error,",~t ~d free~19+~n", [TrlFree]),
OvfTime is TotHOTime+TotSOTime+TotTOTime, OvfTime is TotHOTime+TotSOTime+TotTOTime,
format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n", format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
[OvfTime,NOfHO,NOfSO,NOfTO]), [OvfTime,NOfHO,NOfSO,NOfTO]),
@ -599,9 +599,12 @@ grow_stack(X) :- $grow_stack(X).
% environment to return to. % environment to return to.
% %
%garbage_collect :- save(dump), '$gc', save(dump2). %garbage_collect :- save(dump), '$gc', save(dump2).
garbage_collect :- '$gc'. garbage_collect :-
gc :- yap_flag(gc,on). '$gc'.
nogc :- yap_flag(gc,off). gc :-
yap_flag(gc,on).
nogc :-
yap_flag(gc,off).
'$force_environment_for_gc'. '$force_environment_for_gc'.