Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

C/absmi.c

@@ -968,7 +968,7 @@ Yap_absmi(int inp)
       {
 	yamop *pt;
 	saveregs();
-	pt = Yap_ExoLookup(PredFromDefCode(PREG));
+	pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS);
 	setregs();
 #ifdef SHADOW_S
 	SREG = S;
@@ -1050,12 +1050,13 @@ Yap_absmi(int inp)
       Op(retry_exo, lp);
       BEGD(d0);
       CACHE_Y(B);
-      saveregs();
+      {
-      d0 = Yap_NextExo(B_YREG, (struct index_t *)PREG->u.lp.l);
+	struct index_t *it = (struct index_t *)(PREG->u.lp.l);
-      setregs();
+	CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
-#ifdef SHADOW_S
+	d0 = it->links[offset];
-      SREG = S;
+	((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, d0);
-#endif
+	SREG = it->cls+it->arity*offset;
+      }
       if (d0) {
 	/* After retry, cut should be pointing at the parent
 	 * choicepoint for the current B */

C/arith1.c

@@ -689,7 +689,7 @@ eval1(Int fi, Term t) {
       return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
     case big_int_e:
 #ifdef USE_GMP
-      return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t));
+      return Yap_gmp_mul_float_big(Yap_random(), t);
 #endif
     default:
       RERROR();

C/c_interface.c

@@ -333,6 +333,7 @@
 #include "Yap.h"
 #include "clause.h"
 #include "yapio.h"
+#include "Foreign.h"
 #include "attvar.h"
 #include "SWI-Stream.h"
 #if HAVE_STDARG_H
@@ -438,8 +439,8 @@ X_API PredEntry *STD_PROTO(YAP_AtomToPred,(Atom));
 X_API PredEntry *STD_PROTO(YAP_FunctorToPredInModule,(Functor, Term));
 X_API PredEntry *STD_PROTO(YAP_AtomToPredInModule,(Atom, Term));
 X_API Int     STD_PROTO(YAP_CallProlog,(Term));
-X_API void   *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
+X_API void   *STD_PROTO(YAP_AllocSpaceFromYap,(size_t));
-X_API void   *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
+X_API void   *STD_PROTO(YAP_ReallocSpaceFromYap,(void*,size_t));
 X_API void    STD_PROTO(YAP_FreeSpaceFromYap,(void *));
 X_API int     STD_PROTO(YAP_StringToBuffer, (Term, char *, unsigned int));
 X_API Term    STD_PROTO(YAP_ReadBuffer, (char *,Term *));
@@ -1909,7 +1910,7 @@ YAP_CallProlog(Term t)
 }
 
 X_API void *
-YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) {
+YAP_ReallocSpaceFromYap(void *ptr,size_t size) {
   CACHE_REGS
   void *new_ptr;
   BACKUP_MACHINE_REGS();
@@ -1923,7 +1924,7 @@ YAP_ReallocSpaceFromYap(void *ptr,unsigned int size) {
   return new_ptr;
 }
 X_API void *
-YAP_AllocSpaceFromYap(unsigned int size)
+YAP_AllocSpaceFromYap(size_t size)
 {
   CACHE_REGS 
     void *ptr;
@@ -2836,7 +2837,7 @@ YAP_CompileClause(Term t)
 {
   CACHE_REGS
   yamop *codeaddr;
-  int mod = CurrentModule;
+  Term mod = CurrentModule;
   Term tn = TermNil;
 
   BACKUP_MACHINE_REGS();
@@ -3261,8 +3262,14 @@ YAP_FastInit(char saved_state[])
   init_args.DelayedReleaseLoad = 3;
   init_args.PrologShouldHandleInterrupts = FALSE;
   init_args.ExecutionMode = INTERPRETED;
-  init_args.Argc = 0;
+  init_args.Argc = 1;
-  init_args.Argv = NULL;
+  {
+    size_t l1 = 2*sizeof(char *);
+    if (!(init_args.Argv = (char **)malloc(l1)))
+      return YAP_BOOT_ERROR;
+    init_args.Argv[0] = Yap_FindExecutable ();
+    init_args.Argv[1] = NULL;
+  }
   init_args.ErrorNo = 0;
   init_args.ErrorCause = NULL;
   init_args.QuietMode = FALSE;

C/cdmgr.c

@@ -544,6 +544,9 @@ PredForChoicePt(yamop *p_code) {
     case _retry_me:
     case _trust_me:
       return p_code->u.Otapl.p;
+    case _retry_exo:
+    case _retry_all_exo:
+      return p_code->u.lp.p;
     case _try_logical:
     case _retry_logical:
     case _trust_logical:
@@ -891,7 +894,7 @@ Yap_BuildMegaClause(PredEntry *ap)
   ap->cs.p_code.FirstClause =
     ap->cs.p_code.LastClause =
     mcl->ClCode;
-  ap->PredFlags |= MegaClausePredFlag;
+  ap->PredFlags |= MegaClausePredFlag|SourcePredFlag;
   Yap_inform_profiler_of_clause(mcl, (char *)mcl+required, ap, GPROF_MEGA);
 }
 
@@ -904,9 +907,13 @@ split_megaclause(PredEntry *ap)
   yamop *ptr;
   UInt ncls = ap->cs.p_code.NOfClauses, i;
 
-  RemoveIndexation(ap);
   mcl =
     ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
+  if (mcl->ClFlags & ExoMask) {
+    Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,TermNil,"while deleting clause from exo predicate %s/%d\n",RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,ap->ArityOfPE);
+    return;
+  }
+  RemoveIndexation(ap);
   for (i = 0, ptr = mcl->ClCode; i < ncls; i++) {
     StaticClause *new = (StaticClause *)Yap_AllocCodeSpace(sizeof(StaticClause)+mcl->ClItemSize+(UInt)NEXTOP((yamop *)NULL,p));
     if (new == NULL) {
@@ -2707,7 +2714,7 @@ p_purge_clauses( USES_REGS1 )
   Term            t = Deref(ARG1);
   Term            mod = Deref(ARG2);
   MegaClause      *before = DeadMegaClauses;
-
+  
   Yap_PutValue(AtomAbol, MkAtomTerm(AtomNil));
   if (IsVarTerm(t))
     return FALSE;
@@ -3003,6 +3010,27 @@ p_is_source( USES_REGS1 )
   return(out);
 }
 
+static Int 
+p_is_exo( USES_REGS1 )
+{				/* '$is_dynamic'(+P)	 */
+  PredEntry      *pe;
+  Int             out;
+  MegaClause *mcl;
+
+  pe = get_pred(Deref(ARG1),  Deref(ARG2), "$is_exo");
+  if (EndOfPAEntr(pe))
+    return FALSE;
+  PELOCK(28,pe);
+  out = (pe->PredFlags & MegaClausePredFlag);
+  if (out) {
+    mcl =
+      ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
+    out = mcl->ClFlags & ExoMask;
+  }
+  UNLOCKPE(46,pe);
+  return(out);
+}
+
 static Int 
 p_owner_file( USES_REGS1 )
 {				/* '$owner_file'(+P,M,F)	 */
@@ -5228,6 +5256,15 @@ p_nth_clause( USES_REGS1 )
     UNLOCK(pe->PELock);
     return Yap_unify(MkDBRefTerm((DBRef)cl), ARG4);
   } else if (pe->PredFlags & MegaClausePredFlag) {
+    MegaClause *mcl = ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
+    if (mcl->ClFlags & ExoMask) {
+      Term tf[2];
+      tf[0] = pe->ModuleOfPred;
+      tf[1] = Yap_MkApplTerm(pe->FunctorOfPred, pe->ArityOfPE, (CELL *)((char *)mcl->ClCode+(ncls-1)*mcl->ClItemSize));
+      UNLOCK(pe->PELock);
+      return Yap_unify(Yap_MkApplTerm(FunctorExoClause, 2, tf), ARG4);
+    }
+    /* fast access to nth element, all have same size */
     UNLOCK(pe->PELock);
     return Yap_unify(Yap_MkMegaRefTerm(pe,(yamop *)cl), ARG4);
   } else {
@@ -5769,6 +5806,12 @@ p_choicepoint_info( USES_REGS1 )
       pe = ipc->u.Otapl.p;
       t = BuildActivePred(pe, cptr->cp_args);
       break;
+    case _retry_exo:
+    case _retry_all_exo:
+      ncl = NULL;
+      pe = ipc->u.lp.p;
+      t = BuildActivePred(pe, cptr->cp_args);
+      break;      
     case _Nstop:
       { 
 	Atom at = AtomLive;
@@ -5978,7 +6021,7 @@ p_dbload_get_space( USES_REGS1 )
   ap->cs.p_code.FirstClause =
     ap->cs.p_code.LastClause =
     mcl->ClCode;
-  ap->PredFlags |= MegaClausePredFlag;
+  ap->PredFlags |= (MegaClausePredFlag|SourcePredFlag);
   ap->cs.p_code.NOfClauses = ncls;
   if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
     ap->OpcodeOfPred = Yap_opcode(_spy_pred);
@@ -6037,6 +6080,7 @@ Yap_InitCdMgr(void)
   Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag);
   Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag);
   Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag);
+  Yap_InitCPred("$is_exo", 2, p_is_exo, TestPredFlag | SafePredFlag);
   Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag);
   Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag);
   Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);

