fix broken, complicated code for slots

C/adtdefs.c

@@ -1483,43 +1483,6 @@ ArgsOfSFTerm(Term t)
 
 #endif
 
-Int
-Yap_NewSlots(int n USES_REGS)
-{
-  Int old_slots = IntOfTerm(ASP[0]), oldn = n;
-  while (n > 0) {
-    RESET_VARIABLE(ASP);
-    ASP--;
-    n--;
-  }
-  ASP[0] = MkIntTerm(old_slots+oldn);
-  CurSlot = LCL0-ASP;
-  return((ASP+1)-LCL0);
-}
-
-Int
-Yap_InitSlot(Term t USES_REGS)
-{
-  Int old_slots = IntOfTerm(ASP[0]);
-  *ASP = t;
-  ASP--;
-  CurSlot ++;
-  ASP[0] = MkIntTerm(old_slots+1);
-  return((ASP+1)-LCL0);
-}
-
-int
-Yap_RecoverSlots(int n USES_REGS)
-{
-  Int old_slots = IntOfTerm(ASP[0]);
-  if (old_slots - n < 0) {
-    return FALSE;
-  }
-  ASP += n;
-  CurSlot -= n;
-  ASP[0] = MkIntTerm(old_slots-n);
-  return TRUE;
-}
 
 static HoldEntry *
 InitAtomHold(void)

C/c_interface.c

@@ -1210,7 +1210,6 @@ YAP_cut_up(void)
 	 pointer back to where cut_up called it. Slots depend on it. */
   if (ENV > B->cp_env) {
     ASP = B->cp_env;
-    Yap_PopSlots( PASS_REGS1 );
   }
 #ifdef YAPOR
   {
@@ -1636,16 +1635,67 @@ execute_cargs_back(PredEntry *pe, CPredicate exec_code, struct foreign_context *
   }
 }
 
