diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-02-25 17:52:30 +00:00
commit 5e1f8ff84f
35 changed files with 934 additions and 558 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
C/arith1.c
View File

@ -555,6 +555,17 @@ eval1(Int fi, Term t) {
case db_ref_e:
RERROR();
}
#if HAVE_ISNAN
if (isnan(dbl)) {
return Yap_ArithError(DOMAIN_ERROR_OUT_OF_RANGE, t, "integer(%f)", dbl);
}
#endif
#if HAVE_ISNAN
if (isinf(dbl)) {
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, MkFloatTerm(dbl), "integer\
(%f)",dbl);
}
#endif
if (dbl <= (Float)Int_MAX && dbl >= (Float)Int_MIN) {
RINT((Int) dbl);
} else {
@ -797,8 +808,9 @@ p_unary_is(void)
return FALSE;
}
top = Yap_Eval(Deref(ARG3));
if (top == 0L)
if (!Yap_FoundArithError(top, ARG3)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval1(IntegerOfTerm(t), top), Deref(ARG3));
if (!tout)

8
C/arith2.c
View File

@ -1117,13 +1117,15 @@ p_binary_is(void)
return(FALSE);
}
t1 = Yap_Eval(Deref(ARG3));
if (t1 == 0L)
if (!Yap_FoundArithError(t1, ARG3)) {
return FALSE;
}
t2 = Yap_Eval(Deref(ARG4));
if (t2 == 0L)
if (!Yap_FoundArithError(t2, ARG4)) {
return FALSE;
}
if (IsIntTerm(t)) {
Term tout = Yap_FoundArithError(eval2(IntegerOfTerm(t), t1, t2), 0L);
Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L);
if (!tout)
return FALSE;
return Yap_unify_constant(ARG1,tout);

6
C/compiler.c
View File

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

1
C/dbase.c
View File

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

24
C/exec.c
View File

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

7
C/iopreds.c
View File

@ -2164,8 +2164,13 @@ check_bom(int sno, StreamDesc *st)
int ch;
ch = st->stream_getc(sno);
if (ch == EOFCHAR)
if (ch == EOFCHAR) {
st->och = ch;
st->stream_getc = PlUnGetc;
st->stream_wgetc = get_wchar;
st->stream_gets = DefaultGets;
return TRUE;
}
switch(ch) {
case 0xFE:
{

11
C/sysbits.c
View File

@ -2972,6 +2972,16 @@ p_ld_path(void)
return Yap_unify(ARG1,MkAtomTerm(Yap_LookupAtom(YAP_LIBDIR)));
}
static Int
p_address_bits(void)
{
#if SIZEOF_INT_P==4
return Yap_unify(ARG1,MkIntTerm(32));
#else
return Yap_unify(ARG1,MkIntTerm(64));
#endif
}
#ifdef _WIN32
@ -3193,6 +3203,7 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);
Yap_InitCPred ("$win32", 0, p_win32, SafePredFlag);
Yap_InitCPred ("$ld_path", 1, p_ld_path, SafePredFlag);
Yap_InitCPred ("$address_bits", 1, p_address_bits, SafePredFlag);
#ifdef _WIN32
Yap_InitCPred ("win_registry_get_value", 3, p_win_registry_get_value,0);
#endif

3
COPYING Executable file
View File

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

10
Makefile.in Normal file → Executable file
View File

@ -29,7 +29,7 @@ INFODIR=$(SHAREDIR)/info
#
# where to store documentaion files
#
DOCSDIR=$(SHAREDIR)/docs/yap
DOCSDIR=$(SHAREDIR)/docs/Yap
#
# Add this flag to YAP_EXTRAS if you need the extension:
@ -511,6 +511,10 @@ install_unix: startup.yss libYap.a
@INSTALL_DLLS@ $(INSTALL_DATA) -m 755 @YAPLIB@ $(DESTDIR)$(LIBDIR)
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl
mkdir -p $(DESTDIR)$(DOCSDIR)
$(INSTALL) $(srcdir)/Artistic $(DESTDIR)$(DOCSDIR)
$(INSTALL) $(srcdir)/README $(DESTDIR)$(DOCSDIR)
$(INSTALL) $(srcdir)/COPYING $(DESTDIR)$(DOCSDIR)
for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
@INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) install)
@INSTALL_DLLS@ (cd packages/plunit; $(MAKE) install)
@ -546,6 +550,10 @@ install_win32: startup.yss
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/swi
mkdir -p $(DESTDIR)$(DOCSDIR)
$(INSTALL) $(srcdir)/Artistic $(DESTDIR)$(DOCSDIR)
$(INSTALL) $(srcdir)/README $(DESTDIR)$(DOCSDIR)/README.TXT
$(INSTALL) $(srcdir)/COPYING $(DESTDIR)$(DOCSDIR)/COPYING.TXT
for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done
$(INSTALL) $(HEADERS) $(DESTDIR)$(INCLUDEDIR)
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done

5
include/SWI-Prolog.h
View File

