Exo compilation, the range example.

C/absmi.c

@@ -990,6 +990,35 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      /* check if enough space between trail and codespace */
+      /* try_exo    Pred,Label */
+      Op(try_exo_udi, 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);
+      S_YREG--;
+      /* 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();
+
       /* try_udi    Pred,Label */
       Op(try_udi, p);
       /* check if enough space between trail and codespace */
@@ -1107,6 +1136,59 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+      /* retry_exo_udi    Pred */
+      Op(retry_exo_udi, lp);
+      BEGD(d0);
+      CACHE_Y(B);
+      {
+	struct index_t *it = (struct index_t *)(PREG->u.lp.l);
+	saveregs();
+	d0 = ((CRetryExoIndex)it->udi_next)(it);
+	setregs();
+#ifdef SHADOW_S
+	SREG = S;
+#endif
+      }
+      if (d0) {
+	/* After retry, cut should be pointing at the parent
+	 * choicepoint for the current B */
+	restore_yaam_regs(PREG);
+	restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
+#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(PREG->u.lp.p->ArityOfPE);
+#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(PREG->u.lp.p->ArityOfPE);
+	    /* 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();
+
       /* retry_exo    Pred */
       Op(retry_udi, p);
       BEGD(d0);

C/attvar.c

@@ -364,10 +364,10 @@ DelAtts(attvar_record *attv, Term oatt USES_REGS)
 static void 
 PutAtt(Int pos, Term atts, Term att USES_REGS)
 {
-  if (IsVarTerm(att) && (CELL *)att > H && (CELL *)att < LCL0) {
+  if (IsVarTerm(att) && VarOfTerm(att) > H && VarOfTerm(att) < LCL0) {
     /* globalise locals */
     Term tnew = MkVarTerm();
-    Bind_NonAtt((CELL *)att, tnew);
+    Bind_NonAtt(VarOfTerm(att), tnew);
     att = tnew;
   }
   MaBind(RepAppl(atts)+pos, att);

C/cdmgr.c

@@ -5436,6 +5436,7 @@ index_ssz(StaticIndex *x, PredEntry *pe)
 
       while (i) {
 	sz = i->size+sz;
+	i = i->next;
       }
       return sz;
     }

C/exo.c

@@ -216,7 +216,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
 }
 
 static struct index_t *
-add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[])
+add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
 {
   CACHE_REGS
   UInt ncls = ap->cs.p_code.NOfClauses, j;
@@ -224,6 +224,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
   struct index_t *i;
   size_t sz;
   yamop *ptr;
+  UInt *bnds = LOCAL_ibnds;
   
   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))) {
@@ -278,7 +279,9 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
       i->ncollisions = i->nentries = i->ntrys = 0;
       continue;
     }
+#if DEBUG
     fprintf(stderr, "entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
+#endif
     if (!i->ntrys && !i->is_key) {
       i->is_key = TRUE;
       if (base != realloc(base, i->hsize*sizeof(BITS32)))
@@ -333,7 +336,12 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]
   ptr = NEXTOP(ptr, p);
   ptr->opc = Yap_opcode(_Ystop);
   ptr->u.l.l = i->code;
-  Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX); 
+  Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX);
+  if (ap->PredFlags & UDIPredFlag) {
+    Yap_new_udi_clause( ap, NULL, (Term)ip);
+  } else {
+    i->is_udi = FALSE;
+  }
   return i;
 }
 
@@ -369,11 +377,14 @@ Yap_ExoLookup(PredEntry *ap USES_REGS)
     i = i->next;
   }
   if (!i) {
-    i = add_index(ip, bmap, ap, count, LOCAL_ibnds);
+    i = add_index(ip, bmap, ap, count);
   }
-  if (count)
+  if (count) {
-    return LOOKUP(i, arity, j0, LOCAL_ibnds);
+    yamop *code = LOOKUP(i, arity, j0, LOCAL_ibnds);
-  else
+    if (i->is_udi) 
+      return ((CEnterExoIndex)i->udi_first)(i);
+    else return code;
+  } else
     return i->code;
 }
 

C/exo_udi.c

