support backtracking with uninst args

C/absmi.c

@@ -989,7 +989,7 @@ Yap_absmi(int inp)
       CACHE_Y(YREG);
       { 
 	struct index_t *i = (struct index_t *)(PREG->u.lp.l);
-	S_YREG[-1] = i->links[(CELL)(SREG-i->cls)/i->arity];
+	S_YREG[-1] = (CELL)EXO_OFFSET_TO_ADDRESS(i,i->links[(CELL)(SREG-i->cls)/i->arity]);
       }
       S_YREG--;
       /* store arguments for procedure */
@@ -1011,6 +1011,41 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      /* check if enough space between trail and codespace */
+      /* try_exo    Pred,Label */
+      Op(try_all_exo, lp);
+      /* check if enough space between trail and codespace */
+      check_trail(TR);
+      /* I use YREG =to go through the choicepoint. Usually YREG =is in a
+       * register, but sometimes (X86) not. In this case, have a
+       * new register to point at YREG =*/
+      CACHE_Y(YREG);
+      { 
+	struct index_t *i = (struct index_t *)(PREG->u.lp.l);
+	SREG = i->cls;
+	S_YREG[-2] = (CELL)(SREG+i->arity);
+	S_YREG[-1] = (CELL)(SREG+i->arity*i->nels);
+      }
+      S_YREG-=2;
+      /* store arguments for procedure */
+      store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
+      /* store abstract machine registers */
+      store_yaam_regs(NEXTOP(PREG,lp), 0);
+      /* On a try_me, set cut to point at previous choicepoint,
+       * that is, to the B before the cut.
+       */
+      set_cut(S_YREG, B);
+      /* now, install the new YREG =*/
+      B = B_YREG;
+#ifdef YAPOR
+      SCH_set_load(B_YREG);
+#endif	/* YAPOR */
+      PREG = NEXTOP(NEXTOP(PREG, lp),lp);
+      SET_BB(B_YREG);
+      ENDCACHE_Y();
+      GONext();
+      ENDOp();
+
       /* retry_exo    Pred */
       Op(retry_exo, lp);
       BEGD(d0);
@@ -1061,6 +1096,57 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      /* retry_exo    Pred */
+      Op(retry_all_exo, lp);
+      BEGD(d0);
+      CACHE_Y(B);
+      {
+	UInt arity = ((struct index_t *)PREG->u.lp.l)->arity;
+	CELL *extras = (CELL *)(B+1);
+	SREG = (CELL *)extras[arity];
+	d0 = (SREG+arity != (CELL *)extras[arity+1]);
+	if (d0) {
+	  extras[arity] = (CELL)(SREG+arity);
+	  /* After retry, cut should be pointing at the parent
+	   * choicepoint for the current B */
+	  restore_yaam_regs(PREG);
+	  restore_at_least_one_arg(arity);
+#ifdef FROZEN_STACKS
+	  S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
+	  set_cut(S_YREG, B->cp_b);
+#else
+	  set_cut(S_YREG, B_YREG->cp_b);
+#endif /* FROZEN_STACKS */
+	  SET_BB(B_YREG);
+	} else {
+#ifdef YAPOR
+	  if (SCH_top_shared_cp(B)) {
+	    SCH_last_alternative(PREG, B_YREG);
+	    restore_at_least_one_arg(arity);
+#ifdef FROZEN_STACKS
+	    S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
+#endif /* FROZEN_STACKS */
+	    set_cut(S_YREG, B->cp_b);
+	  } else
+#endif	/* YAPOR */
+	    {
+	      pop_yaam_regs();
+	      pop_at_least_one_arg(arity);
+	      /* After trust, cut should be pointing at the new top
+	       * choicepoint */
+#ifdef FROZEN_STACKS
+	      S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
+#endif /* FROZEN_STACKS */
+	      set_cut(S_YREG, B);
+	    }
+	}
+      }
+      PREG = NEXTOP(PREG, lp);
+      ENDCACHE_Y();
+      ENDD(D0);
+      GONext();
+      ENDOp();
+
 /*****************************************************************
 *        Profiled try - retry - trust instructions               *
 *****************************************************************/

C/exo.c

@@ -213,14 +213,15 @@ fill_hash(UInt bmap, UInt bnds[], struct index_t *it)
 }
 
 static struct index_t *
