diff --git a/C/absmi.c b/C/absmi.c index a2c520179..f64ef6ae6 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -857,7 +857,6 @@ Yap_absmi(int inp) BOp(Ystop, l); SET_ASP(YREG, E_CB*sizeof(CELL)); /* make sure ASP is initialised */ - Yap_StartSlots( PASS_REGS1 ); saveregs(); #if PUSH_REGS diff --git a/C/c_interface.c b/C/c_interface.c index 0a7d35f4f..0b39bfbd9 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -462,6 +462,7 @@ X_API Term STD_PROTO(YAP_NBufferToDiffList, (char *, Term, size_t)); X_API Term STD_PROTO(YAP_WideBufferToDiffList, (wchar_t *, Term)); X_API Term STD_PROTO(YAP_NWideBufferToDiffList, (wchar_t *, Term, size_t)); X_API void STD_PROTO(YAP_Error,(int, Term, char *, ...)); +X_API Int STD_PROTO(YAP_RunPredicate,(PredEntry *, Term *)); X_API Int STD_PROTO(YAP_RunGoal,(Term)); X_API Int STD_PROTO(YAP_RunGoalOnce,(Term)); X_API int STD_PROTO(YAP_RestartGoal,(void)); @@ -472,7 +473,7 @@ X_API int STD_PROTO(YAP_LeaveGoal,(int, YAP_dogoalinfo *)); X_API int STD_PROTO(YAP_GoalHasException,(Term *)); X_API void STD_PROTO(YAP_ClearExceptions,(void)); X_API int STD_PROTO(YAP_ContinueGoal,(void)); -X_API void STD_PROTO(YAP_PruneGoal,(void)); +X_API void STD_PROTO(YAP_PruneGoal,(YAP_dogoalinfo *)); X_API IOSTREAM *STD_PROTO(YAP_TermToStream,(Term)); X_API IOSTREAM *STD_PROTO(YAP_InitConsult,(int, char *)); X_API void STD_PROTO(YAP_EndConsult,(IOSTREAM *)); @@ -2272,36 +2273,14 @@ YAP_AtomToPredInModule(Atom at, Term mod) static int -run_emulator(YAP_dogoalinfo *dgi) +run_emulator(YAP_dogoalinfo *dgi USES_REGS) { - CACHE_REGS - choiceptr myB; int out; - BACKUP_MACHINE_REGS(); LOCAL_PrologMode = UserMode; out = Yap_absmi(0); LOCAL_PrologMode = UserCCallMode; - myB = (choiceptr)(LCL0-dgi->b); - CP = myB->cp_cp; - if (!out ) { - /* recover stack */ - /* on failed computations */ - TR = B->cp_tr; - H = B->cp_h; -#ifdef DEPTH_LIMIT - DEPTH = B->cp_depth = DEPTH; -#endif /* DEPTH_LIMIT */ - YENV = ENV = B->cp_env; - ASP = (CELL *)(B+1); - Yap_PopSlots( PASS_REGS1 ); - B = B->cp_b; - HB = B->cp_h; - } else { - Yap_StartSlots( PASS_REGS1 ); - } - P = dgi->p; - RECOVER_MACHINE_REGS(); + Yap_StartSlots(PASS_REGS1); return out; } @@ -2309,39 +2288,15 @@ X_API int YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi) { CACHE_REGS - UInt i; - choiceptr myB; int out; BACKUP_MACHINE_REGS(); dgi->p = P; - ptr--; - i = pe->ArityOfPE; - while (i>0) { - XREGS[i] = ptr[i]; - i--; - } + dgi->cp = CP; P = pe->CodeOfPred; - /* create a choice-point to be tag new goal */ - myB = (choiceptr)ASP; - myB--; - dgi->b = LCL0-(CELL *)myB; - myB->cp_tr = TR; - myB->cp_h = HB = H; - myB->cp_b = B; -#ifdef DEPTH_LIMIT - myB->cp_depth = DEPTH; -#endif /* DEPTH_LIMIT */ - myB->cp_cp = CP; - myB->cp_ap = NOCODE; - myB->cp_env = ENV; - CP = YESCODE; - B = myB; - HB = H; - ASP = YENV = (CELL *)B; - Yap_PopSlots( PASS_REGS1 ); - YENV[E_CB] = Unsigned (B); - out = run_emulator(dgi); + Yap_PrepGoal(pe->ArityOfPE, ptr, B PASS_REGS); + dgi->b = LCL0-(CELL*)B; + out = run_emulator(dgi PASS_REGS); RECOVER_MACHINE_REGS(); return out; } @@ -2361,7 +2316,7 @@ YAP_RetryGoal(YAP_dogoalinfo *dgi) return FALSE; } P = FAILCODE; - out = run_emulator(dgi); + out = run_emulator(dgi PASS_REGS); RECOVER_MACHINE_REGS(); return out; } @@ -2400,15 +2355,25 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi) Yap_TrimTrail(); } /* recover local stack */ - ASP = (CELL *)(B+1); - Yap_PopSlots( PASS_REGS1 ); +#ifdef DEPTH_LIMIT + DEPTH= ENV[E_DEPTH]; +#endif /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { POP_EXECUTE(); } - B = B->cp_b; - HB = B->cp_h; + ENV = (CELL *)(ENV[E_E]); + /* ASP should be set to the top of the local stack when we + did the call */ + ASP = B->cp_env; + /* YENV should be set to the current environment */ + YENV = ENV = (CELL *)((B->cp_env)[E_E]); + B = B->cp_b; + //SET_BB(B); + HB = PROTECT_FROZEN_H(B); + Yap_PopSlots( PASS_REGS1 ); + CP = dgi->cp; P = dgi->p; RECOVER_MACHINE_REGS(); return TRUE; @@ -2645,12 +2610,13 @@ YAP_ContinueGoal(void) } X_API void -YAP_PruneGoal(void) +YAP_PruneGoal(YAP_dogoalinfo *gi) { CACHE_REGS - BACKUP_B(); + BACKUP_B(); - while (B->cp_ap != NOCODE) { + choiceptr myB = (choiceptr)(LCL0-gi->b); + while (B != myB) { /* make sure we prune C-choicepoints */ if (POP_CHOICE_POINT(B->cp_b)) { @@ -2661,9 +2627,6 @@ YAP_PruneGoal(void) B = B->cp_b; } Yap_TrimTrail(); - /* make sure that we do not destroy the guard choice-point */ - if (Yap_op_from_opcode(B->cp_ap->opc) != _Nstop) - B = B->cp_b; RECOVER_B(); } diff --git a/C/exec.c b/C/exec.c index 82c31d315..9c2a16a7f 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1126,8 +1126,8 @@ exec_absmi(int top USES_REGS) } -static void -init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS) +void +Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) { /* create an initial pseudo environment so that when garbage collection is going up in the environment chain it doesn't get @@ -1168,8 +1168,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS) #endif /* DEPTH_LIMIT */ YENV = ASP = (CELL *)B; HB = H; - /* start with some slots so that we can use them */ - Yap_StartSlots( PASS_REGS1 ); CP = YESCODE; } @@ -1179,7 +1177,7 @@ do_goal(yamop *CodeAdr, int arity, CELL *pt, int top USES_REGS) choiceptr saved_b = B; Int out; - init_stack(arity, pt, top, saved_b PASS_REGS); + Yap_PrepGoal(arity, pt, saved_b PASS_REGS); P = (yamop *) CodeAdr; S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ @@ -1774,8 +1772,7 @@ Yap_InitYaamRegs( int myworker_id ) LOCK(REMOTE_SignalLock(myworker_id)); CreepFlag = CalculateStackGap(); UNLOCK(REMOTE_SignalLock(myworker_id)); - EX = NULL; - init_stack(0, NULL, TRUE, NULL PASS_REGS); + Yap_PrepGoal(0, NULL, NULL PASS_REGS); /* the first real choice-point will also have AP=FAIL */ /* always have an empty slots for people to use */ CurSlot = 0; diff --git a/H/Yap.h b/H/Yap.h index f54429edc..04457def9 100755 --- a/H/Yap.h +++ b/H/Yap.h @@ -107,6 +107,10 @@ #endif /* HAVE_SYS_TIME_H */ #endif /* _MSC_VER */ +#if HAVE_TIME_H +#include +#endif + #ifdef __MINGW32__ #ifndef _WIN32 #define _WIN32 1 @@ -755,6 +759,10 @@ typedef struct thandle { #endif pthread_mutex_t tlock; pthread_mutex_t tlock_status; +#if HAVE_GETHRTIME + hrtime_t start_of_w_times; + hrtime_t last_w_time; +#endif #if HAVE_GETRUSAGE struct timeval *start_of_timesp; struct timeval *last_timep; @@ -861,6 +869,8 @@ extern struct worker_local Yap_local; static inline void Yap_StartSlots( USES_REGS1 ) { + if (CurSlot == LCL0-ASP) + return; *--ASP = MkIntegerTerm(CurSlot); *--ASP = MkIntTerm(0); CurSlot = LCL0-ASP; diff --git a/H/Yapproto.h b/H/Yapproto.h index b2fe79b8c..a132d015a 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -182,6 +182,7 @@ Int STD_PROTO(Yap_execute_goal,(Term, int, Term)); Int STD_PROTO(Yap_exec_absmi,(int)); void STD_PROTO(Yap_trust_last,(void)); Term STD_PROTO(Yap_GetException,(void)); +void STD_PROTO(Yap_PrepGoal,(UInt, CELL *, choiceptr USES_REGS)); /* exo.c */ void STD_PROTO(Yap_InitExoPreds,(void)); diff --git a/include/YapInterface.h b/include/YapInterface.h index 80f9e6e7f..f4bb46c3d 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -274,6 +274,8 @@ extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *)); /* int YAP_RunGoal(YAP_Term) */ extern X_API YAP_Int PROTO(YAP_RunGoal,(YAP_Term)); +extern X_API YAP_Int PROTO(YAP_RunPredicate,(YAP_PredEntryPtr, YAP_Term *)); + /* int YAP_RunGoalOnce(YAP_Term) */ extern X_API YAP_Int PROTO(YAP_RunGoalOnce,(YAP_Term)); @@ -288,7 +290,7 @@ extern X_API YAP_Bool PROTO(YAP_ContinueGoal,(void)); /* void YAP_PruneGoal(void) */ -extern X_API void PROTO(YAP_PruneGoal,(void)); +extern X_API void PROTO(YAP_PruneGoal,(YAP_dogoalinfo *)); /* int YAP_FunctorToPred(struct pred_entry *, YAP_Term *) */ extern X_API YAP_PredEntryPtr PROTO(YAP_FunctorToPred,(YAP_Functor)); diff --git a/include/yap_structs.h b/include/yap_structs.h index 08098748a..0c05be59c 100755 --- a/include/yap_structs.h +++ b/include/yap_structs.h @@ -229,7 +229,7 @@ typedef struct YAP_pred_entry *YAP_PredEntryPtr; /* this should be opaque to the user */ typedef struct { unsigned long b; - struct yami *p; + struct yami *p, *cp; } YAP_dogoalinfo; typedef int (*YAP_agc_hook)(void *_Atom); diff --git a/library/dialect/swi/fli/swi.c b/library/dialect/swi/fli/swi.c index f86aa3175..33d618705 100755 --- a/library/dialect/swi/fli/swi.c +++ b/library/dialect/swi/fli/swi.c @@ -109,23 +109,6 @@ Yap_InitSWIHash(void) } } -static void -PredicateInfo(void *p, Atom* a, unsigned long int* arity, Term* m) -{ - PredEntry *pd = (PredEntry *)p; - if (pd->ArityOfPE) { - *arity = pd->ArityOfPE; - *a = NameOfFunctor(pd->FunctorOfPred); - } else { - *arity = 0; - *a = (Atom)(pd->FunctorOfPred); - } - if (pd->ModuleOfPred) - *m = pd->ModuleOfPred; - else - *m = TermProlog; -} - static void UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int flags) { @@ -2198,7 +2181,7 @@ PL_open_foreign_frame(void) open_query *new = (open_query *)malloc(sizeof(open_query)); if (!new) return 0; new->old = LOCAL_execution; - new->g = TermNil; + new->g = NULL; new->open = FALSE; new->cp = CP; new->p = P; @@ -2245,7 +2228,6 @@ backtrack(void) CACHE_REGS P = FAILCODE; Yap_absmi(0); - H = HB = B->cp_h; TR = B->cp_tr; } @@ -2291,16 +2273,16 @@ PL_discard_foreign_frame(fid_t f) X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0) { CACHE_REGS - Atom yname; - unsigned long int arity; - Term t[2], m; + YAP_Term *t = NULL; + if (t0) + t = Yap_AddressFromSlot(t0 PASS_REGS); /* ignore flags and module for now */ if (!LOCAL_execution) { open_query *new = (open_query *)malloc(sizeof(open_query)); if (!new) return 0; new->old = LOCAL_execution; - new->g = TermNil; + new->g = NULL; new->open = FALSE; new->cp = CP; new->p = P; @@ -2312,31 +2294,8 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0) LOCAL_execution->open=1; LOCAL_execution->state=0; LOCAL_execution->flags = flags; - PredicateInfo((PredEntry *)p, &yname, &arity, &m); - t[0] = SWIModuleToModule(ctx); - if (arity == 0) { - t[1] = MkAtomTerm(yname); - } else { - Functor f = Yap_MkFunctor(yname, arity); - t[1] = Yap_MkApplTerm(f,arity,Yap_AddressFromSlot(t0 PASS_REGS)); - } - if (ctx) { - Term ti; - t[0] = MkAtomTerm((Atom)ctx); - ti = Yap_MkApplTerm(FunctorModule,2,t); - t[0] = ti; - LOCAL_execution->g = Yap_MkApplTerm(FunctorCall,1,t); - } else { - if (m && m != CurrentModule) { - Term ti; - t[0] = m; - ti = Yap_MkApplTerm(FunctorModule,2,t); - t[0] = ti; - LOCAL_execution->g = Yap_MkApplTerm(FunctorCall,1,t); - } else { - LOCAL_execution->g = t[1]; - } - } + LOCAL_execution->pe = (PredEntry *)p; + LOCAL_execution->g = t; return LOCAL_execution; } @@ -2348,10 +2307,10 @@ X_API int PL_next_solution(qid_t qi) if (setjmp(LOCAL_execution->env)) return 0; if (qi->state == 0) { - result = YAP_RunGoal(qi->g); + result = YAP_EnterGoal((YAP_PredEntryPtr)qi->pe, qi->g, &qi->h); } else { LOCAL_AllowRestart = qi->open; - result = YAP_RestartGoal(); + result = YAP_RetryGoal(&qi->h); } qi->state = 1; if (result == 0) { @@ -2363,8 +2322,7 @@ X_API int PL_next_solution(qid_t qi) X_API void PL_cut_query(qid_t qi) { if (qi->open != 1 || qi->state == 0) return; - YAP_PruneGoal(); - YAP_cut_up(); + YAP_LeaveGoal(FALSE, &qi->h); qi->open = 0; } @@ -2379,8 +2337,7 @@ X_API void PL_close_query(qid_t qi) if (qi->open != 1 || qi->state == 0) { return; } - YAP_PruneGoal(); - YAP_RestartGoal(); + YAP_LeaveGoal(FALSE, &qi->h); qi->open = 0; } diff --git a/library/dialect/swi/fli/swi.h b/library/dialect/swi/fli/swi.h index 391c43199..55dac20de 100644 --- a/library/dialect/swi/fli/swi.h +++ b/library/dialect/swi/fli/swi.h @@ -45,11 +45,13 @@ void Yap_install_blobs(void); typedef struct open_query_struct { int open; int state; - YAP_Term g; + YAP_Term *g; + PredEntry *pe; yamop *p, *cp; Int slots, b; jmp_buf env; int flags; + YAP_dogoalinfo h; struct open_query_struct *old; } open_query;