@@ -0,0 +1,393 @@
+/*************************************************************************
+*									 *
+*	 YAP Prolog 							 *
+*									 *
+*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
+*									 *
+* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
+*									 *
+**************************************************************************
+*									 *
+* File:		exo.c							 *
+* comments:	Exo compilation						 *
+*									 *
+* Last rev:     $Date: 2008-07-22 23:34:44 $,$Author: vsc $		 *				 *
+* $Log: not supported by cvs2svn $				 	 *
+*                                                                        *
+*									 *
+*************************************************************************/
+
+#include "Yap.h"
+#include "clause.h"
+#include "yapio.h"
+#include "eval.h"
+#include "tracer.h"
+#include "attvar.h"
+#ifdef YAPOR
+#include "or.macros.h"
+#endif	/* YAPOR */
+#ifdef TABLING
+#include "tab.macros.h"
+#endif /* TABLING */
+#if HAVE_STRING_H
+#include <string.h>
+#endif
+#define YAP_Term Term
+#define YAP_Atom Atom
+#include <udi.h>
+
+#define arg_of_interest() 0
+
+
+static int
+compar(const void *ip0, const void *jp0) {
+  BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0;
+  BITS32 *bs = LOCAL_exo_base;
+  Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg];
+  Int j = bs[LOCAL_exo_arity*(*jp)+LOCAL_exo_arg];
+  return IntOfTerm(i)-IntOfTerm(j);
+}
+
+static int
+compare(const BITS32 *ip, Int j) {
+  BITS32 *bs = LOCAL_exo_base;
+  Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg];
+  /* fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j); */
+  return IntOfTerm(i)-j;
+}
+
+
+static void
+RangeUDIRefitIndex(struct index_t **ip, UInt b[])
+{
+  size_t sz;
+  struct index_t *it = *ip;
+  BITS32 *sorted0, *sorted;
+  UInt arity = it->arity;
+  yamop *code;
+
+  /* hard-wired implementation for the range case */
+  Int i = arg_of_interest();
+  /* it is bound, use hash */
+  if (it->bmap & b[i]) return;
+  /* no constraints, nothing to gain */
+  if (!IsAttVar(VarOfTerm(XREGS[i+1]))) return;
+  /* be conservative */
+  sz = sizeof(BITS32)*(it->ntrys+it->nentries*2);
+  /* allocate space */
+  if (!(it->udi_data = malloc(sz)))
+    return;
+  sorted0 = sorted = (BITS32 *)it->udi_data;
+  LOCAL_exo_base = it->cls;
+  LOCAL_exo_arity = it->arity;
+  LOCAL_exo_arg = i;
+  for (i=0; i < it->hsize; i++) {
+    if (it->key[i]) {
+      BITS32 *s0 = sorted;
+      BITS32 offset = it->key[i]/arity, offset0 = offset;
+      
+      if (offset) {
+	*sorted++ = 0;
+	while (offset) {
+	  *sorted++ = offset;
+	  offset = it->links[offset];
+	}
+	if (sorted-s0 == 2) {
+	  it->links[offset0] = 0;
+	  sorted = s0;
+	} else {
+	  /* number of elements comes first */
+	  *s0 = sorted - (s0+1);
+	  qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar); 
+	  it->links[offset0] = s0-sorted0;
+	}
+      }
+    }
+  }
+  it->is_udi = i+1;
+  code = it->code;
+  code->opc = Yap_opcode(_try_exo_udi);
+  code = NEXTOP(code, lp);
+  code->opc = Yap_opcode(_retry_exo_udi);
+}
+
+static yamop *
+Min(struct index_t *it, BITS32 off)
+{
+  if (it->links[off]) {
+    BITS32 *c = (BITS32 *)it->udi_data;
+    BITS32 f = c[it->links[off]+1];
+    S = it->cls+it->arity*f;
+  }
+  return NEXTOP(NEXTOP(it->code,lp),lp);
+}
+
+static yamop *
+Max(struct index_t *it, BITS32 off)
+{
+  if (it->links[off]) {
+    BITS32 *c = (BITS32 *)it->udi_data;
+    BITS32 n = c[it->links[off]];
+    BITS32 f = c[it->links[off]+n];
+    S = it->cls+it->arity*f;
+  }
+  return NEXTOP(NEXTOP(it->code,lp),lp);
+}
+
+static yamop *
+Gt(struct index_t *it, Int x, BITS32 off)
+{
+  if (it->links[off]) {
+    BITS32 *c = (BITS32 *)it->udi_data;
+    BITS32 n = c[it->links[off]];
+
+    LOCAL_exo_base = it->cls;
+    LOCAL_exo_arity = it->arity;
+    LOCAL_exo_arg = arg_of_interest();
+    BITS32 *pt  = c+(it->links[off]+1);
+    BITS32 *end  = c+(it->links[off]+(n+2));
+    if (n > 8 && FALSE) {
+      //      start = binary_search(start,end, x, it);
+    } else {
+      while ( pt < end && compare(pt, x) <= 0 ) {
+	pt++;
+      }
+    }
+    if (pt == end) 
+      return FAILCODE;
+    S = it->cls+it->arity*pt[0];
+    end --;
+    if (pt < end ) {
+      YENV[-2] = (CELL)( pt+1 );
+      YENV[-1] = (CELL)( end );
+      YENV -= 2;
+      return it->code;
+    }
+  }
+  return NEXTOP(NEXTOP(it->code,lp),lp);
+}
+
+static yamop *
+Lt(struct index_t *it, Int x, BITS32 off)
+{
+  if (it->links[off]) {
+    BITS32 *c = (BITS32 *)it->udi_data;
+    BITS32 n = c[it->links[off]];
+
+    LOCAL_exo_base = it->cls;
+    LOCAL_exo_arity = it->arity;
+    LOCAL_exo_arg = arg_of_interest();
+    BITS32 *start  = c+(it->links[off]+1), *pt = start+1;
+    BITS32 *end  = c+(it->links[off]+(n+2));
+    if (n > 8 && FALSE) {
+      //      start = binary_search(start,end, x, it);
+    } else {
+      if (compare(start, x) >= 0)
+	return FAILCODE;
+      while ( pt < end && compare(pt, x) < 0 ) {
+	pt++;
+      }
+    }
+    S = it->cls+it->arity*start[0];
+    pt --;
+    if ( pt > start ) {
+      YENV[-2] = (CELL)( start+1 );
+      YENV[-1] = (CELL)( pt  );
+      YENV -= 2;
+      return it->code;
+    }
+  }
+  return NEXTOP(NEXTOP(it->code,lp),lp);
+}
+
+static yamop *
+Eq(struct index_t *it, Int x, BITS32 off)
+{
+  if (it->links[off]) {
+    BITS32 *c = (BITS32 *)it->udi_data;
+    BITS32 n = c[it->links[off]];
+
+    LOCAL_exo_base = it->cls;
+    LOCAL_exo_arity = it->arity;
+    LOCAL_exo_arg = arg_of_interest();
+    BITS32 *end  = c+(it->links[off]+(n+2));
+    BITS32 *start, *pt = c+(it->links[off]+1);
+    if (n > 8 && FALSE) {
+      //      start = binary_search(start,end, x, it);
+    } else {
+      Int c;
+      while ( pt < end && (c = compare(pt, x)) < 0 ) {
+	pt++;
+      }
+      if (pt == end || c) 
+	return FAILCODE;
+      start = pt;
+      pt ++;
+      while ( pt < end && (c = compare(pt, x)) == 0 ) {
+	pt++;
+      }
+    }
+    S = it->cls+it->arity*start[0];
+    pt --;
+    if ( pt > start ) {
+      YENV[-2] = (CELL)( start+1 );
+      YENV[-1] = (CELL)( pt  );
+      YENV -= 2;
+      return it->code;
+    }
+  }
+  return NEXTOP(NEXTOP(it->code,lp),lp);
+}
+
+static yamop *
+All(struct index_t *it, BITS32 off)
+{
+  if (it->links[off]) {
+    BITS32 *c = (BITS32 *)it->udi_data;
+    BITS32 n = c[it->links[off]];
+
+    LOCAL_exo_base = it->cls;
+    LOCAL_exo_arity = it->arity;
+    LOCAL_exo_arg = arg_of_interest();
+    BITS32 *start  = c+(it->links[off]+1);
+    BITS32 *end  = c+(it->links[off]+(n+1));
+    S = it->cls+it->arity*start[0];
+    if ( end > start ) {
+      YENV[-2] = (CELL)( start+1 );
+      YENV[-1] = (CELL)( end  );
+      YENV -= 2;
+      return it->code;
+    }
+  }
+  return NEXTOP(NEXTOP(it->code,lp),lp);
+}
+
+static yamop *
+RangeEnterUDIIndex(struct index_t *it)
+{
+  Int i = arg_of_interest();
+  Term  t = XREGS[i+1], a1;
+  BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S)/it->arity;
+  attvar_record *attv;
+  Atom at;
+
+  t = Deref(t);
+  if (!IsVarTerm(t))
+    return FALSE;
+  if(!IsAttVar(VarOfTerm(t)))
+    return FALSE;
+  attv = RepAttVar(VarOfTerm(t));
+  t =  attv->Atts;
+  a1 = ArgOfTerm(2,t);
+  if (IsAtomTerm(a1)) {
+    at = AtomOfTerm(a1);
+  } else {
+    Functor f = FunctorOfTerm(a1);
+    at  = NameOfFunctor(f);
+  }
+  if (at == AtomMax) {
+    return Max(it, off);
+  } else if (at == AtomMin) {
+    return Min(it, off);
+  } else if (at == AtomGT) {
+    Term arg = ArgOfTerm(1, a1);
+    if (IsVarTerm(arg))
+      return All(it, off);
+    else if (!IsIntTerm(arg)) {
+      Yap_Error(TYPE_ERROR_INTEGER, arg, "data-base constraint");
+      return FAILCODE;
+    }
+    return Gt(it, IntOfTerm(arg), off);
+  } else if (at == AtomLT) {
+    Term arg = ArgOfTerm(1, a1);
+
+    if (IsVarTerm(arg))
+      return All(it, off);
+    else if (!IsIntTerm(arg)) {
+      Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint");
+      return FAILCODE;
+    }
+    return Lt(it, IntOfTerm(arg), off);
+  } else if (at == AtomEQ) {
+    Term arg = ArgOfTerm(1, a1);
+
+    if (IsVarTerm(arg))
+      return All(it, off);
+    else if (!IsIntTerm(arg)) {
+      Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint");
+      return FAILCODE;
+    }
+    return Eq(it, IntOfTerm(arg), off);
+  }
+  return FAILCODE;
+}
+
+static int
+RangeRetryUDIIndex(struct index_t *it)
+{
+  CELL *w = (CELL*)(B+1);
+  BITS32 *end = (BITS32 *) w[it->arity+2],
+  *pt = (BITS32 *) w[it->arity+1];
+  BITS32 f = *pt;
+
+  S = it->cls+it->arity*f;
+  if (pt++ == end) return FALSE;
+  w[it->arity+1] = (CELL)pt;
+  return TRUE;
+}
+
+
+static struct udi_control_block RangeCB;
+
+typedef struct exo_udi_access_t {
+  CRefitExoIndex refit;
+};
+
+static struct exo_udi_access_t ExoCB;
+
+static void *
+RangeUdiInit (Term spec, int arg, int arity) {
+  ExoCB.refit = RangeUDIRefitIndex;
+  return (void *)&ExoCB;
+}
+
+static void *
+RangeUdiInsert (void *control,
+                Term term, int arg, void *data)
+{
+  struct index_t **ip = (struct index_t **)term;
+  (ExoCB.refit)(ip, LOCAL_ibnds);
+  (*ip)->udi_first = (void *)RangeEnterUDIIndex;
+  (*ip)->udi_next = (void *)RangeRetryUDIIndex;
+  return control;
+}
+
+static void *
+RangeUdiSearch (void *control,
+                int arg, Yap_UdiCallback callback, void *args)
+{
+  return NULL;
+}
+
+static int RangeUdiDestroy(void *control)
+{
+  return TRUE;
+}
+
+
+
+void Yap_udi_range_init(void) {
+  UdiControlBlock cb = &RangeCB;
+
+  memset((void *) cb,0, sizeof(*cb));
+
+  /*TODO: ask vitor why this gives a warning*/
+  cb->decl=Yap_LookupAtom("range");
+
+  cb->init= RangeUdiInit;
+  cb->insert=RangeUdiInsert;
+  cb->search=RangeUdiSearch;
+  cb->destroy=RangeUdiDestroy;
+
+  Yap_UdiRegister(cb);
+}

