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 

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

131
C/cdmgr.c
View File

@ -1171,9 +1171,7 @@ p_endconsult(void)
static Int
p_purge_clauses(void)
{ /* '$purge_clauses'(+Func) */
Atom at;
PredEntry *pred;
unsigned int arity;
Term t = Deref(ARG1);
CODEADDR q, q1;
@ -1181,15 +1179,13 @@ p_purge_clauses(void)
if (IsVarTerm(t))
return (FALSE);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
Atom at = AtomOfTerm(t);
pred = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun);
arity = ArityOfFunctor(fun);
pred = RepPredProp(PredPropByFunc(fun));
} else
return (FALSE);
pred = RepPredProp(PredProp(at, arity));
WRITE_LOCK(pred->PRWLock);
if (pred->PredFlags & StandardPredFlag) {
WRITE_UNLOCK(pred->PRWLock);
@ -1232,8 +1228,6 @@ p_setspy(void)
{ /* '$set_spy'(+Fun) */
Atom at;
PredEntry *pred;
unsigned int arity;
Functor fun;
CELL fg;
Term t;
@ -1244,16 +1238,14 @@ p_setspy(void)
if (IsVarTerm(t))
return (FALSE);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
Atom at = AtomOfTerm(t);
pred = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
fun = FunctorOfTerm(t);
at = NameOfFunctor(fun);
arity = ArityOfFunctor(fun);
Functor fun = FunctorOfTerm(t);
pred = RepPredProp(PredPropByFunc(fun));
} else {
return (FALSE);
}
pred = RepPredProp(PredProp(at, arity));
restart_spy:
WRITE_LOCK(pred->PRWLock);
if (pred->PredFlags & (CPredFlag | SafePredFlag)) {
@ -1286,10 +1278,8 @@ p_setspy(void)
static Int
p_rmspy(void)
{ /* '$rm_spy'(+T) */
unsigned int arity;
Atom at;
PredEntry *pred;
Functor fun;
Term t;
t = Deref(ARG1);
@ -1297,14 +1287,12 @@ p_rmspy(void)
return (FALSE);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
pred = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
fun = FunctorOfTerm(t);
at = NameOfFunctor(fun);
arity = ArityOfFunctor(fun);
Functor fun = FunctorOfTerm(t);
pred = RepPredProp(PredPropByFunc(fun));
} else
return (FALSE);
pred = RepPredProp(PredProp(at, arity));
WRITE_LOCK(pred->PRWLock);
if (!(pred->PredFlags & SpiedPredFlag)) {
WRITE_UNLOCK(pred->PRWLock);
@ -1336,22 +1324,19 @@ static Int
p_number_of_clauses(void)
{ /* '$number_of_clauses'(Predicate,N) */
Term t = Deref(ARG1);
unsigned int arity;
int ncl = 0;
Prop pe;
Atom a;
CODEADDR q;
int testing;
if (IsAtomTerm(t))
arity = 0, a = AtomOfTerm(t);
else if (IsApplTerm(t)) {
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredProp(a, 0);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(f);
} else
return (FALSE);
pe = PredProp(a, arity);
q = RepPredProp(pe)->FirstClause;
READ_LOCK(RepPredProp(pe)->PRWLock);
if (q != NIL) {
@ -1378,21 +1363,18 @@ static Int
p_find_dynamic(void)
{ /* '$find_dynamic'(+G,+N,-C) */
Term t = Deref(ARG1);
int arity;
Prop pe;
Atom a;
CODEADDR q;
int position;
if (IsAtomTerm(t))
arity = 0, a = AtomOfTerm(t);
else if (IsApplTerm(t)) {
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredProp(a, 0);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
pe = PredPropByFunc(f);
} else
return (FALSE);
pe = PredProp(a, arity);
q = RepPredProp(pe)->FirstClause;
t = Deref(ARG2);
if (IsVarTerm(t) || !IsIntTerm(t))
@ -1433,25 +1415,21 @@ static Int
p_next_dynamic(void)
{ /* '$next_dynamic'(+G,+C,-N) */
Term t = Deref(ARG1);
int arity;
Prop pe;
Atom a;
CODEADDR q, oldq;
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);
if (IsVarTerm(t) || !IsIntegerTerm(t))
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;
READ_LOCK(RepPredProp(pe)->PRWLock);
if (!(RepPredProp(pe)->PredFlags & DynamicPredFlag))
@ -1473,8 +1451,6 @@ p_next_dynamic(void)
static Int
p_in_use(void)
{ /* '$in_use'(+P) */
Atom at;
int arity;
Term t = Deref(ARG1);
PredEntry *pe;
Int out;
@ -1482,15 +1458,13 @@ p_in_use(void)
if (IsVarTerm(t))
return (FALSE);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun);
arity = ArityOfFunctor(fun);
pe = RepPredProp(PredPropByFunc(fun));
} else
return (FALSE);
pe = RepPredProp(PredProp(at, arity));
READ_LOCK(pe->PRWLock);
out = static_in_use(pe,TRUE);
READ_UNLOCK(pe->PRWLock);
@ -1591,8 +1565,6 @@ p_is_logical_updatable(void)
static Int
p_is_dynamic(void)
{ /* '$is_dynamic'(+P) */
Atom at;
int arity;
PredEntry *pe;
Term t = Deref(ARG1);
Int out;
@ -1600,15 +1572,13 @@ p_is_dynamic(void)
if (IsVarTerm(t)) {
return (FALSE);
} else if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
at = NameOfFunctor(fun);
arity = ArityOfFunctor(fun);
pe = RepPredProp(PredPropByFunc(fun));
} else
return (FALSE);
pe = RepPredProp(PredProp(at, arity));
if (pe == NIL)
return (FALSE);
READ_LOCK(pe->PRWLock);
@ -1647,8 +1617,6 @@ p_set_pred_module(void)
static Int
p_undefined(void)
{ /* '$undefined'(P) */
Atom at;
int arity;
PredEntry *pe;
Term t;
@ -1661,8 +1629,8 @@ p_undefined(void)
return(FALSE);
}
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
Atom at = AtomOfTerm(t);
pe = RepPredProp(GetPredProp(at,0));
} else if (IsApplTerm(t)) {
Functor funt = FunctorOfTerm(t);
if (funt == FunctorModule) {
@ -1673,13 +1641,11 @@ p_undefined(void)
goto restart_undefined;
}
}
at = NameOfFunctor(funt);
arity = ArityOfFunctor(funt);
pe = RepPredProp(GetPredPropByFunc(funt));
} else {
*CurrentModulePtr = MkIntTerm(omod);
return (FALSE);
}
pe = RepPredProp(GetPredProp(at, arity));
*CurrentModulePtr = MkIntTerm(omod);
if (pe == RepPredProp(NIL))
return (TRUE);
@ -1704,21 +1670,18 @@ p_undefined(void)
static Int
p_kill_dynamic(void)
{ /* '$kill_dynamic'(P) */
Atom at;
int arity;
PredEntry *pe;
Term t;
t = Deref(ARG1);
if (IsAtomTerm(t))
at = AtomOfTerm(t), arity = 0;
else if (IsApplTerm(t)) {
if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
Functor funt = FunctorOfTerm(t);
at = NameOfFunctor(funt);
arity = ArityOfFunctor(funt);
pe = RepPredProp(PredPropByFunc(funt));
} else
return (FALSE);
pe = RepPredProp(PredProp(at, arity));
if (pe == NIL)
return (TRUE);
WRITE_LOCK(pe->PRWLock);
@ -1907,23 +1870,19 @@ p_search_for_static_predicate_in_use(void)
#if defined(YAPOR) || defined(THREADS)
return(FALSE);
#else
Atom at;
int arity;
PredEntry *pe;
Term t;
Int out;
t = Deref(ARG1);
if (IsAtomTerm(t)) {
at = AtomOfTerm(t);
arity = 0;
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredProp(at, 0));
} else if (IsApplTerm(t)) {
Functor funt = FunctorOfTerm(ARG1);
at = NameOfFunctor(funt);
arity = ArityOfFunctor(funt);
pe = RepPredProp(PredPropByFunc(funt));
} else
return(FALSE);
pe = RepPredProp(PredProp(at, arity));
/* do nothing if we are in consult */
if (STATIC_PREDICATES_MARKED)
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);
} else {
Functor f = FunctorOfTerm(Goal);
Prop p0 = PredProp(NameOfFunctor(f), ArityOfFunctor(f));
Prop p0 = PredPropByFunc(f);
if (profiling)
emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
c_args(Goal);
@ -1260,7 +1260,7 @@ c_goal(Term Goal)
}
else {
f = FunctorOfTerm(Goal);
p = RepPredProp(p0 = PredProp(NameOfFunctor(f), ArityOfFunctor(f)));
p = RepPredProp(p0 = PredPropByFunc(f));
if (f == FunctorOr) {
CELL l = ++labelno;
CELL m = ++labelno;
@ -2849,18 +2849,14 @@ cclause(Term inp_clause, int NOfArgs)
ErrorMessage = "clause should be atom or term";
return (0);
} else {
int Arity;
Atom ap;
/* find out which predicate we are compiling for */
if (IsAtomTerm(head)) {
Arity = 0;
ap = AtomOfTerm(head);
Atom ap = AtomOfTerm(head);
CurrentPred = RepPredProp(PredProp(ap, 0));
} else {
ap = NameOfFunctor(FunctorOfTerm(head)),
Arity = ArityOfFunctor(FunctorOfTerm(head));
CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head)));
}
CurrentPred = RepPredProp(PredProp(ap, Arity));
/* insert extra instructions to count calls */
READ_LOCK(CurrentPred->PRWLock);
if ((CurrentPred->PredFlags & ProfiledPredFlag) ||

20
C/computils.c
View File

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

33
C/dbase.c
View File

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

4
C/errors.c
View File

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

104
C/exec.c
View File

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

5
C/save.c
View File

@ -2408,10 +2408,7 @@ CleanCode(PredEntry *pp)
CODEADDR FirstC, LastC;
/* Init takes care of the first 2 cases */
if (pp->ArityOfPE)
pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
else
pp->FunctorOfPred = (Functor) AtomAdjust((Atom)(pp->FunctorOfPred));
pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
if (pp->OwnerFile)
pp->OwnerFile = AtomAdjust(pp->OwnerFile);
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 init_current_atom, (void));
STD_PROTO(static Int cont_current_atom, (void));
STD_PROTO(static PredEntry *NextPred, (PropEntry *));
STD_PROTO(static Int init_current_pre, (void));
STD_PROTO(static Int cont_current_pre, (void));
STD_PROTO(static Int init_current_predicate, (void));
STD_PROTO(static Int cont_current_predicate, (void));
STD_PROTO(static OpEntry *NextOp, (OpEntry *));
STD_PROTO(static Int init_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
STD_PROTO(static Int p_debug, (void));
#endif
@ -1362,142 +1359,27 @@ init_current_atom(void)
return (cont_current_atom());
}
#define NotVisibleEntry(pp) (pp->ModuleOfPred && pp->ModuleOfPred!=CurrentModule)
static PredEntry *
NextPred(PropEntry *pp)
static Int
cont_current_predicate(void)
{
while (!EndOfPAEntr(pp) &&
((pp->KindOfPE & 0x8000) || NotVisibleEntry(((PredEntry *) pp))))
pp = RepProp(pp->NextOfPE);
return ((PredEntry *)pp);
PredEntry *pp = (PredEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(2,1));
UInt Arity;
Atom name;
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
cont_pred_for(void)
init_current_predicate(void)
{
unsigned int arity;
Term out_term, p[MaxArity];
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());
EXTRA_CBACK_ARG(2,1) = (CELL)MkIntegerTerm((Int)ModulePred[CurrentModule]);
return (cont_current_predicate());
}
static OpEntry *
@ -2192,9 +2074,7 @@ InitBackCPreds(void)
{
InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom,
SafePredFlag|SyncPredFlag);
InitCPredBack("$pred_defined_for", 2, 2, init_pred_for, cont_pred_for,
SafePredFlag|SyncPredFlag);
InitCPredBack("$current_predicate", 2, 3, init_current_pre, cont_current_pre,
InitCPredBack("$current_predicate", 2, 1, init_current_predicate, cont_current_predicate,
SafePredFlag|SyncPredFlag);
InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
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:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0) {
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
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 {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0) {
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
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 {
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0) {
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
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:
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0) {
s = RepAtom((Atom)(pred->FunctorOfPred))->StrOfAE;
} else {
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
}
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
send_tracer_message("FAIL ", NULL, 0, NULL, args);

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* 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 */
@ -135,6 +135,7 @@ typedef struct various_codes {
UInt number_of_cpreds;
UInt number_of_cmpfuncs;
Term module_name[MaxModules];
struct pred_entry *module_pred[MaxModules];
SMALLUNSGN no_of_modules;
struct clause_struct *dead_clauses;
#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_CMPFUNCS heap_regs->number_of_cmpfuncs
#define ModuleName heap_regs->module_name
#define ModulePred heap_regs->module_pred
#define PrimitivesModule heap_regs->primitives_module
#define UserModule heap_regs->user_module
#define DBQueues heap_regs->db_queues

3
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* 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 */
@ -52,6 +52,7 @@ CELL STD_PROTO(*ArgsOfSFTerm,(Term));
int STD_PROTO(LookupModule,(Term));
Prop STD_PROTO(GetPredProp,(Atom,unsigned int));
Prop STD_PROTO(GetPredPropByFunc,(Functor));
Prop STD_PROTO(LockedGetPredProp,(Atom,unsigned int));
Prop STD_PROTO(GetExpProp,(Atom,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>
<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
from James Cussens).</li>
<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 */
Atom NameOfFE; /* back pointer to owner atom */
Prop PropsOfFE; /* pointer to list of properties for this functor */
#if defined(YAPOR) || defined(THREADS)
rwlock_t FRWLock;
#endif
} FunctorEntry;
typedef FunctorEntry *Functor;

36
m4/Yatom.h.m4
View File

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

11
pl/listing.yap
View File

@ -20,25 +20,28 @@
*/
listing :-
current_predicate(_,Pred),
'$current_predicate_no_modules'(_,Pred),
'$list_clauses'(Pred).
listing.
listing(V) :- var(V), !. % ignore variables
listing(M:V) :- !,
'$mod_switch'(M,listing(V)).
'$mod_switch'(M,'$listing'(V)).
listing([]) :- !.
listing([X|Rest]) :-
!,
listing(X),
listing(Rest).
listing(X) :-
'$listing'(X).
'$listing'(X) :-
'$funcspec'(X,Name,Arity),
current_predicate(Name,Pred),
'$current_predicate_no_modules'(Name,Pred),
functor(Pred,Name,Arity),
'$list_clauses'(Pred).
listing(_).
'$listing'(_).
'$funcspec'(Name/Arity,Name,Arity) :- !, 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).
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
var(M), !,
current_module(M),
'$current_predicate2'(A,T).
current_predicate(A,T) :-
'$current_predicate'(A,T).
M \= prolog,
'$mod_switch'(M,'$current_predicate_no_modules'(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
atom(A), !, '$pred_defined_for'(A,T),
'$pred_exists'(T).
'$current_predicate2'(A,T) :- % generate them all
'$current_predicate'(A,T),
current_predicate(M:F) :- % module specified
var(M), !,
current_module(M),
M \= prolog,
'$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).
'$system_predicate'(Pred) :-
'$flags'(Pred,Flags,_),
Flags /\ 8'40000 =\= 0.
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).
'$current_predicate3'(A/Arity) :-
'$current_predicate'(A,Arity),
functor(T,A,Arity),
'$pred_exists'(T).
%%% User interface for statistics
@ -421,7 +422,6 @@ statistics :-
format(user_error,":~t ~d in use~19+", [TrlInUse]),
TrlFree is TrlSpa-TrlInUse,
format(user_error,",~t ~d free~19+~n", [TrlFree]),
OvfTime is TotHOTime+TotSOTime+TotTOTime,
format(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
[OvfTime,NOfHO,NOfSO,NOfTO]),
@ -599,9 +599,12 @@ grow_stack(X) :- $grow_stack(X).
% environment to return to.
%
%garbage_collect :- save(dump), '$gc', save(dump2).
garbage_collect :- '$gc'.
gc :- yap_flag(gc,on).
nogc :- yap_flag(gc,off).
garbage_collect :-
'$gc'.
gc :-
yap_flag(gc,on).
nogc :-
yap_flag(gc,off).
'$force_environment_for_gc'.