@ -185,6 +185,7 @@ typedef void *PL_engine_t;
#define CVT_MASK 0x00ff
#define CVT_EXCEPTION 0x10000
#define CVT_VARNOFAIL 0x20000 /* return 2 if argument is unbound */
#define BUF_DISCARDABLE 0x0000
#define BUF_RING 0x0100
@ -409,6 +410,7 @@ extern X_API void PL_discard_foreign_frame(fid_t);
extern X_API void PL_rewind_foreign_frame(fid_t);
extern X_API fid_t PL_open_foreign_frame(void);
extern X_API int PL_raise_exception(term_t);
extern X_API void PL_clear_exception(void);
extern X_API void PL_register_atom(atom_t);
extern X_API void PL_unregister_atom(atom_t);
extern X_API predicate_t PL_pred(functor_t, module_t);
@ -420,6 +422,7 @@ extern X_API void PL_cut_query(qid_t);
extern X_API void PL_close_query(qid_t);
extern X_API int PL_toplevel(void);
extern X_API term_t PL_exception(qid_t);
extern X_API term_t PL_exception(qid_t);
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
extern X_API int PL_call(term_t, module_t);
extern X_API void PL_register_foreign(const char *, int, foreign_t (*)(void), int);
@ -436,7 +439,7 @@ extern X_API int PL_destroy_engine(PL_engine_t);
extern X_API int PL_set_engine(PL_engine_t,PL_engine_t *);
extern X_API int PL_get_string_chars(term_t, char **, int *);
extern X_API record_t PL_record(term_t);
extern X_API void PL_recorded(record_t, term_t);
extern X_API int PL_recorded(record_t, term_t);
extern X_API void PL_erase(record_t);
extern X_API int PL_action(int,...);
extern X_API void *PL_malloc(int);

7
library/itries.yap
View File

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

2
library/system/sys.c
View File

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

3
library/tries.yap
View File

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

12
library/tries/base_tries.c
View File

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

50
library/tries/base_tries.h
View File

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

9
library/tries/core_tries.c
View File

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

151
library/tries/itries.c
View File

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

59
library/tries/tries.c
View File

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

11
library/yap2swi/yap2swi.c
View File

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

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

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

4
packages/PLStream/Makefile.in
View File