C/stdpreds.c

@@ -4285,6 +4285,7 @@ Yap_InitCPreds(void)
   Yap_InitMYDDAS_TopLevelPreds();
 #endif
   Yap_udi_init();
+  Yap_udi_range_init();
 
   Yap_InitSignalCPreds();
   Yap_InitUserCPreds();

C/udi.c

@@ -33,42 +33,42 @@ p_new_udi( USES_REGS1 )
 
   /* get the predicate from the spec, copied from cdmgr.c */
   if (IsVarTerm(spec)) {
-	  Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1");
+    Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1");
-	  return FALSE;
+    return FALSE;
   } else if (!IsApplTerm(spec)) {
-	  Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1");
+    Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1");
-	  return FALSE;
+    return FALSE;
   } else {
-	  Functor fun = FunctorOfTerm(spec);
+    Functor fun = FunctorOfTerm(spec);
-	  Term tmod = CurrentModule;
+    Term tmod = CurrentModule;
 
-	  while (fun == FunctorModule) {
+    while (fun == FunctorModule) {
-		  tmod = ArgOfTerm(1,spec);
+      tmod = ArgOfTerm(1,spec);
-		  if (IsVarTerm(tmod) ) {
+      if (IsVarTerm(tmod) ) {
-			  Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1");
+	Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1");
-			  return FALSE;
+	return FALSE;
-		  }
+      }
-		  if (!IsAtomTerm(tmod) ) {
+      if (!IsAtomTerm(tmod) ) {
-			  Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1");
+	Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1");
-			  return FALSE;
+	return FALSE;
-		  }
+      }
-		  spec = ArgOfTerm(2, spec);
+      spec = ArgOfTerm(2, spec);
-		  fun = FunctorOfTerm(spec);
+      fun = FunctorOfTerm(spec);
-	  }
+    }
-	  p = RepPredProp(PredPropByFunc(fun, tmod));
+    p = RepPredProp(PredPropByFunc(fun, tmod));
   }
   if (!p)