C/dbase.c

@@ -4501,6 +4501,10 @@ p_erase_clause( USES_REGS1 )
 	Yap_EraseMegaClause(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1));
 	return TRUE;
       }
+      if (FunctorOfTerm(t1) == FunctorExoClause) {
+	Yap_Error(TYPE_ERROR_DBREF, t1, "erase exo clause");
+	return FALSE;
+      }
     }
     Yap_Error(TYPE_ERROR_DBREF, t1, "erase");
     return FALSE;
@@ -4688,6 +4692,9 @@ p_instance( USES_REGS1 )
       if (FunctorOfTerm(t1) == FunctorMegaClause) {
 	return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
       }
+      if (FunctorOfTerm(t1) == FunctorExoClause) {
+	return Yap_unify(ARG2,ArgOfTerm(2,t1));
+      }
     }
     return FALSE;
   } else {

C/exo.c

@@ -52,29 +52,29 @@ HASH(UInt hash0, UInt j, CELL *cl, struct index_t *it)
   Term t = cl[j];
   UInt sz = it->hsize;
   if (IsIntTerm(t))
-    return (IntOfTerm(t) * 17* (hash0+1)*(j+1) ) % sz;
+    return (17*(IntOfTerm(t) + (hash0+1)*j ) ) % sz;
-  return (((UInt)AtomOfTerm(t) >> 5)* 17*(hash0+1)*(j+1) ) % sz;
+  return (17*(((UInt)AtomOfTerm(t)>>5) + (hash0+1)*j ) ) % sz;
-}
-
-/* search for matching elements */
-static int 
-MATCH(CELL *clp, CELL *kvp, UInt j, struct index_t *it)
-{
-  if ((kvp - it->cls)%it->arity != j)
-    return FALSE;
-  do {
-    if ( LOCAL_ibnds[j] && *clp != *kvp)
-      return FALSE;
-    clp--;
-    kvp--;
-  } while (j-- != 0);
-  return TRUE;
 }
 
 static UInt
 NEXT(UInt hash, Term t, UInt j, struct index_t *it)
 {
-  return (hash+(t>>4)+j+1) % (it->hsize);
+  return (hash+(j+1)*997) % (it->hsize);
+}
+
+/* search for matching elements */
+static int 
+MATCH(CELL *clp, CELL *kvp, UInt j, struct index_t *it, UInt bnds[])
+{
+  if ((kvp - it->cls)%it->arity != j)
+    return FALSE;
+  do {
+    if ( bnds[j] && *clp != *kvp)
+      return FALSE;
+    clp--;
+    kvp--;
+  } while (j-- != 0);
+  return TRUE;
 }
 
 static void
@@ -112,14 +112,14 @@ ADD_TO_TRY_CHAIN(CELL *kvp, CELL *cl, struct index_t *it)
  * else
  */
 static void
-INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
+INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0, UInt bnds[])
 {
   UInt j = base;
   CELL *kvp;
   UInt hash;
 
   /* skip over argument */
-  while (!LOCAL_ibnds[j]) {
+  while (!bnds[j]) {
     j++;
   }
   /* j is the firs bound element */
@@ -134,16 +134,16 @@ INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
     it->nentries++;
     it->key[hash] = cl+j;
     return;
-  } else if (MATCH(cl+j, kvp, j, it))  {
+  } else if (MATCH(cl+j, kvp, j, it, bnds))  {
     /* collision */
     UInt k;
     CELL *target;
     
     for (k =j+1, target = kvp+1; k < arity; k++,target++ ) {
-      if (LOCAL_ibnds[k]) {
+      if (bnds[k]) {
 	if (*target != cl[k]) {
 	  /* found a new forking point */
-	  INSERT(cl, it, arity, k, hash0);
+	  INSERT(cl, it, arity, k, hash0, bnds);
 	  return;
 	}
       }
@@ -160,8 +160,9 @@ INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
 }
 
 static yamop *
-LOOKUP(struct index_t *it, UInt arity, UInt j)
+LOOKUP(struct index_t *it, UInt arity, UInt j, UInt bnds[])
 {
+  CACHE_REGS
   CELL *kvp;
   UInt hash, hash0 = 0;
 
@@ -175,13 +176,13 @@ LOOKUP(struct index_t *it, UInt arity, UInt j)
   if (kvp == NULL) {
     /* simple case, no element */
     return FAILCODE;
-  } else if (MATCH(XREGS+(j+1), kvp, j, it))  {
+  } else if (MATCH(XREGS+(j+1), kvp, j, it, bnds))  {
     /* found element */
     UInt k;
     CELL *target;
 
     for (k =j+1, target = kvp+1; k < arity; k++ ) {
-      if (LOCAL_ibnds[k]) {
+      if (bnds[k]) {
 	if (*target != XREGS[k+1]) {
 	  j = k;
 	  goto hash;
@@ -202,14 +203,14 @@ LOOKUP(struct index_t *it, UInt arity, UInt j)
 }
 
 static void
-fill_hash(UInt bmap, struct index_t *it)
+fill_hash(UInt bmap, struct index_t *it, UInt bnds[])
 {
   UInt i;
   UInt arity = it->arity;
   CELL *cl = it->cls;
 
   for (i=0; i < it->nels; i++) {
-    INSERT(cl, it, arity, 0, 0);
+    INSERT(cl, it, arity, 0, 0, bnds);
     cl += arity;
   }
   for (i=0; i < it->hsize; i++) {
@@ -226,7 +227,7 @@ fill_hash(UInt bmap, struct index_t *it)
 }
 
 static struct index_t *
-add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
+add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[])
 {
   UInt ncls = ap->cs.p_code.NOfClauses, j;
   CELL *base = NULL;
@@ -264,16 +265,16 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
     bzero(base, 3*sizeof(CELL)*ncls);
   }
   i->key = (CELL **)base;
-  i->links = (CELL *)(base+2*ncls);
+  i->links = (CELL *)(base+i->hsize);
   i->ncollisions = i->nentries = i->ntrys = 0;
   i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *)); 
   *ip = i;
   if (count) {
-    fill_hash(bmap, i);
+    fill_hash(bmap, i, bnds);
     printf("entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
     if (!i->ntrys) {
       i->is_key = TRUE;
-      if (base != realloc(base, 2*sizeof(CELL)*ncls))
+      if (base != realloc(base, i->hsize*sizeof(CELL)))
 	return FALSE;
     }
   }
@@ -311,7 +312,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
 }
 
 yamop  *
-Yap_ExoLookup(PredEntry *ap) 
+Yap_ExoLookup(PredEntry *ap USES_REGS) 
 {
   UInt arity = ap->ArityOfPE;
   UInt bmap = 0L, bit = 1, count = 0, j, j0 = 0;
@@ -345,10 +346,10 @@ Yap_ExoLookup(PredEntry *ap)
     i = i->next;
   }
   if (!i) {
-    i = add_index(ip, bmap, ap, count);
+    i = add_index(ip, bmap, ap, count, LOCAL_ibnds);
   }
   if (count)
-    return LOOKUP(i, arity, j0);
+    return LOOKUP(i, arity, j0, LOCAL_ibnds);
   else
     return i->code;
 }
@@ -356,6 +357,7 @@ Yap_ExoLookup(PredEntry *ap)
 CELL
 Yap_NextExo(choiceptr cptr, struct index_t *it) 
 {
+  CACHE_REGS
   CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
   CELL next = it->links[offset];
   ((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, next);
@@ -420,8 +422,8 @@ p_exodb_get_space( USES_REGS1 )
   }
   Yap_ClauseSpace += required;
   /* cool, it's our turn to do the conversion */
-  mcl->ClFlags = MegaMask;
+  mcl->ClFlags = MegaMask|ExoMask;
-  mcl->ClSize = required-sizeof(MegaClause);
+  mcl->ClSize = required;
   mcl->ClPred = ap;
   mcl->ClItemSize = arity*sizeof(CELL);
   mcl->ClNext = NULL;
@@ -430,7 +432,7 @@ p_exodb_get_space( USES_REGS1 )
   ap->cs.p_code.FirstClause =
     ap->cs.p_code.LastClause =
     mcl->ClCode;
-  ap->PredFlags |= MegaClausePredFlag;
+  ap->PredFlags |= MegaClausePredFlag|SourcePredFlag;
   ap->cs.p_code.NOfClauses = ncls;
   if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
     ap->OpcodeOfPred = Yap_opcode(_spy_pred);

C/heapgc.c

@@ -2307,6 +2307,10 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
 	mark_ref_in_use((DBRef)rtp->u.OtILl.block PASS_REGS);
 	nargs = rtp->u.OtILl.d->ClPred->ArityOfPE+1;
 	break;
+      case _retry_exo:
+      case _retry_all_exo:
+	nargs = rtp->u.lp.p->ArityOfPE;
+	break;
 #ifdef DEBUG
       case _retry_me:
       case _trust_me:
@@ -3223,6 +3227,10 @@ sweep_choicepoints(choiceptr gc_B USES_REGS)
     case _retry4:
       sweep_b(gc_B, 4 PASS_REGS);
       break;
+    case _retry_exo:
+    case _retry_all_exo:
+      sweep_b(gc_B, rtp->u.lp.p->ArityOfPE PASS_REGS);
+      break;
     case _retry_c:
     case _retry_userc:
       {

C/load_aix.c

@@ -26,9 +26,10 @@
  *   FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
+  return NULL;
 }
 
 

C/load_aout.c

@@ -54,8 +54,8 @@ this code is no being maintained anymore
  *   YAP_FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
   register char  *cp, *cp2;
   struct stat     stbuf;
@@ -94,7 +94,7 @@ Yap_FindExecutable(char *name)
   strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]);
   Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
   if (oktox(GLOBAL_Executable))
-    return;
+    return GLOBAL_Executable;
   else
     Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(GLOBAL_Executable)),
 	  "cannot find file being executed");

C/load_coff.c

@@ -50,8 +50,8 @@ this code is no being maintained anymore
  *   YAP_FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
   register char  *cp, *cp2;
   struct stat     stbuf;
@@ -64,7 +64,7 @@ Yap_FindExecutable(char *name)
     if (oktox(GLOBAL_argv[0])) {
       strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]);
       Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
-      return;
+      return NULL;
     }
   }
   if (*cp == ':')
