Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

C/absmi.c

@@ -8059,6 +8059,7 @@ Yap_absmi(int inp)
 	  UNLOCK(pe->StatisticsForPred.lock);
 	  ReductionsCounter--;
 	  if (ReductionsCounter == 0 && ReductionsCounterOn) {
+	    UNLOCK(pe->PELock);
 	    saveregs();
 	    Yap_Error(CALL_COUNTER_UNDERFLOW,TermNil,"");
 	    setregs();
@@ -8066,6 +8067,7 @@ Yap_absmi(int inp)
 	  } 
 	  PredEntriesCounter--;
 	  if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
+	    UNLOCK(pe->PELock);
 	    saveregs();
 	    Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
 	    setregs();
@@ -8074,6 +8076,7 @@ Yap_absmi(int inp)
 	  if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) == 
 	    CountPredFlag) {
 	    PREG = pe->cs.p_code.TrueCodeOfPred;
+	    UNLOCK(pe->PELock);
 	    JMPNext();
 	  }
 	}
@@ -8084,6 +8087,7 @@ Yap_absmi(int inp)
 	  UNLOCK(pe->StatisticsForPred.lock);
 	  if (!(pe->PredFlags & SpiedPredFlag)) {
 	    PREG = pe->cs.p_code.TrueCodeOfPred;
+	    UNLOCK(pe->PELock);
 	    JMPNext();
 	  }
 	}

C/alloc.c

@@ -873,12 +873,18 @@ InitWorkSpace(Int s)
     return(NULL);
   }
 #elif defined(__APPLE__)