-add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap)
+add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap, UInt count)
 {
   UInt ncls = ap->cs.p_code.NOfClauses, j;
-  CELL *base;
+  CELL *base = NULL;
   struct index_t *i;
   size_t sz;
   yamop *ptr;
   
+  if (count) {
     if (!(base = (CELL *)Yap_AllocCodeSpace(3*sizeof(CELL)*ncls))) {
       CACHE_REGS
       save_machine_regs();
@@ -229,6 +230,7 @@ add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap)
       Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
       return NULL;
     }
+  }
   sz =   (CELL)NEXTOP(NEXTOP((yamop*)NULL,lp),lp)+ap->ArityOfPE*(CELL)NEXTOP((yamop *)NULL,x) +(CELL)NEXTOP(NEXTOP((yamop *)NULL,p),l);
   if (!(i = (struct index_t *)Yap_AllocCodeSpace(sizeof(struct index_t)+sz))) {
     CACHE_REGS
@@ -238,6 +240,7 @@ add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap)
     Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
     return NULL;
   }
+  if (count)
     bzero(base, 3*sizeof(CELL)*ncls);
   i->next = *ip;
   i->prev = NULL;
@@ -251,14 +254,22 @@ add_index(struct index_t **ip, UInt bmap, UInt bndsf[], PredEntry *ap)
   i->links = (CELL *)(base+2*ncls);
   i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *)); 
   *ip = i;
+  if (count) {
     fill_hash(bmap, bndsf, i);
+  }
   ptr = (yamop *)(i+1);
   i->code = ptr;
+  if (count)
     ptr->opc = Yap_opcode(_try_exo);
+  else
+    ptr->opc = Yap_opcode(_try_all_exo);
   ptr->u.lp.l = (yamop *)i;
   ptr->u.lp.p = ap;
   ptr = NEXTOP(ptr, lp);
+  if (count)
     ptr->opc = Yap_opcode(_retry_exo);
+  else
+    ptr->opc = Yap_opcode(_retry_all_exo);
   ptr->u.lp.p = ap;
   ptr->u.lp.l = (yamop *)i;
   ptr = NEXTOP(ptr, lp);
@@ -314,17 +325,20 @@ Yap_ExoLookup(PredEntry *ap)
     i = i->next;
   }
   if (!i) {
-    i = add_index(ip, bmap, bnds, ap);
+    i = add_index(ip, bmap, bnds, ap, count);
   }
+  if (count)
     return LOOKUP(i, arity, bnds);
+  else
+    return i->code;
 }
 
 CELL
 Yap_NextExo(choiceptr cptr, struct index_t *it) 
 {
-  CELL offset = ((CELL *)(B+1))[it->arity];
+  CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
   CELL next = it->links[offset];
-  ((CELL *)(B+1))[it->arity] = next;
+  ((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, next);
   S = it->cls+it->arity*offset;
   return next;
 }

H/YapOpcodes.h

@@ -9,7 +9,9 @@
   OPCODE(trust_me                   ,Otapl),
   OPCODE(enter_exo                  ,e),
   OPCODE(try_exo                    ,lp),
+  OPCODE(try_all_exo                ,lp),
   OPCODE(retry_exo                  ,lp),
+  OPCODE(retry_all_exo              ,lp),
   OPCODE(enter_profiling            ,p),
   OPCODE(retry_profiled             ,p),
   OPCODE(profiled_retry_me          ,Otapl),

H/clause.h

@@ -173,6 +173,22 @@ typedef struct index_t {
   yamop *code;
 } Index_t;
 
+INLINE_ONLY EXTERN inline  UInt EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
+
+INLINE_ONLY EXTERN inline   UInt
+EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL* ptr)
+{
+  return ptr-it->links;
+}
+
+INLINE_ONLY EXTERN inline  CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt  off);
+
+INLINE_ONLY EXTERN inline   CELL *
+EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt  off)
+{
+  return it->links+off;
+}
+
 
 typedef struct dbterm_list {
   /* a list of dbterms associated with a clause */

H/rclause.h

@@ -286,7 +286,9 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
       pc = NEXTOP(pc,llll);
       break;
       /* instructions type lp */
+    case _retry_all_exo:
     case _retry_exo:
+    case _try_all_exo:
     case _try_exo:
     case _user_switch:
       pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);

H/saveclause.h

@@ -303,7 +303,9 @@
       pc = NEXTOP(pc,llll);
       break;
       /* instructions type lp */
+    case _retry_all_exo:
     case _retry_exo:
+    case _try_all_exo:
     case _try_exo:
     case _user_switch:
       CHECK(save_PtoOp(stream, pc->u.lp.l));

H/walkclause.h

@@ -216,7 +216,9 @@
       pc = NEXTOP(pc,llll);
       break;
       /* instructions type lp */
+    case _retry_all_exo:
     case _retry_exo:
+    case _try_all_exo:
     case _try_exo:
     case _user_switch:
       pc = NEXTOP(pc,lp);