@@ -84,16 +84,17 @@ Yap_FindExecutable(char *name)
     if (!oktox(LOCAL_FileNameBuf))
       continue;
     Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
-    return;
+    return GLOBAL_Executable;
   }
   /* one last try for dual systems */
   strcpy(LOCAL_FileNameBuf, GLOBAL_argv[0]);
   Yap_TrueFileName(LOCAL_FileNameBuf, GLOBAL_Executable, TRUE);
   if (oktox(GLOBAL_Executable))
-    return;
+    return GLOBAL_Executable;
   else
     Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(GLOBAL_Executable)),
 	  "cannot find file being executed");
+  return NULL;
 }
 
 

C/load_dl.c

@@ -24,6 +24,10 @@
 #include <dlfcn.h>
 #include <string.h>
 #include <stdio.h>
+#if defined(__APPLE__)
+#include <mach-o/dyld.h> 
+#endif 
+ 
 
 typedef void (*prismf)(void);
 
@@ -57,9 +61,29 @@ Yap_CallFunctionByName(const char *thing_string)
  *   YAP_FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
+  if (GLOBAL_argv && GLOBAL_argv[0])
+    return GLOBAL_argv[0];
+#if HAVE_GETEXECNAME
+  return getxecname();
+#elif __APPLE__
+  char path[1024];
+  uint32_t size = sizeof(path);
+  if (!_NSGetExecutablePath(path, &size)) {
+    size_t sz = strlen(path);
+    char *rc = malloc(sz+1);
+    strncpy(rc, path, sz);
+    return rc;
+  } else {
+    char *rc = malloc(size+1);
+    if (_NSGetExecutablePath(rc, &size) == 0)
+      return "yap";
+    return rc;
+  }
+#endif
+  return "yap";
 }
 
 void *
@@ -200,7 +224,7 @@ Yap_ShutdownLoadForeign(void)
       if (dlclose(objs->handle) != 0)
       	return; /* ERROR */
       objs = objs->next;
-      Yap_FreeCodeSpace(old);
+      Yap_FreeCodeSpace((ADDR)old);
     }
     libs = f_code->libs;
     while (libs != NULL) {
@@ -208,7 +232,7 @@ Yap_ShutdownLoadForeign(void)
       if (dlclose(libs->handle) != 0)
 	return; /* ERROR */
       libs = libs->next;
-      Yap_FreeCodeSpace(old);
+      Yap_FreeCodeSpace((ADDR)old);
     }
     f_code = f_code->next;
     Yap_FreeCodeSpace((ADDR)of_code);

C/load_dld.c

@@ -26,15 +26,15 @@ this code is no being maintained anymore
  *   YAP_FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
   /* use dld_find_executable */
   char *res;
   if(name != NULL && (res=dld_find_executable(name))) {
-    strcpy(GLOBAL_Executable,res);
+    return GLOBAL_Executable;
   } else {
-    strcpy(GLOBAL_Executable,"./yap");
+    return "yap";
   }
 }
 

C/load_dll.c

@@ -30,6 +30,7 @@
 void
 Yap_FindExecutable(char *name)
 {
+  return NULL;
 }
 
 void *

C/load_dyld.c

