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
Show Stats 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);
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 */

277
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);
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;
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)) {

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

11
C/qlyr.c
View File

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

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

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

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; }

2
H/qly.h
View File

@ -101,7 +101,7 @@ 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 (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 SYSTEM_PRED_FLAGS (BackCPredFlag|UserCPredFlag|CArgsPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)