+static Int
+complete_fail(choiceptr ptr, int has_cp USES_REGS)
+{
+  // this case is easy, jut be sure to throw everything 
+  // after the old B;
+  while (B != ptr) {
+    B = B->cp_b;
+  }
+  if (has_cp)
+    return do_cut( FALSE );
+  return FALSE;
+}
+
+static int
+complete_exit(choiceptr ptr, int has_cp, int cut_all USES_REGS)
+{
+  // the user often leaves open frames, especially in forward execuryion
+  while (B && (!ptr ||  B < ptr)) {
+    if (cut_all || B->cp_ap == NOCODE) {/* separator */
+      do_cut( TRUE ); // pushes B up
+      continue;
+    } else if (B->cp_ap->opc == RETRY_USERC_OPCODE && B->cp_b == ptr) { 
+      // started the current choicepoint, I hope
+      return do_cut( TRUE );
+    } else 
+      break; // oops, there is something else
+  }
+  if (!ptr ||  B < ptr) {
+    // we're still not there yet
+    choiceptr new = B;
+    while (new  && new < ptr) {
+      if (new->cp_ap == NOCODE) /* separator */
+	new->cp_ap = FAILCODE; // there are choice-points above but at least, these won't harm innocent code
+      else if (new->cp_ap->opc == RETRY_USERC_OPCODE && new->cp_b == ptr) { 
+	// I can't cut, but I can tag it as done
+	new->cp_ap = FAILCODE; // there are choice-points above but at least, these won't harm innocent code
+      }
+      new = new->cp_b;
+    }
+  }
+  if (has_cp) {
+    if (B == ptr) {
+      return do_cut( TRUE );
+    } else {
+      ptr->cp_ap = FAILCODE;
+    }
+  }
+  return TRUE;
+}
 
 Int
 YAP_Execute(PredEntry *pe, CPredicate exec_code)
 {
   CACHE_REGS
   Int ret;
+  Int OASP = LCL0-(CELL *)B;
   //  Term omod = CurrentModule;
   //if (pe->PredFlags & CArgsPredFlag) {
   //  CurrentModule = pe->ModuleOfPred;
   //}
+  Int CurSlot = Yap_StartSlots( PASS_REGS1 );
   if (pe->PredFlags & SWIEnvPredFlag) {
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context ctx;
@@ -1666,6 +1716,12 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
     ret = (exec_code)( PASS_REGS1 );
   }
   PP = NULL;
+  // check for junk: open frames, etc */
+  LOCAL_CurSlot = CurSlot;
+  if (ret)
+    complete_exit(((choiceptr)(LCL0-OASP)), FALSE, FALSE PASS_REGS);
+  else
+    complete_fail(((choiceptr)(LCL0-OASP)), FALSE PASS_REGS);
   //CurrentModule = omod;
   if (!ret) {
     Term t;
@@ -1689,12 +1745,13 @@ Int
 YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
 {
   CACHE_REGS
+  CELL ocp = LCL0-(CELL *)B;
+  /* for slots to work */
+  Int CurSlot = Yap_StartSlots( PASS_REGS1 );
   if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
     Int val;
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
-    struct open_query_struct *oexec = LOCAL_execution;
-    extern void PL_close_foreign_frame(struct open_query_struct *);
 
     PP = pe;
     ctx->control = FRG_FIRST_CALL;
@@ -1705,9 +1762,7 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
     } else {
       val = ((codev)(B->cp_args-LCL0,0,ctx));
     }
-    /* make sure we clean up the frames left by the user */
+    LOCAL_CurSlot = CurSlot;
-    while (LOCAL_execution != oexec)
-      PL_close_foreign_frame(LOCAL_execution);
     PP = NULL;
     if (val == 0) {
       Term t;
@@ -1720,9 +1775,9 @@ YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
 	Yap_JumpToEnv(t);
 	return FALSE;
       }
-      cut_fail();
+      return complete_fail(((choiceptr)(LCL0-ocp)), TRUE PASS_REGS);
     } else if (val == 1) { /* TRUE */
-      cut_succeed();
+      return complete_exit(((choiceptr)(LCL0-ocp)), TRUE, FALSE PASS_REGS);
     } else {
       if ((val & REDO_PTR) == REDO_PTR)
 	ctx->context = (int *)(val & ~REDO_PTR);
@@ -1758,22 +1813,19 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
     Int val;
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
-    struct open_query_struct *oexec = LOCAL_execution;
-    extern void PL_close_foreign_frame(struct open_query_struct *);
     CELL *args = B->cp_args;
 
     B = oB;
     PP = pe;
     ctx->control = FRG_CUTTED;
     ctx->engine = NULL; //(PL_local_data *)Yap_regp;
+    /* for slots to work */
+    Yap_StartSlots( PASS_REGS1 );
     if (pe->PredFlags & CArgsPredFlag) {
       val = execute_cargs_back(pe, exec_code, ctx PASS_REGS);
     } else {
       val = ((codev)(args-LCL0,0,ctx));
     }
-    /* make sure we clean up the frames left by the user */
-    while (LOCAL_execution != oexec)
-      PL_close_foreign_frame(LOCAL_execution);
 
     PP = NULL;
     //    B = LCL0-(CELL*)oB;
@@ -1792,9 +1844,12 @@ YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top)
       return TRUE;
     } 
   } else {
-    Int ret;
+    Int ret, CurSlot;
     B = oB;
+    /* for slots to work */
+    CurSlot = Yap_StartSlots( PASS_REGS1 );
     ret = (exec_code)( PASS_REGS1 );
+    LOCAL_CurSlot = CurSlot;
     if (!ret) {
       Term t;
 
@@ -1814,12 +1869,13 @@ Int
 YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
 {
   CACHE_REGS
+    /* for slots to work */
+  Int CurSlot = Yap_StartSlots( PASS_REGS1 );
+  UInt ocp = LCL0-(CELL *)B;
   if (pe->PredFlags & (SWIEnvPredFlag|CArgsPredFlag)) {
     Int val;
     CPredicateV codev = (CPredicateV)exec_code;
     struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
-    struct open_query_struct *oexec = LOCAL_execution;
-    extern void PL_close_foreign_frame(struct open_query_struct *);
     
     PP = pe;
     ctx->control = FRG_REDO;
@@ -1828,9 +1884,9 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
     } else {
       val = ((codev)(B->cp_args-LCL0,0,ctx));
     }
+    LOCAL_CurSlot = CurSlot;
+    /* we are below the original choice point ?? */
     /* make sure we clean up the frames left by the user */
-    while (LOCAL_execution != oexec)
-      PL_close_foreign_frame(LOCAL_execution);
     PP = NULL;
     if (val == 0) {
       Term t;
@@ -1843,10 +1899,10 @@ YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
 	Yap_JumpToEnv(t);
 	return FALSE;
       } else {
-	cut_fail();
+	return complete_fail(((choiceptr)(LCL0-ocp)), TRUE PASS_REGS);
       }
     } else if (val == 1) { /* TRUE */
-      cut_succeed();
+      return complete_exit(((choiceptr)(LCL0-ocp)), TRUE, FALSE PASS_REGS);
     } else {
       if ((val & REDO_PTR) == REDO_PTR)
 	ctx->context = (int *)(val & ~REDO_PTR);
@@ -2251,8 +2307,6 @@ run_emulator(YAP_dogoalinfo *dgi USES_REGS)
   LOCAL_PrologMode = UserMode;
   out = Yap_absmi(0);
   LOCAL_PrologMode = UserCCallMode;
-  if (out)
-    Yap_StartSlots(PASS_REGS1);
   return out;
 }
 
@@ -2265,12 +2319,17 @@ YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
   BACKUP_MACHINE_REGS();
   dgi->p = P;
   dgi->cp = CP;
+  dgi->CurSlot = LOCAL_CurSlot;
   // ensure our current ENV receives current P.
   Yap_PrepGoal(pe->ArityOfPE, ptr, B PASS_REGS);
   P = pe->CodeOfPred;
   dgi->b = LCL0-(CELL*)B;
   out = run_emulator(dgi PASS_REGS);
   RECOVER_MACHINE_REGS();
+  if (out) {
+    LOCAL_CurSlot = dgi->CurSlot; // ignore any slots created within the called goal
+    Yap_StartSlots( PASS_REGS1 );
+  }
   return out;
 }
 
@@ -2291,9 +2350,13 @@ YAP_RetryGoal(YAP_dogoalinfo *dgi)
   P = FAILCODE;
   /* make sure we didn't leave live slots when we backtrack */
   ASP = (CELL *)B;
-  Yap_PopSlots( PASS_REGS1 );
+  LOCAL_CurSlot = dgi->CurSlot;
   out = run_emulator(dgi PASS_REGS);
   RECOVER_MACHINE_REGS();
+  if (out) {
+    LOCAL_CurSlot = dgi->CurSlot;
+    Yap_StartSlots( PASS_REGS1 );
+  }
   return out;
 }
 
