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

Merge with upstream code

Browse Source
This commit is contained in:
Tiago Gomes 2012-12-13 12:55:55 +00:00
commit dd8a92aaf3
55 changed files with 1897 additions and 462 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
C/c_interface.c
View File

@ -2255,14 +2255,12 @@ YAP_AtomToPred(Atom at)
X_API PredEntry *
YAP_FunctorToPredInModule(Functor func, Term mod)
{
CACHE_REGS
return RepPredProp(PredPropByFunc(func, mod));
}
X_API PredEntry *
YAP_AtomToPredInModule(Atom at, Term mod)
{
CACHE_REGS
return RepPredProp(PredPropByAtom(at, mod));
}
@ -2433,7 +2431,6 @@ YAP_RunGoal(Term t)
B = B->cp_b;
LOCAL_AllowRestart = FALSE;
}
RECOVER_MACHINE_REGS();
return out;
@ -2562,6 +2559,8 @@ YAP_RestartGoal(void)
if (LOCAL_AllowRestart) {
P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode;
// exec_absmi destroys slots on top of stack....
Yap_CloseSlots( PASS_REGS1 );
out = Yap_exec_absmi(TRUE);
LOCAL_PrologMode = UserCCallMode;
if (out == FALSE) {
@ -3072,7 +3071,7 @@ YAP_Init(YAP_init_args *yap_init)
}
{ BACKUP_MACHINE_REGS();
Yap_InitYaamRegs();
Yap_InitYaamRegs( 0);
#if HAVE_MPE
Yap_InitMPE ();
@ -3112,7 +3111,7 @@ YAP_Init(YAP_init_args *yap_init)
In the SBA we cannot just happily inherit registers
from the other workers
*/
Yap_InitYaamRegs();
Yap_InitYaamRegs( 0);
#endif /* YAPOR_COPY || YAPOR_SBA */
#ifndef YAPOR_THREADS
Yap_InitPreAllocCodeSpace();
@ -3191,7 +3190,7 @@ YAP_Init(YAP_init_args *yap_init)
/* first, initialise the saved state */
Term t_goal = MkAtomTerm(AtomInitProlog);
YAP_RunGoalOnce(t_goal);
Yap_InitYaamRegs();
Yap_InitYaamRegs( 0 );
/* reset stacks */
return YAP_BOOT_FROM_SAVED_CODE;
} else {
@ -3225,7 +3224,7 @@ YAP_Init(YAP_init_args *yap_init)
goal = Yap_MkApplTerm(fgoal, 1, as);
YAP_RunGoalOnce(goal);
/* reset stacks */
Yap_InitYaamRegs();
Yap_InitYaamRegs( 0 );
}
Yap_PutValue(Yap_FullLookupAtom("$live"), MkAtomTerm (Yap_FullLookupAtom("$true")));
}
@ -3296,6 +3295,9 @@ X_API int
YAP_Reset(void)
{
CACHE_REGS
#ifndef THREADS
int worker_id = 0;
#endif
BACKUP_MACHINE_REGS();
/* first, backtrack to the root */
@ -3306,13 +3308,13 @@ YAP_Reset(void)
if (Yap_exec_absmi(0) != 0) {
GLOBAL_Initialised = TRUE;
Yap_InitYaamRegs();
Yap_InitYaamRegs( worker_id );
RECOVER_MACHINE_REGS();
return FALSE;
}
}
/* reinitialise the engine */
Yap_InitYaamRegs();
Yap_InitYaamRegs( worker_id );
GLOBAL_Initialised = TRUE;
RECOVER_MACHINE_REGS();
@ -3532,7 +3534,7 @@ YAP_ThreadAttachEngine( int wid)
#else
return FALSE;
#endif
}
}
X_API int
YAP_ThreadDetachEngine(int wid)

48
C/cdmgr.c
View File

@ -2151,6 +2151,7 @@ goal_expansion_support(PredEntry *p, Term tf)
if (p0) {
mark_preds_with_this_func(FunctorOfTerm(tg), p0);
} else {
CACHE_REGS
Term mod = CurrentModule;
PredEntry *npe;
if (CurrentModule == PROLOG_MODULE)
@ -4420,7 +4421,7 @@ Yap_HidePred(PredEntry *pe)
}
static Int /* $system_predicate(P) */
p_hide_predicate( USES_REGS1 )
p_stash_predicate( USES_REGS1 )
{
PredEntry *pe;
@ -4463,6 +4464,50 @@ p_hide_predicate( USES_REGS1 )
return TRUE;
}
static Int /* $system_predicate(P) */
p_hide_predicate( USES_REGS1 )
{
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return(FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"hide_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"hide_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
if (EndOfPAEntr(pe))
return FALSE;
pe->PredFlags |= HiddenPredFlag;
return TRUE;
}
static Int /* $hidden_predicate(P) */
p_hidden_predicate( USES_REGS1 )
@ -6016,6 +6061,7 @@ Yap_InitCdMgr(void)
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("$stash_predicate", 2, p_stash_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag);
Yap_InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag);

167
C/exec.c
View File

@ -646,6 +646,117 @@ p_execute_in_mod( USES_REGS1 )
return(do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS));
}
static Int
p_do_goal_expansion( USES_REGS1 )
{
Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL;
Int out = FALSE;
PredEntry *pe;
Term cmod = Deref(ARG2);
ARG2 = ARG3;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
/* CurMod:goal_expansion(A,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
out = TRUE;
ARG3 = ARG2;
goto complete;
}
/* system:goal_expansion(A,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
out = TRUE;
ARG3 = ARG2;
goto complete;
}
ARG3 = ARG2;
ARG2 = cmod;
/* user:goal_expansion(A,CurMod,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
out = TRUE;
goto complete;
}
ARG2 = ARG3;
/* user:goal_expansion(A,B) */
if ( cmod != USER_MODULE && /* we have tried this before */
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
ARG3 = ARG2;
out = TRUE;
}
complete:
LOCK(LOCAL_SignalLock);
if (creeping) {
LOCAL_ActiveSignals |= YAP_CREEP_SIGNAL;
}
UNLOCK(LOCAL_SignalLock);
return out;
}
static Int
p_do_term_expansion( USES_REGS1 )
{
Int creeping = LOCAL_ActiveSignals & YAP_CREEP_SIGNAL;
Int out = FALSE;
PredEntry *pe;
Term cmod = CurrentModule;
/* disable creeping */
LOCK(LOCAL_SignalLock);
LOCAL_ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
/* CurMod:term_expansion(A,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
out = TRUE;
goto complete;
}
/* system:term_expansion(A,B) */
if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
out = TRUE;
goto complete;
}
/* user:term_expansion(A,B) */
if ( cmod != USER_MODULE && /* we have tried this before */
(pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) &&
pe->OpcodeOfPred != FAIL_OPCODE &&
pe->OpcodeOfPred != UNDEF_OPCODE &&
CallPredicate(pe, B, pe->CodeOfPred PASS_REGS) ) {
out = TRUE;
}
complete:
LOCK(LOCAL_SignalLock);
if (creeping) {
LOCAL_ActiveSignals |= YAP_CREEP_SIGNAL;
}
UNLOCK(LOCAL_SignalLock);
return out;
}
static Int
p_execute0( USES_REGS1 )
{ /* '$execute0'(Goal,Mod) */
@ -1604,18 +1715,22 @@ p_generate_pred_info( USES_REGS1 ) {
}
void
Yap_InitYaamRegs(void)
Yap_InitYaamRegs( int myworker_id )
{
CACHE_REGS
Term h0var;
#if PUSH_REGS
/* Guarantee that after a longjmp we go back to the original abstract
machine registers */
#ifdef THREADS
int myworker_id = worker_id;
pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(myworker_id).default_yaam_regs);
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
worker_id = myworker_id; /* ricroc: for what I understand, this shouldn't be necessary */
CACHE_REGS
int wid = worker_id;
if (wid != myworker_id) {
pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(myworker_id).default_yaam_regs);
REFRESH_CACHE_REGS
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
worker_id = myworker_id;
}
/* may be run by worker_id on behalf on myworker_id */
#else
Yap_regp = &Yap_standard_regs;
#endif
@ -1623,12 +1738,10 @@ Yap_InitYaamRegs(void)
Yap_ResetExceptionTerm ();
Yap_PutValue (AtomBreak, MkIntTerm (0));
TR = (tr_fr_ptr)LOCAL_TrailBase;
if (Yap_AttsSize > (LOCAL_LocalBase-LOCAL_GlobalBase)/8)
Yap_AttsSize = (LOCAL_LocalBase-LOCAL_GlobalBase)/8;
H = H0 = ((CELL *) LOCAL_GlobalBase)+ Yap_AttsSize/sizeof(CELL);
H = H0 = ((CELL *) REMOTE_GlobalBase(wid));
RESET_VARIABLE(H0-1);
LCL0 = ASP = (CELL *) LOCAL_LocalBase;
CurrentTrailTop = (tr_fr_ptr)(LOCAL_TrailTop-MinTrailGap);
LCL0 = ASP = (CELL *) REMOTE_LocalBase(wid);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(wid)-MinTrailGap);
/* notice that an initial choice-point and environment
*must* be created since for the garbage collector to work */
B = NULL;
@ -1643,27 +1756,27 @@ Yap_InitYaamRegs(void)
#ifdef YAPOR_SBA
BSEG =
#endif /* YAPOR_SBA */
BBREG = B_FZ = (choiceptr) LOCAL_LocalBase;
TR = TR_FZ = (tr_fr_ptr) LOCAL_TrailBase;
BBREG = B_FZ = (choiceptr) REMOTE_LocalBase(wid);
TR = TR_FZ = (tr_fr_ptr) REMOTE_TrailBase(wid);
#endif /* FROZEN_STACKS */
LOCK(LOCAL_SignalLock);
LOCK(REMOTE_SignalLock(wid));
CreepFlag = CalculateStackGap();
UNLOCK(LOCAL_SignalLock);
UNLOCK(REMOTE_SignalLock(wid));
EX = NULL;
init_stack(0, NULL, TRUE, NULL PASS_REGS);
/* the first real choice-point will also have AP=FAIL */
/* always have an empty slots for people to use */
CurSlot = 0;
Yap_StartSlots( PASS_REGS1 );
LOCAL_GlobalArena = TermNil;
REMOTE_GlobalArena(wid) = TermNil;
h0var = MkVarTerm();
#if COROUTINING
LOCAL_WokenGoals = Yap_NewTimedVar(TermNil);
LOCAL_AttsMutableList = Yap_NewTimedVar(h0var);
REMOTE_WokenGoals(wid) = Yap_NewTimedVar(TermNil);
REMOTE_AttsMutableList(wid) = Yap_NewTimedVar(h0var);
#endif
LOCAL_GcGeneration = Yap_NewTimedVar(h0var);
LOCAL_GcCurrentPhase = 0L;
LOCAL_GcPhase = Yap_NewTimedVar(MkIntTerm(LOCAL_GcCurrentPhase));
REMOTE_GcGeneration(wid) = Yap_NewTimedVar(h0var);
REMOTE_GcCurrentPhase(wid) = 0L;
REMOTE_GcPhase(wid) = Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(wid)));
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
PREG_ADDR = NULL;
@ -1678,8 +1791,14 @@ Yap_InitYaamRegs(void)
#endif
#ifdef TABLING
/* ensure that LOCAL_top_dep_fr is always valid */
if (LOCAL_top_dep_fr)
DepFr_cons_cp(LOCAL_top_dep_fr) = NORM_CP(B);
if (REMOTE_top_dep_fr(wid))
DepFr_cons_cp(REMOTE_top_dep_fr(wid)) = NORM_CP(B);
#endif
#ifdef THREADS
worker_id = wid;
if (myworker_id != worker_id) {
pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(worker_id).default_yaam_regs);
}
#endif
}
@ -1838,6 +1957,8 @@ Yap_InitExecFs(void)
Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0);
Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0);
Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0);
Yap_InitCPred("$do_goal_expansion", 3, p_do_goal_expansion, 0);
Yap_InitCPred("$do_term_expansion", 2, p_do_term_expansion, 0);
Yap_InitCPred("$get_exception", 1, p_get_exception, 0);
}