@@ -65,6 +65,18 @@ mydlerror(void)
 void
 Yap_FindExecutable(char *name)
 {
+  char path[1024];
+  uint32_t size = sizeof(path);
+  if (_NSGetExecutablePath(path, &size) == 0) {
+    char *rc = malloc(size+1);
+    strncpy(rc, path, size);
+    return rc;
+  } else {
+    char *rc = malloc(size+1);
+    if (_NSGetExecutablePath(rc, &size) == 0)
+      return "yap";
+    return rc;
+  }
 }
 
 

C/load_foreign.c

@@ -225,10 +225,6 @@ p_open_shared_objects( USES_REGS1 ) {
 void
 Yap_InitLoadForeign( void )
 {
-  if (GLOBAL_argv == NULL)
-    Yap_FindExecutable("yap");
-  else
-    Yap_FindExecutable(GLOBAL_argv[0]);
   Yap_InitCPred("$load_foreign_files", 3, p_load_foreign, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$open_shared_objects", 0, p_open_shared_objects, SafePredFlag);
   Yap_InitCPred("$open_shared_object", 3, p_open_shared_object, SyncPredFlag);

C/load_none.c

@@ -26,9 +26,10 @@
  *   YAP_FindExecutable(argv[0]) should be called on yap initialization to
  *   locate the executable of Yap
 */
-void
+char *
-Yap_FindExecutable(char *name)
+Yap_FindExecutable(void)
 {
+  return NULL;
 }
 
 

C/load_shl.c

@@ -16,7 +16,7 @@
  *   locate the executable of Yap
 */
 
-void Yap_FindExecutable(char *name)
+char * Yap_FindExecutable(void)
 {
 }
 

C/qlyr.c

@@ -849,6 +849,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
   } else if (pp->PredFlags & MegaClausePredFlag) {
     CACHE_REGS
     char *base = (void *)read_uint(stream);
+    UInt mask = read_uint(stream);
     UInt size = read_uint(stream);
     MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);
 
@@ -857,12 +858,20 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
     }
     LOCAL_HDiff = (char *)cl-base;
     read_bytes(stream, cl, size);
+    cl->ClFlags = mask;
     pp->cs.p_code.FirstClause =
       pp->cs.p_code.LastClause =
       cl->ClCode;
     pp->PredFlags |= MegaClausePredFlag;
     /* enter index mode */
-    pp->OpcodeOfPred = INDEX_OPCODE;
+    if (mask & ExoMask) { 
+      struct index_t **icl = (struct index_t **)(cl->ClCode); 
+      pp->OpcodeOfPred = Yap_opcode(_enter_exo);
+      icl[0] = NULL;
+      icl[1] = NULL;
+    } else {
+      pp->OpcodeOfPred = INDEX_OPCODE;
+    }
     pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred)); 
     /* This must be set for restoremegaclause */
     pp->cs.p_code.NOfClauses = nclauses;

C/qlyw.c

@@ -649,6 +649,7 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
     UInt size = cl->ClSize;
 
     CHECK(save_uint(stream, (UInt)cl));
+    CHECK(save_uint(stream, (UInt)(cl->ClFlags)));
     CHECK(save_uint(stream, size));
     CHECK(save_bytes(stream, cl, size));
   } else if (pp->PredFlags & DynamicPredFlag) {

C/stdpreds.c

@@ -4007,8 +4007,11 @@ p_argv( USES_REGS1 )
 static Int 
 p_executable( USES_REGS1 )
 {
-  
+  if (GLOBAL_argv && GLOBAL_argv[0])
-  Yap_TrueFileName (GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE);
+    Yap_TrueFileName (GLOBAL_argv[0], LOCAL_FileNameBuf, FALSE);
+  else
+    strncpy(LOCAL_FileNameBuf,Yap_FindExecutable (), YAP_FILENAME_MAX) ;
+
   return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)),ARG1);
 }
 

H/Foreign.h

@@ -105,7 +105,7 @@ typedef void (*YapInitProc)(void);
 #define STD_PROTO(F,A)  F A
 #endif
 
-void    STD_PROTO(Yap_FindExecutable,(char *));
+char   *STD_PROTO(Yap_FindExecutable,(void));
 void   *STD_PROTO(Yap_LoadForeignFile,(char *, int));
 int     STD_PROTO(Yap_CallForeignFile,(void *, char *));
 int     STD_PROTO(Yap_CloseForeignFile,(void *));

H/clause.h

@@ -263,7 +263,7 @@ LogUpdClause  *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
 LogUpdClause  *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *, Term *, yamop *,yamop *));
 
 /* exo.c */
-yamop    *Yap_ExoLookup(PredEntry *ap);
+yamop    *Yap_ExoLookup(PredEntry *ap USES_REGS);
 CELL    Yap_NextExo(choiceptr cpt, struct index_t *it);
 
 #if USE_THREADED_CODE

H/iatoms.h