-	  return FALSE;
+    return FALSE;
   /* boring, boring, boring! */
   if ((p->PredFlags
-		  & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag))
+       & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag))
-		  || (p->ModuleOfPred == PROLOG_MODULE)) {
+      || (p->ModuleOfPred == PROLOG_MODULE)) {
-	  Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2");
+    Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2");
-	  return FALSE;
+    return FALSE;
   }
   if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|TabledPredFlag)) {
-	  Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2");
+    Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2");
-	  return FALSE;
+    return FALSE;
   }
   /* TODO: remove AtomRTree from atom list */
 

H/YapOpcodes.h

@@ -9,9 +9,11 @@
   OPCODE(trust_me                   ,Otapl),
   OPCODE(enter_exo                  ,e),
   OPCODE(try_exo                    ,lp),
+  OPCODE(try_exo_udi                ,lp),
   OPCODE(try_udi                    ,p),
   OPCODE(try_all_exo                ,lp),
   OPCODE(retry_exo                  ,lp),
+  OPCODE(retry_exo_udi              ,lp),
   OPCODE(retry_udi                  ,p),
   OPCODE(retry_all_exo              ,lp),
   OPCODE(enter_profiling            ,p),

H/Yapproto.h

@@ -186,6 +186,7 @@ void	STD_PROTO(Yap_PrepGoal,(UInt, CELL *, choiceptr USES_REGS));
 
 /* exo.c */
 void	STD_PROTO(Yap_InitExoPreds,(void));
