Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6
This commit is contained in:
commit
5e1f8ff84f
14
C/arith1.c
14
C/arith1.c
@ -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)
|
||||||
|
@ -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);
|
||||||
|
@ -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);
|
||||||
|
@ -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;
|
||||||
|
24
C/exec.c
24
C/exec.c
@ -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);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -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:
|
||||||
{
|
{
|
||||||
|
11
C/sysbits.c
11
C/sysbits.c
@ -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
3
COPYING
Executable 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
10
Makefile.in
Normal file → Executable 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
|
||||||
|
@ -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);
|
||||||
|
@ -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).
|
||||||
|
@ -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));
|
||||||
|
@ -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)).
|
|
||||||
|
@ -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;
|
||||||
}
|
}
|
||||||
|
@ -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); \
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -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");
|
||||||
|
@ -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
|
|
||||||
|
@ -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 */
|
||||||
|
@ -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
27
misc/yap.nsi
Normal file → Executable 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"
|
||||||
|
@ -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 \
|
||||||
|
@ -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")
|
||||||
|
@ -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;
|
||||||
|
@ -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;
|
|
||||||
}
|
|
||||||
|
|
@ -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);
|
||||||
|
@ -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)
|
||||||
|
@ -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, ...);
|
||||||
|
@ -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)();
|
||||||
|
@ -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);
|
||||||
|
|
||||||
|
@ -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 */
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -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;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
@ -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;
|
||||||
|
}
|
||||||
|
|
||||||
|
@ -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
|
@ -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 ;
|
||||||
|
Reference in New Issue
Block a user