diff --git a/C/absmi.c b/C/absmi.c index 25031d196..55358914a 100644 --- a/C/absmi.c +++ b/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); diff --git a/C/c_interface.c b/C/c_interface.c index ce94a975e..540d0d5ce 100644 --- a/C/c_interface.c +++ b/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; +} diff --git a/C/errors.c b/C/errors.c index 8506ead58..6f715c575 100644 --- a/C/errors.c +++ b/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 diff --git a/C/init.c b/C/init.c index cc0d3cf93..18eb04cff 100644 --- a/C/init.c +++ b/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); diff --git a/C/qlyr.c b/C/qlyr.c index 84679cf9f..2ef03469d 100644 --- a/C/qlyr.c +++ b/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; } diff --git a/H/pl-incl.h b/H/pl-incl.h index 93188ac03..a97582d97 100644 --- a/H/pl-incl.h +++ b/H/pl-incl.h @@ -7,7 +7,7 @@ #ifdef __WINDOWS__ #include -#include +#include #define O_HASDRIVES 1 #define O_HASSHARES 1 #endif diff --git a/H/qly.h b/H/qly.h index a46096fd3..d1fda83c2 100644 --- a/H/qly.h +++ b/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) diff --git a/OPTYap/or.thread_engine.c b/OPTYap/or.thread_engine.c index 8bf584646..db2f99158 100644 --- a/OPTYap/or.thread_engine.c +++ b/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); diff --git a/docs/yap.tex b/docs/yap.tex index 77f8eb386..f475b349f 100644 --- a/docs/yap.tex +++ b/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 diff --git a/include/YapInterface.h b/include/YapInterface.h index 4ac15377c..b45c37e3b 100644 --- a/include/YapInterface.h +++ b/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 diff --git a/library/lammpi/prologterms2c.c b/library/lammpi/prologterms2c.c index 88673202a..7996f9e2c 100644 --- a/library/lammpi/prologterms2c.c +++ b/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); diff --git a/library/lammpi/yap_mpi.c b/library/lammpi/yap_mpi.c index 4bba051f9..daa8e38e4 100644 --- a/library/lammpi/yap_mpi.c +++ b/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 diff --git a/os/pl-stream.c b/os/pl-stream.c index a6974add4..4ef6e148b 100644 --- a/os/pl-stream.c +++ b/os/pl-stream.c @@ -23,7 +23,7 @@ */ #if defined(__WINDOWS__)||defined(__WIN32) -#include +#include #ifndef _YAP_NOT_INSTALLED_ #ifdef WIN64 #define MD "config/win64.h" diff --git a/packages/CLPBN/Makefile.in b/packages/CLPBN/Makefile.in index c3cc626e7..2f908d017 100644 --- a/packages/CLPBN/Makefile.in +++ b/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 \ diff --git a/packages/CLPBN/clpbn/table.yap b/packages/CLPBN/clpbn/table.yap index 9c07503bc..a3a5e16cb 100644 --- a/packages/CLPBN/clpbn/table.yap +++ b/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], - _S1 =.. [NF|Args], - L0 = [_|OArgs], - S2 =.. [NF|OArgs], - asserta(clpbn_table(S, M, S2)), + L2 = [_|Args2], + Goal =.. [NF|Args2], + L0 = [_|Args0], + IGoal =.. [NF|Args0], + asserta(clpbn_table(S, M, IGoal)), assert( (M:S :- + !, +% write(S: ' ' ), b_getval(clpbn_tables, Tab), - ( b_hash_lookup(Key, V1, Tab) -> - V1=V + % V2 is unbound. + ( 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 diff --git a/packages/CLPBN/learning/aleph_params.yap b/packages/CLPBN/learning/aleph_params.yap index ea49bc0c3..dc2a6a165 100644 --- a/packages/CLPBN/learning/aleph_params.yap +++ b/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), !. diff --git a/packages/CLPBN/learning/em.yap b/packages/CLPBN/learning/em.yap index a09eac3f0..960e10ad5 100644 --- a/packages/CLPBN/learning/em.yap +++ b/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([], [], _). diff --git a/packages/jpl b/packages/jpl index 4f82114d4..4742393c9 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit 4f82114d41f8eba34afaae50a0d98936b7f19122 +Subproject commit 4742393c919d372b28df044754d6034d653967e1