+void    Yap_udi_range_init(void);
 
 /* foreign.c */
 char   *STD_PROTO(Yap_FindExecutable,(void));

H/clause.h

@@ -166,6 +166,7 @@ typedef struct index_t {
   PredEntry *ap;
   CELL bmap;
   int is_key;
+  int is_udi;
   UInt ncollisions;
   UInt ntrys;
   UInt nentries;
@@ -175,6 +176,7 @@ typedef struct index_t {
   BITS32 *links;
   size_t size;
   yamop *code;
+  void *udi_data, *udi_first, *udi_next;
 } Index_t;
 
 INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
@@ -211,6 +213,9 @@ LINK_TO_ADDRESS(struct index_t *it, BITS32  off)
   return it->links+off;
 }
 
+typedef void (*CRefitExoIndex)(struct index_t **ip, UInt b[]);
+typedef yamop *  (*CEnterExoIndex)(struct index_t *it);
+typedef int     (*CRetryExoIndex)(struct index_t *it);
 
 typedef struct dbterm_list {
   /* a list of dbterms associated with a clause */

H/dlocals.h

@@ -403,6 +403,12 @@
 
 #define LOCAL_ibnds LOCAL->ibnds_
 #define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_
+#define LOCAL_exo_base LOCAL->exo_base_
+#define REMOTE_exo_base(wid) REMOTE(wid)->exo_base_
+#define LOCAL_exo_arity LOCAL->exo_arity_
+#define REMOTE_exo_arity(wid) REMOTE(wid)->exo_arity_
+#define LOCAL_exo_arg LOCAL->exo_arg_
+#define REMOTE_exo_arg(wid) REMOTE(wid)->exo_arg_
 
 #define LOCAL_search_atoms LOCAL->search_atoms_
 #define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_

H/hlocals.h

@@ -227,6 +227,9 @@ typedef struct worker_local {
   Functor  FunctorVar_;
 
   UInt  ibnds_[256];
+  void*  exo_base_;
+  UInt  exo_arity_;
+  UInt  exo_arg_;
 
   struct scan_atoms*  search_atoms_;
 } w_local;

H/iatoms.h

@@ -161,11 +161,13 @@
   AtomLocal = Yap_LookupAtom("local");
   AtomLocalSp = Yap_LookupAtom("local_sp");
   AtomLocalTrie = Yap_LookupAtom("local_trie");
+  AtomMax = Yap_LookupAtom("max");
   AtomMaxArity = Yap_LookupAtom("max_arity");
   AtomMaxFiles = Yap_LookupAtom("max_files");
   AtomMegaClause = Yap_FullLookupAtom("$mega_clause");
   AtomMetaCall = Yap_FullLookupAtom("$call");
   AtomMfClause = Yap_FullLookupAtom("$mf_clause");
+  AtomMin = Yap_LookupAtom("min");
   AtomMinus = Yap_LookupAtom("-");
   AtomModify = Yap_LookupAtom("modify");
   AtomMultiFile = Yap_FullLookupAtom("$mf");

H/ilocals.h

@@ -227,6 +227,9 @@ static void InitWorker(int wid) {
   REMOTE_FunctorVar(wid) = FunctorVar;
 
 
+  REMOTE_exo_base(wid) = NULL;
+  REMOTE_exo_arity(wid) = 0;
+  REMOTE_exo_arg(wid) = 0;
 
 
 }

H/ratoms.h

@@ -161,11 +161,13 @@
   AtomLocal = AtomAdjust(AtomLocal);
   AtomLocalSp = AtomAdjust(AtomLocalSp);
   AtomLocalTrie = AtomAdjust(AtomLocalTrie);
+  AtomMax = AtomAdjust(AtomMax);
   AtomMaxArity = AtomAdjust(AtomMaxArity);
   AtomMaxFiles = AtomAdjust(AtomMaxFiles);
   AtomMegaClause = AtomAdjust(AtomMegaClause);
   AtomMetaCall = AtomAdjust(AtomMetaCall);
   AtomMfClause = AtomAdjust(AtomMfClause);
+  AtomMin = AtomAdjust(AtomMin);
   AtomMinus = AtomAdjust(AtomMinus);
   AtomModify = AtomAdjust(AtomModify);
   AtomMultiFile = AtomAdjust(AtomMultiFile);

H/rclause.h

@@ -288,8 +288,10 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
       /* instructions type lp */
     case _retry_all_exo:
     case _retry_exo:
+    case _retry_exo_udi:
     case _try_all_exo:
     case _try_exo:
+    case _try_exo_udi:
     case _user_switch:
       pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);
       pc->u.lp.p = PtoPredAdjust(pc->u.lp.p);

