varia
This commit is contained in:
parent
ca7d66a791
commit
d942b55dc4
448
C/cdmgr.c
448
C/cdmgr.c
@ -57,6 +57,8 @@ static Int p_endconsult(USES_REGS1);
|
|||||||
static Int p_undefined(USES_REGS1);
|
static Int p_undefined(USES_REGS1);
|
||||||
static Int p_new_multifile(USES_REGS1);
|
static Int p_new_multifile(USES_REGS1);
|
||||||
static Int p_is_multifile(USES_REGS1);
|
static Int p_is_multifile(USES_REGS1);
|
||||||
|
static Int p_new_multifile(USES_REGS1);
|
||||||
|
static Int p_is_multifile(USES_REGS1);
|
||||||
static Int p_optimizer_on(USES_REGS1);
|
static Int p_optimizer_on(USES_REGS1);
|
||||||
static Int p_optimizer_off(USES_REGS1);
|
static Int p_optimizer_off(USES_REGS1);
|
||||||
static Int p_is_dynamic(USES_REGS1);
|
static Int p_is_dynamic(USES_REGS1);
|
||||||
@ -108,13 +110,6 @@ void Yap_ResetConsultStack(void) {
|
|||||||
* supportted for fast predicates
|
* supportted for fast predicates
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag)
|
|
||||||
#define is_static(pe) (pe->PredFlags & CompiledPredFlag)
|
|
||||||
#define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag)
|
|
||||||
#ifdef TABLING
|
|
||||||
#define is_tabled(pe) (pe->PredFlags & TabledPredFlag)
|
|
||||||
#endif /* TABLING */
|
|
||||||
|
|
||||||
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
|
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
|
||||||
Term t0 = t;
|
Term t0 = t;
|
||||||
|
|
||||||
@ -984,7 +979,7 @@ static void retract_all(PredEntry *p, int in_use) {
|
|||||||
p->OpcodeOfPred = UNDEF_OPCODE;
|
p->OpcodeOfPred = UNDEF_OPCODE;
|
||||||
}
|
}
|
||||||
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||||
if (PROFILING) {
|
if (trueGlobalPrologFlag(PROFILING_FLAG)) {
|
||||||
p->PredFlags |= ProfiledPredFlag;
|
p->PredFlags |= ProfiledPredFlag;
|
||||||
} else
|
} else
|
||||||
p->PredFlags &= ~ProfiledPredFlag;
|
p->PredFlags &= ~ProfiledPredFlag;
|
||||||
@ -995,8 +990,7 @@ static void retract_all(PredEntry *p, int in_use) {
|
|||||||
Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue));
|
Yap_PutValue(AtomAbol, MkAtomTerm(AtomTrue));
|
||||||
}
|
}
|
||||||
|
|
||||||
bool Yap_unknown( Term t )
|
bool Yap_unknown(Term t) {
|
||||||
{
|
|
||||||
|
|
||||||
if (t == TermFastFail) {
|
if (t == TermFastFail) {
|
||||||
UndefCode->OpcodeOfPred = FAIL_OPCODE;
|
UndefCode->OpcodeOfPred = FAIL_OPCODE;
|
||||||
@ -1034,8 +1028,7 @@ static void add_first_static(PredEntry *p, yamop *cp, int spy_flag) {
|
|||||||
#ifdef TABLING
|
#ifdef TABLING
|
||||||
if (is_tabled(p)) {
|
if (is_tabled(p)) {
|
||||||
p->OpcodeOfPred = INDEX_OPCODE;
|
p->OpcodeOfPred = INDEX_OPCODE;
|
||||||
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred =
|
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
|
||||||
(yamop *)(&(p->OpcodeOfPred));
|
|
||||||
}
|
}
|
||||||
#endif /* TABLING */
|
#endif /* TABLING */
|
||||||
p->cs.p_code.TrueCodeOfPred = pt;
|
p->cs.p_code.TrueCodeOfPred = pt;
|
||||||
@ -1050,7 +1043,7 @@ static void add_first_static(PredEntry *p, yamop *cp, int spy_flag) {
|
|||||||
#endif
|
#endif
|
||||||
p->CodeOfPred = pt;
|
p->CodeOfPred = pt;
|
||||||
p->cs.p_code.NOfClauses = 1;
|
p->cs.p_code.NOfClauses = 1;
|
||||||
if (PROFILING) {
|
if (trueGlobalPrologFlag(PROFILING_FLAG)) {
|
||||||
p->PredFlags |= ProfiledPredFlag;
|
p->PredFlags |= ProfiledPredFlag;
|
||||||
spy_flag = TRUE;
|
spy_flag = TRUE;
|
||||||
} else {
|
} else {
|
||||||
@ -1075,19 +1068,18 @@ static void add_first_static(PredEntry *p, yamop *cp, int spy_flag) {
|
|||||||
|
|
||||||
/* p is already locked */
|
/* p is already locked */
|
||||||
static void add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) {
|
static void add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) {
|
||||||
CACHE_REGS
|
|
||||||
yamop *ncp = ((DynamicClause *)NULL)->ClCode;
|
yamop *ncp = ((DynamicClause *)NULL)->ClCode;
|
||||||
DynamicClause *cl;
|
DynamicClause *cl;
|
||||||
|
|
||||||
if (PROFILING) {
|
if (trueGlobalPrologFlag(PROFILING_FLAG)) {
|
||||||
p->PredFlags |= ProfiledPredFlag;
|
p->PredFlags |= ProfiledPredFlag;
|
||||||
spy_flag = TRUE;
|
spy_flag = true;
|
||||||
} else {
|
} else {
|
||||||
p->PredFlags &= ~ProfiledPredFlag;
|
p->PredFlags &= ~ProfiledPredFlag;
|
||||||
}
|
}
|
||||||
if (CALL_COUNTING) {
|
if (CALL_COUNTING) {
|
||||||
p->PredFlags |= CountPredFlag;
|
p->PredFlags |= CountPredFlag;
|
||||||
spy_flag = TRUE;
|
spy_flag = true;
|
||||||
} else {
|
} else {
|
||||||
p->PredFlags &= ~CountPredFlag;
|
p->PredFlags &= ~CountPredFlag;
|
||||||
}
|
}
|
||||||
@ -1159,7 +1151,7 @@ static void add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) {
|
|||||||
ncp = NEXTOP(ncp, e);
|
ncp = NEXTOP(ncp, e);
|
||||||
ncp->opc = Yap_opcode(_Ystop);
|
ncp->opc = Yap_opcode(_Ystop);
|
||||||
ncp->y_u.l.l = cl->ClCode;
|
ncp->y_u.l.l = cl->ClCode;
|
||||||
//if (!(p->PredFlags & MultiFileFlag) && p->src.OwnerFile == AtomNil)
|
// if (!(p->PredFlags & MultiFileFlag) && p->src.OwnerFile == AtomNil)
|
||||||
// p->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
|
// p->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1379,7 +1371,7 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
|
|||||||
// if (p->ArityOfPE)
|
// if (p->ArityOfPE)
|
||||||
// printf("+ %s %s
|
// printf("+ %s %s
|
||||||
//%d\n",NameOfFunctor(p->FunctorOfPred)->StrOfAE,p->src.OwnerFile->StrOfAE,
|
//%d\n",NameOfFunctor(p->FunctorOfPred)->StrOfAE,p->src.OwnerFile->StrOfAE,
|
||||||
//p->cs.p_code.NOfClauses);
|
// p->cs.p_code.NOfClauses);
|
||||||
retract_all(p, Yap_static_in_use(p, TRUE));
|
retract_all(p, Yap_static_in_use(p, TRUE));
|
||||||
}
|
}
|
||||||
// printf("- %s
|
// printf("- %s
|
||||||
@ -1395,7 +1387,7 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
|
|||||||
!(p->PredFlags & MultiFileFlag)) /* we are in reconsult mode */ {
|
!(p->PredFlags & MultiFileFlag)) /* we are in reconsult mode */ {
|
||||||
retract_all(p, Yap_static_in_use(p, TRUE));
|
retract_all(p, Yap_static_in_use(p, TRUE));
|
||||||
}
|
}
|
||||||
//p->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
|
// p->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
|
||||||
}
|
}
|
||||||
LOCAL_LastAssertedPred = p;
|
LOCAL_LastAssertedPred = p;
|
||||||
return TRUE; /* careful */
|
return TRUE; /* careful */
|
||||||
@ -1470,10 +1462,12 @@ PredEntry *Yap_PredFromClause(Term t USES_REGS) {
|
|||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool Yap_discontiguous(PredEntry *ap USES_REGS) {
|
bool Yap_discontiguous(PredEntry *ap, Term mode USES_REGS) {
|
||||||
register consult_obj *fp;
|
register consult_obj *fp;
|
||||||
|
|
||||||
if (ap->PredFlags & (DiscontiguousPredFlag | MultiFileFlag))
|
if (ap->PredFlags & (DiscontiguousPredFlag))
|
||||||
|
return false;
|
||||||
|
if (mode != TermConsult && mode != TermReconsult)
|
||||||
return false;
|
return false;
|
||||||
if (!LOCAL_ConsultSp) {
|
if (!LOCAL_ConsultSp) {
|
||||||
return false;
|
return false;
|
||||||
@ -1488,11 +1482,59 @@ bool Yap_discontiguous(PredEntry *ap USES_REGS) {
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Int p_is_discontiguous(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
|
||||||
|
PredEntry *pe;
|
||||||
|
Int out;
|
||||||
|
|
||||||
|
pe = get_pred(Deref(ARG1), Deref(ARG2), "discontiguous");
|
||||||
|
if (EndOfPAEntr(pe))
|
||||||
|
return FALSE;
|
||||||
|
PELOCK(27, pe);
|
||||||
|
out = (pe->PredFlags & DiscontiguousPredFlag);
|
||||||
|
UNLOCKPE(44, pe);
|
||||||
|
return (out);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_new_discontiguous(USES_REGS1) { /* '$new_discontiguous'(+N,+Ar,+Mod) */
|
||||||
|
Atom at;
|
||||||
|
int arity;
|
||||||
|
PredEntry *pe;
|
||||||
|
Term t = Deref(ARG1);
|
||||||
|
Term mod = Deref(ARG3);
|
||||||
|
|
||||||
|
if (IsVarTerm(t))
|
||||||
|
return (FALSE);
|
||||||
|
if (IsAtomTerm(t))
|
||||||
|
at = AtomOfTerm(t);
|
||||||
|
else
|
||||||
|
return (FALSE);
|
||||||
|
t = Deref(ARG2);
|
||||||
|
if (IsVarTerm(t))
|
||||||
|
return (FALSE);
|
||||||
|
if (IsIntTerm(t))
|
||||||
|
arity = IntOfTerm(t);
|
||||||
|
else
|
||||||
|
return FALSE;
|
||||||
|
if (arity == 0)
|
||||||
|
pe = RepPredProp(PredPropByAtom(at, mod));
|
||||||
|
else
|
||||||
|
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity), mod));
|
||||||
|
PELOCK(26, pe);
|
||||||
|
pe->PredFlags |= DiscontiguousPredFlag;
|
||||||
|
/* mutifile-predicates are weird, they do not seat really on the default
|
||||||
|
* module */
|
||||||
|
if (pe->ModuleOfPred == PROLOG_MODULE)
|
||||||
|
pe->ModuleOfPred = TermProlog;
|
||||||
|
UNLOCKPE(43, pe);
|
||||||
|
return (TRUE);
|
||||||
|
}
|
||||||
|
|
||||||
bool Yap_multiple(PredEntry *ap, int mode USES_REGS) {
|
bool Yap_multiple(PredEntry *ap, int mode USES_REGS) {
|
||||||
register consult_obj *fp;
|
register consult_obj *fp;
|
||||||
|
|
||||||
if ((ap->PredFlags & (MultiFileFlag | LogUpdatePredFlag | DynamicPredFlag)) ||
|
if ((ap->PredFlags & (MultiFileFlag | LogUpdatePredFlag | DynamicPredFlag)) ||
|
||||||
mode == TermConsult)
|
mode != TermReconsult)
|
||||||
return false;
|
return false;
|
||||||
if (LOCAL_consult_level == 0)
|
if (LOCAL_consult_level == 0)
|
||||||
return false;
|
return false;
|
||||||
@ -1535,25 +1577,25 @@ Atom Yap_source_file_name(void) {
|
|||||||
*
|
*
|
||||||
* @return boolean
|
* @return boolean
|
||||||
*/
|
*/
|
||||||
bool Yap_constPred( PredEntry *p)
|
bool Yap_constPred(PredEntry *p) {
|
||||||
{
|
|
||||||
pred_flags_t pflags;
|
pred_flags_t pflags;
|
||||||
pflags = p->PredFlags;
|
pflags = p->PredFlags;
|
||||||
|
|
||||||
|
if (pflags &
|
||||||
if (pflags & ((UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
|
((UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
|
||||||
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag) ) )
|
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)))
|
||||||
return true;
|
return true;
|
||||||
|
|
||||||
if (p->PredFlags & (SysExportPredFlag|MultiFileFlag|DynamicPredFlag))
|
if (p->PredFlags &
|
||||||
|
(SysExportPredFlag | MultiFileFlag | DynamicPredFlag | LogUpdatePredFlag))
|
||||||
return false;
|
return false;
|
||||||
|
|
||||||
if (Yap_isSystemModule(p->ModuleOfPred)){
|
if (Yap_isSystemModule(p->ModuleOfPred)) {
|
||||||
if (p->cs.p_code.NOfClauses == 0) {
|
if (p->cs.p_code.NOfClauses == 0) {
|
||||||
p->src.OwnerFile = LOCAL_SourceFileName;
|
p->src.OwnerFile = Yap_source_file_name();
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
if ( p->src.OwnerFile == LOCAL_SourceFileName ) {
|
if (p->src.OwnerFile == Yap_source_file_name()) {
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1562,7 +1604,7 @@ Atom Yap_source_file_name(void) {
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
static bool addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
||||||
/*
|
/*
|
||||||
*
|
*
|
||||||
mode
|
mode
|
||||||
@ -1599,7 +1641,7 @@ static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
|||||||
if (Yap_constPred(p)) {
|
if (Yap_constPred(p)) {
|
||||||
addcl_permission_error(RepAtom(at), Arity, FALSE);
|
addcl_permission_error(RepAtom(at), Arity, FALSE);
|
||||||
UNLOCKPE(30, p);
|
UNLOCKPE(30, p);
|
||||||
return TermNil;
|
return false;
|
||||||
}
|
}
|
||||||
pflags = p->PredFlags;
|
pflags = p->PredFlags;
|
||||||
/* we are redefining a prolog module predicate */
|
/* we are redefining a prolog module predicate */
|
||||||
@ -1613,9 +1655,8 @@ static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
|||||||
Yap_AddClauseToIndex(p, cp, mode == asserta);
|
Yap_AddClauseToIndex(p, cp, mode == asserta);
|
||||||
}
|
}
|
||||||
if (pflags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag))
|
if (pflags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag))
|
||||||
spy_flag = TRUE;
|
spy_flag = true;
|
||||||
if (mode == consult &&
|
if (Yap_discontiguous(p, mode PASS_REGS)) {
|
||||||
Yap_discontiguous(p PASS_REGS)) {
|
|
||||||
Term disc[3], sc[4];
|
Term disc[3], sc[4];
|
||||||
if (p->ArityOfPE) {
|
if (p->ArityOfPE) {
|
||||||
disc[0] = MkAtomTerm(NameOfFunctor(p->FunctorOfPred));
|
disc[0] = MkAtomTerm(NameOfFunctor(p->FunctorOfPred));
|
||||||
@ -1631,7 +1672,7 @@ static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
|||||||
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
|
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
|
||||||
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
|
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
|
||||||
sc[1] = MkAtomTerm(AtomWarning);
|
sc[1] = MkAtomTerm(AtomWarning);
|
||||||
Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError,2), 2, sc));
|
Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError, 2), 2, sc));
|
||||||
} else if (Yap_multiple(p, mode PASS_REGS)) {
|
} else if (Yap_multiple(p, mode PASS_REGS)) {
|
||||||
Term disc[4], sc[4];
|
Term disc[4], sc[4];
|
||||||
if (p->ArityOfPE) {
|
if (p->ArityOfPE) {
|
||||||
@ -1649,15 +1690,15 @@ static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
|||||||
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
|
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
|
||||||
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
|
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
|
||||||
sc[1] = MkAtomTerm(AtomWarning);
|
sc[1] = MkAtomTerm(AtomWarning);
|
||||||
Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError,2), 2, sc));
|
Yap_PrintWarning(Yap_MkApplTerm(Yap_MkFunctor(AtomError, 2), 2, sc));
|
||||||
}
|
}
|
||||||
if (mode == consult)
|
if (mode == consult)
|
||||||
not_was_reconsulted(p, t, TRUE);
|
not_was_reconsulted(p, t, true);
|
||||||
/* always check if we have a valid error first */
|
/* always check if we have a valid error first */
|
||||||
if (LOCAL_ErrorMessage &&
|
if (LOCAL_ErrorMessage &&
|
||||||
LOCAL_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE) {
|
LOCAL_Error_TYPE == PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE) {
|
||||||
UNLOCKPE(31, p);
|
UNLOCKPE(31, p);
|
||||||
return TermNil;
|
return false;
|
||||||
}
|
}
|
||||||
if (pflags & UDIPredFlag) {
|
if (pflags & UDIPredFlag) {
|
||||||
Yap_new_udi_clause(p, cp, t);
|
Yap_new_udi_clause(p, cp, t);
|
||||||
@ -1742,11 +1783,13 @@ static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
|||||||
} else {
|
} else {
|
||||||
tf = Yap_MkStaticRefTerm(ClauseCodeToStaticClause(cp), p);
|
tf = Yap_MkStaticRefTerm(ClauseCodeToStaticClause(cp), p);
|
||||||
}
|
}
|
||||||
if (*t4ref != TermNil) {
|
if (t4ref && *t4ref != TermNil) {
|
||||||
if (!Yap_unify(*t4ref, tf)) {
|
if (!Yap_unify(*t4ref, tf)) {
|
||||||
return FALSE;
|
return false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
if (mod == PROLOG_MODULE)
|
||||||
|
mod = TermProlog;
|
||||||
if (pflags & MultiFileFlag) {
|
if (pflags & MultiFileFlag) {
|
||||||
/* add Info on new clause for multifile predicates to the DB */
|
/* add Info on new clause for multifile predicates to the DB */
|
||||||
Term t[5], tn;
|
Term t[5], tn;
|
||||||
@ -1758,10 +1801,10 @@ static int addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
|
|||||||
tn = Yap_MkApplTerm(FunctorMultiFileClause, 5, t);
|
tn = Yap_MkApplTerm(FunctorMultiFileClause, 5, t);
|
||||||
Yap_Recordz(AtomMultiFile, tn);
|
Yap_Recordz(AtomMultiFile, tn);
|
||||||
}
|
}
|
||||||
return TRUE;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
int Yap_addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) {
|
bool Yap_addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) {
|
||||||
return addclause(t, cp, mode, mod, t4ref);
|
return addclause(t, cp, mode, mod, t4ref);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1808,7 +1851,7 @@ void Yap_EraseStaticClause(StaticClause *cl, PredEntry *ap, Term mod) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (ap->cs.p_code.NOfClauses == 1) {
|
if (ap->cs.p_code.NOfClauses == 1) {
|
||||||
assert( ap->cs.p_code.FirstClause );
|
assert(ap->cs.p_code.FirstClause);
|
||||||
ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
|
ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
|
||||||
ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc;
|
ap->OpcodeOfPred = ap->cs.p_code.TrueCodeOfPred->opc;
|
||||||
}
|
}
|
||||||
@ -1878,13 +1921,12 @@ void Yap_add_logupd_clause(PredEntry *pe, LogUpdClause *cl, int mode) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
|
||||||
p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
|
|
||||||
Term t = Deref(ARG1);
|
Term t = Deref(ARG1);
|
||||||
Term t1 = Deref(ARG2);
|
Term t1 = Deref(ARG2);
|
||||||
Term mod = Deref(ARG4);
|
Term mod = Deref(ARG4);
|
||||||
yamop *code_adr;
|
yamop *code_adr;
|
||||||
int old_optimize, mode;
|
int mode;
|
||||||
|
|
||||||
if (IsVarTerm(t1) || !IsAtomicTerm(t1))
|
if (IsVarTerm(t1) || !IsAtomicTerm(t1))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
@ -1907,15 +1949,12 @@ static Int
|
|||||||
if (mode == assertz && LOCAL_consult_level && mod == CurrentModule)
|
if (mode == assertz && LOCAL_consult_level && mod == CurrentModule)
|
||||||
mode = consult;
|
mode = consult;
|
||||||
*/
|
*/
|
||||||
old_optimize = optimizer_on;
|
|
||||||
YAPEnterCriticalSection();
|
|
||||||
code_adr = Yap_cclause(t, 5, mod,
|
code_adr = Yap_cclause(t, 5, mod,
|
||||||
Deref(ARG3)); /* vsc: give the number of arguments to
|
Deref(ARG3)); /* vsc: give the number of arguments to
|
||||||
cclause() in case there is a overflow */
|
cclause() in case there is a overflow */
|
||||||
t = Deref(ARG1); /* just in case there was an heap overflow */
|
t = Deref(ARG1); /* just in case there was an heap overflow */
|
||||||
if (!LOCAL_ErrorMessage) {
|
if (!LOCAL_ErrorMessage) {
|
||||||
|
|
||||||
optimizer_on = old_optimize;
|
|
||||||
addclause(t, code_adr, mode, mod, &ARG5);
|
addclause(t, code_adr, mode, mod, &ARG5);
|
||||||
}
|
}
|
||||||
if (LOCAL_ErrorMessage) {
|
if (LOCAL_ErrorMessage) {
|
||||||
@ -1923,7 +1962,7 @@ static Int
|
|||||||
LOCAL_Error_Term = TermNil;
|
LOCAL_Error_Term = TermNil;
|
||||||
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
||||||
YAPLeaveCriticalSection();
|
YAPLeaveCriticalSection();
|
||||||
return FALSE;
|
return false;
|
||||||
}
|
}
|
||||||
YAPLeaveCriticalSection();
|
YAPLeaveCriticalSection();
|
||||||
return true;
|
return true;
|
||||||
@ -2315,10 +2354,9 @@ static Int p_new_multifile(USES_REGS1) { /* '$new_multifile'(+N,+Ar,+Mod) */
|
|||||||
else
|
else
|
||||||
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity), mod));
|
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity), mod));
|
||||||
PELOCK(26, pe);
|
PELOCK(26, pe);
|
||||||
if (pe->PredFlags & (UserCPredFlag | CArgsPredFlag |
|
if (pe->PredFlags &
|
||||||
NumberDBPredFlag | AtomDBPredFlag |
|
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
|
||||||
TestPredFlag | AsmPredFlag |
|
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
|
||||||
CPredFlag | BinaryPredFlag)) {
|
|
||||||
UNLOCKPE(26, pe);
|
UNLOCKPE(26, pe);
|
||||||
addcl_permission_error(RepAtom(at), arity, FALSE);
|
addcl_permission_error(RepAtom(at), arity, FALSE);
|
||||||
return false;
|
return false;
|
||||||
@ -2359,8 +2397,8 @@ static Int p_is_multifile(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
|
|||||||
return (out);
|
return (out);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int p_new_system_predicate(
|
||||||
p_new_discontiguous(USES_REGS1) { /* '$new_discontiguous'(+N,+Ar,+Mod) */
|
USES_REGS1) { /* '$new_system_predicate'(+N,+Ar,+Mod) */
|
||||||
Atom at;
|
Atom at;
|
||||||
arity_t arity;
|
arity_t arity;
|
||||||
PredEntry *pe;
|
PredEntry *pe;
|
||||||
@ -2385,24 +2423,25 @@ static Int
|
|||||||
else
|
else
|
||||||
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity), mod));
|
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity), mod));
|
||||||
PELOCK(26, pe);
|
PELOCK(26, pe);
|
||||||
pe->PredFlags |= DiscontiguousPredFlag;
|
if (pe->PredFlags & (LogUpdatePredFlag | DynamicPredFlag | MultiFileFlag)) {
|
||||||
/* mutifile-predicates are weird, they do not seat really on the default
|
UNLOCKPE(43, pe);
|
||||||
* module */
|
return false;
|
||||||
if (pe->ModuleOfPred == PROLOG_MODULE)
|
}
|
||||||
pe->ModuleOfPred = TermProlog;
|
pe->PredFlags |= StandardPredFlag;
|
||||||
UNLOCKPE(43, pe);
|
UNLOCKPE(43, pe);
|
||||||
return (TRUE);
|
return (TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int p_is_discontiguous(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
|
static Int
|
||||||
|
p_is_system_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
|
||||||
PredEntry *pe;
|
PredEntry *pe;
|
||||||
bool out;
|
bool out;
|
||||||
|
|
||||||
pe = get_pred(Deref(ARG1), Deref(ARG2), "discontiguous");
|
pe = get_pred(Deref(ARG1), Deref(ARG2), "system_predicate");
|
||||||
if (EndOfPAEntr(pe))
|
if (EndOfPAEntr(pe))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
PELOCK(27, pe);
|
PELOCK(27, pe);
|
||||||
out = (pe->PredFlags & DiscontiguousPredFlag);
|
out = (pe->PredFlags & SystemPredFlags);
|
||||||
UNLOCKPE(44, pe);
|
UNLOCKPE(44, pe);
|
||||||
return (out);
|
return (out);
|
||||||
}
|
}
|
||||||
@ -2439,11 +2478,16 @@ static Int p_is_source(USES_REGS1) { /* '$is_dynamic'(+P) */
|
|||||||
|
|
||||||
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
|
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
|
||||||
if (EndOfPAEntr(pe))
|
if (EndOfPAEntr(pe))
|
||||||
return FALSE;
|
return false;
|
||||||
PELOCK(28, pe);
|
PELOCK(28, pe);
|
||||||
out = (pe->PredFlags & SourcePredFlag);
|
if (pe->PredFlags & SystemPredFlags) {
|
||||||
UNLOCKPE(46, pe);
|
UNLOCKPE(46, pe);
|
||||||
return (out);
|
return false;
|
||||||
|
}
|
||||||
|
out = (pe->PredFlags & (SourcePredFlag | LogUpdatePredFlag |
|
||||||
|
MegaClausePredFlag | DynamicPredFlag));
|
||||||
|
UNLOCKPE(46, pe);
|
||||||
|
return out;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int p_is_exo(USES_REGS1) { /* '$is_dynamic'(+P) */
|
static Int p_is_exo(USES_REGS1) { /* '$is_dynamic'(+P) */
|
||||||
@ -2554,11 +2598,11 @@ static Int p_pred_exists(USES_REGS1) { /* '$pred_exists'(+P,+M) */
|
|||||||
|
|
||||||
pe = get_pred(Deref(ARG1), Deref(ARG2), "$exists");
|
pe = get_pred(Deref(ARG1), Deref(ARG2), "$exists");
|
||||||
if (EndOfPAEntr(pe))
|
if (EndOfPAEntr(pe))
|
||||||
return FALSE;
|
return false;
|
||||||
PELOCK(34, pe);
|
PELOCK(34, pe);
|
||||||
if (pe->PredFlags & HiddenPredFlag) {
|
if (pe->PredFlags & HiddenPredFlag) {
|
||||||
UNLOCKPE(54, pe);
|
UNLOCKPE(54, pe);
|
||||||
return FALSE;
|
return false;
|
||||||
}
|
}
|
||||||
out = (pe->OpcodeOfPred != UNDEF_OPCODE);
|
out = (pe->OpcodeOfPred != UNDEF_OPCODE);
|
||||||
UNLOCKPE(55, pe);
|
UNLOCKPE(55, pe);
|
||||||
@ -2672,6 +2716,7 @@ static Int p_compile_mode(USES_REGS1) { /* $compile_mode(Old,New) */
|
|||||||
if (!Yap_unify_constant(ARG1, t3))
|
if (!Yap_unify_constant(ARG1, t3))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
t2 = Deref(ARG2);
|
t2 = Deref(ARG2);
|
||||||
|
|
||||||
if (IsVarTerm(t2) || !IsIntTerm(t2))
|
if (IsVarTerm(t2) || !IsIntTerm(t2))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
compile_mode = IntOfTerm(t2) & 1;
|
compile_mode = IntOfTerm(t2) & 1;
|
||||||
@ -2685,7 +2730,7 @@ static Int p_is_profiled(USES_REGS1) {
|
|||||||
if (IsVarTerm(t)) {
|
if (IsVarTerm(t)) {
|
||||||
Term ta;
|
Term ta;
|
||||||
|
|
||||||
if (PROFILING)
|
if (trueGlobalPrologFlag(PROFILING_FLAG))
|
||||||
ta = MkAtomTerm(AtomOn);
|
ta = MkAtomTerm(AtomOn);
|
||||||
else
|
else
|
||||||
ta = MkAtomTerm(AtomOff);
|
ta = MkAtomTerm(AtomOff);
|
||||||
@ -2695,7 +2740,6 @@ static Int p_is_profiled(USES_REGS1) {
|
|||||||
return (FALSE);
|
return (FALSE);
|
||||||
s = (char *)RepAtom(AtomOfTerm(t))->StrOfAE;
|
s = (char *)RepAtom(AtomOfTerm(t))->StrOfAE;
|
||||||
if (strcmp(s, "on") == 0) {
|
if (strcmp(s, "on") == 0) {
|
||||||
PROFILING = TRUE;
|
|
||||||
Yap_InitComma();
|
Yap_InitComma();
|
||||||
return (TRUE);
|
return (TRUE);
|
||||||
} else if (strcmp(s, "off") == 0) {
|
} else if (strcmp(s, "off") == 0) {
|
||||||
@ -2862,131 +2906,6 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
|
|||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int /* $ml_system_predicate(P) */
|
|
||||||
p_mk_system_pred(USES_REGS1) {
|
|
||||||
PredEntry *pe;
|
|
||||||
|
|
||||||
Term t1 = Deref(ARG1);
|
|
||||||
Term tm = Deref(ARG2);
|
|
||||||
if (IsVarTerm(t1))
|
|
||||||
return FALSE;
|
|
||||||
if (IsAtomTerm(t1)) {
|
|
||||||
pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), tm));
|
|
||||||
pe->ModuleOfPred = PROLOG_MODULE;
|
|
||||||
return true;
|
|
||||||
} else if (IsApplTerm(t1)) {
|
|
||||||
Functor funt = FunctorOfTerm(t1);
|
|
||||||
if (IsExtensionFunctor(funt)) {
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
pe = RepPredProp(PredPropByFunc(funt, tm));
|
|
||||||
pe->ModuleOfPred = PROLOG_MODULE;
|
|
||||||
return true;
|
|
||||||
} else if (IsPairTerm(t1)) {
|
|
||||||
pe = RepPredProp(PredPropByFunc(FunctorDot, tm));
|
|
||||||
pe->ModuleOfPred = PROLOG_MODULE;
|
|
||||||
return TRUE;
|
|
||||||
}
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
|
|
||||||
static Int /* $system_predicate(P) */
|
|
||||||
p_system_pred(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, "system_predicate/1");
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
if (!IsAtomTerm(nmod)) {
|
|
||||||
Yap_Error(TYPE_ERROR_ATOM, ARG1, "system_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))
|
|
||||||
return FALSE;
|
|
||||||
return (!pe->ModuleOfPred || /* any predicate in prolog module */
|
|
||||||
/* any C-pred */
|
|
||||||
pe->PredFlags & (UserCPredFlag | CPredFlag | BinaryPredFlag |
|
|
||||||
AsmPredFlag | TestPredFlag) ||
|
|
||||||
/* any weird user built-in */
|
|
||||||
pe->OpcodeOfPred == Yap_opcode(_try_userc));
|
|
||||||
}
|
|
||||||
|
|
||||||
static Int /* $system_predicate(P) */
|
|
||||||
p_all_system_pred(USES_REGS1) {
|
|
||||||
PredEntry *pe;
|
|
||||||
|
|
||||||
Term t1 = Deref(ARG1);
|
|
||||||
Term mod = Deref(ARG2);
|
|
||||||
|
|
||||||
restart_system_pred:
|
|
||||||
if (IsVarTerm(t1))
|
|
||||||
return TRUE;
|
|
||||||
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, "system_predicate/1");
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
if (!IsAtomTerm(nmod)) {
|
|
||||||
Yap_Error(TYPE_ERROR_ATOM, ARG1, "system_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))
|
|
||||||
return FALSE;
|
|
||||||
if (pe->ModuleOfPred) {
|
|
||||||
if (!Yap_unify(ARG3, pe->ModuleOfPred))
|
|
||||||
return FALSE;
|
|
||||||
} else {
|
|
||||||
if (!Yap_unify(ARG3, TermProlog))
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
return (!pe->ModuleOfPred || /* any predicate in prolog module */
|
|
||||||
/* any C-pred */
|
|
||||||
pe->PredFlags & (UserCPredFlag | CPredFlag | BinaryPredFlag |
|
|
||||||
AsmPredFlag | TestPredFlag) ||
|
|
||||||
/* any weird user built-in */
|
|
||||||
pe->OpcodeOfPred == Yap_opcode(_try_userc));
|
|
||||||
}
|
|
||||||
|
|
||||||
void Yap_HidePred(PredEntry *pe) {
|
void Yap_HidePred(PredEntry *pe) {
|
||||||
Prop p0 = AbsPredProp(pe);
|
Prop p0 = AbsPredProp(pe);
|
||||||
if (pe->ArityOfPE == 0) {
|
if (pe->ArityOfPE == 0) {
|
||||||
@ -3607,8 +3526,7 @@ static Int p_predicate_erased_statistics(USES_REGS1) {
|
|||||||
Yap_unify(ARG5, MkIntegerTerm(isz));
|
Yap_unify(ARG5, MkIntegerTerm(isz));
|
||||||
}
|
}
|
||||||
|
|
||||||
void /* $hidden_predicate(P) */
|
void Yap_UpdateTimestamps(PredEntry *ap) {
|
||||||
Yap_UpdateTimestamps(PredEntry *ap) {
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
choiceptr bptr = B;
|
choiceptr bptr = B;
|
||||||
yamop *cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred, Otapl);
|
yamop *cl0 = NEXTOP(PredLogUpdClause0->CodeOfPred, Otapl);
|
||||||
@ -3749,12 +3667,13 @@ static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th,
|
|||||||
th = Deref(Terms[0]);
|
th = Deref(Terms[0]);
|
||||||
tb = Deref(Terms[1]);
|
tb = Deref(Terms[1]);
|
||||||
tr = Deref(Terms[2]);
|
tr = Deref(Terms[2]);
|
||||||
/* don't do this!! I might have stored a choice-point and changed ASP
|
/*
|
||||||
|
don't do this!! I might have stored a choice-point and changed ASP
|
||||||
Yap_RecoverSlots(3);
|
Yap_RecoverSlots(3);
|
||||||
*/
|
*/
|
||||||
if (cl == NULL) {
|
if (cl == NULL || !(cl->ClFlags & SrcMask)) {
|
||||||
UNLOCKPE(45, pe);
|
UNLOCKPE(45, pe);
|
||||||
return FALSE;
|
return false;
|
||||||
}
|
}
|
||||||
if (pe->PredFlags & MegaClausePredFlag) {
|
if (pe->PredFlags & MegaClausePredFlag) {
|
||||||
yamop *code = (yamop *)cl;
|
yamop *code = (yamop *)cl;
|
||||||
@ -3818,12 +3737,6 @@ static Int fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th,
|
|||||||
UNLOCKPE(45, pe);
|
UNLOCKPE(45, pe);
|
||||||
return Yap_unify(tr, rtn);
|
return Yap_unify(tr, rtn);
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!(pe->PredFlags & SourcePredFlag)) {
|
|
||||||
rtn = Yap_MkStaticRefTerm(cl, pe);
|
|
||||||
UNLOCKPE(45, pe);
|
|
||||||
return Yap_unify(tr, rtn);
|
|
||||||
}
|
|
||||||
while ((t = Yap_FetchClauseTermFromDB(cl->usc.ClSource)) == 0L) {
|
while ((t = Yap_FetchClauseTermFromDB(cl->usc.ClSource)) == 0L) {
|
||||||
if (first_time) {
|
if (first_time) {
|
||||||
if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
|
if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
|
||||||
@ -3888,10 +3801,10 @@ static Int /* $hidden_predicate(P) */
|
|||||||
}
|
}
|
||||||
pe = get_pred(t1, Deref(ARG2), "clause/3");
|
pe = get_pred(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);
|
||||||
return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, new_cp,
|
return fetch_next_static_clause(pe, pe->CodeOfPred, ARG1, ARG3, ARG4, new_cp,
|
||||||
TRUE);
|
true);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int /* $hidden_predicate(P) */
|
static Int /* $hidden_predicate(P) */
|
||||||
@ -3901,7 +3814,7 @@ static Int /* $hidden_predicate(P) */
|
|||||||
|
|
||||||
PELOCK(48, pe);
|
PELOCK(48, pe);
|
||||||
return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap,
|
return fetch_next_static_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap,
|
||||||
FALSE);
|
false);
|
||||||
}
|
}
|
||||||
|
|
||||||
static UInt compute_dbcl_size(arity_t arity) {
|
static UInt compute_dbcl_size(arity_t arity) {
|
||||||
@ -4513,7 +4426,7 @@ static Int predicate_flags(
|
|||||||
Term mod = Deref(ARG2);
|
Term mod = Deref(ARG2);
|
||||||
|
|
||||||
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
|
||||||
return (FALSE);
|
return false;
|
||||||
}
|
}
|
||||||
if (IsVarTerm(t1))
|
if (IsVarTerm(t1))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
@ -4566,12 +4479,108 @@ static Int predicate_flags(
|
|||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static bool pred_flag_clause(Functor f, Term mod, const char *name,
|
||||||
|
pred_flags_t val USES_REGS) {
|
||||||
|
Term tn;
|
||||||
|
|
||||||
|
Term s[2];
|
||||||
|
s[0] = MkAtomTerm(Yap_LookupAtom(name));
|
||||||
|
#if SIZEOF_INT_P == 8
|
||||||
|
s[1] = MkIntegerTerm(val);
|
||||||
|
#elif USE_GMP
|
||||||
|
{
|
||||||
|
char s[64];
|
||||||
|
MP_INT rop;
|
||||||
|
|
||||||
|
#ifdef _WIN32
|
||||||
|
snprintf(s, 64, "%I64d", (long long int)val);
|
||||||
|
#elif HAVE_SNPRINTF
|
||||||
|
snprintf(s, 64, "%lld", (long long int)val);
|
||||||
|
#else
|
||||||
|
sprintf(s, "%lld", (long long int)val);
|
||||||
|
#endif
|
||||||
|
mpz_init_set_str(&rop, s, 10);
|
||||||
|
s[1] = Yap_MkBigNumTerm((void *)&rop);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
tn = Yap_MkApplTerm(f, 2, s);
|
||||||
|
yamop *code_adr =
|
||||||
|
Yap_cclause(tn, 2, mod, tn); /* vsc: give the number of arguments to
|
||||||
|
cclause() in case there is a overflow */
|
||||||
|
if (LOCAL_ErrorMessage) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
addclause(tn, code_adr, assertz, mod, NULL);
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct pred_entry *Yap_MkLogPred(struct pred_entry *pe) {
|
||||||
|
pe->PredFlags = LogUpdatePredFlag;
|
||||||
|
pe->OpcodeOfPred = FAIL_OPCODE;
|
||||||
|
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE;
|
||||||
|
return pe;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int init_pred_flag_vals(USES_REGS1) {
|
||||||
|
Functor f;
|
||||||
|
Term mod = Deref(ARG2), t = Deref(ARG1);
|
||||||
|
|
||||||
|
if (IsAtomTerm(t)) {
|
||||||
|
return false;
|
||||||
|
} else if (IsApplTerm(t)) {
|
||||||
|
f = FunctorOfTerm(t);
|
||||||
|
arity_t Arity = ArityOfFunctor(f);
|
||||||
|
if (Arity != 2)
|
||||||
|
return false;
|
||||||
|
} else {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
pred_flag_clause(f, mod, "asm", AsmPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "atom_db", AtomDBPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "back_c", BackCPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "c", CPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "c_args", CArgsPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "compiled", CompiledPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "count", CountPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "discontiguous", DiscontiguousPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "immediate_update", DynamicPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "hidden", HiddenPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "in_use", InUsePredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "indexed", IndexedPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "log_update", LogUpdatePredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "mega_clause", MegaClausePredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "meta", MetaPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "module_transparent",
|
||||||
|
ModuleTransparentPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "multi", MultiFileFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "no_spy", NoSpyPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "no_trace", NoTracePredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "number_db", NumberDBPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "profiled", ProfiledPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "quasi_quotation", QuasiQuotationPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "safe", SafePredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "sequential", SequentialPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "source", SourcePredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "spied", SpiedPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "standard", StandardPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "swi_env", SWIEnvPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "sync", SyncPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "sys_export", SysExportPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "tabled", TabledPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "test", TestPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "thread_local", ThreadLocalPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "udi", UDIPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "user_c", UserCPredFlag PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "system", SystemPredFlags PASS_REGS);
|
||||||
|
pred_flag_clause(f, mod, "foreign", ForeignPredFlags PASS_REGS);
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
void Yap_InitCdMgr(void) {
|
void Yap_InitCdMgr(void) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
Term cm = CurrentModule;
|
Term cm = CurrentModule;
|
||||||
|
|
||||||
Yap_InitCPred("$compile_mode", 2, p_compile_mode,
|
Yap_InitCPred("$init_pred_flag_vals", 2, init_pred_flag_vals, SyncPredFlag);
|
||||||
SafePredFlag | SyncPredFlag);
|
|
||||||
Yap_InitCPred("$start_consult", 3, p_startconsult,
|
Yap_InitCPred("$start_consult", 3, p_startconsult,
|
||||||
SafePredFlag | SyncPredFlag);
|
SafePredFlag | SyncPredFlag);
|
||||||
Yap_InitCPred("$show_consult_level", 1, p_showconslultlev, SafePredFlag);
|
Yap_InitCPred("$show_consult_level", 1, p_showconslultlev, SafePredFlag);
|
||||||
@ -4613,6 +4622,10 @@ void Yap_InitCdMgr(void) {
|
|||||||
SafePredFlag | SyncPredFlag);
|
SafePredFlag | SyncPredFlag);
|
||||||
Yap_InitCPred("$is_multifile", 2, p_is_multifile,
|
Yap_InitCPred("$is_multifile", 2, p_is_multifile,
|
||||||
TestPredFlag | SafePredFlag);
|
TestPredFlag | SafePredFlag);
|
||||||
|
Yap_InitCPred("$new_system_predicate", 3, p_new_system_predicate,
|
||||||
|
SafePredFlag | SyncPredFlag);
|
||||||
|
Yap_InitCPred("$is_system_predicate", 2, p_is_system_predicate,
|
||||||
|
TestPredFlag | SafePredFlag);
|
||||||
Yap_InitCPred("$new_discontiguous", 3, p_new_discontiguous,
|
Yap_InitCPred("$new_discontiguous", 3, p_new_discontiguous,
|
||||||
SafePredFlag | SyncPredFlag);
|
SafePredFlag | SyncPredFlag);
|
||||||
Yap_InitCPred("$is_discontiguous", 2, p_is_discontiguous,
|
Yap_InitCPred("$is_discontiguous", 2, p_is_discontiguous,
|
||||||
@ -4635,9 +4648,6 @@ void Yap_InitCdMgr(void) {
|
|||||||
SafePredFlag | SyncPredFlag);
|
SafePredFlag | SyncPredFlag);
|
||||||
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
|
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
|
||||||
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
|
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
|
||||||
Yap_InitCPred("$mk_system_predicate", 2, p_mk_system_pred, SafePredFlag);
|
|
||||||
Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag);
|
|
||||||
Yap_InitCPred("$all_system_predicate", 3, p_all_system_pred, SafePredFlag);
|
|
||||||
Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
|
Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
|
||||||
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag);
|
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag);
|
||||||
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
|
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
|
||||||
|
Reference in New Issue
Block a user