@@ -99,6 +99,7 @@
   AtomExecuteWoMod = Yap_FullLookupAtom("$execute_wo_mod");
   AtomExist = Yap_LookupAtom("exist");
   AtomExistenceError = Yap_LookupAtom("existence_error");
+  AtomExoClause = Yap_FullLookupAtom("$exo_clause");
   AtomExpectedNumber = Yap_LookupAtom("expected_number_syntax");
   AtomExtendFileSearchPath = Yap_FullLookupAtom("$extend_file_search_path");
   AtomFB = Yap_LookupAtom("fb");
@@ -374,6 +375,7 @@
   FunctorExecuteInMod = Yap_MkFunctor(AtomExecuteInMod,2);
   FunctorExecuteWithin = Yap_MkFunctor(AtomExecuteWithin,1);
   FunctorExistenceError = Yap_MkFunctor(AtomExistenceError,2);
+  FunctorExoClause = Yap_MkFunctor(AtomExoClause,2);
   FunctorFunctor = Yap_MkFunctor(AtomFunctor,3);
   FunctorGAtom = Yap_MkFunctor(AtomAtom,1);
   FunctorGAtomic = Yap_MkFunctor(AtomAtomic,1);

H/ratoms.h

@@ -99,6 +99,7 @@
   AtomExecuteWoMod = AtomAdjust(AtomExecuteWoMod);
   AtomExist = AtomAdjust(AtomExist);
   AtomExistenceError = AtomAdjust(AtomExistenceError);
+  AtomExoClause = AtomAdjust(AtomExoClause);
   AtomExpectedNumber = AtomAdjust(AtomExpectedNumber);
   AtomExtendFileSearchPath = AtomAdjust(AtomExtendFileSearchPath);
   AtomFB = AtomAdjust(AtomFB);
@@ -374,6 +375,7 @@
   FunctorExecuteInMod = FuncAdjust(FunctorExecuteInMod);
   FunctorExecuteWithin = FuncAdjust(FunctorExecuteWithin);
   FunctorExistenceError = FuncAdjust(FunctorExistenceError);
+  FunctorExoClause = FuncAdjust(FunctorExoClause);
   FunctorFunctor = FuncAdjust(FunctorFunctor);
   FunctorGAtom = FuncAdjust(FunctorGAtom);
   FunctorGAtomic = FuncAdjust(FunctorGAtomic);

H/rheap.h

@@ -588,10 +588,21 @@ RestoreMegaClause(MegaClause *cl USES_REGS)
   }
   max = (yamop *)((CODEADDR)cl+cl->ClSize);
 
-  for (ptr = cl->ClCode; ptr < max; ) {
+  if (cl->ClFlags & ExoMask) {
-    nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
+    CELL *base = (CELL *)((ADDR)cl->ClCode+2*sizeof(struct index_t *));
-    restore_opcodes(ptr, nextptr PASS_REGS);
+    CELL *end = (CELL*)max, *ptr;
-    ptr = nextptr;
+
+    for (ptr = base; ptr < end; ptr++) {
+      Term t = *ptr;
+      if (IsAtomTerm(t)) *ptr = AtomTermAdjust(t);
+      /* don't handle other complex terms just yet, ints are ok  */
+    }
+  } else {
+    for (ptr = cl->ClCode; ptr < max; ) {
+      nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
+      restore_opcodes(ptr, nextptr PASS_REGS);
+      ptr = nextptr;
+    }
   }
 }
 

H/tatoms.h

@@ -196,6 +196,8 @@
 #define AtomExist Yap_heap_regs->AtomExist_
   Atom AtomExistenceError_;
 #define AtomExistenceError Yap_heap_regs->AtomExistenceError_
+  Atom AtomExoClause_;
+#define AtomExoClause Yap_heap_regs->AtomExoClause_
   Atom AtomExpectedNumber_;
 #define AtomExpectedNumber Yap_heap_regs->AtomExpectedNumber_
   Atom AtomExtendFileSearchPath_;
@@ -746,6 +748,8 @@
 #define FunctorExecuteWithin Yap_heap_regs->FunctorExecuteWithin_
   Functor FunctorExistenceError_;
 #define FunctorExistenceError Yap_heap_regs->FunctorExistenceError_
+  Functor FunctorExoClause_;
+#define FunctorExoClause Yap_heap_regs->FunctorExoClause_
   Functor FunctorFunctor_;
 #define FunctorFunctor Yap_heap_regs->FunctorFunctor_
   Functor FunctorGAtom_;

config.h.in

@@ -186,6 +186,7 @@
 #undef  HAVE_FTIME
 #undef  HAVE_GETCWD
 #undef  HAVE_GETENV
