exo first step.

C/absmi.c

@@ -960,6 +960,96 @@ Yap_absmi(int inp)
       GONext();
       ENDOp();
 
+/*****************************************************************
+*        EXO try - retry instructions                  *
+*****************************************************************/
+      /* try_exo    Pred,Label */
+      BOp(enter_exo, e);
+      {
+	yamop *pt;
+	saveregs();
+	pt = Yap_ExoLookup(PredFromExpandCode(PREG));
+	setregs();
+	PREG = pt;
+      }
+      JMPNext();      
+      ENDBOp();
+
+      /* check if enough space between trail and codespace */
+      /* try_exo    Pred,Label */
+      Op(try_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);
+      S_YREG[-1] = (CELL)SREG;
+      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(PREG, lp);
+      SET_BB(B_YREG);
+      ENDCACHE_Y();
+      GONext();
+      ENDOp();
+
+      /* retry_exo    Pred */
+      Op(retry_exo, lp);
+      BEGD(d0);
+      CACHE_Y(B);
+      d0 = Yap_NextExo(B_YREG, (struct index_t *)PREG->u.lp.l);
+      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.Otapl.s);
+#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.Otapl.s);
+	    /* 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               *
 *****************************************************************/
@@ -3228,7 +3318,7 @@ Yap_absmi(int inp)
      ENDOp();
 
      Op(run_eam, os);
