fix current and system predicate

This commit is contained in:
Vítor Santos Costa 2014-11-25 12:03:48 +00:00
parent cfafc26b68
commit bb8ea9a27d
27 changed files with 1335 additions and 1254 deletions

View File

@ -951,7 +951,7 @@ interrupt_execute( USES_REGS1 )
}
if (PP) UNLOCKPE(1,PP);
PP = P->y_u.pp.p0;
if ((PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
}
SET_ASP(YENV, E_CB*sizeof(CELL));
@ -979,7 +979,7 @@ interrupt_call( USES_REGS1 )
if (PP) UNLOCKPE(1,PP);
PP = P->y_u.Osbpp.p0;
if (Yap_only_has_signal(YAP_CREEP_SIGNAL) &&
(PP->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
(PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) ) {
return 2;
}
SET_ASP(YENV, P->y_u.Osbpp.s);
@ -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->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
if ((PP->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2;
}
/* set S for next instructions */
@ -7826,8 +7826,7 @@ Yap_absmi(int inp)
BOp(call_cpred, Osbpp);
check_trail(TR);
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag)) &&
!(PREG->y_u.Osbpp.p0->ExtraPredFlags & (NoTracePredFlag|HiddenPredFlag))) {
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) {
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCCall, HR);
ENDCACHE_Y_AS_ENV();

View File

@ -848,7 +848,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
}
}
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= NoTracePredFlag;
p->PredFlags |= NoTracePredFlag;
}
p->FunctorOfPred = fe;
if (fe->PropsOfFE) {
@ -937,7 +937,7 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
p->FunctorOfPred = ap->FunctorOfPred;
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_THREAD);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= (NoSpyPredFlag|NoTracePredFlag);
p->PredFlags |= (NoSpyPredFlag|NoTracePredFlag);
}
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_THREAD);
@ -1008,7 +1008,7 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
if (LOCAL_PL_local_data_p== NULL || !truePrologFlag(PLFLAG_DEBUGINFO)) {
p->ExtraPredFlags |= (NoTracePredFlag|NoSpyPredFlag);
p->PredFlags |= (NoTracePredFlag|NoSpyPredFlag);
}
WRITE_UNLOCK(ae->ARWLock);
{

View File

@ -3096,7 +3096,7 @@ YAP_Init(YAP_init_args *yap_init)
/* slaves, waiting for work */
CurrentModule = USER_MODULE;
P = GETWORK_FIRST_TIME;
Yap_exec_absmi(FALSE);
Yap_exec_absmi(FALSE, YAP_EXEC_ABSMI);
Yap_Error(INTERNAL_ERROR, TermNil, "abstract machine unexpected exit (YAP_Init)");
}
#endif /* YAPOR */

View File

@ -2136,7 +2136,7 @@ Yap_discontiguous( PredEntry *ap USES_REGS )
{
register consult_obj *fp;
if (ap->ExtraPredFlags & (DiscontiguousPredFlag|MultiFileFlag))
if (ap->PredFlags & (DiscontiguousPredFlag|MultiFileFlag))
return FALSE;
if (!LOCAL_ConsultSp) {
return FALSE;
@ -2339,7 +2339,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
PELOCK(20,p);
pflags = p->PredFlags;
/* we are redefining a prolog module predicate */
if (((p->ExtraPredFlags & SysExportPredFlag) == (UInt)0) &&
if (((p->PredFlags & SysExportPredFlag) == (UInt)0) &&
(
(pflags & (UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) ||
(p->ModuleOfPred == PROLOG_MODULE &&
@ -2847,7 +2847,7 @@ p_sys_export( USES_REGS1 )
return (FALSE);
}
PELOCK(100,pred);
pred->ExtraPredFlags |= SysExportPredFlag;
pred->PredFlags |= SysExportPredFlag;
UNLOCKPE(100,pred);
return TRUE;
}
@ -2868,7 +2868,7 @@ p_is_no_trace( USES_REGS1 )
if (EndOfPAEntr(pe))
return TRUE;
PELOCK(36,pe);
if (pe->ExtraPredFlags & NoTracePredFlag) {
if (pe->PredFlags & NoTracePredFlag) {
UNLOCKPE(57,pe);
return TRUE;
}
@ -2886,7 +2886,7 @@ p_set_no_trace( USES_REGS1 )
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
pe->PredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
@ -2904,7 +2904,7 @@ Yap_SetNoTrace(char *name, UInt arity, Term tmod)
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(36,pe);
pe->ExtraPredFlags |= NoTracePredFlag;
pe->PredFlags |= NoTracePredFlag;
UNLOCKPE(57,pe);
return TRUE;
}
@ -3164,7 +3164,7 @@ p_new_discontiguous( USES_REGS1 )
else
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, arity),mod));
PELOCK(26,pe);
pe->ExtraPredFlags |= DiscontiguousPredFlag;
pe->PredFlags |= DiscontiguousPredFlag;
/* mutifile-predicates are weird, they do not seat really on the default module */
if (pe->ModuleOfPred == PROLOG_MODULE)
pe->ModuleOfPred = TermProlog;
@ -3183,7 +3183,7 @@ p_is_discontiguous( USES_REGS1 )
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(27,pe);
out = (pe->ExtraPredFlags & DiscontiguousPredFlag);
out = (pe->PredFlags & DiscontiguousPredFlag);
UNLOCKPE(44,pe);
return(out);
}

View File

@ -1991,8 +1991,8 @@ Yap_InitExecFs(void)
#ifdef DEPTH_LIMIT
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
#endif
Yap_InitCPred("$execute0", 2, p_execute0, 0);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0);
Yap_InitCPred("$execute0", 2, p_execute0, NoTracePredFlag);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop,NoTracePredFlag );
Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0);
Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0);
Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0);

View File

