fix SWI exec issues and try to clean up the code a bit

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

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);
+  Yap_StartSlots(PASS_REGS1);
-  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();
   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--;
+  dgi->cp = CP;
-  i = pe->ArityOfPE;
-  while (i>0) {
-    XREGS[i] = ptr[i];
-    i--;
-  }
   P = pe->CodeOfPred;
-  /* create a choice-point to be tag new goal */
+  Yap_PrepGoal(pe->ArityOfPE, ptr, B PASS_REGS);
-  myB = (choiceptr)ASP;
+  dgi->b = LCL0-(CELL*)B;
-  myB--;
+  out = run_emulator(dgi PASS_REGS);
-  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);
   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);
+#ifdef DEPTH_LIMIT
-  Yap_PopSlots( PASS_REGS1 );
+  DEPTH= ENV[E_DEPTH];
+#endif
   /* make sure we prune C-choicepoints */
   if (POP_CHOICE_POINT(B->cp_b))
     {
       POP_EXECUTE();
     }
-  B = B->cp_b;
+  ENV  = (CELL *)(ENV[E_E]);
-  HB = B->cp_h;
+  /* 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();
 }

C/exec.c

@@ -1126,8 +1126,8 @@ exec_absmi(int top USES_REGS)
 }
 
 
-static  void
+void
-init_stack(int arity, CELL *pt, int top, choiceptr saved_b USES_REGS)
+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;
+  Yap_PrepGoal(0, NULL, NULL PASS_REGS);
-  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;

H/Yap.h

@@ -107,6 +107,10 @@
 #endif /* HAVE_SYS_TIME_H */
 #endif /* _MSC_VER */
 
+#if HAVE_TIME_H
+#include <time.h>
+#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;

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

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

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

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;
+  YAP_Term *t = NULL;
-  unsigned long int  arity;
+  if (t0) 
-  Term t[2], m;
+    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);
+  LOCAL_execution->pe = (PredEntry *)p;
-  t[0] = SWIModuleToModule(ctx);
+  LOCAL_execution->g = t;
-  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];
-    }
-  }
   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_LeaveGoal(FALSE, &qi->h);
-  YAP_cut_up();
   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_LeaveGoal(FALSE, &qi->h);
-  YAP_RestartGoal();
   qi->open = 0;
 }
 

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;