handles in SWI and changes in exports

include/SWI-Prolog.h

@@ -294,7 +294,7 @@ typedef struct foreign_context *control_t;
 
 #define PRED_IMPL(name, arity, fname, flags) \
         foreign_t \
-        pl_ ## fname ## _va(term_t PL__t0, int PL__ac, control_t PL__ctx)
+        pl_ ## fname ## arity ## _va(term_t PL__t0, int PL__ac, control_t PL__ctx)
 
 #define CTX_CNTRL ForeignControl(PL__ctx)
 #define CTX_PTR   ForeignContextPtr(PL__ctx)
@@ -304,7 +304,7 @@ typedef struct foreign_context *control_t;
 #define BeginPredDefs(id) \
         const PL_extension PL_predicates_from_ ## id[] = {
 #define PRED_DEF(name, arity, fname, flags) \
-  { name, arity, pl_ ## fname ## _va, (flags)|PL_FA_VARARGS },
+  { name, arity, pl_ ## fname ## arity ## _va, (flags)|PL_FA_VARARGS },
 #define EndPredDefs \
         { NULL, 0, NULL, 0 } \
         };

include/yap_structs.h

@@ -231,6 +231,7 @@ typedef struct YAP_pred_entry *YAP_PredEntryPtr;
 /* this should be opaque to the user */ 
 typedef struct {
   unsigned long  b;
+  YAP_Int CurSlot; 
   struct yami *p, *cp;
 } YAP_dogoalinfo;
 

library/dialect/swi/fli/swi.c

@@ -2184,51 +2184,49 @@ X_API fid_t
 PL_open_foreign_frame(void)
 {
   CACHE_REGS
-  open_query *new = (open_query *)malloc(sizeof(open_query));
+  /* initialise a new marker choicepoint */
-  if (!new) return 0;
+    choiceptr cp_b = ((choiceptr)(ASP-1))-1;
-  new->old = LOCAL_execution;
-  new->g = NULL;
-  new->open = FALSE;
-  new->cp = CP;
-  new->p = P;
-  new->flags = 0;
-  new->b = (CELL)(LCL0-(CELL*)B);
-  new->envp = (CELL)(LCL0-ENV);
-  new->asp = (CELL)(LCL0-ASP);
-  new->slots = CurSlot;
-  LOCAL_execution = new;
-  { 
-    /* initialise a new marker choicepoint */
-    choiceptr cp_b = ((choiceptr)ASP)-1;
     cp_b->cp_tr = TR;
     cp_b->cp_h = H;
     cp_b->cp_b = B;
     cp_b->cp_cp = CP;
     cp_b->cp_env = ENV;
     cp_b->cp_ap = NOCODE;
+#ifdef DEPTH_LIMIT
+    cp_b->cp_depth = DEPTH;
+#endif /* DEPTH_LIMIT */
+    cp_b->cp_a1 = MkIntTerm(LOCAL_CurSlot);
     HB = H;
     B = cp_b;
     ASP = (CELL *)B;
     Yap_StartSlots( PASS_REGS1 );
-  }
+    
-  return (fid_t)new;
+    return (fid_t)(LCL0-(CELL*)cp_b);
 }
 
 X_API void
 PL_close_foreign_frame(fid_t f)
 {
   CACHE_REGS
-  open_query *env = (open_query *)f;
+  choiceptr cp_b = (choiceptr)(LCL0-(UInt)f);
-  CP = env->cp;
+  CELL *old_slots;
-  P = env->p;
+  LOCAL_CurSlot = IntOfTerm(cp_b->cp_a1);
-  CurSlot = env->slots;
+  B = cp_b->cp_b;
-  B = (choiceptr)(LCL0-env->b);
+  CP = cp_b->cp_cp;
-  ENV = (CELL *)(LCL0-env->envp);
+  ENV = cp_b->cp_env;
-  ASP = (CELL *)(LCL0-env->asp);
+#ifdef DEPTH_LIMIT
-  EX = NULL;
+  DEPTH = cp_b->cp_depth;
-  LOCAL_BallTerm = EX;
+#endif /* DEPTH_LIMIT */
-  LOCAL_execution = env->old;
+  HB = B->cp_h;
-  free(env);
+  Yap_TrimTrail();
+  if (LOCAL_CurSlot) {
+  /* we can assume there was a slot before */
+    CELL *old_slot;
+    old_slot = LCL0-(LOCAL_CurSlot);
+    ASP = old_slot-(2+IntOfTerm(old_slot[-1]));
+  } else {
+    ASP = ((CELL *)(cp_b+1))+1;
+  }
 }
 
 static void
@@ -2244,12 +2242,15 @@ X_API void
 PL_rewind_foreign_frame(fid_t f)
 {
   CACHE_REGS
-  open_query *env = (open_query *)f;
+  choiceptr cp_b = (choiceptr)(LCL0-(UInt)f);
-  CurSlot = env->slots;
+  if (B != cp_b) {
-  while (B->cp_b != (choiceptr)(LCL0-env->b))
+    while (B->cp_b != cp_b)
-    B = B->cp_b;
+      B = B->cp_b;
+  }
   backtrack();
+  // restore to original location
   ASP = (CELL *)B;
+  LOCAL_CurSlot = IntOfTerm(B->cp_a1);
   Yap_StartSlots( PASS_REGS1 );  
 }
 
@@ -2257,27 +2258,29 @@ X_API void
 PL_discard_foreign_frame(fid_t f)
 {
   CACHE_REGS
-  open_query *env = (open_query *)f;
+  choiceptr cp_b = (choiceptr)(LCL0-(UInt)f);
-  if (LOCAL_execution != env) {
+
-    /* handle the case where we do not want to kill the last open frame */ 
+  if (B != cp_b) {
-    open_query *env0 = LOCAL_execution;
+    while (B->cp_b != cp_b)
-    while (env0 && env0 != env) env0 = env0->old;
+      B = B->cp_b;
-    if (!env0)
+    backtrack();
-      return;
+  }
+  LOCAL_CurSlot = IntOfTerm(cp_b->cp_a1);
+  B = cp_b->cp_b;
+  CP = cp_b->cp_cp;
+  ENV = cp_b->cp_env;
+  HB = B->cp_h;
+#ifdef DEPTH_LIMIT
+  DEPTH = cp_b->cp_depth;
+#endif /* DEPTH_LIMIT */
+  /* we can assume there was a slot before */
+  if (LOCAL_CurSlot) {
+    CELL *old_slot;
+    old_slot = LCL0-(LOCAL_CurSlot);
+    ASP = old_slot-(2+IntOfTerm(old_slot[-1]));
+  } else {
+    ASP = ((CELL *)(cp_b+1))+1;
   }
-  while (B->cp_b != (choiceptr)(LCL0-env->b))
-    B = B->cp_b;
-  backtrack();
-  CurSlot = env->slots;
-  ENV = (CELL *)(LCL0-env->envp);
-  CP = env->cp;
-  P = env->p;
-  LOCAL_execution = env->old;
-  ASP = LCL0-env->asp;
-  B = B->cp_b;
-  //LOCAL_BallTerm = EX;
-  //EX = NULL;
-  free(env);
 }
 
 X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
@@ -2288,26 +2291,13 @@ X_API qid_t PL_open_query(module_t ctx, int flags, predicate_t p, term_t t0)
     t = Yap_AddressFromSlot(t0 PASS_REGS);
 
   /* ignore flags  and module for now */
-  if (!LOCAL_execution) {
+  open_query *new = (open_query *)(LCL0+Yap_NewSlots(sizeof(open_query)/sizeof(CELL) PASS_REGS));
-    open_query *new = (open_query *)malloc(sizeof(open_query));
+  LOCAL_execution = new;
-    if (!new) return 0;
+  new->open=1;
-    new->old = LOCAL_execution;
+  new->state=0;
-    new->g = NULL;
+  new->flags = flags;
-    new->open = FALSE;
+  new->pe = (PredEntry *)p;
-    new->cp = CP;
+  new->g = t;
-    new->p = P;
-    new->b = (CELL)(LCL0-(CELL*)B);
-    new->envp = (CELL)(LCL0-ENV);
-    new->asp = (CELL)(LCL0-ASP);
-    new->slots = CurSlot;
-    new->flags = 0;
-    LOCAL_execution = new;
-  }
-  LOCAL_execution->open=1;
-  LOCAL_execution->state=0;
-  LOCAL_execution->flags = flags;
-  LOCAL_execution->pe = (PredEntry *)p;
-  LOCAL_execution->g = t;
   return LOCAL_execution;
 }
 
@@ -2318,6 +2308,7 @@ X_API int PL_next_solution(qid_t qi)
   if (qi->open != 1) return 0;
   if (setjmp(LOCAL_execution->env))
     return 0;
+  // don't forget, on success these guys must create slots
   if (qi->state == 0) {
     result = YAP_EnterGoal((YAP_PredEntryPtr)qi->pe, qi->g, &qi->h);
   } else {
@@ -2342,7 +2333,7 @@ X_API void PL_cut_query(qid_t qi)
 X_API void PL_close_query(qid_t qi)
 {
   CACHE_REGS
-  EX = NULL;
+
   if (EX && !(qi->flags & (PL_Q_CATCH_EXCEPTION))) {
     EX = NULL;
   }

library/dialect/swi/fli/swi.h

@@ -48,11 +48,9 @@ typedef struct open_query_struct {
   YAP_Term *g;
   PredEntry *pe;
   yamop *p, *cp;
-  Int slots, b, envp, asp;
   jmp_buf env;
   int flags;
   YAP_dogoalinfo h;
-  struct open_query_struct *old;
 } open_query;
 
 #define addr_hash(V) (((CELL) (V)) >> 4 & (N_SWI_HASH-1))