H/rlocals.h

@@ -225,6 +225,9 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
+
+
 
 
 

H/saveclause.h

@@ -305,8 +305,10 @@
       /* instructions type lp */
     case _retry_all_exo:
     case _retry_exo:
+    case _retry_exo_udi:
     case _try_all_exo:
     case _try_exo:
+    case _try_exo_udi:
     case _user_switch:
       CHECK(save_PtoOp(stream, pc->u.lp.l));
       CHECK(save_PtoPred(stream, pc->u.lp.p));

H/tatoms.h

@@ -320,6 +320,8 @@
 #define AtomLocalSp Yap_heap_regs->AtomLocalSp_
   Atom AtomLocalTrie_;
 #define AtomLocalTrie Yap_heap_regs->AtomLocalTrie_
+  Atom AtomMax_;
+#define AtomMax Yap_heap_regs->AtomMax_
   Atom AtomMaxArity_;
 #define AtomMaxArity Yap_heap_regs->AtomMaxArity_
   Atom AtomMaxFiles_;
@@ -330,6 +332,8 @@
 #define AtomMetaCall Yap_heap_regs->AtomMetaCall_
   Atom AtomMfClause_;
 #define AtomMfClause Yap_heap_regs->AtomMfClause_
+  Atom AtomMin_;
+#define AtomMin Yap_heap_regs->AtomMin_
   Atom AtomMinus_;
 #define AtomMinus Yap_heap_regs->AtomMinus_
   Atom AtomModify_;