-       if (inp==-9000) { /* usar a indexação para saber quais as alternativas validas */
+       if (inp==-9000) { /* use indexing to find out valid alternatives */
  	  extern CELL *beam_ALTERNATIVES;
           *beam_ALTERNATIVES= (CELL *) PREG->u.os.opcw;
 	  beam_ALTERNATIVES++;
@@ -3277,6 +3367,8 @@ Yap_absmi(int inp)
 #endif
 
 
+
+
 /************************************************************************\
 *    Get Instructions							*
 \************************************************************************/
@@ -3470,6 +3562,35 @@ Yap_absmi(int inp)
       ENDD(d0);
       ENDOp();
 
+      Op(get_atom_exo, x);
+      BEGD(d0);
+      BEGD(d1);
+      /* fetch arguments */
+      d0 = XREG(PREG->u.xc.x);
+      d1 = *SREG++;
+
+      BEGP(pt0);
+      deref_head(d0, gatom_exo_unk);
+      /* argument is nonvar */
+    gatom_exo_nonvar:
+      if (d0 == d1) {
+	PREG = NEXTOP(PREG, x);
+	GONext();
+      }
+      else {
+	FAIL();
+      }
+
+      deref_body(d0, pt0, gatom_exo_unk, gatom_exo_nonvar);
+      /* argument is a variable */
+      PREG = NEXTOP(PREG, x);
+      Bind(pt0, d1);
+      GONext();
+      ENDP(pt0);
+      ENDD(d1);
+      ENDD(d0);
+      ENDOp();
+
       Op(get_2atoms, cc);
       BEGD(d0);
       BEGD(d1);

C/exo.c

@@ -0,0 +1,453 @@
+/*************************************************************************
+*									 *
+*	 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"
+#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 NEXTOP(V,TYPE)    ((yamop *)(&((V)->u.TYPE.next)))
+
+#define MAX_ARITY 256
+
+/* Simple hash function */
+static UInt
+HASH(UInt j, CELL *cl, struct index_t *it)
+{
+  return (cl[j] >> 3) % it->nels + j*(7*it->nels)/11;
+}
+
+/* search for matching elements */
+static int 
+MATCH(CELL *clp,CELL *kvp, UInt j, UInt bnds[])
+{
+  do {
+    if ( bnds[j] && *clp == *kvp)
+      return FALSE;
+    clp--;
+    kvp--;
+    j--;
+  } while (j != 0);
+  return TRUE;
+}
+
+static void
+ADD_TO_TRY_CHAIN(CELL *kvp, CELL *cl, struct index_t *it)
+{
+  UInt new = (kvp-it->cls)/it->arity;
+  UInt old = (cl-it->cls)/it->arity;
+  UInt *links = it->links;
+  UInt tmp = links[old]; /* points to the end of the chain */
+
+  if (!tmp) {
+    links[old] = links[new] = new;
+  } else {
+    links[new] = links[tmp];
+    links[tmp] = new;
+    links[old] = new;
+  }
+}
+
+static UInt
+NEXT(UInt hash, struct index_t *it, UInt j)
+{
+  return (j+1) % it->nels;
+}
+
+/* This is the critical routine, it builds the hash table *
+ * each HT field stores a key pointer which is actually
+ * a pointer to the point in the clause where one can find the element.
+ *
+ * The cls table indexes all elements that can be reached using that key.
+ * 
+ * Insert:
+ * j = first
+ * not match cij -> insert, open new chain
+ * match ci..j ck..j -> find j = minarg(cij \= c2j), 
+ * else j = +inf -> c2+ci
+ * Lookup:
+ * j= first
+ * not match cij -> fail
+ * match ci..j ck..j -> find j = minarg(cij \= c2j)
+ * else
+ */
+static void
+INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt bnds[])
+{
+  UInt j = base;
+  CELL *kvp;
+  UInt hash;
+
+  /* skip over argument */
+  while (!bnds[j]) {
+    j++;
+  }
+  /* j is the firs bound element */
+  /* check if we match */
+  hash = HASH(j, cl, it);
+ next:
+  /* loop to insert element */
+  kvp = it->key[hash];
+  if (kvp == NULL) {
+    /* simple case, new entry */
+    it->key[hash] = cl+j;
+    return;
+  } else if (MATCH(cl+j, kvp, j, bnds))  {
+    /* collision */
+    UInt k;
+    CELL *target;
+    
+    for (k =j, target = kvp; k < arity; k++,target++ ) {
+      if (bnds[k]) {
+	if (*target != cl[k]) {
+	  /* found a new forking point */
+	  INSERT(cl, it, arity, j, bnds);
+	  return;
+	}
+      }
+    }
+    ADD_TO_TRY_CHAIN(kvp-base, cl, it);
+    return;
+  } else {
+    j =  NEXT(hash, it, j);
+    goto next;
+  }
+}
+
+static yamop *
+LOOKUP(struct index_t *it, UInt arity, UInt bnds[])
+{
+  UInt j = 0;
+  CELL *kvp;
+  UInt hash;
+
+  /* skip over argument */
+  while (!bnds[j]) {
+    j++;
+  }
+  /* j is the firs bound element */
+  /* check if we match */
+ hash:
+  hash = HASH(j, XREGS+1, it);
+ next:
+  /* loop to insert element */
+  kvp = it->key[hash];
+  if (kvp == NULL) {
+    /* simple case, no element */
+    return FAILCODE;
+  } else if (MATCH(XREGS+(j+1), kvp, j, bnds))  {
+    /* found element */
+    UInt k;
+    CELL *target;
+    
+    for (k =j, target = kvp; k < arity; k++,target++ ) {
+      if (bnds[k]) {
+	if (*target != XREGS[k+1]) {
+	  goto hash;
+	}
+      }
+    }
+    S = target-arity;
+    return it->code;
+  } else {
+    /* collision */
+    j =  NEXT(hash, it, j);
+    goto next;
+  }
+}
+
+static void
+fill_hash(UInt bmap, UInt bnds[], struct index_t *it)
+{
+  UInt i;
+  UInt arity = it->arity;
+  CELL *cl = it->cls;
+
+  for (i=0; i < it->nels; i++) {
+    INSERT(cl, it, arity, 0, bnds);
+    cl += arity;
+  }
+  for (i=0; i < it->nels*2; i++) {
+    if (it->key[i]) {
+      UInt offset = (it->key[i]-it->cls)/arity;
+      UInt last = it->links[offset];
+
+      /* the chain used to point straight to the last, and the last back to the origibal first */
+      it->links[offset] = it->links[last];
+      it->links[last] = 0;
+    }
+  }
+}
+
+static struct index_t *
+add_index(struct index_t *i0, UInt bmap, UInt bndsf[], PredEntry *ap)
+{
+  UInt ncls = ap->cs.p_code.NOfClauses, j;
+  CELL *base;
+  struct index_t *i;
+  size_t sz;
+  yamop *ptr;
+  
+  if (!(base = (CELL *)Yap_AllocCodeSpace(3*sizeof(CELL)*ncls))) {
+    CACHE_REGS
+    save_machine_regs();
+    LOCAL_Error_Size = 3*ncls*sizeof(CELL);
+    LOCAL_ErrorMessage = "not enough space to index";
+    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
+    save_machine_regs();
+    LOCAL_Error_Size = 3*ncls*sizeof(CELL);
+    LOCAL_ErrorMessage = "not enough space to index";
+    Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
+    return NULL;
+  }
+  bzero(base, 3*sizeof(CELL)*ncls);
+  i->next = i0->next;
+  i->prev = i0;
+  i->nels = ncls;
+  i->arity = ap->ArityOfPE;
+  i->ap = ap;
+  i->bmap = bmap;
+  i->is_key = FALSE;
+  i->hsize = 2*ncls;
+  i->key = (CELL **)base;
+  i->links = (CELL *)(base+2*ncls);
+  i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *));
+  i0->next = i;
+  fill_hash(bmap, base, i);
+  ptr = (yamop *)(i+1);
+  i->code = ptr;
+  ptr->opc = Yap_opcode(_try_exo);
+  ptr->u.lp.l = (yamop *)i;
+  ptr->u.lp.p = ap;
+  ptr = NEXTOP(ptr, lp);
+  ptr->opc = Yap_opcode(_retry_exo);
+  ptr->u.lp.p = ap;
+  ptr->u.lp.l = (yamop *)i;
+  ptr = NEXTOP(ptr, lp);
+  for (j = 0; j < i->arity; j++) {
+    ptr->opc = Yap_opcode(_get_atom_exo);
+#if PRECOMPUTE_REGADDRESS
+    ptr->u.x.x = (CELL) (XREGS + (j+1));
+#else
+    ptr->u.x.x = j+1;
+#endif
+    ptr = NEXTOP(ptr, x);
+  }
+  ptr->opc = Yap_opcode(_procceed);
+  ptr->u.p.p = ap;
+  ptr = NEXTOP(ptr, p);
+  ptr->opc = Yap_opcode(_Ystop);
+  ptr->u.l.l = i->code;
+  return i;
+}
+
+yamop  *
+Yap_ExoLookup(PredEntry *ap) 
+{
+  UInt arity = ap->ArityOfPE;
+  UInt bmap = 0L, bit = 1, count = 0, j;
+  struct index_t *i = *(struct index_t **)(ap->cs.p_code.FirstClause);
+  UInt bnds[MAX_ARITY];
+  
+  for (j=0; j< arity; j++, bit<<=1) {
+    Term t = Deref(XREGS[j+1]);
+    if (!IsVarTerm(t)) {
+      bmap += bit;
+      bnds[j] = TRUE;
+      count++;
+    }
+    XREGS[j+1] = t;
+  }
+
+  while (i) {
+    if (i->is_key) {
+      if ((i->bmap & bmap) == i->bmap) {
+	break;
+      }
+    } else {
+      if (i->bmap == bmap) {
+	break;
+      }
+    }
+  }
+  if (!i) {
+    i = add_index(i, bmap, bnds, ap);
+  }
+  return LOOKUP(i, arity, bnds);
+}
+
+CELL
+Yap_NextExo(choiceptr cptr, struct index_t *it) 
+{
+  CELL offset = ((CELL *)(B+1))[it->arity];
+  CELL next = it->links[offset];
+  ((CELL *)(B+1))[it->arity] = next;
+  S = it->cls+it->arity*offset;
+  return next;
+}
+
+static Int 
+p_exodb_get_space( USES_REGS1 )
+{				/* '$number_of_clauses'(Predicate,M,N) */
+  Term            t = Deref(ARG1);
+  Term            mod = Deref(ARG2);
+  Term            tn = Deref(ARG3);
+  UInt		  arity;
+  Prop            pe;
+  PredEntry      *ap;
+  MegaClause *mcl;
+  UInt ncls;
+  UInt required;
+  struct index_t **li;
+
+
+  if (IsVarTerm(mod)  || !IsAtomTerm(mod)) {
+    return(FALSE);
+  }
+  if (IsAtomTerm(t)) {
+    Atom a = AtomOfTerm(t);
+    arity = 0;
+    pe = PredPropByAtom(a, mod);
+  } else if (IsApplTerm(t)) {
+    register Functor f = FunctorOfTerm(t);
+    arity = ArityOfFunctor(f);
+    pe = PredPropByFunc(f, mod);
+  } else {
+    return FALSE;
+  }
+  if (EndOfPAEntr(pe))
+    return FALSE;
+  ap = RepPredProp(pe);
+  if (ap->PredFlags & (DynamicPredFlag|LogUpdatePredFlag
+#ifdef TABLING
+		       |TabledPredFlag
+#endif /* TABLING */
+		       )) {
+    Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,t,"dbload_get_space/4");
+    return FALSE;
+  }
+  if (IsVarTerm(tn)  || !IsIntegerTerm(tn)) {
+    return FALSE;
+  }
+  ncls = IntegerOfTerm(tn);
+  if (ncls <= 1) {
+    return FALSE;
+  }
+
+  required = ncls*sizeof(CELL)+sizeof(MegaClause)+2*sizeof(struct index_t *);
+#ifdef DEBUG
+  total_megaclause += required;
+  nof_megaclauses++;
+#endif
+  while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
+    if (!Yap_growheap(FALSE, required, NULL)) {
+      /* just fail, the system will keep on going */
+      return FALSE;
+    }
+  }
+  Yap_ClauseSpace += required;
+  /* cool, it's our turn to do the conversion */
+  mcl->ClFlags = MegaMask;
+  mcl->ClSize = required-sizeof(MegaClause);
+  mcl->ClPred = ap;
+  mcl->ClItemSize = arity*sizeof(CELL);
+  mcl->ClNext = NULL;
+  li = (struct index_t **)(mcl->ClCode);
+  li[0] = li[1] = NULL;
+  ap->cs.p_code.FirstClause =
+    ap->cs.p_code.LastClause =
+    mcl->ClCode;
+  ap->PredFlags |= MegaClausePredFlag;
+  ap->cs.p_code.NOfClauses = ncls;
+  if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
+    ap->OpcodeOfPred = Yap_opcode(_spy_pred);
+  } else {
+    ap->OpcodeOfPred = Yap_opcode(_enter_exo);
+  }
+  ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); 
+  return Yap_unify(ARG4, MkIntegerTerm((Int)mcl));
+}
+
+#define DerefAndCheck(t, V)			\
+  t = Deref(V); if(IsVarTerm(t) || !(IsAtomOrIntTerm(t))) Yap_Error(TYPE_ERROR_ATOM, t0, "load_db");
+
+static int 
+store_exo(yamop *pc, UInt arity, Term t0)
+{
+  Term t;
+  CELL *tp = RepAppl(t0)+1,
+    *cpc = (CELL *)pc;
+  UInt i;
+  for (i = 0; i< arity; i++) {
+    DerefAndCheck(t, tp[0]);
+    *cpc = t;
+    tp++;
+    cpc++;
+  }
+  return TRUE;
+}
+
+static Int 
+p_exoassert( USES_REGS1 )
+{				/* '$number_of_clauses'(Predicate,M,N) */
+  Term            thandle = Deref(ARG2);
+  Term            tn = Deref(ARG3);
+  PredEntry       *pe;
+  MegaClause      *mcl;
+  Int              n;
+
+
+  if (IsVarTerm(thandle)  || !IsIntegerTerm(thandle)) {
+    return FALSE;
+  }
+  mcl = (MegaClause *)IntegerOfTerm(thandle);
+  if (IsVarTerm(tn)  || !IsIntegerTerm(tn)) {
+    return FALSE;
+  }
+  n = IntegerOfTerm(tn);
+  pe = mcl->ClPred;
+  return store_exo((yamop *)((ADDR)mcl->ClCode+2*sizeof(struct index_t *)+n*(mcl->ClItemSize)),pe->ArityOfPE, Deref(ARG1));
+}
+
+void 
+Yap_InitExoPreds(void)
+{
+  CACHE_REGS
+  Term cm = CurrentModule;
+
+  CurrentModule = DBLOAD_MODULE;
+  Yap_InitCPred("exo_db_get_space", 4, p_exodb_get_space, 0L);
+  Yap_InitCPred("exoassert", 3, p_exoassert, 0L);
+  CurrentModule = cm;
+}

