diff --git a/C/exec.c b/C/exec.c index 8ff00e4ce..7588b175b 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1034,11 +1034,6 @@ init_stack(int arity, CELL *pt, int top, choiceptr saved_b) } B = (choiceptr)ASP; B--; -#ifdef TABLING - if (top && GLOBAL_root_dep_fr) { - DepFr_cons_cp(GLOBAL_root_dep_fr) = B; - } -#endif /* TABLING */ B->cp_h = H; B->cp_tr = TR; B->cp_cp = CP; diff --git a/C/write.c b/C/write.c index 504c2bdf2..740359f0e 100755 --- a/C/write.c +++ b/C/write.c @@ -292,29 +292,30 @@ wrputref(CODEADDR ref, int Quote_illegal, wrf writewch) /* writes a data base static int legalAtom(unsigned char *s) /* Is this a legal atom ? */ - { wchar_t ch = *s; if (ch == '\0') - return(FALSE); + return FALSE; if (Yap_chtype[ch] != LC) { - if (ch == '[') - return (*++s == ']' && !(*++s)); - else if (ch == '{') - return (*++s == '}' && !(*++s)); + if (ch == '[') { + return (s[1] == ']' && !s[2]); + } else if (ch == '{') { + return (s[1] == '}' && !s[2]); // else if (ch == '/') // return (*++s != '*'); - else if (Yap_chtype[ch] == SL) - return (!*++s); - else if ((ch == ',' || ch == '.') && !s[1]) + } else if (Yap_chtype[ch] == SL) { + return (!s[1]); + } else if ((ch == ',' || ch == '.') && !s[1]) { return FALSE; - else + } else { while (ch) { - if (Yap_chtype[ch] != SY) + if (Yap_chtype[ch] != SY) { return FALSE; + } ch = *++s; } + } return TRUE; } else while ((ch = *++s) != 0) diff --git a/OPTYap/opt.init.c b/OPTYap/opt.init.c index 1d94e2024..8d6dcc2d1 100644 --- a/OPTYap/opt.init.c +++ b/OPTYap/opt.init.c @@ -239,6 +239,9 @@ void make_root_frames(void) { /* root dependency frame */ if (!GLOBAL_root_dep_fr) { new_dependency_frame(GLOBAL_root_dep_fr, FALSE, NULL, NULL, NULL, NULL, NULL); +#ifdef TABLING + DepFr_cons_cp(GLOBAL_root_dep_fr) = B; +#endif /* TABLING */ } #endif /* TABLING */ } diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index d439a1ca6..5ccbdafd9 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -513,8 +513,8 @@ extern X_API int PL_recorded_external(char *, term_t); extern X_API int PL_erase_external(char *); extern X_API int PL_action(int,...); extern X_API void PL_on_halt(void (*)(int, void *), void *); -extern X_API void *PL_malloc(int); -extern X_API void *PL_realloc(void*,int); +extern X_API void *PL_malloc(size_t); +extern X_API void *PL_realloc(void*,size_t); extern X_API void PL_free(void *); extern X_API int PL_eval_expression_to_int64_ex(term_t t, int64_t *val); extern X_API void PL_cleanup_fork(void); diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index fea5696be..69474c30f 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -6,7 +6,6 @@ :- module(system, [concat_atom/2, concat_atom/3, setenv/2, - prolog_to_os_filename/2, is_absolute_file_name/1, read_clause/1, string/1, @@ -224,7 +223,6 @@ goal_expansion(rename_file(A,B),system:swi_rename_file(A,B)) :- swi_io. goal_expansion(is_absolute_file_name(A), is_absolute_file_name(A)) :- swi_io. goal_expansion(file_base_name(A,B),system:swi_file_base_name(A,B)) :- swi_io. goal_expansion(file_directory_name(A,B),system:swi_file_directory_name(A,B)) :- swi_io. -goal_expansion(prolog_to_os_filename(A,B),system:swi_prolog_to_os_filename(A,B)) :- swi_io. goal_expansion('$mark_executable'(A), system:'swi_is_absolute_file_name'(A)) :- swi_io. goal_expansion('$absolute_file_name'(A,B),system:'swi_$absolute_file_name'(A,B)) :- swi_io. @@ -281,8 +279,6 @@ concat_atom(List, New) :- setenv(X,Y) :- unix(putenv(X,Y)). -prolog_to_os_filename(X,X). - is_absolute_file_name(X) :- absolute_file_name(X,X). diff --git a/library/tries/core_dbtries.c b/library/tries/core_dbtries.c index 822adf24d..071c1b23e 100644 --- a/library/tries/core_dbtries.c +++ b/library/tries/core_dbtries.c @@ -612,8 +612,17 @@ TrNode core_breadth_reduction(TrEngine engine, TrNode node, TrNode breadth_node, } while (bucket != first_bucket); } else { do { - if (TrNode_entry(child) == PairEndTag) - return core_breadth_reduction(engine, child, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function); + if (TrNode_entry(child) == PairEndTag) { + /* do breadth reduction simplification */ + node = TrNode_parent(child); + DATA_DESTRUCT_FUNCTION = destruct_function; + remove_child_nodes(TrNode_child(node)); + TrNode_child(node) = NULL; + node = trie_node_check_insert(node, PairEndTag); + INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); + return node; + //return core_breadth_reduction(engine, node, breadth_node, opt_level, construct_function, destruct_function, copy_function, correct_order_function); + } while (IS_FUNCTOR_NODE(child)) { child = TrNode_child(child); if (IS_HASH_NODE(child)) { // gets first child in the hash diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index 7f4572cb1..d1cf2e9ec 100755 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -272,8 +272,8 @@ ensure_space(char **sp, size_t room, unsigned flags) { min += 512; if (flags & BUF_MALLOC) { - free(*sp); - *sp = malloc(room); + PL_free(*sp); + *sp = PL_malloc(room); return *sp; } else if (flags & BUF_RING) { for (i=1; i<= SWI_BUF_RINGS; i++) @@ -512,7 +512,7 @@ static int do_yap_putc(int sno, wchar_t ch) { UInt bufsize = putc_cur_lim-putc_cur_buf; UInt bufpos = putc_curp-putc_cur_buf; - if (!(putc_cur_buf = realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) { + if (!(putc_cur_buf = PL_realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) { /* we can+t go forever */ return FALSE; } @@ -564,7 +564,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags) if ((flags & BUF_RING)) { tmp = alloc_ring_buf(); } else if ((flags & BUF_MALLOC)) { - tmp = malloc(SWI_BUF_SIZE); + tmp = PL_malloc(SWI_BUF_SIZE); } else { tmp = SWI_buffers[0]; } @@ -641,7 +641,7 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags) } if (flags & BUF_MALLOC) { size_t sz = strlen(tmp); - char *nbf = malloc(sz+1); + char *nbf = PL_malloc(sz+1); if (!nbf) return 0; strncpy(nbf,tmp,sz+1); @@ -685,7 +685,7 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags) } room = (sz+1)*sizeof(wchar_t); if (flags & BUF_MALLOC) { - *wsp = buf = (wchar_t *)malloc(room); + *wsp = buf = (wchar_t *)PL_malloc(room); } else if (flags & BUF_RING) { *wsp = (wchar_t *)alloc_ring_buf(); buf = (wchar_t *)ensure_space((char **)wsp, room, flags); @@ -1129,7 +1129,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...) { va_list ap; int arity, i; - Term *tmp = (Term *)SWI_buffers[0]; + Term *tmp, t; Functor ff = SWIFunctorToFunctor(f); if (IsAtomTerm((Term)ff)) { @@ -1137,46 +1137,55 @@ X_API int PL_cons_functor(term_t d, functor_t f,...) return TRUE; } arity = ArityOfFunctor(ff); - if (arity > SWI_TMP_BUF_SIZE/sizeof(YAP_CELL)) { - fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity); - return FALSE; + while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) { + if (!Yap_gc(0, ENV, CP)) { + return FALSE; + } + } + if (arity == 2 && ff == FunctorDot) { + t = Yap_MkNewPairTerm(); + tmp = RepPair(t); + } else { + t = Yap_MkNewApplTerm(ff, arity); + tmp = RepAppl(t)+1; } va_start (ap, f); for (i = 0; i < arity; i++) { - tmp[i] = Yap_GetFromSlot(va_arg(ap, term_t)); + Yap_unify(tmp[i],Yap_GetFromSlot(va_arg(ap, term_t))); } va_end (ap); - if (arity == 2 && ff == FunctorDot) - Yap_PutInSlot(d,MkPairTerm(tmp[0],tmp[1])); - else - Yap_PutInSlot(d,Yap_MkApplTerm(ff,arity,tmp)); - if (Unsigned(H) > Unsigned(ASP)-CreepFlag) { - if (!Yap_gc(0, ENV, CP)) { - return FALSE; - } - } + Yap_PutInSlot(d,t); return TRUE; } -X_API int PL_cons_functor_v(term_t d, functor_t f,term_t a0) +X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0) { - int arity; + int arity, i; + Term *tmp, t; Functor ff = SWIFunctorToFunctor(f); if (IsAtomTerm((Term)ff)) { - Yap_PutInSlot(d,(Term)ff); + Yap_PutInSlot(d, (YAP_Term)f); return TRUE; } arity = ArityOfFunctor(ff); - if (arity == 2 && ff == FunctorDot) - Yap_PutInSlot(d,MkPairTerm(Yap_GetFromSlot(a0),Yap_GetFromSlot(a0+1))); - else - Yap_PutInSlot(d,Yap_MkApplTerm(ff,arity,Yap_AddressFromSlot(a0))); - if (Unsigned(H) > Unsigned(ASP)-CreepFlag) { + while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) { if (!Yap_gc(0, ENV, CP)) { return FALSE; } } + if (arity == 2 && ff == FunctorDot) { + t = Yap_MkNewPairTerm(); + tmp = RepPair(t); + } else { + t = Yap_MkNewApplTerm(ff, arity); + tmp = RepAppl(t)+1; + } + for (i = 0; i < arity; i++) { + Yap_unify(tmp[i],Yap_GetFromSlot(a0)); + a0++; + } + Yap_PutInSlot(d,t); return TRUE; } @@ -3011,21 +3020,33 @@ PL_set_engine(PL_engine_t engine, PL_engine_t *old) X_API void * -PL_malloc(int sz) +PL_malloc(size_t sz) { - return (void *)Yap_AllocCodeSpace((long unsigned int)sz); + if ( sz == 0 ) + return NULL; + return (void *)malloc((long unsigned int)sz); } X_API void * -PL_realloc(void *ptr, int sz) +PL_realloc(void *ptr, size_t sz) { - return Yap_ReallocCodeSpace((char *)ptr,(long unsigned int)sz); + if (ptr) { + if (sz) { + return realloc((char *)ptr,(long unsigned int)sz); + } else { + free(ptr); + return NULL; + } + } else { + return PL_malloc(sz); + } } X_API void PL_free(void *obj) { - return Yap_FreeCodeSpace((char *)obj); + if (obj) + free(obj); } X_API int diff --git a/packages/clib/process.pl b/packages/clib/process.pl index 0e600a9eb..9950d38c7 100644 --- a/packages/clib/process.pl +++ b/packages/clib/process.pl @@ -45,6 +45,8 @@ :- use_module(library(option)). :- use_module(library(error)). +:- use_module(library(maplist)). + :- use_foreign_library(foreign(process)). /** Create processes and redirect I/O diff --git a/packages/semweb/rdf_db.pl b/packages/semweb/rdf_db.pl index 449cc7bff..9ad5671e2 100644 --- a/packages/semweb/rdf_db.pl +++ b/packages/semweb/rdf_db.pl @@ -127,6 +127,10 @@ (rdf_meta)/1, % +Heads op(1150, fx, (rdf_meta)) ]). + +:- expects_dialect(swi). +:- assert(system:swi_io). + :- use_module(library(rdf)). :- use_module(library(lists)). :- use_module(library(shlib)). @@ -153,6 +157,16 @@ :- discontiguous term_expansion/2. +:- meta_predicate + rdf_transaction(0), + rdf_transaction(0, +), + rdf_monitor(1, +), + rdf_save(+, :), + rdf_load(+, :). + +:- thread_local + named_anon/2. % +Resource, -Id + /** Core RDF database @see Documentation for semweb package @@ -1369,16 +1383,6 @@ rdf_reset_db :- % file-url (=|file://path|=) or a stream wrapped % in a term stream(Out). -:- meta_predicate - rdf_transaction(0), - rdf_transaction(0, +), - rdf_monitor(1, +), - rdf_save(+, :), - rdf_load(+, :). - -:- thread_local - named_anon/2. % +Resource, -Id - rdf_save(File) :- rdf_save2(File, []). @@ -2183,3 +2187,7 @@ into(_, _) --> []. % TBD in_time(Triples, ParseTime) --> [ ' in ~2f sec; ~D triples'-[ParseTime, Triples] ]. + +:- retract(system:swi_io). + + diff --git a/packages/tai/Makefile.in b/packages/tai/Makefile.in index 0801fa6d9..1ad6a6045 100755 --- a/packages/tai/Makefile.in +++ b/packages/tai/Makefile.in @@ -56,4 +56,4 @@ install: all clean: rm -f *.o *~ $(OBJS) $(SOBJS) *.BAK - + -(cd libtai && $(MAKE) clean) diff --git a/pl/consult.yap b/pl/consult.yap index d90a14d3c..598c56f53 100755 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -1036,6 +1036,8 @@ file_name_extension(A1,A2,F) :- atom_codes(A2, S2), ( S2 = [0'.|_] %' + ; + A2 = '' -> atom_concat(A1, A2, F) ; diff --git a/pl/yio.yap b/pl/yio.yap index 9a406d509..89d1510b1 100644 --- a/pl/yio.yap +++ b/pl/yio.yap @@ -1209,3 +1209,21 @@ with_output_to(Output, Command) :- atom_codes(Char, [Code]), '$codes_to_chars'(String0, String, Chars). +prolog_to_os_filename(Prolog, OS) :- + '$undefined'(swi_prolog_to_os_filename(Prolog, OS), system), + '$current_module'(Old, system), + load_foreign_files([libplstream], [], initIO), + '$current_module'(system, Old), + fail. +prolog_to_os_filename(Prolog, OS) :- + system:swi_prolog_to_os_filename(Prolog, OS). + + + + + + + + + +