+#ifdef MMAP_ADDR
   a = mmap(((void *)MMAP_ADDR), (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
 	   MAP_PRIVATE | MAP_ANON | MAP_FIXED, -1, 0);
   if (a != (MALLOC_T)MMAP_ADDR) {
     Yap_Error(FATAL_ERROR, TermNil, "mmap could not map ANON at %p, got %p", (void *)MMAP_ADDR,a );
     return(NULL);
   }
+#else
+  a = mmap(NULL, (size_t) s, PROT_READ | PROT_WRITE | PROT_EXEC,
+	   MAP_PRIVATE | MAP_ANON, -1, 0);
+  fprintf(stderr,"a=%p\n",a);
+#endif
 #else
   fd = open("/dev/zero", O_RDWR, S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH);
   if (fd < 0) {

C/index.c

@@ -6904,6 +6904,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
 	ipc = ipc->u.ollll.l1;
 	S = s_reg = RepPair(t);
       } else if (t == TermNil) {
+	unbounded = FALSE;
 	jlbl = &(ipc->u.ollll.l2);
 	ipc = ipc->u.ollll.l2;
       } else {

C/save.c

@@ -473,6 +473,9 @@ save_code_info(void)
 static void
 save_heap(void)
 {
+#ifdef USE_SYSTEM_MALLOC
+  return;
+#endif
   int j;
   /* Then save the whole heap */
 #if defined(YAPOR) || (defined(TABLING) && !defined(YAP_MEMORY_ALLOC_SCHEME))

C/utilpreds.c

@@ -1547,15 +1547,11 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end)
   return -1;
 }
  
-static Int 
+int Yap_IsGroundTerm(Term t)
-p_ground(void)			/* ground(+T)		 */
 {
-  Term t;
-
   while (TRUE) {
     Int out;
 
-    t = Deref(ARG1);
     if (IsVarTerm(t)) {
       return FALSE;
     }  else if (IsPrimitiveTerm(t)) {
@@ -1585,6 +1581,12 @@ p_ground(void)			/* ground(+T)		 */
   }
 }
 
+static Int 
+p_ground(void)			/* ground(+T)		 */
+{
+  return Yap_IsGroundTerm(Deref(ARG1));
+}
+
 static int
 SizeOfExtension(Term t)
 {

H/Yap.h

@@ -330,15 +330,16 @@ typedef CELL Term;
 
 #if !defined(YAPOR) && !defined(THREADS)
 #include <nolocks.h>
-#elif USE_PTHREAD_LOCKING
+#elif USE_PTHREAD_LOCKING || defined(__APPLE__) || defined(__CYGWIN__)
 
 #ifndef _XOPEN_SOURCE
 #define _XOPEN_SOURCE 600
 #endif
 
+#include <pthread_locks.h>
 typedef pthread_mutex_t lockvar;
 typedef pthread_rwlock_t rwlock_t;
-#include <pthread_locks.h>
+
 #elif defined(i386) || defined(__x86_64__)
 typedef volatile int lockvar;
 #include <x86_locks.h>

H/Yapproto.h

@@ -368,6 +368,7 @@ Term	STD_PROTO(Yap_CopyTerm,(Term));
 int	STD_PROTO(Yap_IsListTerm,(Term));
 Term	STD_PROTO(Yap_CopyTermNoShare,(Term));
 int	STD_PROTO(Yap_SizeGroundTerm,(Term, int));
+int	STD_PROTO(Yap_IsGroundTerm,(Term));
 void	STD_PROTO(Yap_InitUtilCPreds,(void));
 
 /* yap.c */

OPTYap/or.macros.h

@@ -81,8 +81,8 @@ STD_PROTO(static inline qg_sol_fr_ptr CUT_prune_solution_frames, (qg_sol_fr_ptr,
 #define YAMOP_CUT(INST)            (((INST)->u.Otapl.or_arg) & YAMOP_CUT_FLAG)
 #define YAMOP_FLAGS(INST)          (((INST)->u.Otapl.or_arg) & YAMOP_FLAGS_BITS)
 
-#define INIT_YAMOP_LTT(INST, LTT)  (INST)->u.Otapl.or_arg = LTT
+#define INIT_YAMOP_LTT(INST, LTT)  ((INST)->u.Otapl.or_arg = LTT+1)
-#define PUT_YAMOP_LTT(INST, LTT)   (INST)->u.Otapl.or_arg = YAMOP_FLAGS(INST) | (LTT)
+#define PUT_YAMOP_LTT(INST, LTT)   (INST)->u.Otapl.or_arg = YAMOP_FLAGS(INST) | (LTT+1)
 #define PUT_YAMOP_SEQ(INST)        (INST)->u.Otapl.or_arg |= YAMOP_SEQ_FLAG
 #define PUT_YAMOP_CUT(INST)        (INST)->u.Otapl.or_arg |= YAMOP_CUT_FLAG
 

OPTYap/pthread_locks.h

@@ -15,6 +15,8 @@
 *									 *
 *************************************************************************/
 
+#include <pthread.h>
+
 /* ----------------------------------- **
 **      Atomic locks for PTHREADS      **
 ** ----------------------------------- */

configure.in

@@ -1037,7 +1037,7 @@ then
   *darwin*)
     DYNYAPLIB=libYap"$SHLIB_SUFFIX"
     YAPLIB="$DYNYAPLIB"
-    DYNLIB_LD="$CC -dynamiclib"
+    DYNLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.dylib"
     PRE_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$(abs_top_builddir)"
     EXTEND_DYNLOADER_PATH="DYLD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPBOOTDIR=\$(DESTDIR)\$(SHAREDIR)/pl  YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
 #    CROSS_SIMULATOR="DYLD_LIBRARY_PATH=."
@@ -1056,7 +1056,7 @@ then
        esac
     EXTEND_DYNLOADER_PATH="LD_LIBRARY_PATH=\$(DESTDIR)\$(LIBDIR): YAPSHAREDIR=\$(DESTDIR)\$(SHAREDIR) YAPBOOTDIR=\$(DESTDIR)\$(SHAREDIR)/pl YAPLIBDIR=\$(DESTDIR)\$(YAPLIBDIR)"
     PRE_DYNLOADER_PATH="LD_LIBRARY_PATH=\$(abs_top_builddir)"
-    LDFLAGS="$LDFLAGS -Wl,-R,$prefix/lib  -Wl,-R,$JAVA_HOME/jre/lib/$JAVA_TARGET"
+    LDFLAGS="$LDFLAGS -Wl,-install-name,$prefix/lib  -Wl,-R,$JAVA_HOME/jre/lib/$JAVA_TARGET"
     DYNYAPLIB=libYap"$SHLIB_SUFFIX"
     YAPLIB="$DYNYAPLIB"
     DYNLIB_LD="$SHLIB_LD"

include/SWI-Prolog.h

@@ -368,6 +368,7 @@ extern X_API  int PL_compare(term_t, term_t);
 /* begin PL_unify_* functions =============================*/
 extern X_API  int PL_unify(term_t, term_t);
 extern X_API  int PL_unify_atom(term_t, atom_t);
+extern X_API  int PL_unify_arg(int, term_t, atom_t);
 extern X_API  int PL_unify_atom_chars(term_t, const char *);
 extern X_API  int PL_unify_atom_nchars(term_t, size_t len, const char *);
 extern X_API  int PL_unify_float(term_t, double);
@@ -391,6 +392,7 @@ extern X_API  int PL_is_atomic(term_t);
 extern X_API  int PL_is_compound(term_t);
 extern X_API  int PL_is_float(term_t);
 extern X_API  int PL_is_functor(term_t, functor_t);
+extern X_API  int PL_is_ground(term_t);
 extern X_API  int PL_is_integer(term_t);
 extern X_API  int PL_is_list(term_t);
 extern X_API  int PL_is_number(term_t);
@@ -420,6 +422,7 @@ extern X_API int PL_toplevel(void);
 extern X_API term_t PL_exception(qid_t);
 extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
 extern X_API int PL_call(term_t, module_t);
+extern X_API void PL_register_foreign(const char *, int, foreign_t (*)(void), int);
 extern X_API void PL_register_foreign_in_module(const char *, const char *, int, foreign_t (*)(void), int);
 extern X_API void PL_register_extensions(const PL_extension *);
 extern X_API void PL_load_extensions(const PL_extension *);
@@ -441,8 +444,6 @@ extern X_API void *PL_realloc(void*,int);
 extern X_API void PL_free(void *);
 extern X_API int  PL_eval_expression_to_int64_ex(term_t t, int64_t *val);
 
-#define PL_register_foreign(name, arity, function, flags) PL_register_foreign_in_module(NULL, (name), (arity), (function), (flags))
-
 extern X_API int Sprintf(const char * fm,...);
 extern X_API int Sdprintf(const char *,...);
 

library/yap2swi/yap2swi.c

@@ -1327,9 +1327,36 @@ X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
   } else if (!IsPairTerm(t)) {
     return FALSE;
   }
-  Yap_PutInSlot(h,HeadOfTerm(t));
+  return 
-  Yap_PutInSlot(tail,TailOfTerm(t));
+    Yap_unify(Yap_GetFromSlot(h),HeadOfTerm(t)) &&
-  return TRUE;
+    Yap_unify(Yap_GetFromSlot(tail),TailOfTerm(t));
+}
+
+/* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
+   YAP long int  unify(YAP_Term* a, Term* b) */
+X_API int PL_unify_arg(int index, term_t tt, term_t arg)
+{
+  Term t = Deref(Yap_GetFromSlot(tt)), to;
+  if (index < 0)
+    return FALSE;
+  if (IsVarTerm(t) || IsAtomOrIntTerm(t)) {
+    return FALSE;
+  } else if (IsPairTerm(t)) {
+    if (index == 1)
+      to = HeadOfTerm(t);
+    else if (index == 2)
+      to = TailOfTerm(t);
+    else
+      return FALSE;
+  } else {
+    Functor f = FunctorOfTerm(t);
+    if (IsExtensionFunctor(f)) 
+      return FALSE;
+    if (index > ArityOfFunctor(f))
+      return FALSE;
+    to = ArgOfTerm(index, t);
+  }
+  return Yap_unify(Yap_GetFromSlot(t),to);
 }
 
 /* SWI: int PL_unify_list(term_t ?t, term_t +h, term_t -t)
@@ -1706,6 +1733,11 @@ X_API int PL_is_atom(term_t t)
   return IsAtomTerm(Yap_GetFromSlot(t));
 }
 
+X_API int PL_is_ground(term_t t)
+{
+  return Yap_IsGroundTerm(Yap_GetFromSlot(t));
+}
+
 X_API int PL_is_atomic(term_t ts)
 {
   YAP_Term t = Yap_GetFromSlot(ts);
@@ -2110,6 +2142,11 @@ X_API void PL_register_extensions(const PL_extension *ptr)
   PL_load_extensions(ptr);
 }
 
+X_API void PL_register_foreign(const char *name, int arity, foreign_t (*function)(void), int flags)
+{
+  PL_register_foreign_in_module(NULL, name, arity, function, flags);
+}
+
 X_API void PL_load_extensions(const PL_extension *ptr)
 {
   /* ignore flags for now */

pl/boot.yap

@@ -390,7 +390,9 @@ true :- true.
  % but YAP and SICStus does.
  %
  '$process_directive'(G, _, M) :-
-	 ( '$notrace'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
+	 '$exit_system_mode',
+	 ( '$notrace'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ),
+	 '$enter_system_mode'.
 
  '$continue_with_command'(reconsult,V,Pos,G,Source) :-
 	 '$go_compile_clause'(G,V,Pos,5,Source),

pl/debug.yap

@@ -123,21 +123,21 @@
 	recorded('$spy','$spy'(G,M),_), !.
 
 spy Spec :-
-	prolog:debug_action_hook(spy(Spec)), !.
+	'$notrace'(prolog:debug_action_hook(spy(Spec))), !.
 spy L :-
 	'$current_module'(M),
 	'$suspy'(L, spy, M), fail.
 spy _ :- debug.
 
 nospy Spec :-
-	prolog:debug_action_hook(nospy(Spec)), !.
+	'$notrace'(prolog:debug_action_hook(nospy(Spec))), !.
 nospy L :-
 	'$current_module'(M),
 	'$suspy'(L, nospy, M), fail.
 nospy _.
 
 nospyall :-
-	prolog:debug_action_hook(nospyall), !.
+	'$notrace'(prolog:debug_action_hook(nospyall)), !.
 nospyall :-
 	recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
 nospyall.
@@ -333,7 +333,7 @@ debugging :-
 	L1 is L+1,			/* bump it			*/
 	nb_setval('$spy_gn',L1),	/* and save it globaly		*/
         b_getval('$spy_glist',History),	/* get goal list		*/
-	b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det)|History]),	/* and update it		*/
+	b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]),	/* and update it		*/
 	'$loop_spy'(L, G, Module, CalledFromDebugger).	/* set creep on		*/
 
 % we are skipping, so we can just call the goal,