C/stdpreds.c

@@ -4486,6 +4486,7 @@ Yap_InitCPreds(void)
   Yap_InitGlobals();
   Yap_InitInlines();
   Yap_InitIOPreds();
+  Yap_InitExoPreds();
   Yap_InitLoadForeign();
   Yap_InitModulesC();
   Yap_InitSavePreds();

H/YapOpcodes.h

@@ -7,6 +7,9 @@
   OPCODE(try_me                     ,Otapl),
   OPCODE(retry_me                   ,Otapl),
   OPCODE(trust_me                   ,Otapl),
+  OPCODE(enter_exo                  ,e),
+  OPCODE(try_exo                    ,lp),
+  OPCODE(retry_exo                  ,lp),
   OPCODE(enter_profiling            ,p),
   OPCODE(retry_profiled             ,p),
   OPCODE(profiled_retry_me          ,Otapl),
@@ -58,6 +61,7 @@
   OPCODE(get_x_val                  ,xx),
   OPCODE(get_y_val                  ,yx),
   OPCODE(get_atom                   ,xc),
+  OPCODE(get_atom_exo               ,x),
   OPCODE(get_2atoms                 ,cc),
   OPCODE(get_3atoms                 ,ccc),
   OPCODE(get_4atoms                 ,cccc),

