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

C/absmi.c

@@ -6279,8 +6279,8 @@ Yap_absmi(int inp)
 #endif
 	XREG(PREVOP(PREG,yyxx)->u.yyxx.x2) = d1;
       ENDD(d1);
+      ALWAYS_GONext();
       ALWAYS_END_PREFETCH();
-      GONext();
       ENDOp();
 
       Op(put_unsafe, yx);
@@ -6607,8 +6607,8 @@ Yap_absmi(int inp)
       H += 2;
       ENDCACHE_S();
       ENDD(d0);
+      ALWAYS_GONext();
       ALWAYS_END_PREFETCH();
-      GONext();
       ENDOp();
 
       Op(write_struct, fa);

C/c_interface.c

@@ -543,6 +543,7 @@ X_API void    *STD_PROTO(YAP_ExternalDataInStackFromTerm,(Term));
 X_API int      STD_PROTO(YAP_NewOpaqueType,(void *));
 X_API Term     STD_PROTO(YAP_NewOpaqueObject,(int, size_t));
 X_API void    *STD_PROTO(YAP_OpaqueObjectFromTerm,(Term));
+X_API int      STD_PROTO(YAP_Argv,(char *** argvp));
 
 static int
 dogc( USES_REGS1 )
@@ -1942,6 +1943,7 @@ YAP_ReadBuffer(char *s, Term *tp)
   Term t; 
   BACKUP_H();
 
+  LOCAL_ErrorMessage=NULL;
   while ((t = Yap_StringToTerm(s,tp)) == 0L) {
     if (LOCAL_ErrorMessage) {
       if (!strcmp(LOCAL_ErrorMessage,"Stack Overflow")) {
@@ -2839,7 +2841,6 @@ YAP_Init(YAP_init_args *yap_init)
   Yap_InitPageSize();  /* init memory page size, required by later functions */
 #if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
   Yap_init_yapor_global_local_memory();
-  LOCAL = REMOTE(0);
 #endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
   GLOBAL_PrologShouldHandleInterrupts = yap_init->PrologShouldHandleInterrupts;
   Yap_InitSysbits();  /* init signal handling and time, required by later functions */
@@ -3716,7 +3717,8 @@ int YAP_MaxOpPriority(Atom at, Term module)
   return ret;
 }
 
-int YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio)
+int
+YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio)
 {
   AtomEntry      *ae = RepAtom(at);
   OpEntry        *info;
@@ -3780,4 +3782,11 @@ int YAP_OpInfo(Atom at, Term module, int opkind, int *yap_type, int *prio)
 }
 
 
-
+int
+YAP_Argv(char ***argvp)
+{
+  if (argvp) {
+    *argvp = GLOBAL_argv;
+  }
+  return GLOBAL_argc;
+}

C/errors.c

@@ -370,6 +370,7 @@ Yap_bug_location(yamop *pc)
   CACHE_REGS
   detect_bug_location(pc, FIND_PRED_FROM_ANYWHERE, (char *)H, 256);
   fprintf(stderr,"%s\n",(char *)H);
+  dump_stack( PASS_REGS1 );
 }
 
 #endif

C/init.c

@@ -1264,6 +1264,9 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
   Yap_regp = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
   LOCAL = REMOTE(0);
 #endif /* THREADS */
+#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA)
+  LOCAL = REMOTE(0);
+#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA */
   if (Heap < MinHeapSpace)
     Heap = MinHeapSpace;
   Heap = AdjustPageSize(Heap * K);

C/qlyr.c

@@ -60,7 +60,7 @@ Yap_AlwaysAllocCodeSpace(UInt size)
 }
 
 static void
-ERROR(qlfr_err_t my_err)
+QLYR_ERROR(qlfr_err_t my_err)
 {
   fprintf(stderr,"Error %d\n", my_err);
   exit(1);
@@ -80,7 +80,7 @@ LookupAtom(Atom oat)
     }
     a = a->next;
   }