@@ -2343,7 +2406,6 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
   /* ASP should be set to the top of the local stack when we
      did the call */
   ASP = B->cp_env;
-  Yap_PopSlots(PASS_REGS1);
   /* YENV should be set to the current environment */
   YENV = ENV  = (CELL *)((B->cp_env)[E_E]);
   B    = B->cp_b;
@@ -2351,6 +2413,7 @@ YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
   HB = PROTECT_FROZEN_H(B);
   CP = dgi->cp;
   P = dgi->p;
+  LOCAL_CurSlot = dgi->CurSlot;
   RECOVER_MACHINE_REGS();
   return TRUE;
 }
@@ -2361,6 +2424,7 @@ YAP_RunGoal(Term t)
   CACHE_REGS
   Term out;
   yamop *old_CP = CP;
+  Int CurSlot = LOCAL_CurSlot;
   BACKUP_MACHINE_REGS();
 
   LOCAL_AllowRestart = FALSE;
@@ -2372,6 +2436,7 @@ YAP_RunGoal(Term t)
     ENV = (CELL *)ENV[E_E];
     CP = old_CP;
     LOCAL_AllowRestart = TRUE;
+    // we are back to user code again, need slots */
     Yap_StartSlots( PASS_REGS1 );
   } else {
     ENV = B->cp_env;
@@ -2379,8 +2444,9 @@ YAP_RunGoal(Term t)
     CP = old_CP;
     B = B->cp_b;
     LOCAL_AllowRestart = FALSE;
+    ASP = ENV;
+    LOCAL_CurSlot = CurSlot;
   }
-
   RECOVER_MACHINE_REGS();
   return out;
 }
@@ -2451,13 +2517,11 @@ YAP_RunGoalOnce(Term t)
   Term out;
   yamop *old_CP = CP;
   Int oldPrologMode = LOCAL_PrologMode;
-  Int oldSlot = CurSlot;
 
   BACKUP_MACHINE_REGS();
   LOCAL_PrologMode = UserMode;
   out = Yap_RunTopGoal(t);
   LOCAL_PrologMode = oldPrologMode;