2
C/index.c
View File

@ -2367,7 +2367,7 @@ cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno, int in_idb)
}
} else {
while (cl <= max) {
add_head_info(cl, argno);
add_info(cl, argno);
/* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */
cl++;
}

3
C/init.c
View File

@ -1157,6 +1157,7 @@ InitFirstWorkerThreadHandle(void)
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock, NULL);
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL);
LOCAL_ThreadHandle.tdetach = MkAtomTerm(AtomFalse);
LOCAL_ThreadHandle.ref_count = 1;
#endif
}
@ -1314,7 +1315,7 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
#endif /* YAPOR || TABLING */
Yap_AttsSize = Atts;
Yap_InitTime();
Yap_InitTime( 0 );
/* InitAbsmi must be done before InitCodes */
/* This must be done before initialising predicates */
for (i = 0; i <= NUMBER_OF_YAP_FLAGS; i++) {

10
C/load_dl.c
View File

@ -191,21 +191,27 @@ Yap_ShutdownLoadForeign(void)
f_code = ForeignCodeLoaded;
while (f_code != NULL) {
StringList objs, libs;
StringList objs, libs, old;
ForeignObj *of_code = f_code;
objs = f_code->objs;
while (objs != NULL) {
old = objs;
if (dlclose(objs->handle) != 0)
return; /* ERROR */
objs = objs->next;
Yap_FreeCodeSpace(old);
}
libs = f_code->libs;
while (libs != NULL) {
old = libs;
if (dlclose(libs->handle) != 0)
return; /* ERROR */
objs = libs->next;
libs = libs->next;
Yap_FreeCodeSpace(old);
}
f_code = f_code->next;
Yap_FreeCodeSpace((ADDR)of_code);
}
/*
make sure that we don't try to close foreign code several times, eg,

2
C/qlyr.c
View File

@ -1008,7 +1008,7 @@ ReInitProlog(void)
#if defined(YAPOR) || defined(TABLING)
Yap_init_root_frames();
#endif /* YAPOR || TABLING */
Yap_InitYaamRegs();
Yap_InitYaamRegs( 0 );
YAP_RunGoalOnce(t);
}

2
C/save.c
View File

@ -1781,7 +1781,7 @@ Restore(char *s, char *lib_dir USES_REGS)
break;
case DO_ONLY_CODE:
UnmarkTrEntries( PASS_REGS1 );
Yap_InitYaamRegs();
Yap_InitYaamRegs( 0 );
break;
}

89
C/sysbits.c
View File

@ -90,7 +90,7 @@ static char SccsId[] = "%W% %G%";
#endif
STATIC_PROTO (void InitTime, (void));
STATIC_PROTO (void InitTime, (int));
STATIC_PROTO (void InitWTime, (void));
STATIC_PROTO (Int p_sh, ( USES_REGS1 ));
STATIC_PROTO (Int p_shell, ( USES_REGS1 ));
@ -335,32 +335,60 @@ bla bla
#define StartOfTimes (*(LOCAL_ThreadHandle.start_of_timesp))
#define last_time (*(LOCAL_ThreadHandle.last_timep))
#define StartOfTimes_sys (*(LOCAL_ThreadHandle.start_of_times_sysp))
#define last_time_sys (*(LOCAL_ThreadHandle.last_time_sysp))
#else
/* since the point YAP was started */
static struct timeval StartOfTimes;
/* since last call to runtime */
static struct timeval last_time;
#endif
/* same for system time */
static struct timeval last_time_sys;
static struct timeval StartOfTimes_sys;
#endif
/* store user time in this variable */
static void
InitTime (void)
InitTime (int wid)
{
CACHE_REGS
struct rusage rusage;
#if THREADS
LOCAL_ThreadHandle.start_of_timesp = (struct timeval *)malloc(sizeof(struct timeval));
LOCAL_ThreadHandle.last_timep = (struct timeval *)malloc(sizeof(struct timeval));
#endif
REMOTE_ThreadHandle(wid).start_of_timesp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_timep = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct timeval *)malloc(sizeof(struct timeval));
REMOTE_ThreadHandle(wid).last_time_sysp = (struct timeval *)malloc(sizeof(struct timeval));
getrusage(RUSAGE_SELF, &rusage);
last_time.tv_sec = StartOfTimes.tv_sec = rusage.ru_utime.tv_sec;
last_time.tv_usec = StartOfTimes.tv_usec = rusage.ru_utime.tv_usec;
last_time_sys.tv_sec = StartOfTimes_sys.tv_sec = rusage.ru_stime.tv_sec;
last_time_sys.tv_usec = StartOfTimes_sys.tv_usec = rusage.ru_stime.tv_usec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec =
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_sec =
rusage.ru_utime.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec =
(*REMOTE_ThreadHandle(wid).start_of_timesp).tv_usec =
rusage.ru_utime.tv_usec;
(*REMOTE_ThreadHandle(wid).last_time_sysp).tv_sec =
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_sec =
rusage.ru_stime.tv_sec;
(*REMOTE_ThreadHandle(wid).last_time_sysp).tv_usec =
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).tv_usec =
rusage.ru_stime.tv_usec;
#else
getrusage(RUSAGE_SELF, &rusage);
last_time.tv_sec =
StartOfTimes.tv_sec =
rusage.ru_utime.tv_sec;
last_time.tv_usec =
StartOfTimes.tv_usec =
rusage.ru_utime.tv_usec;
last_time_sys.tv_sec =
StartOfTimes_sys.tv_sec =
rusage.ru_stime.tv_sec;
last_time_sys.tv_usec =
StartOfTimes_sys.tv_usec =
rusage.ru_stime.tv_usec;
#endif
}
@ -391,6 +419,7 @@ void Yap_cputime_interval(Int *now,Int *interval)
void Yap_systime_interval(Int *now,Int *interval)
{
CACHE_REGS
struct rusage rusage;
getrusage(RUSAGE_SELF, &rusage);
@ -437,7 +466,7 @@ static clock_t TimesStartOfTimes, Times_last_time;
/* store user time in this variable */
static void
InitTime (void)
InitTime (int)
{
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
@ -447,14 +476,22 @@ InitTime (void)
t = clock ();
Times_last_time = TimesStartOfTimes = t;
} else {
last_time.dwLowDateTime = UserTime.dwLowDateTime;
last_time.dwHighDateTime = UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime = UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime = UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime = KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime = KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime = KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime = KernelTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).last_timep).dwLowDateTime =
UserTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_timep).dwHighDateTime =
UserTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).start_of_timesp).dwLowDateTime =
UserTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).start_of_timesp).dwHighDateTime =
UserTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).last_time_sysp).dwLowDateTime =
KernelTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_time_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwLowDateTime =
KernelTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
}
}
@ -604,7 +641,7 @@ InitTime (void)
{
struct tms t;
times (&t);
last_time = StartOfTimes = t.tms_utime;
(*REMOTE_ThreadHandle(wid).last_timep) = StartOfTimes = t.tms_utime;
last_time_sys = StartOfTimes_sys = t.tms_stime;
}
@ -648,13 +685,13 @@ static struct timeval last_time;
/* store user time in this variable */
static void
InitTime (void)
InitTime (int wid)
{
struct timeval tp;
gettimeofday(&tp,NULL);
last_time.tv_sec = StartOfTimes.tv_sec = tp.tv_sec;
last_time.tv_usec = StartOfTimes.tv_usec = tp.tv_usec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_sec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_sec = tp.tv_sec;
(*REMOTE_ThreadHandle(wid).last_timep).tv_usec = (*REMOTE_ThreadHandle.start_of_timesp(wid)).tv_usec = tp.tv_usec;
}
@ -2730,9 +2767,9 @@ Yap_InitSysbits (void)
}
void
Yap_InitTime(void)
Yap_InitTime( int wid )
{
InitTime();
InitTime( wid );
}
void

13
C/threads.c
View File

