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

This commit is contained in:
Vítor Santos Costa 2010-02-25 17:52:30 +00:00
commit 5e1f8ff84f
35 changed files with 934 additions and 558 deletions

View File

@ -555,6 +555,17 @@ eval1(Int fi, Term t) {
case db_ref_e: case db_ref_e:
RERROR(); 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) { if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) {
RINT((Int) dbl); RINT((Int) dbl);
} else { } else {
@ -797,8 +808,9 @@ p_unary_is(void)
return FALSE; return FALSE;
} }
top = Yap_Eval(Deref(ARG3)); top = Yap_Eval(Deref(ARG3));
if (top == 0L) if (!Yap_FoundArithError(top, ARG3)) {
return FALSE; return FALSE;
}
if (IsIntTerm(t)) { if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3)); Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3));
if (!tout) if (!tout)

View File

@ -1117,13 +1117,15 @@ p_binary_is(void)
return(FALSE); return(FALSE);
} }
t1 = Yap_Eval(Deref(ARG3)); t1 = Yap_Eval(Deref(ARG3));
if (t1 == 0L) if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE; return FALSE;
}
t2 = Yap_Eval(Deref(ARG4)); t2 = Yap_Eval(Deref(ARG4));
if (t2 == 0L) if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE; return FALSE;
}
if (IsIntTerm(t)) { 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) if (!tout)
return FALSE; return FALSE;
return Yap_unify_constant(ARG1,tout); return Yap_unify_constant(ARG1,tout);

View File

@ -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_args, (Term, unsigned int, compiler_struct *));
STATIC_PROTO(void c_eq, (Term, Term, compiler_struct *)); STATIC_PROTO(void c_eq, (Term, Term, compiler_struct *));
STATIC_PROTO(void c_test, (Int, 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_goal, (Term, Term, compiler_struct *));
STATIC_PROTO(void c_body, (Term, Term, compiler_struct *)); STATIC_PROTO(void c_body, (Term, Term, compiler_struct *));
STATIC_PROTO(void c_head, (Term, compiler_struct *)); STATIC_PROTO(void c_head, (Term, compiler_struct *));
@ -942,7 +942,7 @@ bip_cons Op,Xk,Ri,C
*/ */
static void 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 */ /* compile Z = X Op Y arithmetic function */
/* first we fetch the arguments */ /* first we fetch the arguments */
@ -1795,7 +1795,7 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
return; return;
} }
else if (p->PredFlags & AsmPredFlag) { else if (p->PredFlags & AsmPredFlag) {
int op = p->PredFlags & 0x7f; basic_preds op = p->PredFlags & 0x7f;
if (profiling) if (profiling)
Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint); Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint);

View File

@ -4631,6 +4631,7 @@ p_instance(void)
if (IsVarTerm(t2)) { if (IsVarTerm(t2)) {
Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity))); Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity)));
} else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) { } else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
UNLOCK(ap->PELock);
return FALSE; return FALSE;
} }
ptr = RepAppl(t2)+1; ptr = RepAppl(t2)+1;

View File

@ -788,25 +788,17 @@ p_execute_nonstop(void)
} }
/* N = arity; */ /* N = arity; */
/* call may not define new system predicates!! */ /* 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 (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); return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
} else if ((RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) && } else { if (ActiveSignals & YAP_CREEP_SIGNAL &&
RepPredProp(pe)->OpcodeOfPred != Yap_opcode(_call_bfunc_xx)) { !Yap_InterruptsDisabled &&
/* USER C-Code may walk over registers */ (!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) ||
if (RepPredProp(pe)->PredFlags & UserCPredFlag) { RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) {
save_machine_regs(); 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); return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
} }
} }

View File

@ -2164,8 +2164,13 @@ check_bom(int sno, StreamDesc *st)
int ch; int ch;
ch = st->stream_getc(sno); 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; return TRUE;
}
switch(ch) { switch(ch) {
case 0xFE: case 0xFE:
{ {

View File

@ -2972,6 +2972,16 @@ p_ld_path(void)
return Yap_unify(ARG1,MkAtomTerm(Yap_LookupAtom(YAP_LIBDIR))); 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 #ifdef _WIN32
@ -3193,6 +3203,7 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag); Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag); Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
Yap_InitCPred ("$address_bits", 1, p_address_bits, SafePredFlag);
#ifdef _WIN32 #ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0); Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif #endif

3
COPYING Executable file
View File

@ -0,0 +1,3 @@
This system is distributed under the LGPL licence terms. For details
visit http://www.gnu.org/copyleft/lesser.html.

10
Makefile.in Normal file → Executable file
View File

@ -29,7 +29,7 @@ INFODIR=$(SHAREDIR)/info
# #
# where to store documentaion files # where to store documentaion files
# #
DOCSDIR=$(SHAREDIR)/docs/yap DOCSDIR=$(SHAREDIR)/docs/Yap
# #
# Add this flag to YAP_EXTRAS if you need the extension: # 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) @INSTALL_DLLS@ $(INSTALL_DATA) -m 755 @YAPLIB@ $(DESTDIR)$(LIBDIR)
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl 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 for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
@INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) install) @INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) install)
@INSTALL_DLLS@ (cd packages/plunit; $(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
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/swi 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 for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
$(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR) $(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR)
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done

View File

@ -185,6 +185,7 @@ typedef void *PL_engine_t;
#define CVT_MASK 0x00ff #define CVT_MASK 0x00ff
#define CVT_EXCEPTION 0x10000 #define CVT_EXCEPTION 0x10000
#define CVT_VARNOFAIL 0x20000 /* return 2 if argument is unbound */
#define BUF_DISCARDABLE 0x0000 #define BUF_DISCARDABLE 0x0000
#define BUF_RING 0x0100 #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 void PL_rewind_foreign_frame(fid_t);
extern X_API fid_t PL_open_foreign_frame(void); extern X_API fid_t PL_open_foreign_frame(void);
extern X_API int PL_raise_exception(term_t); 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_register_atom(atom_t);
extern X_API void PL_unregister_atom(atom_t); extern X_API void PL_unregister_atom(atom_t);
extern X_API predicate_t PL_pred(functor_t, module_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 void PL_close_query(qid_t);
extern X_API int PL_toplevel(void); 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 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_predicate(module_t, int, predicate_t, term_t);
extern X_API int PL_call(term_t, module_t); extern X_API int PL_call(term_t, module_t);
extern X_API void PL_register_foreign(const char *, int, foreign_t (*)(void), int); extern X_API void PL_register_foreign(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_set_engine(PL_engine_t,PL_engine_t *);
extern X_API int PL_get_string_chars(term_t, char **, int *); extern X_API int PL_get_string_chars(term_t, char **, int *);
extern X_API record_t PL_record(term_t); 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 void PL_erase(record_t);
extern X_API int PL_action(int,...); extern X_API int PL_action(int,...);
extern X_API void *PL_malloc(int); extern X_API void *PL_malloc(int);

View File

@ -28,13 +28,12 @@
itrie_save/2, itrie_save/2,
itrie_save_as_trie/2, itrie_save_as_trie/2,
itrie_load/2, itrie_load/2,
itrie_save2stream/2,
itrie_loadFromstream/2,
itrie_stats/4, itrie_stats/4,
itrie_max_stats/4, itrie_max_stats/4,
itrie_usage/4, itrie_usage/4,
itrie_print/1, itrie_print/1
%added by nf
itrie_save2stream/2,
itrie_loadFromstream/2
]). ]).
:- load_foreign_files([itries], [], init_itries). :- load_foreign_files([itries], [], init_itries).

View File

@ -205,7 +205,7 @@ sysmktime(void)
loc.tm_hour = YAP_IntOfTerm(YAP_ARG4); loc.tm_hour = YAP_IntOfTerm(YAP_ARG4);
loc.tm_min = YAP_IntOfTerm(YAP_ARG5); loc.tm_min = YAP_IntOfTerm(YAP_ARG5);
loc.tm_sec = YAP_IntOfTerm(YAP_ARG6); loc.tm_sec = YAP_IntOfTerm(YAP_ARG6);
loc.tm_isdst = daylight; loc.tm_isdst = -1;
if ((tim = mktime(&loc)) == (time_t)-1) { if ((tim = mktime(&loc)) == (time_t)-1) {
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno)); return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));

View File

@ -50,5 +50,4 @@ trie_dup(Trie, CopyTrie) :-
trie_join(CopyTrie, Trie). trie_join(CopyTrie, Trie).
trie_traverse(Trie, Ref) :- trie_traverse(Trie, Ref) :-
trie_get_first_entry(Trie, InitRef), trie_traverse(Trie, 0, Ref).
(Ref = InitRef ; trie_traverse(Trie, InitRef, Ref)).

View File

@ -72,8 +72,10 @@ void trie_data_destruct(TrNode node) {
if (TrData_next(data)) { if (TrData_next(data)) {
TrData_previous(TrData_next(data)) = TrData_previous(data); TrData_previous(TrData_next(data)) = TrData_previous(data);
TrData_next(TrData_previous(data)) = TrData_next(data); TrData_next(TrData_previous(data)) = TrData_next(data);
} else } else {
TrEntry_last_data(trie) = TrData_previous(data);
TrData_next(TrData_previous(data)) = NULL; TrData_next(TrData_previous(data)) = NULL;
}
free_trie_data(data); free_trie_data(data);
return; return;
} }
@ -177,6 +179,8 @@ TrData trie_get_last_entry(TrEntry trie) {
TrData data; TrData data;
data = TrEntry_last_data(trie); data = TrEntry_last_data(trie);
if (data == AS_TR_DATA_NEXT(&TrEntry_first_data(trie)))
return NULL;
return data; return data;
} }
@ -185,7 +189,11 @@ inline
TrData trie_traverse_init(TrEntry trie, TrData init_data) { TrData trie_traverse_init(TrEntry trie, TrData init_data) {
TrData 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; TrEntry_traverse_data(trie) = data;
return data; return data;
} }

View File

@ -53,32 +53,32 @@ typedef struct trie_data {
/* Macros */ /* Macros */
/* --------------------------- */ /* --------------------------- */
#define new_trie_entry(TR_ENTRY, TR_NODE) \ #define new_trie_entry(TR_ENTRY, TR_NODE) \
{ new_struct(TR_ENTRY, TYPE_TR_ENTRY, SIZEOF_TR_ENTRY); \ { new_struct(TR_ENTRY, TYPE_TR_ENTRY, SIZEOF_TR_ENTRY); \
TrEntry_trie(TR_ENTRY) = TR_NODE; \ TrEntry_trie(TR_ENTRY) = TR_NODE; \
TrEntry_first_data(TR_ENTRY) = NULL; \ TrEntry_first_data(TR_ENTRY) = NULL; \
TrEntry_last_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_traverse_data(TR_ENTRY) = NULL; \
TrEntry_next(TR_ENTRY) = FIRST_TRIE; \ TrEntry_next(TR_ENTRY) = FIRST_TRIE; \
TrEntry_previous(TR_ENTRY) = AS_TR_ENTRY_NEXT(&FIRST_TRIE); \ TrEntry_previous(TR_ENTRY) = AS_TR_ENTRY_NEXT(&FIRST_TRIE); \
INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_ENTRY); \ INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_ENTRY); \
} }
#define new_trie_data(TR_DATA, TR_ENTRY, TR_NODE) \ #define new_trie_data(TR_DATA, TR_ENTRY, TR_NODE) \
{ TrData last_data = TrEntry_last_data(TR_ENTRY); \ { TrData first_data = TrEntry_first_data(TR_ENTRY); \
new_struct(TR_DATA, TYPE_TR_DATA, SIZEOF_TR_DATA); \ new_struct(TR_DATA, TYPE_TR_DATA, SIZEOF_TR_DATA); \
TrData_trie(TR_DATA) = TR_ENTRY; \ TrData_trie(TR_DATA) = TR_ENTRY; \
TrData_leaf(TR_DATA) = TR_NODE; \ TrData_leaf(TR_DATA) = TR_NODE; \
TrData_next(TR_DATA) = NULL; \ TrData_next(TR_DATA) = NULL; \
if (last_data) { \ if (first_data) { \
TrData_next(last_data) = TR_DATA; \ TrData last_data = TrEntry_last_data(TR_ENTRY); \
TrData_previous(TR_DATA) = last_data; \ TrData_next(last_data) = TR_DATA; \
TrEntry_last_data(TR_ENTRY) = TR_DATA; \ TrData_previous(TR_DATA) = last_data; \
} else { \ } else { \
TrData_previous(TR_DATA) = AS_TR_DATA_NEXT(&TrEntry_first_data(TR_ENTRY)); \ TrData_previous(TR_DATA) = AS_TR_DATA_NEXT(&TrEntry_first_data(TR_ENTRY)); \
TrEntry_first_data(TR_ENTRY) = TR_DATA; \ TrEntry_first_data(TR_ENTRY) = TR_DATA; \
TrEntry_last_data(TR_ENTRY) = TR_DATA; \ } \
} \ TrEntry_last_data(TR_ENTRY) = TR_DATA; \
INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_DATA); \ INCREMENT_MEMORY(TRIE_ENGINE, SIZEOF_TR_DATA); \
} }

View File