H/Yapproto.h

@@ -183,6 +183,9 @@ Int	STD_PROTO(Yap_exec_absmi,(int));
 void	STD_PROTO(Yap_trust_last,(void));
 Term	STD_PROTO(Yap_GetException,(void));
 
+/* exo.c */
+void	STD_PROTO(Yap_InitExoPreds,(void));
+
 /* gprof.c */
 void	STD_PROTO(Yap_InitLowProf,(void));
 #if  LOW_PROF

H/clause.h

@@ -159,6 +159,21 @@ typedef union clause_ptr {
   struct static_index *si;
 } ClausePointer;
 
+typedef struct index_t {
+  struct index_t *next, *prev;
+  UInt nels;
+  UInt arity;
+  PredEntry *ap;
+  CELL bmap;
+  int is_key;
+  UInt hsize;
+  CELL **key;
+  CELL *cls;
+  CELL *links;
+  yamop *code;
+} Index_t;
+
+
 typedef struct dbterm_list {
   /* a list of dbterms associated with a clause */
   DBTerm *dbterms;
@@ -228,6 +243,10 @@ void     STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
 LogUpdClause  *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
 LogUpdClause  *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *, Term *, yamop *,yamop *));
 
+/* exo.c */
+yamop    *Yap_ExoLookup(PredEntry *ap);
+CELL    Yap_NextExo(choiceptr cpt, struct index_t *it);
+
 #if USE_THREADED_CODE
 
 #define OP_HASH_SIZE 2048