@ -237,8 +237,8 @@ setup_engine(int myworker_id, int init_thread)
LOCAL = REMOTE(worker_id);
Yap_InitExStacks(REMOTE_ThreadHandle(myworker_id).tsize, REMOTE_ThreadHandle(myworker_id).ssize);
CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod;
Yap_InitTime();
Yap_InitYaamRegs();
Yap_InitTime( myworker_id );
Yap_InitYaamRegs( myworker_id );
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
/* I exist */
GLOBAL_NOfThreadsCreated++;
@ -246,7 +246,7 @@ setup_engine(int myworker_id, int init_thread)
DEBUG_TLOCK_ACCESS(2, myworker_id);
pthread_mutex_unlock(&(REMOTE_ThreadHandle(myworker_id).tlock));
#ifdef TABLING
new_dependency_frame(LOCAL_top_dep_fr, FALSE, NULL, NULL, B, NULL, FALSE, NULL); /* same as in Yap_init_root_frames() */
new_dependency_frame(REMOTE_top_dep_fr(myworker_id), FALSE, NULL, NULL, B, NULL, FALSE, NULL); /* same as in Yap_init_root_frames() */
#endif /* TABLING */
return TRUE;
}
@ -456,8 +456,9 @@ Yap_thread_create_engine(thread_attr *ops)
Term t = TermNil;
/*
ok, this creates a problem, because we are initializing an engine from some "empty" thread.
We need first to foool the thread into believing it is the main thread
ok, this creates a problem, because we are initializing an engine from
some "empty" thread.
We need first to fool the thread into believing it is the main thread
*/
if (new_id == -1) {
/* YAP ERROR */
@ -492,7 +493,6 @@ Yap_thread_create_engine(thread_attr *ops)
Int
Yap_thread_attach_engine(int wid)
{
CACHE_REGS
/*
already locked
pthread_mutex_lock(&(REMOTE_ThreadHandle(wid).tlock));
@ -507,6 +507,7 @@ Yap_thread_attach_engine(int wid)
REMOTE_ThreadHandle(wid).pthread_handle = pthread_self();
REMOTE_ThreadHandle(wid).ref_count++;
pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(wid).default_yaam_regs);
CACHE_REGS
worker_id = wid; /* ricroc: for what I understand, this shouldn't be necessary */
DEBUG_TLOCK_ACCESS(9, wid);
pthread_mutex_unlock(&(REMOTE_ThreadHandle(wid).tlock));

2
C/write.c
View File

@ -282,7 +282,7 @@ writebig(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, stru
blob_info = big_tag - USER_BLOB_START;
if (GLOBAL_OpaqueHandlers &&
(f= GLOBAL_OpaqueHandlers[blob_info].write_handler)) {
(f)(wglb->stream, big_tag, (void *)((MP_INT *)(pt+1)), 0);
(f)(wglb->stream, big_tag, ExternalBlobFromTerm(t), 0);
}
}
wrputs("0",wglb->stream);

3
H/Regs.h
View File

@ -83,6 +83,7 @@ INLINE_ONLY inline EXTERN void restore_B(void);
INLINE_ONLY inline EXTERN void save_B(void);
#define CACHE_REGS
#define REFRESH_CACHE_REGS
#define INIT_REGS
#define PASS_REGS1
#define PASS_REGS
@ -182,12 +183,14 @@ extern Term Yap_XREGS[MaxTemps]; /* 29 */
extern pthread_key_t Yap_yaamregs_key;
#undef CACHE_REGS
#undef REFRESH_CACHE_REGS
#undef INIT_REGS
#undef PASS_REGS
#undef PASS_REGS1
#undef USES_REGS
#undef USES_REGS1
#define CACHE_REGS REGSTORE *regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
#define REFRESH_CACHE_REGS regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
#define INIT_REGS , ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))
#define PASS_REGS1 regcache
#define PASS_REGS , regcache

35
H/Yap.h
View File

@ -749,6 +749,8 @@ typedef struct thandle {
#if HAVE_GETRUSAGE||defined(_WIN32)
struct timeval *start_of_timesp;
struct timeval *last_timep;
struct timeval *start_of_times_sysp;
struct timeval *last_time_sysp;
#endif
} yap_thandle;
#endif /* THREADS */
@ -850,22 +852,6 @@ Yap_StartSlots( USES_REGS1 ) {
CurSlot = LCL0-ASP;
}
static inline void
Yap_CloseSlots( USES_REGS1 ) {
Int old_slots;
if (CurSlot < LCL0-ASP)
return;
old_slots = IntOfTerm(ASP[0]);
ASP += (old_slots+1);
CurSlot = IntOfTerm(*ASP);
ASP++;
}
static inline Int
Yap_CurrentSlot( USES_REGS1 ) {
return IntOfTerm(ASP[0]);
}
/* pop slots when pruning */
static inline void
Yap_PopSlots( USES_REGS1 ) {
@ -878,6 +864,23 @@ Yap_PopSlots( USES_REGS1 ) {
}
}
static inline void
Yap_CloseSlots( USES_REGS1 ) {
Int old_slots;
Yap_PopSlots( PASS_REGS1 );
if (LCL0-CurSlot == ASP) {
old_slots = IntOfTerm(ASP[0]);
ASP += (old_slots+1);
CurSlot = IntOfTerm(*ASP);
ASP++;
}
}
static inline Int
Yap_CurrentSlot( USES_REGS1 ) {
return IntOfTerm(ASP[0]);
}
static inline Term
Yap_GetFromSlot(Int slot USES_REGS)
{

2
H/YapOpcodes.h
View File

@ -319,9 +319,9 @@
OPCODE(p_func2f_yx ,yxx),
OPCODE(p_func2f_yy ,yyx),
OPCODE(p_functor ,e),
OPCODE(p_execute_tail ,Osbmp),
OPCODE(p_execute2 ,Osbpp),
OPCODE(p_execute ,Osbmp),
OPCODE(p_execute_tail ,Osbpp),
#ifdef YAPOR
OPCODE(getwork_first_time ,e),
OPCODE(getwork ,Otapl),

4
H/Yapproto.h
View File

@ -248,7 +248,7 @@ void STD_PROTO(Yap_KillStacks,(int));
#else
void STD_PROTO(Yap_KillStacks,(int));
#endif
void STD_PROTO(Yap_InitYaamRegs,(void));
void STD_PROTO(Yap_InitYaamRegs,(int));
void STD_PROTO(Yap_ReInitWallTime, (void));
int STD_PROTO(Yap_OpDec,(int,char *,Atom,Term));
void STD_PROTO(Yap_CloseScratchPad,(void));
@ -360,7 +360,7 @@ void STD_PROTO(Yap_systime_interval,(Int *,Int *));
void STD_PROTO(Yap_walltime_interval,(Int *,Int *));
void STD_PROTO(Yap_InitSysbits,(void));
void STD_PROTO(Yap_InitSysPreds,(void));
void STD_PROTO(Yap_InitTime,(void));
void STD_PROTO(Yap_InitTime,(int));
int STD_PROTO(Yap_TrueFileName, (char *, char *, int));
double STD_PROTO(Yap_random, (void));
#ifdef _WIN32

8
H/findclause.h
View File

@ -292,7 +292,7 @@
case _write_void:
cl = NEXTOP(cl,e);
break;
case _write_struct:
case _write_l_struc:
cl = NEXTOP(cl,fa);
break;
case _write_longint:
@ -358,6 +358,12 @@
case _unify_l_float_write:
cl = NEXTOP(cl,od);
break;
case _unify_l_struc:
cl = NEXTOP(cl,ofa);
break;
case _unify_l_struc_write:
cl = NEXTOP(cl,ofa);
break;
case _unify_struct:
cl = NEXTOP(cl,ofa);
break;

6
H/headclause.h
View File

@ -327,6 +327,12 @@
case _unify_l_float_write:
cl = NEXTOP(cl,od);
break;
case _unify_l_struc:
cl = NEXTOP(cl,ofa);
break;
case _unify_l_struc_write:
cl = NEXTOP(cl,ofa);
break;
case _unify_struct:
cl = NEXTOP(cl,ofa);
break;

2
H/iatoms.h
View File

@ -289,6 +289,7 @@
AtomSystemLibraryDir = Yap_LookupAtom("system_library_directory");
AtomTerm = Yap_LookupAtom("term");
AtomTerms = Yap_LookupAtom("terms");
AtomTermExpansion = Yap_LookupAtom("term_expansion");
AtomTextStream = Yap_LookupAtom("text_stream");
AtomThreads = Yap_LookupAtom("threads");
AtomThrow = Yap_LookupAtom("throw");
@ -424,6 +425,7 @@
FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,4);
FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,7);
FunctorShortSyntaxError = Yap_MkFunctor(AtomSyntaxError,1);
FunctorTermExpansion = Yap_MkFunctor(AtomTermExpansion,2);
FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2);
FunctorThrow = Yap_MkFunctor(AtomThrow,1);
FunctorTimeoutError = Yap_MkFunctor(AtomTimeoutError,2);

2
H/ratoms.h
View File

@ -289,6 +289,7 @@
AtomSystemLibraryDir = AtomAdjust(AtomSystemLibraryDir);
AtomTerm = AtomAdjust(AtomTerm);
AtomTerms = AtomAdjust(AtomTerms);
AtomTermExpansion = AtomAdjust(AtomTermExpansion);
AtomTextStream = AtomAdjust(AtomTextStream);
AtomThreads = AtomAdjust(AtomThreads);
AtomThrow = AtomAdjust(AtomThrow);
@ -424,6 +425,7 @@
FunctorStreamPos = FuncAdjust(FunctorStreamPos);
FunctorSyntaxError = FuncAdjust(FunctorSyntaxError);
FunctorShortSyntaxError = FuncAdjust(FunctorShortSyntaxError);
FunctorTermExpansion = FuncAdjust(FunctorTermExpansion);
FunctorThreadRun = FuncAdjust(FunctorThreadRun);
FunctorThrow = FuncAdjust(FunctorThrow);
FunctorTimeoutError = FuncAdjust(FunctorTimeoutError);

2
H/rclause.h
View File

@ -53,6 +53,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
break;
/* instructions type Osbmp */
case _p_execute:
case _p_execute_tail:
OrArgAdjust(pc->u.Osbmp.or_arg);
pc->u.Osbmp.s = ConstantAdjust(pc->u.Osbmp.s);
pc->u.Osbmp.bmap = CellPtoHeapAdjust(pc->u.Osbmp.bmap);
@ -75,7 +76,6 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _call_usercpred:
case _fcall:
case _p_execute2:
case _p_execute_tail:
OrArgAdjust(pc->u.Osbpp.or_arg);
pc->u.Osbpp.s = ConstantAdjust(pc->u.Osbpp.s);
pc->u.Osbpp.bmap = CellPtoHeapAdjust(pc->u.Osbpp.bmap);

2
H/saveclause.h
View File

@ -49,6 +49,7 @@
break;
/* instructions type Osbmp */
case _p_execute:
case _p_execute_tail:
#ifdef YAPOR
CHECK(save_OrArg(stream, pc->u.Osbmp.or_arg));
#endif
@ -75,7 +76,6 @@
case _call_usercpred:
case _fcall:
case _p_execute2:
case _p_execute_tail:
#ifdef YAPOR
CHECK(save_OrArg(stream, pc->u.Osbpp.or_arg));
#endif

4
H/tatoms.h
View File

@ -576,6 +576,8 @@
#define AtomTerm Yap_heap_regs->AtomTerm_
Atom AtomTerms_;
#define AtomTerms Yap_heap_regs->AtomTerms_
Atom AtomTermExpansion_;
#define AtomTermExpansion Yap_heap_regs->AtomTermExpansion_
Atom AtomTextStream_;
#define AtomTextStream Yap_heap_regs->AtomTextStream_
Atom AtomThreads_;
@ -846,6 +848,8 @@
#define FunctorSyntaxError Yap_heap_regs->FunctorSyntaxError_
Functor FunctorShortSyntaxError_;
#define FunctorShortSyntaxError Yap_heap_regs->FunctorShortSyntaxError_
Functor FunctorTermExpansion_;
#define FunctorTermExpansion Yap_heap_regs->FunctorTermExpansion_
Functor FunctorThreadRun_;
#define FunctorThreadRun Yap_heap_regs->FunctorThreadRun_
Functor FunctorThrow_;

3
H/walkclause.h
View File

