Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

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);
 }
 
@@ -3003,6 +3006,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)	 */
@@ -5769,6 +5793,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 +6008,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 +6067,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

@@ -422,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;
@@ -432,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/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 */
+    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) {

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,12 +588,23 @@ RestoreMegaClause(MegaClause *cl USES_REGS)
   }
   max = (yamop *)((CODEADDR)cl+cl->ClSize);
 
+  if (cl->ClFlags & ExoMask) {
+    CELL *base = (CELL *)((ADDR)cl->ClCode+2*sizeof(struct index_t *));
+    CELL *end = (CELL*)max, *ptr;
+
+    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;
     }
   }
+}
 
 /* Restores a prolog clause, in its compiled form */
 static void 

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_;

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

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).