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

Merge branch 'master' of /home/vsc/yap-6.3 

Conflicts:
	C/cdmgr.c
	pl/preds.yap
This commit is contained in:
Vitor Santos Costa 2015-01-17 03:06:59 -08:00
parent ec0aa5ed0a b494cce5dc
commit e40c248c16
26 changed files with 573 additions and 498 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/absmi.c
View File

@ -1252,7 +1252,7 @@ interrupt_dexecute( USES_REGS1 )
if (PP) UNLOCKPE(1,PP);
PP = P->y_u.pp.p0;
pe = P->y_u.pp.p;
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
if ((pe->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
}
/* set S for next instructions */

20
C/c_interface.c
View File

@ -1584,12 +1584,15 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
if (pe->PredFlags & SWIEnvPredFlag) {
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context ctx;
UInt i;
Int sl = 0;
UInt i, arity = pe->ArityOfPE;
yhandle_t sl = 0;
ctx.engine = NULL;
for (i=pe->ArityOfPE; i > 0; i--) {
sl = Yap_InitSlot(XREGS[i] PASS_REGS);
if (arity > 0) {
sl = Yap_NewSlots( arity );
for (i= 0; i < arity; i++ ) {
Yap_PutInSlot(sl+i, XREGS[i+1] PASS_REGS);
}
}
PP = pe;
ret = ((codev)(sl,0,&ctx));
@ -1632,7 +1635,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
CACHE_REGS
CELL ocp = LCL0-(CELL *)B;
/* for slots to work */
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
yhandle_t CurSlot = Yap_StartSlots( PASS_REGS1 );
if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag|ModuleTransparentPredFlag)) {
uintptr_t val;
CPredicateV codev = (CPredicateV)exec_code;
@ -1700,7 +1703,7 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
Int CurSlot;
yhandle_t CurSlot;
CELL *args = B->cp_args;
B = oB;
@ -1733,7 +1736,8 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
return TRUE;
}
} else {
Int ret, CurSlot;
Int ret;
yhandle_t CurSlot;
B = oB;
/* for slots to work */
CurSlot = Yap_StartSlots( PASS_REGS1 );
@ -1759,7 +1763,7 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
{
CACHE_REGS
/* for slots to work */
Int CurSlot = Yap_StartSlots( PASS_REGS1 );
yhandle_t CurSlot = Yap_StartSlots( PASS_REGS1 );
UInt ocp = LCL0-(CELL *)B;
if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
Int val;

279
C/cdmgr.c
View File

@ -707,15 +707,20 @@ static_in_use(PredEntry *p, int check_everything)
#define is_tabled(pe) (pe->PredFlags & TabledPredFlag)
#endif /* TABLING */
static PredEntry *
get_pred(Term t, Term tmod, char *pname)
/**
* @short Given a Prolog term and a module, return the
* corresponding predicate.
*
* returns NULL in error.
*/
PredEntry *
Yap_getPred(Term t, Term tmod, char *msg)
{
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
@ -724,17 +729,17 @@ get_pred(Term t, Term tmod, char *pname)
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
return NULL;
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), msg);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
}
if (!IsAtomTerm(tmod) ) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
Yap_Error(TYPE_ERROR_ATOM, t0, msg);
return NULL;
}
t = ArgOfTerm(2, t);
@ -745,6 +750,43 @@ get_pred(Term t, Term tmod, char *pname)
return NULL;
}
PredEntry *
Yap_Pred(Term t, Term tmod, char *msg)
{
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), msg);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod) ) {
Yap_Error(INSTANTIATION_ERROR, t0, msg);
return NULL;
}
if (!IsAtomTerm(tmod) ) {
Yap_Error(TYPE_ERROR_ATOM, t0, msg);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
return RepPredProp(PredPropByFunc(fun, tmod));
} else
return NULL;
}
/******************************************************************
Mega Clauses
@ -2864,7 +2906,7 @@ p_is_no_trace( USES_REGS1 )
{ /* '$undefined'(P,Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
@ -2882,7 +2924,7 @@ p_set_no_trace( USES_REGS1 )
{ /* '$set_no_trace'(+Fun,+M) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
@ -2897,7 +2939,7 @@ Yap_SetNoTrace(char *name, arity_t arity, Term tmod)
PredEntry *pe;
if (arity == 0) {
pe = get_pred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace");
pe = Yap_getPred(MkAtomTerm(Yap_LookupAtom(name)), tmod, "no_trace");
} else {
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom(name), arity),tmod));
}
@ -3072,7 +3114,7 @@ p_in_use( USES_REGS1 )
PredEntry *pe;
Int out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$in_use");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$in_use");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(25,pe);
@ -3128,7 +3170,7 @@ p_is_multifile( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_multifile");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_multifile");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@ -3179,7 +3221,7 @@ p_is_discontiguous( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "discontiguous");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "discontiguous");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@ -3194,7 +3236,7 @@ p_is_thread_local( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@ -3209,7 +3251,7 @@ p_is_log_updatable( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_log_updatable");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
@ -3224,7 +3266,7 @@ p_is_source( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(28,pe);
@ -3240,7 +3282,7 @@ p_is_exo( USES_REGS1 )
bool out;
MegaClause *mcl;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_exo");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_exo");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(28,pe);
@ -3260,7 +3302,7 @@ p_owner_file( USES_REGS1 )
PredEntry *pe;
Atom owner;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(29,pe);
@ -3284,7 +3326,7 @@ p_set_owner_file( USES_REGS1 )
{ /* '$owner_file'(+P,M,F) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(29,pe);
@ -3306,7 +3348,7 @@ p_mk_d( USES_REGS1 )
{ /* '$is_dynamic'(+P) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30,pe);
@ -3324,7 +3366,7 @@ p_is_dynamic( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_dynamic");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_dynamic");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(31,pe);
@ -3339,7 +3381,7 @@ p_is_metapredicate( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_meta");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$is_meta");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(32,pe);
@ -3417,7 +3459,7 @@ p_pred_exists( USES_REGS1 )
PredEntry *pe;
bool out;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$exists");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "$exists");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(34,pe);
@ -3435,7 +3477,7 @@ p_set_pred_module( USES_REGS1 )
{ /* '$set_pred_module'(+P,+Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1");
pe = Yap_getPred(Deref(ARG1), CurrentModule, "set_pred_module/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(35,pe);
@ -3450,7 +3492,7 @@ p_set_pred_owner( USES_REGS1 )
PredEntry *pe;
Term a2 = Deref( ARG2 );
pe = get_pred(Deref(ARG1), CurrentModule, "set_pred_module/1");
pe = Yap_getPred(Deref(ARG1), CurrentModule, "set_pred_module/1");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(35,pe);
@ -3478,7 +3520,7 @@ p_undefined( USES_REGS1 )
{ /* '$undefined'(P,Mod) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
@ -3504,7 +3546,7 @@ p_kill_dynamic( USES_REGS1 )
{ /* '$kill_dynamic'(P,M) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "kill_dynamic/1");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "kill_dynamic/1");
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(37,pe);
@ -4690,126 +4732,59 @@ p_all_system_pred( USES_REGS1 )
}
void
Yap_HidePred(PredEntry *pe)
Yap_HidePred(PredEntry *pe, bool offline)
{
Prop p0 = AbsPredProp(pe);
if (pe->ArityOfPE == 0) {
Atom a = (Atom)pe->FunctorOfPred;
if (offline) {
Prop p0 = AbsPredProp(pe);
if(pe->ArityOfPE == 0) {
Atom a = (Atom)pe->FunctorOfPred;
p0 = RepAtom(a)->PropsOfAE;
if (p0 == AbsPredProp(pe)) {
RepAtom(a)->PropsOfAE = pe->NextOfPE;
p0 = RepAtom(a)->PropsOfAE;
if (p0 == AbsPredProp(pe)) {
RepAtom(a)->PropsOfAE = pe->NextOfPE;
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
}
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
p0->NextOfPE = pe->NextOfPE;
}
} else {
Functor funt = pe->FunctorOfPred;
Functor funt = pe->FunctorOfPred;
p0 = funt->PropsOfFE;
if (p0 == AbsPredProp(pe)) {
funt->PropsOfFE = pe->NextOfPE;
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
p0->NextOfPE = pe->NextOfPE;
p0 = funt->PropsOfFE;
if (p0 == AbsPredProp(pe)) {
funt->PropsOfFE = pe->NextOfPE;
} else {
while (p0->NextOfPE != AbsPredProp(pe))
p0 = p0->NextOfPE;
if (p0 == NIL)
return;
}
}
p0->NextOfPE = pe->NextOfPE;
pe->NextOfPE = HIDDEN_PREDICATES;
HIDDEN_PREDICATES = AbsPredProp(pe);
}
pe->NextOfPE = HIDDEN_PREDICATES;
HIDDEN_PREDICATES = AbsPredProp(pe);
pe->PredFlags |= HiddenPredFlag|NoTracePredFlag;
pe->PredFlags |= (HiddenPredFlag|NoTracePredFlag|NoSpyPredFlag);
}
static Int /* $system_predicate(P) */
p_stash_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return(FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
PredEntry *pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "stash_predicate/1" );
if (EndOfPAEntr(pe))
return FALSE;
Yap_HidePred(pe);
Yap_HidePred(pe, true);
return TRUE;
}
static Int /* $system_predicate(P) */
p_hide_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return(FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
PredEntry *pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "hide_predicate/1" );
if (EndOfPAEntr(pe))
return FALSE;
pe->PredFlags |= HiddenPredFlag;
Yap_HidePred(pe, false);
return TRUE;
}
@ -4817,42 +4792,10 @@ p_hide_predicate( USES_REGS1 )
static Int /* $hidden_predicate(P) */
p_hidden_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return(FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return (TRUE);
} else
return (FALSE);
PredEntry *pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "hidden_predicate/1" );
if (EndOfPAEntr(pe))
return(FALSE);
return(pe->PredFlags & HiddenPredFlag);
return FALSE;
return pe->PredFlags & HiddenPredFlag;
}
static Int
@ -4985,7 +4928,7 @@ p_log_update_clause( USES_REGS1 )
} else {
new_cp = P;
}
pe = get_pred(t1, Deref(ARG2), "clause/3");
pe = Yap_getPred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(41,pe);
@ -5136,7 +5079,7 @@ p_log_update_clause_erase( USES_REGS1 )
} else {
new_cp = P;
}
pe = get_pred(t1, Deref(ARG2), "clause/3");
pe = Yap_getPred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(43,pe);
@ -5483,7 +5426,7 @@ p_static_clause( USES_REGS1 )
} else {
new_cp = P;
}
pe = get_pred(t1, Deref(ARG2), "clause/3");
pe = Yap_getPred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
PELOCK(46,pe);
@ -5705,7 +5648,7 @@ p_static_pred_statistics( USES_REGS1 )
Int out;
PredEntry *pe;
pe = get_pred( Deref(ARG1), Deref(ARG2), "predicate_statistics");
pe = Yap_getPred( Deref(ARG1), Deref(ARG2), "predicate_statistics");
if (pe == NIL)
return (FALSE);
PELOCK(50,pe);
@ -5730,7 +5673,7 @@ p_predicate_erased_statistics( USES_REGS1 )
Term tpred = ArgOfTerm(2,Deref(ARG1));
Term tmod = ArgOfTerm(1,Deref(ARG1));
if (EndOfPAEntr(pe=get_pred(tpred, tmod, "predicate_erased_statistics")))
if (EndOfPAEntr(pe=Yap_getPred(tpred, tmod, "predicate_erased_statistics")))
return FALSE;
while (cl) {
if (cl->ClPred == pe) {
@ -6499,7 +6442,7 @@ p_nth_instance( USES_REGS1 )
Yap_Error(DOMAIN_ERROR_NOT_ZERO, TCount, "nth_clause/3");
return FALSE;
}
pe = get_pred(Deref(ARG1), Deref(ARG2), "nth_clause/3");
pe = Yap_getPred(Deref(ARG1), Deref(ARG2), "nth_clause/3");
if (pe) {
PELOCK(47,pe);
}

11
C/exec.c
View File

@ -193,7 +193,7 @@ do_execute(Term t, Term mod USES_REGS)
Yap_get_signal( YAP_CREEP_SIGNAL ) ) {
CalculateStackGap( PASS_REGS1 );
}
return CallMetaCall(ARG1, mod PASS_REGS);
return CallMetaCall(t, mod PASS_REGS);
} else if (Yap_has_a_signal() &&
!LOCAL_InterruptsDisabled &&
!(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) {
@ -406,7 +406,14 @@ do_execute_n(Term t, Term mod, unsigned int n USES_REGS)
static Int
EnterCreepMode(Term t, Term mod USES_REGS) {
PredEntry *PredCreep;
if ( Yap_only_has_signal( YAP_CREEP_SIGNAL ) ) {
PredEntry *pen = Yap_Pred( t, mod, " creep" );
if (pen->PredFlags & NoTracePredFlag) {
Yap_get_signal( YAP_CREEP_SIGNAL );
return do_execute(ARG1, mod PASS_REGS);
}
}
if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) {
ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) {

21
C/gmp_support.c
View File

@ -1027,22 +1027,34 @@ Yap_gmp_exp_big_big(Term t1, Term t2)
Term
Yap_gmp_big_from_64bits(YAP_LONG_LONG i)
Yap_gmp_big_from_64bits(int64_t i)
{
char s[64];
char s[65];
MP_INT new;
#ifdef _WIN32
snprintf(s,64,"%I64d", (long long int)i);
#elif HAVE_SNPRINTF
snprintf(s, 64, "%lld", (long long int)i);
snprintf(s, 64, "%lld", (int64_t)i);
#else
sprintf(s, "%lld", (long long int)i);
sprintf(s, "%lld", (int64_t)i);
#endif
mpz_init_set_str (&new, s, 10);
return MkBigAndClose(&new);
}
int64_t
Yap_gmp_big_to_64bits(Term t)
{
MP_INT *b = Yap_BigIntOfTerm(t);
int64_t rc;
mpz_export( &rc, NULL, 0, sizeof(int64_t), 0, 0, b);
if ( mpz_sgn(b) < 0 ) {
rc = -rc;
}
return rc;
}
Term
Yap_gmq_rdiv_int_int(Int i1, Int i2)
{
@ -1752,6 +1764,7 @@ Yap_term_to_existing_rat(Term t, MP_RAT *b)
return FALSE;
}
#endif

2
C/heapgc.c
View File

@ -4179,7 +4179,7 @@ p_inform_gc( USES_REGS1 )
{
Term tn = MkIntegerTerm(LOCAL_TotGcTime);
Term tt = MkIntegerTerm(LOCAL_GcCalls);
Term ts = Yap_Mk64IntegerTerm((LOCAL_TotGcRecovered*sizeof(CELL)));
Term ts = Yap_MkInt64Term((LOCAL_TotGcRecovered*sizeof(CELL)));
return(Yap_unify(tn, ARG2) && Yap_unify(tt, ARG1) && Yap_unify(ts, ARG3));

13
C/qlyr.c
View File

@ -693,7 +693,7 @@ read_tag(IOSTREAM *stream)
return ch;
}
static UInt
static pred_flags_t
read_predFlags(IOSTREAM *stream)
{
pred_flags_t v;
@ -1005,8 +1005,9 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
static void
read_pred(IOSTREAM *stream, Term mod) {
UInt flags;
UInt nclauses, fl1;
pred_flags_t flags;
UInt nclauses;
pred_flags_t fl1;
PredEntry *ap;
ap = LookupPredEntry((PredEntry *)read_UInt(stream));
@ -1019,8 +1020,8 @@ read_pred(IOSTREAM *stream, Term mod) {
// printf(" %s/%ld\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE);
//else if (ap->ModuleOfPred != IDB_MODULE)
// printf(" %s/%ld\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE);
fl1 = flags & ((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(pred_flags_t)EXTRA_PRED_FLAGS);
ap->PredFlags &= ~((pred_flags_t)STATIC_PRED_FLAGS|(pred_flags_t)EXTRA_PRED_FLAGS);
ap->PredFlags |= fl1;
if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_UInt(stream);
@ -1037,7 +1038,7 @@ read_pred(IOSTREAM *stream, Term mod) {
}
read_clauses(stream, ap, nclauses, flags);
if (flags & HiddenPredFlag) {
Yap_HidePred(ap);
Yap_HidePred(ap, false);
}
}

144
C/scanner.c
View File

@ -837,12 +837,14 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
GET_LD
char *sp = s;
int ch = *chp;
Int val = 0L, base = ch - '0';
int might_be_float = TRUE, has_overflow = FALSE;
Int val = 0L;
int base = ch-'0';
bool might_be_float = true, has_overflow = false;
const unsigned char *decimalpoint;
*sp++ = ch;
ch = getchr(inp_stream);
/*
* because of things like 00'2, 03'2 and even better 12'2, I need to
* do this (have mercy)
@ -852,103 +854,97 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
base = 10 * base + ch - '0';
base = base*10+ ch - '0';
ch = getchr(inp_stream);
}
if (ch == '\'') {
if (base > 36) {
return num_send_error_message("Admissible bases are 0..36");
}
might_be_float = FALSE;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = ch;
ch = getchr(inp_stream);
if (base == 0) {
wchar_t ascii = ch;
int scan_extra = TRUE;
if (base == 0) {
if (ch <= '9' && ch >= '0') {
*sp++ = ch;
val = base;
base = 10;
// go scan a number
} else if (ch == '\'') {
int scan_extra;
wchar_t ascii;
ch = getchr(inp_stream);
if (ch == '\\' &&
Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) {
/* a quick way to represent ASCII */
ascii = read_quoted_char(&scan_extra, inp_stream);
} else {
ascii = ch;
}
/* a quick way to represent ASCII */
if (scan_extra)
*chp = getchr(inp_stream);
ch = getchr(inp_stream);
*chp = ch;
if (sign == -1) {
return MkIntegerTerm(-ascii);
}
return MkIntegerTerm(ascii);
} else if (base >= 10 && base <= 36) {
int upper_case = 'A' - 11 + base;
int lower_case = 'a' - 11 + base;
while (my_isxdigit(ch, upper_case, lower_case)) {
Int oval = val;
int chval = (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = ch;
val = oval * base + chval;
if (oval != (val-chval)/base) /* overflow */
has_overflow = (has_overflow || TRUE);
} else {
switch (ch) {
case 'b':
base = 2;
ch = getchr(inp_stream);
break;
case 'o':
base = 8;
ch = getchr(inp_stream);
break;
case 'x':
base = 16;
ch = getchr(inp_stream);
break;
default:
/* floating point */
base = 10;
}
}
} else if (ch == 'x' && base == 0) {
might_be_float = FALSE;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
} else {
/* base > 0, must be a number */
if (ch == '\'') {
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
sp = s;
ch = getchr(inp_stream);
} else {
val = base;
base = 10;
}
*sp++ = ch;
ch = getchr(inp_stream);
while (my_isxdigit(ch, 'F', 'f')) {
}
if (base <= 10) {
// do this fast, it is most important */
while ( ch >= '0' && ch <= base+('0'- 1)) {
Int oval = val;
int chval = (chtype(ch) == NU ? ch - '0' :
(my_isupper(ch) ? ch - 'A' : ch - 'a') + 10);
if (!has_overflow) {
val = val * base + ch - '0';
if (val/base != oval || val -oval*base != ch-'0') /* overflow */
has_overflow = true;
}
*sp++ = ch;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = ch;
val = val * 16 + chval;
if (oval != (val-chval)/16) /* overflow */
has_overflow = TRUE;
ch = getchr(inp_stream);
}
*chp = ch;
}
else if (ch == 'o' && base == 0) {
might_be_float = FALSE;
base = 8;
ch = getchr(inp_stream);
} else if (ch == 'b' && base == 0) {
might_be_float = FALSE;
base = 2;
ch = getchr(inp_stream);
} else {
val = base;
base = 10;
}
while (chtype(ch) == NU) {
Int oval = val;
if (!(val == 0 && ch == '0') || has_overflow) {
while (chtype(ch) == NU ||my_isxdigit(ch, 'a'+(base-10), 'A'+(base-10))) {
Int oval = val;
if (!has_overflow) {
int dig =
(ch >= '0' && ch <= '9' ? ch - '0' :
ch >= 'a' ? ch +10 - 'a' : ch+10-'A' );
val = val * base + dig;
if (val/base != oval || val -oval*base != dig) /* overflow */
has_overflow = true;
}
*sp++ = ch;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = ch;
ch = getchr(inp_stream);
}
if (ch - '0' >= base) {
if (sign == -1)
return MkIntegerTerm(-val);
return MkIntegerTerm(val);
}
val = val * base + ch - '0';
if (val/base != oval || val -oval*base != ch-'0') /* overflow */
has_overflow = TRUE;
ch = getchr(inp_stream);
}
if (might_be_float && ( ch == '.' || ch == 'e' || ch == 'E')) {
int has_dot = ( ch == '.' );
@ -1028,7 +1024,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
*sp = '\0';
/* skip base */
*chp = ch;
if (s[0] == '0' && s[1] == 'x')
if (s[0] == '0' && (s[1] == 'x'|| s[1] == 'X'))
return read_int_overflow(s+2,16,val,sign);
else if (s[0] == '0' && s[1] == 'o')
return read_int_overflow(s+2,8,val,sign);

2
C/signals.c
View File

@ -156,7 +156,7 @@ get_signal(yap_signals sig USES_REGS)
#if THREADS
uint64_t old;
// first, clear the Creep Flag, now if someone sets it it is their problem
// first, clear the Interrupted Marker, now if someone sets it it is their problem
CalculateStackGap( PASS_REGS1 );
// reset the flag
if ( (old =__sync_fetch_and_and( &LOCAL_Signals, ~SIGNAL_TO_BIT(sig) ) ) !=

102
C/stdpreds.c
View File

@ -827,52 +827,41 @@ static Int cont_current_predicate(USES_REGS1) {
Functor f;
if (IsNonVarTerm(t1)) {
PropEntry *p = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
PropEntry *q = AddressOfTerm(EXTRA_CBACK_ARG(4, 2));
// restart inner loop
for (; q; q = q->NextOfPE) {
if (q->KindOfPE == PEProp) {
pp = RepPredProp(q);
q = q->NextOfPE;
if (q == NIL)
p = p->NextOfPE;
if (!p)
is_det = true;
// we are done with this loop.
break;
}
}
if (!pp && p) {
// try using outer loop
for (; p; p = p->NextOfPE) {
if (p->KindOfPE == PEProp) {
q = NULL;
pp = RepPredProp(p);
p = p->NextOfPE;
if (!p)
is_det = true;
break;
} else if (p->KindOfPE == FunctorProperty) {
// looping on p/n
for (q = RepFunctorProp(p)->PropsOfFE; q; q = q->NextOfPE) {
if (q->KindOfPE == PEProp) {
pp = RepPredProp(q);
q = q->NextOfPE;
if (!q && !p->NextOfPE)
is_det = true;
break;
}
}
break;
}
PropEntry *p = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)), *p0 = p;
PropEntry *q = AddressOfTerm(EXTRA_CBACK_ARG(4, 2)), *q0 = q;
PredEntry *pp0;
if (q) pp0 = RepPredProp(q);
else pp0 = RepPredProp(p);
while (!pp && p ) {
if ( p->KindOfPE == PEProp && p != p0) {
pp = RepPredProp(p);
q = NULL;
} else if ( p->KindOfPE == FunctorProperty ) {
if (q0) {
q = q0->NextOfPE;
q0 = NULL;
} else {
q = RepFunctorProp(p)->PropsOfFE;
}
while (!pp && q ) {
if ( q->KindOfPE == PEProp )
pp = RepPredProp(q);
else
q = q->NextOfPE;
}
if (!q)
p = p->NextOfPE;
} else {
p = p->NextOfPE;
}
}
if (pp == NULL) // nothing more
cut_fail();
is_det = true;
if (!is_det) {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(p);
EXTRA_CBACK_ARG(4, 2) = MkAddressTerm(q);
}
pp = pp0;
} else if (IsNonVarTerm(t2)) {
// operating within the same module.
PredEntry *npp;
@ -1014,12 +1003,25 @@ static Int init_current_predicate(USES_REGS1) {
cut_fail();
} else {
PropEntry *p = RepAtom(AtomOfTerm(t1))->PropsOfAE, *q = NIL;
while (p && p->KindOfPE == FunctorProperty &&
(q = RepFunctorProp(p)->PropsOfFE) == NIL) {
p = p->NextOfPE;
while (!pp && p ) {
if ( p->KindOfPE == PEProp ) {
pp = RepPredProp(p);
} else if ( p->KindOfPE == FunctorProperty ) {
q = RepFunctorProp(p)->PropsOfFE;
while (!pp && q ) {
if ( q->KindOfPE == PEProp )
pp = RepPredProp(q);
else
q = q->NextOfPE;
}
if (!q)
p = p->NextOfPE;
} else {
p = p->NextOfPE;
}
}
if (!p)
cut_fail();
if (!pp)
cut_fail();
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(p);
EXTRA_CBACK_ARG(4, 2) = MkAddressTerm(q);
}
@ -1195,7 +1197,7 @@ static Int p_flags(USES_REGS1) { /* $flags(+Functor,+Mod,?OldFlags,?NewFlags) */
if (EndOfPAEntr(pe))
return (FALSE);
PELOCK(92, pe);
if (!Yap_unify_constant(ARG3, MkIntegerTerm(pe->PredFlags))) {
if (!Yap_unify_constant(ARG3, Yap_MkInt64Term(pe->PredFlags))) {
UNLOCK(pe->PELock);
return (FALSE);
}
@ -1203,18 +1205,18 @@ static Int p_flags(USES_REGS1) { /* $flags(+Functor,+Mod,?OldFlags,?NewFlags) */
if (IsVarTerm(ARG4)) {
UNLOCK(pe->PELock);
return (TRUE);
} else if (!IsIntegerTerm(ARG4)) {
} else if (!IsInt64Term(ARG4)) {
Term te = Yap_Eval(ARG4);
if (IsIntegerTerm(te)) {
newFl = IntegerOfTerm(te);
if (IsInt64Term(te)) {
newFl = Yap_Int64OfTerm(te);
} else {
UNLOCK(pe->PELock);
Yap_Error(TYPE_ERROR_INTEGER, ARG4, "flags");
return (FALSE);
}
} else
newFl = IntegerOfTerm(ARG4);
newFl = Yap_Int64OfTerm(ARG4);
pe->PredFlags = newFl;
UNLOCK(pe->PELock);
return TRUE;
@ -1268,7 +1270,7 @@ static Int
if (IsVarTerm(ARG4)) {
UNLOCK(pe->PELock);
return (FALSE);
} else if (!IsIntTerm(v)) {
} else if (!IsInt64Term(v)) {
Yap_Error(TYPE_ERROR_ATOM, v, "set_property/1");
return (FALSE);
}

2
C/write.c
View File

@ -556,7 +556,7 @@ write_quoted(wchar_t ch, wchar_t quote, wrf stream)
char esc[8];
/* last backslash in ISO mode */
sprintf(esc, "\\%03o\\", ch);
snprintf(esc, 7, "\\%03o\\", (unsigned int)ch);
wrputs(esc, stream);
}
}

12
H/YapHandles.h
View File

@ -112,7 +112,7 @@ Yap_PutInSlot(yhandle_t slot, Term t USES_REGS)
/// @brief allocate n empty new slots
static inline yhandle_t
Yap_NewSlots(int n USES_REGS)
Yap_NewSlots(size_t n USES_REGS)
{
yhandle_t old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) {
@ -132,7 +132,7 @@ Yap_countSlots( USES_REGS1 )
}
/// @brief create a new slot with term t
static inline Int
static inline yhandle_t
Yap_InitSlot(Term t USES_REGS)
{
yhandle_t old_slots = IntOfTerm(ASP[0]);
@ -143,8 +143,8 @@ Yap_InitSlot(Term t USES_REGS)
}
/// @brief Succeeds if it is to recover the space allocated for $n$ contiguos slots starting at topSlot.
static inline int
Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS)
static inline bool
Yap_RecoverSlots(size_t n, yhandle_t topSlot USES_REGS)
{
yhandle_t old_slots = IntOfTerm(ASP[0]),
new_slots = old_slots-n;
@ -152,10 +152,10 @@ Yap_RecoverSlots(int n, yhandle_t topSlot USES_REGS)
return FALSE;
}
if (ASP+1 != LCL0+topSlot)
return FALSE;
return false;
ASP += n;
ASP[new_slots+1] = ASP[0] = MkIntTerm(new_slots);
return TRUE;
return true;
}
#endif

4
H/Yapproto.h
View File

@ -133,8 +133,10 @@ void Yap_BuildMegaClause(struct pred_entry *);
void Yap_EraseMegaClause(yamop *,struct pred_entry *);
void Yap_ResetConsultStack(void);
void Yap_AssertzClause(struct pred_entry *, yamop *);
void Yap_HidePred(struct pred_entry *pe);
void Yap_HidePred(struct pred_entry *pe, bool offline);
int Yap_SetNoTrace(char *name, UInt arity, Term tmod);
struct pred_entry* Yap_getPred(Term t, Term tmod, char *msg);
struct pred_entry* Yap_Pred(Term t, Term tmod, char *msg);
/* cmppreds.c */
Int Yap_compare_terms(Term,Term);

116
H/Yatom.h
View File

@ -651,39 +651,39 @@ IsValProperty (int flags)
don't forget to also add in qly.h
*/
#define DiscontiguousPredFlag ((pred_flags_t)0x1000000000) /* predicates whose clauses may be all-over the place.. */
#define SysExportPredFlag ((pred_flags_t)0x800000000)
#define DiscontiguousPredFlag ((pred_flags_t)0x1000000000LL) /* predicates whose clauses may be all-over the place.. */
#define SysExportPredFlag ((pred_flags_t)0x800000000LL)
/* reuse export list to prolog module. */
#define NoTracePredFlag ((pred_flags_t)0x400000000) /* cannot trace this predicate */
#define NoSpyPredFlag ((pred_flags_t)0x200000000) /* cannot spy this predicate */
#define QuasiQuotationPredFlag ((pred_flags_t)0x100000000) /* SWI-like quasi quotations */
#define MegaClausePredFlag ((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */
#define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */
#define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */
#define UserCPredFlag ((pred_flags_t)0x10000000) /* CPred defined by the user */
#define LogUpdatePredFlag ((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */
#define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */
#define CountPredFlag ((pred_flags_t)0x02000000) /* count calls to pred */
#define HiddenPredFlag ((pred_flags_t)0x01000000) /* invisible predicate */
#define CArgsPredFlag ((pred_flags_t)0x00800000) /* SWI-like C-interface pred. */
#define SourcePredFlag ((pred_flags_t)0x00400000) /* static predicate with source declaration */
#define MetaPredFlag ((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */
#define SyncPredFlag ((pred_flags_t)0x00100000) /* has to synch before it can execute */
#define NumberDBPredFlag ((pred_flags_t)0x00080000) /* entry for a number key */
#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for an atom key */
#define GoalExPredFlag ((pred_flags_t)0x00020000) /* predicate that is called by goal_expand */
#define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */
#define AsmPredFlag ((pred_flags_t)0x00008000) /* inline */
#define StandardPredFlag ((pred_flags_t)0x00004000) /* system predicate */
#define DynamicPredFlag ((pred_flags_t)0x00002000) /* dynamic predicate */
#define CPredFlag ((pred_flags_t)0x00001000) /* written in C */
#define SafePredFlag ((pred_flags_t)0x00000800) /* does not alter arguments */
#define CompiledPredFlag ((pred_flags_t)0x00000400) /* is static */
#define IndexedPredFlag ((pred_flags_t)0x00000200) /* has indexing code */
#define SpiedPredFlag ((pred_flags_t)0x00000100) /* is a spy point */
#define BinaryPredFlag ((pred_flags_t)0x00000080) /* test predicate */
#define TabledPredFlag ((pred_flags_t)0x00000040) /* is tabled */
#define SequentialPredFlag ((pred_flags_t)0x00000020) /* may not create parallel choice points! */
#define NoTracePredFlag ((pred_flags_t)0x400000000LL) /* cannot trace this predicate */
#define NoSpyPredFlag ((pred_flags_t)0x200000000LL) /* cannot spy this predicate */
#define QuasiQuotationPredFlag ((pred_flags_t)0x100000000LL) /* SWI-like quasi quotations */
#define MegaClausePredFlag ((pred_flags_t)0x80000000LL) /* predicate is implemented as a mega-clause */
#define ThreadLocalPredFlag ((pred_flags_t)0x40000000LL) /* local to a thread */
#define MultiFileFlag ((pred_flags_t)0x20000000LL) /* is multi-file */
#define UserCPredFlag ((pred_flags_t)0x10000000LL) /* CPred defined by the user */
#define LogUpdatePredFlag ((pred_flags_t)0x08000000LL) /* dynamic predicate with log. upd. sem. */
#define InUsePredFlag ((pred_flags_t)0x04000000LL) /* count calls to pred */
#define CountPredFlag ((pred_flags_t)0x02000000LL) /* count calls to pred */
#define HiddenPredFlag ((pred_flags_t)0x01000000LL) /* invisible predicate */
#define CArgsPredFlag ((pred_flags_t)0x00800000LL) /* SWI-like C-interface pred. */
#define SourcePredFlag ((pred_flags_t)0x00400000LL) /* static predicate with source declaration */
#define MetaPredFlag ((pred_flags_t)0x00200000LL) /* predicate subject to a meta declaration */
#define SyncPredFlag ((pred_flags_t)0x00100000LL) /* has to synch before it can execute */
#define NumberDBPredFlag ((pred_flags_t)0x00080000LL) /* entry for a number key */
#define AtomDBPredFlag ((pred_flags_t)0x00040000LL) /* entry for an atom key */
#define GoalExPredFlag ((pred_flags_t)0x00020000LL) /* predicate that is called by goal_expand */
#define TestPredFlag ((pred_flags_t)0x00010000LL) /* is a test (optim. comit) */
#define AsmPredFlag ((pred_flags_t)0x00008000LL) /* inline */
#define StandardPredFlag ((pred_flags_t)0x00004000LL) /* system predicate */
#define DynamicPredFlag ((pred_flags_t)0x00002000LL) /* dynamic predicate */
#define CPredFlag ((pred_flags_t)0x00001000LL) /* written in C */
#define SafePredFlag ((pred_flags_t)0x00000800LL) /* does not alter arguments */
#define CompiledPredFlag ((pred_flags_t)0x00000400LL) /* is static */
#define IndexedPredFlag ((pred_flags_t)0x00000200LL) /* has indexing code */
#define SpiedPredFlag ((pred_flags_t)0x00000100LL) /* is a spy point */
#define BinaryPredFlag ((pred_flags_t)0x00000080LL) /* test predicate */
#define TabledPredFlag ((pred_flags_t)0x00000040LL) /* is tabled */
#define SequentialPredFlag ((pred_flags_t)0x00000020LL) /* may not create parallel choice points! */
#define ProfiledPredFlag ((pred_flags_t)0x00000010) /* pred is being profiled */
#define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred */
#define ModuleTransparentPredFlag ((pred_flags_t)0x00000004) /* ModuleTransparent pred */
@ -1865,6 +1865,58 @@ PredPropByAtomAndMod (Atom at, Term cur_mod)
return Yap_NewPredPropByAtom (ae, cur_mod);
}
//
// report arity, name, and module for a predicate.
//
INLINE_ONLY inline EXTERN
UInt IndicatorOfPred(PredEntry * ap, const char **name, const char **module);
INLINE_ONLY inline EXTERN
UInt IndicatorOfPred(PredEntry * ap, const char **name, const char **module)
{
if (module) {
Term tmod = ap->ModuleOfPred;
if (!tmod) *module = "prolog";
else *module = RepAtom(AtomOfTerm( tmod ))->StrOfAE;
}
if (ap->ModuleOfPred == IDB_MODULE) {
if (ap->PredFlags & NumberDBPredFlag ) {
if (name) {
Int id = ap->src.IndxId;
char *s = (char *)malloc(16);
snprintf(s, 15, Int_FORMAT, id);
*name = s;
}
return 0;
} else if (ap->PredFlags & AtomDBPredFlag) {
if (name) {
Atom At = (Atom)ap->FunctorOfPred;
*name = RepAtom(At)->StrOfAE;
}
return 0;
} else {
Functor f = ap->FunctorOfPred;
if (name) {
Atom At = NameOfFunctor(f);
*name = RepAtom(At)->StrOfAE;
}
return ArityOfFunctor(f);
}
} else {
if (name) {
if (ap->ArityOfPE == 0) {
Atom At = (Atom)ap->FunctorOfPred;
*name = RepAtom(At)->StrOfAE;
} else {
Functor f = ap->FunctorOfPred;
Atom At = NameOfFunctor(f);
*name = RepAtom(At)->StrOfAE;
}
}
return ap->ArityOfPE;
}
}
#if DEBUG_PELOCKING
#define PELOCK(I,Z) \
{ LOCK((Z)->PELock); (Z)->StatisticsForPred.NOfEntries=(I);(Z)->StatisticsForPred.NOfHeadSuccesses=pthread_self(); }

40
H/eval.h
View File

@ -489,7 +489,8 @@ Term Yap_gmp_exp_big_big(Term,Term);
Term Yap_gmp_gcd_int_big(Int,Term);
Term Yap_gmp_gcd_big_big(Term,Term);
Term Yap_gmp_big_from_64bits(YAP_LONG_LONG);
Term Yap_gmp_big_from_64bits(int64_t);
int64_t Yap_gmp_big_to_64bits(Term);
Term Yap_gmp_float_to_big(Float);
Term Yap_gmp_float_to_rational(Float);
@ -538,12 +539,12 @@ int Yap_term_to_existing_rat(Term, MP_RAT *);
void Yap_gmp_set_bit(Int i, Term t);
#endif
#define Yap_Mk64IntegerTerm(i) __Yap_Mk64IntegerTerm((i) PASS_REGS)
#define Yap_MkInt64Term(i) __Yap_MkInt64Term((i) PASS_REGS)
INLINE_ONLY inline EXTERN Term __Yap_Mk64IntegerTerm(YAP_LONG_LONG USES_REGS);
INLINE_ONLY inline EXTERN Term __Yap_MkInt64Term(YAP_LONG_LONG USES_REGS);
INLINE_ONLY inline EXTERN Term
__Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
__Yap_MkInt64Term(YAP_LONG_LONG i USES_REGS)
{
if (i <= Int_MAX && i >= Int_MIN) {
return MkIntegerTerm((Int)i);
@ -556,6 +557,37 @@ __Yap_Mk64IntegerTerm(YAP_LONG_LONG i USES_REGS)
}
}
INLINE_ONLY inline EXTERN bool IsInt64Term (Term);
INLINE_ONLY inline EXTERN bool
IsInt64Term (Term t)
{
CELL *pt;
return IsIntegerTerm (t)
||(FunctorOfTerm (t) == FunctorBigInt &&
( pt = RepAppl(t)) &&
pt[1] == BIG_INT &&
mpz_sizeinbase(Yap_BigIntOfTerm(t), 2) < 64);
}
#define Yap_Int64OfTerm(i) __Yap_Int64OfTerm((i) PASS_REGS)
INLINE_ONLY inline EXTERN int64_t __Yap_Int64OfTerm(Term t USES_REGS);
INLINE_ONLY inline EXTERN int64_t
__Yap_Int64OfTerm( Term t USES_REGS)
{
if (IsIntegerTerm( t )) {
return IntegerOfTerm(t);
} else {
#if USE_GMP
return Yap_gmp_big_to_64bits(t);
#else
return 0;
#endif
}
}
#if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }

7
H/qly.h
View File

@ -101,9 +101,14 @@ typedef enum {
QLY_ATOM_BLOB = 17
} qlf_tag_t;
#define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag)
#define STATIC_PRED_FLAGS (HiddenPredFlag|AtomDBPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|SYSTEM_PRED_FLAGS|PROP_PRED_FLAGS|SWI_PRED_FLAGS|EXTRA_PRED_FLAGS)
#define EXTRA_PRED_FLAGS (QuasiQuotationPredFlag|NoTracePredFlag|NoSpyPredFlag)
#define PROP_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|ModuleTransparentPredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag)
#define SWI_PRED_FLAGS (SWIEnvPredFlag|CArgsPredFlag)
#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)
#define CHECK(F) { size_t r = (F); if (!r) return r; }

5
Makefile.in
View File

@ -218,10 +218,7 @@ HEADERS = \
OPTYap/locks_mips_funcs.h OPTYap/locks_alpha.h \
OPTYap/locks_alpha_funcs.h \
OPTYap/locks_pthread.h \
library/dialect/swi/fli/swi.h \
JIT/HPP/JIT.hpp \
JIT/HPP/JIT_Compiler.hpp \
JIT/HPP/jit_predicates.hpp
library/dialect/swi/fli/swi.h
IOLIB_SOURCES=os/pl-buffer.c os/pl-ctype.c \
os/pl-codelist.c \

10
library/dialect/swi/fli/swi.c
View File

@ -129,7 +129,7 @@ Yap_InitSWIHash(void)
}
static void
UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags)
UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, pred_flags_t flags)
{
CACHE_REGS
@ -2503,7 +2503,7 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
{
CACHE_REGS
Term tmod;
Int nflags = 0;
pred_flags_t nflags = 0;
#ifdef DEBUG
if (flags & (PL_FA_CREF)) {
@ -2523,14 +2523,14 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
} else {
nflags |= CArgsPredFlag;
}
if (flags & PL_FA_NOTRACE) {
nflags |= NoTracePredFlag;
}
if (flags & PL_FA_NONDETERMINISTIC) {
Yap_InitCPredBackCut((char *)name, arity, sizeof(struct foreign_context)/sizeof(CELL), (CPredicate)function, (CPredicate)function, (CPredicate)function, UserCPredFlag|nflags);
} else {
UserCPredicate((char *)name,(CPredicate)function,arity,tmod,nflags);
}
if (flags & PL_FA_NOTRACE) {
Yap_SetNoTrace((char *)name, arity, tmod);
}
}
X_API void PL_register_extensions(const PL_extension *ptr)

2
os/pl-rl.c
View File

@ -613,7 +613,7 @@ PL_install_readline(void)
Serror->functions = &GD->os.rl_functions;
#define PRED(name, arity, func, attr) \
PL_register_foreign_in_module("system", name, arity, func, attr)
PL_register_foreign_in_module("prolog", name, arity, func, attr)
PRED("rl_read_init_file", 1, pl_rl_read_init_file, 0);
PRED("rl_add_history", 1, pl_rl_add_history, PL_FA_NOTRACE);

6
pl/boot.yap
View File

@ -450,13 +450,13 @@ true :- true.
(print_message(error, E),
'$handle_toplevel_error'(Line, E))),
(
'$pred_exists'(rl_add_history(_), user)
'$pred_exists'(rl_add_history(_), prolog)
->
format(atom(CompleteLine), '~W~W',
[ Line, [partial(true)],
'.', [partial(true)]
]),
user:rl_add_history(CompleteLine)
userprolog:rl_add_history(CompleteLine)
;
true
),
@ -1471,7 +1471,7 @@ expand_term(Term,Expanded) :-
%
'$expand_array_accesses_in_term'(Expanded0,ExpandedF) :-
'$array_refs_compiled',
'$arrays':'$c_arrays'(Expanded0,ExpandedF), !.
'$c_arrays'(Expanded0,ExpandedF), !.
'$expand_array_accesses_in_term'(Expanded,Expanded).

176
pl/debug.yap
View File

@ -88,95 +88,91 @@ mode and the existing spy-points, when the debugger is on.
% First part : setting and reseting spy points
% $suspy does most of the work
'$suspy'(V,S,M) :- var(V) , !,
'$do_error'(instantiation_error,M:spy(V,S)).
'$suspy'((M:S),P,_) :- !,
'$suspy'(S,P,M).
'$suspy'([],_,_) :- !.
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
'$suspy'(F/N,S,M) :- !,
functor(T,F,N),
'$do_suspy'(S, F, N, T, M).
'$suspy'(A,S,M) :- atom(A), !,
'$suspy_predicates_by_name'(A,S,M).
'$suspy'(P,spy,M) :- !,
'$do_error'(domain_error(predicate_spec,P),spy(M:P)).
'$suspy'(P,nospy,M) :-
'$do_error'(domain_error(predicate_spec,P),nospy(M:P)).
'$suspy'(V,S) :-
strip_module( V, M, Indicators ),
(
ground( Indicators )
->
true
;
'$do_error'(instantiation_error,M:spy(V,S) )
),
/* muat be ground, can be conjunction, list or single element */
( lists:member( I0, Indicators ),
strip_module( I0, M, I ),
'$do_suspy'( M:I, S ),
fail
;
conjunctions:conj_member( I0, Indicators ),
strip_module( I0, M, I ),
'$do_suspy'( M:I, S ),
fail
;
true
).
'$suspy_predicates_by_name'(A,S,M) :-
% just check one such predicate exists
(
current_predicate(A,M:_)
->
M = EM,
A = NA
;
recorded('$import','$import'(EM,M,GA,_,A,_),_),
functor(GA,NA,_)
),
!,
'$do_suspy_predicates_by_name'(NA,S,EM).
'$suspy_predicates_by_name'(A,spy,M) :- !,
print_message(warning,no_match(spy(M:A))).
'$suspy_predicates_by_name'(A,nospy,M) :-
print_message(warning,no_match(nospy(M:A))).
'$do_suspy_predicates_by_name'(A,S,M) :-
current_predicate(A,M:T),
functor(T,A,N),
'$do_suspy'(S, A, N, T, M).
'$do_suspy_predicates_by_name'(A, S, M) :-
recorded('$import','$import'(EM,M,_,T,A,N),_),
'$do_suspy'(S, A, N, T, EM).
'$do_suspy'(M:A, Action) :-
atom( A ), !,
(
current_predicate( M:A/N ),
functor( G, A, N)
*->
'$exec_spy'( M, G, Action )
;
print_message(warning,no_match( M:A ) )
).
'$do_suspy'(M:A/N, Action) :- !,
( current_predicate( M:A/N )
*->
functor( G, A, N),
'$exec_spy'( M, G, Action )
;
G =.. [ Action, M:A/N],
print_message(warning,no_match( G ) )
).
'$do_suspy'( I, Action) :-
G =.. [ Action, I],
'$do_error'(domain_error(predicate_spec,I), G ).
%
% protect against evil arguments.
%
'$do_suspy'(S, F, N, T, M) :-
recorded('$import','$import'(EM,M,T0,_,F,N),_), !,
functor(T0, F0, N0),
'$do_suspy'(S, F0, N0, T, EM).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
'$exec_spy'( M, G, Action ) :-
'$follow_import_chain'( M, G, M0, G0 ),
'$exec_spy2'( M0, G0, Action ).
'$exec_spy2'( M0, S0, Action ) :-
'$system_predicate'(S0,M0), 1,
'$flags'(S0,M0,F,F),
(
F /\ 0x118dd080 =\= 0
->
Call =.. [Action,M0:S0],
functor(S0,N0,A0),
'$do_error'(permission_error(access,private_procedure,M0:A0/N0),Call)
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M),
'$flags'(T,M,F,F),
F /\ 0x118dd080 =\= 0,
( S = spy ->
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
;
'$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
print_message(warning,no_match(spy(M:F/N)))
;
print_message(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M).
true
),
'$suspy2'(Action, S0, M0 ).
'$exec_spy2'( M0, S0, Action ) :-
'$suspy2'(Action, S0, M0 ).
'$suspy2'(spy,F,N,T,M) :-
'$suspy2'(spy,T,M) :-
recorded('$spy','$spy'(T,M),_), !,
functor(T,F,N),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
'$suspy2'(spy,F,N,T,M) :- !,
'$suspy2'(spy,T,M) :- !,
recorda('$spy','$spy'(T,M),_),
'$set_spy'(T,M),
functor(T,F,N),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
'$suspy2'(nospy,F,N,T,M) :-
'$suspy2'(nospy,T,M) :-
recorded('$spy','$spy'(T,M),R), !,
erase(R),
'$rm_spy'(T,M),
functor(T,F,N),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
'$suspy2'(nospy,F,N,_,M) :-
'$suspy2'(nospy,T,M) :-
functor(T,F,N),
print_message(informational,breakp(no,breakpoint_for,M:F/N)).
'$pred_being_spied'(G, M) :-
@ -189,33 +185,30 @@ Sets spy-points on all the predicates represented by
_P_. _P_ can either be a single specification or a list of
specifications. Each one must be of the form _Name/Arity_
or _Name_. In the last case all predicates with the name
_Name_ will be spied. As in C-Prolog, system predicates and
predicates written in C, cannot be spied.
_Name_ will be spied.
*/
spy Spec :-
spy Spec :-
'$init_debugger',
prolog:debug_action_hook(spy(Spec)), !.
spy L :-
'$current_module'(M),
'$suspy'(L, spy, M), fail.
spy _ :- debug.
spy L :-
'$suspy'(L, spy), fail.
spy _ :- debug.
/** @pred nospy( + _P_ )
Removes spy-points from all predicates specified by _P_.
The possible forms for _P_ are the same as in `spy P`.
The possible forms for _P_ are the same as in spy/1.
*/
nospy Spec :-
nospy Spec :-
'$init_debugger',
prolog:debug_action_hook(nospy(Spec)), !.
nospy L :-
'$current_module'(M),
'$suspy'(L, nospy, M), fail.
nospy L :-
'$suspy'(L, nospy), fail.
nospy _.
/** @pred nospyall
@ -232,8 +225,11 @@ nospyall :-
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
nospyall.
% debug mode -> debug flag = 1
/** debug
Enters debug mode, meaning that it resets the state of the debugger and
enables the operation of spy-points and creeping.
*/
debug :-
'$init_debugger',
( nb_getval('$spy_gn',_) -> true ; nb_setval('$spy_gn',1) ),
@ -887,6 +883,10 @@ be lost.
'$is_metapredicate'(G, M), !,
'$meta_expansion'(G,M,M,M,G1,[]),
'$spycall_expanded'(G1, M, CalledFromDebugger, InRedo).
'$spycall'(G, M, _CalledFromDebugger, _InRedo) :-
'$undefined'(G, M), !,
'$current_module'(Mod),
'$undefp'([M|G], Mod).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo).

1
pl/flags.yap
View File

@ -598,6 +598,7 @@ yap_flag(V,Out) :-
;
'$swi_current_prolog_flag'(V, Current)
->
!,
(var(Out) ->
Current = Out
;

4
pl/init.yap
View File

@ -315,10 +315,10 @@ modules defining clauses for it too.
:- dynamic user:portray_message/2.
/** @pred exception(+ _Exception_, + _Context_, - _Action_)
/** @pred prolog:exception(+ _Exception_, + _Context_, - _Action_)
Dynamic predicate, normally not defined. Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1.
Dynamic predicate, originally defined in SWI-Prolog. The prolog:exception/3 dynamic predicate is Called by the Prolog system on run-time exceptions that can be repaired `just-in-time`. The values for _Exception_ are described below. See also catch/3 and throw/1.
If this hook predicate succeeds it must instantiate the _Action_ argument to the atom `fail` to make the operation fail silently, `retry` to tell Prolog to retry the operation or `error` to make the system generate an exception. The action `retry` only makes sense if this hook modified the environment such that the operation can now succeed without error.
+ `undefined_predicate`

8
pl/lists.yap
View File

@ -76,3 +76,11 @@ lists:delete([Head|List], Elem, [Head|Residue]) :-
:- '$set_yap_flags'(11,0). % disable source.
conjunctions:conj_member(X, Y) :-
var(Y), !,
X = Y.
conjunctions:conj_member(X, (C1,C2)) :-
conjunctions:conj_member(X, C1).
conjunctions:conj_member(X, (C1,C2)) :-
conjunctions:conj_member(X2, C1).
conjunctions:conj_member(X, X).

53
pl/preds.yap
View File

@ -1171,18 +1171,24 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
/** @pred current_predicate( _A_, _P_)
Defines the relation: _P_ is a currently defined predicate whose name is the atom _A_.
Defines the relation: _P_ is a currently defined predicate whose name
is the atom _A_. This includes all predicates defined
within the module and all predicates explicitely imported by the
module, but not the system predicates that are visible by default.
YAP does not use autoloader by default, so autoloaded predicates are not
included.
*/
current_predicate(A,T) :-
'$system_module'(M),
'$ground_module'(T, M, T0),
(
'$current_predicate'(A, M, T0, _)
strip_module(T, M, T0),
(
'$current_predicate'(A, M, T0, _)
;
'$imported_predicate'(A, M, A/_Arity, T0, _)
).
/** @pred system_predicate( _A_, _P_)
'$imported_predicate'(A, M, A/_Arity, T0, _)
).
/** @pred system_predicate( _A_, _P_)
Defines the relation: _P_ is a built-in predicate whose name
is the atom _A_.
@ -1209,19 +1215,30 @@ system_predicate(P) :-
@pred current_predicate( _F_) is iso
True if _F_ is the predicate indicator for a currently defined user or
library predicate.The indicator _F_ is of the form _Mod_:_Na_/_Ar_ or _Na/Ar_,
library predicate. The indicator _F_ is of the form _Mod_:_Na_/_Ar_ or _Na/Ar_,
where the atom _Mod_ is the module of the predicate,
_Na_ is the name of the predicate, and _Ar_ its arity.
_Na_ is the name of the predicate, and _Ar_ its arity.
Notice that this built-in differs from current_predicate/2 in that it also returns all system predicates, as they are available to every module.
*/
current_predicate(F0) :-
'$ground_module'(F0, M, F),
(
'$current_predicate'(N, M, S, _),
functor( S, N, Ar),
F = N/Ar
strip_module(F0, M, F),
F = A/Arity,
(
'$current_predicate'(A, M, T, _),
functor( T, A, Arity )
;
'$imported_predicate'(_Name, M, F, _S, _)
).
'$imported_predicate'(A, M, A/Arity, _T0, _)
;
M \= prolog,
'$current_predicate'(A, prolog, T, _),
functor( T, A, Arity )
;
M \= system,
'$current_predicate'(A, system, T, _),
functor( T, A, Arity )
).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),

29
pl/protect.yap
View File

@ -19,28 +19,23 @@
% This protects all code from further changes
% and also makes it impossible from some predicates to be seen
'$protect' :-
fail,
'$system_mod'( M ),
'$current_predicate'(_A, M, T0, Flags),
NFlags is Flags \/ 0x00004000,
'$flags'(M:T0, Flags, NFlags),
fail.
'$protect' :-
current_atom(Name),
atom_codes(Name,[0'$|_]),
% '$hide_predicates'(Name),
'$hide'(Name).
sub_atom(Name,0,1,_,'$'),
'$hide'(Name),
'$current_predicate'(Name, Mod, P, _Flags0),
'$hide_predicate'(P,Mod),
fail.
'$protect' :-
'$hide_predicates'(bootstrap),
'$hide'(bootstrap).
'$hide'(bootstrap),
'$hide_predicate'(bootstrap),
fail.
'$protect'.
'$hide_predicates'(Name) :-
'$current_predicate'(Name, Mod, P, _),
'$hide_predicate'(P,Mod),
fail.
'$hide_predicates'(_).
'$notrace_predicate'(Mod:P, Flags0) :-
Flags is Flags0 \/ 0x400000000,
'$flags'(P, Mod, Flags0, Flags ).
% hide all atoms who start by '$'
'$hide'('$VAR') :- !, fail. /* not $VAR */