@ -32,6 +32,7 @@
break;
/* instructions type Osbmp */
case _p_execute:
case _p_execute_tail:
pc = NEXTOP(pc,Osbmp);
break;
/* instructions type Osbpa */
@ -47,8 +48,6 @@
return walk_found_c_pred(pp, startp, endp);
case _p_execute2:
return found_meta_call(startp, endp);
case _p_execute_tail:
return found_meta_call(startp, endp);
case _call:
case _fcall:
clause_code = TRUE;

20
configure vendored
View File

@ -4665,7 +4665,7 @@ fi
if test "${enable_clpbn_bp+set}" = set; then :
enableval=$enable_clpbn_bp; yap_cv_clpbn_bp="$enableval"
else
yap_cv_clpbn_bp=no
yap_cv_clpbn_bp=yes
fi
@ -5059,17 +5059,18 @@ else
INSTALL_MATLAB=""
fi
ac_ext=cpp
if test "$yap_cv_clpbn_bp"="yes"; then
ac_ext=cpp
ac_cpp='$CXXCPP $CPPFLAGS'
ac_compile='$CXX -c $CXXFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CXX -o conftest$ac_exeext $CXXFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_cxx_compiler_gnu
my_save_cxxflags="$CXXFLAGS"
CXXFLAGS=-std=c++0x
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether CXX supports -std-c++0x" >&5
my_save_cxxflags="$CXXFLAGS"
CXXFLAGS=-std=c++0x
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether CXX supports -std-c++0x" >&5
$as_echo_n "checking whether CXX supports -std-c++0x... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@ -5083,20 +5084,21 @@ _ACEOF
if ac_fn_cxx_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
yap_cv_clpbn_bp=yes
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
yap_cv_clpbn_bp=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
CXXFLAGS="$my_save_cxxflags"
ac_ext=c
CXXFLAGS="$my_save_cxxflags"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
fi
if test "$yap_cv_clpbn_bp" = no
then

24
configure.in
View File

@ -218,7 +218,7 @@ AC_ARG_ENABLE(cplint,
AC_ARG_ENABLE(clpbn-bp,
[ --enable-clpbn-bp enable belief propagation solver in CLPBN. ],
yap_cv_clpbn_bp="$enableval", yap_cv_clpbn_bp=no)
yap_cv_clpbn_bp="$enableval", yap_cv_clpbn_bp=yes)
AC_ARG_WITH(gmp,
[ --with-gmp[=DIR] use GNU Multiple Precision in DIR],
@ -516,17 +516,19 @@ else
INSTALL_MATLAB=""
fi
AC_LANG_PUSH([C++])
my_save_cxxflags="$CXXFLAGS"
CXXFLAGS=-std=c++0x
AC_MSG_CHECKING([whether CXX supports -std-c++0x])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],
[AC_MSG_RESULT([yes])]
[yap_cv_clpbn_bp=yes],
if test "$yap_cv_clpbn_bp"="yes"; then
AC_LANG_PUSH([C++])
my_save_cxxflags="$CXXFLAGS"
CXXFLAGS=-std=c++0x
AC_MSG_CHECKING([whether CXX supports -std-c++0x])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],
[AC_MSG_RESULT([yes])],
[AC_MSG_RESULT([no])]
)
CXXFLAGS="$my_save_cxxflags"
AC_LANG_POP()
[yap_cv_clpbn_bp=no]
)
CXXFLAGS="$my_save_cxxflags"
AC_LANG_POP()
fi
if test "$yap_cv_clpbn_bp" = no
then

16
docs/yap.tex
View File

@ -1818,6 +1818,14 @@ Make hidden atom @var{Atom} visible.
Make predicate @var{Pred} invisible to @code{current_predicate/2},
@code{listing}, and friends.
@item stash_predicate(+@var{Pred})
@findex stash_predicate/1
@snindex stash_predicate/1
@cnindex stash_predicate/1
Make predicate @var{Pred} invisible to new code, and to @code{current_predicate/2},
@code{listing}, and friends. New predicates with the same name and
functor can be declared.
@item expand_exprs(-@var{O},+@var{N})
@findex expand_exprs/2
@snindex expand_exprs/2
@ -4616,10 +4624,10 @@ If @code{first} (default), the predicates leaves no choice-point.
Otherwise a choice-point will be left and backtracking may yield
more solutions.
@c @item expand(@code{true}/@code{false})
@c If @code{true} (default is @code{false}) and @var{Spec} is atomic,
@c call @code{expand_file_name/2} followed by @code{member/2} on @var{Spec} before
@c proceeding. This is a SWI-Prolog extension.
@item expand(@code{true}/@code{false})
If @code{true} (default is @code{false}) and @var{Spec} is atomic,
call @code{expand_file_name/2} followed by @code{member/2} on @var{Spec} before
proceeding. This is originally a SWI-Prolog extension.
@end table
@c The Prolog flag @code{verbose_file_search} can be set to @code{true}

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

@ -2545,6 +2545,7 @@ X_API PL_engine_t
PL_create_engine(const PL_thread_attr_t *attr)
{
#if THREADS
int eng;
if (attr) {
YAP_thread_attr yapt;
@ -2552,13 +2553,15 @@ PL_create_engine(const PL_thread_attr_t *attr)
yapt.tsize = attr->global_size;
yapt.alias = (YAP_Term)attr->alias;
yapt.cancel = attr->cancel;
return Yap_local+YAP_ThreadCreateEngine(&yapt);
eng = YAP_ThreadCreateEngine(&yapt);
} else {
return Yap_local+YAP_ThreadCreateEngine(NULL);
eng = YAP_ThreadCreateEngine(NULL);
}
#else
return NULL;
if (eng >= 0)
return Yap_local[eng];
#endif
return NULL;
}
@ -2578,7 +2581,6 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
CACHE_REGS
#if THREADS
int cwid = PL_thread_self(), nwid;
if (cwid >= 0) {
if (old) *old = (PL_engine_t)(Yap_local[cwid]);
}
@ -2599,7 +2601,7 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
}
return PL_ENGINE_SET;
} else {
nwid = ((struct worker_local *)engine)->ThreadHandle_.current_yaam_regs->worker_id_;
nwid = ((struct worker_local *)engine)->ThreadHandle_.id;
}
pthread_mutex_lock(&(REMOTE_ThreadHandle(nwid).tlock));
@ -2610,13 +2612,6 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old)
}
return PL_ENGINE_SET;
}
if (cwid >= 0) {
if (!YAP_ThreadDetachEngine(cwid)) {
*old = NULL;
pthread_mutex_unlock(&(REMOTE_ThreadHandle(nwid).tlock));
return PL_ENGINE_INVAL;
}
}
if (!YAP_ThreadAttachEngine(nwid)) {
return PL_ENGINE_INVAL;
}

3
library/system.yap
View File

@ -225,7 +225,8 @@ process_err_stream_for_exec(Stream, Stream, _, L, L) :-
stream_property(Stream, input).
close_temp_streams([]).
close_temp_streams([S|Ss]) :- close(S),
close_temp_streams([S|Ss]) :-
close(S),
close_temp_streams(Ss).
popen(Command, Mode, Stream) :-

2
misc/ATOMS
View File

@ -294,6 +294,7 @@ A SystemError N "system_error"
A SystemLibraryDir N "system_library_directory"
A Term N "term"
A Terms N "terms"
A TermExpansion N "term_expansion"
A TextStream N "text_stream"
A Threads N "threads"
A Throw N "throw"
@ -429,6 +430,7 @@ F StreamEOS EndOfStream 1
F StreamPos StreamPos 4
F SyntaxError SyntaxError 7
F ShortSyntaxError SyntaxError 1
F TermExpansion TermExpansion 2
F ThreadRun TopThreadGoal 2
F Throw Throw 1
F TimeoutError TimeoutError 2

7
misc/buildops
View File

@ -1034,9 +1034,10 @@ opinfo("unify_l_n_atoms_write",[]).
opinfo("write_n_atoms",[body]).
opinfo("unify_struct",[]).
opinfo("unify_struct_write",[]).
opinfo("unify_l_struct",[]).
opinfo("unify_l_struct_write",[]).
opinfo("write_struct",[body]).
opinfo("unify_l_struc",[]).
opinfo("unify_l_struc_write",[]).
opinfo("write_struc",[body]).
opinfo("write_l_struc",[body]).
opinfo("unify_float",[]).
opinfo("unify_float_write",[]).
opinfo("unify_l_float",[]).

3
os/pl-file.c
View File

@ -4796,8 +4796,7 @@ struct PL_local_data *Yap_InitThreadIO(int wid)
}
#if THREADS
if (wid) {
/* copy from other worker */
memcpy(p, Yap_local[worker_id]->PL_local_data_p_, sizeof(struct PL_local_data));
memcpy(p, Yap_local[0]->PL_local_data_p_, sizeof(struct PL_local_data));
}
#endif
return p;

2
packages/CLPBN/clpbn.yap
View File

@ -256,6 +256,8 @@ project_attributes(GVars, AVars) :-
AVars = [_|_],
solver(Solver),
( GVars = [_|_] ; Solver = graphs), !,
% we don't pass query variables in this way
b_setval(clpbn_query_variables, none),
clpbn_vars(AVars, DiffVars, AllVars),
get_clpbn_vars(GVars,CLPBNGVars0),
simplify_query_vars(CLPBNGVars0, CLPBNGVars),

28
packages/CLPBN/clpbn/jt.yap
View File