H/rclause.h

@@ -218,6 +218,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
     case _Nstop:
     case _allocate:
     case _copy_idb_term:
+    case _enter_exo:
     case _expand_index:
     case _index_blob:
     case _index_dbref:
@@ -285,6 +286,8 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
       pc = NEXTOP(pc,llll);
       break;
       /* instructions type lp */
+    case _retry_exo:
+    case _try_exo:
     case _user_switch:
       pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);
       pc->u.lp.p = PtoPredAdjust(pc->u.lp.p);
@@ -537,6 +540,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
       pc = NEXTOP(pc,sssllp);
       break;
       /* instructions type x */
+    case _get_atom_exo:
     case _get_list:
     case _put_list:
     case _save_b_x:

H/saveclause.h

@@ -236,6 +236,7 @@
     case _Nstop:
     case _allocate:
     case _copy_idb_term:
+    case _enter_exo:
     case _expand_index:
     case _index_blob:
     case _index_dbref:
@@ -302,6 +303,8 @@
       pc = NEXTOP(pc,llll);
       break;
       /* instructions type lp */
+    case _retry_exo:
+    case _try_exo:
     case _user_switch:
       CHECK(save_PtoOp(stream, pc->u.lp.l));
       CHECK(save_PtoPred(stream, pc->u.lp.p));
@@ -553,6 +556,7 @@
       pc = NEXTOP(pc,sssllp);
       break;
       /* instructions type x */
+    case _get_atom_exo:
     case _get_list:
     case _put_list:
     case _save_b_x:

H/walkclause.h

@@ -165,6 +165,7 @@
     case _unify_idb_term:
       return found_idb_clause(pc, startp, endp);
     case _allocate:
+    case _enter_exo:
     case _index_blob:
     case _index_dbref:
     case _index_long:
@@ -215,6 +216,8 @@
       pc = NEXTOP(pc,llll);
       break;
       /* instructions type lp */
+    case _retry_exo:
+    case _try_exo:
     case _user_switch:
       pc = NEXTOP(pc,lp);
       break;
@@ -405,6 +408,7 @@
       pc = NEXTOP(pc,sssllp);
       break;
       /* instructions type x */
+    case _get_atom_exo:
     case _get_list:
     case _put_list:
     case _save_b_x:

Makefile.in

@@ -243,6 +243,7 @@ C_SOURCES= \
 	$(srcdir)/C/corout.c $(srcdir)/C/dbase.c $(srcdir)/C/dlmalloc.c \
 	$(srcdir)/C/errors.c \
 	$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
+	$(srcdir)/C/exo.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	   \
@@ -361,7 +362,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 globals.o gmp_support.o gprof.o grow.o \
+	exec.o exo.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/buildops

@@ -139,6 +139,7 @@ file(I,W,C,L,F,H, S) :-
 	output_save_clause(S).
 
 grep_opcode(W, Line) :-
+%format('~s~n', [Line]),
 	split(Line," 	,();",[OP,Name,Type]),
 	Name \= "or_last",
 	check_op(OP),

pl/dbload.yap

@@ -31,11 +31,11 @@ prolog:load_db(Fs) :-
 dbload(Fs, _, G) :-
 	var(Fs),
 	'$do_error'(instantiation_error,G).	
-dbload([], _, _).	
+dbload([], _, _) :- !.	
-dbload([F|Fs], M0, G) :-
+dbload([F|Fs], M0, G) :- !,
 	dbload(F, M0, G),
 	dbload(Fs, M0, G).
-dbload(M:F, _M0, G) :-
+dbload(M:F, _M0, G) :- !,
 	dbload(F, M, G).
 dbload(F, M0, G) :-
 	atom(F), !,
@@ -76,8 +76,11 @@ dbload_count(T0, M0) :-
 get_module(M1:T0,_,T,M) :- !,
 	get_module(T0, M1, T , M).
 get_module(T,M,T,M).
+
 	
-	
+load_facts :-
+	yap_flag(exo_compilation, on), !.
+	load_exofacts.
 load_facts :-
 	retract(dbloading(Na,Arity,M,T,NaAr,_)),
 	nb_getval(NaAr,Size),
@@ -104,13 +107,44 @@ dbload_add_facts(R, M) :-
 dbload_add_fact(T0, M0) :-
 	get_module(T0,M0,T,M),
 	functor(T,Na,Arity),
-	Na \= gene_product,
 	dbloading(Na,Arity,M,_,NaAr,Handle),
 	nb_getval(NaAr,I0),
 	I is I0+1,
 	nb_setval(NaAr,I),
 	dbassert(T,Handle,I0).
-	
+
+load_exofacts :-
+	retract(dbloading(Na,Arity,M,T,NaAr,_)),
+	nb_getval(NaAr,Size),
+	exo_db_get_space(T, M, Size, Handle),
+	assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
+	nb_setval(NaAr,0),
+	fail.
+load_rxofacts :-
+	dbprocess(F, M),
+	open(F, read, R),
+	exodb_add_facts(R, M),
+	close(R),
+	fail.
+load_facts.
+
+exodb_add_facts(R, M) :-
+	repeat,
+	read(R,T),
+	( T = end_of_file -> !;
+	    exodb_add_fact(T, M),
+	    fail 
+	).
+
+exodb_add_fact(T0, M0) :-
+	get_module(T0,M0,T,M),
+	functor(T,Na,Arity),
+	dbloading(Na,Arity,M,_,NaAr,Handle),
+	nb_getval(NaAr,I0),
+	I is I0+1,
+	nb_setval(NaAr,I),
+	exoassert(T,Handle,I0).
+
 clean_up :-
 	retractall(dbloading(_,_,_,_,_,_)),
 	retractall(dbprocess(_,_)),