@ -431,7 +431,8 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode,
fpos_t curpos; fpos_t curpos;
fscanf(file, "%14s", version); fscanf(file, "%14s", version);
if (fgetpos(file, &curpos) ) return NULL; if (fgetpos(file, &curpos))
return NULL;
if (!strcmp(version, "BEGIN_TRIE_v2")) { if (!strcmp(version, "BEGIN_TRIE_v2")) {
fseek(file, -11, SEEK_END); fseek(file, -11, SEEK_END);
@ -442,7 +443,8 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode,
fprintf(stderr, "******************************************\n"); fprintf(stderr, "******************************************\n");
return NULL; return NULL;
} }
if (fsetpos(file, &curpos) ) return NULL; if (fsetpos(file, &curpos))
return NULL;
CURRENT_LOAD_VERSION = 2; CURRENT_LOAD_VERSION = 2;
} else if (!strcmp(version, "BEGIN_TRIE")) { } else if (!strcmp(version, "BEGIN_TRIE")) {
fseek(file, -8, SEEK_END); fseek(file, -8, SEEK_END);
@ -453,7 +455,8 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode,
fprintf(stderr, "******************************************\n"); fprintf(stderr, "******************************************\n");
return NULL; return NULL;
} }
if (fsetpos(file, &curpos) ) return NULL; if (fsetpos(file, &curpos))
return NULL;
CURRENT_LOAD_VERSION = 1; CURRENT_LOAD_VERSION = 1;
} else { } else {
fprintf(stderr, "****************************************\n"); fprintf(stderr, "****************************************\n");

View File

@ -47,13 +47,13 @@ static int p_itrie_count_intersect(void);
static int p_itrie_save(void); static int p_itrie_save(void);
static int p_itrie_save_as_trie(void); static int p_itrie_save_as_trie(void);
static int p_itrie_load(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_stats(void);
static int p_itrie_max_stats(void); static int p_itrie_max_stats(void);
static int p_itrie_usage(void); static int p_itrie_usage(void);
static int p_itrie_print(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", p_itrie_save, 2);
YAP_UserCPredicate("itrie_save_as_trie", p_itrie_save_as_trie, 2); YAP_UserCPredicate("itrie_save_as_trie", p_itrie_save_as_trie, 2);
YAP_UserCPredicate("itrie_load", p_itrie_load, 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_stats", p_itrie_stats, 4);
YAP_UserCPredicate("itrie_max_stats", p_itrie_max_stats, 4); YAP_UserCPredicate("itrie_max_stats", p_itrie_max_stats, 4);
YAP_UserCPredicate("itrie_usage", p_itrie_usage, 4); YAP_UserCPredicate("itrie_usage", p_itrie_usage, 4);
YAP_UserCPredicate("itrie_print", p_itrie_print, 1); 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; return;
} }
@ -101,7 +100,7 @@ void init_itries(void) {
/* Local Procedures */ /* Local Procedures */
/* -------------------------- */ /* -------------------------- */
/* itrie_open(+Itrie) */ /* itrie_open(-Itrie) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
static int p_itrie_open(void) { static int p_itrie_open(void) {
TrEntry itrie; TrEntry itrie;
@ -117,7 +116,7 @@ static int p_itrie_open(void) {
#undef arg_itrie #undef arg_itrie
/* itrie_close(-Itrie) */ /* itrie_close(+Itrie) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
static int p_itrie_close(void) { static int p_itrie_close(void) {
/* check arg */ /* 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_itrie YAP_ARG1
#define arg_mode YAP_ARG2 #define arg_mode YAP_ARG2
static int p_itrie_mode(void) { static int p_itrie_mode(void) {
@ -189,7 +188,7 @@ static int p_itrie_mode(void) {
#undef arg_mode #undef arg_mode
/* itrie_timestamp(-Itrie,?Time) */ /* itrie_timestamp(+Itrie,?Time) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_time YAP_ARG2 #define arg_time YAP_ARG2
static int p_itrie_timestamp(void) { static int p_itrie_timestamp(void) {
@ -218,7 +217,7 @@ static int p_itrie_timestamp(void) {
#undef arg_time #undef arg_time
/* itrie_put_entry(-Itrie,-Entry) */ /* itrie_put_entry(+Itrie,+Entry) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
static int p_itrie_put_entry(void) { static int p_itrie_put_entry(void) {
@ -234,7 +233,7 @@ static int p_itrie_put_entry(void) {
#undef arg_entry #undef arg_entry
/* itrie_update_entry(-Itrie,-Entry) */ /* itrie_update_entry(+Itrie,+Entry) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
static int p_itrie_update_entry(void) { static int p_itrie_update_entry(void) {
@ -250,7 +249,7 @@ static int p_itrie_update_entry(void) {
#undef arg_entry #undef arg_entry
/* itrie_check_entry(-Itrie,-Entry,+Ref) */ /* itrie_check_entry(+Itrie,+Entry,-Ref) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
#define arg_ref YAP_ARG3 #define arg_ref YAP_ARG3
@ -271,7 +270,7 @@ static int p_itrie_check_entry(void) {
#undef arg_ref #undef arg_ref
/* itrie_get_entry(-Ref,+Entry) */ /* itrie_get_entry(+Ref,-Entry) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
static int p_itrie_get_entry(void) { static int p_itrie_get_entry(void) {
@ -289,7 +288,7 @@ static int p_itrie_get_entry(void) {
#undef arg_entry #undef arg_entry
/* itrie_get_data(-Ref,+Data) */ /* itrie_get_data(+Ref,-Data) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
#define arg_data YAP_ARG2 #define arg_data YAP_ARG2
static int p_itrie_get_data(void) { static int p_itrie_get_data(void) {
@ -323,7 +322,7 @@ static int p_itrie_get_data(void) {
#undef arg_data #undef arg_data
/* itrie_traverse(-Itrie,+Ref) */ /* itrie_traverse(+Itrie,-Ref) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_ref YAP_ARG2 #define arg_ref YAP_ARG2
static int p_itrie_traverse_init(void) { static int p_itrie_traverse_init(void) {
@ -344,7 +343,7 @@ static int p_itrie_traverse_init(void) {
#undef arg_ref #undef arg_ref
/* itrie_traverse(-Itrie,+Ref) */ /* itrie_traverse(+Itrie,-Ref) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_ref YAP_ARG2 #define arg_ref YAP_ARG2
static int p_itrie_traverse_cont(void) { static int p_itrie_traverse_cont(void) {
@ -361,7 +360,7 @@ static int p_itrie_traverse_cont(void) {
#undef arg_ref #undef arg_ref
/* itrie_remove_entry(-Ref) */ /* itrie_remove_entry(+Ref) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
static int p_itrie_remove_entry(void) { static int p_itrie_remove_entry(void) {
/* check arg */ /* check arg */
@ -375,7 +374,7 @@ static int p_itrie_remove_entry(void) {
#undef arg_ref #undef arg_ref
/* itrie_remove_subtree(-Ref) */ /* itrie_remove_subtree(+Ref) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
static int p_itrie_remove_subtree(void) { static int p_itrie_remove_subtree(void) {
/* check arg */ /* check arg */
@ -389,7 +388,7 @@ static int p_itrie_remove_subtree(void) {
#undef arg_ref #undef arg_ref
/* itrie_add(-ItrieDest,-ItrieSource) */ /* itrie_add(+ItrieDest,+ItrieSource) */
#define arg_itrie_dest YAP_ARG1 #define arg_itrie_dest YAP_ARG1
#define arg_itrie_source YAP_ARG2 #define arg_itrie_source YAP_ARG2
static int p_itrie_add(void) { static int p_itrie_add(void) {
@ -407,7 +406,7 @@ static int p_itrie_add(void) {
#undef arg_itrie_source #undef arg_itrie_source
/* itrie_subtract(-ItrieDest,-ItrieSource) */ /* itrie_subtract(+ItrieDest,+ItrieSource) */
#define arg_itrie_dest YAP_ARG1 #define arg_itrie_dest YAP_ARG1
#define arg_itrie_source YAP_ARG2 #define arg_itrie_source YAP_ARG2
static int p_itrie_subtract(void) { static int p_itrie_subtract(void) {
@ -425,7 +424,7 @@ static int p_itrie_subtract(void) {
#undef arg_itrie_source #undef arg_itrie_source
/* itrie_join(-ItrieDest,-ItrieSource) */ /* itrie_join(+ItrieDest,+ItrieSource) */
#define arg_itrie_dest YAP_ARG1 #define arg_itrie_dest YAP_ARG1
#define arg_itrie_source YAP_ARG2 #define arg_itrie_source YAP_ARG2
static int p_itrie_join(void) { static int p_itrie_join(void) {
@ -443,7 +442,7 @@ static int p_itrie_join(void) {
#undef arg_itrie_source #undef arg_itrie_source
/* itrie_intersect(-ItrieDest,-ItrieSource) */ /* itrie_intersect(+ItrieDest,+ItrieSource) */
#define arg_itrie_dest YAP_ARG1 #define arg_itrie_dest YAP_ARG1
#define arg_itrie_source YAP_ARG2 #define arg_itrie_source YAP_ARG2
static int p_itrie_intersect(void) { static int p_itrie_intersect(void) {
@ -461,7 +460,7 @@ static int p_itrie_intersect(void) {
#undef arg_itrie_source #undef arg_itrie_source
/* itrie_count_join(-Itrie1,-Itrie2,+Entries) */ /* itrie_count_join(+Itrie1,+Itrie2,-Entries) */
#define arg_itrie1 YAP_ARG1 #define arg_itrie1 YAP_ARG1
#define arg_itrie2 YAP_ARG2 #define arg_itrie2 YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -483,7 +482,7 @@ static int p_itrie_count_join(void) {
#undef arg_entries #undef arg_entries
/* itrie_count_intersect(-Itrie1,-Itrie2,+Entries) */ /* itrie_count_intersect(+Itrie1,+Itrie2,-Entries) */
#define arg_itrie1 YAP_ARG1 #define arg_itrie1 YAP_ARG1
#define arg_itrie2 YAP_ARG2 #define arg_itrie2 YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -505,7 +504,7 @@ static int p_itrie_count_intersect(void) {
#undef arg_entries #undef arg_entries
/* itrie_save(-Itrie,-FileName) */ /* itrie_save(+Itrie,+FileName) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static int p_itrie_save(void) { static int p_itrie_save(void) {
@ -533,7 +532,7 @@ static int p_itrie_save(void) {
#undef arg_file #undef arg_file
/* itrie_save_as_trie(-Itrie,-FileName) */ /* itrie_save_as_trie(+Itrie,+FileName) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static int p_itrie_save_as_trie(void) { static int p_itrie_save_as_trie(void) {
@ -561,7 +560,7 @@ static int p_itrie_save_as_trie(void) {
#undef arg_file #undef arg_file
/* itrie_load(+Itrie,-FileName) */ /* itrie_load(-Itrie,+FileName) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static int p_itrie_load(void) { static int p_itrie_load(void) {
@ -581,10 +580,9 @@ static int p_itrie_load(void) {
return FALSE; return FALSE;
/* load itrie and close file */ /* load itrie and close file */
itrie = itrie_load(file); if (!(itrie = itrie_load(file)))
if (fclose(file))
return FALSE; return FALSE;
if (!itrie) if (fclose(file))
return FALSE; return FALSE;
return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie)); return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie));
} }
@ -592,7 +590,49 @@ static int p_itrie_load(void) {
#undef arg_file #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_memory YAP_ARG1
#define arg_tries YAP_ARG2 #define arg_tries YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -618,7 +658,7 @@ static int p_itrie_stats(void) {
#undef arg_nodes #undef arg_nodes
/* itrie_max_stats(+Memory,+Tries,+Entries,+Nodes) */ /* itrie_max_stats(-Memory,-Tries,-Entries,-Nodes) */
#define arg_memory YAP_ARG1 #define arg_memory YAP_ARG1
#define arg_tries YAP_ARG2 #define arg_tries YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -644,7 +684,7 @@ static int p_itrie_max_stats(void) {
#undef arg_nodes #undef arg_nodes
/* itrie_usage(-Itrie,+Entries,+Nodes,+VirtualNodes) */ /* itrie_usage(+Itrie,-Entries,-Nodes,-VirtualNodes) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
#define arg_entries YAP_ARG2 #define arg_entries YAP_ARG2
#define arg_nodes YAP_ARG3 #define arg_nodes YAP_ARG3
@ -672,7 +712,7 @@ static int p_itrie_usage(void) {
#undef arg_virtualnodes #undef arg_virtualnodes
/* itrie_print(-Itrie) */ /* itrie_print(+Itrie) */
#define arg_itrie YAP_ARG1 #define arg_itrie YAP_ARG1
static int p_itrie_print(void) { static int p_itrie_print(void) {
/* check arg */ /* check arg */
@ -684,44 +724,3 @@ static int p_itrie_print(void) {
return TRUE; return TRUE;
} }
#undef arg_itrie #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

View File

@ -104,13 +104,13 @@ void init_tries(void) {
/* Backwards Compatibility */ /* Backwards Compatibility */
/* --------------------------------- */ /* --------------------------------- */
/* open_trie(+Trie) */ /* open_trie(-Trie) */
static int p_open_trie(void) { static int p_open_trie(void) {
return p_trie_open(); return p_trie_open();
} }
/* close_trie(-Trie) */ /* close_trie(+Trie) */
static int p_close_trie(void) { static int p_close_trie(void) {
return p_trie_close(); 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_mode YAP_ARG1
#define arg_trie YAP_ARG2 #define arg_trie YAP_ARG2
#define arg_entry YAP_ARG3 #define arg_entry YAP_ARG3
@ -156,7 +156,7 @@ static int p_put_trie_entry(void) {
#undef arg_ref #undef arg_ref
/* get_trie_entry(-Mode,-Ref,+Entry) */ /* get_trie_entry(+Mode,+Ref,-Entry) */
#define arg_mode YAP_ARG1 #define arg_mode YAP_ARG1
#define arg_ref YAP_ARG2 #define arg_ref YAP_ARG2
#define arg_entry YAP_ARG3 #define arg_entry YAP_ARG3
@ -188,13 +188,13 @@ static int p_get_trie_entry(void) {
#undef arg_entry #undef arg_entry
/* remove_trie_entry(-Ref) */ /* remove_trie_entry(+Ref) */
static int p_remove_trie_entry(void) { static int p_remove_trie_entry(void) {
return p_trie_remove_entry(); return p_trie_remove_entry();
} }
/* print_trie(-Trie) */ /* print_trie(+Trie) */
static int p_print_trie(void) { static int p_print_trie(void) {
return p_trie_print(); return p_trie_print();
} }
@ -205,7 +205,7 @@ static int p_print_trie(void) {
/* Local Procedures */ /* Local Procedures */
/* -------------------------- */ /* -------------------------- */
/* trie_open(+Trie) */ /* trie_open(-Trie) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
static int p_trie_open(void) { static int p_trie_open(void) {
TrEntry trie; TrEntry trie;
@ -221,7 +221,7 @@ static int p_trie_open(void) {
#undef arg_trie #undef arg_trie
/* trie_close(-Trie) */ /* trie_close(+Trie) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
static int p_trie_close(void) { static int p_trie_close(void) {
/* check arg */ /* check arg */
@ -275,7 +275,7 @@ static int p_trie_mode(void) {
#undef arg_mode #undef arg_mode
/* trie_put_entry(-Trie,-Entry,+Ref) */ /* trie_put_entry(+Trie,+Entry,-Ref) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
#define arg_ref YAP_ARG3 #define arg_ref YAP_ARG3
@ -295,7 +295,7 @@ static int p_trie_put_entry(void) {
#undef arg_ref #undef arg_ref
/* trie_check_entry(-Trie,-Entry,+Ref) */ /* trie_check_entry(+Trie,+Entry,-Ref) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
#define arg_ref YAP_ARG3 #define arg_ref YAP_ARG3
@ -316,7 +316,7 @@ static int p_trie_check_entry(void) {
#undef arg_ref #undef arg_ref
/* trie_get_entry(-Ref,+Entry) */ /* trie_get_entry(+Ref,-Entry) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
#define arg_entry YAP_ARG2 #define arg_entry YAP_ARG2
static int p_trie_get_entry(void) { static int p_trie_get_entry(void) {
@ -334,7 +334,7 @@ static int p_trie_get_entry(void) {
#undef arg_entry #undef arg_entry
/* trie_get_first_entry(-Trie,+Ref) */ /* trie_get_first_entry(+Trie,-Ref) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_ref YAP_ARG2 #define arg_ref YAP_ARG2
static int p_trie_get_first_entry(void) { static int p_trie_get_first_entry(void) {
@ -353,7 +353,7 @@ static int p_trie_get_first_entry(void) {
#undef arg_ref #undef arg_ref
/* trie_get_last_entry(-Trie,+Ref) */ /* trie_get_last_entry(+Trie,-Ref) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_ref YAP_ARG2 #define arg_ref YAP_ARG2
static int p_trie_get_last_entry(void) { static int p_trie_get_last_entry(void) {
@ -372,7 +372,7 @@ static int p_trie_get_last_entry(void) {
#undef arg_ref #undef arg_ref
/* trie_traverse(-Trie,-FirstRef,+Ref) */ /* trie_traverse(+Trie,+FirstRef,-Ref) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_init_ref YAP_ARG2 #define arg_init_ref YAP_ARG2
#define arg_ref YAP_ARG3 #define arg_ref YAP_ARG3
@ -397,7 +397,7 @@ static int p_trie_traverse_init(void) {
#undef arg_ref #undef arg_ref
/* trie_traverse(-Trie,-FirstRef,+Ref) */ /* trie_traverse(+Trie,+FirstRef,-Ref) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_init_ref YAP_ARG2 #define arg_init_ref YAP_ARG2
#define arg_ref YAP_ARG3 #define arg_ref YAP_ARG3
@ -416,7 +416,7 @@ static int p_trie_traverse_cont(void) {
#undef arg_ref #undef arg_ref
/* trie_remove_entry(-Ref) */ /* trie_remove_entry(+Ref) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
static int p_trie_remove_entry(void) { static int p_trie_remove_entry(void) {
/* check arg */ /* check arg */
@ -430,7 +430,7 @@ static int p_trie_remove_entry(void) {
#undef arg_ref #undef arg_ref
/* trie_remove_subtree(-Ref) */ /* trie_remove_subtree(+Ref) */
#define arg_ref YAP_ARG1 #define arg_ref YAP_ARG1
static int p_trie_remove_subtree(void) { static int p_trie_remove_subtree(void) {
/* check arg */ /* check arg */
@ -444,7 +444,7 @@ static int p_trie_remove_subtree(void) {
#undef arg_ref #undef arg_ref
/* trie_join(-TrieDest,-TrieSource) */ /* trie_join(+TrieDest,+TrieSource) */
#define arg_trie_dest YAP_ARG1 #define arg_trie_dest YAP_ARG1
#define arg_trie_source YAP_ARG2 #define arg_trie_source YAP_ARG2
static int p_trie_join(void) { static int p_trie_join(void) {
@ -462,7 +462,7 @@ static int p_trie_join(void) {
#undef arg_trie_source #undef arg_trie_source
/* trie_intersect(-TrieDest,-TrieSource) */ /* trie_intersect(+TrieDest,+TrieSource) */
#define arg_trie_dest YAP_ARG1 #define arg_trie_dest YAP_ARG1
#define arg_trie_source YAP_ARG2 #define arg_trie_source YAP_ARG2
static int p_trie_intersect(void) { static int p_trie_intersect(void) {
@ -480,7 +480,7 @@ static int p_trie_intersect(void) {
#undef arg_trie_source #undef arg_trie_source
/* trie_count_join(-Trie1,-Trie2,+Entries) */ /* trie_count_join(+Trie1,+Trie2,-Entries) */
#define arg_trie1 YAP_ARG1 #define arg_trie1 YAP_ARG1
#define arg_trie2 YAP_ARG2 #define arg_trie2 YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -502,7 +502,7 @@ static int p_trie_count_join(void) {
#undef arg_entries #undef arg_entries
/* trie_count_intersect(-Trie1,-Trie2,+Entries) */ /* trie_count_intersect(+Trie1,+Trie2,-Entries) */
#define arg_trie1 YAP_ARG1 #define arg_trie1 YAP_ARG1
#define arg_trie2 YAP_ARG2 #define arg_trie2 YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -524,7 +524,7 @@ static int p_trie_count_intersect(void) {
#undef arg_entries #undef arg_entries
/* trie_save(-Trie,-FileName) */ /* trie_save(+Trie,+FileName) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static int p_trie_save(void) { static int p_trie_save(void) {
@ -552,7 +552,7 @@ static int p_trie_save(void) {
#undef arg_file #undef arg_file
/* trie_load(+Trie,-FileName) */ /* trie_load(-Trie,+FileName) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_file YAP_ARG2 #define arg_file YAP_ARG2
static int p_trie_load(void) { static int p_trie_load(void) {
@ -572,10 +572,9 @@ static int p_trie_load(void) {
return FALSE; return FALSE;
/* load trie and close file */ /* load trie and close file */
data = trie_load(file); if (!(data = trie_load(file)))
if (fclose(file))
return FALSE; return FALSE;
if (!data) if (fclose(file))
return FALSE; return FALSE;
return YAP_Unify(arg_trie, YAP_MkIntTerm((YAP_Int) data)); return YAP_Unify(arg_trie, YAP_MkIntTerm((YAP_Int) data));
} }
@ -583,7 +582,7 @@ static int p_trie_load(void) {
#undef arg_file #undef arg_file
/* trie_stats(+Memory,+Tries,+Entries,+Nodes) */ /* trie_stats(-Memory,-Tries,-Entries,-Nodes) */
#define arg_memory YAP_ARG1 #define arg_memory YAP_ARG1
#define arg_tries YAP_ARG2 #define arg_tries YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -609,7 +608,7 @@ static int p_trie_stats(void) {
#undef arg_nodes #undef arg_nodes
/* trie_max_stats(+Memory,+Tries,+Entries,+Nodes) */ /* trie_max_stats(-Memory,-Tries,-Entries,-Nodes) */
#define arg_memory YAP_ARG1 #define arg_memory YAP_ARG1
#define arg_tries YAP_ARG2 #define arg_tries YAP_ARG2
#define arg_entries YAP_ARG3 #define arg_entries YAP_ARG3
@ -635,7 +634,7 @@ static int p_trie_max_stats(void) {
#undef arg_nodes #undef arg_nodes
/* trie_usage(-Trie,+Entries,+Nodes,+VirtualNodes) */ /* trie_usage(+Trie,-Entries,-Nodes,-VirtualNodes) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
#define arg_entries YAP_ARG2 #define arg_entries YAP_ARG2
#define arg_nodes YAP_ARG3 #define arg_nodes YAP_ARG3
@ -663,7 +662,7 @@ static int p_trie_usage(void) {
#undef arg_virtualnodes #undef arg_virtualnodes
/* trie_print(-Trie) */ /* trie_print(+Trie) */
#define arg_trie YAP_ARG1 #define arg_trie YAP_ARG1
static int p_trie_print(void) { static int p_trie_print(void) {
/* check arg */ /* check arg */

View File

@ -1858,11 +1858,14 @@ PL_record(term_t ts)
return (record_t)Yap_StoreTermInDB(t, 0); return (record_t)Yap_StoreTermInDB(t, 0);
} }
X_API void X_API int
PL_recorded(record_t db, term_t ts) PL_recorded(record_t db, term_t ts)
{ {
Term t = Yap_FetchTermFromDB((DBTerm *)db); Term t = Yap_FetchTermFromDB((DBTerm *)db);
if (t == 0L)
return FALSE;
Yap_PutInSlot(ts,t); Yap_PutInSlot(ts,t);
return TRUE;
} }
X_API void X_API void
@ -1959,6 +1962,12 @@ PL_exception(qid_t q)
} }
} }
X_API void
PL_clear_exception(void)
{
EX = 0L;
}
X_API int X_API int
PL_initialise(int myargc, char **myargv) PL_initialise(int myargc, char **myargv)
{ {

27
misc/yap.nsi Normal file → Executable file
View File

@ -29,7 +29,7 @@ ComponentText "This will install YAP on your computer."
DirText "This program will install YAP on your computer.\ DirText "This program will install YAP on your computer.\
Choose a directory" Choose a directory"
LicenseData c:\Yap\share\docs\Artistic LicenseData c:\Yap\share\docs\Yap\Artistic
LicenseText "YAP is governed by the Artistic License,\ LicenseText "YAP is governed by the Artistic License,\
but includes code under the GPL and LGPL." but includes code under the GPL and LGPL."
@ -53,16 +53,7 @@ Section "Base system (required)"
SetOutPath $INSTDIR\bin SetOutPath $INSTDIR\bin
; SYSTEM STUFF ; SYSTEM STUFF
File c:\Yap\lib\Yap\matrix.dll File c:\Yap\lib\Yap\*.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
SetOutPath $INSTDIR\lib SetOutPath $INSTDIR\lib
; SYSTEM STUFF ; SYSTEM STUFF
@ -76,12 +67,12 @@ Section "Base system (required)"
; SYSTEM STUFF ; SYSTEM STUFF
File /r c:\Yap\share\Yap\* File /r c:\Yap\share\Yap\*
SetOutPath $INSTDIR\docs SetOutPath $INSTDIR\docs\Yap
File c:\Yap\share\docs\yap.html File c:\Yap\share\docs\Yap\yap.html
File c:\Yap\share\docs\yap.pdf File c:\Yap\share\docs\Yap\yap.pdf
File c:\Yap\share\docs\Artistic File c:\Yap\share\docs\Yap\Artistic
File c:\Yap\share\docs\README.TXT File c:\Yap\share\docs\Yap\README.TXT
File c:\Yap\share\docs\COPYING.TXT File c:\Yap\share\docs\Yap\COPYING.TXT
WriteRegStr HKLM ${REGKEY} "home" "$INSTDIR" WriteRegStr HKLM ${REGKEY} "home" "$INSTDIR"
WriteRegStr HKLM ${REGKEY} "startup" "$INSTDIR\lib\startup.yss" WriteRegStr HKLM ${REGKEY} "startup" "$INSTDIR\lib\startup.yss"
@ -277,4 +268,4 @@ Function .onInstFailed
installer, please contact yap-users@sf.net" installer, please contact yap-users@sf.net"
FunctionEnd FunctionEnd
outfile "yap-5.1.4-installer.exe" outfile "yap-6.0.0-installer.exe"

View File

@ -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-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 $(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 \ 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-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \
$(srcdir)/pl-privitf.c \ $(srcdir)/pl-privitf.c \
$(srcdir)/pl-stream.c $(srcdir)/pl-string.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-text.c \
$(srcdir)/pl-utils.c \ $(srcdir)/pl-utils.c \
$(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.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-file.o pl-files.o pl-os.o pl-privitf.o \
pl-stream.o pl-string.o pl-table.o \ pl-stream.o pl-string.o pl-table.o \
pl-text.o pl-utils.o pl-utf8.o \ pl-text.o pl-utils.o pl-utf8.o \

View File

@ -504,6 +504,7 @@
#define ATOM_term_position MK_ATOM("term_position") #define ATOM_term_position MK_ATOM("term_position")
#define ATOM_terminal MK_ATOM("terminal") #define ATOM_terminal MK_ATOM("terminal")
#define ATOM_terminal_capability MK_ATOM("terminal_capability") #define ATOM_terminal_capability MK_ATOM("terminal_capability")
#define ATOM_temporary_files MK_ATOM("temporary_files")
#define ATOM_text MK_ATOM("text") #define ATOM_text MK_ATOM("text")
#define ATOM_thread MK_ATOM("thread") #define ATOM_thread MK_ATOM("thread")
#define ATOM_thread_cputime MK_ATOM("thread_cputime") #define ATOM_thread_cputime MK_ATOM("thread_cputime")

View File

@ -298,7 +298,8 @@ unify_char_type(term_t type, const char_type *ct, int context, int how)
static foreign_t static foreign_t
do_char_type(term_t chr, term_t class, control_t h, int how) do_char_type(term_t chr, term_t class, control_t h, int how)
{ generator *gen; { GET_LD
generator *gen;
fid_t fid; fid_t fid;
switch( ForeignControl(h) ) switch( ForeignControl(h) )
@ -399,7 +400,9 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
succeed; succeed;
} }
fid = PL_open_foreign_frame(); if ( !(fid = PL_open_foreign_frame()) )
goto error;
for(;;) for(;;)
{ int rval; { int rval;
@ -412,7 +415,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
{ if ( rval < 0 || { if ( rval < 0 ||
!unify_char_type(class, gen->class, rval, how) ) !unify_char_type(class, gen->class, rval, how) )
goto next; goto next;
} else if ( gen->do_enum & ENUM_CLASS ) } else if ( gen->do_enum & ENUM_CLASS )
{ if ( !unify_char_type(class, gen->class, rval, how) ) { if ( !unify_char_type(class, gen->class, rval, how) )
goto next; goto next;
@ -432,6 +435,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
break; break;
} }
error:
freeHeap(gen, sizeof(*gen)); freeHeap(gen, sizeof(*gen));
fail; fail;
} }
@ -440,13 +444,13 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
static static
PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC) 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 static
PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC) 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 static foreign_t
modify_case_atom(term_t in, term_t out, int down) 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) ) if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE; return FALSE;
@ -578,7 +583,7 @@ modify_case_atom(term_t in, term_t out, int down)
{ tout.text.t[i] = (char)c; { tout.text.t[i] = (char)c;
} }
} }
} }
} else } else
{ if ( down ) { if ( down )
{ for(i=0; i<tin.length; i++) { for(i=0; i<tin.length; i++)
@ -619,7 +624,8 @@ PRED_IMPL("upcase_atom", 2, upcase_atom, 0)
static int static int
write_normalize_space(IOSTREAM *out, term_t in) write_normalize_space(IOSTREAM *out, term_t in)
{ PL_chars_t tin; { GET_LD
PL_chars_t tin;
size_t i, end; size_t i, end;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) ) if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
@ -655,18 +661,12 @@ PRED_IMPL("normalize_space", 2, normalize_space, 0)
{ redir_context ctx; { redir_context ctx;
word rc; word rc;
EXCEPTION_GUARDED(/*code*/ if ( (rc = setupOutputRedirect(A1, &ctx, FALSE)) )
if ( setupOutputRedirect(A1, &ctx, FALSE) ) { if ( (rc = write_normalize_space(ctx.stream, A2)) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) ) rc = closeOutputRedirect(&ctx);
rc = closeOutputRedirect(&ctx); else
else discardOutputRedirect(&ctx);
discardOutputRedirect(&ctx); }
} else
rc = FALSE;
/*cleanup*/,
DEBUG(1, Sdprintf("Cleanup after throw()\n"));
discardOutputRedirect(&ctx);
rc = PL_rethrow(););
return rc; return rc;
} }
@ -730,7 +730,8 @@ static lccat lccats[] =
static static
PRED_IMPL("setlocale", 3, setlocale, 0) PRED_IMPL("setlocale", 3, setlocale, 0)
{ char *what; { PRED_LD
char *what;
char *locale; char *locale;
const lccat *lcp; const lccat *lcp;
@ -794,28 +795,28 @@ EndPredDefs
const char _PL_char_types[] = { const char _PL_char_types[] = {
/* ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O 0-15 */ /* ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O 0-15 */
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,
/* ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_ 16-31 */ /* ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_ 16-31 */
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,
/* sp ! " # $ % & ' ( ) * + , - . / 32-47 */ /* sp ! " # $ % & ' ( ) * + , - . / 32-47 */
SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY, SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? 48-63 */ /* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? 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 */ /* @ 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 */ /* 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 */ /* ` 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 */ /* 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) */ /* 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) */ /* 160-255 (G1 graphics) */
/* ISO Latin 1 is assumed */ /* ISO Latin 1 is assumed */
SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO, 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, 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, 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, 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 IOENC
initEncoding(void) initEncoding(void)
{ if ( LD ) { GET_LD
if ( LD )
{ if ( !LD->encoding ) { if ( !LD->encoding )
{ char *enc; { char *enc;
@ -882,7 +885,8 @@ initCharTypes(void)
#if __SWI_PROLOG__ #if __SWI_PROLOG__
bool bool
systemMode(bool accept) systemMode(bool accept)
{ bool old = SYSTEM_MODE ? TRUE : FALSE; { GET_LD
bool old = SYSTEM_MODE ? TRUE : FALSE;
if ( accept ) if ( accept )
debugstatus.styleCheck |= DOLLAR_STYLE; debugstatus.styleCheck |= DOLLAR_STYLE;

View File

@ -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;
}

View File

@ -69,7 +69,7 @@ handling times must be cleaned, but that not only holds for this module.
#undef LD /* fetch LD once per function */ #undef LD /* fetch LD once per function */
#define LD LOCAL_LD #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 noprotocol(void);
static int streamStatus(IOSTREAM *s); static int streamStatus(IOSTREAM *s);
@ -261,9 +261,13 @@ freeStream(IOSTREAM *s)
if ( (symb=lookupHTable(streamContext, s)) ) if ( (symb=lookupHTable(streamContext, s)) )
{ stream_context *ctx = symb->value; { stream_context *ctx = symb->value;
if ( ctx->filename == source_file_name ) if ( ctx->filename != NULL_ATOM )
{ source_file_name = NULL_ATOM; /* TBD: pop? */ { PL_unregister_atom(ctx->filename);
source_line_no = -1;
if ( ctx->filename == source_file_name )
{ source_file_name = NULL_ATOM; /* TBD: pop? */
source_line_no = -1;
}
} }
freeHeap(ctx, sizeof(*ctx)); freeHeap(ctx, sizeof(*ctx));
@ -289,10 +293,18 @@ freeStream(IOSTREAM *s)
/* MT: locked by caller (openStream()) */ /* MT: locked by caller (openStream()) */
/* name must be registered by the caller */
static void static void
setFileNameStream(IOSTREAM *s, atom_t name) 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 } else
{ term_t a = PL_new_term_ref(); { term_t a = PL_new_term_ref();
PL_put_pointer(a, s); rval = ( (a=PL_new_term_ref()) &&
PL_cons_functor(a, FUNCTOR_dstream1, a); PL_put_pointer(a, s) &&
PL_cons_functor(a, FUNCTOR_dstream1, a) &&
rval = PL_unify(t, a); PL_unify(t, a)
);
} }
UNLOCK(); UNLOCK();
if ( !rval && !PL_is_variable(t) )
return PL_error(NULL, 0, "stream-argument", ERR_MUST_BE_VAR, 0);
return rval; return rval;
} }
@ -541,8 +557,10 @@ PL_unify_stream(term_t t, IOSTREAM *s)
ctx = getStreamContext(s); ctx = getStreamContext(s);
UNLOCK(); UNLOCK();
PL_put_pointer(a, s); if ( !(a = PL_new_term_ref()) ||
PL_cons_functor(a, FUNCTOR_dstream1, a); !PL_put_pointer(a, s) ||
!PL_cons_functor(a, FUNCTOR_dstream1, a) )
return FALSE; /* resource error */
if ( PL_unify(t, a) ) if ( PL_unify(t, a) )
return TRUE; return TRUE;
@ -666,14 +684,21 @@ reportStreamError(IOSTREAM *s)
if ( (s->flags & SIO_FERR) ) if ( (s->flags & SIO_FERR) )
{ if ( s->exception ) { if ( s->exception )
{ fid_t fid = PL_open_foreign_frame(); { fid_t fid;
term_t ex = PL_new_term_ref(); term_t ex;
PL_recorded(s->exception, 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); PL_erase(s->exception);
s->exception = NULL; s->exception = NULL;
PL_raise_exception(ex); if ( rc )
rc = PL_raise_exception(ex);
PL_close_foreign_frame(fid); PL_close_foreign_frame(fid);
return FALSE; return rc;
} }
if ( s->flags & SIO_INPUT ) if ( s->flags & SIO_INPUT )
@ -1038,11 +1063,11 @@ closeOutputRedirect(redir_context *ctx)
rval = PL_unify_wchars_diff(out, tail, ctx->out_format, rval = PL_unify_wchars_diff(out, tail, ctx->out_format,
ctx->size/sizeof(wchar_t), ctx->size/sizeof(wchar_t),
(wchar_t*)ctx->data); (wchar_t*)ctx->data);
if ( tail ) if ( rval && tail )
rval = PL_unify(tail, diff); rval = PL_unify(tail, diff);
if ( ctx->data != ctx->buffer ) if ( ctx->data != ctx->buffer )
free(ctx->data); Sfree(ctx->data);
} }
return rval; return rval;
@ -1064,7 +1089,7 @@ discardOutputRedirect(redir_context *ctx)
} else } else
{ closeStream(ctx->stream); { closeStream(ctx->stream);
if ( ctx->data != ctx->buffer ) 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 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; goto ok;
} else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */ } else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */
{ int close; { int close;
@ -1428,6 +1469,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
if ( !PL_get_atom_ex(a, &fn) ) if ( !PL_get_atom_ex(a, &fn) )
goto error; goto error;
PL_register_atom(fn);
LOCK(); LOCK();
setFileNameStream(s, fn); setFileNameStream(s, fn);
UNLOCK(); UNLOCK();
@ -1467,7 +1509,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
if ( !PL_get_atom_ex(a, &val) ) if ( !PL_get_atom_ex(a, &val) )
goto error; goto error;
if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN ) if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN )
{ bad_encoding(val); { bad_encoding(NULL, val);
goto error; goto error;
} }
@ -2191,7 +2233,12 @@ PRED_IMPL("get_single_char", 1, get_single_char, 0)
int c = getSingleChar(s, TRUE); int c = getSingleChar(s, TRUE);
if ( c == EOF ) if ( c == EOF )
{ PL_unify_integer(A1, -1); { if ( PL_exception(0) )
{ releaseStream(s);
return FALSE;
}
PL_unify_integer(A1, -1);
return streamStatus(s); return streamStatus(s);
} }
@ -2512,12 +2559,12 @@ encoding_to_atom(IOENC enc)
static int static int
bad_encoding(atom_t name) bad_encoding(const char *msg, atom_t name)
{ GET_LD { GET_LD
term_t t = PL_new_term_ref(); term_t t = PL_new_term_ref();
PL_put_atom(t, name); 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 ) if ( encoding != NULL_ATOM )
{ enc = atom_to_encoding(encoding); { enc = atom_to_encoding(encoding);
if ( enc == ENC_UNKNOWN ) if ( enc == ENC_UNKNOWN )
{ bad_encoding(encoding); { bad_encoding(NULL, encoding);
return NULL; 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 ) } else if ( type == ATOM_binary )
{ enc = ENC_OCTET; { enc = ENC_OCTET;
bom = FALSE; bom = FALSE;
@ -2675,10 +2735,12 @@ openStream(term_t file, term_t mode, term_t options)
} }
#ifdef HAVE_POPEN #ifdef HAVE_POPEN
else if ( PL_is_functor(file, FUNCTOR_pipe1) ) else if ( PL_is_functor(file, FUNCTOR_pipe1) )
{ term_t a = PL_new_term_ref(); { term_t a;
char *cmd; 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) ) if ( !PL_get_chars(a, &cmd, CVT_ATOM|CVT_STRING|REP_FN) )
{ PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a); { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a);
return NULL; 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(;;) for(;;)
{ if ( pe->s ) /* given stream */ { if ( pe->s ) /* given stream */
@ -3531,7 +3601,8 @@ PRED_IMPL("stream_property", 2, stream_property,
goto enum_e; goto enum_e;
} }
fid2 = PL_open_foreign_frame(); if ( !(fid2 = PL_open_foreign_frame()) )
goto error;
for( ; pe->p->functor ; pe->p++ ) for( ; pe->p->functor ; pe->p++ )
{ if ( PL_unify_functor(property, pe->p->functor) ) { if ( PL_unify_functor(property, pe->p->functor) )
{ int rval; { int rval;
@ -3559,6 +3630,9 @@ PRED_IMPL("stream_property", 2, stream_property,
} }
} }
if ( exception_term )
goto error;
if ( pe->fixed_p ) if ( pe->fixed_p )
break; break;
PL_rewind_foreign_frame(fid2); PL_rewind_foreign_frame(fid2);
@ -3579,6 +3653,8 @@ PRED_IMPL("stream_property", 2, stream_property,
pe->p = sprop_list; pe->p = sprop_list;
break; break;
} }
if ( exception_term )
goto error;
} }
} }
@ -4081,11 +4157,16 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0)
{ PRED_LD { PRED_LD
IOSTREAM *in = NULL, *out = NULL, *error = NULL; IOSTREAM *in = NULL, *out = NULL, *error = NULL;
int rval = FALSE; int rval = FALSE;
int wrapin = FALSE;
if ( !PL_get_stream_handle(A1, &in) || if ( !get_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED) ||
!PL_get_stream_handle(A2, &out) ) !get_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS) )
goto out; goto out;
wrapin = (LD->IO.streams[0] != in);
if ( wrapin )
in = getStream(in); /* lock it */
if ( PL_compare(A2, A3) == 0 ) /* == */ if ( PL_compare(A2, A3) == 0 ) /* == */
{ error = getStream(Snew(out->handle, out->flags, out->functions)); { error = getStream(Snew(out->handle, out->flags, out->functions));
error->flags &= ~SIO_ABUF; /* disable buffering */ 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_ABUF; /* output: line buffered */
out->flags |= SIO_LBUF; out->flags |= SIO_LBUF;
LD->IO.streams[0] = in; /* user_input */
LD->IO.streams[1] = out; /* user_output */ LD->IO.streams[1] = out; /* user_output */
LD->IO.streams[2] = error; /* user_error */ LD->IO.streams[2] = error; /* user_error */
LD->IO.streams[3] = in; /* current_input */
LD->IO.streams[4] = out; /* current_output */ LD->IO.streams[4] = out; /* current_output */
wrapIO(in, Sread_user, NULL); if ( wrapin )
LD->prompt.next = TRUE; { LD->IO.streams[3] = in; /* current_input */
LD->IO.streams[0] = in; /* user_input */
wrapIO(in, Sread_user, NULL);
LD->prompt.next = TRUE;
}
UNLOCK(); UNLOCK();
rval = TRUE; rval = TRUE;
out: out:
if ( in ) if ( wrapin && in )
releaseStream(in); releaseStream(in);
if ( out ) if ( out )
releaseStream(out); releaseStream(out);

View File

@ -351,21 +351,25 @@ MarkExecutable(const char *name)
* FIND FILES FROM C * * FIND FILES FROM C *
*********************************/ *********************************/
int static int
unifyTime(term_t t, time_t time) unifyTime(term_t t, time_t time)
{ return PL_unify_float(t, (double)time); { return PL_unify_float(t, (double)time);
} }
static void static int
add_option(term_t options, functor_t f, atom_t val) add_option(term_t options, functor_t f, atom_t val)
{ GET_LD { GET_LD
term_t head = PL_new_term_ref(); term_t head;
PL_unify_list(options, head, options); if ( (head=PL_new_term_ref()) &&
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val); 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) #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]; char ospath[MAXPATHLEN];
if ( flags & PL_FILE_SEARCH ) if ( flags & PL_FILE_SEARCH )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system"); { fid_t fid;
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);
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 ) PL_put_term(av+0, n);
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_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) ) if ( rc ) rc = PL_unify_nil(options);
return FALSE; 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 ) 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) ) if ( !PL_get_chars(base, &n, CVT_ALL) )
return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base); 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 * * CHANGE FILESYSTEM *
@ -653,7 +706,13 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
static static
PRED_IMPL("delete_file", 1, delete_file, 0) 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) ) if ( !PL_get_file_name(A1, &n, 0) )
return FALSE; return FALSE;
@ -662,7 +721,7 @@ PRED_IMPL("delete_file", 1, delete_file, 0)
return TRUE; return TRUE;
return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, 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 static int
name_too_long() name_too_long(void)
{ return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); { 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_file", 1, exists_file, 0)
PRED_DEF("exists_directory", 1, exists_directory, 0) PRED_DEF("exists_directory", 1, exists_directory, 0)
PRED_DEF("tmp_file", 2, tmp_file, 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_file", 1, delete_file, 0)
PRED_DEF("delete_directory", 1, delete_directory, 0) PRED_DEF("delete_directory", 1, delete_directory, 0)
PRED_DEF("make_directory", 1, make_directory, 0) PRED_DEF("make_directory", 1, make_directory, 0)

View File

@ -109,8 +109,7 @@ typedef struct {
} prolog_flag; } prolog_flag;
struct struct
{ TempFile _tmpfile_head; { Table tmp_files; /* Known temporary files */
TempFile _tmpfile_tail;
CanonicalDir _canonical_dirlist; CanonicalDir _canonical_dirlist;
char * myhome; /* expansion of ~ */ char * myhome; /* expansion of ~ */
char * fred; /* last expanded ~user */ char * fred; /* last expanded ~user */
@ -123,6 +122,25 @@ typedef struct {
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */ IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
} os; } 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 struct
{ atom_t * array; /* index --> atom */ { atom_t * array; /* index --> atom */
size_t count; /* elements in array */ size_t count; /* elements in array */
@ -136,6 +154,8 @@ extern gds_t gds;
#define GD (&gds) #define GD (&gds)
#define GLOBAL_LD (&gds) #define GLOBAL_LD (&gds)
typedef struct typedef struct
{ unsigned long flags; /* Fast access to some boolean Prolog flags */ { unsigned long flags; /* Fast access to some boolean Prolog flags */
} pl_features_t; } pl_features_t;
@ -280,6 +300,7 @@ typedef struct PL_local_data {
term_t tmp; /* tmp for errors */ term_t tmp; /* tmp for errors */
term_t pending; /* used by the debugger */ term_t pending; /* used by the debugger */
int in_hook; /* inside exception_hook() */ int in_hook; /* inside exception_hook() */
int processing; /* processing an exception */
exception_frame *throw_environment; /* PL_throw() environments */ exception_frame *throw_environment; /* PL_throw() environments */
} exception; } exception;
const char *float_format; /* floating point format */ const char *float_format; /* floating point format */
@ -290,6 +311,8 @@ typedef struct PL_local_data {
} PL_local_data_t; } PL_local_data_t;
#define usedStack(D) 0
#define features (LD->feature.mask) #define features (LD->feature.mask)
extern PL_local_data_t lds; 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 ****/ /**** stuff from pl-files.c ****/
void initFiles(void); void initFiles(void);
int RemoveFile(const char *path);
int PL_get_file_name(term_t n, char **namep, int flags);
/* empty stub */ /* empty stub */
void setPrologFlag(const char *name, int flags, ...); void setPrologFlag(const char *name, int flags, ...);

View File

@ -119,7 +119,8 @@ have to be dropped. See the header of pl-incl.h for details.
bool bool
initOs(void) initOs(void)
{ DEBUG(1, Sdprintf("OS:initExpand() ...\n")); { GET_LD
DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
initExpand(); initExpand();
DEBUG(1, Sdprintf("OS:initEnviron() ...\n")); DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
initEnviron(); initEnviron();
@ -409,10 +410,10 @@ setOSPrologFlags(void)
* MEMORY * * MEMORY *
*******************************/ *******************************/
#if __SWI_PROLOG__
uintptr_t uintptr_t
UsedMemory(void) UsedMemory(void)
{ { GET_LD
#if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS) #if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS)
struct rusage usage; struct rusage usage;
@ -427,23 +428,15 @@ UsedMemory(void)
usedStack(local) + usedStack(local) +
usedStack(trail)); usedStack(trail));
} }
#else
uintptr_t
UsedMemory(void)
{
return 0;
}
#endif
uintptr_t uintptr_t
FreeMemory(void) FreeMemory(void)
{ {
#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA) #if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
uintptr_t used = UsedMemory(); uintptr_t used = UsedMemory();
struct rlimit limit; struct rlimit limit;
if ( getrlimit(RLIMIT_DATA, &limit) == 0 ) if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
return limit.rlim_cur - used; return limit.rlim_cur - used;
@ -511,7 +504,9 @@ setRandom(unsigned int *seedp)
uint64_t uint64_t
_PL_Random(void) _PL_Random(void)
{ if ( !LD->os.rand_initialised ) { GET_LD
if ( !LD->os.rand_initialised )
{ setRandom(NULL); { setRandom(NULL);
LD->os.rand_initialised = TRUE; LD->os.rand_initialised = TRUE;
} }
@ -530,9 +525,9 @@ _PL_Random(void)
#else #else
{ uint64_t l = rand(); /* 0<n<2^15-1 */ { uint64_t l = rand(); /* 0<n<2^15-1 */
l ^= rand()<<15; l ^= (uint64_t)rand()<<15;
l ^= rand()<<30; l ^= (uint64_t)rand()<<30;
l ^= rand()<<45; l ^= (uint64_t)rand()<<45;
return l; return l;
} }
@ -552,7 +547,7 @@ available to the Prolog user based on these functions. These functions
are in this module as non-UNIX OS probably don't have getpid() or put are in this module as non-UNIX OS probably don't have getpid() or put
temporaries on /tmp. temporaries on /tmp.
atom_t TemporaryFile(const char *id) atom_t TemporaryFile(const char *id, int *fdp)
The return value of this call is an atom, whose string represents The return value of this call is an atom, whose string represents
the path name of a unique file that can be used as temporary file. the path name of a unique file that can be used as temporary file.
@ -566,14 +561,6 @@ temporaries on /tmp.
not be created at all, or might already have been deleted. not be created at all, or might already have been deleted.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
struct tempfile
{ atom_t name;
TempFile next;
}; /* chain of temporary files */
#define tmpfile_head (GD->os._tmpfile_head)
#define tmpfile_tail (GD->os._tmpfile_tail)
#ifndef DEFTMPDIR #ifndef DEFTMPDIR
#ifdef __WINDOWS__ #ifdef __WINDOWS__
#define DEFTMPDIR "c:/tmp" #define DEFTMPDIR "c:/tmp"
@ -582,22 +569,64 @@ struct tempfile
#endif #endif
#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 atom_t
TemporaryFile(const char *id) TemporaryFile(const char *id, int *fdp)
{ char temp[MAXPATHLEN]; { char temp[MAXPATHLEN];
TempFile tf = allocHeap(sizeof(struct tempfile)); static char *tmpdir = NULL;
char envbuf[MAXPATHLEN]; atom_t tname;
char *tmpdir; int retries = 0;
if ( !((tmpdir = Getenv("TEMP", envbuf, sizeof(envbuf))) || if ( !tmpdir )
(tmpdir = Getenv("TMP", envbuf, sizeof(envbuf)))) ) { LOCK();
tmpdir = DEFTMPDIR; 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__ #ifdef __unix__
{ static int MTOK_temp_counter = 0; { static int MTOK_temp_counter = 0;
const char *sep = id[0] ? "_" : "";
Ssprintf(temp, "%s/pl_%s_%d_%d", Ssprintf(temp, "%s/pl_%s%s%d_%d",
tmpdir, id, (int) getpid(), MTOK_temp_counter++); tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++);
} }
#endif #endif
@ -612,49 +641,74 @@ TemporaryFile(const char *id)
#endif #endif
{ PrologPath(tmp, temp, sizeof(temp)); { PrologPath(tmp, temp, sizeof(temp));
} else } else
Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++); { const char *sep = id[0] ? "_" : "";
}
#endif
#if EMX Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++);
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;
} }
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 void
RemoveTemporaryFiles(void) RemoveTemporaryFiles(void)
{ TempFile tf, tf2; { LOCK();
if ( GD->os.tmp_files )
{ Table t = GD->os.tmp_files;
startCritical; GD->os.tmp_files = NULL;
for(tf = tmpfile_head; tf; tf = tf2) UNLOCK();
{ RemoveFile(stringAtom(tf->name)); destroyHTable(t);
tf2 = tf->next; } else
freeHeap(tf, sizeof(struct tempfile)); { UNLOCK();
} }
tmpfile_head = tmpfile_tail = NULL;
endCritical;
} }
@ -756,7 +810,8 @@ OsPath(const char *p, char *buf)
#if O_XOS #if O_XOS
char * char *
PrologPath(const char *p, char *buf, size_t len) 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); return _xos_canonical_filename(p, buf, len, flags);
} }
@ -813,7 +868,7 @@ forwards char *canoniseDir(char *);
static void static void
initExpand(void) initExpand(void)
{ { GET_LD
#ifdef O_CANONISE_DIRS #ifdef O_CANONISE_DIRS
char *dir; char *dir;
char *cpaths; char *cpaths;
@ -923,6 +978,7 @@ verify_entry(CanonicalDir d)
d->inode = buf.st_ino; d->inode = buf.st_ino;
d->device = buf.st_dev; d->device = buf.st_dev;
return TRUE;
} else } else
{ DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical)); { 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); free(d);
} }
@ -1139,7 +1198,9 @@ utf8_strlwr(char *s)
char * char *
canonisePath(char *path) canonisePath(char *path)
{ if ( !truePrologFlag(PLFLAG_FILE_CASE) ) { GET_LD
if ( !truePrologFlag(PLFLAG_FILE_CASE) )
utf8_strlwr(path); utf8_strlwr(path);
canoniseFileName(path); canoniseFileName(path);
@ -1186,7 +1247,8 @@ takeWord(const char **string, char *wrd, int maxlen)
bool bool
expandVars(const char *pattern, char *expanded, int maxlen) expandVars(const char *pattern, char *expanded, int maxlen)
{ int size = 0; { GET_LD
int size = 0;
char wordbuf[MAXPATHLEN]; char wordbuf[MAXPATHLEN];
if ( *pattern == '~' ) if ( *pattern == '~' )
@ -1338,7 +1400,8 @@ ExpandFile(const char *pattern, char **vector)
char * char *
ExpandOneFile(const char *spec, char *file) ExpandOneFile(const char *spec, char *file)
{ char *vector[256]; { GET_LD
char *vector[256];
int size; int size;
switch( (size=ExpandFile(spec, vector)) ) switch( (size=ExpandFile(spec, vector)) )
@ -1437,10 +1500,13 @@ IsAbsolutePath(const char *p)
char * char *
AbsoluteFile(const char *spec, char *path) AbsoluteFile(const char *spec, char *path)
{ char tmp[MAXPATHLEN]; { GET_LD
char tmp[MAXPATHLEN];
char buf[MAXPATHLEN]; char buf[MAXPATHLEN];
char *file = PrologPath(spec, buf, sizeof(buf)); char *file = PrologPath(spec, buf, sizeof(buf));
if ( !file )
return (char *) NULL;
if ( truePrologFlag(PLFLAG_FILEVARS) ) if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(file = ExpandOneFile(buf, tmp)) ) { if ( !(file = ExpandOneFile(buf, tmp)) )
return (char *) NULL; return (char *) NULL;
@ -1485,7 +1551,9 @@ AbsoluteFile(const char *spec, char *path)
void void
PL_changed_cwd(void) PL_changed_cwd(void)
{ if ( CWDdir ) { GET_LD
if ( CWDdir )
remove_string(CWDdir); remove_string(CWDdir);
CWDdir = NULL; CWDdir = NULL;
CWDlen = 0; CWDlen = 0;
@ -1494,7 +1562,9 @@ PL_changed_cwd(void)
const char * const char *
PL_cwd(void) PL_cwd(void)
{ if ( CWDlen == 0 ) { GET_LD
if ( CWDlen == 0 )
{ char buf[MAXPATHLEN]; { char buf[MAXPATHLEN];
char *rval; char *rval;
@ -1583,7 +1653,8 @@ DirName(const char *f, char *dir)
bool bool
ChDir(const char *path) ChDir(const char *path)
{ char ospath[MAXPATHLEN]; { GET_LD
char ospath[MAXPATHLEN];
char tmp[MAXPATHLEN]; char tmp[MAXPATHLEN];
OsPath(path, ospath); OsPath(path, ospath);
@ -1681,7 +1752,8 @@ ResetStdin(void)
static ssize_t static ssize_t
Sread_terminal(void *handle, char *buf, size_t size) 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; int fd = (int)h;
source_location oldsrc = LD->read_source; source_location oldsrc = LD->read_source;
@ -1708,7 +1780,8 @@ Sread_terminal(void *handle, char *buf, size_t size)
void void
ResetTty() ResetTty()
{ startCritical; { GET_LD
startCritical;
ResetStdin(); ResetStdin();
if ( !GD->os.iofunctions.read ) if ( !GD->os.iofunctions.read )
@ -1736,7 +1809,8 @@ ResetTty()
bool bool
PushTty(IOSTREAM *s, ttybuf *buf, int mode) PushTty(IOSTREAM *s, ttybuf *buf, int mode)
{ struct termios tio; { GET_LD
struct termios tio;
int fd; int fd;
buf->mode = ttymode; buf->mode = ttymode;
@ -1803,7 +1877,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool bool
PopTty(IOSTREAM *s, ttybuf *buf) PopTty(IOSTREAM *s, ttybuf *buf)
{ int fd; { GET_LD
int fd;
ttymode = buf->mode; ttymode = buf->mode;
if ( (fd = Sfileno(s)) < 0 || !isatty(fd) ) if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
@ -1898,7 +1973,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool bool
PopTty(IOSTREAM *s, ttybuf *buf) PopTty(IOSTREAM *s, ttybuf *buf)
{ ttymode = buf->mode; { GET_LD
ttymode = buf->mode;
if ( ttymode != TTY_RAW ) if ( ttymode != TTY_RAW )
LD->prompt.next = TRUE; LD->prompt.next = TRUE;
@ -2204,7 +2280,8 @@ argument to wait()
int int
System(char *cmd) System(char *cmd)
{ int pid; { GET_LD
int pid;
char *shell = "/bin/sh"; char *shell = "/bin/sh";
int rval; int rval;
void (*old_int)(); void (*old_int)();

View File

@ -245,8 +245,9 @@ extern char *Getenv(const char *, char *buf, size_t buflen);
extern char *BaseName(const char *f); extern char *BaseName(const char *f);
extern time_t LastModifiedFile(const char *f); extern time_t LastModifiedFile(const char *f);
extern bool ExistsFile(const char *path); extern bool ExistsFile(const char *path);
extern atom_t TemporaryFile(const char *id); extern atom_t TemporaryFile(const char *id, int *fdp);
extern int RemoveFile(const char *path); extern atom_t TemporaryFile(const char *id, int *fdp);
extern int DeleteTemporaryFile(atom_t name);
extern bool ChDir(const char *path); extern bool ChDir(const char *path);
extern char *PrologPath(const char *ospath, char *path, size_t len); extern char *PrologPath(const char *ospath, char *path, size_t len);

View File

@ -3,9 +3,9 @@
Part of SWI-Prolog Part of SWI-Prolog
Author: Jan Wielemaker Author: Jan Wielemaker
E-mail: wielemak@science.uva.nl E-mail: J.Wielemaker@uva.nl
WWW: http://www.swi-prolog.org 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 This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public 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 Multithreading is supported through Slock() and Sunlock(). These are
recursive locks. If a stream handle might be known to another thread recursive locks. If a stream handle might be known to another thread
locking is required. locking is required.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifdef MD #ifdef MD
@ -222,6 +222,7 @@ S__setbuf(IOSTREAM *s, char *buffer, size_t size)
free(newunbuf); free(newunbuf);
errno = oldeno; errno = oldeno;
S__seterror(s);
return -1; return -1;
} }
} }
@ -246,8 +247,8 @@ S__setbuf(IOSTREAM *s, char *buffer, size_t size)
void void
Ssetbuffer(IOSTREAM *s, char *buffer, size_t size) Ssetbuffer(IOSTREAM *s, char *buffer, size_t size)
{ S__setbuf(s, buffer, size); { if ( S__setbuf(s, buffer, size) != (size_t)-1 )
s->flags &= ~SIO_USERBUF; s->flags &= ~SIO_USERBUF;
} }
@ -290,16 +291,16 @@ print_trace(void)
size_t size; size_t size;
char **strings; char **strings;
size_t i; size_t i;
size = backtrace(array, sizeof(array)/sizeof(void *)); size = backtrace(array, sizeof(array)/sizeof(void *));
strings = backtrace_symbols(array, size); strings = backtrace_symbols(array, size);
printf(" Stack:"); printf(" Stack:");
for(i = 1; i < size; i++) for(i = 1; i < size; i++)
{ printf("\n\t[%ld] %s", (long)i, strings[i]); { printf("\n\t[%ld] %s", (long)i, strings[i]);
} }
printf("\n"); printf("\n");
free(strings); free(strings);
} }
#endif /*DEBUG_IO_LOCKS*/ #endif /*DEBUG_IO_LOCKS*/
@ -339,8 +340,8 @@ StryLock(IOSTREAM *s)
} }
static int int
S__unlock(IOSTREAM *s) Sunlock(IOSTREAM *s)
{ int rval = 0; { int rval = 0;
#ifdef DEBUG_IO_LOCKS #ifdef DEBUG_IO_LOCKS
@ -359,15 +360,7 @@ S__unlock(IOSTREAM *s)
{ assert(0); { assert(0);
} }
return rval;
}
int
Sunlock(IOSTREAM *s)
{ int rval = S__unlock(s);
SUNLOCK(s); SUNLOCK(s);
return rval; return rval;
} }
@ -429,16 +422,15 @@ S__flushbufc(int c, IOSTREAM *s)
} else } else
{ if ( s->flags & SIO_NBUF ) { if ( s->flags & SIO_NBUF )
{ char chr = (char)c; { char chr = (char)c;
if ( (*s->functions->write)(s->handle, &chr, 1) != 1 ) if ( (*s->functions->write)(s->handle, &chr, 1) != 1 )
{ s->flags |= SIO_FERR; { S__seterror(s);
c = -1; c = -1;
} }
} else } else
{ if ( S__setbuf(s, NULL, 0) == (size_t)-1 ) { if ( S__setbuf(s, NULL, 0) == (size_t)-1 )
{ s->flags |= SIO_FERR;
c = -1; c = -1;
} else else
*s->bufp++ = (char)c; *s->bufp++ = (char)c;
} }
} }
@ -471,7 +463,7 @@ S__fillbuf(IOSTREAM *s)
{ fd_set wait; { fd_set wait;
struct timeval time; struct timeval time;
int rc; int rc;
time.tv_sec = s->timeout / 1000; time.tv_sec = s->timeout / 1000;
time.tv_usec = (s->timeout % 1000) * 1000; time.tv_usec = (s->timeout % 1000) * 1000;
FD_ZERO(&wait); FD_ZERO(&wait);
@ -483,7 +475,7 @@ S__fillbuf(IOSTREAM *s)
for(;;) for(;;)
{ rc = select(fd+1, &wait, NULL, NULL, &time); { rc = select(fd+1, &wait, NULL, NULL, &time);
if ( rc < 0 && errno == EINTR ) if ( rc < 0 && errno == EINTR )
{ if ( PL_handle_signals() < 0 ) { if ( PL_handle_signals() < 0 )
{ errno = EPLEXCEPTION; { errno = EPLEXCEPTION;
@ -557,6 +549,7 @@ S__fillbuf(IOSTREAM *s)
} else if ( errno == EWOULDBLOCK ) } else if ( errno == EWOULDBLOCK )
{ s->bufp = s->buffer; { s->bufp = s->buffer;
s->limitp = s->buffer; s->limitp = s->buffer;
S__seterror(s);
return -1; return -1;
#endif #endif
} else } else
@ -740,7 +733,7 @@ reperror(int c, IOSTREAM *s)
{ if ( put_byte(*q, s) < 0 ) { if ( put_byte(*q, s) < 0 )
return -1; return -1;
} }
return c; return c;
} }
@ -798,7 +791,7 @@ put_code(int c, IOSTREAM *s)
case ENC_UTF8: case ENC_UTF8:
{ char buf[6]; { char buf[6];
char *p, *end; char *p, *end;
if ( c < 128 ) if ( c < 128 )
goto simple; goto simple;
@ -831,7 +824,7 @@ put_code(int c, IOSTREAM *s)
{ if ( put_byte(*q++, s) < 0 ) { if ( put_byte(*q++, s) < 0 )
return -1; return -1;
} }
break; break;
} }
case ENC_UNKNOWN: case ENC_UNKNOWN:
@ -975,7 +968,7 @@ retry:
code = UTF8_FBV(c,extra); code = UTF8_FBV(c,extra);
for( ; extra > 0; extra-- ) for( ; extra > 0; extra-- )
{ int c2 = get_byte(s); { int c2 = get_byte(s);
if ( !ISUTF8_CB(c2) ) if ( !ISUTF8_CB(c2) )
{ Sseterr(s, SIO_WARN, "Illegal UTF-8 continuation"); { Sseterr(s, SIO_WARN, "Illegal UTF-8 continuation");
c = UTF8_MALFORMED_REPLACEMENT; c = UTF8_MALFORMED_REPLACEMENT;
@ -1025,7 +1018,7 @@ retry:
goto out; goto out;
} else } else
{ Sseterr(s, SIO_WARN, "EOF in UCS character"); { Sseterr(s, SIO_WARN, "EOF in UCS character");
c = UTF8_MALFORMED_REPLACEMENT; c = UTF8_MALFORMED_REPLACEMENT;
goto out; goto out;
} }
} }
@ -1228,16 +1221,16 @@ Sfread(void *data, size_t size, size_t elms, IOSTREAM *s)
if ( (c = Sgetc(s)) == EOF ) if ( (c = Sgetc(s)) == EOF )
break; break;
*buf++ = c & 0xff; *buf++ = c & 0xff;
} }
} else } else
{ while(chars > 0) { while(chars > 0)
{ int c; { int c;
if ( s->bufp < s->limitp ) if ( s->bufp < s->limitp )
{ size_t avail = s->limitp - s->bufp; { size_t avail = s->limitp - s->bufp;
if ( chars <= avail ) if ( chars <= avail )
{ memcpy(buf, s->bufp, chars); { memcpy(buf, s->bufp, chars);
s->bufp += chars; s->bufp += chars;
@ -1249,7 +1242,7 @@ Sfread(void *data, size_t size, size_t elms, IOSTREAM *s)
s->bufp += avail; s->bufp += avail;
} }
} }
if ( (c = S__fillbuf(s)) == EOF ) if ( (c = S__fillbuf(s)) == EOF )
break; break;
@ -1257,7 +1250,7 @@ Sfread(void *data, size_t size, size_t elms, IOSTREAM *s)
chars--; chars--;
} }
} }
return (size*elms - chars)/size; 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 ) { if ( Sputc(*buf++, s) < 0 )
break; break;
} }
return (size*elms - chars)/size; return (size*elms - chars)/size;
} }
@ -1406,19 +1399,22 @@ Sfeof(IOSTREAM *s)
s->bufp--; s->bufp--;
return FALSE; return FALSE;
} }
static int static int
S__seterror(IOSTREAM *s) 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; { char *msg;
if ( (*s->functions->control)(s->handle, if ( (*s->functions->control)(s->handle,
SIO_LASTERROR, SIO_LASTERROR,
(void *)&msg) == 0 ) (void *)&msg) == 0 )
{ Sseterr(s, SIO_FERR, msg); { Sseterr(s, SIO_FERR, msg);
return 0; return 0;
} }
} }
s->flags |= SIO_FERR; s->flags |= SIO_FERR;
@ -1430,7 +1426,7 @@ int
Sferror(IOSTREAM *s) Sferror(IOSTREAM *s)
{ return (s->flags & SIO_FERR) != 0; { return (s->flags & SIO_FERR) != 0;
} }
int int
Sfpasteof(IOSTREAM *s) Sfpasteof(IOSTREAM *s)
@ -1441,6 +1437,7 @@ Sfpasteof(IOSTREAM *s)
void void
Sclearerr(IOSTREAM *s) Sclearerr(IOSTREAM *s)
{ s->flags &= ~(SIO_FEOF|SIO_WARN|SIO_FERR|SIO_FEOF2|SIO_TIMEOUT|SIO_CLEARERR); { s->flags &= ~(SIO_FEOF|SIO_WARN|SIO_FERR|SIO_FEOF2|SIO_TIMEOUT|SIO_CLEARERR);
s->io_errno = 0;
Sseterr(s, 0, NULL); Sseterr(s, 0, NULL);
} }
@ -1485,7 +1482,7 @@ Ssetenc(IOSTREAM *s, IOENC enc, IOENC *old)
if ( s->functions->control ) if ( s->functions->control )
{ if ( (*s->functions->control)(s->handle, { if ( (*s->functions->control)(s->handle,
SIO_SETENCODING, SIO_SETENCODING,
(void *)&enc) != 0 ) (void *)&enc) != 0 )
return -1; return -1;
} }
@ -1563,6 +1560,7 @@ Ssize(IOSTREAM *s)
} }
errno = ESPIPE; errno = ESPIPE;
S__seterror(s);
return -1; return -1;
} }
@ -1587,7 +1585,7 @@ Sseek64(IOSTREAM *s, int64_t pos, int whence)
if ( now != -1 ) if ( now != -1 )
{ int64_t newpos; { int64_t newpos;
char *nbufp = (char *)-1; char *nbufp = (char *)-1;
if ( whence == SIO_SEEK_CUR ) if ( whence == SIO_SEEK_CUR )
{ nbufp = s->bufp + pos; { nbufp = s->bufp + pos;
newpos = now + pos; newpos = now + pos;
@ -1608,11 +1606,12 @@ Sseek64(IOSTREAM *s, int64_t pos, int whence)
if ( !s->functions->seek && !s->functions->seek64 ) if ( !s->functions->seek && !s->functions->seek64 )
{ errno = ESPIPE; { errno = ESPIPE;
S__seterror(s);
return -1; return -1;
} }
Sflush(s); Sflush(s);
s->bufp = s->buffer; s->bufp = s->buffer;
if ( (s->flags & SIO_INPUT) ) if ( (s->flags & SIO_INPUT) )
s->limitp = s->buffer; s->limitp = s->buffer;
@ -1621,18 +1620,19 @@ Sseek64(IOSTREAM *s, int64_t pos, int whence)
{ pos += Stell64(s); { pos += Stell64(s);
whence = SIO_SEEK_SET; whence = SIO_SEEK_SET;
} }
if ( s->functions->seek64 ) if ( s->functions->seek64 )
pos = (*s->functions->seek64)(s->handle, pos, whence); pos = (*s->functions->seek64)(s->handle, pos, whence);
else if ( pos <= LONG_MAX ) else if ( pos <= LONG_MAX )
pos = (*s->functions->seek)(s->handle, (long)pos, whence); pos = (*s->functions->seek)(s->handle, (long)pos, whence);
else else
{ errno = EINVAL; { errno = EINVAL;
S__seterror(s);
return -1; return -1;
} }
if ( pos < 0 ) if ( pos < 0 )
{ errno = EINVAL; { S__seterror(s);
return -1; return -1;
} }
@ -1684,6 +1684,7 @@ Stell64(IOSTREAM *s)
return pos; return pos;
} else } else
{ errno = EINVAL; { errno = EINVAL;
S__seterror(s);
return -1; return -1;
} }
} }
@ -1693,10 +1694,13 @@ long
Stell(IOSTREAM *s) Stell(IOSTREAM *s)
{ int64_t pos = Stell64(s); { int64_t pos = Stell64(s);
if ( pos == -1 )
return -1;
if ( pos <= LONG_MAX ) if ( pos <= LONG_MAX )
return (long) pos; return (long) pos;
errno = EINVAL; errno = EINVAL;
S__seterror(s);
return -1; return -1;
} }
@ -1717,7 +1721,7 @@ Sclose(IOSTREAM *s)
{ int rval = 0; { int rval = 0;
if ( s->magic != SIO_MAGIC ) /* already closed!? */ if ( s->magic != SIO_MAGIC ) /* already closed!? */
{ errno = EINVAL; { s->io_errno = errno = EINVAL;
return -1; return -1;
} }
@ -1747,11 +1751,12 @@ Sclose(IOSTREAM *s)
} }
#endif #endif
if ( s->functions->close && (*s->functions->close)(s->handle) < 0 ) if ( s->functions->close && (*s->functions->close)(s->handle) < 0 )
{ s->flags |= SIO_FERR; { S__seterror(s);
rval = -1; rval = -1;
} }
while(s->locks > 0) /* remove buffer-locks */ while(s->locks > 0) /* remove buffer-locks */
{ int rc = S__unlock(s); { int rc = Sunlock(s);
if ( rval == 0 ) if ( rval == 0 )
rval = rc; rval = rc;
@ -1759,7 +1764,6 @@ Sclose(IOSTREAM *s)
if ( rval < 0 ) if ( rval < 0 )
reportStreamError(s); reportStreamError(s);
run_close_hooks(s); /* deletes Prolog registration */ run_close_hooks(s); /* deletes Prolog registration */
SUNLOCK(s); SUNLOCK(s);
#ifdef O_PLMT #ifdef O_PLMT
@ -1771,6 +1775,8 @@ Sclose(IOSTREAM *s)
#endif #endif
s->magic = SIO_CMAGIC; s->magic = SIO_CMAGIC;
if ( s->message )
free(s->message);
if ( !(s->flags & SIO_STATIC) ) if ( !(s->flags & SIO_STATIC) )
free(s); free(s);
@ -1826,8 +1832,7 @@ Sgets(char *buf)
int int
Sfputs(const char *q, IOSTREAM *s) Sfputs(const char *q, IOSTREAM *s)
{ { for( ; *q; q++)
for( ; *q; q++)
{ if ( Sputcode(*q&0xff, s) < 0 ) { if ( Sputcode(*q&0xff, s) < 0 )
return EOF; return EOF;
} }
@ -2003,7 +2008,7 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
v = va_arg(args, int); v = va_arg(args, int);
break; break;
case 1: case 1:
v = va_arg(args, intptr_t); v = va_arg(args, long);
break; break;
case 2: case 2:
vl = va_arg(args, int64_t); vl = va_arg(args, int64_t);
@ -2168,7 +2173,7 @@ Svsprintf(char *buf, const char *fm, va_list args)
s.buffer = buf; s.buffer = buf;
s.flags = SIO_FBUF|SIO_OUTPUT; s.flags = SIO_FBUF|SIO_OUTPUT;
s.encoding = ENC_ISO_LATIN_1; s.encoding = ENC_ISO_LATIN_1;
if ( (rval = Svfprintf(&s, fm, args)) >= 0 ) if ( (rval = Svfprintf(&s, fm, args)) >= 0 )
*s.bufp = '\0'; *s.bufp = '\0';
@ -2255,7 +2260,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args)
continue; continue;
} }
} }
if ( *fm != '[' && *fm != c ) if ( *fm != '[' && *fm != c )
while(isblank(c)) while(isblank(c))
c = GET(s); c = GET(s);
@ -2408,13 +2413,13 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args)
{ float *fp = va_arg(args, float *); { float *fp = va_arg(args, float *);
*fp = v; *fp = v;
break; break;
} }
case SZ_LONG: case SZ_LONG:
{ double *fp = va_arg(args, double *); { double *fp = va_arg(args, double *);
*fp = v; *fp = v;
break; break;
} }
} }
done++; done++;
} }
@ -2424,7 +2429,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args)
case 's': case 's':
if ( !supress ) if ( !supress )
{ char *sp = va_arg(args, char *); { char *sp = va_arg(args, char *);
while(!isblank(c) && field_width-- != 0) while(!isblank(c) && field_width-- != 0)
{ *sp++ = c; { *sp++ = c;
c = GET(s); c = GET(s);
@ -2444,7 +2449,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args)
continue; continue;
case '[': case '[':
{ char set[256]; { char set[256];
memset(set, 0, sizeof(set)); memset(set, 0, sizeof(set));
fm++; fm++;
if ( *fm == ']' ) if ( *fm == ']' )
@ -2455,7 +2460,7 @@ Svfscanf(IOSTREAM *s, const char *fm, va_list args)
} }
while(*fm != ']') while(*fm != ']')
{ if ( *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 `parent'. If parent is an output steam we have
application --> filter --> parent --> application --> filter --> parent -->
If parent is an input stream we have If parent is an input stream we have
--> parent --> filter --> application --> 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 * IOSTREAM *
Snew(void *handle, int flags, IOFUNCTIONS *functions) Snew(void *handle, int flags, IOFUNCTIONS *functions)
{ IOSTREAM *s; { IOSTREAM *s;
@ -2692,8 +2706,16 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
recursiveMutexInit(s->mutex); recursiveMutexInit(s->mutex);
} }
#endif #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; return s;
} }
@ -2718,7 +2740,7 @@ IOSTREAM *
Sopen_file(const char *path, const char *how) Sopen_file(const char *path, const char *how)
{ int fd; { int fd;
int oflags = O_BINARY; 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++; int op = *how++;
intptr_t lfd; intptr_t lfd;
enum {lnone=0,lread,lwrite} lock = lnone; enum {lnone=0,lread,lwrite} lock = lnone;
@ -2782,7 +2804,7 @@ Sopen_file(const char *path, const char *how)
return NULL; return NULL;
if ( lock ) if ( lock )
{ {
#ifdef FCNTL_LOCKS #ifdef FCNTL_LOCKS
struct flock buf; struct flock buf;
@ -2830,8 +2852,8 @@ Sopen_file(const char *path, const char *how)
IOSTREAM * IOSTREAM *
Sfdopen(int fd, const char *type) 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 ) if ( fd < 0 )
{ errno = EINVAL; { errno = EINVAL;
@ -2843,9 +2865,15 @@ Sfdopen(int fd, const char *type)
#endif #endif
if ( *type == 'r' ) if ( *type == 'r' )
flags = SIO_FILE|SIO_INPUT|SIO_RECORDPOS; { flags |= SIO_INPUT;
else } else if ( *type == 'w' )
flags = SIO_FILE|SIO_OUTPUT|SIO_RECORDPOS; { flags |= SIO_OUTPUT;
} else
{ errno = EINVAL;
return NULL;
}
if ( type[1] != 'b' )
flags |= SIO_TEXT;
lfd = (intptr_t)fd; lfd = (intptr_t)fd;
@ -2948,9 +2976,9 @@ Sopen_pipe(const char *command, const char *type)
{ int flags; { int flags;
if ( *type == 'r' ) if ( *type == 'r' )
flags = SIO_PIPE|SIO_INPUT; flags = SIO_PIPE|SIO_INPUT|SIO_FBUF;
else else
flags = SIO_PIPE|SIO_OUTPUT; flags = SIO_PIPE|SIO_OUTPUT|SIO_FBUF;
return Snew((void *)fd, flags, &Spipefunctions); return Snew((void *)fd, flags, &Spipefunctions);
} }
@ -3004,7 +3032,7 @@ Swrite_memfile(void *handle, char *buf, size_t size)
{ memfile *mf = handle; { memfile *mf = handle;
if ( mf->here + size + 1 >= mf->allocated ) 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; char *nb;
if ( mf->allocated == 0 || !mf->malloced ) if ( mf->allocated == 0 || !mf->malloced )
@ -3052,7 +3080,7 @@ Sread_memfile(void *handle, char *buf, size_t size)
else else
size = mf->size - mf->here; size = mf->size - mf->here;
} }
memcpy(buf, &(*mf->buffer)[mf->here], size); memcpy(buf, &(*mf->buffer)[mf->here], size);
mf->here += size; mf->here += size;
@ -3095,7 +3123,7 @@ Sclose_memfile(void *handle)
{ free(mf); { free(mf);
return 0; return 0;
} }
errno = EINVAL; /* not opened */ errno = EINVAL; /* not opened */
return -1; return -1;
} }
@ -3396,7 +3424,7 @@ Sreset(void)
if ( (s=Serror) && s->magic == SIO_MAGIC ) if ( (s=Serror) && s->magic == SIO_MAGIC )
{ s->bufp = s->buffer; { s->bufp = s->buffer;
} }
} }
void void
@ -3416,7 +3444,17 @@ Scleanup(void)
s->bufp = s->buffer; /* avoid actual flush */ s->bufp = s->buffer; /* avoid actual flush */
S__removebuf(s); 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 */ *s = S__iob0[i]; /* re-initialise */
} }
} }

View File

@ -93,16 +93,40 @@ PL_save_text(PL_chars_t *text, int flags)
addMultipleBuffer(b, text->text.t, bl, char); addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char); text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING; 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 int
PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD) 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 ( (flags & CVT_ATOM) && isAtom(w) )
{ if ( !get_atom_text(w, text) ) { 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) ) } else if ( (flags & CVT_STRING) && isString(w) )
{ if ( !get_string_text(w, text PASS_LD) ) { if ( !get_string_text(w, text PASS_LD) )
goto maybe_write; goto maybe_write;
PL_from_stack_text(text);
} else if ( (flags & CVT_INTEGER) && isInteger(w) ) } else if ( (flags & CVT_INTEGER) && isInteger(w) )
{ number n; { 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->encoding = ENC_ISO_LATIN_1;
text->canonical = TRUE; text->canonical = TRUE;
} else if ( (flags & CVT_FLOAT) && isReal(w) ) } else if ( (flags & CVT_FLOAT) && isFloat(w) )
{ format_float(valReal(w), text->buf, LD->float_format); { format_float(valFloat(w), text->buf, LD->float_format);
text->text.t = text->buf; text->text.t = text->buf;
text->length = strlen(text->text.t); text->length = strlen(text->text.t);
text->encoding = ENC_ISO_LATIN_1; 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[0] = ENC_ISO_LATIN_1;
encodings[1] = ENC_WCHAR; encodings[1] = ENC_WCHAR;
encodings[2] = ENC_UNKNOWN; encodings[2] = ENC_UNKNOWN;
for(enc = encodings; *enc != ENC_UNKNOWN; enc++) for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
{ size_t size; { size_t size;
IOSTREAM *fd; IOSTREAM *fd;
r = text->buf; r = text->buf;
size = sizeof(text->buf); size = sizeof(text->buf);
fd = Sopenmem(&r, &size, "w"); fd = Sopenmem(&r, &size, "w");
@ -228,6 +253,9 @@ maybe_write:
goto case_write; goto case_write;
error: error:
if ( canBind(w) && (flags & CVT_VARNOFAIL) )
return 2;
if ( (flags & CVT_EXCEPTION) ) if ( (flags & CVT_EXCEPTION) )
{ atom_t expected; { atom_t expected;
@ -237,7 +265,7 @@ error:
expected = ATOM_atomic; expected = ATOM_atomic;
else else
expected = ATOM_atom; expected = ATOM_atom;
return PL_error(NULL, 0, NULL, ERR_TYPE, expected, l); 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: { case PL_ATOM:
{ atom_t a = textToAtom(text); { atom_t a = textToAtom(text);
int rval = _PL_unify_atomic(term, a); int rval = _PL_unify_atomic(term, a);
PL_unregister_atom(a); PL_unregister_atom(a);
return rval; return rval;
} }
@ -285,7 +313,10 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
#if __SWI_PROLOG__ #if __SWI_PROLOG__
{ word w = textToString(text); { word w = textToString(text);
return _PL_unify_atomic(term, w); if ( w )
return _PL_unify_atomic(term, w);
else
return FALSE;
} }
#endif #endif
case PL_CODE_LIST: case PL_CODE_LIST:
@ -300,35 +331,40 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
} }
} else } else
{ GET_LD { GET_LD
word p0, p; term_t l = PL_new_term_ref();
Word p0, p;
switch(text->encoding) switch(text->encoding)
{ case ENC_ISO_LATIN_1: { case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char *)text->text.t; { const unsigned char *s = (const unsigned char *)text->text.t;
const unsigned char *e = &s[text->length]; const unsigned char *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length); if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
if ( type == PL_CODE_LIST ) { return FALSE;
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s); if ( type == PL_CODE_LIST ) {
} else { for( ; s < e; s++)
for( ; s < e; s++) p = EXTEND_SEQ_CODES(p, *s);
p = EXTEND_SEQ_ATOMS(p, *s); } else {
} for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break; break;
} }
case ENC_WCHAR: case ENC_WCHAR:
{ const pl_wchar_t *s = (const pl_wchar_t *)text->text.t; { const pl_wchar_t *s = (const pl_wchar_t *)text->text.t;
const pl_wchar_t *e = &s[text->length]; const pl_wchar_t *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length); if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
if ( type == PL_CODE_LIST ) { return FALSE;
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s); if ( type == PL_CODE_LIST ) {
} else { for( ; s < e; s++)
for( ; s < e; s++) p = EXTEND_SEQ_CODES(p, *s);
p = EXTEND_SEQ_ATOMS(p, *s); } else {
} for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break; break;
} }
case ENC_UTF8: 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]; const char *e = &s[text->length];
size_t len = utf8_strlen(s, text->length); size_t len = utf8_strlen(s, text->length);
p0 = p = INIT_SEQ_CODES(len); if ( !(p0 = p = INIT_SEQ_CODES(len)) )
if ( type == PL_CODE_LIST ) { return FALSE;
while (s < e) {
int chr; if ( type == PL_CODE_LIST ) {
while (s < e) {
s = utf8_get_char(s, &chr); int chr;
p = EXTEND_SEQ_CODES(p, chr);
} s = utf8_get_char(s, &chr);
} else { p = EXTEND_SEQ_CODES(p, chr);
while (s < e) { }
int chr; } else {
while (s < e) {
s = utf8_get_char(s, &chr); int chr;
p = EXTEND_SEQ_ATOMS(p, chr);
} s = utf8_get_char(s, &chr);
} p = EXTEND_SEQ_ATOMS(p, chr);
}
}
break; break;
} }
case ENC_ANSI: case ENC_ANSI:
@ -367,18 +405,21 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
n -= rc; n -= rc;
s += rc; s += rc;
} }
p0 = p = INIT_SEQ_CODES(len);
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
return FALSE;
memset(&mbs, 0, sizeof(mbs)); memset(&mbs, 0, sizeof(mbs));
n = text->length; n = text->length;
while(n > 0) { while(n > 0)
rc = mbrtowc(&wc, s, n, &mbs); { rc = mbrtowc(&wc, s, n, &mbs);
if ( type == PL_CODE_LIST ) if ( type == PL_CODE_LIST )
p = EXTEND_SEQ_CODES(p, wc); p = EXTEND_SEQ_CODES(p, wc);
else else
p = EXTEND_SEQ_ATOMS(p, wc); p = EXTEND_SEQ_ATOMS(p, wc);
s += rc; s += rc;
n -= 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: default:
@ -430,7 +471,7 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
rc = PL_unify_text(term, 0, &sub, type); rc = PL_unify_text(term, 0, &sub, type);
PL_free_text(&sub); PL_free_text(&sub);
return rc; return rc;
} }
} }
@ -458,7 +499,7 @@ PL_promote_text(PL_chars_t *text)
PL_free(text->text.t); PL_free(text->text.t);
text->text.w = new; text->text.w = new;
text->encoding = ENC_WCHAR; text->encoding = ENC_WCHAR;
} else if ( text->storage == PL_CHARS_LOCAL && } else if ( text->storage == PL_CHARS_LOCAL &&
(text->length+1)*sizeof(pl_wchar_t) < sizeof(text->buf) ) (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); PL_free(text->text.t);
text->text.t = new; text->text.t = new;
text->encoding = ENC_ISO_LATIN_1; text->encoding = ENC_ISO_LATIN_1;
} else if ( text->storage == PL_CHARS_LOCAL ) } else if ( text->storage == PL_CHARS_LOCAL )
{ pl_wchar_t buf[sizeof(text->buf)/sizeof(pl_wchar_t)]; { 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 b[6];
char *e = b; char *e = b;
const char *s; const char *s;
e = utf8_put_char(e, c); e = utf8_put_char(e, c);
for(s=b; s<e; s++) for(s=b; s<e; s++)
addBuffer(buf, *s, char); addBuffer(buf, *s, char);
@ -617,7 +658,7 @@ PL_mb_text(PL_chars_t *text, int flags)
if ( text->encoding != target ) if ( text->encoding != target )
{ Buffer b = findBuffer(BUF_RING); { Buffer b = findBuffer(BUF_RING);
switch(text->encoding) switch(text->encoding)
{ case ENC_ISO_LATIN_1: { case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char*)text->text.t; { 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); addBuffer(b, 0, char);
} else /* if ( target == ENC_MB ) */ } else /* if ( target == ENC_MB ) */
{ mbstate_t mbs; { mbstate_t mbs;
memset(&mbs, 0, sizeof(mbs)); memset(&mbs, 0, sizeof(mbs));
for( ; w<e; w++) for( ; w<e; w++)
{ if ( !wctobuffer(*w, &mbs, b) ) { if ( !wctobuffer(*w, &mbs, b) )
@ -692,7 +733,7 @@ rep_error:
sprintf(msg, sprintf(msg,
"Cannot represent char U%04x using %s encoding", "Cannot represent char U%04x using %s encoding",
norep, norep,
target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale"); target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale");
return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding); return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding);
@ -711,7 +752,7 @@ PL_canonise_text(PL_chars_t *text)
case ENC_WCHAR: case ENC_WCHAR:
{ const pl_wchar_t *w = (const pl_wchar_t*)text->text.w; { const pl_wchar_t *w = (const pl_wchar_t*)text->text.w;
const pl_wchar_t *e = &w[text->length]; const pl_wchar_t *e = &w[text->length];
for(; w<e; w++) for(; w<e; w++)
{ if ( *w > 0xff ) { if ( *w > 0xff )
return FALSE; 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; return ifeq;
else else
return *s > *q ? 1 : -1; return *s > *q ? 1 : -1;
} }
} }
@ -1098,35 +1139,3 @@ Sopen_text(PL_chars_t *txt, const char *mode)
return stream; 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;
}

View File

@ -250,7 +250,7 @@ scan_options(term_t options, int flags, atom_t optype,
term_t val = PL_new_term_ref(); term_t val = PL_new_term_ref();
int n; int n;
if ( trueFeature(ISO_FEATURE) ) if ( truePrologFlag(PLFLAG_ISO) )
flags |= OPT_ALL; flags |= OPT_ALL;
va_start(args, specs); 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;
}

View File

@ -148,7 +148,7 @@ EXTEND_SEQ_ATOMS(word gstore, int c) {
} }
static inline int 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 (arg3 == (word)ATOM_nil) {
if (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil())) if (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil()))
return FALSE; return FALSE;
@ -172,14 +172,17 @@ valHandle(term_t tt)
#define isAtom(A) YAP_IsAtomTerm((A)) #define isAtom(A) YAP_IsAtomTerm((A))
#define isList(A) YAP_IsPairTerm((A)) #define isList(A) YAP_IsPairTerm((A))
#define isNil(A) ((A) == YAP_TermNil()) #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 isVar(A) YAP_IsVarTerm((A))
#define varName(l, buf) buf #define varName(l, buf) buf
#define valReal(w) YAP_FloatOfTerm((w)) #define valReal(w) YAP_FloatOfTerm((w))
#define valFloat(w) YAP_FloatOfTerm((w))
#define AtomLength(w) YAP_AtomNameLength(w) #define AtomLength(w) YAP_AtomNameLength(w)
#define atomValue(atom) ((YAP_Atom)atom) #define atomValue(atom) ((YAP_Atom)atom)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i)))) #define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) (t = YAP_Deref(t)) #define deRef(t) (t = YAP_Deref(t))
#define canBind(t) FALSE
#define clearNumber(n) #define clearNumber(n)

@ -1 +1 @@
Subproject commit d9614e99dc98f8546fdc213c9e45003cf6efd520 Subproject commit 9f80255cce18ee268792631aa1180e19a496346f

View File

@ -876,10 +876,20 @@ yap_flag(max_threads,X) :-
yap_flag(max_threads,X) :- yap_flag(max_threads,X) :-
'$do_error'(domain_error(flag_value,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). yap_flag(dialect,yap).
'$show_yap_flag_opts'(V,Out) :- '$show_yap_flag_opts'(V,Out) :-
( (
V = address_bits ;
V = answer_format ; V = answer_format ;
V = argv ; V = argv ;
V = bounded ; V = bounded ;