@ -53,6 +53,8 @@
:- use_module(library(lists),
[reverse/2]).
:- use_module(library(maplist)).
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
@ -87,33 +89,29 @@
jt([[]],_,_) :- !.
jt(LLVs,Vs0,AllDiffs) :-
init_jt_solver(LLVs, Vs0, AllDiffs, State),
run_jt_solver(LLVs, LLPs, State),
maplist(run_jt_solver, LLVs, LLPs, State),
clpbn_bind_vals(LLVs,LLPs,AllDiffs).
init_jt_solver(LLVs, Vs0, _, State) :-
check_for_agg_vars(Vs0, Vs1),
init_influences(Vs1, G, RG),
init_jt_solver_for_questions(LLVs, G, RG, State).
maplist(init_jt_solver_for_question(G, RG), LLVs, State).
init_jt_solver_for_questions([], _, _, []).
init_jt_solver_for_questions([LLVs|MoreLLVs], G, RG, [state(JTree, Evidence)|State]) :-
init_jt_solver_for_question(G, RG, LLVs, state(JTree, Evidence)) :-
influences(LLVs, G, RG, NVs0),
sort(NVs0, NVs),
get_graph(NVs, BayesNet, CPTs, Evidence),
build_jt(BayesNet, CPTs, JTree),
init_jt_solver_for_questions(MoreLLVs, G, RG, State).
build_jt(BayesNet, CPTs, JTree).
run_jt_solver([], [], []).
run_jt_solver([LVs|MoreLVs], [LPs|MorePs], [state(JTree, Evidence)|MoreState]) :-
run_jt_solver(LVs, LPs, state(JTree, Evidence)) :-
% JTree is a dgraph
% now our tree has cpts
fill_with_cpts(JTree, NewTree),
% write_tree(NewTree,0),
% write_tree(0, NewTree),
propagate_evidence(Evidence, NewTree, EvTree),
message_passing(EvTree, MTree),
get_margin(MTree, LVs, LPs),
run_jt_solver(MoreLVs, MorePs, MoreState).
get_margin(MTree, LVs, LPs).
get_graph(LVs, BayesNet, CPTs, Evidence) :-
run_vars(LVs, Edges, Vertices, CPTs, Evidence),
@ -510,16 +508,16 @@ find_clique_from_kids([_|Kids], LVs, Clique, Dist) :-
find_clique_from_kids(Kids, LVs, Clique, Dist).
write_tree(tree(Clique-(Dist,_),Leaves), I0) :- !,
write_tree(I0, tree(Clique-(Dist,_),Leaves)) :- !,
matrix:matrix_to_list(Dist,L),
format('~*c ~w:~w~n',[I0,0' ,Clique,L]),
I is I0+2,
write_subtree(Leaves, I).
write_tree(tree(Clique-Dist,Leaves), I0) :-
maplist(write_tree(I), Leaves).
write_tree(I0, tree(Clique-Dist,Leaves), I0) :-
matrix:matrix_to_list(Dist,L),
format('~*c ~w:~w~n',[I0,0' ,Clique, L]),
I is I0+2,
write_subtree(Leaves, I).
maplist(write_tree(I), Leaves).
write_subtree([], _).
write_subtree([Tree|Leaves], I) :-

14
packages/CLPBN/examples/learning/sprinkler_params.yap
View File

@ -4,12 +4,12 @@
:- use_module(library(clpbn/learning/em)).
%:- clpbn:set_clpbn_flag(em_solver,gibbs).
%:- clpbn:set_clpbn_flag(em_solver,jt).
%:- clpbn:set_clpbn_flag(em_solver,hve).
:- clpbn:set_clpbn_flag(em_solver,bdd).
%:- clpbn:set_clpbn_flag(em_solver,bp).
%:- clpbn:set_clpbn_flag(em_solver,ve).
%:- set_pfl_flag(em_solver,gibbs).
%:- set_pfl_flag(em_solver,jt).
%:- set_pfl_flag(em_solver,hve).
%:- set_pfl_flag(em_solver,bp).
%:- set_pfl_flag(em_solver,ve).
:- set_pfl_flag(em_solver,bdd).
data(t,t,t,t).
data(_,t,_,t).
@ -25,8 +25,6 @@ data(t,t,_,f).
data(t,f,f,t).
data(t,f,t,t).
:- dynamic id/1.
timed_main :-
statistics(runtime, _),
main(Lik),

14
packages/bdd/bdd.yap
View File

@ -52,7 +52,7 @@ set_bdd_from_list(T0, VS, Manager, Cudd) :-
numbervars(VS,0,_),
generate_releases(T0, Manager, T),
% T0 = T,
% writeln_list(T),
% writeln_list(T0),
list_to_cudd(T,Manager,_Cudd0,Cudd).
generate_releases(T0, Manager, T) :-
@ -82,31 +82,31 @@ writeln_list(B.Bindings) :-
%list_to_cudd(H._List,_Manager,_Cudd0,_CuddF) :- writeln(l:H), fail.
list_to_cudd([],_Manager,Cudd,Cudd) :- writeln('X').
list_to_cudd(release_node(M,cudd(V)).T, Manager, Cudd0, CuddF) :- !,
list_to_cudd([release_node(M,cudd(V))|T], Manager, Cudd0, CuddF) :- !,
write('-'), flush_output,
cudd_release_node(M,V),
list_to_cudd(T, Manager, Cudd0, CuddF).
list_to_cudd((V=0*_Par).T, Manager, _Cudd0, CuddF) :- !,
list_to_cudd([(V=0*_Par)|T], Manager, _Cudd0, CuddF) :- !,
write('0'), flush_output,
term_to_cudd(0, Manager, Cudd),
V = cudd(Cudd),
list_to_cudd(T, Manager, Cudd, CuddF).
list_to_cudd((V=0).T, Manager, _Cudd0, CuddF) :- !,
list_to_cudd([(V=0)|T], Manager, _Cudd0, CuddF) :- !,
write('0'), flush_output,
term_to_cudd(0, Manager, Cudd),
V = cudd(Cudd),
list_to_cudd(T, Manager, Cudd, CuddF).
list_to_cudd((V=_Tree*0).T, Manager, _Cudd0, CuddF) :- !,
list_to_cudd([(V=_Tree*0)|T], Manager, _Cudd0, CuddF) :- !,
write('0'), flush_output,
term_to_cudd(0, Manager, Cudd),
V = cudd(Cudd),
list_to_cudd(T, Manager, Cudd, CuddF).
list_to_cudd((V=Tree*1).T, Manager, _Cudd0, CuddF) :- !,
list_to_cudd([(V=Tree*1)|T], Manager, _Cudd0, CuddF) :- !,
write('.'), flush_output,
term_to_cudd(Tree, Manager, Cudd),
V = cudd(Cudd),
list_to_cudd(T, Manager, Cudd, CuddF).
list_to_cudd((V=Tree).T, Manager, _Cudd0, CuddF) :-
list_to_cudd([(V=Tree)|T], Manager, _Cudd0, CuddF) :-
write('.'), flush_output,
( ground(Tree) -> true ; throw(error(instantiation_error(Tree))) ),
term_to_cudd(Tree, Manager, Cudd),

2
packages/chr

@ -1 +1 @@
Subproject commit 6dd05cb45b22cc38e3467d0264706f61381c8945
Subproject commit be76ebc1f9544a5ee96f9f94bebf58252b3a938c

2
packages/clib

@ -1 +1 @@
Subproject commit 75108ca1f119a6fbae3907ce7666e07dc2dcf286
Subproject commit b813923455e5efb2b55770699b84411c6dd37952

2
packages/pldoc

@ -1 +1 @@
Subproject commit 2a596b7cce313c2702f275a189c1ea6a67a20f84
Subproject commit fa667ecacf4128c10dc51215ff54f25672a782c8

106
packages/python/examples/mysql.pl Normal file
View File

@ -0,0 +1,106 @@
:- use_module(library(python)).
:- use_module(library(lists)).
:- python_import('MySQLdb').
:- initialization(main).
main :-
python_import(pyx),
ex(X),
flush_output,
fail.
main.
ex(open) :-
connect,
% execute SQL query using execute() method.
:= $cursor:execute('SELECT VERSION()'),
% Fetch a single row using fetchone() method.
Data := cursor:fetchone(_),
Data = t(Version),
format( "Database version : ~a~n ", [ Version ]),
close.
ex(create) :-
connect,
% Drop table if it already exist using execute() method.
:= $cursor:execute('DROP TABLE IF EXISTS EMPLOYEE'),
% Create table as per requirement
sql := 'CREATE TABLE EMPLOYEE (
FIRST_NAME CHAR(20) NOT NULL,
LAST_NAME CHAR(20),
AGE INT,
SEX CHAR(1),
INCOME FLOAT ) DEFAULT charset=utf8',
:= $cursor:execute($sql),
close.
ex(insert) :-
connect,
% Prepare SQL query to INSERT a record into the database.
catch(add, _, rollback),
close.
add :-
customer(First, Last, Age, Sex, Income),
format(atom(Sql), 'INSERT INTO EMPLOYEE(FIRST_NAME,
LAST_NAME, AGE, SEX, INCOME)
VALUES (\'~a\', \'~a\', ~d, \'~a\', ~g)',
[ First, Last, Age, Sex, Income ]),
% Execute the SQL command
:= $cursor:execute(Sql),
fail.
add :-
% Commit your changes in the database
:= $db:commit(_).
rollback :-
:= db:rollback(_).
connect :-
db := connect('localhost','testuser','test123','TESTDB' ),
:= $db:set_character_set('utf8'),
% prepare a cursor object using cursor() method
cursor := db:cursor(_),
:= $cursor:execute('SET NAMES utf8;'),
:= $cursor:execute('SET CHARACTER SET utf8;'),
:= $cursor:execute('SET character_set_connection=utf8;').
close :-
% disconnect from server
:= db:close(_).
% Open database connection
ex(read) :-
connect,
% Prepare SQL query to SELECT a record from the database.
sql := 'SELECT * FROM EMPLOYEE \
WHERE INCOME > 1000',
catch(try, _, except),
close.
try:-
% Execute the SQL command
:= $cursor:execute($sql),
% Fetch all the rows in a list of lists.
Results := $cursor:fetchall(_),
Results =.. [_|LResults],
member(t(Fname, Lname, Age, Sex, Income), LResults),
% Now print fetched result
format("fname=~a, lname=~a, age=~d, sex=~a, income=~g~n",
[Fname, Lname, Age, Sex, Income ]),
fail.
try.
except:-
format('Error: unable to fecth data', []).
% disconnect from server
customer('João', 'Matos', 40, 'M', 2000).
customer('Maria', 'Söderling', 20, 'F', 3000).
customer('毛', '泽东', 44, 'M', 500).
customer('রবীন্দ্রনাথ', 'ঠাকুর', 30, 'M', 8000).

49
packages/python/examples/pyx.pl Normal file
View File

@ -0,0 +1,49 @@
:- use_module(library(python)).
:- initialization(main).
setup_dir :-
prolog_load_context(directory, Dir),
atom_concat(Dir,'pyx/',Base),
assert(base(Base)).
:- setup_dir.
main :-
python_import(pyx),
ex(X),
flush_output,
fail.
main.
ex(hello) :-
c := canvas:canvas(_),
:= $c:text(0, 0, 'Hello, world!'),
:= $c:stroke(path:line(0, 0, 2, 0)),
:= $c:writePDFfile('hello').
ex(pathitem) :-
c := canvas:canvas(_),
rect1 := path:path(path:moveto(0, 0), path:lineto(1, 0),
path:moveto(1, 0), path:lineto(1, 1),
path:moveto(1, 1), path:lineto(0, 1),
path:moveto(0, 1), path:lineto(0, 0)),
rect2 := path:path(path:moveto(2, 0), path:lineto(3, 0),
path:lineto(3, 1), path:lineto(2, 1),
path:lineto(2, 0)),
rect3 := path:path(path:moveto(4, 0), path:lineto(5, 0),
path:lineto(5, 1), path:lineto(4, 1),
path:closepath(_)),
:= $c:stroke($rect1, [style:linewidth:'THICK']),
:= $c:stroke($rect2, [style:linewidth:'THICK']),
:= $c:stroke($rect3, [style:linewidth:'THICK']),
:= $c:writePDFfile('pathitem').
ex(changebar) :-
g := graph:graphxy(width=8, x=graph:axis:bar(_)),
base(Source), atomic_concat(Source, 'minimal.dat', Data),
:= $g:plot(graph:data:file(Data, xname=0, y=2), [graph:style:changebar(_)]),
:= $g:writePDFfile(changebar).

12
packages/python/examples/pyx/minimal.dat Normal file
View File

@ -0,0 +1,12 @@
January -5 1
Feburary -4 3
March 0 8
April 3 13
May 7 18
June 10 21
July 12 23
August 12 23
September 8 19
October 4 13
November 0 6
December -4 2

154
packages/python/examples/tut.pl Normal file
View File

@ -0,0 +1,154 @@
:- use_module(library(python)).
:- initialization(main).
main :-
ex(X),
flush_output,
fail.
main.
%
% strings are atoms in the interface
% with usual properties
%
% variables must be used with $
%
% UNICODE is supposed to work (does in Linux).
%
ex(currency) :-
(
currency := '€',
O := ord($currency),
X := $currency,
L := len($currency),
format('currency=~a ~d/~d~n',[X, O, L])
->
true
;
failed(currency)
).
ex(home) :-
(
filename := os:environ:get('HOME')
->
X := $filename,
format('HOME=~a~n',[X])
;
true
).
ex(site) :-
X := site:getusersitepackages(_),
format('site packages=~a~n',[X]).
ex(arith) :-
A := 2+2,
B := (50-5*6)/4,
C := 7/3,
width := 20,
height := 5*9,
D := $width* $height,
format('arith=~d ~d ~d ~d~n',[A,B,C,D]).
ex(undefined) :-
format('undefined variable~n', []),
X := $n,
format('undefined=~d',[X]).
ex(fp) :-
X := 3 * 3.75 / 1.5,
Y := 7.0 / 2,
format('fp=~f ~f~n',[X,Y]).
ex(complex) :-
A := complex(0,1) * complex(0,1),
B := complex(3,1)*3,
a := complex(1.5,0.5),
R := $a:real,
I := $a:imag,
format('complex=~w ~w ~w+~wj~n',[A,B,R,I]).
ex(floatint) :-
A := float(22000),
B := int(3.1),
C := long(15000000.5),
format('cast=~w ~w ~w~n',[A,B,C]).
ex(strings) :-
S1 := 'spam eggs',
S2 := 'doesn\'t',
S3 := '"Yes," he said.',
S4 := '"Isn\'t," she said.',
format('s=~a ~a ~a ~a~n',[S1,S2,S3,S4]),
hello := 'This is a rather long string containing\n\
several lines of text just as you would do in C.\n\
Note that whitespace at the beginning of the line is\
significant.',
python_command('print hello'),
X := $hello,
format('s=~a~n',[X]).
ex(strings2) :-
word := 'Help' + 'A',
X := '<' + $word*5 + '>',
Y := (str:strip) + ing,
A1 := $word^[4],
A2 := $word^[0:2],
A3 := $word^[2:4],
format('concat=~a ~a ~a ~a ~a~n',[X,Y,A1,A2,A3]).
ex(slices) :-
s := 'supercalifragilisticexpialidocious',
L := len($s),
S1 := $s^[1:6],
S2 := $s^[-6: -1],
S3 := $s^[_:6],
S4 := $s^[-6:_],
format('slices=~d ~a ~a ~a ~a~n',[L,S1,S2,S3,S4]).
ex(lists) :-
a := [66.25, 333, 333, 1, 1234.5],
A1 := $a:count(333), A2 := $a:count(66.25), A3 := $a:count(x),
format('counts=~d ~d ~d~n',[A1,A2,A3]),
:= $a:insert(2, -1),
:= $a:append(333),
A := $a,
format('a=~w~n', [A]),
I := $a:index(333),
:= $a:remove(333),
B := $a,
format('a=~w~n', [B]),
:= $a:reverse(_),
C := $a,
format('a=~w~n', [C]),
:= $a:sort(_),
D := $a,
format('a=~w~n', [D]).
ex(iter) :-
it := iter(abc),
format('iter= ', []),
iterate(iter).
iterate(iter) :-
repeat,
( X1 := $it:next,
format('i ~a~n', [X1])
->
fail
;
!
).
ex(range) :-
r1 := range(1000),
r2 := range(1000,2000),
r3 := range(2000,10000,1),
S := sum($r1+ $r2+ $r3),
format('range=~d~n', [S]).

949
packages/python/python.c
View File

File diff suppressed because it is too large Load Diff

162
packages/python/python.pl
View File

@ -59,8 +59,7 @@ Data types are
:- use_module(library(lists)).
:- use_module(library(apply_macros)).
:- use_module(library(charsio)).
:- dynamic python_mref_cache/2.
:- dynamic python_mref_cache/2, python_obj_cache/2.
:= F :- python(F,_).
@ -91,67 +90,110 @@ module_extend(M0, M:E, MF, EF, MRef0, MRef) :-
module_extend(MM, E, MF, EF, MRef1, MRef).
module_extend(M, E, M, E, MRef, MRef).
% given an object, detect its len method
python_eval_term(Expression, O) :-
fetch_module(Expression, Module, Exp, MRef), !,
(
atom(Exp)
->
python_access(MRef, Exp, O)
;
functor(Exp, F, _),
python_f(MRef, F, FRef),
python_check_args(FRef, Exp, NExp),
python_apply(FRef, NExp, O)
).
python_eval_term(Obj:Field, O) :-
python_access(Obj, Field, O).
object_prefix('__obj__'(_)).
object_prefix('$'(_)).
object_prefix('__obj__'(_):_).
object_prefix('$'(_):_).
% from an exp take an object, and its corresponding Prolog representation
descend_exp(V, _Obj, _F, _S) :-
var(V), !,
throw(error(instantiation_error,_)).
descend_exp(Exp, Obj, F, S) :-
object_prefix(Exp),
!,
python_field(Exp, Obj, F, S).
descend_exp(Exp, Obj, F, S) :-
python_mref_cache(_, MObj),
python_field(MObj:Exp, Obj, F, S), !.
descend_exp(Mod:Exp, Obj, F, S) :-
atom(Mod),
python_import(Mod, MObj),
python_field(MObj:Exp, Obj, F, S), !.
python_check_args(FRef, Exp, NExp) :-
python_class(Obj) :-
python_obj_cache(inspect:isclass(_), F),
python_apply(F, isclass(Obj), {}, true).
process_obj(Obj, _, S, Obj, NS, Dict) :-
python_callable(Obj), !,
python_check_args(S, NS, Dict).
process_obj(Obj, _, S, Obj, NS, Dict) :-
python_class(Obj),
descend_object(Obj:'__init__', FObj, _, _),
python_check_args(S, NS, Dict).
python_eval_term(Obj, Obj) :-
var(Obj), !.
python_eval_term('__obj__'(Obj), '__obj__'(Obj)) :- !.
python_eval_term($Name, Obj) :- !,
python_is($Name, Obj).
python_eval_term([H|T], [NH|NT]) :- !,
python_eval_term(H, NH),
python_eval_term(T, NT).
python_eval_term(N, N) :- atomic(N), !.
python_eval_term(Exp, O) :-
descend_exp(Exp, Obj, Old, S), !,
(functor(S, _, 0) ->
O = Obj
;
python_check_args(S, NS, Dict),
python_apply(Obj, NS, Dict, O)
).
python_eval_term(S, O) :-
python_check_args(S, NS, {}),
python_is(NS, O).
python_check_args(Exp, t, {}) :-
Exp =.. [_,V], var(V), !.
python_check_args(Exp, NExp, Dict) :-
functor(Exp, _, Arity),
arg(Arity, Exp, _=_), !,
fetch_args(FRef, Dict),
Exp =.. [F|LArgs],
match_args(LArgs, Dict, NLArgs, _),
NExp =.. [F|NLArgs].
python_check_args(FRef, Exp, NExp).
arg(Arity, Exp, A), nonvar(A), A = (_=_), !,
Exp =.. [_F|LArgs],
match_args(LArgs, NLArgs, Dict),
NExp =.. [t|NLArgs].
python_check_args(Exp, NExp, {}) :-
Exp =.. [F|L],
maplist(python_eval_term, L, LF),
NExp =.. [F|LF].
fetch_args(FRef, Args) :-
python_import('inspect', M),
python_f(M, getargspec, F),
python_apply(F, getargspec(FRef), ExtraArgs),
ExtraArgs=t(Args, _, _, _).
% in case it is __init__ from __new__
splice_class(Ref, Ref, ArgNames, ArgNames) :- !.
splice_class(_FRef, _Ref, [_|ArgNames], ArgNames).
match_args([], [], {}).
match_args([V=A|LArgs], [], Dict) :- !,
match_named_args([V=A|LArgs], Map),
map_to_dict(Map, Dict).
match_args([A|LArgs], [VA|NLArgs], Dict) :-
python_eval_term(A, VA),
match_args(LArgs, NLArgs, Dict).
match_named_args([], []).
match_named_args([K=A|LArgs], [K=VA|Map]) :-
python_eval_term(A, VA),
match_named_args(LArgs, Map).
match_args([], _, [], ok).
match_args([A=V|LArgs], Dict, [I=V|NLArgs], OK) :-
match_args(LArgs, Dict, NLArgs, ok), !,
( nth0(I, Dict, A) -> true ; throw(type_error(argument(A=V))) ).
match_args([A|LArgs], Dict, [A|NLArgs], not_ok) :-
match_args(LArgs, Dict, NLArgs, _).
map_to_dict([X=V], {X:V}) :- !.
map_to_dict([X=V|Map], {X:V,NDict}) :-
map_to_dict(Map, {NDict}).
match_from_anames([K|_ArgNames], K, VA, [_|Defaults], [VA|Defaults]) :- !.
match_from_anames([_|ArgNames], K, VA, [V|Defaults], [V|NDefaults]) :-
match_from_anames(ArgNames, K, VA, Defaults, NDefaults).
fetch_args(FRef, Args, Kwd, Defaults) :-
FRef = '__obj__'(_), !,
python_mref_cache('inspect', M),
python_obj_cache(inspect:getargspec(_), F),
python_apply(F, getargspec(FRef), {}, ExtraArgs),
ExtraArgs=t(Args, _, Kwd, Defaults).
fetch_args(_, []).
python(Obj, Out) :-
python_eval_term(Obj, Out), !.
python(Obj, OArg) :-
python_do_is(Obj, Obj1),
python_is(Obj1, OArg).
python_do_is(A+B, NA+NB) :- !,
python_do_is(A, NA),
python_do_is(B, NB).
python_do_is(A-B, NA-NB) :- !,
python_do_is(A, NA),
python_do_is(B, NB).
python_do_is(A*B, NA*NB) :- !,
python_do_is(A, NA),
python_do_is(B, NB).
python_do_is(A/B, NA/NB) :- !,
python_do_is(A, NA),
python_do_is(B, NB).
python_do_is(A, NA) :-
python_eval_term(A, NA), !.
python_do_is(A, A).
python_eval_term(Obj, Out).
python_command(Cmd) :-
python_run_command(Cmd).
@ -159,8 +201,16 @@ python_command(Cmd) :-
start_python :-
use_foreign_library(foreign(python)),
init_python,
python_main_module(MRef),
assert(python_mref_cache('__main__', MRef)),
python_command('import sys'),
python_command('import inspect').
python_import('inspect'),
python_mref_cache(inspect, InspRef),
python_field(InspRef:isclass(_), IsClass, _, _),
assert(python_obj_cache(inspect:isclass(_), IsClass)),
python_field(InspRef:getargspec(_), GetArgSpec, _, _),
assert(python_obj_cache(inspect:getargspec(_), GetArgSpec)),
at_halt(end_python).
add_cwd_to_python :-
unix(getcwd(Dir)),

2
packages/real

@ -1 +1 @@
Subproject commit 6575e08bd063e0d0476a1bdbfe216684b4d5e6e4
Subproject commit 29a8436d86886cf932a790a013cfcf10240c68c8

2
pl/attributes.yap
View File

@ -270,7 +270,7 @@ call_residue(Goal,Module,Residue) :-
delayed_goals(G, Vs, NVs, Gs) :-
project_delayed_goals(G),
copy_term(G.Vs, _.NVs, Gs).
copy_term([G|Vs], [_|NVs], Gs).
project_delayed_goals(G) :-
% SICStus compatible step,

122
pl/boot.yap
View File

@ -92,7 +92,6 @@ true :- true.
'$init_or_threads',
'$run_at_thread_start'.
'$init_globals' :-
'$init_consult',
nb_setval('$chr_toplevel_show_store',false),
@ -218,7 +217,7 @@ true :- true.
get_value('$top_level_goal',GA), GA \= [], !,
set_value('$top_level_goal',[]),
'$run_atom_goal'(GA),
set_value('$live','$false').
halt(0).
'$enter_top_level' :-
'$disable_docreep',
'$run_toplevel_hooks',
@ -229,8 +228,7 @@ true :- true.
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
'$command'(Command,Varnames,_Pos,top),
'$sync_mmapped_arrays',
set_value('$live','$false').
halt(0).
'$erase_sets' :-
@ -436,7 +434,7 @@ true :- true.
->
'$assertz_dynamic'(L,G,G0,Mod)
;
catch(nb_getval('$assert_all',on),_,fail)
'$nb_getval'('$assert_all',on,fail)
->
functor(H,N,A),
'$dynamic'(N/A,Mod),
@ -537,7 +535,7 @@ true :- true.
yap_hacks:current_choice_point(NCP1),
'$attributes':delayed_goals(G, V, NV, LGs),
yap_hacks:current_choice_point(NCP2),
'$clean_ifcp'(CP),
'$clean_ifcp'(CP),
NCP is NCP2-NCP1
;
copy_term_nat(V, NV),
@ -573,7 +571,7 @@ true :- true.
flush_output,
fail.
'$present_answer'((?-), Answ) :-
nb_getval('$break',BL),
'$nb_getval'('$break',BL,fail),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ),
( recorded('$print_options','$toplevel'(Opts),_) ->
@ -732,9 +730,8 @@ true :- true.
'$name_vars_in_goals1'(GVL, 0, _).
'$name_well_known_vars'([]).
'$name_well_known_vars'([[SName|V]|NVL0]) :-
'$name_well_known_vars'([Name=V|NVL0]) :-
var(V), !,
atom_codes(Name, SName),
V = '$VAR'(Name),
'$name_well_known_vars'(NVL0).
'$name_well_known_vars'([_|NVL0]) :-
@ -903,8 +900,8 @@ not(G) :- \+ '$execute'(G).
'$call'(G, CP, G0, CurMod) :-
( '$is_expand_goal_or_meta_predicate'(G,CurMod) ->
(
'$notrace'(('$pred_exists'(goal_expansion(G,NG), CurMod), CurMod:goal_expansion(G,NG) ; system:goal_expansion(G,NG) ; user:goal_expansion(G, CurMod, NG) ; user:goal_expansion(G,NG) )) ->
'$call'(NG, CP, G0,CurMod)
'$do_goal_expansion'(G, CurMod, NG) ->
'$call'(NG, CP, G0,CurMod)
;
% repeat other code.
'$is_metapredicate'(G,CurMod) ->
@ -997,39 +994,6 @@ not(G) :- \+ '$execute'(G).
throw(Ball).
/* This is the break predicate,
it saves the importante data about current streams and
debugger state */
break :-
nb_getval('$system_mode',SystemMode),
nb_getval('$trace',Trace),
nb_setval('$trace',off),
nb_getval('$debug_jump',Jump),
nb_getval('$debug_run',Run),
'$debug_on'(Debug),
'$debug_on'(false),
nb_getval('$break',BL), NBL is BL+1,
nb_getval('$spy_gn',SPY_GN),
b_getval('$spy_glist',GList),
b_setval('$spy_glist',[]),
nb_setval('$break',NBL),
current_output(OutStream), current_input(InpStream),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live',
!,
set_value('$live','$true'),
b_setval('$spy_glist',GList),
nb_setval('$spy_gn',SPY_GN),
set_input(InpStream),
set_output(OutStream),
'$debug_on'(Debug),
nb_setval('$debug_jump',Jump),
nb_setval('$debug_run',Run),
nb_setval('$trace',Trace),
nb_setval('$break',BL),
nb_setval('$system_mode',SystemMode).
'$silent_bootstrap'(F) :-
'$init_globals',
nb_setval('$if_level',0),
@ -1153,18 +1117,12 @@ bootstrap(F) :-
expand_term(Term,Expanded) :-
'$current_module'(Mod),
( \+ '$undefined'(term_expansion(_,_), Mod),
'$notrace'(Mod:term_expansion(Term,Expanded))
; \+ '$undefined'(term_expansion(_,_), system),
'$notrace'(system:term_expansion(Term,Expanded))
; Mod \= user, \+ '$undefined'(term_expansion(_,_), user),
'$notrace'(user:term_expansion(Term,Expanded))
( '$do_term_expansion'(Term,Expanded)
->
true
;
'$expand_term_grammar'(Term,Expanded)
),
!.
).
%
% Grammar Rules expansion
@ -1173,15 +1131,6 @@ expand_term(Term,Expanded) :-
'$translate_rule'((A-->B),C), !.
'$expand_term_grammar'(A, A).
%
% Arithmetic expansion
%
'$expand_term_arith'(G1, G2) :-
get_value('$c_arith',true),
'$c_arith'(G1, G2), !.
'$expand_term_arith'(G,G).
%
% Arithmetic expansion
%
@ -1261,8 +1210,9 @@ catch_ball(Ball, V) :-
catch_ball(C, C).
'$run_toplevel_hooks' :-
nb_getval('$break',0),
recorded('$toplevel_hooks',H,_), !,
'$nb_getval'('$break', 0, fail),
recorded('$toplevel_hooks',H,_),
H \= fail, !,
( '$oncenotrace'(H) -> true ; true).
'$run_toplevel_hooks'.
@ -1271,7 +1221,7 @@ catch_ball(C, C).
'$exit_system_mode' :-
nb_setval('$system_mode',off),
( catch(nb_getval('$trace',on),_,fail) -> '$creep' ; true).
( '$nb_getval'('$trace',on,fail) -> '$creep' ; true).
%
% just prevent creeping from going on...
@ -1301,20 +1251,6 @@ catch_ball(C, C).
'$notrace'(G) :-
'$execute'(G).
'$oncenotrace'(G) :-
'$disable_creep', !,
(
'$execute'(G)
->
'$creep'
;
'$creep',
fail
).
'$oncenotrace'(G) :-
'$execute'(G), !.
'$run_at_thread_start' :-
recorded('$thread_initialization',M:D,_),
'$notrace'(M:D),
@ -1322,31 +1258,5 @@ catch_ball(C, C).
'$run_at_thread_start'.
nb_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) ->
nb_getval(GlobalVariable, Val)
;
'$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val))
).
b_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) ->
true
;
'$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val))
).

40
pl/consult.yap
View File

@ -290,26 +290,26 @@ use_module(M,F,Is) :-
!.
'$reset_if'(OldIfLevel) :-
catch(nb_getval('$if_level',OldIfLevel),_,fail), !,
'$nb_getval'('$if_level', OldIfLevel, fail), !,
nb_setval('$if_level',0).
'$reset_if'(0) :-
nb_setval('$if_level',0).
'$get_if'(Level0) :-
catch(nb_getval('$if_level',Level),_,fail), !,
'$nb_getval'('$if_level', Level, fail), !,
Level0 = Level.
'$get_if'(0).
'$into_system_mode'(OldMode) :-
( catch(nb_getval('$system_mode', OldMode),_,fail) -> true ; OldMode = off),
( '$nb_getval'('$system_mode', OldMode, fail) -> true ; OldMode = off),
( OldMode == off -> '$enter_system_mode' ; true ).
'$ensure_consulting_file'(OldF, Stream) :-
( catch(nb_getval('$consulting_file',OldF), _, fail) -> true ; OldF = []),
( '$nb_getval'('$consulting_file',OldF, fail) -> true ; OldF = []),
'$set_consulting_file'(Stream).
'$ensure_consulting'(Old, New) :-
( catch(nb_getval('$consulting',Old), _, fail) -> true ; Old = false ),
( '$nb_getval'('$consulting',Old, fail) -> true ; Old = false ),
nb_setval('$consulting', New).
'$bind_module'(_, load_files).
@ -409,12 +409,12 @@ initialization(G,OPT) :-
'$exec_initialisation_goals' :-
'$show_consult_level'(Level),
'$current_module'(M),
findall(
G,
(recorded('$initialisation',do(Level,G),R), erase(R), G\='$'),
recorded('$initialisation',do(Level,_),_),
findall(G,
'$fetch_init_goal'(Level, G),
LGs),
lists:member(G,LGs),
nb_getval('$system_mode', OldMode),
'$nb_getval'('$system_mode', OldMode, fail),
( OldMode == on -> '$exit_system_mode' ; true ),
% run initialization under user control (so allow debugging this stuff).
(
@ -428,6 +428,12 @@ initialization(G,OPT) :-
'$exec_initialisation_goals' :-
nb_setval('$initialization_goals',off).
'$fetch_init_goal'(Level, G) :-
recorded('$initialisation',do(Level,G),R),
erase(R),
G\='$'.
'$include'(V, _) :- var(V), !,
'$do_error'(instantiation_error,include(V)).
'$include'([], _) :- !.
@ -437,7 +443,7 @@ initialization(G,OPT) :-
'$include'(X, Status) :-
get_value('$lf_verbose',Verbosity),
'$full_filename'(X,Y,include(X)),
( catch( nb_getval('$included_file',OY), _, fail ) -> true ; OY = [] ),
( '$nb_getval'('$included_file', OY, fail ) -> true ; OY = [] ),
nb_setval('$included_file', Y),
'$current_module'(Mod),
H0 is heapused, '$cputime'(T0,_),
@ -489,13 +495,13 @@ source_file(Mod:Pred, FileName) :-
'$owner_file'(T, Mod, FileName).
prolog_load_context(_, _) :-
nb_getval('$consulting_file',[]), !, fail.
'$nb_getval'('$consulting_file', [], fail), !, fail.
prolog_load_context(directory, DirName) :-
getcwd(DirName).
prolog_load_context(file, FileName) :-
( catch( nb_getval('$included_file',IncFileName), _, fail ) -> true ; IncFileName = [] ),
( '$nb_getval'('$included_file', IncFileName, fail ) -> true ; IncFileName = [] ),
( IncFileName = [] ->
nb_getval('$consulting_file',FileName),
'$nb_getval'('$consulting_file', FileName, fail),
FileName \= []
;
FileName = IncFileName
@ -649,8 +655,10 @@ absolute_file_name(File0,File) :-
'$full_filename'(F0,F,G) :-
'$absolute_file_name'(F0,[access(read),file_type(source),file_errors(fail),solutions(first),expand(true)],F,G).
% fix wrong argument order, TrueFileName should be last.
absolute_file_name(File,TrueFileName,Opts) :-
( var(TrueFileName) ; atom(TrueFileName) ), !,
( var(TrueFileName) -> true ; atom(TrueFileName), TrueFileName \= [] ),
!,
absolute_file_name(File,Opts,TrueFileName).
absolute_file_name(File,Opts,TrueFileName) :-
'$absolute_file_name'(File,Opts,TrueFileName,absolute_file_name(File,Opts,TrueFileName)).
@ -1006,7 +1014,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
'$set_yap_flags'(11,0).
'$fetch_comp_status'(assert_all) :-
catch(nb_getval('$assert_all',on), _, fail), !.
'$nb_getval'('$assert_all',on, fail), !.
'$fetch_comp_status'(source) :-
'$access_yap_flags'(11,1).
'$fetch_comp_status'(compact).
@ -1049,7 +1057,7 @@ make_library_index(_Directory).
).
'$current_loop_stream'(Stream) :-
catch(nb_getval('$loop_stream',Stream), _, fail).
'$nb_getval'('$loop_stream',Stream, fail).
exists_source(File) :-
'$full_filename'(File, AbsFile, exists_source(File)).

106
pl/control.yap
View File

@ -145,7 +145,7 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
'$clean_call'(_, _).
'$cc_check_throw' :-
nb_getval('$catch',Ball),
'$nb_getval'('$catch', Ball, fail),
throw(Ball).
%%% The unknown predicate,
@ -289,11 +289,115 @@ version(T) :-
fail.
'$set_toplevel_hook'(_).
'$oncenotrace'(G) :-
'$disable_creep', !,
(
'$execute'(G)
->
'$creep'
;
'$creep',
fail
).
'$oncenotrace'(G) :-
'$execute'(G), !.
'$once0'(G, M) :-
'$pred_exists'(G, M),
(
'$disable_creep'
->
(
'$execute_nonstop'(G, M)
->
'$creep'
;
'$creep',
fail
)
;
'$execute_nonstop'(G,M)
).
nb_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, nb_getval(GlobalVariable, Val)) ->
nb_getval(GlobalVariable, Val)
;
'$do_error'(existence_error(variable, GlobalVariable),nb_getval(GlobalVariable, Val))
).
b_getval(GlobalVariable, Val) :-
'$nb_getval'(GlobalVariable, Val, Error),
(var(Error)
->
true
;
'$getval_exception'(GlobalVariable, Val, b_getval(GlobalVariable, Val)) ->
true
;
'$do_error'(existence_error(variable, GlobalVariable),b_getval(GlobalVariable, Val))
).
/* This is the break predicate,
it saves the importante data about current streams and
debugger state */
break :-
nb_getval('$system_mode',SystemMode),
nb_getval('$trace',Trace),
nb_setval('$trace',off),
nb_getval('$debug_jump',Jump),
nb_getval('$debug_run',Run),
'$debug_on'(Debug),
'$debug_on'(false),
nb_getval('$break',BL), NBL is BL+1,
nb_getval('$spy_gn',SPY_GN),
b_getval('$spy_glist',GList),
b_setval('$spy_glist',[]),
nb_setval('$break',NBL),
current_output(OutStream), current_input(InpStream),
format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live',
!,
set_value('$live','$true'),
b_setval('$spy_glist',GList),
nb_setval('$spy_gn',SPY_GN),
set_input(InpStream),
set_output(OutStream),
'$debug_on'(Debug),
nb_setval('$debug_jump',Jump),
nb_setval('$debug_run',Run),
nb_setval('$trace',Trace),
nb_setval('$break',BL),
nb_setval('$system_mode',SystemMode).
at_halt(G) :-
recorda('$halt', G, _),
fail.
at_halt(_).
halt :-
print_message(informational, halt),
fail.
halt :-
'$halt'(0).
halt(_) :-
recorded('$halt', G, _),
call(G),
fail.
halt(X) :-
'$sync_mmapped_arrays',
set_value('$live','$false'),
'$halt'(X).
prolog_current_frame(Env) :-

6
pl/errors.yap
View File

@ -248,7 +248,7 @@ print_message(Severity, Term) :-
% first step at hook processing
'$message_to_lines'(Term, Lines),
( nonvar(Term),
'$oncenotrace'(user:message_hook(Term, Severity, Lines))
'$once0'(message_hook(Term, Severity, Lines), user)
->
true
;
@ -263,9 +263,9 @@ print_message(_, Term) :-
format(user_error,'~q~n',[Term]).
'$message_to_lines'(Term, Lines) :-
'$oncenotrace'(user:generate_message_hook(Term, [], Lines)), !.
'$once0'(generate_message_hook(Term, [], Lines), user), !.
'$message_to_lines'(Term, Lines) :-
'$oncenotrace'(prolog:message(Term, Lines, [])), !.
'$once0'(message(Term, Lines, []), prolog), !.
'$message_to_lines'(Term, Lines) :-
'$messages':generate_message(Term, Lines, []), !.

13
pl/flags.yap
View File

@ -118,6 +118,18 @@ yap_flag(agc_margin,Margin) :-
%
% SWI compatibility flag
%
yap_flag(debug_on_error,X) :-
var(X), !,
X = false.
yap_flag(debug_on_error,true) :- !,
X = true,
'$do_error'(domain_error(flag_value,debug_on_error+X),yap_flag(debug_on_error,X)).
yap_flag(debug_on_error,false) :- !.
yap_flag(debug_on_error,X) :-
'$do_error'(domain_error(flag_value,debug_on_error+X),yap_flag(debug_on_error,X)).
yap_flag(generate_debug_info,X) :-
var(X), !,
'$access_yap_flags'(18,Options),
@ -830,6 +842,7 @@ yap_flag(dialect,yap).
'$yap_system_flag'(character_escapes).
'$yap_system_flag'(chr_toplevel_show_store).
'$yap_system_flag'(debug).
'$yap_system_flag'(debug_on_error ).
'$yap_system_flag'(debugger_print_options).
'$yap_system_flag'(dialect).
'$yap_system_flag'(discontiguous_warnings).

2
pl/listing.yap
View File

@ -35,7 +35,7 @@ listing(V) :-
'$listing'(V,Mod,Stream) :- var(V), !,
'$current_predicate_no_modules'(Mod,_,Pred),
'$list_clauses'(Stream,Mod,Pred).
( '$list_clauses'(Stream,Mod,Pred) ; true ).
'$listing'(M:V,_,Stream) :- !,
'$listing'(V,M,Stream).
'$listing'([],_,_) :- !.

8
pl/modules.yap
View File

@ -396,11 +396,7 @@ expand_goal(G, G).
% make built-in processing transparent.
'$match_mod'(G, M, ORIG, HM, G1),
'$c_built_in'(G1, M, Gi),
(Gi \== G1 ->
'$module_expansion'(Gi, G2, _, M, CM, HM, HVars)
;
G2 = G1
).
G1 = G2.
'$complete_goal_expansion'(G, GMod, _, HM, NG, NG, _) :-
'$match_mod'(G, GMod, GMod, HM, NG).
@ -586,6 +582,7 @@ source_module(Mod) :-
assertz(:),
assertz(:,+),
assertz_static(:),
at_halt(0),
bagof(?,0,-),
bb_get(:,-),
bb_put(:,+),
@ -650,6 +647,7 @@ source_module(Mod) :-
setup_call_cleanup(0,0,0),
setup_call_catcher_cleanup(0,0,?,0),
spy(:),
stash_predicate(:),
unknown(+,:),
use_module(:),
use_module(:,?),

17
pl/preds.yap
View File

@ -791,6 +791,23 @@ dynamic_predicate(P,Sem) :-
'$flags'(T,Mod,F,F),
F\/0x00400000 =\= 0.
stash_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,stash_predicate(V)).
stash_predicate(M:P) :- !,
'$stash_predicate2'(P, M).
stash_predicate(P) :-
'$current_module'(M),
'$stash_predicate2'(P, M).
'$stash_predicate2'(V, M) :- var(V), !,
'$do_error'(instantiation_error,stash_predicate(M:V)).
'$stash_predicate2'(N/A, M) :- !,
functor(S,N,A),
'$stash_predicate'(S, M) .
'$stash_predicate2'(PredDesc, M) :-
'$do_error'(type_error(predicate_indicator,PredDesc),stash_predicate(M:PredDesc)).
hide_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,hide_predicate(V)).
hide_predicate(M:P) :- !,

16
pl/signals.yap
View File

@ -36,7 +36,7 @@
'$do_signal'(sig_creep, [M|G]) :-
'$creep_allowed', !,
(
( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 )
( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 )
->
(
'$execute_nonstop'(G0,M),
@ -50,7 +50,7 @@
).
%
'$do_signal'(sig_creep, [M|G]) :-
( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ),
( G = '$notrace'(G0) ; G = '$oncenotrace'(G0) ; G = '$once0'(G0) ; G = '$execute0'(G0,M) ; '$system_module'(M), G = G0 ),
!,
(
'$execute_nonstop'(G0,M),
@ -168,6 +168,18 @@
'$creep',
fail
).
'$start_creep'([M0|'$once0'(G)]) :-
!,
('$execute_nonstop'(G,M0),
CP1 is '$last_choice_pt',
% exit port: creep
'$creep',
!
;
% put it back again on fail
'$creep',
fail
).
% do not debug if we are not in debug mode.
'$start_creep'([Mod|G]) :-
'$debug_on'(DBON), DBON = false, !,