-  ERROR(UNKNOWN_ATOM);
+  QLYR_ERROR(UNKNOWN_ATOM);
   return NIL;
 }
 
@@ -122,7 +122,7 @@ LookupFunctor(Functor ofun)
     }
     f = f->next;
   }
-  ERROR(UNKNOWN_FUNCTOR);
+  QLYR_ERROR(UNKNOWN_FUNCTOR);
   return NIL;
 }
 
@@ -164,7 +164,7 @@ LookupPredEntry(PredEntry *op)
     }
     p = p->next;
   }
-  ERROR(UNKNOWN_PRED_ENTRY);
+  QLYR_ERROR(UNKNOWN_PRED_ENTRY);
   return NIL;
 }
 
@@ -206,7 +206,7 @@ LookupOPCODE(OPCODE op)
     }
     f = f->next;
   }
-  ERROR(UNKNOWN_OPCODE);
+  QLYR_ERROR(UNKNOWN_OPCODE);
   return NIL;
 }
 
@@ -224,7 +224,7 @@ OpcodeID(OPCODE op)
     }
     f = f->next;
   }
-  ERROR(UNKNOWN_OPCODE);
+  QLYR_ERROR(UNKNOWN_OPCODE);
   return NIL;
 }
 
@@ -267,7 +267,7 @@ LookupDBRef(DBRef dbr)
     }
     p = p->next;
   }
-  ERROR(UNKNOWN_DBREF);
+  QLYR_ERROR(UNKNOWN_DBREF);
   return NIL;
 }
 
@@ -702,29 +702,29 @@ ReadHash(IOSTREAM *stream)
       UInt len;
 
       len = read_uint(stream);
-      if (!EnoughTempSpace(len)) ERROR(OUT_OF_TEMP_SPACE);
+      if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE);
       read_bytes(stream, rep, (len+1)*sizeof(wchar_t));
       while (!(at = Yap_LookupWideAtom(rep))) {
 	if (!Yap_growheap(FALSE, 0, NULL)) {
 	  exit(1);
 	}
       }
-      if (at == NIL) ERROR(OUT_OF_ATOM_SPACE);
+      if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE);
     } else if (tg == QLY_ATOM) {
       char *rep = (char *)AllocTempSpace();
       UInt len;
 
       len = read_uint(stream);
-      if (!EnoughTempSpace(len)) ERROR(OUT_OF_TEMP_SPACE);
+      if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE);
       read_bytes(stream, rep, (len+1)*sizeof(char));
       while (!(at = Yap_FullLookupAtom(rep))) {
 	if (!Yap_growheap(FALSE, 0, NULL)) {
 	  exit(1);
 	}
       }
-      if (at == NIL) ERROR(OUT_OF_ATOM_SPACE);
+      if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE);
     } else {
-      ERROR(BAD_ATOM);
+      QLYR_ERROR(BAD_ATOM);
       return;
     }
     InsertAtom(oat, at);