H/walkclause.h

@@ -218,8 +218,10 @@
       /* instructions type lp */
     case _retry_all_exo:
     case _retry_exo:
+    case _retry_exo_udi:
     case _try_all_exo:
     case _try_exo:
+    case _try_exo_udi:
     case _user_switch:
       pc = NEXTOP(pc,lp);
       break;

Makefile.in

@@ -243,6 +243,7 @@ C_SOURCES= \
 	$(srcdir)/C/errors.c \
 	$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
 	$(srcdir)/C/exo.c \
+	$(srcdir)/C/exo_udi.c \
 	$(srcdir)/C/globals.c $(srcdir)/C/gmp_support.c \
 	$(srcdir)/C/gprof.c $(srcdir)/C/grow.c \
 	$(srcdir)/C/heapgc.c $(srcdir)/C/index.c	   \
@@ -359,7 +360,7 @@ ENGINE_OBJECTS = \
 	bignum.o bb.o \
 	cdmgr.o cmppreds.o compiler.o computils.o \
 	corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \
-	exec.o exo.o globals.o gmp_support.o gprof.o grow.o \
+	exec.o exo.o exo_udi.o globals.o gmp_support.o gprof.o grow.o \
 	heapgc.o index.o init.o  inlines.o \
 	iopreds.o depth_bound.o mavar.o \
 	myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \

misc/ATOMS

@@ -166,11 +166,13 @@ A	LoadAnswers		N	"load_answers"
 A	Local			N	"local"
 A	LocalSp			N	"local_sp"
 A	LocalTrie		N	"local_trie"
+A	Max			N	"max"
 A	MaxArity		N	"max_arity"
 A	MaxFiles		N	"max_files"
 A	MegaClause		F	"$mega_clause"
 A	MetaCall		F	"$call"
 A	MfClause		F	"$mf_clause"
+A	Min			N	"min"
 A	Minus			N	"-"
 A	Modify			N	"modify"
 A	MultiFile		F	"$mf"

misc/LOCALS

@@ -255,8 +255,12 @@ yamop			       *ImportFAILCODE				=NULL
 
 Functor				FunctorVar				=FunctorVar
 
-// exo indexing
+// exo indexingxb
+
 UInt				ibnds[256]				void
+BITS32*				exo_base				=NULL
+UInt				exo_arity				=0
+UInt				exo_arg					=0
 
 // atom completion
 struct scan_atoms*		search_atoms				void