@ -46,7 +46,7 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h \
$(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \
$(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/pl-utf8.c $(srcdir)/uxnt/uxnt.h
C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-error.c $(srcdir)/pl-feature.c \
$(srcdir)/pl-error.c \
$(srcdir)/pl-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \
$(srcdir)/pl-privitf.c \
$(srcdir)/pl-stream.c $(srcdir)/pl-string.c \
@ -54,7 +54,7 @@ C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-text.c \
$(srcdir)/pl-utils.c \
$(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.c
OBJS=pl-buffer.o pl-ctype.o pl-error.o pl-feature.o \
OBJS=pl-buffer.o pl-ctype.o pl-error.o \
pl-file.o pl-files.o pl-os.o pl-privitf.o \
pl-stream.o pl-string.o pl-table.o \
pl-text.o pl-utils.o pl-utf8.o \

1
packages/PLStream/atoms.h
View File

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

72
packages/PLStream/pl-ctype.c
View File

@ -298,7 +298,8 @@ unify_char_type(term_t type, const char_type *ct, int context, int how)
static foreign_t
do_char_type(term_t chr, term_t class, control_t h, int how)
{ generator *gen;
{ GET_LD
generator *gen;
fid_t fid;
switch( ForeignControl(h) )
@ -399,7 +400,9 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
succeed;
}
fid = PL_open_foreign_frame();
if ( !(fid = PL_open_foreign_frame()) )
goto error;
for(;;)
{ int rval;
@ -412,7 +415,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
{ if ( rval < 0 ||
!unify_char_type(class, gen->class, rval, how) )
goto next;
} else if ( gen->do_enum & ENUM_CLASS )
{ if ( !unify_char_type(class, gen->class, rval, how) )
goto next;
@ -432,6 +435,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
break;
}
error:
freeHeap(gen, sizeof(*gen));
fail;
}
@ -440,13 +444,13 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
static
PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CHAR_MODE);
{ return do_char_type(A1, A2, PL__ctx, PL_CHAR);
}
static
PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CODE_MODE);
{ return do_char_type(A1, A2, PL__ctx, PL_CODE);
}
@ -513,7 +517,8 @@ get_chr_from_text(const PL_chars_t *t, size_t index)
static foreign_t
modify_case_atom(term_t in, term_t out, int down)
{ PL_chars_t tin, tout;
{ GET_LD
PL_chars_t tin, tout;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE;
@ -578,7 +583,7 @@ modify_case_atom(term_t in, term_t out, int down)
{ tout.text.t[i] = (char)c;
}
}
}
}
} else
{ if ( down )
{ for(i=0; i<tin.length; i++)
@ -619,7 +624,8 @@ PRED_IMPL("upcase_atom", 2, upcase_atom, 0)
static int
write_normalize_space(IOSTREAM *out, term_t in)
{ PL_chars_t tin;
{ GET_LD
PL_chars_t tin;
size_t i, end;
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;
word rc;
EXCEPTION_GUARDED(/*code*/
if ( setupOutputRedirect(A1, &ctx, FALSE) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
} else
rc = FALSE;
/*cleanup*/,
DEBUG(1, Sdprintf("Cleanup after throw()\n"));
discardOutputRedirect(&ctx);
rc = PL_rethrow(););
if ( (rc = setupOutputRedirect(A1, &ctx, FALSE)) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
}
return rc;
}
@ -730,7 +730,8 @@ static lccat lccats[] =
static
PRED_IMPL("setlocale", 3, setlocale, 0)
{ char *what;
{ PRED_LD
char *what;
char *locale;
const lccat *lcp;
@ -794,28 +795,28 @@ EndPredDefs
const char _PL_char_types[] = {
/* ^@ ^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 */
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, 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 */
DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY,
DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY,
/* @ A B C D E F G H I J K L M N O 64-79 */
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
/* P Q R S T U V W X Y Z [ \ ] ^ _ 80-95 */
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC,
/* ` a b c d e f g h i j k l m n o 96-111 */
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
/* p q r s t u v w x y z { | } ~ ^? 112-127 */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT,
/* 128-159 (C1 controls) */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* 160-255 (G1 graphics) */
/* ISO Latin 1 is assumed */
SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC, SO, UC, UC, UC, UC, UC, UC, UC, LC,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
@ -840,7 +841,9 @@ static const enc_map map[] =
IOENC
initEncoding(void)
{ if ( LD )
{ GET_LD
if ( LD )
{ if ( !LD->encoding )
{ char *enc;
@ -882,7 +885,8 @@ initCharTypes(void)
#if __SWI_PROLOG__
bool
systemMode(bool accept)
{ bool old = SYSTEM_MODE ? TRUE : FALSE;
{ GET_LD
bool old = SYSTEM_MODE ? TRUE : FALSE;
if ( accept )
debugstatus.styleCheck |= DOLLAR_STYLE;

10
packages/PLStream/pl-feature.c
View File

@ -1,10 +0,0 @@
int defFeature(const char *c, int f, ...) {
/**** add extra flags to engine: nowadays PL_set_prolog_flag */
return 0;
}
int trueFeature(int f) {
/**** define whether the feature is set or not */
return 0;
}

155
packages/PLStream/pl-file.c
View File

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

116
packages/PLStream/pl-files.c
View File

@ -351,21 +351,25 @@ MarkExecutable(const char *name)
* FIND FILES FROM C *
*********************************/
int
static int
unifyTime(term_t t, time_t time)
{ return PL_unify_float(t, (double)time);
}
static void
static int
add_option(term_t options, functor_t f, atom_t val)
{ GET_LD
term_t head = PL_new_term_ref();
term_t head;
PL_unify_list(options, head, options);
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val);
if ( (head=PL_new_term_ref()) &&
PL_unify_list(options, head, options) &&
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val) )
{ PL_reset_term_refs(head);
return TRUE;
}
PL_reset_term_refs(head);
return FALSE;
}
#define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST)
@ -378,29 +382,36 @@ PL_get_file_name(term_t n, char **namep, int flags)
char ospath[MAXPATHLEN];
if ( flags & PL_FILE_SEARCH )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system");
term_t av = PL_new_term_refs(3);
term_t options = PL_copy_term_ref(av+2);
int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
: PL_Q_PASS_EXCEPTION);
{ fid_t fid;
PL_put_term(av+0, n);
if ( (fid = PL_open_foreign_frame()) )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system");
term_t av = PL_new_term_refs(3);
term_t options = PL_copy_term_ref(av+2);
int rc = TRUE;
int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
: PL_Q_PASS_EXCEPTION);
if ( flags & PL_FILE_EXIST )
add_option(options, FUNCTOR_access1, ATOM_exist);
if ( flags & PL_FILE_READ )
add_option(options, FUNCTOR_access1, ATOM_read);
if ( flags & PL_FILE_WRITE )
add_option(options, FUNCTOR_access1, ATOM_write);
if ( flags & PL_FILE_EXECUTE )
add_option(options, FUNCTOR_access1, ATOM_execute);
PL_put_term(av+0, n);
PL_unify_nil(options);
if ( rc && flags & PL_FILE_EXIST )
rc = add_option(options, FUNCTOR_access1, ATOM_exist);
if ( rc && flags & PL_FILE_READ )
rc = add_option(options, FUNCTOR_access1, ATOM_read);
if ( rc && flags & PL_FILE_WRITE )
rc = add_option(options, FUNCTOR_access1, ATOM_write);
if ( rc && flags & PL_FILE_EXECUTE )
rc = add_option(options, FUNCTOR_access1, ATOM_execute);
if ( !PL_call_predicate(NULL, cflags, pred, av) )
return FALSE;
if ( rc ) rc = PL_unify_nil(options);
if ( rc ) rc = PL_call_predicate(NULL, cflags, pred, av);
if ( rc ) rc = PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN);
return PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN);
PL_discard_foreign_frame(fid);
return rc;
}
return FALSE;
}
if ( flags & PL_FILE_NOERRORS )
@ -642,9 +653,51 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
if ( !PL_get_chars(base, &n, CVT_ALL) )
return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base);
return PL_unify_atom(name, TemporaryFile(n));
return PL_unify_atom(name, TemporaryFile(n, NULL));
}
/** tmp_file_stream(+Mode, -File, -Stream)
*/
static
PRED_IMPL("tmp_file_stream", 3, tmp_file_stream, 0)
{ PRED_LD
atom_t fn;
int fd;
IOENC enc;
atom_t encoding;
const char *mode;
if ( !PL_get_atom_ex(A1, &encoding) )
return FALSE;
if ( (enc = atom_to_encoding(encoding)) == ENC_UNKNOWN )
{ if ( encoding == ATOM_binary )
{ enc = ENC_OCTET;
mode = "wb";
} else
{ return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, A1);
}
} else
{ mode = "w";
}
if ( (fn=TemporaryFile("", &fd)) )
{ IOSTREAM *s;
if ( !PL_unify_atom(A2, fn) )
{ close(fd);
return PL_error(NULL, 0, NULL, ERR_MUST_BE_VAR, 2);
}
s = Sfdopen(fd, mode);
s->encoding = enc;
return PL_unify_stream(A3, s);
} else
{ return PL_error(NULL, 0, NULL, ERR_RESOURCE, ATOM_temporary_files);
}
}
/*******************************
* CHANGE FILESYSTEM *
@ -653,7 +706,13 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
static
PRED_IMPL("delete_file", 1, delete_file, 0)
{ char *n;
{ PRED_LD
char *n;
atom_t aname;
if ( PL_get_atom(A1, &aname) &&
DeleteTemporaryFile(aname) )
return TRUE;
if ( !PL_get_file_name(A1, &n, 0) )
return FALSE;
@ -662,7 +721,7 @@ PRED_IMPL("delete_file", 1, delete_file, 0)
return TRUE;
return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION,
ATOM_delete, ATOM_file, A1);
ATOM_delete, ATOM_file, A1);
}
@ -799,7 +858,7 @@ has_extension(const char *name, const char *ext)
static int
name_too_long()
name_too_long(void)
{ return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
}
@ -941,6 +1000,7 @@ BeginPredDefs(files)
PRED_DEF("exists_file", 1, exists_file, 0)
PRED_DEF("exists_directory", 1, exists_directory, 0)
PRED_DEF("tmp_file", 2, tmp_file, 0)
PRED_DEF("tmp_file_stream", 3, tmp_file_stream, 0)
PRED_DEF("delete_file", 1, delete_file, 0)
PRED_DEF("delete_directory", 1, delete_directory, 0)
PRED_DEF("make_directory", 1, make_directory, 0)

29
packages/PLStream/pl-incl.h
View File

@ -109,8 +109,7 @@ typedef struct {
} prolog_flag;
struct
{ TempFile _tmpfile_head;
TempFile _tmpfile_tail;
{ Table tmp_files; /* Known temporary files */
CanonicalDir _canonical_dirlist;
char * myhome; /* expansion of ~ */
char * fred; /* last expanded ~user */
@ -123,6 +122,25 @@ typedef struct {
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
} os;
struct
{ size_t heap; /* heap in use */
size_t atoms; /* No. of atoms defined */
size_t atomspace; /* # bytes used to store atoms */
size_t stack_space; /* # bytes on stacks */
#ifdef O_ATOMGC
size_t atomspacefreed; /* Freed atom-space */
#endif
int functors; /* No. of functors defined */
int predicates; /* No. of predicates defined */
int modules; /* No. of modules in the system */
intptr_t codes; /* No. of byte codes generated */
#ifdef O_PLMT
int threads_created; /* # threads created */
int threads_finished; /* # finished threads */
double thread_cputime; /* Total CPU time of threads */
#endif
} statistics;
struct
{ atom_t * array; /* index --> atom */
size_t count; /* elements in array */
@ -136,6 +154,8 @@ extern gds_t gds;
#define GD (&gds)
#define GLOBAL_LD (&gds)
typedef struct
{ unsigned long flags; /* Fast access to some boolean Prolog flags */
} pl_features_t;
@ -280,6 +300,7 @@ typedef struct PL_local_data {
term_t tmp; /* tmp for errors */
term_t pending; /* used by the debugger */
int in_hook; /* inside exception_hook() */
int processing; /* processing an exception */
exception_frame *throw_environment; /* PL_throw() environments */
} exception;
const char *float_format; /* floating point format */
@ -290,6 +311,8 @@ typedef struct PL_local_data {
} PL_local_data_t;
#define usedStack(D) 0
#define features (LD->feature.mask)
extern PL_local_data_t lds;
@ -586,6 +609,8 @@ extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
/**** stuff from pl-files.c ****/
void initFiles(void);
int RemoveFile(const char *path);
int PL_get_file_name(term_t n, char **namep, int flags);
/* empty stub */
void setPrologFlag(const char *name, int flags, ...);

245
packages/PLStream/pl-os.c
View File

@ -119,7 +119,8 @@ have to be dropped. See the header of pl-incl.h for details.
bool
initOs(void)
{ DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
{ GET_LD
DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
initExpand();
DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
initEnviron();
@ -409,10 +410,10 @@ setOSPrologFlags(void)
* MEMORY *
*******************************/
#if __SWI_PROLOG__
uintptr_t
UsedMemory(void)
{
{ GET_LD
#if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS)
struct rusage usage;
@ -427,23 +428,15 @@ UsedMemory(void)
usedStack(local) +
usedStack(trail));
}
#else
uintptr_t
UsedMemory(void)
{
return 0;
}
#endif
uintptr_t
FreeMemory(void)
{
#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_DATA)
uintptr_t used = UsedMemory();
struct rlimit limit;
struct rlimit limit;
if ( getrlimit(RLIMIT_DATA, &limit) == 0 )
return limit.rlim_cur - used;
@ -511,7 +504,9 @@ setRandom(unsigned int *seedp)
uint64_t
_PL_Random(void)
{ if ( !LD->os.rand_initialised )
{ GET_LD
if ( !LD->os.rand_initialised )
{ setRandom(NULL);
LD->os.rand_initialised = TRUE;
}
@ -530,9 +525,9 @@ _PL_Random(void)
#else
{ uint64_t l = rand(); /* 0<n<2^15-1 */
l ^= rand()<<15;
l ^= rand()<<30;
l ^= rand()<<45;
l ^= (uint64_t)rand()<<15;
l ^= (uint64_t)rand()<<30;
l ^= (uint64_t)rand()<<45;
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
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 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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
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
#ifdef __WINDOWS__
#define DEFTMPDIR "c:/tmp"
@ -582,22 +569,64 @@ struct tempfile
#endif
#endif
static int
free_tmp_symbol(Symbol s)
{ int rc;
atom_t tname = (atom_t)s->name;
PL_chars_t txt;
get_atom_text(tname, &txt);
PL_mb_text(&txt, REP_FN);
rc = RemoveFile(txt.text.t);
PL_free_text(&txt);
PL_unregister_atom(tname);
return rc;
}
static void
void_free_tmp_symbol(Symbol s)
{ (void)free_tmp_symbol(s);
}
#ifndef O_EXCL
#define O_EXCL 0
#endif
#ifndef O_BINARY
#define O_BINARY 0
#endif
atom_t
TemporaryFile(const char *id)
TemporaryFile(const char *id, int *fdp)
{ char temp[MAXPATHLEN];
TempFile tf = allocHeap(sizeof(struct tempfile));
char envbuf[MAXPATHLEN];
char *tmpdir;
static char *tmpdir = NULL;
atom_t tname;
int retries = 0;
if ( !((tmpdir = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
(tmpdir = Getenv("TMP", envbuf, sizeof(envbuf)))) )
tmpdir = DEFTMPDIR;
if ( !tmpdir )
{ LOCK();
if ( !tmpdir )
{ char envbuf[MAXPATHLEN];
char *td;
if ( (td = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
(td = Getenv("TMP", envbuf, sizeof(envbuf))) )
tmpdir = strdup(td);
else
tmpdir = DEFTMPDIR;
}
UNLOCK();
}
retry:
#ifdef __unix__
{ static int MTOK_temp_counter = 0;
const char *sep = id[0] ? "_" : "";
Ssprintf(temp, "%s/pl_%s_%d_%d",
tmpdir, id, (int) getpid(), MTOK_temp_counter++);
Ssprintf(temp, "%s/pl_%s%s%d_%d",
tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++);
}
#endif
@ -612,49 +641,74 @@ TemporaryFile(const char *id)
#endif
{ PrologPath(tmp, temp, sizeof(temp));
} else
Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++);
}
#endif
{ const char *sep = id[0] ? "_" : "";
#if EMX
static int temp_counter = 0;
char *foo;
if ( (foo = tempnam(".", (const char *)id)) )
{ strcpy(temp, foo);
free(foo);
} else
Ssprintf(temp, "pl_%s_%d_%d", id, getpid(), temp_counter++);
#endif
tf->name = PL_new_atom(temp); /* locked: ok! */
tf->next = NULL;
startCritical;
if ( !tmpfile_tail )
{ tmpfile_head = tmpfile_tail = tf;
} else
{ tmpfile_tail->next = tf;
tmpfile_tail = tf;
Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++);
}
endCritical;
return tf->name;
}
#endif
if ( fdp )
{ int fd;
if ( (fd=open(temp, O_CREAT|O_EXCL|O_WRONLY|O_BINARY, 0600)) < 0 )
{ if ( ++retries < 10000 )
goto retry;
else
return NULL_ATOM;
}
*fdp = fd;
}
tname = PL_new_atom(temp); /* locked: ok! */
LOCK();
if ( !GD->os.tmp_files )
{ GD->os.tmp_files = newHTable(4);
GD->os.tmp_files->free_symbol = void_free_tmp_symbol;
}
UNLOCK();
addHTable(GD->os.tmp_files, (void*)tname, (void*)TRUE);
return tname;
}
int
DeleteTemporaryFile(atom_t name)
{ int rc = FALSE;
if ( GD->os.tmp_files )
{ LOCK();
if ( GD->os.tmp_files && GD->os.tmp_files->size > 0 )
{ Symbol s = lookupHTable(GD->os.tmp_files, (void*)name);
if ( s )
{ rc = free_tmp_symbol(s);
deleteSymbolHTable(GD->os.tmp_files, s);
}
}
UNLOCK();
}
return rc;
}
void
RemoveTemporaryFiles(void)
{ TempFile tf, tf2;
{ LOCK();
if ( GD->os.tmp_files )
{ Table t = GD->os.tmp_files;
startCritical;
for(tf = tmpfile_head; tf; tf = tf2)
{ RemoveFile(stringAtom(tf->name));
tf2 = tf->next;
freeHeap(tf, sizeof(struct tempfile));
GD->os.tmp_files = NULL;
UNLOCK();
destroyHTable(t);
} else
{ UNLOCK();
}
tmpfile_head = tmpfile_tail = NULL;
endCritical;
}
@ -756,7 +810,8 @@ OsPath(const char *p, char *buf)
#if O_XOS
char *
PrologPath(const char *p, char *buf, size_t len)
{ int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
{ GET_LD
int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
return _xos_canonical_filename(p, buf, len, flags);
}
@ -813,7 +868,7 @@ forwards char *canoniseDir(char *);
static void
initExpand(void)
{
{ GET_LD
#ifdef O_CANONISE_DIRS
char *dir;
char *cpaths;
@ -923,6 +978,7 @@ verify_entry(CanonicalDir d)
d->inode = buf.st_ino;
d->device = buf.st_dev;
return TRUE;
} else
{ DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical));
@ -939,6 +995,9 @@ verify_entry(CanonicalDir d)
}
}
remove_string(d->name);
if ( d->canonical != d->name )
remove_string(d->canonical);
free(d);
}
@ -1139,7 +1198,9 @@ utf8_strlwr(char *s)
char *
canonisePath(char *path)
{ if ( !truePrologFlag(PLFLAG_FILE_CASE) )
{ GET_LD
if ( !truePrologFlag(PLFLAG_FILE_CASE) )
utf8_strlwr(path);
canoniseFileName(path);
@ -1186,7 +1247,8 @@ takeWord(const char **string, char *wrd, int maxlen)
bool
expandVars(const char *pattern, char *expanded, int maxlen)
{ int size = 0;
{ GET_LD
int size = 0;
char wordbuf[MAXPATHLEN];
if ( *pattern == '~' )
@ -1338,7 +1400,8 @@ ExpandFile(const char *pattern, char **vector)
char *
ExpandOneFile(const char *spec, char *file)
{ char *vector[256];
{ GET_LD
char *vector[256];
int size;
switch( (size=ExpandFile(spec, vector)) )
@ -1437,10 +1500,13 @@ IsAbsolutePath(const char *p)
char *
AbsoluteFile(const char *spec, char *path)
{ char tmp[MAXPATHLEN];
{ GET_LD
char tmp[MAXPATHLEN];
char buf[MAXPATHLEN];
char *file = PrologPath(spec, buf, sizeof(buf));
if ( !file )
return (char *) NULL;
if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(file = ExpandOneFile(buf, tmp)) )
return (char *) NULL;
@ -1485,7 +1551,9 @@ AbsoluteFile(const char *spec, char *path)
void
PL_changed_cwd(void)
{ if ( CWDdir )
{ GET_LD
if ( CWDdir )
remove_string(CWDdir);
CWDdir = NULL;
CWDlen = 0;
@ -1494,7 +1562,9 @@ PL_changed_cwd(void)
const char *
PL_cwd(void)
{ if ( CWDlen == 0 )
{ GET_LD
if ( CWDlen == 0 )
{ char buf[MAXPATHLEN];
char *rval;
@ -1583,7 +1653,8 @@ DirName(const char *f, char *dir)
bool
ChDir(const char *path)
{ char ospath[MAXPATHLEN];
{ GET_LD
char ospath[MAXPATHLEN];
char tmp[MAXPATHLEN];
OsPath(path, ospath);
@ -1681,7 +1752,8 @@ ResetStdin(void)
static ssize_t
Sread_terminal(void *handle, char *buf, size_t size)
{ intptr_t h = (intptr_t)handle;
{ GET_LD
intptr_t h = (intptr_t)handle;
int fd = (int)h;
source_location oldsrc = LD->read_source;
@ -1708,7 +1780,8 @@ Sread_terminal(void *handle, char *buf, size_t size)
void
ResetTty()
{ startCritical;
{ GET_LD
startCritical;
ResetStdin();
if ( !GD->os.iofunctions.read )
@ -1736,7 +1809,8 @@ ResetTty()
bool
PushTty(IOSTREAM *s, ttybuf *buf, int mode)
{ struct termios tio;
{ GET_LD
struct termios tio;
int fd;
buf->mode = ttymode;
@ -1803,7 +1877,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool
PopTty(IOSTREAM *s, ttybuf *buf)
{ int fd;
{ GET_LD
int fd;
ttymode = buf->mode;
if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
@ -1898,7 +1973,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool
PopTty(IOSTREAM *s, ttybuf *buf)
{ ttymode = buf->mode;
{ GET_LD
ttymode = buf->mode;
if ( ttymode != TTY_RAW )
LD->prompt.next = TRUE;
@ -2204,7 +2280,8 @@ argument to wait()
int
System(char *cmd)
{ int pid;
{ GET_LD
int pid;
char *shell = "/bin/sh";
int rval;
void (*old_int)();

5
packages/PLStream/pl-os.h
View File

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

192
packages/PLStream/pl-stream.c
View File

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

191
packages/PLStream/pl-text.c
View File

@ -93,16 +93,40 @@ PL_save_text(PL_chars_t *text, int flags)
addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING;
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PL_from_stack_text() moves a string from the stack, so it won't get
corrupted if GC/shift comes along.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
PL_from_stack_text(PL_chars_t *text)
{ if ( text->storage == PL_CHARS_STACK )
{ size_t bl = bufsize_text(text, text->length+1);
if ( bl < sizeof(text->buf) )
{ memcpy(text->buf, text->text.t, bl);
text->text.t = text->buf;
text->storage = PL_CHARS_LOCAL;
} else
{ Buffer b = findBuffer(BUF_RING);
addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING;
}
}
}
int
PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
{
Word w = valHandle(l);
{ word w = valHandle(l);
if ( (flags & CVT_ATOM) && isAtom(w) )
{ if ( !get_atom_text(w, text) )
@ -110,6 +134,7 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
} else if ( (flags & CVT_STRING) && isString(w) )
{ if ( !get_string_text(w, text PASS_LD) )
goto maybe_write;
PL_from_stack_text(text);
} else if ( (flags & CVT_INTEGER) && isInteger(w) )
{ number n;
@ -141,8 +166,8 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
}
text->encoding = ENC_ISO_LATIN_1;
text->canonical = TRUE;
} else if ( (flags & CVT_FLOAT) && isReal(w) )
{ format_float(valReal(w), text->buf, LD->float_format);
} else if ( (flags & CVT_FLOAT) && isFloat(w) )
{ format_float(valFloat(w), text->buf, LD->float_format);
text->text.t = text->buf;
text->length = strlen(text->text.t);
text->encoding = ENC_ISO_LATIN_1;
@ -182,11 +207,11 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
encodings[0] = ENC_ISO_LATIN_1;
encodings[1] = ENC_WCHAR;
encodings[2] = ENC_UNKNOWN;
for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
{ size_t size;
IOSTREAM *fd;
r = text->buf;
size = sizeof(text->buf);
fd = Sopenmem(&r, &size, "w");
@ -228,6 +253,9 @@ maybe_write:
goto case_write;
error:
if ( canBind(w) && (flags & CVT_VARNOFAIL) )
return 2;
if ( (flags & CVT_EXCEPTION) )
{ atom_t expected;
@ -237,7 +265,7 @@ error:
expected = ATOM_atomic;
else
expected = ATOM_atom;
return PL_error(NULL, 0, NULL, ERR_TYPE, expected, l);
}
@ -277,7 +305,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
{ case PL_ATOM:
{ atom_t a = textToAtom(text);
int rval = _PL_unify_atomic(term, a);
PL_unregister_atom(a);
return rval;
}
@ -285,7 +313,10 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
#if __SWI_PROLOG__
{ word w = textToString(text);
return _PL_unify_atomic(term, w);
if ( w )
return _PL_unify_atomic(term, w);
else
return FALSE;
}
#endif
case PL_CODE_LIST:
@ -300,35 +331,40 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
}
} else
{ GET_LD
word p0, p;
term_t l = PL_new_term_ref();
Word p0, p;
switch(text->encoding)
{ case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char *)text->text.t;
const unsigned char *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length);
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
return FALSE;
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break;
}
case ENC_WCHAR:
{ const pl_wchar_t *s = (const pl_wchar_t *)text->text.t;
const pl_wchar_t *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length);
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
return FALSE;
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break;
}
case ENC_UTF8:
@ -336,22 +372,24 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
const char *e = &s[text->length];
size_t len = utf8_strlen(s, text->length);
p0 = p = INIT_SEQ_CODES(len);
if ( type == PL_CODE_LIST ) {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_CODES(p, chr);
}
} else {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_ATOMS(p, chr);
}
}
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
return FALSE;
if ( type == PL_CODE_LIST ) {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_CODES(p, chr);
}
} else {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_ATOMS(p, chr);
}
}
break;
}
case ENC_ANSI:
@ -367,18 +405,21 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
n -= rc;
s += rc;
}
p0 = p = INIT_SEQ_CODES(len);
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
return FALSE;
memset(&mbs, 0, sizeof(mbs));
n = text->length;
while(n > 0) {
rc = mbrtowc(&wc, s, n, &mbs);
while(n > 0)
{ rc = mbrtowc(&wc, s, n, &mbs);
if ( type == PL_CODE_LIST )
p = EXTEND_SEQ_CODES(p, wc);
else
p = EXTEND_SEQ_ATOMS(p, wc);
s += rc;
n -= rc;
}
@ -391,7 +432,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
}
}
return CLOSE_SEQ_OF_CODES(p, p0, tail, term );
return CLOSE_SEQ_OF_CODES(p, p0, tail, term, l );
}
}
default:
@ -430,7 +471,7 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
rc = PL_unify_text(term, 0, &sub, type);
PL_free_text(&sub);
return rc;
}
}
@ -458,7 +499,7 @@ PL_promote_text(PL_chars_t *text)
PL_free(text->text.t);
text->text.w = new;
text->encoding = ENC_WCHAR;
} else if ( text->storage == PL_CHARS_LOCAL &&
(text->length+1)*sizeof(pl_wchar_t) < sizeof(text->buf) )
@ -512,7 +553,7 @@ PL_demote_text(PL_chars_t *text)
PL_free(text->text.t);
text->text.t = new;
text->encoding = ENC_ISO_LATIN_1;
} else if ( text->storage == PL_CHARS_LOCAL )
{ pl_wchar_t buf[sizeof(text->buf)/sizeof(pl_wchar_t)];
@ -601,7 +642,7 @@ utf8tobuffer(wchar_t c, Buffer buf)
{ char b[6];
char *e = b;
const char *s;
e = utf8_put_char(e, c);
for(s=b; s<e; s++)
addBuffer(buf, *s, char);
@ -617,7 +658,7 @@ PL_mb_text(PL_chars_t *text, int flags)
if ( text->encoding != target )
{ Buffer b = findBuffer(BUF_RING);
switch(text->encoding)
{ case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char*)text->text.t;
@ -658,7 +699,7 @@ PL_mb_text(PL_chars_t *text, int flags)
addBuffer(b, 0, char);
} else /* if ( target == ENC_MB ) */
{ mbstate_t mbs;
memset(&mbs, 0, sizeof(mbs));
for( ; w<e; w++)
{ if ( !wctobuffer(*w, &mbs, b) )
@ -692,7 +733,7 @@ rep_error:
sprintf(msg,
"Cannot represent char U%04x using %s encoding",
norep,
norep,
target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale");
return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding);
@ -711,7 +752,7 @@ PL_canonise_text(PL_chars_t *text)
case ENC_WCHAR:
{ const pl_wchar_t *w = (const pl_wchar_t*)text->text.w;
const pl_wchar_t *e = &w[text->length];
for(; w<e; w++)
{ if ( *w > 0xff )
return FALSE;
@ -1013,7 +1054,7 @@ PL_cmp_text(PL_chars_t *t1, size_t o1, PL_chars_t *t2, size_t o2,
return ifeq;
else
return *s > *q ? 1 : -1;
}
}
}
@ -1098,35 +1139,3 @@ Sopen_text(PL_chars_t *txt, const char *mode)
return stream;
}
int
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text;
term_t tail;
int rc;
if ( len == (size_t)-1 )
len = strlen(s);
text.text.t = (char *)s;
text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \
(flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1);
text.storage = PL_CHARS_HEAP;
text.length = len;
text.canonical = FALSE;
flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1);
if ( (flags & PL_DIFF_LIST) )
{ tail = t+1;
flags &= (~PL_DIFF_LIST);
} else
{ tail = 0;
}
rc = PL_unify_text(t, tail, &text, flags);
PL_free_text(&text);
return rc;
}

33
packages/PLStream/pl-yap.c
View File

@ -250,7 +250,7 @@ scan_options(term_t options, int flags, atom_t optype,
term_t val = PL_new_term_ref();
int n;
if ( trueFeature(ISO_FEATURE) )
if ( truePrologFlag(PLFLAG_ISO) )
flags |= OPT_ALL;
va_start(args, specs);
@ -557,3 +557,34 @@ PL_set_prolog_flag(const char *name, int flags, ...)
{
}
int
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text;
term_t tail;
int rc;
if ( len == (size_t)-1 )
len = strlen(s);
text.text.t = (char *)s;
text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \
(flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1);
text.storage = PL_CHARS_HEAP;
text.length = len;
text.canonical = FALSE;
flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1);
if ( (flags & PL_DIFF_LIST) )
{ tail = t+1;
flags &= (~PL_DIFF_LIST);
} else
{ tail = 0;
}
rc = PL_unify_text(t, tail, &text, flags);
PL_free_text(&text);
return rc;
}

7
packages/PLStream/pl-yap.h
View File

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

2
packages/jpl

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

10
pl/directives.yap
View File

@ -876,10 +876,20 @@ yap_flag(max_threads,X) :-
yap_flag(max_threads,X) :-
'$do_error'(domain_error(flag_value,max_threads+X),yap_flag(max_threads,X)).
yap_flag(address_bits,X) :-
var(X), !,
'$address_bits'(X).
yap_flag(address_bits,X) :-
integer(X), X > 0, !,
'$do_error'(permission_error(modify,flag,address_bits),yap_flag(address_bits,X)).
yap_flag(address_bits,X) :-
'$do_error'(domain_error(flag_value,address_bits+X),yap_flag(address_bits,X)).
yap_flag(dialect,yap).
'$show_yap_flag_opts'(V,Out) :-
(
V = address_bits ;
V = answer_format ;
V = argv ;
V = bounded ;