@ -15,7 +15,7 @@
* *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
@ -23,12 +23,12 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "pl-shared.h"
static Int p_current_module( USES_REGS1 );
static Int p_current_module1( USES_REGS1 );
static Int p_current_module(USES_REGS1);
static Int p_current_module1(USES_REGS1);
static ModEntry *LookupModule(Term a);
static Term Yap_YapStripModule(Term t, Term *modp);
inline static ModEntry *
FetchModuleEntry(Atom at)
inline static ModEntry *FetchModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
@ -38,8 +38,7 @@ FetchModuleEntry(Atom at)
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if ( me->KindOfPE == ModProperty
) {
if (me->KindOfPE == ModProperty) {
READ_UNLOCK(ae->ARWLock);
return me;
}
@ -49,27 +48,24 @@ FetchModuleEntry(Atom at)
return NULL;
}
inline static ModEntry *
GetModuleEntry(Atom at)
inline static ModEntry *GetModuleEntry(Atom at)
/* get predicate entry for ap/arity; create it if neccessary. */
{
Prop p0;
AtomEntry *ae = RepAtom(at);
ModEntry *new;
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
if ( me->KindOfPE == ModProperty
) {
if (me->KindOfPE == ModProperty) {
return me;
}
p0 = me->NextOfPE;
}
{
CACHE_REGS
new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
new = (ModEntry *)Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->ModRWLock);
new->KindOfPE = ModProperty;
new->PredForME = NULL;
@ -77,7 +73,7 @@ GetModuleEntry(Atom at)
CurrentModules = new;
new->AtomOfME = ae;
if (at == AtomProlog)
new->flags = UNKNOWN_FAIL|M_SYSTEM|M_CHARESCAPE;
new->flags = UNKNOWN_FAIL | M_SYSTEM | M_CHARESCAPE;
else
new->flags = LookupModule(LOCAL_SourceModule)->flags;
AddPropToAtom(ae, (PropEntry *)new);
@ -85,20 +81,16 @@ GetModuleEntry(Atom at)
return new;
}
unsigned int
getUnknownModule(ModEntry * m) {
if (m && m->flags & UNKNOWN_MASK)
return m->flags & UNKNOWN_MASK;
else {
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
}
unsigned int getUnknownModule(ModEntry *m) {
if (m && m->flags & UNKNOWN_MASK)
return m->flags & UNKNOWN_MASK;
else {
return GetModuleEntry(AtomUser)->flags & UNKNOWN_MASK;
}
}
#define ByteAdr(X) ((char *) &(X))
Term
Yap_Module_Name(PredEntry *ap)
{
#define ByteAdr(X) ((char *)&(X))
Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS
Term mod;
if (!ap->ModuleOfPred)
@ -109,63 +101,53 @@ Yap_Module_Name(PredEntry *ap)
So I will return the current module in case the system
predicate is a meta-call. Otherwise it will still work.
*/
mod = CurrentModule;
mod = CurrentModule;
else {
mod = ap->ModuleOfPred;
}
if (mod) return mod;
if (mod)
return mod;
return TermProlog;
}
static ModEntry *
LookupModule(Term a )
{
static ModEntry *LookupModule(Term a) {
Atom at;
ModEntry *me;
/* prolog module */
if (a == 0) {
return GetModuleEntry(AtomUser);
return GetModuleEntry(AtomProlog);
}
at = AtomOfTerm(a);
me = GetModuleEntry(at);
return me;
}
Term
Yap_Module(Term tmod)
{
Term Yap_Module(Term tmod) {
LookupModule(tmod);
return tmod;
}
ModEntry *
Yap_GetModuleEntry(Term mod)
{
ModEntry *Yap_GetModuleEntry(Term mod) {
ModEntry *me;
if (!(me = LookupModule(mod)))
return NULL;
return me;
}
Term
Yap_GetModuleFromEntry(ModEntry *me)
{
return MkAtomTerm(me->AtomOfME);;
Term Yap_GetModuleFromEntry(ModEntry *me) {
return MkAtomTerm(me->AtomOfME);
;
}
struct pred_entry *
Yap_ModulePred(Term mod)
{
struct pred_entry *Yap_ModulePred(Term mod) {
ModEntry *me;
if (!(me = LookupModule(mod)))
return NULL;
return me->PredForME;
}
void
Yap_NewModulePred(Term mod, struct pred_entry *ap)
{
void Yap_NewModulePred(Term mod, struct pred_entry *ap) {
ModEntry *me;
if (!(me = LookupModule(mod)))
@ -176,13 +158,12 @@ Yap_NewModulePred(Term mod, struct pred_entry *ap)
WRITE_UNLOCK(me->ModRWLock);
}
static Int
p_current_module( USES_REGS1 )
{ /* $current_module(Old,New) */
Term t;
static Int
p_current_module(USES_REGS1) { /* $current_module(Old,New) */
Term t;
if (CurrentModule) {
if(!Yap_unify_constant(ARG1, CurrentModule))
if (!Yap_unify_constant(ARG1, CurrentModule))
return FALSE;
} else {
if (!Yap_unify_constant(ARG1, TermProlog))
@ -201,17 +182,14 @@ p_current_module( USES_REGS1 )
return TRUE;
}
static Int
p_current_module1( USES_REGS1 )
{ /* $current_module(Old) */
static Int p_current_module1(USES_REGS1) { /* $current_module(Old)
*/
if (CurrentModule)
return Yap_unify_constant(ARG1, CurrentModule);
return Yap_unify_constant(ARG1, TermProlog);
}
static Int
p_change_module( USES_REGS1 )
{ /* $change_module(New) */
static Int p_change_module(USES_REGS1) { /* $change_module(New) */
Term mod = Deref(ARG1);
LookupModule(mod);
CurrentModule = mod;
@ -219,57 +197,94 @@ p_change_module( USES_REGS1 )
return TRUE;
}
static Int
cont_current_module( USES_REGS1 )
{
ModEntry *imod = (ModEntry *)IntegerOfTerm(EXTRA_CBACK_ARG(1,1)), *next;
static Int cont_current_module(USES_REGS1) {
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next;
Term t = MkAtomTerm(imod->AtomOfME);
next = imod->NextME;
/* ARG1 is unbound */
Yap_unify(ARG1,t);
Yap_unify(ARG1, t);
if (!next)
cut_succeed();
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)next);
EXTRA_CBACK_ARG(1, 1) = MkAddressTerm(next);
return TRUE;
}
static Int
init_current_module( USES_REGS1 )
{ /* current_module(?ModuleName) */
static Int init_current_module(
USES_REGS1) { /* current_module(?ModuleName) */
Term t = Deref(ARG1);
if (!IsVarTerm(t)) {
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM,t,"module name must be an atom");
Yap_Error(TYPE_ERROR_ATOM, t, "module name must be an atom");
return FALSE;
}
if (FetchModuleEntry(AtomOfTerm(t)) != NULL)
cut_succeed();
cut_fail();
}
EXTRA_CBACK_ARG(1,1) = MkIntegerTerm((Int)CurrentModules);
return cont_current_module( PASS_REGS1 );
EXTRA_CBACK_ARG(1, 1) = MkIntegerTerm((Int)CurrentModules);
return cont_current_module(PASS_REGS1);
}
static Int
p_strip_module( USES_REGS1 )
{
static Int cont_ground_module(USES_REGS1) {
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(3, 1)), *next;
Term t2 = MkAtomTerm(imod->AtomOfME);
next = imod->NextME;
/* ARG2 is unbound */
if (!next)
cut_succeed();
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(next);
return Yap_unify(ARG2, t2);
}
static Int init_ground_module(USES_REGS1) {
/* current_module(?ModuleName) */
Term t1 = Deref(ARG1), tmod = CurrentModule, t3;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t3 = Yap_YapStripModule(t1, &tmod);
if (!t3) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
if (!IsVarTerm(tmod)) {
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, tmod, "module name must be an atom");
cut_fail();
}
if (FetchModuleEntry(AtomOfTerm(tmod)) != NULL && Yap_unify(tmod, ARG2) &&
Yap_unify(t3, ARG3)) {
cut_succeed();
}
cut_fail();
}
if (!Yap_unify(ARG2, tmod) ||
!Yap_unify(ARG3, t3) ) {
cut_fail();
}
// make sure we keep the binding
B->cp_tr = TR;
B->cp_h = HR;
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules);
return cont_ground_module(PASS_REGS1);
}
static Int p_strip_module(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_StripModule( t1, &tmod );
t1 = Yap_StripModule(t1, &tmod);
if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE,t1,"trying to obtain module");
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod);
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
static Term
Yap_YapStripModule(Term t, Term *modp)
{
static Term Yap_YapStripModule(Term t, Term *modp) {
CACHE_REGS
Term tmod;
@ -281,18 +296,18 @@ Yap_YapStripModule(Term t, Term *modp)
tmod = TermProlog;
}
}
restart:
restart:
if (IsVarTerm(t) || !IsApplTerm(t)) {
if (modp)
*modp = tmod;
return t;
} else {
Functor fun = FunctorOfTerm(t);
Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) {
Term t1 = ArgOfTerm(1, t);
Term t1 = ArgOfTerm(1, t);
tmod = t1;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
return 0L;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
return 0L;
}
t = ArgOfTerm(2, t);
goto restart;
@ -304,50 +319,38 @@ Yap_YapStripModule(Term t, Term *modp)
return 0L;
}
static Int
p_yap_strip_module( USES_REGS1 )
{
static Int p_yap_strip_module(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
}
t1 = Yap_YapStripModule( t1, &tmod );
t1 = Yap_YapStripModule(t1, &tmod);
if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE;
}
return Yap_unify(ARG3, t1) &&
Yap_unify(ARG2, tmod);
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
}
static Int
p_context_module( USES_REGS1 )
{
static Int p_context_module(USES_REGS1) {
yamop *parentcp = P;
CELL *yenv;
PredEntry *ap = EnvPreg(parentcp);
if (ap->ModuleOfPred &&
!(ap->PredFlags & MetaPredFlag))
if (ap->ModuleOfPred && !(ap->PredFlags & MetaPredFlag))
return Yap_unify(ARG1, ap->ModuleOfPred);
parentcp = CP;
yenv = ENV;
do {
ap = EnvPreg(parentcp);
if (ap->ModuleOfPred &&
!(ap->PredFlags & MetaPredFlag))
if (ap->ModuleOfPred && !(ap->PredFlags & MetaPredFlag))
return Yap_unify(ARG1, ap->ModuleOfPred);
parentcp = (yamop *)yenv[E_CP];
yenv = (CELL *)yenv[E_E];
} while(yenv);
} while (yenv);
return Yap_unify(ARG1, CurrentModule);
}
Term
Yap_StripModule(Term t, Term *modp)
{
Term Yap_StripModule(Term t, Term *modp) {
CACHE_REGS
Term tmod;
@ -359,22 +362,22 @@ Yap_StripModule(Term t, Term *modp)
tmod = TermProlog;
}
}
restart:
restart:
if (IsVarTerm(t) || !IsApplTerm(t)) {
if (modp)
*modp = tmod;
return t;
} else {
Functor fun = FunctorOfTerm(t);
Functor fun = FunctorOfTerm(t);
if (fun == FunctorModule) {
Term t1 = ArgOfTerm(1, t);
if (IsVarTerm( t1 ) ) {
*modp = tmod;
return t;
Term t1 = ArgOfTerm(1, t);
if (IsVarTerm(t1)) {
*modp = tmod;
return t;
}
tmod = t1;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod) ) {
return 0L;
if (!IsVarTerm(tmod) && !IsAtomTerm(tmod)) {
return 0L;
}
t = ArgOfTerm(2, t);
goto restart;
@ -386,28 +389,29 @@ Yap_StripModule(Term t, Term *modp)
return 0L;
}
void
Yap_InitModulesC(void)
{
Yap_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module, SafePredFlag|SyncPredFlag);
void Yap_InitModulesC(void) {
Yap_InitCPred("$current_module", 2, p_current_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$current_module", 1, p_current_module1,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("$change_module", 1, p_change_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("strip_module", 3, p_strip_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, p_yap_strip_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("context_module", 1, p_context_module, 0);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module,
SafePredFlag|SyncPredFlag);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
cont_current_module, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module,
cont_current_module, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$ground_module", 3, 1, init_ground_module,
cont_ground_module, SafePredFlag | SyncPredFlag);
}
void
Yap_InitModules(void)
{
void Yap_InitModules(void) {
CACHE_REGS
LookupModule(MkAtomTerm(AtomProlog));
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
LOCAL_SourceModule = MkAtomTerm(AtomProlog);
LookupModule(USER_MODULE);
LookupModule(IDB_MODULE);
LookupModule(ATTRIBUTES_MODULE);

File diff suppressed because it is too large Load Diff

View File

@ -205,7 +205,7 @@ Yap_dir_separator (int ch)
return dir_separator (ch);
}
#if _MSC_VER || defined(__MINGW32__)
#if __WINDOWS__
#include <psapi.h>
char *libdir = NULL;
@ -217,9 +217,8 @@ initSysPath(Term tlib, Term tcommons) {
int len;
int dir_done = FALSE;
int commons_done = FALSE;
Int rcl, rcc;
#if _MSC_VER || defined(__MINGW32__) || defined(__MSYS__)
#if __WINDOWS__
{
char *dir;
if ((dir = Yap_RegistryGetString("library")) &&
@ -236,7 +235,7 @@ initSysPath(Term tlib, Term tcommons) {
}
}
if (dir_done && commons_done)
return rcl && rcc;
return TRUE;
#endif
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
strncat(LOCAL_FileNameBuf,"/", YAP_FILENAME_MAX);
@ -260,7 +259,7 @@ initSysPath(Term tlib, Term tcommons) {
}
}
if (dir_done && commons_done)
return rcl && rcc;
return TRUE;
#if __WINDOWS__
{

View File

@ -356,6 +356,8 @@ kill_thread_engine (int wid, int always_die)
}
if (REMOTE_ScratchPad(wid).ptr)
free(REMOTE_ScratchPad(wid).ptr);
// if (REMOTE_TmpPred(wid).ptr)
// free(REMOTE_TmpPred(wid).ptr);
REMOTE_PL_local_data_p(wid)->reg_cache =
REMOTE_ThreadHandle(wid).current_yaam_regs = NULL;
if (REMOTE_ThreadHandle(wid).start_of_timesp)
@ -882,6 +884,18 @@ typedef struct swi_mutex {
pthread_mutex_t m;
} SWIMutex;
static SWIMutex *MutexOfTerm(Term t)
{
Term t1 = Deref(t);
SWIMutex *mut = NULL;
if (IsVarTerm(t1)) {
} else if (IsAtomTerm(t1)) {
} else {
mut = AddressOfTerm(t1);
}
return mut;
}
static Int
p_new_mutex( USES_REGS1 )
{
@ -906,25 +920,30 @@ p_new_mutex( USES_REGS1 )
pthread_mutex_init(&mutp->m, &mat);
mutp->owners = 0;
mutp->tid_own = 0;
return Yap_unify(ARG1, MkIntegerTerm((Int)mutp));
return Yap_unify(ARG1, MkAddressTerm(mutp));
}
static Int
p_destroy_mutex( USES_REGS1 )
{
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
if (pthread_mutex_destroy(&mut->m) < 0)
return FALSE;
Yap_FreeCodeSpace((void *)mut);
Term t1 = Deref(ARG1);
SWIMutex *mut;
if (IsVarTerm(t1)) {
} else if (IsAtomTerm(t1)) {
} else {
mut = AddressOfTerm(Deref(ARG1));
if (pthread_mutex_destroy(&mut->m) < 0)
return FALSE;
Yap_FreeCodeSpace((void *)mut);
}
return TRUE;
}
static Int
p_lock_mutex( USES_REGS1 )
{
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
SWIMutex *mut = MutexOfTerm( ARG1 );
#if DEBUG_LOCKS
MUTEX_LOCK(&mut->m);
@ -940,7 +959,7 @@ p_new_mutex( USES_REGS1 )
static Int
p_trylock_mutex( USES_REGS1 )
{
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
SWIMutex *mut = MutexOfTerm( ARG1 );
if (MUTEX_TRYLOCK(&mut->m) == EBUSY)
return FALSE;
@ -952,7 +971,7 @@ p_new_mutex( USES_REGS1 )
static Int
p_unlock_mutex( USES_REGS1 )
{
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG1));
SWIMutex *mut = MutexOfTerm( ARG1 );
#if DEBUG_LOCKS
MUTEX_UNLOCK(&mut->m);
@ -979,9 +998,13 @@ p_new_mutex( USES_REGS1 )
p_new_mutex( PASS_REGS1 );
t1 = Deref(ARG1);
}
mut = (SWIMutex*)IntegerOfTerm(t1);
if (!p_lock_mutex( PASS_REGS1 )) {
if (IsAtomTerm(t1)) {
} else {
mut = AddressOfTerm(Deref(ARG1));
if (FALSE && !p_lock_mutex( PASS_REGS1 )) {
return FALSE;
}
}
tg = Yap_StripModule(tg, &tm);
@ -1030,7 +1053,7 @@ p_new_mutex( USES_REGS1 )
end:
ARG1 = MkIntegerTerm((Int)mut);
excep = Yap_GetException();
p_unlock_mutex( PASS_REGS1 );
if (FALSE) p_unlock_mutex( PASS_REGS1 );
if (creeping) {
Yap_signal( YAP_CREEP_SIGNAL );
} else if ( excep != 0) {
@ -1276,7 +1299,7 @@ p_new_mutex( USES_REGS1 )
if (pthread_cond_broadcast(condp) < 0)
return FALSE;
v return TRUE;
return TRUE;
}
static Int

View File

@ -394,6 +394,34 @@ IntegerOfTerm (Term t)
return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
}
#define MkAddressTerm(i) __MkAddressTerm(i PASS_REGS)
INLINE_ONLY inline EXTERN Term __MkAddressTerm (void * USES_REGS);
INLINE_ONLY inline EXTERN Term
__MkAddressTerm (void * n USES_REGS)
{
return __MkIntegerTerm((Int)n PASS_REGS);
}
INLINE_ONLY inline EXTERN bool IsAddressTerm (Term);
INLINE_ONLY inline EXTERN bool
IsAddressTerm (Term t)
{
return (bool) IsIntegerTerm (t);
}
INLINE_ONLY inline EXTERN void * AddressOfTerm (Term);
INLINE_ONLY inline EXTERN void *
AddressOfTerm (Term t)
{
return (void *) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
}
#ifndef YAP_H
#endif

View File

@ -403,7 +403,8 @@ AbsModProp (ModEntry * p)
return (Prop) (p);
}
#define ModToTerm(m) (m == PROLOG_MODULE ? TermProlog : m )
#endif
#define ModProperty ((PropFlags)0xfffa)
@ -651,55 +652,55 @@ IsValProperty (int flags)
C_Preds are things write, read, ... implemented in C. In this case
CodeOfPred holds the address of the correspondent C-function.
don;t forget to also add in qly.h
don't forget to also add in qly.h
*/
typedef enum
{
DiscontiguousPredFlag = ((UInt)0x00000010 << EXTRA_FLAG_BASE), /* predicates whose clauses may be all-over the place.. */
SysExportPredFlag = ((UInt)0x00000008 << EXTRA_FLAG_BASE), /* reuse export list to prolog module. */
NoTracePredFlag = ((UInt)0x00000004 << EXTRA_FLAG_BASE), /* cannot trace this predicate */
NoSpyPredFlag = ((UInt)0x00000002 << EXTRA_FLAG_BASE), /* cannot spy this predicate */
QuasiQuotationPredFlag = ((UInt)0x00000001 << EXTRA_FLAG_BASE), /* SWI-like quasi quotations */
MegaClausePredFlag = (UInt)0x80000000, /* predicate is implemented as a mega-clause */
ThreadLocalPredFlag = (UInt)0x40000000, /* local to a thread */
MultiFileFlag = (UInt)0x20000000, /* is multi-file */
UserCPredFlag = (UInt)0x10000000, /* CPred defined by the user */
LogUpdatePredFlag = (UInt)0x08000000, /* dynamic predicate with log. upd. sem. */
InUsePredFlag = (UInt)0x04000000, /* count calls to pred */
CountPredFlag = (UInt)0x02000000, /* count calls to pred */
HiddenPredFlag = (UInt)0x01000000, /* invisible predicate */
CArgsPredFlag = (UInt)0x00800000, /* SWI-like C-interface pred. */
SourcePredFlag = (UInt)0x00400000, /* static predicate with source declaration */
MetaPredFlag = (UInt)0x00200000, /* predicate subject to a meta declaration */
SyncPredFlag = (UInt)0x00100000, /* has to synch before it can execute */
NumberDBPredFlag = (UInt)0x00080000, /* entry for a number key */
AtomDBPredFlag = (UInt)0x00040000, /* entry for an atom key */
GoalExPredFlag = (UInt)0x00020000, /* predicate that is called by goal_expand */
TestPredFlag = (UInt)0x00010000, /* is a test (optim. comit) */
AsmPredFlag = (UInt)0x00008000, /* inline */
StandardPredFlag = (UInt)0x00004000, /* system predicate */
DynamicPredFlag = (UInt)0x00002000, /* dynamic predicate */
CPredFlag = (UInt)0x00001000, /* written in C */
SafePredFlag = (UInt)0x00000800, /* does not alter arguments */
CompiledPredFlag = (UInt)0x00000400, /* is static */
IndexedPredFlag = (UInt)0x00000200, /* has indexing code */
SpiedPredFlag = (UInt)0x00000100, /* is a spy point */
BinaryPredFlag = (UInt)0x00000080, /* test predicate */
TabledPredFlag = (UInt)0x00000040, /* is tabled */
SequentialPredFlag = (UInt)0x00000020, /* may not create parallel choice points! */
ProfiledPredFlag = (UInt)0x00000010, /* pred is being profiled */
BackCPredFlag = (UInt)0x00000008, /* Myddas Imported pred */
ModuleTransparentPredFlag = (UInt)0x00000004, /* ModuleTransparent pred */
SWIEnvPredFlag = (UInt)0x00000002, /* new SWI interface */
UDIPredFlag = (UInt)0x00000001 /* User Defined Indexing */
DiscontiguousPredFlag = ((uint64_t)((uint64_t)0x1000000000)), /* predicates whose clauses may be all-over the place.. */
SysExportPredFlag = ((uint64_t)0x800000000), /* reuse export list to prolog module. */
NoTracePredFlag = ((uint64_t)0x400000000), /* cannot trace this predicate */
NoSpyPredFlag = ((uint64_t)0x200000000), /* cannot spy this predicate */
QuasiQuotationPredFlag = ((uint64_t)0x100000000), /* SWI-like quasi quotations */
MegaClausePredFlag = (uint64_t)0x80000000, /* predicate is implemented as a mega-clause */
ThreadLocalPredFlag = (uint64_t)0x40000000, /* local to a thread */
MultiFileFlag = (uint64_t)0x20000000, /* is multi-file */
UserCPredFlag = (uint64_t)0x10000000, /* CPred defined by the user */
LogUpdatePredFlag = (uint64_t)0x08000000, /* dynamic predicate with log. upd. sem. */
InUsePredFlag = (uint64_t)0x04000000, /* count calls to pred */
CountPredFlag = (uint64_t)0x02000000, /* count calls to pred */
HiddenPredFlag = (uint64_t)0x01000000, /* invisible predicate */
CArgsPredFlag = (uint64_t)0x00800000, /* SWI-like C-interface pred. */
SourcePredFlag = (uint64_t)0x00400000, /* static predicate with source declaration */
MetaPredFlag = (uint64_t)0x00200000, /* predicate subject to a meta declaration */
SyncPredFlag = (uint64_t)0x00100000, /* has to synch before it can execute */
NumberDBPredFlag = (uint64_t)0x00080000, /* entry for a number key */
AtomDBPredFlag = (uint64_t)0x00040000, /* entry for an atom key */
GoalExPredFlag = (uint64_t)0x00020000, /* predicate that is called by goal_expand */
TestPredFlag = (uint64_t)0x00010000, /* is a test (optim. comit) */
AsmPredFlag = (uint64_t)0x00008000, /* inline */
StandardPredFlag = (uint64_t)0x00004000, /* system predicate */
DynamicPredFlag = (uint64_t)0x00002000, /* dynamic predicate */
CPredFlag = (uint64_t)0x00001000, /* written in C */
SafePredFlag = (uint64_t)0x00000800, /* does not alter arguments */
CompiledPredFlag = (uint64_t)0x00000400, /* is static */
IndexedPredFlag = (uint64_t)0x00000200, /* has indexing code */
SpiedPredFlag = (uint64_t)0x00000100, /* is a spy point */
BinaryPredFlag = (uint64_t)0x00000080, /* test predicate */
TabledPredFlag = (uint64_t)0x00000040, /* is tabled */
SequentialPredFlag = (uint64_t)0x00000020, /* may not create parallel choice points! */
ProfiledPredFlag = (uint64_t)0x00000010, /* pred is being profiled */
BackCPredFlag = (uint64_t)0x00000008, /* Myddas Imported pred */
ModuleTransparentPredFlag = (uint64_t)0x00000004, /* ModuleTransparent pred */
SWIEnvPredFlag = (uint64_t)0x00000002, /* new SWI interface */
UDIPredFlag = (uint64_t)0x00000001 /* User Defined Indexing */
} pred_flag;
/* profile data */
typedef struct
{
YAP_ULONG_LONG NOfEntries; /* nbr of times head unification succeeded */
YAP_ULONG_LONG NOfHeadSuccesses; /* nbr of times head unification succeeded */
YAP_ULONG_LONG NOfRetries; /* nbr of times a clause for the pred
uint64_t NOfEntries; /* nbr of times head unification succeeded */
uint64_t NOfHeadSuccesses; /* nbr of times head unification succeeded */
uint64_t NOfRetries; /* nbr of times a clause for the pred
was retried */
#if defined(YAPOR) || defined(THREADS)
lockvar lock; /* a simple lock to protect this entry */
@ -721,12 +722,7 @@ typedef struct pred_entry
PropFlags KindOfPE; /* kind of property */
struct yami *CodeOfPred;
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
#if SIZEOF_INT_P==4
CELL PredFlags, ExtraPredFlags;
#else
CELL PredFlags;
#define ExtraPredFlags PredFlags
#endif
uint64_t PredFlags;
UInt ArityOfPE; /* arity of property */
union
{

View File

@ -179,8 +179,10 @@ extern "C" {
#if DEBUG_DLMALLOC
#include <assert.h>
#else
#ifndef assert
#define assert(x) ((void)0)
#endif
#endif
/*
The unsigned integer type used for comparing any two chunk sizes.

View File

@ -1,7 +1,7 @@
#if YAP_STAT_PREDS
#include <papi.h>
#endif
#include "Yap.h"
extern Environment ExpEnv;
#if YAP_JIT

View File

@ -4,6 +4,9 @@
search_for/3,
scan_natural/3,
scan_integer/3,
natural/3,
integer/3,
blank/3,
split/2,
split/3,
fields/2,
@ -66,6 +69,19 @@ scan_integer(N) -->
scan_integer(N) -->
scan_natural(0, N).
/** @pred integer(? _Int_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for an integer _Nat_, either a
positive, zero, or negative integer, and unify _RestOfLine_ with
the remainder of the line.
*/
integer(N) -->
"-", !,
natural(0, N0),
N is -N0.
integer(N) -->
natural(0, N).
/** @pred scan_natural(? _Nat_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for a natural number _Nat_, zero
@ -82,6 +98,49 @@ scan_natural(N0,N) -->
get_natural(N1,N).
scan_natural(N,N) --> [].
/** @pred natural(? _Nat_,+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for a natural number _Nat_, zero
or a positive integer, and unify _RestOfLine_ with the remainder
of the line.
*/
natural(N) -->
natural(0, N).
natural(N0,N) -->
[C],
{C >= 0'0, C =< 0'9 }, !,
{ N1 is N0*10+(C-0'0) }, %'
get_natural(N1,N).
natural(N,N) --> [].
/** @pred skip_whitespace(+ _Line_,+ _RestOfLine_)
Scan the list of codes _Line_ for white space, namely for tabbing and space characters.
*/
skip_whitespace([0' |Blanks]) -->
" ",
skip_whitespace( Blanks ).
skip_whitespace([0' |Blanks]) -->
" ",
skip_whitespace( Blanks ).
skip_whitespace( [] ) -->
!.
/** @pred blank(+ _Line_,+ _RestOfLine_)
The list of codes _Line_ is formed by white space, namely by tabbing and space characters.
*/
blank([0' |Blanks]) -->
" ",
blank( Blanks ).
blank([0' |Blanks]) -->
" ",
blank( Blanks ).
blank( [] ) -->
[].
/** @pred split(+ _Line_,- _Split_)
Unify _Words_ with a set of strings obtained from _Line_ by
@ -243,9 +302,12 @@ process(StreamInp, Command) :-
For every line _LineIn_ in file _FileIn_, execute
`call(Goal,LineIn,LineOut)`, and output _LineOut_ to file
_FileOut_.
The input stream is accessible through the alias `filter_input`, and the output
stream is accessible through `filter_output`.
*/
file_filter(Inp, Out, Command) :-
open(Inp, read, StreamInp),
open(Inp, read, StreamInp, [alias(filter_input)]),
open(Out, write, StreamOut),
filter(StreamInp, StreamOut, Command),
close(StreamInp),
@ -258,8 +320,8 @@ Same as file_filter/3, but before starting the filter execute
_Arguments_.
*/
file_filter_with_initialization(Inp, Out, Command, FormatString, Parameters) :-
open(Inp, read, StreamInp),
open(Out, write, StreamOut),
open(Inp, read, StreamInp, [alias(filter_input)]),
open(Out, write, StreamOut, [alias(filter_output)]),
format(StreamOut, FormatString, Parameters),
filter(StreamInp, StreamOut, Command),
close(StreamInp),

View File

@ -54,6 +54,8 @@ Int DepthArenas =0
int ArithError =FALSE
struct pred_entry* LastAssertedPred =NULL
struct pred_entry* TmpPred =NULL
struct pred_entry* LastAssertedPred =NULL
char* ScannerStack =NULL
struct scanner_extra_alloc* ScannerExtraBlocks =NULL
struct DB_TERM* BallTerm =NULL RestoreBallTerm(wid)

View File

@ -192,6 +192,8 @@
#include <stdarg.h>
#define VERSION "2.0.0"
int all_loaded_for_deterministic_variables(namedvars varmap, int disp);
typedef struct _parameters {
int loadfile;
int savedfile;
@ -721,14 +723,14 @@ void myexpand(extmanager MyManager, DdNode *Current) {
}
}
/* Angelicas Algorithm */
/* Angelika's Algorithm */
double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode, *dynvalue;
char *curnode;
double lvalue, hvalue, tvalue;
density_integral dynvalue_parsed;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
@ -811,7 +813,7 @@ static
void PrintNodeQueue(Queue q , extmanager MyManager){
QueueIterator qiter = QueueIteratorNew(q, 1);
fprintf(stderr,"Queue %p is [", *q);
fprintf(stderr,"Queue %p is [", &*q);
while (qiter->currentItem != NULL) {
DdNode* val = (DdNode*) qiter->currentItem->element;

View File

@ -161,6 +161,7 @@ typedef struct _density_integral {
double sigmoid(double x, double slope);
double normal(double x, double mu,double sigma);
double Phi(double x);
double cumulative_normal(double low, double high, double sigma, double mu);
double cumulative_normal_dmu(double low, double high,double mu,double sigma);

View File

@ -188,6 +188,9 @@
#include <errno.h>
#include "simplecudd.h"
int my_index_calc(int varstart, DdNode *node);
int all_loaded_for_deterministic_variables(namedvars varmap, int disp);
/* BDD manager initialization */
int _debug = 0;
@ -1717,8 +1720,7 @@ int GetParam(char *inputline, int iParam) {
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd) {
char buf, *inputline;
int icur, maxlinesize, iline, index, iloop, ivalue, iQsize, i, inQ, iRoot;
double dvalue;
int icur, maxlinesize, iline, index, iloop, iQsize, i, inQ, iRoot;
DdNode **Q, **Q2, *h_node, *l_node, *curnode;
hisqueue *his;
hisnode *hnode;
@ -1756,10 +1758,10 @@ void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, Dd
inQ = 0;
for(i = 0; (i < iQsize / 2) && (inQ < 3); i++)
inQ = (Q[i] == l_node) || (Q[iQsize - i] == l_node) + 2 * (Q[i] == h_node) || (Q[iQsize - i] == h_node);
if (inQ & 1 == 0) inQ = inQ + (GetNode(his, varmap.varstart, l_node) != NULL);
if (inQ & 2 == 0) inQ = inQ + 2 * (GetNode(his, varmap.varstart, h_node) != NULL);
if (inQ & 1 == 1) inQ = inQ - (l_node == HIGH(manager) || l_node == LOW(manager));
if (inQ & 2 == 2) inQ = inQ - 2 * (h_node == HIGH(manager) || h_node == LOW(manager));
if ((inQ & 1) == 0) inQ = inQ + (GetNode(his, varmap.varstart, l_node) != NULL);
if ((inQ & 2) == 0) inQ = inQ + 2 * (GetNode(his, varmap.varstart, h_node) != NULL);
if ((inQ & 1) == 1) inQ = inQ - (l_node == HIGH(manager) || l_node == LOW(manager));
if ((inQ & 2) == 2) inQ = inQ - 2 * (h_node == HIGH(manager) || h_node == LOW(manager));
inQ = 0;
switch(inQ) {
case 0:

View File

@ -63,7 +63,7 @@
'$convert_for_export'/7,
'$extend_exports'/3]).
:- use_system_module( '$_preds', ['$current_predicate_no_modules'/3]).
:- use_system_module( '$_preds', ['$current_predicate'/4]).
/**
@ -890,7 +890,7 @@ source_file(FileName) :-
source_file(Mod:Pred, FileName) :-
current_module(Mod),
Mod \= prolog,
'$current_predicate_no_modules'(Mod,_,Pred),
'$current_predicate'(_,Mod,Pred,_),
'$owned_by'(Pred, Mod, FileName).
'$owned_by'(T, Mod, FileName) :-
@ -1173,12 +1173,13 @@ unload_file( F0 ) :-
% eliminate multi-files;
% get rid of file-only predicataes.
'$unload_file'( FileName, _F0 ) :-
'$current_predicate_var'(_A,Mod,P),
'$owner_file'(P,Mod,FileName),
\+ '$is_multifile'(P,Mod),
functor( P, Na, Ar),
abolish(Mod:Na/Ar),
fail.
current_module(Mod),
'$current_predicate'(_A,Mod,P,_),
'$owner_file'(P,Mod,FileName),
\+ '$is_multifile'(P,Mod),
functor( P, Na, Ar),
abolish(Mod:Na/Ar),
fail.
%next multi-file.
'$unload_file'( FileName, _F0 ) :-
recorded('$lf_loaded','$lf_loaded'( FileName, _Age, _), R),

View File

@ -57,18 +57,18 @@ programs:
Switches the debugger on.
+ debugging
+ debugging
Outputs status information about the debugger which includes the leash
mode and the existing spy-points, when the debugger is on.
+ nodebug
+ nodebug
Switches the debugger off.
*/
@ -164,14 +164,14 @@ mode and the existing spy-points, when the debugger is on.
'$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M).
'$suspy2'(spy,F,N,T,M) :-
'$suspy2'(spy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),_), !,
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
'$suspy2'(spy,F,N,T,M) :- !,
recorda('$spy','$spy'(T,M),_),
recorda('$spy','$spy'(T,M),_),
'$set_spy'(T,M),
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
'$suspy2'(nospy,F,N,T,M) :-
'$suspy2'(nospy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),R), !,
erase(R),
'$rm_spy'(T,M),
@ -182,17 +182,17 @@ mode and the existing spy-points, when the debugger is on.
'$pred_being_spied'(G, M) :-
recorded('$spy','$spy'(G,M),_), !.
/** @pred spy( + _P_ ).
/**
@pred spy( + _P_ ).
Sets spy-points on all the predicates represented by
_P_. _P_ can either be a single specification or a list of
specifications. Each one must be of the form _Name/Arity_
or _Name_. In the last case all predicates with the name
_Name_ will be spied. As in C-Prolog, system predicates and
_P_. _P_ can either be a single specification or a list of
specifications. Each one must be of the form _Name/Arity_
or _Name_. In the last case all predicates with the name
_Name_ will be spied. As in C-Prolog, system predicates and
predicates written in C, cannot be spied.
*/
spy Spec :-
'$init_debugger',
@ -208,7 +208,7 @@ predicates written in C, cannot be spied.
Removes spy-points from all predicates specified by _P_.
The possible forms for _P_ are the same as in `spy P`.
*/
nospy Spec :-
'$init_debugger',
@ -218,12 +218,12 @@ The possible forms for _P_ are the same as in `spy P`.
'$suspy'(L, nospy, M), fail.
nospy _.
/** @pred nospyall
/** @pred nospyall
Removes all existing spy-points.
*/
nospyall :-
'$init_debugger',
@ -260,12 +260,12 @@ debug :-
%
/** @pred trace
/** @pred trace
Switches on the debugger and enters tracing mode.
*/
trace :-
'$init_debugger',
@ -276,7 +276,7 @@ trace :-
print_message(informational,debug(trace)),
'$creep'.
/** @pred notrace
/** @pred notrace
Ends tracing and exits the debugger. This is the same as
@ -297,7 +297,7 @@ notrace :-
-----------------------------------------------------------------------------*/
/** @pred leash(+ _M_)
/** @pred leash(+ _M_)
Sets leashing mode to _M_.
@ -323,13 +323,13 @@ never prompt, same as `off`
The initial leashing mode is `full`.
The user may also specify directly the debugger ports
where he wants to be prompted. If the argument for leash
The user may also specify directly the debugger ports
where he wants to be prompted. If the argument for leash
is a number _N_, each of lower four bits of the number is used to
control prompting at one the ports of the box model. The debugger will
control prompting at one the ports of the box model. The debugger will
prompt according to the following conditions:
+ if `N/\ 1 =\= 0` prompt on fail
+ if `N/\ 1 =\= 0` prompt on fail
+ if `N/\ 2 =\= 0` prompt on redo
+ if `N/\ 4 =\= 0` prompt on exit
+ if `N/\ 8 =\= 0` prompt on call
@ -428,10 +428,10 @@ model, execution is seen at the procedure level: each activation of a
procedure is seen as a box with control flowing into and out of that
box.
In the four port model control is caught at four key points: before
entering the procedure, after exiting the procedure (meaning successful
evaluation of all queries activated by the procedure), after backtracking but
before trying new alternative to the procedure and after failing the
In the four port model control is caught at four key points: before
entering the procedure, after exiting the procedure (meaning successful
evaluation of all queries activated by the procedure), after backtracking but
before trying new alternative to the procedure and after failing the
procedure. Each one of these points is named a port:
~~~~~
@ -483,20 +483,20 @@ control and show a message of the form:
The debugger message will be shown while creeping, or at spy-points,
and it includes four or five fields:
+
+
The first three characters are used to point out special states of the
debugger. If the port is exit and the first character is '?', the
current call is non-deterministic, that is, it still has alternatives to
be tried. If the second character is a `\*`, execution is at a
spy-point. If the third character is a `>`, execution has returned
either from a skip, a fail or a redo command.
+
+
The second field is the activation number, and uniquely identifies the
activation. The number will start from 1 and will be incremented for
each activation found by the debugger.
+
+
In the third field, the debugger shows the active port.
+
+
The fourth field is the goal. The goal is written by
`write_term/3` on the standard error stream, using the options
given by debugger_print_options.
@ -508,8 +508,8 @@ character, followed by a return. By default, only the call and redo
entries are leashed, but the leash/1 predicate can be used in
order to make the debugger stop where needed.
There are several commands available, but the user only needs to
remember the help command, which is `h`. This command shows all the
There are several commands available, but the user only needs to
remember the help command, which is `h`. This command shows all the
available options, which are:
+ `c` - creep
@ -551,7 +551,7 @@ kept; useful if skip becomes slow.
+ `f [ _GoalId_]` - fail
If given no argument, forces YAP to fail the goal, skipping the fail
port and backtracking to the parent.
port and backtracking to the parent.
If <tt>f</tt> receives a goal number as
the argument, the command fails all the way to the goal. If goal _GoalId_ has completed execution, YAP fails until meeting the first active ancestor.
@ -620,7 +620,7 @@ more information about `write_depth/2` ( (see Input/Output Control)).
+ `A` - alternatives
show the list of backtrack points in the current execution.
show the list of backtrack points in the current execution.
+ `g [ _N_]`
@ -647,7 +647,7 @@ be lost.
% Skip Create CP Create CP
% FastLeap Stop Ignore
% FastIgnore Ignore Ignore
% flag description initial possible values
@ -669,7 +669,7 @@ be lost.
'$swi_current_prolog_flag'(debug, false), !,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
CP is '$last_choice_pt',
CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, spy).
% last argument to do_spy says that we are at the end of a context. It
@ -724,7 +724,7 @@ be lost.
nb_setval('$spy_gn',L1), /* and save it globaly */
b_getval('$spy_glist',History), /* get goal list */
b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), /* and update it */
'$loop_spy'(L, G, Module, CalledFromDebugger).
'$loop_spy'(L, G, Module, CalledFromDebugger).
% we are skipping, so we can just call the goal,
% while leaving the minimal structure in place.
@ -734,7 +734,7 @@ be lost.
Module, error(Event,Context),
'$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)).
% handle weird things happening in the debugger.
% handle weird things happening in the debugger.
'$loop_spy_event'('$pass'(Event), _, _, _, _) :- !,
throw(Event).
'$loop_spy_event'(error('$retry_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :-
@ -773,8 +773,8 @@ be lost.
'$continue_debugging'(fail, CalledFromDebugger),
fail.
% if we are in
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
% if we are in
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
/* the following choice point is where the predicate is called */
b_getval('$spy_glist',[Info|_]), /* get goal list */
Info = info(_,_,_,Retry,Det,false),
@ -805,7 +805,7 @@ be lost.
;
true
),
'$continue_debugging'(exit, CalledFromDebugger)
'$continue_debugging'(exit, CalledFromDebugger)
;
% make sure we are in system mode when running the debugger.
/* backtracking from exit */
@ -828,7 +828,7 @@ be lost.
/* fail port */
fail
).
'$enter_goal'(GoalNumber, G, Module) :-
'$zip'(GoalNumber, G, Module), !.
'$enter_goal'(GoalNumber, G, Module) :-
@ -857,10 +857,10 @@ be lost.
->
StopPoint < GoalNumber
).
%
%
'$spycall'(G, M, _, _) :-
nb_getval('$debug_jump',true),
!,
@ -877,10 +877,10 @@ be lost.
'$meta_expansion'(G,M,M,M,G1,[]),
'$creep'(G1, M)
;
'$execute'(M:G)
'$execute'(M:G)
).
'$spycall'(G, M, _, _) :-
'$tabled_predicate'(G,M),
'$tabled_predicate'(G,M),
!,
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)).
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
@ -941,7 +941,7 @@ be lost.
'$swi_set_prolog_flag'(debug, false),
repeat,
'$trace_msg'(P,G,Module,L,Deterministic),
(
(
'$unleashed'(P) ->
'$action'(10,P,L,G,Module,Debug),
put_code(user_error, 10)
@ -975,7 +975,7 @@ be lost.
->
GW = Module:G
;
GW = G
GW = G
),
format(user_error,'~a~a~a (~d) ~q:',[Det,CSPY,SLL,L,P0]),
'$debugger_write'(user_error,GW).
@ -1086,7 +1086,7 @@ be lost.
'$swi_set_prolog_flag'(debug, true),
throw(error('$retry_spy'(ScanNumber),[])).
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
'$skipeol'(0's), % '
'$skipeol'(0's), % '
( (P=call; P=redo) ->
nb_setval('$debug_run',CallNumber),
nb_setval('$debug_jump',false)
@ -1142,7 +1142,7 @@ be lost.
'$execute_dgoal'(G).
'$continue_debugging_goal'(_,G) :-
'$execute_creep_dgoal'(G).
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
'$execute_nonstop'(G,M).
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
@ -1199,7 +1199,7 @@ be lost.
format(user_error,'^ view subg ^^ view using~n', []),
format(user_error,'A choices g [N] ancestors~n', []),
format(user_error,'! g execute goal~n', []).
'$ilgl'(C) :-
print_message(warning, trace_command(C)),
print_message(help, trace_help),
@ -1229,7 +1229,7 @@ be lost.
NbI is Nb0*10+(C-"0"),
get0(user, NC),
'$scan_number3'( NC, NbI, Nb).
'$print_deb_sterm'(G) :-
'$get_sterm_list'(L), !,
'$deb_get_sterm_in_g'(L,G,A),
@ -1285,7 +1285,7 @@ be lost.
recorda('$print_options','$debugger'([max_depth(D)|LN]),_).
'$set_deb_depth'(D) :-
recorda('$print_options','$debugger'([quoted(true),numbervars(true),portrayed(true),max_depth(D)]),_).
'$delete_if_there'([], _, []).
'$delete_if_there'([T|L], T, LN) :- !,
'$delete_if_there'(L, T, LN).
@ -1323,6 +1323,3 @@ be lost.
yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !,
'$debugger_skip_loop_spy2'(CPs,CPs1).
'$debugger_skip_loop_spy2'(CPs,CPs).

View File

@ -222,11 +222,8 @@ beautify_hidden_goal('$call'(G,_CP,?,M),prolog) -->
[call(M:G)].
beautify_hidden_goal('$call'(_G,_CP,G0,M),prolog) -->
[call(M:G0)].
beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) -->
[current_predicate(M,Na/Ar)].
beautify_hidden_goal('$current_predicate_for_atom'(Name,M,Ar),prolog) -->
{ functor(P, Name, Ar) },
[current_predicate(Name,M:P)].
beautify_hidden_goal('$current_predicate'(Na,M,S,_),prolog) -->
[current_predicate(Na,M:S)].
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
[listing(Stream,M:Pred)].

View File

@ -23,7 +23,7 @@
:- use_system_module( '$_errors', ['$do_error'/2]).
:- use_system_module( '$_preds', ['$clause'/4,
'$current_predicate_no_modules'/3]).
'$current_predicate'/4]).
/* listing : Listing clauses in the database
@ -62,7 +62,7 @@ listing :-
Mod \= prolog,
Mod \= system,
\+ '$hidden'( Mod ),
'$current_predicate_no_modules'(Mod,_,Pred),
'$current_predicate'(_,Mod,Pred, _),
'$undefined'(Pred, prolog), % skip predicates exported from prolog.
functor(Pred,Name,Arity),
\+ atom_concat('$', _, Name),

View File

@ -831,21 +831,25 @@ expand_goal(G, G).
'$exit_undefp',
fail.
% This predicate should be bidirectional: both
% a consumer and a generator.
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
recorded('$import','$import'(ExportingModI,ImportingMod,G0I,G,_,_),_),
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I), !.
'$continue_imported'(ExportingMod, ExportingModI, G0, G0I).
% SWI builtin
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
recorded('$dialect',Dialect,_),
Dialect \= yap,
functor(G, Name, Arity),
call(Dialect:index(Name,Arity,ExportingModI,_)), !,
'$continue_imported'(ExportingMod, ExportingModI, G0, G), !.
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
% autoload
'$get_undefined_pred'(G, _ImportingMod, G0, ExportingMod) :-
yap_flag(autoload, V),
V = true,
'$autoloader_find_predicate'(G,ExportingModI), !,
'$autoloader_find_predicate'(G,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
% parent module mechanism
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod) :-
prolog:'$parent_module'(ImportingMod,ExportingModI),
'$continue_imported'(ExportingMod, ExportingModI, G0, G).
@ -1203,7 +1207,8 @@ abolish_module(Mod) :-
recorded('$import','$import'(Mod,_,_,_,_,_),R), erase(R),
fail.
abolish_module(Mod) :-
'$current_predicate'(Mod,Na,Ar),
'$current_predicate'(Na,Mod,S,_),
functor(S, Na, Ar),
abolish(Mod:Na/Ar),
fail.
abolish_module(_).

View File

@ -71,7 +71,7 @@ and therefore he should try to avoid them whenever possible.
unknown/2], ['$assert_static'/5,
'$assertz_dynamic'/4,
'$clause'/4,
'$current_predicate_no_modules'/3,
'$current_predicate'/4,
'$init_preds'/0,
'$noprofile'/2,
'$public'/2,
@ -788,13 +788,15 @@ abolish(X) :-
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all'(M) :-
'$current_predicate'(M,Na,Ar),
'$current_predicate'(Na, M, S, _),
functor(S, Na, Ar),
'$new_abolish'(Na/Ar, M),
fail.
'$abolish_all'(_).
'$abolish_all_atoms'(Na, M) :-
'$current_predicate_for_atom'(Na,M,Ar),
'$current_predicate'(Na,M,S,_),
functor(S, Na, Ar),
'$new_abolish'(Na/Ar, M),
fail.
'$abolish_all_atoms'(_,_).
@ -858,13 +860,15 @@ abolish(X) :-
'$do_error'(type_error(predicate_indicator,T),abolish(M:T)).
'$abolish_all_old'(M) :-
'$current_predicate'(M, Na, Ar),
'$current_predicate'(Na, M, S, _),
functor( S, Na, Ar ),
'$abolish'(Na, Ar, M),
fail.
'$abolish_all_old'(_).
'$abolish_all_atoms_old'(Na, M) :-
'$current_predicate_for_atom'(Na, M, Ar),
'$current_predicate'(Na, M, S, _),
functor(S, Na, Ar),
'$abolish'(Na, Ar, M),
fail.
'$abolish_all_atoms_old'(_,_).
@ -1071,7 +1075,8 @@ predicate_property(Pred,Prop) :-
).
'$generate_all_preds_from_mod'(Pred, M, M) :-
'$current_predicate'(M,Na,Ar),
'$current_predicate'(Na,M,S,_),
functor(S,Na,Ar),
'$ifunctor'(Pred,Na,Ar).
'$generate_all_preds_from_mod'(Pred, SourceMod, Mod) :-
recorded('$import','$import'(SourceMod, Mod, Orig, Pred,_,_),_),
@ -1165,59 +1170,37 @@ predicate_erased_statistics(P,NCls,Sz,ISz) :-
Defines the relation: _P_ is a currently defined predicate whose
name is the atom _A_.
*/
current_predicate(A,T) :-
var(T), !, % only for the predicate
'$current_module'(M),
'$current_predicate_no_modules'(M,A,T).
current_predicate(A,M:T) :- % module unspecified
var(M), !,
'$current_predicate_var'(A,M,T).
current_predicate(A,M:T) :- % module specified
nonvar(T),
!,
functor(T,A,_),
'$pred_exists'(T,M).
current_predicate(A,M:T) :- % module specified
!,
'$current_predicate_no_modules'(M,A,T).
current_predicate(A,T) :- % only for the predicate
'$current_module'(M),
'$current_predicate_no_modules'(M,A,T).
'$current_predicate_var'(A,M,T) :-
var(T), !,
current_module(M),
M \= prolog,
'$current_predicate_no_modules'(M,A,T).
'$current_predicate_var'(A,M,T) :-
functor(T,A,_),
current_module(M),
M \= prolog,
'$pred_exists'(T,M).
'$ground_module'(T, M, T0),
(
'$current_predicate'(A, M, T0, _)
;
'$imported_predicate'(A, M, A/_Arity, T0, _)
).
/** @pred system_predicate( _A_, _P_)
Defines the relation: _P_ is a built-in predicate whose name
is the atom _A_.
is the atom _A_.
*/
system_predicate(A,P) :-
'$current_predicate_no_modules'(prolog,A,P),
system_predicate(A,T) :-
'$ground_module'(T, M, T0),
(
'$current_predicate'(A, M, T0, Flags)
;
'$current_predicate'(A, prolog, T0, Flags)
),
Flags /\ 0x00004000 =\= 0,
\+ '$hidden'(A).
system_predicate(P) :-
'$current_module'(M),
'$system_predicate'(P,M).
/** @pred system_predicate( ?_P_ )
Defines the relation: _P_ is a currently defined system predicate.
*/
system_predicate(P) :-
system_predicate(_, P).
'$current_predicate_no_modules'(M,A,T) :-
'$current_predicate'(M,A,Arity),
'$ifunctor'(T,A,Arity),
'$pred_exists'(T,M).
/** @pred current_predicate( _F_) is iso
@ -1225,65 +1208,32 @@ system_predicate(P) :-
_F_ is the predicate indicator for a currently defined user or
library predicate. _F_ is of the form _Na/Ar_, where the atom
_Na_ is the name of the predicate, and _Ar_ its arity.
*/
current_predicate(F0) :-
'$yap_strip_module'(F0, M, F),
'$$current_predicate'(F, M).
'$$current_predicate'(F, M) :-
( var(M) -> % only for the predicate
'$all_current_modules'(M)
; true),
M \= prolog,
'$current_predicate3'(F,M).
'$current_predicate3'(A/Arity,M) :-
nonvar(A), nonvar(Arity), !,
( '$ifunctor'(T,A,Arity),
'$pred_exists'(T,M)
->
true
;
% '$current_predicate'(prolog,A,Arity)
% ->
% functor(T,A,Arity),
% '$pred_exists'(T,M)
% ;
recorded('$import','$import'(NM,M,G,T,A,Arity),_)
->
'$pred_exists'(G,NM)
).
'$current_predicate3'(A/Arity,M) :- !,
'$ground_module'(F0, M, F),
(
'$current_predicate'(M,A,Arity),
'$ifunctor'(T,A,Arity),
'$pred_exists'(T,M)
'$current_predicate'(N, M, S, _),
functor( S, N, Ar),
F = N/Ar
;
% '$current_predicate'(prolog,A,Arity),
% functor(T,A,Arity),
% '$pred_exists'(T,M)
% ;
recorded('$import','$import'(NM,M,G,T,A,Arity),_),
functor(T,A,Arity),
'$pred_exists'(G,NM)
'$imported_predicate'(_Name, M, F, _S, _)
).
'$current_predicate3'(BadSpec,M) :- % only for the predicate
'$do_error'(type_error(predicate_indicator,BadSpec),current_predicate(M:BadSpec)).
'$imported_predicate'(A, ImportingMod, A/Arity, G, Flags) :-
'$get_undefined_pred'(G, ImportingMod, G0, ExportingMod),
functor(G, A, Arity),
'$pred_exists'(G, ExportingMod),
'$flags'(G0, ExportingMod, Flags, Flags).
/** @pred current_key(? _A_,? _K_)
Defines the relation: _K_ is a currently defined database key whose
name is the atom _A_. It can be used to generate all the keys for
the internal data-base.
the internal data-base.
*/
current_key(A,K) :-
'$current_predicate'(idb,A,Arity),
'$ifunctor'(K,A,Arity).
'$current_predicate'(A,idb,K,_).
% do nothing for now.
'$noprofile'(_, _).
@ -1307,10 +1257,6 @@ calls to assert/1 or retract/1 on the named predicates
raise a permission error. This predicate is designed to deal with parts
of the program that is generated at runtime but does not change during
the remainder of the program execution.
*/
compile_predicates(Ps) :-
'$current_module'(Mod),

View File

@ -126,8 +126,8 @@ profile_data(P, Parm, Data) :-
'$profile_say'(Stats, Parm, Data).
'$profile_data_for_var'(Name/Arity, Parm, Data, M) :-
'$current_predicate'(M,Name,Arity),
functor(P,Name,Arity),
'$current_predicate'(Name,M,P,_),
\+ '$hidden'(Name), % don't show hidden predicates.
'$profile_info'(M, P, Stats),
'$profile_say'(Stats, Parm, Data).
@ -137,8 +137,7 @@ profile_data(P, Parm, Data) :-
profile_reset :-
current_module(M),
'$current_predicate'(M,Na,Ar),
functor(P,Na,Ar),
'$current_predicate'(_Na,M,P,_),
'$profile_reset'(M, P),
fail.
profile_reset.

View File

@ -30,8 +30,7 @@
'$protect'.
'$hide_predicates'(Name) :-
'$current_predicate_for_atom'(Name, prolog, Ar),
functor(P, Name, Ar),
'$current_predicate'(Name, prolog, P, _),
'$hide_predicate'(P,prolog),
fail.
'$hide_predicates'(_).

View File

@ -227,7 +227,8 @@ order of dispatch.
'$execute_nonstop'(G, M),
'$$save_by'(CP2),
'$disable_debugging',
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) )
(CP == CP2 -> ! ; ( true ; '$enable_debugging', fail ) ),
'$enable_debugging'
;
'$disable_debugging',
fail