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

support 64 bit flags in 32 bit mode

Browse Source
This commit is contained in:
Vitor Santos Costa
2015-01-14 04:51:54 -08:00
parent 0d5fff0f16
commit 3122d323b5
12 changed files with 322 additions and 339 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
C/absmi.c
View File

@@ -1238,7 +1238,7 @@ interrupt_dexecute( USES_REGS1 )
if (PP) UNLOCKPE(1,PP); if (PP) UNLOCKPE(1,PP);
PP = P->y_u.pp.p0; PP = P->y_u.pp.p0;
pe = P->y_u.pp.p; 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; return 2;
} }
/* set S for next instructions */ /* set S for next instructions */

233
C/cdmgr.c
View File

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

9
C/exec.c
View File

@@ -193,7 +193,7 @@ do_execute(Term t, Term mod USES_REGS)
Yap_get_signal( YAP_CREEP_SIGNAL ) ) { Yap_get_signal( YAP_CREEP_SIGNAL ) ) {
CalculateStackGap( PASS_REGS1 ); CalculateStackGap( PASS_REGS1 );
} }
return CallMetaCall(ARG1, mod PASS_REGS); return CallMetaCall(t, mod PASS_REGS);
} else if (Yap_has_a_signal() && } else if (Yap_has_a_signal() &&
!LOCAL_InterruptsDisabled && !LOCAL_InterruptsDisabled &&
!(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) { !(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) {
@@ -407,6 +407,13 @@ static Int
EnterCreepMode(Term t, Term mod USES_REGS) { EnterCreepMode(Term t, Term mod USES_REGS) {
PredEntry *PredCreep; 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 ) ) { if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) {
ARG1 = t; ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) { if (!Yap_locked_growheap(FALSE, 0, NULL)) {

2
C/heapgc.c
View File

@@ -4179,7 +4179,7 @@ p_inform_gc( USES_REGS1 )
{ {
Term tn = MkIntegerTerm(LOCAL_TotGcTime); Term tn = MkIntegerTerm(LOCAL_TotGcTime);
Term tt = MkIntegerTerm(LOCAL_GcCalls); 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)); return(Yap_unify(tn, ARG2) && Yap_unify(tt, ARG1) && Yap_unify(ts, ARG3));

11
C/qlyr.c
View File

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

148
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 GET_LD
char *sp = s; char *sp = s;
int ch = *chp; int ch = *chp;
Int val = 0L, base = ch - '0'; Int val = 0L;
int might_be_float = TRUE, has_overflow = FALSE; int base = ch-'0';
bool might_be_float = true, has_overflow = false;
const unsigned char *decimalpoint; const unsigned char *decimalpoint;
*sp++ = ch; *sp++ = ch;
ch = getchr(inp_stream); ch = getchr(inp_stream);
/* /*
* because of things like 00'2, 03'2 and even better 12'2, I need to * because of things like 00'2, 03'2 and even better 12'2, I need to
* do this (have mercy) * do this (have mercy)
@@ -852,104 +854,98 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
if (--max_size == 0) { if (--max_size == 0) {
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
base = 10 * base + ch - '0'; base = base*10+ ch - '0';
ch = getchr(inp_stream); 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) { if (base == 0) {
wchar_t ascii = ch; if (ch <= '9' && ch >= '0') {
int scan_extra = TRUE; *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 == '\\' && if (ch == '\\' &&
Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) { Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) {
ascii = read_quoted_char(&scan_extra, inp_stream);
}
/* a quick way to represent ASCII */ /* a quick way to represent ASCII */
if (scan_extra) ascii = read_quoted_char(&scan_extra, inp_stream);
*chp = getchr(inp_stream); } else {
ascii = ch;
}
ch = getchr(inp_stream);
*chp = ch;
if (sign == -1) { if (sign == -1) {
return MkIntegerTerm(-ascii); return MkIntegerTerm(-ascii);
} }
return MkIntegerTerm(ascii); return MkIntegerTerm(ascii);
} else if (base >= 10 && base <= 36) { } else {
int upper_case = 'A' - 11 + base; switch (ch) {
int lower_case = 'a' - 11 + base; case 'b':
base = 2;
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);
ch = getchr(inp_stream); ch = getchr(inp_stream);
} break;
} case 'o':
} else if (ch == 'x' && base == 0) {
might_be_float = FALSE;
if (--max_size == 0) {
return num_send_error_message("Number Too Long");
}
*sp++ = ch;
ch = getchr(inp_stream);
while (my_isxdigit(ch, 'F', 'f')) {
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 = 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; base = 8;
ch = getchr(inp_stream); ch = getchr(inp_stream);
} else if (ch == 'b' && base == 0) { break;
might_be_float = FALSE; case 'x':
base = 2; base = 16;
ch = getchr(inp_stream);
break;
default:
/* floating point */
base = 10;
}
}
} 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); ch = getchr(inp_stream);
} else { } else {
val = base; val = base;
base = 10; base = 10;
} }
while (chtype(ch) == NU) { }
if (base <= 10) {
// do this fast, it is most important */
while ( ch >= '0' && ch <= base+('0'- 1)) {
Int oval = val; Int oval = val;
if (!(val == 0 && ch == '0') || has_overflow) { 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) { if (--max_size == 0) {
return num_send_error_message("Number Too Long"); return num_send_error_message("Number Too Long");
} }
*sp++ = ch;
}
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); ch = getchr(inp_stream);
} }
} else {
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");
}
ch = getchr(inp_stream);
}
}
if (might_be_float && ( ch == '.' || ch == 'e' || ch == 'E')) { if (might_be_float && ( ch == '.' || ch == 'e' || ch == 'E')) {
int has_dot = ( ch == '.' ); int has_dot = ( ch == '.' );
if (has_dot) { if (has_dot) {
@@ -1028,7 +1024,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
*sp = '\0'; *sp = '\0';
/* skip base */ /* skip base */
*chp = ch; *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); return read_int_overflow(s+2,16,val,sign);
else if (s[0] == '0' && s[1] == 'o') else if (s[0] == '0' && s[1] == 'o')
return read_int_overflow(s+2,8,val,sign); 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 #if THREADS
uint64_t old; 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 ); CalculateStackGap( PASS_REGS1 );
// reset the flag // reset the flag
if ( (old =__sync_fetch_and_and( &LOCAL_Signals, ~SIGNAL_TO_BIT(sig) ) ) != if ( (old =__sync_fetch_and_and( &LOCAL_Signals, ~SIGNAL_TO_BIT(sig) ) ) !=

88
C/stdpreds.c
View File

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

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_EraseMegaClause(yamop *,struct pred_entry *);
void Yap_ResetConsultStack(void); void Yap_ResetConsultStack(void);
void Yap_AssertzClause(struct pred_entry *, yamop *); 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); 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 */ /* cmppreds.c */
Int Yap_compare_terms(Term,Term); Int Yap_compare_terms(Term,Term);

64
H/Yatom.h
View File

@@ -651,39 +651,39 @@ IsValProperty (int flags)
don't forget to also add in qly.h 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 DiscontiguousPredFlag ((pred_flags_t)0x1000000000LL) /* predicates whose clauses may be all-over the place.. */
#define SysExportPredFlag ((pred_flags_t)0x800000000) #define SysExportPredFlag ((pred_flags_t)0x800000000LL)
/* reuse export list to prolog module. */ /* reuse export list to prolog module. */
#define NoTracePredFlag ((pred_flags_t)0x400000000) /* cannot trace this predicate */ #define NoTracePredFlag ((pred_flags_t)0x400000000LL) /* cannot trace this predicate */
#define NoSpyPredFlag ((pred_flags_t)0x200000000) /* cannot spy this predicate */ #define NoSpyPredFlag ((pred_flags_t)0x200000000LL) /* cannot spy this predicate */
#define QuasiQuotationPredFlag ((pred_flags_t)0x100000000) /* SWI-like quasi quotations */ #define QuasiQuotationPredFlag ((pred_flags_t)0x100000000LL) /* SWI-like quasi quotations */
#define MegaClausePredFlag ((pred_flags_t)0x80000000) /* predicate is implemented as a mega-clause */ #define MegaClausePredFlag ((pred_flags_t)0x80000000LL) /* predicate is implemented as a mega-clause */
#define ThreadLocalPredFlag ((pred_flags_t)0x40000000) /* local to a thread */ #define ThreadLocalPredFlag ((pred_flags_t)0x40000000LL) /* local to a thread */
#define MultiFileFlag ((pred_flags_t)0x20000000) /* is multi-file */ #define MultiFileFlag ((pred_flags_t)0x20000000LL) /* is multi-file */
#define UserCPredFlag ((pred_flags_t)0x10000000) /* CPred defined by the user */ #define UserCPredFlag ((pred_flags_t)0x10000000LL) /* CPred defined by the user */
#define LogUpdatePredFlag ((pred_flags_t)0x08000000) /* dynamic predicate with log. upd. sem. */ #define LogUpdatePredFlag ((pred_flags_t)0x08000000LL) /* dynamic predicate with log. upd. sem. */
#define InUsePredFlag ((pred_flags_t)0x04000000) /* count calls to pred */ #define InUsePredFlag ((pred_flags_t)0x04000000LL) /* count calls to pred */
#define CountPredFlag ((pred_flags_t)0x02000000) /* count calls to pred */ #define CountPredFlag ((pred_flags_t)0x02000000LL) /* count calls to pred */
#define HiddenPredFlag ((pred_flags_t)0x01000000) /* invisible predicate */ #define HiddenPredFlag ((pred_flags_t)0x01000000LL) /* invisible predicate */
#define CArgsPredFlag ((pred_flags_t)0x00800000) /* SWI-like C-interface pred. */ #define CArgsPredFlag ((pred_flags_t)0x00800000LL) /* SWI-like C-interface pred. */
#define SourcePredFlag ((pred_flags_t)0x00400000) /* static predicate with source declaration */ #define SourcePredFlag ((pred_flags_t)0x00400000LL) /* static predicate with source declaration */
#define MetaPredFlag ((pred_flags_t)0x00200000) /* predicate subject to a meta declaration */ #define MetaPredFlag ((pred_flags_t)0x00200000LL) /* predicate subject to a meta declaration */
#define SyncPredFlag ((pred_flags_t)0x00100000) /* has to synch before it can execute */ #define SyncPredFlag ((pred_flags_t)0x00100000LL) /* has to synch before it can execute */
#define NumberDBPredFlag ((pred_flags_t)0x00080000) /* entry for a number key */ #define NumberDBPredFlag ((pred_flags_t)0x00080000LL) /* entry for a number key */
#define AtomDBPredFlag ((pred_flags_t)0x00040000) /* entry for an atom key */ #define AtomDBPredFlag ((pred_flags_t)0x00040000LL) /* entry for an atom key */
#define GoalExPredFlag ((pred_flags_t)0x00020000) /* predicate that is called by goal_expand */ #define GoalExPredFlag ((pred_flags_t)0x00020000LL) /* predicate that is called by goal_expand */
#define TestPredFlag ((pred_flags_t)0x00010000) /* is a test (optim. comit) */ #define TestPredFlag ((pred_flags_t)0x00010000LL) /* is a test (optim. comit) */
#define AsmPredFlag ((pred_flags_t)0x00008000) /* inline */ #define AsmPredFlag ((pred_flags_t)0x00008000LL) /* inline */
#define StandardPredFlag ((pred_flags_t)0x00004000) /* system predicate */ #define StandardPredFlag ((pred_flags_t)0x00004000LL) /* system predicate */
#define DynamicPredFlag ((pred_flags_t)0x00002000) /* dynamic predicate */ #define DynamicPredFlag ((pred_flags_t)0x00002000LL) /* dynamic predicate */
#define CPredFlag ((pred_flags_t)0x00001000) /* written in C */ #define CPredFlag ((pred_flags_t)0x00001000LL) /* written in C */
#define SafePredFlag ((pred_flags_t)0x00000800) /* does not alter arguments */ #define SafePredFlag ((pred_flags_t)0x00000800LL) /* does not alter arguments */
#define CompiledPredFlag ((pred_flags_t)0x00000400) /* is static */ #define CompiledPredFlag ((pred_flags_t)0x00000400LL) /* is static */
#define IndexedPredFlag ((pred_flags_t)0x00000200) /* has indexing code */ #define IndexedPredFlag ((pred_flags_t)0x00000200LL) /* has indexing code */
#define SpiedPredFlag ((pred_flags_t)0x00000100) /* is a spy point */ #define SpiedPredFlag ((pred_flags_t)0x00000100LL) /* is a spy point */
#define BinaryPredFlag ((pred_flags_t)0x00000080) /* test predicate */ #define BinaryPredFlag ((pred_flags_t)0x00000080LL) /* test predicate */
#define TabledPredFlag ((pred_flags_t)0x00000040) /* is tabled */ #define TabledPredFlag ((pred_flags_t)0x00000040LL) /* is tabled */
#define SequentialPredFlag ((pred_flags_t)0x00000020) /* may not create parallel choice points! */ #define SequentialPredFlag ((pred_flags_t)0x00000020LL) /* may not create parallel choice points! */
#define ProfiledPredFlag ((pred_flags_t)0x00000010) /* pred is being profiled */ #define ProfiledPredFlag ((pred_flags_t)0x00000010) /* pred is being profiled */
#define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred */ #define BackCPredFlag ((pred_flags_t)0x00000008) /* Myddas Imported pred */
#define ModuleTransparentPredFlag ((pred_flags_t)0x00000004) /* ModuleTransparent pred */ #define ModuleTransparentPredFlag ((pred_flags_t)0x00000004) /* ModuleTransparent pred */

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_int_big(Int,Term);
Term Yap_gmp_gcd_big_big(Term,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_big(Float);
Term Yap_gmp_float_to_rational(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); void Yap_gmp_set_bit(Int i, Term t);
#endif #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 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) { if (i <= Int_MAX && i >= Int_MIN) {
return MkIntegerTerm((Int)i); 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 */ #if __clang__ && FALSE /* not in OSX yet */
#define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; } #define DO_ADD() if (__builtin_sadd_overflow( i1, i2, & z ) ) { goto overflow; }

2
H/qly.h
View File

@@ -101,7 +101,7 @@ typedef enum {
QLY_ATOM_BLOB = 17 QLY_ATOM_BLOB = 17
} qlf_tag_t; } 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 (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|HiddenPredFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|SYSTEM_PRED_FLAGS)
#define EXTRA_PRED_FLAGS (QuasiQuotationPredFlag|NoTracePredFlag|NoSpyPredFlag) #define EXTRA_PRED_FLAGS (QuasiQuotationPredFlag|NoTracePredFlag|NoSpyPredFlag)
#define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag) #define SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)