-  CurSlot = oldSlot;
   if (!(oldPrologMode & UserCCallMode)) {
     /* called from top-level */
     LOCAL_AllowRestart = FALSE;
@@ -2509,8 +2573,6 @@ 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) {
@@ -2557,7 +2619,6 @@ YAP_ShutdownGoal(int backtrack)
     }
     /* we can always recover the stack */
     ASP = cut_pt->cp_env;
-    Yap_PopSlots( PASS_REGS1 );
     ENV = (CELL *)ASP[E_E];
     B = (choiceptr)ASP[E_CB];
     Yap_TrimTrail();
@@ -3237,8 +3298,6 @@ YAP_Reset(void)
   ASP = (CELL *)B;
   /* 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 );
   P = CP = YESCODE;
   RECOVER_MACHINE_REGS();
   return res;

H/YapHandles.h

@@ -0,0 +1,131 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 	%W% %G% 					 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		YapHandles.h   						 *
+* mods:									 *
+* comments:	term handles for YAP: basic ops				 *
+* version:      $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $	 *
+*************************************************************************/
+
+#ifndef YAP_HANDLES_H
+#define YAP_HANDLES_H 1
+
+
+/*************************************************************************************************
+                                           slots
+
+Also known as term handles, they provide a way to access terms without being exposed to stack shifts in gc.
+
+They should always be used as local variables.
+
+They are organized as follows:
+---- Tagged Offset of next pointer in chain 
+---- Tagged Number of entries
+Entry 
+Entry 
+Entry 
+Entry 
+---- Tagged Number of entries
+
+They are not known to the yaam. Instead, 
+they are created when entering user code (see YAP_Execute* functions). They are also created:
+
+- by SWI PL_foreign_frame function,
+- by YAP_*Goal routines, when they exit successfully. Notice that all handles created by c-goals  within
+a *Goal execution should not be used afterwards.
+
+
+
+*************************************************************************************************/
+
+
+static inline Int
+Yap_StartSlots( USES_REGS1 ) {
+  Int CurSlot = LOCAL_CurSlot;
+  // if (CurSlot == LCL0-(ASP+(IntOfTerm(ASP[0])+2)))
+  //  return CurSlot;
+  /* new slot */
+  *--ASP = MkIntegerTerm(CurSlot);
+  LOCAL_CurSlot =  LCL0-ASP;
+  *--ASP = MkIntTerm(0);
+  *--ASP = MkIntTerm(0);
+  return CurSlot;
+}
+
+static inline Int
+Yap_CurrentSlot( USES_REGS1 ) {
+  return IntOfTerm(ASP[0]);
+}
+
+static inline Term
+Yap_GetFromSlot(Int slot USES_REGS)
+{
+  return(Deref(LCL0[slot]));
+}
+
+static inline Term
+Yap_GetDerefedFromSlot(Int slot USES_REGS)
+{
+  return LCL0[slot];
+}
+
+static inline Term
+Yap_GetPtrFromSlot(Int slot USES_REGS)
+{
+  return(LCL0[slot]);
+}
+
+static inline Term *
+Yap_AddressFromSlot(Int slot USES_REGS)
+{
+  return(LCL0+slot);
+}
+
+static inline void
+Yap_PutInSlot(Int slot, Term t USES_REGS)
+{
+  LCL0[slot] = t;
+}
+
+static inline Int
+Yap_NewSlots(int n USES_REGS)
+{
+  Int old_slots = IntOfTerm(ASP[0]), oldn = n;
+  while (n > 0) {
+    RESET_VARIABLE(ASP);
+    ASP--;
+    n--;
+  }
+  ASP[old_slots+oldn+1] = ASP[0] = MkIntTerm(old_slots+oldn);
+  return((ASP+1)-LCL0);
+}
+
+static inline Int
+Yap_InitSlot(Term t USES_REGS)
+{
+  Int old_slots = IntOfTerm(ASP[0]);
+  *ASP = t;
+  ASP--;
+  ASP[old_slots+2] = ASP[0] = MkIntTerm(old_slots+1);
+  return((ASP+1)-LCL0);
+}
+
+static inline int
+Yap_RecoverSlots(int n USES_REGS)
+{
+  Int old_slots = IntOfTerm(ASP[0]);
+  if (old_slots - n < 0) {
+    return FALSE;
+  }
+  ASP += n;
+  ASP[old_slots+(n-old_slots+1)] = ASP[0] = MkIntTerm(old_slots-n);
+  return TRUE;
+}
+
+#endif