@@ -393,7 +393,8 @@ debugging :-
 	   ;
 	     G = G0
 	   ),
-	   b_getval('$spy_glist',[info(_,_,_,Retry,Det)|_]),	/* get goal list		*/
+	   b_getval('$spy_glist',[Info|_]),	/* get goal list		*/
+	   Info = info(_,_,_,Retry,Det,false),
 	   (
 	    /* call port */
 	    '$enter_goal'(GoalNumber, G, Module),
@@ -408,6 +409,8 @@ debugging :-
 	/* go execute the predicate	*/
 	    (
 	      Retry = false ->
+	       /* found an answer, so it can redo */
+	       nb_setarg(6, Info, true),
 	      '$show_trace'(exit,G,Module,GoalNumber,Det),	/* output message at exit	*/
 	       /* exit port */
 	       /* get rid of deterministic computations */
@@ -424,8 +427,15 @@ debugging :-
 	        /* we get here when we want to redo a goal		*/
 		/* redo port */
 	     '$disable_docreep',
-	     '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error		*/
+	      (
-	    '$continue_debugging'(CalledFromDebugger),
+	       arg(6, Info, true)
+	      ->
+	        '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error		*/
+	        nb_setarg(6, Info, false)
+	       ;
+	         true
+	      ),
+	     '$continue_debugging'(CalledFromDebugger),
 	     fail			/* to backtrack to spycalls	*/
 	     )
 	  ;
@@ -743,7 +753,7 @@ debugging :-
 
 '$show_ancestors'([],_).
 '$show_ancestors'([_|_],0) :- !.
-'$show_ancestors'([info(L,M,G,Retry,Det)|History],HowMany) :-
+'$show_ancestors'([info(L,M,G,Retry,Det,_Exited)|History],HowMany) :-
 	'$show_ancestor'(L,M,G,Retry,Det,HowMany,HowMany1),
 	'$show_ancestors'(History,HowMany1).