+#undef  HAVE_GETEXECNAME
 #undef  HAVE_GETHOSTBYNAME
 #undef  HAVE_GETHOSTENT
 #undef  HAVE_GETHOSTID

configure

@@ -10250,6 +10250,17 @@ _ACEOF
 fi
 done
 
+for ac_func in getexecname
+do :
+  ac_fn_c_check_func "$LINENO" "getexecname" "ac_cv_func_getexecname"
+if test "x$ac_cv_func_getexecname" = xyes; then :
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_GETEXECNAME 1
+_ACEOF
+
+fi
+done
+
 for ac_func in gethostbyname gethostent gethostid gethostname
 do :
   as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`

configure.in

@@ -2069,6 +2069,7 @@ AC_CHECK_FUNCS(alloca asinh atanh chdir clock clock_gettime)
 AC_CHECK_FUNCS(ctime dlopen dup2)
 AC_CHECK_FUNCS(erf feclearexcept)
 AC_CHECK_FUNCS(fesettrapenable fgetpos finite fpclass ftime getcwd getenv)
+AC_CHECK_FUNCS(getexecname)
 AC_CHECK_FUNCS(gethostbyname gethostent gethostid gethostname)
 AC_CHECK_FUNCS(gethrtime getpagesize)
 AC_CHECK_FUNCS(getpwnam getrlimit getrusage gettimeofday getwd)

include/YapInterface.h

@@ -263,10 +263,10 @@ extern X_API void PROTO(YAP_cut_up,(void));
 #define YAP_cut_fail() do { YAP_cut_up(); return FALSE; } while(0)
 
 /*  void *AllocSpaceFromYAP_(int) */
-extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int));
+extern X_API void *PROTO(YAP_AllocSpaceFromYap,(size_t));
 
 /*  void *ReallocSpaceFromYAP_(void*,int) */
-extern X_API void *PROTO(YAP_ReallocSpaceFromYap,(void*,unsigned int));
+extern X_API void *PROTO(YAP_ReallocSpaceFromYap,(void*,size_t));
 
 /*  void FreeSpaceFromYAP_(void *) */
 extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *));

misc/ATOMS

@@ -104,6 +104,7 @@ A	ExecuteWithin		F	"$execute_within"
 A	ExecuteWoMod		F	"$execute_wo_mod"
 A	Exist			N	"exist"
 A	ExistenceError		N	"existence_error"
+A	ExoClause		F	"$exo_clause"
 A	ExpectedNumber		N	"expected_number_syntax"
 A	ExtendFileSearchPath	F	"$extend_file_search_path"
 A	FB			N	"fb"
@@ -379,6 +380,7 @@ F	Execute2InMod		ExecuteWoMod	2
 F	ExecuteInMod		ExecuteInMod	2
 F	ExecuteWithin		ExecuteWithin	1
 F	ExistenceError		ExistenceError	2
+F	ExoClause		ExoClause	2
 F	Functor			Functor		3
 F	GAtom			Atom		1
 F	GAtomic			Atomic		1

packages/pldoc

@@ -1 +1 @@
-Subproject commit fa667ecacf4128c10dc51215ff54f25672a782c8
+Subproject commit 9beecb39041e1faf95e5d2af257e7be8cdda467c

packages/zlib

@@ -1 +1 @@
-Subproject commit 980a0b9950ca0b52b327234fd2f66e0790f9c4e1
+Subproject commit b98ea2bb69599c44bdda52c7f1d3e6e3152b97aa

pl/preds.yap

@@ -281,12 +281,19 @@ clause(V,Q,R) :-
 	( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
 '$clause'(V,M,Q,R) :- var(V), !, 
 	'$do_error'(instantiation_error,clause(M:V,Q,R)).
-'$clause'(C,M,Q,R) :- number(C), !,
+'$clause'(C,M,Q,R) :- 
+	number(C), !,
 	'$do_error'(type_error(callable,C),clause(M:C,Q,R)).
-'$clause'(R,M,Q,R) :- db_reference(R), !,
+'$clause'(C,M,Q,R) :-
-	'$do_error'(type_error(callable,R),clause(M:R,Q,R)).
+	db_reference(C), !,
+	'$do_error'(type_error(callable,C),clause(M:R,Q,R)).
 '$clause'(M:P,_,Q,R) :- !,
 	'$clause'(P,M,Q,R).
+'$clause'(P,M,Q,R) :-
+	'$is_exo'(P, M), !,
+	Q = true,
+	R = '$exo_clause'(M,P),
+	'$execute0'(P, M).
 '$clause'(P,M,Q,R) :-
 	'$is_source'(P, M), !,
 	'$static_clause'(P,M,Q,R).