@@ -756,6 +756,8 @@ ReadHash(IOSTREAM *stream)
     if (omod) {
       mod = MkAtomTerm(AtomAdjust(omod));
       if (mod == TermProlog) mod = 0;
+    } else {
+      mod = TermProlog;
     }
 
     if (mod != IDB_MODULE) {
@@ -882,7 +884,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
 
     if (pp->PredFlags & SYSTEM_PRED_FLAGS) {
       if (nclauses) {
-	ERROR(INCONSISTENT_CPRED);	
+	QLYR_ERROR(INCONSISTENT_CPRED);	
       }
       return;
     }

H/pl-incl.h

@@ -7,7 +7,7 @@
 
 #ifdef __WINDOWS__
 #include <windows.h>
-#include <uxnt.h>
+#include <windows/uxnt.h>
 #define O_HASDRIVES 1
 #define O_HASSHARES 1
 #endif

H/qly.h

@@ -111,7 +111,7 @@ typedef enum {
 #define NEXTOP(V,TYPE)    ((yamop *)(&((V)->u.TYPE.next)))
 
 #define CHECK(F) { size_t r = (F); if (!r) return r; }
-#define RCHECK(F)  if(!(F)) { ERROR(MISMATCH); return; }
+#define RCHECK(F)  if(!(F)) { QLYR_ERROR(MISMATCH); return; }
 
 #define AllocTempSpace() (H)
 #define EnoughTempSpace(sz) ((ASP-H)*sizeof(CELL) > sz)

OPTYap/or.thread_engine.c

@@ -139,6 +139,9 @@ int p_share_work() {
 
 int q_share_work(int worker_p) {
   CACHE_REGS
+  register tr_fr_ptr aux_tr;
+  register CELL aux_cell;
+
   LOCK_OR_FRAME(LOCAL_top_or_fr);
   if (Get_REMOTE_prune_request(worker_p)) {
     /* worker p with prune request */
@@ -151,6 +154,32 @@ int q_share_work(int worker_p) {
   Set_LOCAL_prune_request(NULL);
   UNLOCK_OR_FRAME(LOCAL_top_or_fr);
 
+ /* unbind variables */
+  aux_tr = Get_LOCAL_top_cp()->cp_tr;
+  TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr);
+  while (aux_tr != TR) {
+    aux_cell = TrailTerm(--TR);
+    /* check for global or local variables */
+    if (IsVarTerm(aux_cell)) {
+      RESET_VARIABLE(aux_cell);
+#ifdef TABLING
+    } else if (IsPairTerm(aux_cell)) {
+      aux_cell = (CELL) RepPair(aux_cell);
+      if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) {
+        /* avoid frozen segments */
+        TR = (tr_fr_ptr) aux_cell;
+        TABLING_ERROR_CHECKING(q_share_work, TR > (tr_fr_ptr) LOCAL_TrailTop);
+        TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr);
+      }
+#endif /* TABLING */
+#ifdef MULTI_ASSIGNMENT_VARIABLES
+    } else if (IsApplTerm(aux_cell)) {
+      CELL *aux_ptr = RepAppl(aux_cell);
+      Term aux_val = TrailTerm(--aux_tr);
+      *aux_ptr = aux_val;
+#endif /* MULTI_ASSIGNMENT_VARIABLES */
+    }
+  }
   OPTYAP_ERROR_CHECKING(q_share_work, Get_LOCAL_top_cp() != Get_LOCAL_top_cp_on_stack());
   OPTYAP_ERROR_CHECKING(q_share_work, YOUNGER_CP(B_FZ, Get_LOCAL_top_cp()));
   YAPOR_ERROR_CHECKING(q_share_work, LOCAL_reply_signal != worker_ready);

docs/yap.tex

@@ -16836,6 +16836,10 @@ function is called with two arguments: the exit code of the process
 the closure argument @var{closure}.
 @c See also @code{at_halt/1}.
 
+@item  @code{int} YAP_Argv(@code{char ***argvp})
+@findex YAP_Argv (C-Interface function)
+Return the number of arguments to YAP and instantiate argvp to point to the list of such arguments.
+
 @end table
 
 

include/YapInterface.h

@@ -566,6 +566,8 @@ extern X_API YAP_Term PROTO(YAP_NewOpaqueObject,(YAP_opaque_tag_t, size_t));
 
 extern X_API void *PROTO(YAP_OpaqueObjectFromTerm,(YAP_Term));
 
+extern X_API int *PROTO(YAP_Argv,(char ***));
+
 #define YAP_InitCPred(N,A,F)  YAP_UserCPredicate(N,F,A)
 
 __END_DECLS

library/lammpi/prologterms2c.c

@@ -208,8 +208,8 @@ YAP_Term
 string2term(char *const ptr,const size_t *size) {
   YAP_Term t;
   struct buffer_ds b;
-  b.size=b.len=b.pos=0;
 
+  b.size=b.len=b.pos=0;
   if (BUFFER_PTR!=ptr) {    //
 #ifdef DEBUG
     write_msg(__FUNCTION__,__FILE__,__LINE__,"copy buffer string2term\n");
@@ -222,7 +222,6 @@ string2term(char *const ptr,const size_t *size) {
     b.ptr=NULL;
   }
   BUFFER_POS=0;
-  LOCAL_ErrorMessage=NULL;
   t = YAP_ReadBuffer( BUFFER_PTR , NULL );
   if ( t==FALSE ) {
     write_msg(__FUNCTION__,__FILE__,__LINE__,"FAILED string2term>>>>size:%d %d %s\n",BUFFER_SIZE,strlen(BUFFER_PTR),LOCAL_ErrorMessage);

library/lammpi/yap_mpi.c

@@ -260,8 +260,10 @@ static int mpi_error(int errcode){
 static int 
 mpi_init(void){
   int thread_level;
+  char ** my_argv;
+  int my_argc = YAP_Argv(&my_argv);
   //  MPI_Init(&GLOBAL_argc, &GLOBAL_argv);
-  MPI_Init_thread(&GLOBAL_argc, &GLOBAL_argv,MPI_THREAD_SINGLE,&thread_level);
+  MPI_Init_thread(&my_argc, &my_argv, MPI_THREAD_SINGLE, &thread_level);
 #ifdef DEBUG
   write_msg(__FUNCTION__,__FILE__,__LINE__,"Thread level: %d\n",thread_level);
 #endif

os/pl-stream.c

@@ -23,7 +23,7 @@
 */
 
 #if defined(__WINDOWS__)||defined(__WIN32)
-#include <uxnt.h>
+#include <windows/uxnt.h>
 #ifndef _YAP_NOT_INSTALLED_
 #ifdef WIN64
 #define MD "config/win64.h"

packages/CLPBN/Makefile.in

@@ -56,7 +56,7 @@ CLPBN_PROGRAMS= \
 	$(CLPBN_SRCDIR)/xbif.yap
 
 CLPBN_LEARNING_PROGRAMS= \
-	$(CLPBN_LEARNING_SRCDIR)/aleph_parms.yap \
+	$(CLPBN_LEARNING_SRCDIR)/aleph_params.yap \
 	$(CLPBN_LEARNING_SRCDIR)/bnt_parms.yap \
 	$(CLPBN_LEARNING_SRCDIR)/em.yap \
 	$(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \

packages/CLPBN/clpbn/table.yap

@@ -44,6 +44,10 @@
 			       variant/2
 			       ]).
 
+:- use_module(evidence, [
+			       put_evidence/2
+			       ]).
+
 :- dynamic clpbn_table/3.
 
 :- meta_predicate clpbn_table(:), clpbn_table_all_args(:).
@@ -92,23 +96,32 @@ clpbn_table((P1,P2),M) :- !,
 clpbn_table(F/N,M) :-
 	functor(S,F,N),
 	S =.. L0,
-	take_tail(L0, V, L1, V, L2),
+	take_tail(L0, A0, L1, V2, L2),
 	Key =.. L1,
 	atom_concat(F, '___tabled', NF),
-	L2 = [_|Args],
+	L2 = [_|Args2],
-	_S1 =.. [NF|Args],
+	Goal =.. [NF|Args2],
-	L0 = [_|OArgs],
+	L0 = [_|Args0],
-	S2 =.. [NF|OArgs],
+	IGoal =.. [NF|Args0],
-	asserta(clpbn_table(S, M, S2)),
+	asserta(clpbn_table(S, M, IGoal)),
 	assert(
 	       (M:S :-
+	        !,
+%		write(S: ' ' ),
 	        b_getval(clpbn_tables, Tab),
-		( b_hash_lookup(Key, V1, Tab) ->
+		% V2 is unbound.
-		  V1=V
+		( b_hash_lookup(Key, V2, Tab) ->
+%		 (attvar(V2) -> writeln(ok:A0:V2) ; writeln(error(V2:should_be_attvar(S)))),
+		 ( var(A0) -> A0 = V2 ; put_evidence(A0, V2) )
 		;
-		  b_hash_insert(Tab, Key, V, NewTab),
+%		writeln(new),
+		  b_hash_insert(Tab, Key, V2, NewTab),
 		  b_setval(clpbn_tables,NewTab),
-		  once(M:S2)
+		  once(M:Goal), !,
+		  % enter evidence after binding.
+		  ( var(A0) -> A0 = V2 ; put_evidence(A0, V2) )
+		;
+		  throw(error(tabled_clpbn_predicate_should_never_fail,S))
 		)
 	       )
 	      ).
@@ -136,6 +149,7 @@ clpbn_tableallargs(F/N,M) :-
 	asserta(clpbn_table(Key, M, NKey)),
 	assert(
 	       (M:Key :-
+	        !,
 	        b_getval(clpbn_tables, Tab),
 		( b_hash_lookup(Key, Out, Tab) ->
 		  true

packages/CLPBN/learning/aleph_params.yap

@@ -35,6 +35,7 @@
 	 clpbn_tabled_clause/2,
 	 clpbn_tabled_number_of_clauses/2,
 	 clpbn_is_tabled/1,
+	 clpbn_reset_tables/0,
 	 clpbn_tabled_dynamic/1]).
 
 %
@@ -90,7 +91,9 @@ store_theory(_,_,_) :-
 store_theory(_,(H:-_),_) :-
 	clpbn_is_tabled(user:H), !,
 	store_tabled_theory(H).
-store_theory(_,(H:-_),_) :-
+store_theory(_,(H:-_),_) :- !,
+	store_theory(H).
+store_theory(_,H,_) :-
 	store_theory(H).
 
 store_tabled_theory(H) :-
@@ -163,6 +166,7 @@ user:cost((H :- B),Inf,Score) :- !,
 	(
 	    clpbn_is_tabled(user:H)
 	->
+	    clpbn_reset_tables,
 	    clpbn_tabled_asserta(user:(H :- IB), R)
 	;
 	    asserta(user:(H :- IB), R)
@@ -251,7 +255,7 @@ key_from_head(H,K,V) :-
 rewrite_body((A,B), (user:NA,NB), [V|Vs], [D|Ds], Tail) :-
 	rewrite_goal(A, V, D, NA), !,
 	rewrite_body(B, NB, Vs, Ds, Tail).
-rewrite_body((A,B), (user:A,NB), Vs, Ds, Tail) :-
+rewrite_body((A,B), (user:A,NB), Vs, Ds, Tail) :- !,
 	rewrite_body(B,NB, Vs, Ds, Tail).
 rewrite_body(A,(user:NA,Tail), [V], [D], Tail) :- 
 	rewrite_goal(A, V, D, NA), !.

packages/CLPBN/learning/em.yap

@@ -203,6 +203,8 @@ compute_parameters([], [], _, Lik, Lik, _).
 compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables],  MDistTable, Lik0, Lik, LPs:MargVars) :-
 	empty_dist(Id, Table0),
 	add_samples(Samples, Table0, MDistTable),
+%matrix_to_list(Table0,Mat), 
+%format(user_error, 'FINAL ~d ~w~n', [Id,Mat]),
 	soften_sample(Table0, SoftenedTable),
 %	matrix:matrix_sum(Table0,TotM),
 	normalise_counts(SoftenedTable, NewTable),
@@ -218,6 +220,7 @@ add_samples([i(_,_,[Case],[])|Samples], Table, MDistTable) :- !,
 add_samples([i(_,_,Cases,Hiddens)|Samples], Table, MDistTable) :-
 	rb_lookup(Hiddens, Ps, MDistTable),
 	run_sample(Cases, Ps, Table),
+%matrix_to_list(Table,M), format(user_error, '~w ~w~n', [Cases,Ps]),
 	add_samples(Samples, Table, MDistTable).
 
 run_sample([], [], _).

packages/jpl

@@ -1 +1 @@
-Subproject commit 4f82114d41f8eba34afaae50a0d98936b7f19122
+Subproject commit 4742393c919d372b28df044754d6034d653967e1