diff --git a/C/arith1.c b/C/arith1.c index 477881b60..980301c4f 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -555,6 +555,17 @@ eval1(Int fi, Term t) { case db_ref_e: RERROR(); } +#if HAVE_ISNAN + if (isnan(dbl)) { + return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl); + } +#endif +#if HAVE_ISNAN + if (isinf(dbl)) { + return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\ +(%f)",dbl); + } +#endif if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) { RINT((Int) dbl); } else { @@ -797,8 +808,9 @@ p_unary_is(void) return FALSE; } top = Yap_Eval(Deref(ARG3)); - if (top == 0L) + if (!Yap_FoundArithError(top, ARG3)) { return FALSE; + } if (IsIntTerm(t)) { Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3)); if (!tout) diff --git a/C/arith2.c b/C/arith2.c index e79ca6284..cd4db2f96 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -1117,13 +1117,15 @@ p_binary_is(void) return(FALSE); } t1 = Yap_Eval(Deref(ARG3)); - if (t1 == 0L) + if (!Yap_FoundArithError(t1, ARG3)) { return FALSE; + } t2 = Yap_Eval(Deref(ARG4)); - if (t2 == 0L) + if (!Yap_FoundArithError(t2, ARG4)) { return FALSE; + } if (IsIntTerm(t)) { - Term tout = Yap_FoundArithError(eval2(IntegerOfTerm(t), t1, t2), 0L); + Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L); if (!tout) return FALSE; return Yap_unify_constant(ARG1,tout); diff --git a/C/compiler.c b/C/compiler.c index dce318db6..c91de9ea6 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -229,7 +229,7 @@ STATIC_PROTO(void c_arg, (Int, Term, unsigned int, unsigned int, compiler_struct STATIC_PROTO(void c_args, (Term, unsigned int, compiler_struct *)); STATIC_PROTO(void c_eq, (Term, Term, compiler_struct *)); STATIC_PROTO(void c_test, (Int, Term, compiler_struct *)); -STATIC_PROTO(void c_bifun, (Int, Term, Term, Term, Term, Term, compiler_struct *)); +STATIC_PROTO(void c_bifun, (basic_preds, Term, Term, Term, Term, Term, compiler_struct *)); STATIC_PROTO(void c_goal, (Term, Term, compiler_struct *)); STATIC_PROTO(void c_body, (Term, Term, compiler_struct *)); STATIC_PROTO(void c_head, (Term, compiler_struct *)); @@ -942,7 +942,7 @@ bip_cons Op,Xk,Ri,C */ static void -c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler_struct *cglobs) +c_bifun(basic_preds Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler_struct *cglobs) { /* compile Z = X Op Y arithmetic function */ /* first we fetch the arguments */ @@ -1795,7 +1795,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) return; } else if (p->PredFlags & AsmPredFlag) { - int op = p->PredFlags & 0x7f; + basic_preds op = p->PredFlags & 0x7f; if (profiling) Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint); diff --git a/C/dbase.c b/C/dbase.c index 7ad9669a2..65b1e0d1b 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -4631,6 +4631,7 @@ p_instance(void) if (IsVarTerm(t2)) { Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity))); } else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) { + UNLOCK(ap->PELock); return FALSE; } ptr = RepAppl(t2)+1; diff --git a/C/exec.c b/C/exec.c index c9de95784..8dc7b0b6f 100644 --- a/C/exec.c +++ b/C/exec.c @@ -788,25 +788,17 @@ p_execute_nonstop(void) } /* N = arity; */ /* call may not define new system predicates!! */ - if (ActiveSignals & YAP_CREEP_SIGNAL && !Yap_InterruptsDisabled) { - Yap_signal(YAP_CREEP_SIGNAL); - } if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { + if (ActiveSignals & YAP_CREEP_SIGNAL && !Yap_InterruptsDisabled) { + Yap_signal(YAP_CREEP_SIGNAL); + } return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred); - } else if ((RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) && - RepPredProp(pe)->OpcodeOfPred != Yap_opcode(_call_bfunc_xx)) { - /* USER C-Code may walk over registers */ - if (RepPredProp(pe)->PredFlags & UserCPredFlag) { - save_machine_regs(); + } else { if (ActiveSignals & YAP_CREEP_SIGNAL && + !Yap_InterruptsDisabled && + (!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) || + RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) { + Yap_signal(YAP_CREEP_SIGNAL); } - if (RepPredProp(pe)->PredFlags & UserCPredFlag) { - Int out = RepPredProp(pe)->cs.f_code(); - restore_machine_regs(); - return out; - } else { - return RepPredProp(pe)->cs.f_code(); - } - } else { return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred); } } diff --git a/C/iopreds.c b/C/iopreds.c index f84e84088..ffd23023d 100755 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -2164,8 +2164,13 @@ check_bom(int sno, StreamDesc *st) int ch; ch = st->stream_getc(sno); - if (ch == EOFCHAR) + if (ch == EOFCHAR) { + st->och = ch; + st->stream_getc = PlUnGetc; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; return TRUE; + } switch(ch) { case 0xFE: { diff --git a/C/sysbits.c b/C/sysbits.c index 29080b069..a6afde9db 100755 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -2972,6 +2972,16 @@ p_ld_path(void) return Yap_unify(ARG1,MkAtomTerm(Yap_LookupAtom(YAP_LIBDIR))); } +static Int +p_address_bits(void) +{ +#if SIZEOF_INT_P==4 + return Yap_unify(ARG1,MkIntTerm(32)); +#else + return Yap_unify(ARG1,MkIntTerm(64)); +#endif +} + #ifdef _WIN32 @@ -3193,6 +3203,7 @@ Yap_InitSysPreds(void) Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag); Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag); + Yap_InitCPred ("$address_bits", 1, p_address_bits, SafePredFlag); #ifdef _WIN32 Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0); #endif diff --git a/COPYING b/COPYING new file mode 100755 index 000000000..824fd88ca --- /dev/null +++ b/COPYING @@ -0,0 +1,3 @@ +This system is distributed under the LGPL licence terms. For details +visit http://www.gnu.org/copyleft/lesser.html. + diff --git a/Makefile.in b/Makefile.in old mode 100644 new mode 100755 index 0d586fbf2..56cdad158 --- a/Makefile.in +++ b/Makefile.in @@ -29,7 +29,7 @@ INFODIR=$(SHAREDIR)/info # # where to store documentaion files # -DOCSDIR=$(SHAREDIR)/docs/yap +DOCSDIR=$(SHAREDIR)/docs/Yap # # Add this flag to YAP_EXTRAS if you need the extension: @@ -511,6 +511,10 @@ install_unix: startup.yss libYap.a @INSTALL_DLLS@ $(INSTALL_DATA) -m 755 @YAPLIB@ $(DESTDIR)$(LIBDIR) mkdir -p $(DESTDIR)$(SHAREDIR)/Yap mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl + mkdir -p $(DESTDIR)$(DOCSDIR) + $(INSTALL) $(srcdir)/Artistic $(DESTDIR)$(DOCSDIR) + $(INSTALL) $(srcdir)/README $(DESTDIR)$(DOCSDIR) + $(INSTALL) $(srcdir)/COPYING $(DESTDIR)$(DOCSDIR) for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done @INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) install) @INSTALL_DLLS@ (cd packages/plunit; $(MAKE) install) @@ -546,6 +550,10 @@ install_win32: startup.yss mkdir -p $(DESTDIR)$(SHAREDIR)/Yap mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/swi + mkdir -p $(DESTDIR)$(DOCSDIR) + $(INSTALL) $(srcdir)/Artistic $(DESTDIR)$(DOCSDIR) + $(INSTALL) $(srcdir)/README $(DESTDIR)$(DOCSDIR)/README.TXT + $(INSTALL) $(srcdir)/COPYING $(DESTDIR)$(DOCSDIR)/COPYING.TXT for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done $(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR) for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index cc2f59b87..112adf88b 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -185,6 +185,7 @@ typedef void *PL_engine_t; #define CVT_MASK 0x00ff #define CVT_EXCEPTION 0x10000 +#define CVT_VARNOFAIL 0x20000 /* return 2 if argument is unbound */ #define BUF_DISCARDABLE 0x0000 #define BUF_RING 0x0100 @@ -409,6 +410,7 @@ extern X_API void PL_discard_foreign_frame(fid_t); extern X_API void PL_rewind_foreign_frame(fid_t); extern X_API fid_t PL_open_foreign_frame(void); extern X_API int PL_raise_exception(term_t); +extern X_API void PL_clear_exception(void); extern X_API void PL_register_atom(atom_t); extern X_API void PL_unregister_atom(atom_t); extern X_API predicate_t PL_pred(functor_t, module_t); @@ -420,6 +422,7 @@ extern X_API void PL_cut_query(qid_t); extern X_API void PL_close_query(qid_t); extern X_API int PL_toplevel(void); extern X_API term_t PL_exception(qid_t); +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); @@ -436,7 +439,7 @@ extern X_API int PL_destroy_engine(PL_engine_t); extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *); extern X_API int PL_get_string_chars(term_t, char **, int *); extern X_API record_t PL_record(term_t); -extern X_API void PL_recorded(record_t, term_t); +extern X_API int PL_recorded(record_t, term_t); extern X_API void PL_erase(record_t); extern X_API int PL_action(int,...); extern X_API void *PL_malloc(int); diff --git a/library/itries.yap b/library/itries.yap index 323dc2daa..c7b3618d3 100644 --- a/library/itries.yap +++ b/library/itries.yap @@ -28,13 +28,12 @@ itrie_save/2, itrie_save_as_trie/2, itrie_load/2, + itrie_save2stream/2, + itrie_loadFromstream/2, itrie_stats/4, itrie_max_stats/4, itrie_usage/4, - itrie_print/1, - %added by nf - itrie_save2stream/2, - itrie_loadFromstream/2 + itrie_print/1 ]). :- load_foreign_files([itries], [], init_itries). diff --git a/library/system/sys.c b/library/system/sys.c index fa17de23c..5334e7fae 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -205,7 +205,7 @@ sysmktime(void) loc.tm_hour = YAP_IntOfTerm(YAP_ARG4); loc.tm_min = YAP_IntOfTerm(YAP_ARG5); loc.tm_sec = YAP_IntOfTerm(YAP_ARG6); - loc.tm_isdst = daylight; + loc.tm_isdst = -1; if ((tim = mktime(&loc)) == (time_t)-1) { return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); diff --git a/library/tries.yap b/library/tries.yap index e57a7d081..096cbfa4a 100644 --- a/library/tries.yap +++ b/library/tries.yap @@ -50,5 +50,4 @@ trie_dup(Trie, CopyTrie) :- trie_join(CopyTrie, Trie). trie_traverse(Trie, Ref) :- - trie_get_first_entry(Trie, InitRef), - (Ref = InitRef ; trie_traverse(Trie, InitRef, Ref)). + trie_traverse(Trie, 0, Ref). diff --git a/library/tries/base_tries.c b/library/tries/base_tries.c index 7a53f2e43..36c90e12b 100644 --- a/library/tries/base_tries.c +++ b/library/tries/base_tries.c @@ -72,8 +72,10 @@ void trie_data_destruct(TrNode node) { if (TrData_next(data)) { TrData_previous(TrData_next(data)) = TrData_previous(data); TrData_next(TrData_previous(data)) = TrData_next(data); - } else + } else { + TrEntry_last_data(trie) = TrData_previous(data); TrData_next(TrData_previous(data)) = NULL; + } free_trie_data(data); return; } @@ -177,6 +179,8 @@ TrData trie_get_last_entry(TrEntry trie) { TrData data; data = TrEntry_last_data(trie); + if (data == AS_TR_DATA_NEXT(&TrEntry_first_data(trie))) + return NULL; return data; } @@ -185,7 +189,11 @@ inline TrData trie_traverse_init(TrEntry trie, TrData init_data) { TrData data; - data = TrData_next(init_data); + if (init_data) { + data = TrData_next(init_data); + } else { + data = TrEntry_first_data(trie); + } TrEntry_traverse_data(trie) = data; return data; } diff --git a/library/tries/base_tries.h b/library/tries/base_tries.h index 09e6a0bee..e8c7a8788 100644 --- a/library/tries/base_tries.h +++ b/library/tries/base_tries.h @@ -53,32 +53,32 @@ typedef struct trie_data { /* Macros */ /* --------------------------- */ -#define new_trie_entry(TR_ENTRY, TR_NODE) \ - { new_struct(TR_ENTRY, TYPE_TR_ENTRY, SIZEOF_TR_ENTRY); \ - TrEntry_trie(TR_ENTRY) = TR_NODE; \ - TrEntry_first_data(TR_ENTRY) = NULL; \ - TrEntry_last_data(TR_ENTRY) = NULL; \ - TrEntry_traverse_data(TR_ENTRY) = NULL; \ - TrEntry_next(TR_ENTRY) = FIRST_TRIE; \ - TrEntry_previous(TR_ENTRY) = AS_TR_ENTRY_NEXT(&FIRST_TRIE); \ - INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_ENTRY); \ +#define new_trie_entry(TR_ENTRY, TR_NODE) \ + { new_struct(TR_ENTRY, TYPE_TR_ENTRY, SIZEOF_TR_ENTRY); \ + TrEntry_trie(TR_ENTRY) = TR_NODE; \ + TrEntry_first_data(TR_ENTRY) = NULL; \ + TrEntry_last_data(TR_ENTRY) = AS_TR_DATA_NEXT(&TrEntry_first_data(TR_ENTRY)); \ + TrEntry_traverse_data(TR_ENTRY) = NULL; \ + TrEntry_next(TR_ENTRY) = FIRST_TRIE; \ + TrEntry_previous(TR_ENTRY) = AS_TR_ENTRY_NEXT(&FIRST_TRIE); \ + INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_ENTRY); \ } -#define new_trie_data(TR_DATA, TR_ENTRY, TR_NODE) \ - { TrData last_data = TrEntry_last_data(TR_ENTRY); \ - new_struct(TR_DATA, TYPE_TR_DATA, SIZEOF_TR_DATA); \ - TrData_trie(TR_DATA) = TR_ENTRY; \ - TrData_leaf(TR_DATA) = TR_NODE; \ - TrData_next(TR_DATA) = NULL; \ - if (last_data) { \ - TrData_next(last_data) = TR_DATA; \ - TrData_previous(TR_DATA) = last_data; \ - TrEntry_last_data(TR_ENTRY) = TR_DATA; \ - } else { \ - TrData_previous(TR_DATA) = AS_TR_DATA_NEXT(&TrEntry_first_data(TR_ENTRY)); \ - TrEntry_first_data(TR_ENTRY) = TR_DATA; \ - TrEntry_last_data(TR_ENTRY) = TR_DATA; \ - } \ - INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_DATA); \ +#define new_trie_data(TR_DATA, TR_ENTRY, TR_NODE) \ + { TrData first_data = TrEntry_first_data(TR_ENTRY); \ + new_struct(TR_DATA, TYPE_TR_DATA, SIZEOF_TR_DATA); \ + TrData_trie(TR_DATA) = TR_ENTRY; \ + TrData_leaf(TR_DATA) = TR_NODE; \ + TrData_next(TR_DATA) = NULL; \ + if (first_data) { \ + TrData last_data = TrEntry_last_data(TR_ENTRY); \ + TrData_next(last_data) = TR_DATA; \ + TrData_previous(TR_DATA) = last_data; \ + } else { \ + TrData_previous(TR_DATA) = AS_TR_DATA_NEXT(&TrEntry_first_data(TR_ENTRY)); \ + TrEntry_first_data(TR_ENTRY) = TR_DATA; \ + } \ + TrEntry_last_data(TR_ENTRY) = TR_DATA; \ + INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_DATA); \ } diff --git a/library/tries/core_tries.c b/library/tries/core_tries.c index 424a5f40c..316b8558c 100644 --- a/library/tries/core_tries.c +++ b/library/tries/core_tries.c @@ -431,7 +431,8 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, fpos_t curpos; fscanf(file, "%14s", version); - if (fgetpos(file, &curpos) ) return NULL; + if (fgetpos(file, &curpos)) + return NULL; if (!strcmp(version, "BEGIN_TRIE_v2")) { fseek(file, -11, SEEK_END); @@ -442,7 +443,8 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, fprintf(stderr, "******************************************\n"); return NULL; } - if (fsetpos(file, &curpos) ) return NULL; + if (fsetpos(file, &curpos)) + return NULL; CURRENT_LOAD_VERSION = 2; } else if (!strcmp(version, "BEGIN_TRIE")) { fseek(file, -8, SEEK_END); @@ -453,7 +455,8 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, fprintf(stderr, "******************************************\n"); return NULL; } - if (fsetpos(file, &curpos) ) return NULL; + if (fsetpos(file, &curpos)) + return NULL; CURRENT_LOAD_VERSION = 1; } else { fprintf(stderr, "****************************************\n"); diff --git a/library/tries/itries.c b/library/tries/itries.c index 5a1b66e9e..ef527a557 100644 --- a/library/tries/itries.c +++ b/library/tries/itries.c @@ -47,13 +47,13 @@ static int p_itrie_count_intersect(void); static int p_itrie_save(void); static int p_itrie_save_as_trie(void); static int p_itrie_load(void); +static int p_itrie_save2stream(void); +static int p_itrie_loadFromStream(void); static int p_itrie_stats(void); static int p_itrie_max_stats(void); static int p_itrie_usage(void); static int p_itrie_print(void); -//nf -static int p_itrie_loadFromStream(void); -static int p_itrie_save2stream(void); + /* -------------------------- */ @@ -85,13 +85,12 @@ void init_itries(void) { YAP_UserCPredicate("itrie_save", p_itrie_save, 2); YAP_UserCPredicate("itrie_save_as_trie", p_itrie_save_as_trie, 2); YAP_UserCPredicate("itrie_load", p_itrie_load, 2); + YAP_UserCPredicate("itrie_save2stream", p_itrie_save2stream, 2); + YAP_UserCPredicate("itrie_loadFromstream", p_itrie_loadFromStream, 2); YAP_UserCPredicate("itrie_stats", p_itrie_stats, 4); YAP_UserCPredicate("itrie_max_stats", p_itrie_max_stats, 4); YAP_UserCPredicate("itrie_usage", p_itrie_usage, 4); YAP_UserCPredicate("itrie_print", p_itrie_print, 1); - // nf - YAP_UserCPredicate("itrie_save2stream", p_itrie_save2stream, 2); - YAP_UserCPredicate("itrie_loadFromstream", p_itrie_loadFromStream, 2); return; } @@ -101,7 +100,7 @@ void init_itries(void) { /* Local Procedures */ /* -------------------------- */ -/* itrie_open(+Itrie) */ +/* itrie_open(-Itrie) */ #define arg_itrie YAP_ARG1 static int p_itrie_open(void) { TrEntry itrie; @@ -117,7 +116,7 @@ static int p_itrie_open(void) { #undef arg_itrie -/* itrie_close(-Itrie) */ +/* itrie_close(+Itrie) */ #define arg_itrie YAP_ARG1 static int p_itrie_close(void) { /* check arg */ @@ -138,7 +137,7 @@ static int p_itrie_close_all(void) { } -/* itrie_mode(-Itrie,?Mode) */ +/* itrie_mode(+Itrie,?Mode) */ #define arg_itrie YAP_ARG1 #define arg_mode YAP_ARG2 static int p_itrie_mode(void) { @@ -189,7 +188,7 @@ static int p_itrie_mode(void) { #undef arg_mode -/* itrie_timestamp(-Itrie,?Time) */ +/* itrie_timestamp(+Itrie,?Time) */ #define arg_itrie YAP_ARG1 #define arg_time YAP_ARG2 static int p_itrie_timestamp(void) { @@ -218,7 +217,7 @@ static int p_itrie_timestamp(void) { #undef arg_time -/* itrie_put_entry(-Itrie,-Entry) */ +/* itrie_put_entry(+Itrie,+Entry) */ #define arg_itrie YAP_ARG1 #define arg_entry YAP_ARG2 static int p_itrie_put_entry(void) { @@ -234,7 +233,7 @@ static int p_itrie_put_entry(void) { #undef arg_entry -/* itrie_update_entry(-Itrie,-Entry) */ +/* itrie_update_entry(+Itrie,+Entry) */ #define arg_itrie YAP_ARG1 #define arg_entry YAP_ARG2 static int p_itrie_update_entry(void) { @@ -250,7 +249,7 @@ static int p_itrie_update_entry(void) { #undef arg_entry -/* itrie_check_entry(-Itrie,-Entry,+Ref) */ +/* itrie_check_entry(+Itrie,+Entry,-Ref) */ #define arg_itrie YAP_ARG1 #define arg_entry YAP_ARG2 #define arg_ref YAP_ARG3 @@ -271,7 +270,7 @@ static int p_itrie_check_entry(void) { #undef arg_ref -/* itrie_get_entry(-Ref,+Entry) */ +/* itrie_get_entry(+Ref,-Entry) */ #define arg_ref YAP_ARG1 #define arg_entry YAP_ARG2 static int p_itrie_get_entry(void) { @@ -289,7 +288,7 @@ static int p_itrie_get_entry(void) { #undef arg_entry -/* itrie_get_data(-Ref,+Data) */ +/* itrie_get_data(+Ref,-Data) */ #define arg_ref YAP_ARG1 #define arg_data YAP_ARG2 static int p_itrie_get_data(void) { @@ -323,7 +322,7 @@ static int p_itrie_get_data(void) { #undef arg_data -/* itrie_traverse(-Itrie,+Ref) */ +/* itrie_traverse(+Itrie,-Ref) */ #define arg_itrie YAP_ARG1 #define arg_ref YAP_ARG2 static int p_itrie_traverse_init(void) { @@ -344,7 +343,7 @@ static int p_itrie_traverse_init(void) { #undef arg_ref -/* itrie_traverse(-Itrie,+Ref) */ +/* itrie_traverse(+Itrie,-Ref) */ #define arg_itrie YAP_ARG1 #define arg_ref YAP_ARG2 static int p_itrie_traverse_cont(void) { @@ -361,7 +360,7 @@ static int p_itrie_traverse_cont(void) { #undef arg_ref -/* itrie_remove_entry(-Ref) */ +/* itrie_remove_entry(+Ref) */ #define arg_ref YAP_ARG1 static int p_itrie_remove_entry(void) { /* check arg */ @@ -375,7 +374,7 @@ static int p_itrie_remove_entry(void) { #undef arg_ref -/* itrie_remove_subtree(-Ref) */ +/* itrie_remove_subtree(+Ref) */ #define arg_ref YAP_ARG1 static int p_itrie_remove_subtree(void) { /* check arg */ @@ -389,7 +388,7 @@ static int p_itrie_remove_subtree(void) { #undef arg_ref -/* itrie_add(-ItrieDest,-ItrieSource) */ +/* itrie_add(+ItrieDest,+ItrieSource) */ #define arg_itrie_dest YAP_ARG1 #define arg_itrie_source YAP_ARG2 static int p_itrie_add(void) { @@ -407,7 +406,7 @@ static int p_itrie_add(void) { #undef arg_itrie_source -/* itrie_subtract(-ItrieDest,-ItrieSource) */ +/* itrie_subtract(+ItrieDest,+ItrieSource) */ #define arg_itrie_dest YAP_ARG1 #define arg_itrie_source YAP_ARG2 static int p_itrie_subtract(void) { @@ -425,7 +424,7 @@ static int p_itrie_subtract(void) { #undef arg_itrie_source -/* itrie_join(-ItrieDest,-ItrieSource) */ +/* itrie_join(+ItrieDest,+ItrieSource) */ #define arg_itrie_dest YAP_ARG1 #define arg_itrie_source YAP_ARG2 static int p_itrie_join(void) { @@ -443,7 +442,7 @@ static int p_itrie_join(void) { #undef arg_itrie_source -/* itrie_intersect(-ItrieDest,-ItrieSource) */ +/* itrie_intersect(+ItrieDest,+ItrieSource) */ #define arg_itrie_dest YAP_ARG1 #define arg_itrie_source YAP_ARG2 static int p_itrie_intersect(void) { @@ -461,7 +460,7 @@ static int p_itrie_intersect(void) { #undef arg_itrie_source -/* itrie_count_join(-Itrie1,-Itrie2,+Entries) */ +/* itrie_count_join(+Itrie1,+Itrie2,-Entries) */ #define arg_itrie1 YAP_ARG1 #define arg_itrie2 YAP_ARG2 #define arg_entries YAP_ARG3 @@ -483,7 +482,7 @@ static int p_itrie_count_join(void) { #undef arg_entries -/* itrie_count_intersect(-Itrie1,-Itrie2,+Entries) */ +/* itrie_count_intersect(+Itrie1,+Itrie2,-Entries) */ #define arg_itrie1 YAP_ARG1 #define arg_itrie2 YAP_ARG2 #define arg_entries YAP_ARG3 @@ -505,7 +504,7 @@ static int p_itrie_count_intersect(void) { #undef arg_entries -/* itrie_save(-Itrie,-FileName) */ +/* itrie_save(+Itrie,+FileName) */ #define arg_itrie YAP_ARG1 #define arg_file YAP_ARG2 static int p_itrie_save(void) { @@ -533,7 +532,7 @@ static int p_itrie_save(void) { #undef arg_file -/* itrie_save_as_trie(-Itrie,-FileName) */ +/* itrie_save_as_trie(+Itrie,+FileName) */ #define arg_itrie YAP_ARG1 #define arg_file YAP_ARG2 static int p_itrie_save_as_trie(void) { @@ -561,7 +560,7 @@ static int p_itrie_save_as_trie(void) { #undef arg_file -/* itrie_load(+Itrie,-FileName) */ +/* itrie_load(-Itrie,+FileName) */ #define arg_itrie YAP_ARG1 #define arg_file YAP_ARG2 static int p_itrie_load(void) { @@ -581,10 +580,9 @@ static int p_itrie_load(void) { return FALSE; /* load itrie and close file */ - itrie = itrie_load(file); - if (fclose(file)) + if (!(itrie = itrie_load(file))) return FALSE; - if (!itrie) + if (fclose(file)) return FALSE; return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie)); } @@ -592,7 +590,49 @@ static int p_itrie_load(void) { #undef arg_file -/* itrie_stats(+Memory,+Tries,+Entries,+Nodes) */ +/* itrie_save2stream(+Itrie,+Stream) */ +#define arg_itrie YAP_ARG1 +#define arg_stream YAP_ARG2 +static int p_itrie_save2stream(void) { + FILE *file; + + /* check args */ + if (!YAP_IsIntTerm(arg_itrie)) + return FALSE; + if ((file = (FILE*) YAP_FileDescriptorFromStream(arg_stream)) == NULL) + return FALSE; + + /* save itrie */ + itrie_save((TrEntry) YAP_IntOfTerm(arg_itrie), file); + return TRUE; +} +#undef arg_itrie +#undef arg_stream + + +/* itrie_loadFromStream(-Itrie,+Stream) */ +#define arg_itrie YAP_ARG1 +#define arg_stream YAP_ARG2 +static int p_itrie_loadFromStream(void) { + TrEntry itrie; + FILE *file; + + /* check args */ + if (!YAP_IsVarTerm(arg_itrie)) + return FALSE; + if (!(file = (FILE*) Yap_FileDescriptorFromStream(arg_stream))) + return FALSE; + + /* load itrie */ + if (!(itrie = itrie_load(file))) + return FALSE; + return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie)); +} +#undef arg_itrie +#undef arg_stream + + +/* itrie_stats(-Memory,-Tries,-Entries,-Nodes) */ #define arg_memory YAP_ARG1 #define arg_tries YAP_ARG2 #define arg_entries YAP_ARG3 @@ -618,7 +658,7 @@ static int p_itrie_stats(void) { #undef arg_nodes -/* itrie_max_stats(+Memory,+Tries,+Entries,+Nodes) */ +/* itrie_max_stats(-Memory,-Tries,-Entries,-Nodes) */ #define arg_memory YAP_ARG1 #define arg_tries YAP_ARG2 #define arg_entries YAP_ARG3 @@ -644,7 +684,7 @@ static int p_itrie_max_stats(void) { #undef arg_nodes -/* itrie_usage(-Itrie,+Entries,+Nodes,+VirtualNodes) */ +/* itrie_usage(+Itrie,-Entries,-Nodes,-VirtualNodes) */ #define arg_itrie YAP_ARG1 #define arg_entries YAP_ARG2 #define arg_nodes YAP_ARG3 @@ -672,7 +712,7 @@ static int p_itrie_usage(void) { #undef arg_virtualnodes -/* itrie_print(-Itrie) */ +/* itrie_print(+Itrie) */ #define arg_itrie YAP_ARG1 static int p_itrie_print(void) { /* check arg */ @@ -684,44 +724,3 @@ static int p_itrie_print(void) { return TRUE; } #undef arg_itrie - -/* added by nf: itrie_save2stream(+Itrie,+Stream) */ -#define arg_itrie YAP_ARG1 -#define arg_stream YAP_ARG2 -static int p_itrie_save2stream(void) { - FILE *file; - - /* check args */ - if (!YAP_IsIntTerm(arg_itrie)) - return FALSE; - if ((file=(FILE*)YAP_FileDescriptorFromStream(arg_stream))==NULL) - return FALSE; - - /* save itrie and close file */ - itrie_save((TrEntry) YAP_IntOfTerm(arg_itrie), file); - return TRUE; -} -#undef arg_itrie -#undef arg_stream - -/* added by nf: itrie_loadFromStream(-Itrie,+Stream) */ -#define arg_itrie YAP_ARG1 -#define arg_stream YAP_ARG2 -static int p_itrie_loadFromStream(void) { - TrEntry itrie; - FILE *file; - - /* check args */ - if (!YAP_IsVarTerm(arg_itrie)) - return FALSE; - if (!(file=(FILE*)Yap_FileDescriptorFromStream(arg_stream))) - return FALSE; - - /* load itrie and close file */ - itrie = itrie_load(file); - if (!itrie) - return FALSE; - return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie)); -} -#undef arg_itrie -#undef arg_stream diff --git a/library/tries/tries.c b/library/tries/tries.c index 111cd89c1..9e58fc1fb 100644 --- a/library/tries/tries.c +++ b/library/tries/tries.c @@ -104,13 +104,13 @@ void init_tries(void) { /* Backwards Compatibility */ /* --------------------------------- */ -/* open_trie(+Trie) */ +/* open_trie(-Trie) */ static int p_open_trie(void) { return p_trie_open(); } -/* close_trie(-Trie) */ +/* close_trie(+Trie) */ static int p_close_trie(void) { return p_trie_close(); } @@ -122,7 +122,7 @@ static int p_close_all_tries(void) { } -/* put_trie_entry(-Mode,-Trie,-Entry,+Ref) */ +/* put_trie_entry(+Mode,+Trie,+Entry,-Ref) */ #define arg_mode YAP_ARG1 #define arg_trie YAP_ARG2 #define arg_entry YAP_ARG3 @@ -156,7 +156,7 @@ static int p_put_trie_entry(void) { #undef arg_ref -/* get_trie_entry(-Mode,-Ref,+Entry) */ +/* get_trie_entry(+Mode,+Ref,-Entry) */ #define arg_mode YAP_ARG1 #define arg_ref YAP_ARG2 #define arg_entry YAP_ARG3 @@ -188,13 +188,13 @@ static int p_get_trie_entry(void) { #undef arg_entry -/* remove_trie_entry(-Ref) */ +/* remove_trie_entry(+Ref) */ static int p_remove_trie_entry(void) { return p_trie_remove_entry(); } -/* print_trie(-Trie) */ +/* print_trie(+Trie) */ static int p_print_trie(void) { return p_trie_print(); } @@ -205,7 +205,7 @@ static int p_print_trie(void) { /* Local Procedures */ /* -------------------------- */ -/* trie_open(+Trie) */ +/* trie_open(-Trie) */ #define arg_trie YAP_ARG1 static int p_trie_open(void) { TrEntry trie; @@ -221,7 +221,7 @@ static int p_trie_open(void) { #undef arg_trie -/* trie_close(-Trie) */ +/* trie_close(+Trie) */ #define arg_trie YAP_ARG1 static int p_trie_close(void) { /* check arg */ @@ -275,7 +275,7 @@ static int p_trie_mode(void) { #undef arg_mode -/* trie_put_entry(-Trie,-Entry,+Ref) */ +/* trie_put_entry(+Trie,+Entry,-Ref) */ #define arg_trie YAP_ARG1 #define arg_entry YAP_ARG2 #define arg_ref YAP_ARG3 @@ -295,7 +295,7 @@ static int p_trie_put_entry(void) { #undef arg_ref -/* trie_check_entry(-Trie,-Entry,+Ref) */ +/* trie_check_entry(+Trie,+Entry,-Ref) */ #define arg_trie YAP_ARG1 #define arg_entry YAP_ARG2 #define arg_ref YAP_ARG3 @@ -316,7 +316,7 @@ static int p_trie_check_entry(void) { #undef arg_ref -/* trie_get_entry(-Ref,+Entry) */ +/* trie_get_entry(+Ref,-Entry) */ #define arg_ref YAP_ARG1 #define arg_entry YAP_ARG2 static int p_trie_get_entry(void) { @@ -334,7 +334,7 @@ static int p_trie_get_entry(void) { #undef arg_entry -/* trie_get_first_entry(-Trie,+Ref) */ +/* trie_get_first_entry(+Trie,-Ref) */ #define arg_trie YAP_ARG1 #define arg_ref YAP_ARG2 static int p_trie_get_first_entry(void) { @@ -353,7 +353,7 @@ static int p_trie_get_first_entry(void) { #undef arg_ref -/* trie_get_last_entry(-Trie,+Ref) */ +/* trie_get_last_entry(+Trie,-Ref) */ #define arg_trie YAP_ARG1 #define arg_ref YAP_ARG2 static int p_trie_get_last_entry(void) { @@ -372,7 +372,7 @@ static int p_trie_get_last_entry(void) { #undef arg_ref -/* trie_traverse(-Trie,-FirstRef,+Ref) */ +/* trie_traverse(+Trie,+FirstRef,-Ref) */ #define arg_trie YAP_ARG1 #define arg_init_ref YAP_ARG2 #define arg_ref YAP_ARG3 @@ -397,7 +397,7 @@ static int p_trie_traverse_init(void) { #undef arg_ref -/* trie_traverse(-Trie,-FirstRef,+Ref) */ +/* trie_traverse(+Trie,+FirstRef,-Ref) */ #define arg_trie YAP_ARG1 #define arg_init_ref YAP_ARG2 #define arg_ref YAP_ARG3 @@ -416,7 +416,7 @@ static int p_trie_traverse_cont(void) { #undef arg_ref -/* trie_remove_entry(-Ref) */ +/* trie_remove_entry(+Ref) */ #define arg_ref YAP_ARG1 static int p_trie_remove_entry(void) { /* check arg */ @@ -430,7 +430,7 @@ static int p_trie_remove_entry(void) { #undef arg_ref -/* trie_remove_subtree(-Ref) */ +/* trie_remove_subtree(+Ref) */ #define arg_ref YAP_ARG1 static int p_trie_remove_subtree(void) { /* check arg */ @@ -444,7 +444,7 @@ static int p_trie_remove_subtree(void) { #undef arg_ref -/* trie_join(-TrieDest,-TrieSource) */ +/* trie_join(+TrieDest,+TrieSource) */ #define arg_trie_dest YAP_ARG1 #define arg_trie_source YAP_ARG2 static int p_trie_join(void) { @@ -462,7 +462,7 @@ static int p_trie_join(void) { #undef arg_trie_source -/* trie_intersect(-TrieDest,-TrieSource) */ +/* trie_intersect(+TrieDest,+TrieSource) */ #define arg_trie_dest YAP_ARG1 #define arg_trie_source YAP_ARG2 static int p_trie_intersect(void) { @@ -480,7 +480,7 @@ static int p_trie_intersect(void) { #undef arg_trie_source -/* trie_count_join(-Trie1,-Trie2,+Entries) */ +/* trie_count_join(+Trie1,+Trie2,-Entries) */ #define arg_trie1 YAP_ARG1 #define arg_trie2 YAP_ARG2 #define arg_entries YAP_ARG3 @@ -502,7 +502,7 @@ static int p_trie_count_join(void) { #undef arg_entries -/* trie_count_intersect(-Trie1,-Trie2,+Entries) */ +/* trie_count_intersect(+Trie1,+Trie2,-Entries) */ #define arg_trie1 YAP_ARG1 #define arg_trie2 YAP_ARG2 #define arg_entries YAP_ARG3 @@ -524,7 +524,7 @@ static int p_trie_count_intersect(void) { #undef arg_entries -/* trie_save(-Trie,-FileName) */ +/* trie_save(+Trie,+FileName) */ #define arg_trie YAP_ARG1 #define arg_file YAP_ARG2 static int p_trie_save(void) { @@ -552,7 +552,7 @@ static int p_trie_save(void) { #undef arg_file -/* trie_load(+Trie,-FileName) */ +/* trie_load(-Trie,+FileName) */ #define arg_trie YAP_ARG1 #define arg_file YAP_ARG2 static int p_trie_load(void) { @@ -572,10 +572,9 @@ static int p_trie_load(void) { return FALSE; /* load trie and close file */ - data = trie_load(file); - if (fclose(file)) + if (!(data = trie_load(file))) return FALSE; - if (!data) + if (fclose(file)) return FALSE; return YAP_Unify(arg_trie, YAP_MkIntTerm((YAP_Int) data)); } @@ -583,7 +582,7 @@ static int p_trie_load(void) { #undef arg_file -/* trie_stats(+Memory,+Tries,+Entries,+Nodes) */ +/* trie_stats(-Memory,-Tries,-Entries,-Nodes) */ #define arg_memory YAP_ARG1 #define arg_tries YAP_ARG2 #define arg_entries YAP_ARG3 @@ -609,7 +608,7 @@ static int p_trie_stats(void) { #undef arg_nodes -/* trie_max_stats(+Memory,+Tries,+Entries,+Nodes) */ +/* trie_max_stats(-Memory,-Tries,-Entries,-Nodes) */ #define arg_memory YAP_ARG1 #define arg_tries YAP_ARG2 #define arg_entries YAP_ARG3 @@ -635,7 +634,7 @@ static int p_trie_max_stats(void) { #undef arg_nodes -/* trie_usage(-Trie,+Entries,+Nodes,+VirtualNodes) */ +/* trie_usage(+Trie,-Entries,-Nodes,-VirtualNodes) */ #define arg_trie YAP_ARG1 #define arg_entries YAP_ARG2 #define arg_nodes YAP_ARG3 @@ -663,7 +662,7 @@ static int p_trie_usage(void) { #undef arg_virtualnodes -/* trie_print(-Trie) */ +/* trie_print(+Trie) */ #define arg_trie YAP_ARG1 static int p_trie_print(void) { /* check arg */ diff --git a/library/yap2swi/yap2swi.c b/library/yap2swi/yap2swi.c index d69e82864..394442b5e 100755 --- a/library/yap2swi/yap2swi.c +++ b/library/yap2swi/yap2swi.c @@ -1858,11 +1858,14 @@ PL_record(term_t ts) return (record_t)Yap_StoreTermInDB(t, 0); } -X_API void +X_API int PL_recorded(record_t db, term_t ts) { Term t = Yap_FetchTermFromDB((DBTerm *)db); + if (t == 0L) + return FALSE; Yap_PutInSlot(ts,t); + return TRUE; } X_API void @@ -1959,6 +1962,12 @@ PL_exception(qid_t q) } } +X_API void +PL_clear_exception(void) +{ + EX = 0L; +} + X_API int PL_initialise(int myargc, char **myargv) { diff --git a/misc/yap.nsi b/misc/yap.nsi old mode 100644 new mode 100755 index 289d551e0..3a7901cb3 --- a/misc/yap.nsi +++ b/misc/yap.nsi @@ -29,7 +29,7 @@ ComponentText "This will install YAP on your computer." DirText "This program will install YAP on your computer.\ Choose a directory" -LicenseData c:\Yap\share\docs\Artistic +LicenseData c:\Yap\share\docs\Yap\Artistic LicenseText "YAP is governed by the Artistic License,\ but includes code under the GPL and LGPL." @@ -53,16 +53,7 @@ Section "Base system (required)" SetOutPath $INSTDIR\bin ; SYSTEM STUFF - File c:\Yap\lib\Yap\matrix.dll - File c:\Yap\lib\Yap\plterm.dll - File c:\Yap\lib\Yap\random.dll - File c:\Yap\lib\Yap\regcomp.dll - File c:\Yap\lib\Yap\regerror.dll - File c:\Yap\lib\Yap\regexec.dll - File c:\Yap\lib\Yap\regexp.dll - File c:\Yap\lib\Yap\regfree.dll - File c:\Yap\lib\Yap\sys.dll - File c:\Yap\lib\Yap\yap_tries.dll + File c:\Yap\lib\Yap\*.dll SetOutPath $INSTDIR\lib ; SYSTEM STUFF @@ -76,12 +67,12 @@ Section "Base system (required)" ; SYSTEM STUFF File /r c:\Yap\share\Yap\* - SetOutPath $INSTDIR\docs - File c:\Yap\share\docs\yap.html - File c:\Yap\share\docs\yap.pdf - File c:\Yap\share\docs\Artistic - File c:\Yap\share\docs\README.TXT - File c:\Yap\share\docs\COPYING.TXT + SetOutPath $INSTDIR\docs\Yap + File c:\Yap\share\docs\Yap\yap.html + File c:\Yap\share\docs\Yap\yap.pdf + File c:\Yap\share\docs\Yap\Artistic + File c:\Yap\share\docs\Yap\README.TXT + File c:\Yap\share\docs\Yap\COPYING.TXT WriteRegStr HKLM ${REGKEY} "home" "$INSTDIR" WriteRegStr HKLM ${REGKEY} "startup" "$INSTDIR\lib\startup.yss" @@ -277,4 +268,4 @@ Function .onInstFailed installer, please contact yap-users@sf.net" FunctionEnd -outfile "yap-5.1.4-installer.exe" +outfile "yap-6.0.0-installer.exe" diff --git a/packages/PLStream/Makefile.in b/packages/PLStream/Makefile.in index 965b4ceaf..0f6eb492a 100755 --- a/packages/PLStream/Makefile.in +++ b/packages/PLStream/Makefile.in @@ -46,7 +46,7 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h \ $(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \ $(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/pl-utf8.c $(srcdir)/uxnt/uxnt.h C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \ - $(srcdir)/pl-error.c $(srcdir)/pl-feature.c \ + $(srcdir)/pl-error.c \ $(srcdir)/pl-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \ $(srcdir)/pl-privitf.c \ $(srcdir)/pl-stream.c $(srcdir)/pl-string.c \ @@ -54,7 +54,7 @@ C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \ $(srcdir)/pl-text.c \ $(srcdir)/pl-utils.c \ $(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.c -OBJS=pl-buffer.o pl-ctype.o pl-error.o pl-feature.o \ +OBJS=pl-buffer.o pl-ctype.o pl-error.o \ pl-file.o pl-files.o pl-os.o pl-privitf.o \ pl-stream.o pl-string.o pl-table.o \ pl-text.o pl-utils.o pl-utf8.o \ diff --git a/packages/PLStream/atoms.h b/packages/PLStream/atoms.h index a1849a08e..f760ef301 100644 --- a/packages/PLStream/atoms.h +++ b/packages/PLStream/atoms.h @@ -504,6 +504,7 @@ #define ATOM_term_position MK_ATOM("term_position") #define ATOM_terminal MK_ATOM("terminal") #define ATOM_terminal_capability MK_ATOM("terminal_capability") +#define ATOM_temporary_files MK_ATOM("temporary_files") #define ATOM_text MK_ATOM("text") #define ATOM_thread MK_ATOM("thread") #define ATOM_thread_cputime MK_ATOM("thread_cputime") diff --git a/packages/PLStream/pl-ctype.c b/packages/PLStream/pl-ctype.c index 313a6ebb1..ce34c51df 100644 --- a/packages/PLStream/pl-ctype.c +++ b/packages/PLStream/pl-ctype.c @@ -298,7 +298,8 @@ unify_char_type(term_t type, const char_type *ct, int context, int how) static foreign_t do_char_type(term_t chr, term_t class, control_t h, int how) -{ generator *gen; +{ GET_LD + generator *gen; fid_t fid; switch( ForeignControl(h) ) @@ -399,7 +400,9 @@ do_char_type(term_t chr, term_t class, control_t h, int how) succeed; } - fid = PL_open_foreign_frame(); + if ( !(fid = PL_open_foreign_frame()) ) + goto error; + for(;;) { int rval; @@ -412,7 +415,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how) { if ( rval < 0 || !unify_char_type(class, gen->class, rval, how) ) goto next; - + } else if ( gen->do_enum & ENUM_CLASS ) { if ( !unify_char_type(class, gen->class, rval, how) ) goto next; @@ -432,6 +435,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how) break; } +error: freeHeap(gen, sizeof(*gen)); fail; } @@ -440,13 +444,13 @@ do_char_type(term_t chr, term_t class, control_t h, int how) static PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC) -{ return do_char_type(A1, A2, PL__ctx, CHAR_MODE); +{ return do_char_type(A1, A2, PL__ctx, PL_CHAR); } static PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC) -{ return do_char_type(A1, A2, PL__ctx, CODE_MODE); +{ return do_char_type(A1, A2, PL__ctx, PL_CODE); } @@ -513,7 +517,8 @@ get_chr_from_text(const PL_chars_t *t, size_t index) static foreign_t modify_case_atom(term_t in, term_t out, int down) -{ PL_chars_t tin, tout; +{ GET_LD + PL_chars_t tin, tout; if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) ) return FALSE; @@ -578,7 +583,7 @@ modify_case_atom(term_t in, term_t out, int down) { tout.text.t[i] = (char)c; } } - } + } } else { if ( down ) { for(i=0; i ? 48-63 */ - DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY, + DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY, /* @ A B C D E F G H I J K L M N O 64-79 */ - SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, + SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, /* P Q R S T U V W X Y Z [ \ ] ^ _ 80-95 */ - UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC, + UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC, /* ` a b c d e f g h i j k l m n o 96-111 */ - SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, + SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, /* p q r s t u v w x y z { | } ~ ^? 112-127 */ - LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT, + LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT, /* 128-159 (C1 controls) */ - CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, - CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, + CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, + CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, /* 160-255 (G1 graphics) */ /* ISO Latin 1 is assumed */ SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO, - SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO, + SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, SO, UC, UC, UC, UC, UC, UC, UC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, @@ -840,7 +841,9 @@ static const enc_map map[] = IOENC initEncoding(void) -{ if ( LD ) +{ GET_LD + + if ( LD ) { if ( !LD->encoding ) { char *enc; @@ -882,7 +885,8 @@ initCharTypes(void) #if __SWI_PROLOG__ bool systemMode(bool accept) -{ bool old = SYSTEM_MODE ? TRUE : FALSE; +{ GET_LD + bool old = SYSTEM_MODE ? TRUE : FALSE; if ( accept ) debugstatus.styleCheck |= DOLLAR_STYLE; diff --git a/packages/PLStream/pl-feature.c b/packages/PLStream/pl-feature.c deleted file mode 100644 index c0ebc08fe..000000000 --- a/packages/PLStream/pl-feature.c +++ /dev/null @@ -1,10 +0,0 @@ -int defFeature(const char *c, int f, ...) { -/**** add extra flags to engine: nowadays PL_set_prolog_flag */ - return 0; -} - -int trueFeature(int f) { -/**** define whether the feature is set or not */ - return 0; -} - diff --git a/packages/PLStream/pl-file.c b/packages/PLStream/pl-file.c index 1a690525c..559fea0ad 100755 --- a/packages/PLStream/pl-file.c +++ b/packages/PLStream/pl-file.c @@ -69,7 +69,7 @@ handling times must be cleaned, but that not only holds for this module. #undef LD /* fetch LD once per function */ #define LD LOCAL_LD -static int bad_encoding(atom_t name); +static int bad_encoding(const char *msg, atom_t name); static int noprotocol(void); static int streamStatus(IOSTREAM *s); @@ -261,9 +261,13 @@ freeStream(IOSTREAM *s) if ( (symb=lookupHTable(streamContext, s)) ) { stream_context *ctx = symb->value; - if ( ctx->filename == source_file_name ) - { source_file_name = NULL_ATOM; /* TBD: pop? */ - source_line_no = -1; + if ( ctx->filename != NULL_ATOM ) + { PL_unregister_atom(ctx->filename); + + if ( ctx->filename == source_file_name ) + { source_file_name = NULL_ATOM; /* TBD: pop? */ + source_line_no = -1; + } } freeHeap(ctx, sizeof(*ctx)); @@ -289,10 +293,18 @@ freeStream(IOSTREAM *s) /* MT: locked by caller (openStream()) */ +/* name must be registered by the caller */ static void setFileNameStream(IOSTREAM *s, atom_t name) -{ getStreamContext(s)->filename = name; +{ stream_context *ctx = getStreamContext(s); + + if ( ctx->filename ) + { PL_unregister_atom(ctx->filename); + ctx->filename = NULL_ATOM; + } + if ( name != NULL_ATOM ) + ctx->filename = name; } @@ -520,13 +532,17 @@ PL_unify_stream_or_alias(term_t t, IOSTREAM *s) } else { term_t a = PL_new_term_ref(); - PL_put_pointer(a, s); - PL_cons_functor(a, FUNCTOR_dstream1, a); - - rval = PL_unify(t, a); + rval = ( (a=PL_new_term_ref()) && + PL_put_pointer(a, s) && + PL_cons_functor(a, FUNCTOR_dstream1, a) && + PL_unify(t, a) + ); } UNLOCK(); + if ( !rval && !PL_is_variable(t) ) + return PL_error(NULL, 0, "stream-argument", ERR_MUST_BE_VAR, 0); + return rval; } @@ -541,8 +557,10 @@ PL_unify_stream(term_t t, IOSTREAM *s) ctx = getStreamContext(s); UNLOCK(); - PL_put_pointer(a, s); - PL_cons_functor(a, FUNCTOR_dstream1, a); + if ( !(a = PL_new_term_ref()) || + !PL_put_pointer(a, s) || + !PL_cons_functor(a, FUNCTOR_dstream1, a) ) + return FALSE; /* resource error */ if ( PL_unify(t, a) ) return TRUE; @@ -666,14 +684,21 @@ reportStreamError(IOSTREAM *s) if ( (s->flags & SIO_FERR) ) { if ( s->exception ) - { fid_t fid = PL_open_foreign_frame(); - term_t ex = PL_new_term_ref(); - PL_recorded(s->exception, ex); + { fid_t fid; + term_t ex; + int rc; + + LD->exception.processing = TRUE; /* allow using spare stack */ + if ( !(fid = PL_open_foreign_frame()) ) + return FALSE; + ex = PL_new_term_ref(); + rc = PL_recorded(s->exception, ex); PL_erase(s->exception); s->exception = NULL; - PL_raise_exception(ex); + if ( rc ) + rc = PL_raise_exception(ex); PL_close_foreign_frame(fid); - return FALSE; + return rc; } if ( s->flags & SIO_INPUT ) @@ -1038,11 +1063,11 @@ closeOutputRedirect(redir_context *ctx) rval = PL_unify_wchars_diff(out, tail, ctx->out_format, ctx->size/sizeof(wchar_t), (wchar_t*)ctx->data); - if ( tail ) + if ( rval && tail ) rval = PL_unify(tail, diff); if ( ctx->data != ctx->buffer ) - free(ctx->data); + Sfree(ctx->data); } return rval; @@ -1064,7 +1089,7 @@ discardOutputRedirect(redir_context *ctx) } else { closeStream(ctx->stream); if ( ctx->data != ctx->buffer ) - free(ctx->data); + Sfree(ctx->data); } } @@ -1397,6 +1422,22 @@ PRED_IMPL("set_stream", 2, set_stream, 0) goto error; } + goto ok; + } else if ( aname == ATOM_type ) /* type(Type) */ + { atom_t type; + + if ( !PL_get_atom_ex(a, &type) ) + return FALSE; + if ( type == ATOM_text ) + { s->flags |= SIO_TEXT; + } else if ( type == ATOM_binary ) + { s->flags &= ~SIO_TEXT; + } else + { PL_error("set_stream", 2, NULL, ERR_DOMAIN, + ATOM_type, a); + goto error; + } + goto ok; } else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */ { int close; @@ -1428,6 +1469,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0) if ( !PL_get_atom_ex(a, &fn) ) goto error; + PL_register_atom(fn); LOCK(); setFileNameStream(s, fn); UNLOCK(); @@ -1467,7 +1509,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0) if ( !PL_get_atom_ex(a, &val) ) goto error; if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN ) - { bad_encoding(val); + { bad_encoding(NULL, val); goto error; } @@ -2191,7 +2233,12 @@ PRED_IMPL("get_single_char", 1, get_single_char, 0) int c = getSingleChar(s, TRUE); if ( c == EOF ) - { PL_unify_integer(A1, -1); + { if ( PL_exception(0) ) + { releaseStream(s); + return FALSE; + } + + PL_unify_integer(A1, -1); return streamStatus(s); } @@ -2512,12 +2559,12 @@ encoding_to_atom(IOENC enc) static int -bad_encoding(atom_t name) +bad_encoding(const char *msg, atom_t name) { GET_LD term_t t = PL_new_term_ref(); PL_put_atom(t, name); - return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, t); + return PL_error(NULL, 0, msg, ERR_DOMAIN, ATOM_encoding, t); } @@ -2630,10 +2677,23 @@ openStream(term_t file, term_t mode, term_t options) if ( encoding != NULL_ATOM ) { enc = atom_to_encoding(encoding); if ( enc == ENC_UNKNOWN ) - { bad_encoding(encoding); - + { bad_encoding(NULL, encoding); return NULL; } + if ( type == ATOM_binary && enc != ENC_OCTET ) + { bad_encoding("type(binary) implies encoding(octet)", encoding); + return NULL; + } + switch(enc) /* explicitely specified: do not */ + { case ENC_OCTET: /* switch to Unicode. For implicit */ + case ENC_ASCII: /* and unicode types we must detect */ + case ENC_ISO_LATIN_1: /* and skip the BOM */ + case ENC_WCHAR: + bom = FALSE; + break; + default: + ; + } } else if ( type == ATOM_binary ) { enc = ENC_OCTET; bom = FALSE; @@ -2675,10 +2735,12 @@ openStream(term_t file, term_t mode, term_t options) } #ifdef HAVE_POPEN else if ( PL_is_functor(file, FUNCTOR_pipe1) ) - { term_t a = PL_new_term_ref(); + { term_t a; char *cmd; - PL_get_arg(1, file, a); + PL_clear_exception(); + a = PL_new_term_ref(); + _PL_get_arg(1, file, a); if ( !PL_get_chars(a, &cmd, CVT_ATOM|CVT_STRING|REP_FN) ) { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a); return NULL; @@ -3520,7 +3582,15 @@ PRED_IMPL("stream_property", 2, stream_property, } - fid = PL_open_foreign_frame(); + if ( !(fid = PL_open_foreign_frame()) ) + { error: + + if ( pe->e ) + freeTableEnum(pe->e); + + freeHeap(pe, sizeof(*pe)); + return FALSE; + } for(;;) { if ( pe->s ) /* given stream */ @@ -3531,7 +3601,8 @@ PRED_IMPL("stream_property", 2, stream_property, goto enum_e; } - fid2 = PL_open_foreign_frame(); + if ( !(fid2 = PL_open_foreign_frame()) ) + goto error; for( ; pe->p->functor ; pe->p++ ) { if ( PL_unify_functor(property, pe->p->functor) ) { int rval; @@ -3559,6 +3630,9 @@ PRED_IMPL("stream_property", 2, stream_property, } } + if ( exception_term ) + goto error; + if ( pe->fixed_p ) break; PL_rewind_foreign_frame(fid2); @@ -3579,6 +3653,8 @@ PRED_IMPL("stream_property", 2, stream_property, pe->p = sprop_list; break; } + if ( exception_term ) + goto error; } } @@ -4081,11 +4157,16 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0) { PRED_LD IOSTREAM *in = NULL, *out = NULL, *error = NULL; int rval = FALSE; + int wrapin = FALSE; - if ( !PL_get_stream_handle(A1, &in) || - !PL_get_stream_handle(A2, &out) ) + if ( !get_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED) || + !get_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS) ) goto out; + wrapin = (LD->IO.streams[0] != in); + if ( wrapin ) + in = getStream(in); /* lock it */ + if ( PL_compare(A2, A3) == 0 ) /* == */ { error = getStream(Snew(out->handle, out->flags, out->functions)); error->flags &= ~SIO_ABUF; /* disable buffering */ @@ -4099,20 +4180,22 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0) out->flags &= ~SIO_ABUF; /* output: line buffered */ out->flags |= SIO_LBUF; - LD->IO.streams[0] = in; /* user_input */ LD->IO.streams[1] = out; /* user_output */ LD->IO.streams[2] = error; /* user_error */ - LD->IO.streams[3] = in; /* current_input */ LD->IO.streams[4] = out; /* current_output */ - wrapIO(in, Sread_user, NULL); - LD->prompt.next = TRUE; + if ( wrapin ) + { LD->IO.streams[3] = in; /* current_input */ + LD->IO.streams[0] = in; /* user_input */ + wrapIO(in, Sread_user, NULL); + LD->prompt.next = TRUE; + } UNLOCK(); rval = TRUE; out: - if ( in ) + if ( wrapin && in ) releaseStream(in); if ( out ) releaseStream(out); diff --git a/packages/PLStream/pl-files.c b/packages/PLStream/pl-files.c index 2344a6b86..31a5d7b7e 100755 --- a/packages/PLStream/pl-files.c +++ b/packages/PLStream/pl-files.c @@ -351,21 +351,25 @@ MarkExecutable(const char *name) * FIND FILES FROM C * *********************************/ -int +static int unifyTime(term_t t, time_t time) { return PL_unify_float(t, (double)time); } -static void +static int add_option(term_t options, functor_t f, atom_t val) { GET_LD - term_t head = PL_new_term_ref(); + term_t head; - PL_unify_list(options, head, options); - PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val); + if ( (head=PL_new_term_ref()) && + PL_unify_list(options, head, options) && + PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val) ) + { PL_reset_term_refs(head); + return TRUE; + } - PL_reset_term_refs(head); + return FALSE; } #define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST) @@ -378,29 +382,36 @@ PL_get_file_name(term_t n, char **namep, int flags) char ospath[MAXPATHLEN]; if ( flags & PL_FILE_SEARCH ) - { predicate_t pred = PL_predicate("absolute_file_name", 3, "system"); - term_t av = PL_new_term_refs(3); - term_t options = PL_copy_term_ref(av+2); - int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION - : PL_Q_PASS_EXCEPTION); + { fid_t fid; - PL_put_term(av+0, n); + if ( (fid = PL_open_foreign_frame()) ) + { predicate_t pred = PL_predicate("absolute_file_name", 3, "system"); + term_t av = PL_new_term_refs(3); + term_t options = PL_copy_term_ref(av+2); + int rc = TRUE; + int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION + : PL_Q_PASS_EXCEPTION); - if ( flags & PL_FILE_EXIST ) - add_option(options, FUNCTOR_access1, ATOM_exist); - if ( flags & PL_FILE_READ ) - add_option(options, FUNCTOR_access1, ATOM_read); - if ( flags & PL_FILE_WRITE ) - add_option(options, FUNCTOR_access1, ATOM_write); - if ( flags & PL_FILE_EXECUTE ) - add_option(options, FUNCTOR_access1, ATOM_execute); + PL_put_term(av+0, n); - PL_unify_nil(options); + if ( rc && flags & PL_FILE_EXIST ) + rc = add_option(options, FUNCTOR_access1, ATOM_exist); + if ( rc && flags & PL_FILE_READ ) + rc = add_option(options, FUNCTOR_access1, ATOM_read); + if ( rc && flags & PL_FILE_WRITE ) + rc = add_option(options, FUNCTOR_access1, ATOM_write); + if ( rc && flags & PL_FILE_EXECUTE ) + rc = add_option(options, FUNCTOR_access1, ATOM_execute); - if ( !PL_call_predicate(NULL, cflags, pred, av) ) - return FALSE; + if ( rc ) rc = PL_unify_nil(options); + if ( rc ) rc = PL_call_predicate(NULL, cflags, pred, av); + if ( rc ) rc = PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN); - return PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN); + PL_discard_foreign_frame(fid); + return rc; + } + + return FALSE; } if ( flags & PL_FILE_NOERRORS ) @@ -642,9 +653,51 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0) if ( !PL_get_chars(base, &n, CVT_ALL) ) return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base); - return PL_unify_atom(name, TemporaryFile(n)); + return PL_unify_atom(name, TemporaryFile(n, NULL)); } +/** tmp_file_stream(+Mode, -File, -Stream) +*/ + +static +PRED_IMPL("tmp_file_stream", 3, tmp_file_stream, 0) +{ PRED_LD + atom_t fn; + int fd; + IOENC enc; + atom_t encoding; + const char *mode; + + if ( !PL_get_atom_ex(A1, &encoding) ) + return FALSE; + if ( (enc = atom_to_encoding(encoding)) == ENC_UNKNOWN ) + { if ( encoding == ATOM_binary ) + { enc = ENC_OCTET; + mode = "wb"; + } else + { return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, A1); + } + } else + { mode = "w"; + } + + if ( (fn=TemporaryFile("", &fd)) ) + { IOSTREAM *s; + + if ( !PL_unify_atom(A2, fn) ) + { close(fd); + return PL_error(NULL, 0, NULL, ERR_MUST_BE_VAR, 2); + } + + s = Sfdopen(fd, mode); + s->encoding = enc; + return PL_unify_stream(A3, s); + } else + { return PL_error(NULL, 0, NULL, ERR_RESOURCE, ATOM_temporary_files); + } +} + + /******************************* * CHANGE FILESYSTEM * @@ -653,7 +706,13 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0) static PRED_IMPL("delete_file", 1, delete_file, 0) -{ char *n; +{ PRED_LD + char *n; + atom_t aname; + + if ( PL_get_atom(A1, &aname) && + DeleteTemporaryFile(aname) ) + return TRUE; if ( !PL_get_file_name(A1, &n, 0) ) return FALSE; @@ -662,7 +721,7 @@ PRED_IMPL("delete_file", 1, delete_file, 0) return TRUE; return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, - ATOM_delete, ATOM_file, A1); + ATOM_delete, ATOM_file, A1); } @@ -799,7 +858,7 @@ has_extension(const char *name, const char *ext) static int -name_too_long() +name_too_long(void) { return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); } @@ -941,6 +1000,7 @@ BeginPredDefs(files) PRED_DEF("exists_file", 1, exists_file, 0) PRED_DEF("exists_directory", 1, exists_directory, 0) PRED_DEF("tmp_file", 2, tmp_file, 0) + PRED_DEF("tmp_file_stream", 3, tmp_file_stream, 0) PRED_DEF("delete_file", 1, delete_file, 0) PRED_DEF("delete_directory", 1, delete_directory, 0) PRED_DEF("make_directory", 1, make_directory, 0) diff --git a/packages/PLStream/pl-incl.h b/packages/PLStream/pl-incl.h index 8b89bf9e1..dd0e42b05 100755 --- a/packages/PLStream/pl-incl.h +++ b/packages/PLStream/pl-incl.h @@ -109,8 +109,7 @@ typedef struct { } prolog_flag; struct - { TempFile _tmpfile_head; - TempFile _tmpfile_tail; + { Table tmp_files; /* Known temporary files */ CanonicalDir _canonical_dirlist; char * myhome; /* expansion of ~ */ char * fred; /* last expanded ~user */ @@ -123,6 +122,25 @@ typedef struct { IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */ } os; + struct + { size_t heap; /* heap in use */ + size_t atoms; /* No. of atoms defined */ + size_t atomspace; /* # bytes used to store atoms */ + size_t stack_space; /* # bytes on stacks */ +#ifdef O_ATOMGC + size_t atomspacefreed; /* Freed atom-space */ +#endif + int functors; /* No. of functors defined */ + int predicates; /* No. of predicates defined */ + int modules; /* No. of modules in the system */ + intptr_t codes; /* No. of byte codes generated */ +#ifdef O_PLMT + int threads_created; /* # threads created */ + int threads_finished; /* # finished threads */ + double thread_cputime; /* Total CPU time of threads */ +#endif + } statistics; + struct { atom_t * array; /* index --> atom */ size_t count; /* elements in array */ @@ -136,6 +154,8 @@ extern gds_t gds; #define GD (&gds) #define GLOBAL_LD (&gds) + + typedef struct { unsigned long flags; /* Fast access to some boolean Prolog flags */ } pl_features_t; @@ -280,6 +300,7 @@ typedef struct PL_local_data { term_t tmp; /* tmp for errors */ term_t pending; /* used by the debugger */ int in_hook; /* inside exception_hook() */ + int processing; /* processing an exception */ exception_frame *throw_environment; /* PL_throw() environments */ } exception; const char *float_format; /* floating point format */ @@ -290,6 +311,8 @@ typedef struct PL_local_data { } PL_local_data_t; +#define usedStack(D) 0 + #define features (LD->feature.mask) extern PL_local_data_t lds; @@ -586,6 +609,8 @@ extern int get_atom_ptr_text(Atom a, PL_chars_t *text); /**** stuff from pl-files.c ****/ void initFiles(void); +int RemoveFile(const char *path); +int PL_get_file_name(term_t n, char **namep, int flags); /* empty stub */ void setPrologFlag(const char *name, int flags, ...); diff --git a/packages/PLStream/pl-os.c b/packages/PLStream/pl-os.c index 1b2237cd0..d92088332 100755 --- a/packages/PLStream/pl-os.c +++ b/packages/PLStream/pl-os.c @@ -119,7 +119,8 @@ have to be dropped. See the header of pl-incl.h for details. bool initOs(void) -{ DEBUG(1, Sdprintf("OS:initExpand() ...\n")); +{ GET_LD + DEBUG(1, Sdprintf("OS:initExpand() ...\n")); initExpand(); DEBUG(1, Sdprintf("OS:initEnviron() ...\n")); initEnviron(); @@ -409,10 +410,10 @@ setOSPrologFlags(void) * MEMORY * *******************************/ -#if __SWI_PROLOG__ uintptr_t UsedMemory(void) -{ +{ GET_LD + #if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS) struct rusage usage; @@ -427,23 +428,15 @@ UsedMemory(void) usedStack(local) + usedStack(trail)); } -#else -uintptr_t -UsedMemory(void) -{ - return 0; -} -#endif uintptr_t FreeMemory(void) { - #if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA) uintptr_t used = UsedMemory(); - struct rlimit limit; + struct rlimit limit; if ( getrlimit(RLIMIT_DATA, &limit) == 0 ) return limit.rlim_cur - used; @@ -511,7 +504,9 @@ setRandom(unsigned int *seedp) uint64_t _PL_Random(void) -{ if ( !LD->os.rand_initialised ) +{ GET_LD + + if ( !LD->os.rand_initialised ) { setRandom(NULL); LD->os.rand_initialised = TRUE; } @@ -530,9 +525,9 @@ _PL_Random(void) #else { uint64_t l = rand(); /* 0os._tmpfile_head) -#define tmpfile_tail (GD->os._tmpfile_tail) - #ifndef DEFTMPDIR #ifdef __WINDOWS__ #define DEFTMPDIR "c:/tmp" @@ -582,22 +569,64 @@ struct tempfile #endif #endif +static int +free_tmp_symbol(Symbol s) +{ int rc; + atom_t tname = (atom_t)s->name; + PL_chars_t txt; + + get_atom_text(tname, &txt); + PL_mb_text(&txt, REP_FN); + rc = RemoveFile(txt.text.t); + PL_free_text(&txt); + + PL_unregister_atom(tname); + return rc; +} + + +static void +void_free_tmp_symbol(Symbol s) +{ (void)free_tmp_symbol(s); +} + + +#ifndef O_EXCL +#define O_EXCL 0 +#endif +#ifndef O_BINARY +#define O_BINARY 0 +#endif + atom_t -TemporaryFile(const char *id) +TemporaryFile(const char *id, int *fdp) { char temp[MAXPATHLEN]; - TempFile tf = allocHeap(sizeof(struct tempfile)); - char envbuf[MAXPATHLEN]; - char *tmpdir; + static char *tmpdir = NULL; + atom_t tname; + int retries = 0; - if ( !((tmpdir = Getenv("TEMP", envbuf, sizeof(envbuf))) || - (tmpdir = Getenv("TMP", envbuf, sizeof(envbuf)))) ) - tmpdir = DEFTMPDIR; + if ( !tmpdir ) + { LOCK(); + if ( !tmpdir ) + { char envbuf[MAXPATHLEN]; + char *td; + if ( (td = Getenv("TEMP", envbuf, sizeof(envbuf))) || + (td = Getenv("TMP", envbuf, sizeof(envbuf))) ) + tmpdir = strdup(td); + else + tmpdir = DEFTMPDIR; + } + UNLOCK(); + } + +retry: #ifdef __unix__ { static int MTOK_temp_counter = 0; + const char *sep = id[0] ? "_" : ""; - Ssprintf(temp, "%s/pl_%s_%d_%d", - tmpdir, id, (int) getpid(), MTOK_temp_counter++); + Ssprintf(temp, "%s/pl_%s%s%d_%d", + tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++); } #endif @@ -612,49 +641,74 @@ TemporaryFile(const char *id) #endif { PrologPath(tmp, temp, sizeof(temp)); } else - Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++); -} -#endif + { const char *sep = id[0] ? "_" : ""; -#if EMX - static int temp_counter = 0; - char *foo; - - if ( (foo = tempnam(".", (const char *)id)) ) - { strcpy(temp, foo); - free(foo); - } else - Ssprintf(temp, "pl_%s_%d_%d", id, getpid(), temp_counter++); -#endif - - tf->name = PL_new_atom(temp); /* locked: ok! */ - tf->next = NULL; - - startCritical; - if ( !tmpfile_tail ) - { tmpfile_head = tmpfile_tail = tf; - } else - { tmpfile_tail->next = tf; - tmpfile_tail = tf; + Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++); } - endCritical; - - return tf->name; } +#endif + + if ( fdp ) + { int fd; + + if ( (fd=open(temp, O_CREAT|O_EXCL|O_WRONLY|O_BINARY, 0600)) < 0 ) + { if ( ++retries < 10000 ) + goto retry; + else + return NULL_ATOM; + } + + *fdp = fd; + } + + tname = PL_new_atom(temp); /* locked: ok! */ + + LOCK(); + if ( !GD->os.tmp_files ) + { GD->os.tmp_files = newHTable(4); + GD->os.tmp_files->free_symbol = void_free_tmp_symbol; + } + UNLOCK(); + + addHTable(GD->os.tmp_files, (void*)tname, (void*)TRUE); + + return tname; +} + + +int +DeleteTemporaryFile(atom_t name) +{ int rc = FALSE; + + if ( GD->os.tmp_files ) + { LOCK(); + if ( GD->os.tmp_files && GD->os.tmp_files->size > 0 ) + { Symbol s = lookupHTable(GD->os.tmp_files, (void*)name); + + if ( s ) + { rc = free_tmp_symbol(s); + deleteSymbolHTable(GD->os.tmp_files, s); + } + } + UNLOCK(); + } + + return rc; +} + void RemoveTemporaryFiles(void) -{ TempFile tf, tf2; +{ LOCK(); + if ( GD->os.tmp_files ) + { Table t = GD->os.tmp_files; - startCritical; - for(tf = tmpfile_head; tf; tf = tf2) - { RemoveFile(stringAtom(tf->name)); - tf2 = tf->next; - freeHeap(tf, sizeof(struct tempfile)); + GD->os.tmp_files = NULL; + UNLOCK(); + destroyHTable(t); + } else + { UNLOCK(); } - - tmpfile_head = tmpfile_tail = NULL; - endCritical; } @@ -756,7 +810,8 @@ OsPath(const char *p, char *buf) #if O_XOS char * PrologPath(const char *p, char *buf, size_t len) -{ int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE); +{ GET_LD + int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE); return _xos_canonical_filename(p, buf, len, flags); } @@ -813,7 +868,7 @@ forwards char *canoniseDir(char *); static void initExpand(void) -{ +{ GET_LD #ifdef O_CANONISE_DIRS char *dir; char *cpaths; @@ -923,6 +978,7 @@ verify_entry(CanonicalDir d) d->inode = buf.st_ino; d->device = buf.st_dev; + return TRUE; } else { DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical)); @@ -939,6 +995,9 @@ verify_entry(CanonicalDir d) } } + remove_string(d->name); + if ( d->canonical != d->name ) + remove_string(d->canonical); free(d); } @@ -1139,7 +1198,9 @@ utf8_strlwr(char *s) char * canonisePath(char *path) -{ if ( !truePrologFlag(PLFLAG_FILE_CASE) ) +{ GET_LD + + if ( !truePrologFlag(PLFLAG_FILE_CASE) ) utf8_strlwr(path); canoniseFileName(path); @@ -1186,7 +1247,8 @@ takeWord(const char **string, char *wrd, int maxlen) bool expandVars(const char *pattern, char *expanded, int maxlen) -{ int size = 0; +{ GET_LD + int size = 0; char wordbuf[MAXPATHLEN]; if ( *pattern == '~' ) @@ -1338,7 +1400,8 @@ ExpandFile(const char *pattern, char **vector) char * ExpandOneFile(const char *spec, char *file) -{ char *vector[256]; +{ GET_LD + char *vector[256]; int size; switch( (size=ExpandFile(spec, vector)) ) @@ -1437,10 +1500,13 @@ IsAbsolutePath(const char *p) char * AbsoluteFile(const char *spec, char *path) -{ char tmp[MAXPATHLEN]; +{ GET_LD + char tmp[MAXPATHLEN]; char buf[MAXPATHLEN]; char *file = PrologPath(spec, buf, sizeof(buf)); + if ( !file ) + return (char *) NULL; if ( truePrologFlag(PLFLAG_FILEVARS) ) { if ( !(file = ExpandOneFile(buf, tmp)) ) return (char *) NULL; @@ -1485,7 +1551,9 @@ AbsoluteFile(const char *spec, char *path) void PL_changed_cwd(void) -{ if ( CWDdir ) +{ GET_LD + + if ( CWDdir ) remove_string(CWDdir); CWDdir = NULL; CWDlen = 0; @@ -1494,7 +1562,9 @@ PL_changed_cwd(void) const char * PL_cwd(void) -{ if ( CWDlen == 0 ) +{ GET_LD + + if ( CWDlen == 0 ) { char buf[MAXPATHLEN]; char *rval; @@ -1583,7 +1653,8 @@ DirName(const char *f, char *dir) bool ChDir(const char *path) -{ char ospath[MAXPATHLEN]; +{ GET_LD + char ospath[MAXPATHLEN]; char tmp[MAXPATHLEN]; OsPath(path, ospath); @@ -1681,7 +1752,8 @@ ResetStdin(void) static ssize_t Sread_terminal(void *handle, char *buf, size_t size) -{ intptr_t h = (intptr_t)handle; +{ GET_LD + intptr_t h = (intptr_t)handle; int fd = (int)h; source_location oldsrc = LD->read_source; @@ -1708,7 +1780,8 @@ Sread_terminal(void *handle, char *buf, size_t size) void ResetTty() -{ startCritical; +{ GET_LD + startCritical; ResetStdin(); if ( !GD->os.iofunctions.read ) @@ -1736,7 +1809,8 @@ ResetTty() bool PushTty(IOSTREAM *s, ttybuf *buf, int mode) -{ struct termios tio; +{ GET_LD + struct termios tio; int fd; buf->mode = ttymode; @@ -1803,7 +1877,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode) bool PopTty(IOSTREAM *s, ttybuf *buf) -{ int fd; +{ GET_LD + int fd; ttymode = buf->mode; if ( (fd = Sfileno(s)) < 0 || !isatty(fd) ) @@ -1898,7 +1973,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode) bool PopTty(IOSTREAM *s, ttybuf *buf) -{ ttymode = buf->mode; +{ GET_LD + ttymode = buf->mode; if ( ttymode != TTY_RAW ) LD->prompt.next = TRUE; @@ -2204,7 +2280,8 @@ argument to wait() int System(char *cmd) -{ int pid; +{ GET_LD + int pid; char *shell = "/bin/sh"; int rval; void (*old_int)(); diff --git a/packages/PLStream/pl-os.h b/packages/PLStream/pl-os.h index 238cbb8a1..58ca1eae7 100755 --- a/packages/PLStream/pl-os.h +++ b/packages/PLStream/pl-os.h @@ -245,8 +245,9 @@ extern char *Getenv(const char *, char *buf, size_t buflen); extern char *BaseName(const char *f); extern time_t LastModifiedFile(const char *f); extern bool ExistsFile(const char *path); -extern atom_t TemporaryFile(const char *id); -extern int RemoveFile(const char *path); +extern atom_t TemporaryFile(const char *id, int *fdp); +extern atom_t TemporaryFile(const char *id, int *fdp); +extern int DeleteTemporaryFile(atom_t name); extern bool ChDir(const char *path); extern char *PrologPath(const char *ospath, char *path, size_t len); diff --git a/packages/PLStream/pl-stream.c b/packages/PLStream/pl-stream.c index 976eade6f..b23aeb84a 100644 --- a/packages/PLStream/pl-stream.c +++ b/packages/PLStream/pl-stream.c @@ -3,9 +3,9 @@ Part of SWI-Prolog Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl + E-mail: J.Wielemaker@uva.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2007, University of Amsterdam + Copyright (C): 1985-2009, University of Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -52,7 +52,7 @@ MT: Multithreading is supported through Slock() and Sunlock(). These are recursive locks. If a stream handle might be known to another thread -locking is required. +locking is required. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifdef MD @@ -222,6 +222,7 @@ S__setbuf(IOSTREAM *s, char *buffer, size_t size) free(newunbuf); errno = oldeno; + S__seterror(s); return -1; } } @@ -246,8 +247,8 @@ S__setbuf(IOSTREAM *s, char *buffer, size_t size) void Ssetbuffer(IOSTREAM *s, char *buffer, size_t size) -{ S__setbuf(s, buffer, size); - s->flags &= ~SIO_USERBUF; +{ if ( S__setbuf(s, buffer, size) != (size_t)-1 ) + s->flags &= ~SIO_USERBUF; } @@ -290,16 +291,16 @@ print_trace(void) size_t size; char **strings; size_t i; - + size = backtrace(array, sizeof(array)/sizeof(void *)); strings = backtrace_symbols(array, size); - + printf(" Stack:"); for(i = 1; i < size; i++) { printf("\n\t[%ld] %s", (long)i, strings[i]); } printf("\n"); - + free(strings); } #endif /*DEBUG_IO_LOCKS*/ @@ -339,8 +340,8 @@ StryLock(IOSTREAM *s) } -static int -S__unlock(IOSTREAM *s) +int +Sunlock(IOSTREAM *s) { int rval = 0; #ifdef DEBUG_IO_LOCKS @@ -359,15 +360,7 @@ S__unlock(IOSTREAM *s) { assert(0); } - return rval; -} - - -int -Sunlock(IOSTREAM *s) -{ int rval = S__unlock(s); SUNLOCK(s); - return rval; } @@ -429,16 +422,15 @@ S__flushbufc(int c, IOSTREAM *s) } else { if ( s->flags & SIO_NBUF ) { char chr = (char)c; - + if ( (*s->functions->write)(s->handle, &chr, 1) != 1 ) - { s->flags |= SIO_FERR; + { S__seterror(s); c = -1; } } else { if ( S__setbuf(s, NULL, 0) == (size_t)-1 ) - { s->flags |= SIO_FERR; c = -1; - } else + else *s->bufp++ = (char)c; } } @@ -471,7 +463,7 @@ S__fillbuf(IOSTREAM *s) { fd_set wait; struct timeval time; int rc; - + time.tv_sec = s->timeout / 1000; time.tv_usec = (s->timeout % 1000) * 1000; FD_ZERO(&wait); @@ -483,7 +475,7 @@ S__fillbuf(IOSTREAM *s) for(;;) { rc = select(fd+1, &wait, NULL, NULL, &time); - + if ( rc < 0 && errno == EINTR ) { if ( PL_handle_signals() < 0 ) { errno = EPLEXCEPTION; @@ -557,6 +549,7 @@ S__fillbuf(IOSTREAM *s) } else if ( errno == EWOULDBLOCK ) { s->bufp = s->buffer; s->limitp = s->buffer; + S__seterror(s); return -1; #endif } else @@ -740,7 +733,7 @@ reperror(int c, IOSTREAM *s) { if ( put_byte(*q, s) < 0 ) return -1; } - + return c; } @@ -798,7 +791,7 @@ put_code(int c, IOSTREAM *s) case ENC_UTF8: { char buf[6]; char *p, *end; - + if ( c < 128 ) goto simple; @@ -831,7 +824,7 @@ put_code(int c, IOSTREAM *s) { if ( put_byte(*q++, s) < 0 ) return -1; } - + break; } case ENC_UNKNOWN: @@ -975,7 +968,7 @@ retry: code = UTF8_FBV(c,extra); for( ; extra > 0; extra-- ) { int c2 = get_byte(s); - + if ( !ISUTF8_CB(c2) ) { Sseterr(s, SIO_WARN, "Illegal UTF-8 continuation"); c = UTF8_MALFORMED_REPLACEMENT; @@ -1025,7 +1018,7 @@ retry: goto out; } else { Sseterr(s, SIO_WARN, "EOF in UCS character"); - c = UTF8_MALFORMED_REPLACEMENT; + c = UTF8_MALFORMED_REPLACEMENT; goto out; } } @@ -1228,16 +1221,16 @@ Sfread(void *data, size_t size, size_t elms, IOSTREAM *s) if ( (c = Sgetc(s)) == EOF ) break; - + *buf++ = c & 0xff; } - } else + } else { while(chars > 0) { int c; if ( s->bufp < s->limitp ) { size_t avail = s->limitp - s->bufp; - + if ( chars <= avail ) { memcpy(buf, s->bufp, chars); s->bufp += chars; @@ -1249,7 +1242,7 @@ Sfread(void *data, size_t size, size_t elms, IOSTREAM *s) s->bufp += avail; } } - + if ( (c = S__fillbuf(s)) == EOF ) break; @@ -1257,7 +1250,7 @@ Sfread(void *data, size_t size, size_t elms, IOSTREAM *s) chars--; } } - + return (size*elms - chars)/size; } @@ -1271,7 +1264,7 @@ Sfwrite(const void *data, size_t size, size_t elms, IOSTREAM *s) { if ( Sputc(*buf++, s) < 0 ) break; } - + return (size*elms - chars)/size; } @@ -1406,19 +1399,22 @@ Sfeof(IOSTREAM *s) s->bufp--; return FALSE; } - + static int S__seterror(IOSTREAM *s) -{ if ( s->functions->control ) +{ s->io_errno = errno; + + if ( !(s->flags&SIO_CLOSING) && /* s->handle is already invalid */ + s->functions->control ) { char *msg; if ( (*s->functions->control)(s->handle, - SIO_LASTERROR, + SIO_LASTERROR, (void *)&msg) == 0 ) { Sseterr(s, SIO_FERR, msg); return 0; - } + } } s->flags |= SIO_FERR; @@ -1430,7 +1426,7 @@ int Sferror(IOSTREAM *s) { return (s->flags & SIO_FERR) != 0; } - + int Sfpasteof(IOSTREAM *s) @@ -1441,6 +1437,7 @@ Sfpasteof(IOSTREAM *s) void Sclearerr(IOSTREAM *s) { s->flags &= ~(SIO_FEOF|SIO_WARN|SIO_FERR|SIO_FEOF2|SIO_TIMEOUT|SIO_CLEARERR); + s->io_errno = 0; Sseterr(s, 0, NULL); } @@ -1485,7 +1482,7 @@ Ssetenc(IOSTREAM *s, IOENC enc, IOENC *old) if ( s->functions->control ) { if ( (*s->functions->control)(s->handle, - SIO_SETENCODING, + SIO_SETENCODING, (void *)&enc) != 0 ) return -1; } @@ -1563,6 +1560,7 @@ Ssize(IOSTREAM *s) } errno = ESPIPE; + S__seterror(s); return -1; } @@ -1587,7 +1585,7 @@ Sseek64(IOSTREAM *s, int64_t pos, int whence) if ( now != -1 ) { int64_t newpos; char *nbufp = (char *)-1; - + if ( whence == SIO_SEEK_CUR ) { nbufp = s->bufp + pos; newpos = now + pos; @@ -1608,11 +1606,12 @@ Sseek64(IOSTREAM *s, int64_t pos, int whence) if ( !s->functions->seek && !s->functions->seek64 ) { errno = ESPIPE; + S__seterror(s); return -1; } Sflush(s); - + s->bufp = s->buffer; if ( (s->flags & SIO_INPUT) ) s->limitp = s->buffer; @@ -1621,18 +1620,19 @@ Sseek64(IOSTREAM *s, int64_t pos, int whence) { pos += Stell64(s); whence = SIO_SEEK_SET; } - + if ( s->functions->seek64 ) pos = (*s->functions->seek64)(s->handle, pos, whence); else if ( pos <= LONG_MAX ) pos = (*s->functions->seek)(s->handle, (long)pos, whence); else { errno = EINVAL; + S__seterror(s); return -1; } - + if ( pos < 0 ) - { errno = EINVAL; + { S__seterror(s); return -1; } @@ -1684,6 +1684,7 @@ Stell64(IOSTREAM *s) return pos; } else { errno = EINVAL; + S__seterror(s); return -1; } } @@ -1693,10 +1694,13 @@ long Stell(IOSTREAM *s) { int64_t pos = Stell64(s); + if ( pos == -1 ) + return -1; if ( pos <= LONG_MAX ) return (long) pos; errno = EINVAL; + S__seterror(s); return -1; } @@ -1717,7 +1721,7 @@ Sclose(IOSTREAM *s) { int rval = 0; if ( s->magic != SIO_MAGIC ) /* already closed!? */ - { errno = EINVAL; + { s->io_errno = errno = EINVAL; return -1; } @@ -1747,11 +1751,12 @@ Sclose(IOSTREAM *s) } #endif if ( s->functions->close && (*s->functions->close)(s->handle) < 0 ) - { s->flags |= SIO_FERR; + { S__seterror(s); rval = -1; } + while(s->locks > 0) /* remove buffer-locks */ - { int rc = S__unlock(s); + { int rc = Sunlock(s); if ( rval == 0 ) rval = rc; @@ -1759,7 +1764,6 @@ Sclose(IOSTREAM *s) if ( rval < 0 ) reportStreamError(s); run_close_hooks(s); /* deletes Prolog registration */ - SUNLOCK(s); #ifdef O_PLMT @@ -1771,6 +1775,8 @@ Sclose(IOSTREAM *s) #endif s->magic = SIO_CMAGIC; + if ( s->message ) + free(s->message); if ( !(s->flags & SIO_STATIC) ) free(s); @@ -1826,8 +1832,7 @@ Sgets(char *buf) int Sfputs(const char *q, IOSTREAM *s) -{ - for( ; *q; q++) +{ for( ; *q; q++) { if ( Sputcode(*q&0xff, s) < 0 ) return EOF; } @@ -2003,7 +2008,7 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args) v = va_arg(args, int); break; case 1: - v = va_arg(args, intptr_t); + v = va_arg(args, long); break; case 2: vl = va_arg(args, int64_t); @@ -2168,7 +2173,7 @@ Svsprintf(char *buf, const char *fm, va_list args) s.buffer = buf; s.flags = SIO_FBUF|SIO_OUTPUT; s.encoding = ENC_ISO_LATIN_1; - + if ( (rval = Svfprintf(&s, fm, args)) >= 0 ) *s.bufp = '\0'; @@ -2255,7 +2260,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args) continue; } } - + if ( *fm != '[' && *fm != c ) while(isblank(c)) c = GET(s); @@ -2408,13 +2413,13 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args) { float *fp = va_arg(args, float *); *fp = v; break; - } + } case SZ_LONG: { double *fp = va_arg(args, double *); *fp = v; break; } - } + } done++; } @@ -2424,7 +2429,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args) case 's': if ( !supress ) { char *sp = va_arg(args, char *); - + while(!isblank(c) && field_width-- != 0) { *sp++ = c; c = GET(s); @@ -2444,7 +2449,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args) continue; case '[': { char set[256]; - + memset(set, 0, sizeof(set)); fm++; if ( *fm == ']' ) @@ -2455,7 +2460,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args) } while(*fm != ']') { if ( *fm == '-' ) - + } } } @@ -2488,7 +2493,7 @@ Link two streams in a pipeline, where filter filters data for stream `parent'. If parent is an output steam we have application --> filter --> parent --> - + If parent is an input stream we have --> parent --> filter --> application @@ -2660,6 +2665,15 @@ IOFUNCTIONS Sttyfunctions = }; +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +(*) Windows isatty() is totally broken since VC9; crashing the +application instead of returning EINVAL on wrong values of fd. As we +provide the socket-id through Sfileno, this code crashes on +tcp_open_socket(). As ttys and its detection is of no value on Windows +anyway, we skip this. Second, Windows doesn't have fork(), so FD_CLOEXEC +is of no value. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + IOSTREAM * Snew(void *handle, int flags, IOFUNCTIONS *functions) { IOSTREAM *s; @@ -2692,8 +2706,16 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions) recursiveMutexInit(s->mutex); } #endif - if ( (fd = Sfileno(s)) >= 0 && isatty(fd) ) - s->flags |= SIO_ISATTY; + +#ifndef __WINDOWS__ /* (*) */ + if ( (fd = Sfileno(s)) >= 0 ) + { if ( isatty(fd) ) + s->flags |= SIO_ISATTY; +#if defined(F_SETFD) && defined(FD_CLOEXEC) + fcntl(fd, F_SETFD, FD_CLOEXEC); +#endif + } +#endif return s; } @@ -2718,7 +2740,7 @@ IOSTREAM * Sopen_file(const char *path, const char *how) { int fd; int oflags = O_BINARY; - int flags = SIO_FILE|SIO_TEXT|SIO_RECORDPOS; + int flags = SIO_FILE|SIO_TEXT|SIO_RECORDPOS|SIO_FBUF; int op = *how++; intptr_t lfd; enum {lnone=0,lread,lwrite} lock = lnone; @@ -2782,7 +2804,7 @@ Sopen_file(const char *path, const char *how) return NULL; if ( lock ) - { + { #ifdef FCNTL_LOCKS struct flock buf; @@ -2830,8 +2852,8 @@ Sopen_file(const char *path, const char *how) IOSTREAM * Sfdopen(int fd, const char *type) -{ int flags; - intptr_t lfd; +{ intptr_t lfd; + int flags = SIO_FILE|SIO_RECORDPOS|SIO_FBUF; if ( fd < 0 ) { errno = EINVAL; @@ -2843,9 +2865,15 @@ Sfdopen(int fd, const char *type) #endif if ( *type == 'r' ) - flags = SIO_FILE|SIO_INPUT|SIO_RECORDPOS; - else - flags = SIO_FILE|SIO_OUTPUT|SIO_RECORDPOS; + { flags |= SIO_INPUT; + } else if ( *type == 'w' ) + { flags |= SIO_OUTPUT; + } else + { errno = EINVAL; + return NULL; + } + if ( type[1] != 'b' ) + flags |= SIO_TEXT; lfd = (intptr_t)fd; @@ -2948,9 +2976,9 @@ Sopen_pipe(const char *command, const char *type) { int flags; if ( *type == 'r' ) - flags = SIO_PIPE|SIO_INPUT; + flags = SIO_PIPE|SIO_INPUT|SIO_FBUF; else - flags = SIO_PIPE|SIO_OUTPUT; + flags = SIO_PIPE|SIO_OUTPUT|SIO_FBUF; return Snew((void *)fd, flags, &Spipefunctions); } @@ -3004,7 +3032,7 @@ Swrite_memfile(void *handle, char *buf, size_t size) { memfile *mf = handle; if ( mf->here + size + 1 >= mf->allocated ) - { intptr_t ns = S__memfile_nextsize(mf->here + size + 1); + { size_t ns = S__memfile_nextsize(mf->here + size + 1); char *nb; if ( mf->allocated == 0 || !mf->malloced ) @@ -3052,7 +3080,7 @@ Sread_memfile(void *handle, char *buf, size_t size) else size = mf->size - mf->here; } - + memcpy(buf, &(*mf->buffer)[mf->here], size); mf->here += size; @@ -3095,7 +3123,7 @@ Sclose_memfile(void *handle) { free(mf); return 0; } - + errno = EINVAL; /* not opened */ return -1; } @@ -3396,7 +3424,7 @@ Sreset(void) if ( (s=Serror) && s->magic == SIO_MAGIC ) { s->bufp = s->buffer; } -} +} void @@ -3416,7 +3444,17 @@ Scleanup(void) s->bufp = s->buffer; /* avoid actual flush */ S__removebuf(s); + +#ifdef O_PLMT + if ( S__iob[i].mutex ) + { recursiveMutex *m = S__iob[i].mutex; + + S__iob[i].mutex = NULL; + recursiveMutexDelete(m); + free(m); + } +#endif + *s = S__iob0[i]; /* re-initialise */ } } - diff --git a/packages/PLStream/pl-text.c b/packages/PLStream/pl-text.c index 04bbb001a..68b50be6c 100644 --- a/packages/PLStream/pl-text.c +++ b/packages/PLStream/pl-text.c @@ -93,16 +93,40 @@ PL_save_text(PL_chars_t *text, int flags) addMultipleBuffer(b, text->text.t, bl, char); text->text.t = baseBuffer(b, char); - + text->storage = PL_CHARS_RING; } } +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +PL_from_stack_text() moves a string from the stack, so it won't get +corrupted if GC/shift comes along. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +static void +PL_from_stack_text(PL_chars_t *text) +{ if ( text->storage == PL_CHARS_STACK ) + { size_t bl = bufsize_text(text, text->length+1); + + if ( bl < sizeof(text->buf) ) + { memcpy(text->buf, text->text.t, bl); + text->text.t = text->buf; + text->storage = PL_CHARS_LOCAL; + } else + { Buffer b = findBuffer(BUF_RING); + + addMultipleBuffer(b, text->text.t, bl, char); + text->text.t = baseBuffer(b, char); + text->storage = PL_CHARS_RING; + } + } +} + + int PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD) -{ - Word w = valHandle(l); +{ word w = valHandle(l); if ( (flags & CVT_ATOM) && isAtom(w) ) { if ( !get_atom_text(w, text) ) @@ -110,6 +134,7 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD) } else if ( (flags & CVT_STRING) && isString(w) ) { if ( !get_string_text(w, text PASS_LD) ) goto maybe_write; + PL_from_stack_text(text); } else if ( (flags & CVT_INTEGER) && isInteger(w) ) { number n; @@ -141,8 +166,8 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD) } text->encoding = ENC_ISO_LATIN_1; text->canonical = TRUE; - } else if ( (flags & CVT_FLOAT) && isReal(w) ) - { format_float(valReal(w), text->buf, LD->float_format); + } else if ( (flags & CVT_FLOAT) && isFloat(w) ) + { format_float(valFloat(w), text->buf, LD->float_format); text->text.t = text->buf; text->length = strlen(text->text.t); text->encoding = ENC_ISO_LATIN_1; @@ -182,11 +207,11 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD) encodings[0] = ENC_ISO_LATIN_1; encodings[1] = ENC_WCHAR; encodings[2] = ENC_UNKNOWN; - + for(enc = encodings; *enc != ENC_UNKNOWN; enc++) { size_t size; IOSTREAM *fd; - + r = text->buf; size = sizeof(text->buf); fd = Sopenmem(&r, &size, "w"); @@ -228,6 +253,9 @@ maybe_write: goto case_write; error: + if ( canBind(w) && (flags & CVT_VARNOFAIL) ) + return 2; + if ( (flags & CVT_EXCEPTION) ) { atom_t expected; @@ -237,7 +265,7 @@ error: expected = ATOM_atomic; else expected = ATOM_atom; - + return PL_error(NULL, 0, NULL, ERR_TYPE, expected, l); } @@ -277,7 +305,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type) { case PL_ATOM: { atom_t a = textToAtom(text); int rval = _PL_unify_atomic(term, a); - + PL_unregister_atom(a); return rval; } @@ -285,7 +313,10 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type) #if __SWI_PROLOG__ { word w = textToString(text); - return _PL_unify_atomic(term, w); + if ( w ) + return _PL_unify_atomic(term, w); + else + return FALSE; } #endif case PL_CODE_LIST: @@ -300,35 +331,40 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type) } } else { GET_LD - word p0, p; - + term_t l = PL_new_term_ref(); + Word p0, p; + switch(text->encoding) { case ENC_ISO_LATIN_1: { const unsigned char *s = (const unsigned char *)text->text.t; const unsigned char *e = &s[text->length]; - p0 = p = INIT_SEQ_CODES(text->length); - if ( type == PL_CODE_LIST ) { - for( ; s < e; s++) - p = EXTEND_SEQ_CODES(p, *s); - } else { - for( ; s < e; s++) - p = EXTEND_SEQ_ATOMS(p, *s); - } + if ( !(p0 = p = INIT_SEQ_CODES(text->length)) ) + return FALSE; + + if ( type == PL_CODE_LIST ) { + for( ; s < e; s++) + p = EXTEND_SEQ_CODES(p, *s); + } else { + for( ; s < e; s++) + p = EXTEND_SEQ_ATOMS(p, *s); + } break; } case ENC_WCHAR: { const pl_wchar_t *s = (const pl_wchar_t *)text->text.t; const pl_wchar_t *e = &s[text->length]; - - p0 = p = INIT_SEQ_CODES(text->length); - if ( type == PL_CODE_LIST ) { - for( ; s < e; s++) - p = EXTEND_SEQ_CODES(p, *s); - } else { - for( ; s < e; s++) - p = EXTEND_SEQ_ATOMS(p, *s); - } + + if ( !(p0 = p = INIT_SEQ_CODES(text->length)) ) + return FALSE; + + if ( type == PL_CODE_LIST ) { + for( ; s < e; s++) + p = EXTEND_SEQ_CODES(p, *s); + } else { + for( ; s < e; s++) + p = EXTEND_SEQ_ATOMS(p, *s); + } break; } case ENC_UTF8: @@ -336,22 +372,24 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type) const char *e = &s[text->length]; size_t len = utf8_strlen(s, text->length); - p0 = p = INIT_SEQ_CODES(len); - if ( type == PL_CODE_LIST ) { - while (s < e) { - int chr; - - s = utf8_get_char(s, &chr); - p = EXTEND_SEQ_CODES(p, chr); - } - } else { - while (s < e) { - int chr; - - s = utf8_get_char(s, &chr); - p = EXTEND_SEQ_ATOMS(p, chr); - } - } + if ( !(p0 = p = INIT_SEQ_CODES(len)) ) + return FALSE; + + if ( type == PL_CODE_LIST ) { + while (s < e) { + int chr; + + s = utf8_get_char(s, &chr); + p = EXTEND_SEQ_CODES(p, chr); + } + } else { + while (s < e) { + int chr; + + s = utf8_get_char(s, &chr); + p = EXTEND_SEQ_ATOMS(p, chr); + } + } break; } case ENC_ANSI: @@ -367,18 +405,21 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type) n -= rc; s += rc; } - p0 = p = INIT_SEQ_CODES(len); + + if ( !(p0 = p = INIT_SEQ_CODES(len)) ) + return FALSE; + memset(&mbs, 0, sizeof(mbs)); n = text->length; - while(n > 0) { - rc = mbrtowc(&wc, s, n, &mbs); + while(n > 0) + { rc = mbrtowc(&wc, s, n, &mbs); if ( type == PL_CODE_LIST ) p = EXTEND_SEQ_CODES(p, wc); else p = EXTEND_SEQ_ATOMS(p, wc); - + s += rc; n -= rc; } @@ -391,7 +432,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type) } } - return CLOSE_SEQ_OF_CODES(p, p0, tail, term ); + return CLOSE_SEQ_OF_CODES(p, p0, tail, term, l ); } } default: @@ -430,7 +471,7 @@ PL_unify_text_range(term_t term, PL_chars_t *text, rc = PL_unify_text(term, 0, &sub, type); PL_free_text(&sub); - + return rc; } } @@ -458,7 +499,7 @@ PL_promote_text(PL_chars_t *text) PL_free(text->text.t); text->text.w = new; - + text->encoding = ENC_WCHAR; } else if ( text->storage == PL_CHARS_LOCAL && (text->length+1)*sizeof(pl_wchar_t) < sizeof(text->buf) ) @@ -512,7 +553,7 @@ PL_demote_text(PL_chars_t *text) PL_free(text->text.t); text->text.t = new; - + text->encoding = ENC_ISO_LATIN_1; } else if ( text->storage == PL_CHARS_LOCAL ) { pl_wchar_t buf[sizeof(text->buf)/sizeof(pl_wchar_t)]; @@ -601,7 +642,7 @@ utf8tobuffer(wchar_t c, Buffer buf) { char b[6]; char *e = b; const char *s; - + e = utf8_put_char(e, c); for(s=b; sencoding != target ) { Buffer b = findBuffer(BUF_RING); - + switch(text->encoding) { case ENC_ISO_LATIN_1: { const unsigned char *s = (const unsigned char*)text->text.t; @@ -658,7 +699,7 @@ PL_mb_text(PL_chars_t *text, int flags) addBuffer(b, 0, char); } else /* if ( target == ENC_MB ) */ { mbstate_t mbs; - + memset(&mbs, 0, sizeof(mbs)); for( ; wtext.w; const pl_wchar_t *e = &w[text->length]; - + for(; w 0xff ) return FALSE; @@ -1013,7 +1054,7 @@ PL_cmp_text(PL_chars_t *t1, size_t o1, PL_chars_t *t2, size_t o2, return ifeq; else return *s > *q ? 1 : -1; - } + } } @@ -1098,35 +1139,3 @@ Sopen_text(PL_chars_t *txt, const char *mode) return stream; } - -int -PL_unify_chars(term_t t, int flags, size_t len, const char *s) -{ PL_chars_t text; - term_t tail; - int rc; - - if ( len == (size_t)-1 ) - len = strlen(s); - - text.text.t = (char *)s; - text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \ - (flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1); - text.storage = PL_CHARS_HEAP; - text.length = len; - text.canonical = FALSE; - - flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1); - - if ( (flags & PL_DIFF_LIST) ) - { tail = t+1; - flags &= (~PL_DIFF_LIST); - } else - { tail = 0; - } - - rc = PL_unify_text(t, tail, &text, flags); - PL_free_text(&text); - - return rc; -} - diff --git a/packages/PLStream/pl-yap.c b/packages/PLStream/pl-yap.c index 632d4f7b5..83a69b568 100644 --- a/packages/PLStream/pl-yap.c +++ b/packages/PLStream/pl-yap.c @@ -250,7 +250,7 @@ scan_options(term_t options, int flags, atom_t optype, term_t val = PL_new_term_ref(); int n; - if ( trueFeature(ISO_FEATURE) ) + if ( truePrologFlag(PLFLAG_ISO) ) flags |= OPT_ALL; va_start(args, specs); @@ -557,3 +557,34 @@ PL_set_prolog_flag(const char *name, int flags, ...) { } +int +PL_unify_chars(term_t t, int flags, size_t len, const char *s) +{ PL_chars_t text; + term_t tail; + int rc; + + if ( len == (size_t)-1 ) + len = strlen(s); + + text.text.t = (char *)s; + text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \ + (flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1); + text.storage = PL_CHARS_HEAP; + text.length = len; + text.canonical = FALSE; + + flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1); + + if ( (flags & PL_DIFF_LIST) ) + { tail = t+1; + flags &= (~PL_DIFF_LIST); + } else + { tail = 0; + } + + rc = PL_unify_text(t, tail, &text, flags); + PL_free_text(&text); + + return rc; +} + diff --git a/packages/PLStream/pl-yap.h b/packages/PLStream/pl-yap.h index 148f0d6cb..699bd3777 100644 --- a/packages/PLStream/pl-yap.h +++ b/packages/PLStream/pl-yap.h @@ -148,7 +148,7 @@ EXTEND_SEQ_ATOMS(word gstore, int c) { } static inline int -CLOSE_SEQ_OF_CODES(word gstore, word lp, word arg2, word arg3) { +CLOSE_SEQ_OF_CODES(word gstore, word lp, word arg2, word arg3, term_t l) { if (arg3 == (word)ATOM_nil) { if (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil())) return FALSE; @@ -172,14 +172,17 @@ valHandle(term_t tt) #define isAtom(A) YAP_IsAtomTerm((A)) #define isList(A) YAP_IsPairTerm((A)) #define isNil(A) ((A) == YAP_TermNil()) -#define isReal(A)YAP_IsFloatTerm((A)) +#define isReal(A) YAP_IsFloatTerm((A)) +#define isFloat(A) YAP_IsFloatTerm((A)) #define isVar(A) YAP_IsVarTerm((A)) #define varName(l, buf) buf #define valReal(w) YAP_FloatOfTerm((w)) +#define valFloat(w) YAP_FloatOfTerm((w)) #define AtomLength(w) YAP_AtomNameLength(w) #define atomValue(atom) ((YAP_Atom)atom) #define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i)))) #define deRef(t) (t = YAP_Deref(t)) +#define canBind(t) FALSE #define clearNumber(n) diff --git a/packages/jpl b/packages/jpl index d9614e99d..9f80255cc 160000 --- a/packages/jpl +++ b/packages/jpl @@ -1 +1 @@ -Subproject commit d9614e99dc98f8546fdc213c9e45003cf6efd520 +Subproject commit 9f80255cce18ee268792631aa1180e19a496346f diff --git a/pl/directives.yap b/pl/directives.yap index 93a08c43b..3eac18043 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -876,10 +876,20 @@ yap_flag(max_threads,X) :- yap_flag(max_threads,X) :- '$do_error'(domain_error(flag_value,max_threads+X),yap_flag(max_threads,X)). +yap_flag(address_bits,X) :- + var(X), !, + '$address_bits'(X). +yap_flag(address_bits,X) :- + integer(X), X > 0, !, + '$do_error'(permission_error(modify,flag,address_bits),yap_flag(address_bits,X)). +yap_flag(address_bits,X) :- + '$do_error'(domain_error(flag_value,address_bits+X),yap_flag(address_bits,X)). + yap_flag(dialect,yap). '$show_yap_flag_opts'(V,Out) :- ( + V = address_bits ; V = answer_format ; V = argv ; V = bounded ;