From 9550393e6665f2d9cb93f4dc57f5249481f81e64 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 15 Jan 2013 22:58:34 +0000 Subject: [PATCH 1/3] check for enough head space --- C/compiler.c | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/C/compiler.c b/C/compiler.c index d42504c72..9d6907a70 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -2109,14 +2109,14 @@ c_head(Term t, compiler_struct *cglobs) if (IsAtomTerm(t)) { Yap_emit(name_op, (CELL) AtomOfTerm(t), Zero, &cglobs->cint); #ifdef BEAM - if (EAM) { - Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint); - } + if (EAM) { + Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint); + } #endif + Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint); + cglobs->space_op = cglobs->cint.cpc; return; } - Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint); - cglobs->space_op = cglobs->cint.cpc; f = FunctorOfTerm(t); Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f), &cglobs->cint); #ifdef BEAM @@ -2124,8 +2124,10 @@ c_head(Term t, compiler_struct *cglobs) Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint); } #endif - if (Yap_ExecutionMode == MIXED_MODE_USER) + if (Yap_ExecutionMode == MIXED_MODE_USER) Yap_emit(native_op, 0, 0, &cglobs->cint); + Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint); + cglobs->space_op = cglobs->cint.cpc; c_args(t, 0, cglobs); } @@ -3537,6 +3539,10 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src) } if (LOCAL_ErrorMessage) return (0); + /* make sure we give enough space for the fact */ + if (cglobs.space_op) + cglobs.space_op->rnd1 = cglobs.space_used; + #ifdef DEBUG if (GLOBAL_Option['g' - 96]) Yap_ShowCode(&cglobs.cint); From 0eacb68907a8dc6c306b77b5068f8c19c4d12dc5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 16 Jan 2013 00:19:07 +0000 Subject: [PATCH 2/3] SWI update --- C/pl-yap.c | 10 + H/pl-global.h | 10 + H/pl-incl.h | 14 +- include/SWI-Prolog.h | 4 +- os/pl-buffer.h | 24 ++- os/pl-ctype.c | 4 +- os/pl-file.c | 90 +++++---- os/pl-files.c | 126 +++++++++---- os/pl-files.h | 12 +- os/pl-os.c | 440 ++++++++++++++++++++----------------------- os/pl-rl.c | 73 +++---- os/pl-utf8.h | 4 +- 12 files changed, 467 insertions(+), 344 deletions(-) diff --git a/C/pl-yap.c b/C/pl-yap.c index 16e0ba573..a68573bfb 100755 --- a/C/pl-yap.c +++ b/C/pl-yap.c @@ -1213,6 +1213,16 @@ nameOfWideAtom(atom_t atom) return RepAtom(a)->WStrOfAE; } +access_level_t +setAccessLevel(access_level_t accept) +{ GET_LD + bool old; + + old = LD->prolog_flag.access_level; + LD->prolog_flag.access_level = accept; + return old; +} + #if THREADS diff --git a/H/pl-global.h b/H/pl-global.h index a6860b105..f342d002c 100644 --- a/H/pl-global.h +++ b/H/pl-global.h @@ -81,6 +81,15 @@ typedef struct { int optimise; /* -O: optimised compilation */ } cmdline; + struct + { char * CWDdir; + size_t CWDlen; + char * executable; /* Running executable */ +#ifdef __WINDOWS__ + char * module; /* argv[0] module passed */ +#endif + } paths; + struct { ExtensionCell _ext_head; /* head of registered extensions */ ExtensionCell _ext_tail; /* tail of this chain */ @@ -193,6 +202,7 @@ typedef struct PL_local_data { pl_features_t mask; /* Masked access to booleans */ int write_attributes; /* how to write attvars? */ occurs_check_t occurs_check; /* Unify and occurs check */ + access_level_t access_level; /* Current access level */ } prolog_flag; void * glob_info; /* pl-glob.c */ diff --git a/H/pl-incl.h b/H/pl-incl.h index 4d2a7e225..340cf34ab 100755 --- a/H/pl-incl.h +++ b/H/pl-incl.h @@ -240,6 +240,7 @@ users foreign language code. #define PRED_LD #define PASS_LD #define PASS_LD1 +#define IGNORE_LD #else @@ -253,6 +254,7 @@ users foreign language code. #define PASS_LD1 LD #define PASS_LD , LD #define PRED_LD GET_LD +#define IGNORE_LD (void)__PL_ld; #endif @@ -531,6 +533,14 @@ typedef struct redir_context #include "pl-file.h" +typedef enum +{ ACCESS_LEVEL_USER = 0, /* Default user view */ + ACCESS_LEVEL_SYSTEM /* Allow low-level access */ +} access_level_t; + +#define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM) + + /* vsc: global variables */ #include "pl-global.h" @@ -682,6 +692,7 @@ typedef double real; #endif +#define PL_unify_time(A,B) PL_unify_int64(A,B) extern int PL_unify_char(term_t chr, int c, int how); extern int PL_get_char(term_t chr, int *c, int eof); extern void PL_cleanup_fork(void); @@ -797,6 +808,7 @@ COMMON(int) unicode_separator(pl_wchar_t c); COMMON(word) pl_raw_read(term_t term); COMMON(word) pl_raw_read2(term_t stream, term_t term); +COMMON(access_level_t) setAccessLevel(access_level_t new_level); /**** stuff from pl-error.c ****/ extern void outOfCore(void); @@ -838,7 +850,7 @@ extern size_t getenv3(const char *name, char *buf, size_t len); extern int Setenv(char *name, char *value); extern int Unsetenv(char *name); extern int System(char *cmd); -extern bool expandVars(const char *pattern, char *expanded, int maxlen); +extern char *expandVars(const char *pattern, char *expanded, int maxlen); /**** SWI stuff (emulated in pl-yap.c) ****/ extern int writeAtomToStream(IOSTREAM *so, atom_t at); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index aa3cdfe88..85ce03bc3 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -622,7 +622,7 @@ extern char *PL_prompt_string(int fd); PL_EXPORT(int) PL_get_file_name(term_t n, char **name, int flags); PL_EXPORT(int) PL_get_file_nameW(term_t n, wchar_t **name, int flags); PL_EXPORT(void) PL_changed_cwd(void); /* foreign code changed CWD */ -PL_EXPORT(const char *) PL_cwd(void); +PL_EXPORT(char *) PL_cwd(char *buf, size_t buflen); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - NOTE: the functions in this section are not documented, as as yet not @@ -788,8 +788,6 @@ PL_EXPORT(int) PL_unify_mpq(term_t t, mpq_t mpz); #endif -extern X_API const char *PL_cwd(void); - void swi_install(void); X_API int PL_warning(const char *msg, ...); diff --git a/os/pl-buffer.h b/os/pl-buffer.h index a629bf969..ba7e63f21 100644 --- a/os/pl-buffer.h +++ b/os/pl-buffer.h @@ -49,7 +49,7 @@ int growBuffer(Buffer b, size_t minfree); { if ( !growBuffer((Buffer)b, sizeof(type)) ) \ outOfCore(); \ } \ - *((type *)(b)->top) = obj; \ + *((type *)(b)->top) = obj; \ (b)->top += sizeof(type); \ } while(0) @@ -68,6 +68,24 @@ int growBuffer(Buffer b, size_t minfree); (b)->top = (char *)_d; \ } while(0) +#define allocFromBuffer(b, bytes) \ + f__allocFromBuffer((Buffer)(b), (bytes)) + +static inline void* +f__allocFromBuffer(Buffer b, size_t bytes) +{ if ( b->top + bytes <= b->max || + growBuffer(b, bytes) ) + { void *top = b->top; + + b->top += bytes; + + return top; + } + + return NULL; +} + + #define baseBuffer(b, type) ((type *) (b)->base) #define topBuffer(b, type) ((type *) (b)->top) #define inBuffer(b, addr) ((char *) (addr) >= (b)->base && \ @@ -83,6 +101,8 @@ int growBuffer(Buffer b, size_t minfree); sizeof((b)->static_buffer)) #define emptyBuffer(b) ((b)->top = (b)->base) #define isEmptyBuffer(b) ((b)->top == (b)->base) +#define popBuffer(b,type) \ + ((b)->top -= sizeof(type), *(type*)(b)->top) #define discardBuffer(b) \ do \ @@ -99,6 +119,6 @@ int growBuffer(Buffer b, size_t minfree); COMMON(Buffer) findBuffer(int flags); COMMON(int) unfindBuffer(int flags); -COMMON(char *) buffer_string(const char *s, int flags); +COMMON(char *) buffer_string(const char *s, int flags); #endif /*BUFFER_H_INCLUDED*/ diff --git a/os/pl-ctype.c b/os/pl-ctype.c index 552328a0f..5e5a6d1ce 100644 --- a/os/pl-ctype.c +++ b/os/pl-ctype.c @@ -471,7 +471,7 @@ init_tout(PL_chars_t *t, size_t len) { t->text.t = t->buf; t->storage = PL_CHARS_LOCAL; } else - { t->text.t = PL_malloc(len+1); + { t->text.t = PL_malloc(len); t->storage = PL_CHARS_MALLOC; } succeed; @@ -480,7 +480,7 @@ init_tout(PL_chars_t *t, size_t len) { t->text.w = (pl_wchar_t*)t->buf; t->storage = PL_CHARS_LOCAL; } else - { t->text.w = PL_malloc((len+1)*sizeof(pl_wchar_t)); + { t->text.w = PL_malloc(len*sizeof(pl_wchar_t)); t->storage = PL_CHARS_MALLOC; } succeed; diff --git a/os/pl-file.c b/os/pl-file.c index 85fb9d962..4ac3e5b42 100755 --- a/os/pl-file.c +++ b/os/pl-file.c @@ -1154,6 +1154,7 @@ protocol(const char *str, size_t n) * TEMPORARY I/O * *******************************/ + int push_input_context(atom_t type) { GET_LD @@ -1953,7 +1954,7 @@ error: return FALSE; } -#if defined(__WINDOWS__) && !defined(__MINGW32__) /* defined in pl-nt.c */ +#ifdef _MSC_VER /* defined in pl-nt.c */ extern int ftruncate(int fileno, int64_t length); #define HAVE_FTRUNCATE #endif @@ -3586,8 +3587,10 @@ static int stream_file_name_propery(IOSTREAM *s, term_t prop ARG_LD) { atom_t name; - if ( (name = getStreamContext(s)->filename) ) - { return PL_unify_atom(prop, name); + for(; s; s=s->downstream) + { if ( (name = getStreamContext(s)->filename) ) + { return PL_unify_atom(prop, name); + } } return FALSE; @@ -3617,13 +3620,17 @@ stream_mode_property(IOSTREAM *s, term_t prop ARG_LD) static int stream_input_prop(IOSTREAM *s ARG_LD) -{ return (s->flags & SIO_INPUT) ? TRUE : FALSE; +{ IGNORE_LD + + return (s->flags & SIO_INPUT) ? TRUE : FALSE; } static int stream_output_prop(IOSTREAM *s ARG_LD) -{ return (s->flags & SIO_OUTPUT) ? TRUE : FALSE; +{ IGNORE_LD + + return (s->flags & SIO_OUTPUT) ? TRUE : FALSE; } @@ -3664,7 +3671,9 @@ stream_alias_prop(IOSTREAM *s, term_t prop ARG_LD) static int stream_position_prop(IOSTREAM *s, term_t prop ARG_LD) -{ if ( s->position ) +{ IGNORE_LD + + if ( s->position ) { return PL_unify_term(prop, PL_FUNCTOR, FUNCTOR_stream_position4, PL_INT64, s->position->charno, @@ -3680,8 +3689,7 @@ stream_position_prop(IOSTREAM *s, term_t prop ARG_LD) static int stream_end_of_stream_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( s->flags & SIO_INPUT ) - { GET_LD - atom_t val; + { atom_t val; if ( s->flags & SIO_FEOF2 ) val = ATOM_past; @@ -3730,7 +3738,7 @@ stream_reposition_prop(IOSTREAM *s, term_t prop ARG_LD) int fd = Sfileno(s); struct stat buf; - if ( fstat(fd, &buf) == 0 && S_ISREG(buf.st_mode) ) + if ( fd != -1 && fstat(fd, &buf) == 0 && S_ISREG(buf.st_mode) ) val = ATOM_true; else val = ATOM_false; @@ -3746,7 +3754,9 @@ stream_reposition_prop(IOSTREAM *s, term_t prop ARG_LD) static int stream_close_on_abort_prop(IOSTREAM *s, term_t prop ARG_LD) -{ return PL_unify_bool_ex(prop, !(s->flags & SIO_NOCLOSE)); +{ IGNORE_LD + + return PL_unify_bool_ex(prop, !(s->flags & SIO_NOCLOSE)); } @@ -3769,7 +3779,9 @@ stream_file_no_prop(IOSTREAM *s, term_t prop ARG_LD) static int stream_tty_prop(IOSTREAM *s, term_t prop ARG_LD) -{ if ( (s->flags & SIO_ISATTY) ) +{ IGNORE_LD + + if ( (s->flags & SIO_ISATTY) ) return PL_unify_bool_ex(prop, TRUE); return FALSE; @@ -3778,7 +3790,9 @@ stream_tty_prop(IOSTREAM *s, term_t prop ARG_LD) static int stream_bom_prop(IOSTREAM *s, term_t prop ARG_LD) -{ if ( (s->flags & SIO_BOM) ) +{ IGNORE_LD + + if ( (s->flags & SIO_BOM) ) return PL_unify_bool_ex(prop, TRUE); return FALSE; @@ -3876,6 +3890,7 @@ stream_close_on_exec_prop(IOSTREAM *s, term_t prop ARG_LD) #else int fd_flags; #endif + IGNORE_LD if ( (fd = Sfileno(s)) < 0) return FALSE; @@ -3915,7 +3930,7 @@ static const sprop sprop_list [] = { FUNCTOR_end_of_stream1, stream_end_of_stream_prop }, { FUNCTOR_eof_action1, stream_eof_action_prop }, { FUNCTOR_reposition1, stream_reposition_prop }, - { FUNCTOR_type1, stream_type_prop }, + { FUNCTOR_type1, stream_type_prop }, { FUNCTOR_file_no1, stream_file_no_prop }, { FUNCTOR_buffer1, stream_buffer_prop }, { FUNCTOR_buffer_size1, stream_buffer_size_prop }, @@ -3974,7 +3989,7 @@ PRED_IMPL("stream_property", 2, stream_property, ATOM_stream_property, property); } - pe = allocHeap(sizeof(*pe)); + pe = allocForeignState(sizeof(*pe)); pe->e = newTableEnum(streamContext); pe->s = NULL; @@ -3992,7 +4007,7 @@ PRED_IMPL("stream_property", 2, stream_property, { functor_t f; if ( PL_is_variable(property) ) /* generate properties */ - { pe = allocHeap(sizeof(*pe)); + { pe = allocForeignState(sizeof(*pe)); pe->e = NULL; pe->s = s; @@ -4050,7 +4065,7 @@ PRED_IMPL("stream_property", 2, stream_property, { if ( pe->e ) freeTableEnum(pe->e); - freeHeap(pe, sizeof(*pe)); + freeForeignState(pe, sizeof(*pe)); } return TRUE; } @@ -4066,7 +4081,7 @@ PRED_IMPL("stream_property", 2, stream_property, if ( pe->e ) freeTableEnum(pe->e); - freeHeap(pe, sizeof(*pe)); + freeForeignState(pe, sizeof(*pe)); return FALSE; } @@ -4140,7 +4155,7 @@ PRED_IMPL("stream_property", 2, stream_property, { if ( pe->e ) freeTableEnum(pe->e); - freeHeap(pe, sizeof(*pe)); + freeForeignState(pe, sizeof(*pe)); return FALSE; } } @@ -4385,7 +4400,8 @@ PRED_IMPL("current_output", 1, current_output, PL_FA_ISO) static PRED_IMPL("byte_count", 2, byte_count, 0) -{ IOSTREAM *s; +{ PRED_LD + IOSTREAM *s; if ( getStreamWithPosition(A1, &s) ) { int64_t n = s->position->byteno; @@ -4400,7 +4416,8 @@ PRED_IMPL("byte_count", 2, byte_count, 0) static PRED_IMPL("character_count", 2, character_count, 0) -{ IOSTREAM *s; +{ PRED_LD + IOSTREAM *s; if ( getStreamWithPosition(A1, &s) ) { int64_t n = s->position->charno; @@ -4501,7 +4518,7 @@ peek(term_t stream, term_t chr, int how ARG_LD) if ( !getInputStream(stream, how == PL_BYTE ? S_BINARY : S_TEXT, &s) ) return FALSE; - if ( true(s, SIO_NBUF) || (s->bufsize && s->bufsize < MB_LEN_MAX) ) + if ( true(s, SIO_NBUF) || (s->bufsize && s->bufsize < PL_MB_LEN_MAX) ) { releaseStream(s); return PL_error(NULL, 0, "stream is unbuffered", ERR_PERMISSION, ATOM_peek, ATOM_stream, stream); @@ -4588,20 +4605,23 @@ ssize_t Sread_user(void *handle, char *buf, size_t size) { GET_LD wrappedIO *wio = handle; + ssize_t rc; if ( LD->prompt.next && ttymode != TTY_RAW ) PL_write_prompt(TRUE); else Sflush(Suser_output); - size = (*wio->wrapped_functions->read)(wio->wrapped_handle, buf, size); - if ( size == 0 ) /* end-of-file */ + rc = (*wio->wrapped_functions->read)(wio->wrapped_handle, buf, size); + if ( rc == 0 ) /* end-of-file */ { Sclearerr(Suser_input); LD->prompt.next = TRUE; - } else if ( size > 0 && buf[size-1] == '\n' ) + } else if ( rc == 1 && buf[0] == 04 ) + { rc = 0; /* Map ^D to end-of-file */ + } else if ( rc > 0 && buf[rc-1] == '\n' ) LD->prompt.next = TRUE; - return size; + return rc; } @@ -4649,9 +4669,9 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0) IOSTREAM *in = NULL, *out = NULL, *error = NULL; int rval = FALSE; int wrapin = FALSE; + int i; - if ( !term_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED PASS_LD) || - !term_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS PASS_LD) ) + if ( !term_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED PASS_LD) ) goto out; wrapin = (LD->IO.streams[0] != in); @@ -4660,6 +4680,9 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0) goto out; } + if ( !term_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS PASS_LD) ) + goto out; + if ( PL_compare(A2, A3) == 0 ) /* == */ { error = getStream(Snew(out->handle, out->flags, out->functions)); if ( !error ) @@ -4686,6 +4709,11 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0) LD->prompt.next = TRUE; } + for(i=0; i<3; i++) + { LD->IO.streams[i]->position = &LD->IO.streams[0]->posbuf; + LD->IO.streams[i]->flags |= SIO_RECORDPOS; + } + UNLOCK(); rval = TRUE; @@ -4710,7 +4738,7 @@ PRED_IMPL("$size_stream", 2, size_stream, 0) if ( !PL_get_stream_handle(A1, &s) ) return FALSE; - rval = PL_unify_integer(A2, Ssize(s)); + rval = PL_unify_int64(A2, Ssize(s)); PL_release_stream(s); return rval; @@ -4855,15 +4883,12 @@ BeginPredDefs(file) PRED_DEF("is_stream", 1, is_stream, 0) PRED_DEF("set_stream", 2, set_stream, 0) PRED_DEF("with_output_to", 2, with_output_to, PL_FA_TRANSPARENT) -//vsc PRED_DEF("set_prolog_IO", 3, set_prolog_IO, 0) PRED_DEF("protocol", 1, protocol, 0) PRED_DEF("protocola", 1, protocola, 0) PRED_DEF("noprotocol", 0, noprotocol, 0) PRED_DEF("protocolling", 1, protocolling, 0) -//vsc PRED_DEF("prompt1", 1, prompt1, 0) -//vsc PRED_DEF("seek", 4, seek, 0) PRED_DEF("wait_for_input", 3, wait_for_input, 0) PRED_DEF("get_single_char", 1, get_single_char, 0) @@ -4875,11 +4900,10 @@ BeginPredDefs(file) PRED_DEF("set_end_of_stream", 1, set_end_of_stream, 0) /* SWI internal */ - PRED_DEF("$push_input_context", 0, push_input_context, 0) + PRED_DEF("$push_input_context", 1, push_input_context, 0) PRED_DEF("$pop_input_context", 0, pop_input_context, 0) PRED_DEF("$input_context", 1, input_context, 0) PRED_DEF("$size_stream", 2, size_stream, 0) -//vsc EndPredDefs #if __YAP_PROLOG__ diff --git a/os/pl-files.c b/os/pl-files.c index 97a84cb27..2c290d6e1 100644 --- a/os/pl-files.c +++ b/os/pl-files.c @@ -3,9 +3,10 @@ Part of SWI-Prolog Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl + E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2008, University of Amsterdam + Copyright (C): 1985-2011, University of Amsterdam + VU University Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -19,7 +20,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "pl-incl.h" @@ -44,26 +45,89 @@ General file operations and binding to Prolog - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ +#ifdef __WINDOWS__ +static void +set_posix_error(int win_error) +{ int error = 0; + + switch(win_error) + { case ERROR_ACCESS_DENIED: error = EACCES; break; + case ERROR_FILE_NOT_FOUND: error = ENOENT; break; + case ERROR_SHARING_VIOLATION: error = EAGAIN; break; + case ERROR_ALREADY_EXISTS: error = EEXIST; break; + } + + errno = error; +} +#endif /*__WINDOWS__*/ + + /******************************* * OS STUFF * *******************************/ -/** time_t LastModifiedFile(const char *file) +/** int LastModifiedFile(const char *file, double *t) Return the last modification time of file as a POSIX timestamp. Returns (time_t)-1 on failure. + +Contains a 64-bit value representing the number of 100-nanosecond +intervals since January 1, 1601 (UTC). */ +int +LastModifiedFile(const char *name, double *tp) +{ +#ifdef __WINDOWS__ + HANDLE hFile; + wchar_t wfile[MAXPATHLEN]; -time_t -LastModifiedFile(const char *file) -{ char tmp[MAXPATHLEN]; +#define nano * 0.000000001 +#define ntick 100.0 +#define SEC_TO_UNIX_EPOCH 11644473600.0 + + if ( !_xos_os_filenameW(name, wfile, MAXPATHLEN) ) + return FALSE; + + if ( (hFile=CreateFileW(wfile, + 0, + FILE_SHARE_DELETE|FILE_SHARE_READ|FILE_SHARE_WRITE, + NULL, + OPEN_EXISTING, + FILE_FLAG_BACKUP_SEMANTICS, + NULL)) != INVALID_HANDLE_VALUE ) + { FILETIME wt; + int rc; + + rc = GetFileTime(hFile, NULL, NULL, &wt); + CloseHandle(hFile); + + if ( rc ) + { double t; + + t = (double)wt.dwHighDateTime * (4294967296.0 * ntick nano); + t += (double)wt.dwLowDateTime * (ntick nano); + t -= SEC_TO_UNIX_EPOCH; + + *tp = t; + + return TRUE; + } + } + + set_posix_error(GetLastError()); + + return FALSE; +#else + char tmp[MAXPATHLEN]; statstruct buf; - if ( statfunc(OsPath(file, tmp), &buf) < 0 ) - return (time_t)-1; + if ( statfunc(OsPath(name, tmp), &buf) < 0 ) + return FALSE; - return buf.st_mtime; + *tp = (double)buf.st_mtime; + return TRUE; +#endif } @@ -349,13 +413,7 @@ MarkExecutable(const char *name) int unifyTime(term_t t, time_t time) -{ -#if __YAP_PROLOG__ - /* maintain compatibility with old Prolog systems, and avoid losing precision unnecessarily */ - return PL_unify_int64(t, (int64_t)time); -#else - return PL_unify_float(t, (double)time); -#endif +{ return PL_unify_time(t, time); } @@ -433,9 +491,12 @@ get_file_name(term_t n, char **namep, char *tmp, int flags) return PL_error(NULL, 0, "file name contains a 0-code", ERR_DOMAIN, ATOM_file_name, n); } + if ( len+1 >= MAXPATHLEN ) + return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, + ATOM_max_path_length); if ( truePrologFlag(PLFLAG_FILEVARS) ) - { if ( !(name = ExpandOneFile(name, tmp)) ) + { if ( !(name = expandVars(name, tmp, MAXPATHLEN)) ) return FALSE; } @@ -529,13 +590,13 @@ PRED_IMPL("time_file", 2, time_file, 0) { char *fn; if ( PL_get_file_name(A1, &fn, 0) ) - { time_t time; + { double time; - if ( (time = LastModifiedFile(fn)) == (time_t)-1 ) - return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, - ATOM_time, ATOM_file, A1); + if ( LastModifiedFile(fn, &time) ) + return PL_unify_float(A2, time); - return unifyTime(A2, time); + return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, + ATOM_time, ATOM_file, A1); } return FALSE; @@ -544,7 +605,8 @@ PRED_IMPL("time_file", 2, time_file, 0) static PRED_IMPL("size_file", 2, size_file, 0) -{ char *n; +{ PRED_LD + char *n; if ( PL_get_file_name(A1, &n, 0) ) { int64_t size; @@ -680,7 +742,7 @@ static PRED_IMPL("file_base_name", 2, file_base_name, 0) { char *n; - if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) ) + if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) ) return FALSE; return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, BaseName(n)); @@ -692,7 +754,7 @@ PRED_IMPL("file_directory_name", 2, file_directory_name, 0) { char *n; char tmp[MAXPATHLEN]; - if ( !PL_get_chars_ex(A1, &n, CVT_ALL|REP_FN) ) + if ( !PL_get_chars(A1, &n, CVT_ALL|REP_FN|CVT_EXCEPTION) ) return FALSE; return PL_unify_chars(A2, PL_ATOM|REP_FN, -1, DirName(n, tmp)); @@ -868,12 +930,13 @@ PRED_IMPL("$absolute_file_name", 2, absolute_file_name, 0) static PRED_IMPL("working_directory", 2, working_directory, 0) { PRED_LD + char buf[MAXPATHLEN]; const char *wd; term_t old = A1; term_t new = A2; - if ( !(wd = PL_cwd()) ) + if ( !(wd = PL_cwd(buf, sizeof(buf))) ) return FALSE; if ( PL_unify_chars(old, PL_ATOM|REP_FN, -1, wd) ) @@ -966,8 +1029,8 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0) PL_fail; } - if ( PL_get_chars_ex(base, &b, CVT_ALL|BUF_RING|REP_FN) && - PL_get_chars_ex(ext, &e, CVT_ALL|REP_FN) ) + if ( PL_get_chars(base, &b, CVT_ALL|BUF_RING|REP_FN|CVT_EXCEPTION) && + PL_get_chars(ext, &e, CVT_ALL|REP_FN|CVT_EXCEPTION) ) { char *s; if ( e[0] == '.' ) /* +Base, +Extension, -full */ @@ -989,20 +1052,19 @@ PRED_IMPL("file_name_extension", 3, file_name_extension, 0) static PRED_IMPL("prolog_to_os_filename", 2, prolog_to_os_filename, 0) -{ +{ PRED_LD term_t pl = A1; term_t os = A2; #ifdef O_XOS - PRED_LD wchar_t *wn; if ( !PL_is_variable(pl) ) { char *n; wchar_t buf[MAXPATHLEN]; - if ( PL_get_chars_ex(pl, &n, CVT_ALL|REP_UTF8) ) + if ( PL_get_chars(pl, &n, CVT_ALL|REP_UTF8|CVT_EXCEPTION) ) { if ( !_xos_os_filenameW(n, buf, MAXPATHLEN) ) return name_too_long(); diff --git a/os/pl-files.h b/os/pl-files.h index 5c9af21f5..d69e181e0 100644 --- a/os/pl-files.h +++ b/os/pl-files.h @@ -19,7 +19,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef PL_FILES_H_INCLUDED @@ -31,11 +31,11 @@ #define ACCESS_WRITE 4 COMMON(void) initFiles(void); -COMMON(time_t) LastModifiedFile(const char *f); -COMMON(int) RemoveFile(const char *path); +COMMON(int) LastModifiedFile(const char *f, double *t); +COMMON(int) RemoveFile(const char *path); COMMON(int) AccessFile(const char *path, int mode); -COMMON(char *) DeRefLink(const char *link, char *buf); -COMMON(int) ExistsFile(const char *path); -COMMON(int) ExistsDirectory(const char *path); +COMMON(char *) DeRefLink(const char *link, char *buf); +COMMON(int) ExistsFile(const char *path); +COMMON(int) ExistsDirectory(const char *path); #endif /*PL_FILES_H_INCLUDED*/ diff --git a/os/pl-os.c b/os/pl-os.c index 161f72f38..443c68990 100644 --- a/os/pl-os.c +++ b/os/pl-os.c @@ -1,11 +1,10 @@ -/* $Id$ - - Part of SWI-Prolog +/* Part of SWI-Prolog Author: Jan Wielemaker - E-mail: wielemak@science.uva.nl + E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2007, University of Amsterdam + Copyright (C): 1985-2013, University of Amsterdam + VU University Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -19,7 +18,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* Modified (M) 1993 Dave Sherratt */ @@ -30,6 +29,17 @@ #include /* this has to appear before pl-incl.h */ #endif +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +Solaris has asctime_r() with 3 arguments. Using _POSIX_PTHREAD_SEMANTICS +is supposed to give the POSIX standard one. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +#if defined(__sun__) || defined(__sun) +#define _POSIX_PTHREAD_SEMANTICS 1 +#endif + +#define __MINGW_USE_VC2005_COMPAT /* Get Windows time_t as 64-bit */ + #include "pl-incl.h" #include "pl-ctype.h" #include "pl-utf8.h" @@ -96,27 +106,11 @@ static double initial_time; static void initExpand(void); static void cleanupExpand(void); static void initEnviron(void); -static char * Which(const char *program, char *fullname); #ifndef DEFAULT_PATH #define DEFAULT_PATH "/bin:/usr/bin" #endif - /******************************* - * GLOBALS * - *******************************/ -#ifdef HAVE_CLOCK -long clock_wait_ticks; -#endif - -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -This module is a contraction of functions that used to be all over the -place. together with pl-os.h (included by pl-incl.h) this file -should define a basic layer around the OS, on which the rest of -SWI-Prolog is based. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - /******************************** * INITIALISATION * *********************************/ @@ -145,20 +139,6 @@ initOs(void) setPrologFlagMask(PLFLAG_FILE_CASE_PRESERVING); #endif -#ifdef HAVE_CLOCK - clock_wait_ticks = 0L; -#endif - -#if OS2 - { DATETIME i; - DosGetDateTime((PDATETIME)&i); - initial_time = (i.hours * 3600.0) - + (i.minutes * 60.0) - + i.seconds - + (i.hundredths / 100.0); - } -#endif /* OS2 */ - DEBUG(1, Sdprintf("OS:done\n")); succeed; @@ -239,11 +219,26 @@ static char errmsg[64]; #endif /*_SC_CLK_TCK*/ #endif /*HAVE_TIMES*/ +#ifdef HAVE_CLOCK_GETTIME +#define timespec_to_double(ts) \ + ((double)(ts).tv_sec + (double)(ts).tv_nsec/(double)1000000000.0) +#endif double CpuTime(cputime_kind which) { -#ifdef HAVE_TIMES +#if defined(HAVE_CLOCK_GETTIME) && defined(CLOCK_PROCESS_CPUTIME_ID) +#define CPU_TIME_DONE + struct timespec ts; + (void)which; + + if ( clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &ts) == 0 ) + return timespec_to_double(ts); + return 0.0; +#endif + +#if !defined(CPU_TIME_DONE) && defined(HAVE_TIMES) +#define CPU_TIME_DONE struct tms t; double used; static int MTOK_got_hz = FALSE; @@ -268,39 +263,17 @@ CpuTime(cputime_kind which) used = 0.0; /* happens when running under GDB */ return used; -#else +#endif -#if OS2 && EMX - DATETIME i; - - DosGetDateTime((PDATETIME)&i); - return (((i.hours * 3600) - + (i.minutes * 60) - + i.seconds - + (i.hundredths / 100.0)) - initial_time); -#else - -#ifdef HAVE_CLOCK - return (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC; -#else +#if !defined(CPU_TIME_DONE) + (void)which; return 0.0; - -#endif -#endif #endif } #endif /*__WINDOWS__*/ -void -PL_clock_wait_ticks(long waited) -{ -#ifdef HAVE_CLOCK - clock_wait_ticks += waited; -#endif -} - double WallTime(void) @@ -310,7 +283,7 @@ WallTime(void) struct timespec tp; clock_gettime(CLOCK_REALTIME, &tp); - stime = (double)tp.tv_sec + (double)tp.tv_nsec/1000000000.0; + stime = timespec_to_double(tp); #else #ifdef HAVE_GETTIMEOFDAY struct timeval tp; @@ -389,7 +362,7 @@ CpuCount() #include int -CpuCount() +CpuCount(void) { int count ; size_t size=sizeof(count) ; @@ -415,7 +388,7 @@ setOSPrologFlags(void) { int cpu_count = CpuCount(); if ( cpu_count > 0 ) - PL_set_prolog_flag("cpu_count", PL_INTEGER|FF_READONLY, cpu_count); + PL_set_prolog_flag("cpu_count", PL_INTEGER, cpu_count); } #endif @@ -436,8 +409,7 @@ UsedMemory(void) } #endif - return (GD->statistics.heap + - usedStack(global) + + return (usedStack(global) + usedStack(local) + usedStack(trail)); } @@ -448,8 +420,7 @@ 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; @@ -470,7 +441,7 @@ FreeMemory(void) some systems (__WINDOWS__) the seed of rand() is thread-local, while on others it is global. We appear to have the choice between - # srand()/rand() + # srand()/rand() Differ in MT handling, often bad distribution # srandom()/random() @@ -522,16 +493,14 @@ _PL_Random(void) } #ifdef HAVE_RANDOM -#if SIZEOF_VOIDP == 4 { uint64_t l = random(); - l ^= (uint64_t)random()<<32; + l ^= (uint64_t)random()<<15; + l ^= (uint64_t)random()<<30; + l ^= (uint64_t)random()<<45; return l; } -#else - return random(); -#endif #else { uint64_t l = rand(); /* 0os._CWDdir) /* current directory */ -#define CWDlen (LD->os._CWDlen) /* strlen(CWDdir) */ - static void initExpand(void) -{ GET_LD +{ #ifdef O_CANONISE_DIRS char *dir; char *cpaths; #endif - CWDdir = NULL; - CWDlen = 0; + GD->paths.CWDdir = NULL; + GD->paths.CWDlen = 0; #ifdef O_CANONISE_DIRS { char envbuf[MAXPATHLEN]; @@ -898,7 +864,15 @@ cleanupExpand(void) canonical_dirlist = NULL; for( ; dn; dn = next ) { next = dn->next; - free(dn); + if ( dn->canonical && dn->canonical != dn->name ) + remove_string(dn->canonical); + remove_string(dn->name); + PL_free(dn); + } + if ( GD->paths.CWDdir ) + { remove_string(GD->paths.CWDdir); + GD->paths.CWDdir = NULL; + GD->paths.CWDlen = 0; } } @@ -925,7 +899,7 @@ registerParentDirs(const char *path) } if ( statfunc(OsPath(dirname, tmp), &buf) == 0 ) - { CanonicalDir dn = malloc(sizeof(*dn)); + { CanonicalDir dn = PL_malloc(sizeof(*dn)); dn->name = store_string(dirname); dn->inode = buf.st_ino; @@ -980,7 +954,7 @@ verify_entry(CanonicalDir d) remove_string(d->name); if ( d->canonical != d->name ) remove_string(d->canonical); - free(d); + PL_free(d); } return FALSE; @@ -1008,12 +982,12 @@ canoniseDir(char *path) } /* we need to use malloc() here */ - /* because allocHeap() only ensures */ + /* because allocHeapOrHalt() only ensures */ /* alignment for `word', and inode_t */ /* is sometimes bigger! */ if ( statfunc(OsPath(path, tmp), &buf) == 0 ) - { CanonicalDir dn = malloc(sizeof(*dn)); + { CanonicalDir dn = PL_malloc(sizeof(*dn)); char dirname[MAXPATHLEN]; char *e = path + strlen(path); @@ -1082,8 +1056,7 @@ cleanupExpand(void) char * canoniseFileName(char *path) { char *out = path, *in = path, *start = path; - char *osave[100]; - int osavep = 0; + tmp_buffer saveb; #ifdef O_HASDRIVES /* C: */ if ( in[1] == ':' && isLetter(in[0]) ) @@ -1092,8 +1065,8 @@ canoniseFileName(char *path) out = start = in; } #ifdef __MINGW32__ /* /c/ in MINGW is the same as c: */ - if ( in[0] == '/' && isLetter(in[1]) && - in[2] == '/' ) + else if ( in[0] == '/' && isLetter(in[1]) && + in[2] == '/' ) { out[0] = in[1]; out[1] = ':'; @@ -1101,13 +1074,13 @@ canoniseFileName(char *path) out = start = in; } #endif - #endif + #ifdef O_HASSHARES /* //host/ */ if ( in[0] == '/' && in[1] == '/' && isAlpha(in[2]) ) { char *s; - for(s = in+3; *s && (isAlpha(*s) || *s == '.'); s++) + for(s = in+3; *s && (isAlpha(*s) || *s == '-' || *s == '.'); s++) ; if ( *s == '/' ) { in = out = s+1; @@ -1122,7 +1095,8 @@ canoniseFileName(char *path) in += 2; if ( in[0] == '/' ) *out++ = '/'; - osave[osavep++] = out; + initBuffer(&saveb); + addBuffer(&saveb, out, char*); while(*in) { if (*in == '/') @@ -1138,15 +1112,15 @@ canoniseFileName(char *path) } if ( in[2] == EOS ) /* delete trailing /. */ { *out = EOS; - return path; + goto out; } if ( in[2] == '.' && (in[3] == '/' || in[3] == EOS) ) - { if ( osavep > 0 ) /* delete /foo/../ */ - { out = osave[--osavep]; + { if ( !isEmptyBuffer(&saveb) ) /* delete /foo/../ */ + { out = popBuffer(&saveb, char*); in += 3; if ( in[0] == EOS && out > start+1 ) { out[-1] = EOS; /* delete trailing / */ - return path; + goto out; } goto again; } else if ( start[0] == '/' && out == start+1 ) @@ -1160,12 +1134,15 @@ canoniseFileName(char *path) in++; if ( out > path && out[-1] != '/' ) *out++ = '/'; - osave[osavep++] = out; + addBuffer(&saveb, out, char*); } else *out++ = *in++; } *out++ = *in++; +out: + discardBuffer(&saveb); + return path; } @@ -1201,15 +1178,18 @@ canonisePath(char *path) #ifdef O_CANONISE_DIRS { char *e; char dirname[MAXPATHLEN]; + size_t plen = strlen(path); - e = path + strlen(path) - 1; - for( ; *e != '/' && e > path; e-- ) - ; - strncpy(dirname, path, e-path); - dirname[e-path] = EOS; - canoniseDir(dirname); - strcat(dirname, e); - strcpy(path, dirname); + if ( plen > 0 ) + { e = path + plen - 1; + for( ; *e != '/' && e > path; e-- ) + ; + strncpy(dirname, path, e-path); + dirname[e-path] = EOS; + canoniseDir(dirname); + strcat(dirname, e); + strcpy(path, dirname); + } } #endif @@ -1238,11 +1218,12 @@ takeWord(const char **string, char *wrd, int maxlen) } -bool +char * expandVars(const char *pattern, char *expanded, int maxlen) { GET_LD int size = 0; char wordbuf[MAXPATHLEN]; + char *rc = expanded; if ( *pattern == '~' ) { char *user; @@ -1305,7 +1286,9 @@ expandVars(const char *pattern, char *expanded, int maxlen) #endif size += (l = (int) strlen(value)); if ( size+1 >= maxlen ) - return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); + { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); + return NULL; + } strcpy(expanded, value); expanded += l; UNLOCK(); @@ -1345,8 +1328,9 @@ expandVars(const char *pattern, char *expanded, int maxlen) size += (l = (int)strlen(value)); if ( size+1 >= maxlen ) { UNLOCK(); - return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, - ATOM_max_path_length); + PL_error(NULL, 0, NULL, ERR_REPRESENTATION, + ATOM_max_path_length); + return NULL; } strcpy(expanded, value); UNLOCK(); @@ -1359,8 +1343,10 @@ expandVars(const char *pattern, char *expanded, int maxlen) def: size++; if ( size+1 >= maxlen ) - return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, - ATOM_max_path_length); + { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, + ATOM_max_path_length); + return NULL; + } *expanded++ = c; continue; @@ -1369,61 +1355,14 @@ expandVars(const char *pattern, char *expanded, int maxlen) } if ( ++size >= maxlen ) - return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, - ATOM_max_path_length); + { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, + ATOM_max_path_length); + return NULL; + } + *expanded = EOS; - succeed; -} - - -static int -ExpandFile(const char *pattern, char **vector) -{ char expanded[MAXPATHLEN]; - int matches = 0; - - if ( !expandVars(pattern, expanded, sizeof(expanded)) ) - return -1; - - vector[matches++] = store_string(expanded); - - return matches; -} - - -char * -ExpandOneFile(const char *spec, char *file) -{ GET_LD - char *vector[256]; - int size; - - switch( (size=ExpandFile(spec, vector)) ) - { case -1: - return NULL; - case 0: - { term_t tmp = PL_new_term_ref(); - - PL_put_atom_chars(tmp, spec); - PL_error(NULL, 0, "no match", ERR_EXISTENCE, ATOM_file, tmp); - - return NULL; - } - case 1: - strcpy(file, vector[0]); - remove_string(vector[0]); - return file; - default: - { term_t tmp = PL_new_term_ref(); - int n; - - for(n=0; n= MAXPATHLEN ) + if ( (GD->paths.CWDlen + strlen(file) + 1) >= MAXPATHLEN ) { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); return (char *) NULL; } - strcpy(path, CWDdir); + strcpy(path, GD->paths.CWDdir); if ( file[0] != EOS ) - strcpy(&path[CWDlen], file); + strcpy(&path[GD->paths.CWDlen], file); if ( strchr(file, '.') || strchr(file, '/') ) return canonisePath(path); else @@ -1550,20 +1489,20 @@ AbsoluteFile(const char *spec, char *path) void PL_changed_cwd(void) -{ GET_LD - - if ( CWDdir ) - remove_string(CWDdir); - CWDdir = NULL; - CWDlen = 0; +{ LOCK(); + if ( GD->paths.CWDdir ) + remove_string(GD->paths.CWDdir); + GD->paths.CWDdir = NULL; + GD->paths.CWDlen = 0; + UNLOCK(); } -const char * -PL_cwd(void) +static char * +cwd_unlocked(char *cwd, size_t cwdlen) { GET_LD - if ( CWDlen == 0 ) + if ( GD->paths.CWDlen == 0 ) { char buf[MAXPATHLEN]; char *rval; @@ -1593,16 +1532,34 @@ to be implemented directly. What about other Unixes? } canonisePath(buf); - CWDlen = strlen(buf); - buf[CWDlen++] = '/'; - buf[CWDlen] = EOS; + GD->paths.CWDlen = strlen(buf); + buf[GD->paths.CWDlen++] = '/'; + buf[GD->paths.CWDlen] = EOS; - if ( CWDdir ) - remove_string(CWDdir); - CWDdir = store_string(buf); + if ( GD->paths.CWDdir ) + remove_string(GD->paths.CWDdir); + GD->paths.CWDdir = store_string(buf); } - return (const char *)CWDdir; + if ( GD->paths.CWDlen < cwdlen ) + { memcpy(cwd, GD->paths.CWDdir, GD->paths.CWDlen+1); + return cwd; + } else + { PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); + return NULL; + } +} + + +char * +PL_cwd(char *cwd, size_t cwdlen) +{ char *rc; + + LOCK(); + rc = cwd_unlocked(cwd, cwdlen); + UNLOCK(); + + return rc; } @@ -1652,14 +1609,13 @@ DirName(const char *f, char *dir) bool ChDir(const char *path) -{ GET_LD - char ospath[MAXPATHLEN]; +{ char ospath[MAXPATHLEN]; char tmp[MAXPATHLEN]; OsPath(path, ospath); if ( path[0] == EOS || streq(path, ".") || - (CWDdir && streq(path, CWDdir)) ) + (GD->paths.CWDdir && streq(path, GD->paths.CWDdir)) ) succeed; AbsoluteFile(path, tmp); @@ -1672,10 +1628,12 @@ ChDir(const char *path) { tmp[len++] = '/'; tmp[len] = EOS; } - CWDlen = len; - if ( CWDdir ) - remove_string(CWDdir); - CWDdir = store_string(tmp); + LOCK(); /* Lock with PL_changed_cwd() */ + GD->paths.CWDlen = len; /* and PL_cwd() */ + if ( GD->paths.CWDdir ) + remove_string(GD->paths.CWDdir); + GD->paths.CWDdir = store_string(tmp); + UNLOCK(); succeed; } @@ -1689,7 +1647,7 @@ ChDir(const char *path) *********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - struct tm *LocalTime(time_t time, struct tm *r) + struct tm *PL_localtime_r(time_t time, struct tm *r) Convert time in Unix internal form (seconds since Jan 1 1970) into a structure providing easier access to the time. @@ -1713,17 +1671,52 @@ ChDir(const char *path) time_t Time() Return time in seconds after Jan 1 1970 (Unix' time notion). + +Note: MinGW has localtime_r(), but it is not locked and thus not +thread-safe. MinGW does not have localtime_s(), but we test for it in +configure. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ struct tm * -LocalTime(long *t, struct tm *r) +PL_localtime_r(const time_t *t, struct tm *r) { -#if defined(_REENTRANT) && defined(HAVE_LOCALTIME_R) +#ifdef HAVE_LOCALTIME_R return localtime_r(t, r); #else - *r = *localtime((const time_t *) t); +#ifdef HAVE_LOCALTIME_S + return localtime_s(r, t) == EINVAL ? NULL : t; +#else + struct tm *rc; + + LOCK(); + if ( (rc = localtime(t)) ) + *r = *rc; + else + r = NULL; + UNLOCK(); + return r; #endif +#endif +} + +char * +PL_asctime_r(const struct tm *tm, char *buf) +{ +#ifdef HAVE_ASCTIME_R + return asctime_r(tm, buf); +#else + char *rc; + + LOCK(); + if ( (rc = asctime(tm)) ) + strcpy(buf, rc); + else + buf = NULL; + UNLOCK(); + + return buf; +#endif } @@ -1857,7 +1850,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode) if ( !truePrologFlag(PLFLAG_TTY_CONTROL) ) succeed; - buf->state = allocHeap(sizeof(tty_state)); + buf->state = allocHeapOrHalt(sizeof(tty_state)); #ifdef HAVE_TCSETATTR if ( tcgetattr(fd, &TTY_STATE(buf)) ) /* save the old one */ @@ -1915,9 +1908,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode) bool PopTty(IOSTREAM *s, ttybuf *buf, int do_free) -{ GET_LD - - ttymode = buf->mode; +{ ttymode = buf->mode; if ( buf->state ) { int fd = Sfileno(s); @@ -1963,7 +1954,7 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode) if ( !truePrologFlag(PLFLAG_TTY_CONTROL) ) succeed; - buf->state = allocHeap(sizeof(tty_state)); + buf->state = allocHeapOrHalt(sizeof(tty_state)); if ( ioctl(fd, TIOCGETP, &TTY_STATE(buf)) ) /* save the old one */ fail; @@ -2178,7 +2169,7 @@ growEnviron(char **e, int amount) for(e1=e, filled=0; *e1; e1++, filled++) ; size = ROUND(filled+10+amount, 32); - env = (char **)malloc(size * sizeof(char *)); + env = (char **)PL_malloc(size * sizeof(char *)); for ( e1=e, e2=env; *e1; *e2++ = *e1++ ) ; *e2 = (char *) NULL; @@ -2192,7 +2183,7 @@ growEnviron(char **e, int amount) { char **env, **e1, **e2; size += 32; - env = (char **)realloc(e, size * sizeof(char *)); + env = (char **)PL_realloc(e, size * sizeof(char *)); for ( e1=e, e2=env; *e1; *e2++ = *e1++ ) ; *e2 = (char *) NULL; @@ -2224,9 +2215,9 @@ matchName(const char *e, const char *name) static void setEntry(char **e, char *name, char *value) -{ int l = (int)strlen(name); +{ size_t l = strlen(name); - *e = (char *) malloc(l + strlen(value) + 2); + *e = PL_malloc_atomic(l + strlen(value) + 2); strcpy(*e, name); e[0][l++] = '='; strcpy(&e[0][l], value); @@ -2292,7 +2283,7 @@ Unsetenv(char *name) an alternative. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#if defined(__unix__) +#ifdef __unix__ #define SPECIFIC_SYSTEM 1 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -2465,30 +2456,15 @@ char *command; #endif -/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -[candidate] - -exec(+Cmd, [+In, +Out, +Error], -Pid) - -The streams may be one of standard stream, std, null stream, null, or -pipe(S), where S is a pipe stream - -Detach if none is std! - -TBD: Sort out status. The above is SICStus 3. YAP uses `Status' for last -argument (strange). SICStus 4 appears to drop this altogether. -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - char *Symbols(char *buf) + char *findExecutable(char *buf) Return the path name of the executable of SWI-Prolog. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifndef __WINDOWS__ /* Win32 version in pl-nt.c */ +static char * Which(const char *program, char *fullname); char * findExecutable(const char *av0, char *buffer) @@ -2500,7 +2476,7 @@ findExecutable(const char *av0, char *buffer) return NULL; file = Which(buf, tmp); -#if __unix__ /* argv[0] can be an #! script! */ +#if __unix__ /* argv[0] can be an #! script! */ if ( file ) { int n, fd; char buf[MAXPATHLEN]; @@ -2532,14 +2508,8 @@ findExecutable(const char *av0, char *buffer) return strcpy(buffer, file ? file : buf); } -#endif /*__WINDOWS__*/ - -#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__) -#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL } -#define PATHSEP ';' -#else -/* not Windows, must be a Linux-like thingy */ +#ifdef __unix__ static char * okToExec(const char *s) { statstruct stbuff; @@ -2552,6 +2522,11 @@ okToExec(const char *s) return (char *) NULL; } #define PATHSEP ':' +#endif /* __unix__ */ + +#if defined(OS2) || defined(__DOS__) || defined(__WINDOWS__) +#define EXEC_EXTENSIONS { ".exe", ".com", ".bat", ".cmd", NULL } +#define PATHSEP ';' #endif #ifdef EXEC_EXTENSIONS @@ -2636,6 +2611,7 @@ Which(const char *program, char *fullname) return NULL; } +#endif /*__WINDOWS__*/ /** int Pause(double time) diff --git a/os/pl-rl.c b/os/pl-rl.c index 5dc27d836..bb5233c43 100755 --- a/os/pl-rl.c +++ b/os/pl-rl.c @@ -19,7 +19,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -40,7 +40,7 @@ SWI-Prolog.h and SWI-Stream.h #include "SWI-Stream.h" #include "SWI-Prolog.h" -#if defined(__WINDOWS__) && !defined(__YAP_PROLOG__) +#ifdef __WINDOWS__ #ifdef WIN64 #include "config/win64.h" #else @@ -102,7 +102,6 @@ extern void add_history(char *); /* should be in readline.h */ extern int rl_begin_undo_group(void); /* delete when conflict arrises! */ extern int rl_end_undo_group(void); extern Function *rl_event_hook; - #ifndef HAVE_RL_FILENAME_COMPLETION_FUNCTION #define rl_filename_completion_function filename_completion_function extern char *filename_completion_function(const char *, int); @@ -368,7 +367,6 @@ input_on_fd(int fd) return select(fd+1, &rfds, NULL, NULL, &tv) != 0; } - static int event_hook(void) { if ( Sinput->position ) @@ -487,9 +485,8 @@ Sread_readline(void *handle, char *buf, size_t size) rl_prep_terminal(FALSE); rl_readline_state = state; rl_done = 0; - } else { + } else line = pl_readline(prompt); - } in_readline--; if ( my_prompt ) @@ -515,31 +512,26 @@ Sread_readline(void *handle, char *buf, size_t size) } } -#ifdef HAVE_CLOCK - PL_clock_wait_ticks(clock() - oldclock); -#endif - return rval; } static int prolog_complete(int ignore, int key) -{ - if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' ) - { rl_begin_undo_group(); - rl_complete(ignore, key); - if ( rl_point > 0 && rl_line_buffer[rl_point-1] == ' ' ) - { +{ if ( rl_point > 0 && rl_line_buffer[rl_point-1] != ' ' ) + { rl_begin_undo_group(); + rl_complete(ignore, key); + if ( rl_point > 0 && rl_line_buffer[rl_point-1] == ' ' ) + { #ifdef HAVE_RL_INSERT_CLOSE /* actually version >= 1.2 */ - rl_delete_text(rl_point-1, rl_point); - rl_point -= 1; + rl_delete_text(rl_point-1, rl_point); + rl_point -= 1; #else - rl_delete(-1, key); + rl_delete(-1, key); #endif - } - rl_end_undo_group(); - } else + } + rl_end_undo_group(); + } else rl_complete(ignore, key); return 0; @@ -551,7 +543,12 @@ atom_generator(const char *prefix, int state) { char *s = PL_atom_generator(prefix, state); if ( s ) - return strcpy(PL_malloc(1 + strlen(s)), s); + { char *copy = malloc(1 + strlen(s)); + + if ( copy ) /* else pretend no completion */ + strcpy(copy, s); + s = copy; + } return s; } @@ -574,20 +571,26 @@ prolog_completion(const char *text, int start, int end) #undef read /* UXNT redefinition */ +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +For some obscure reasons, notably libreadline 6 can show very bad +interactive behaviour. There is a timeout set to 100000 (0.1 sec). It +isn't particularly clear what this timeout is doing. I _think_ it should +be synchronized PL_dispatch_hook(), and set to 0 if this hook is +non-null. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + install_t PL_install_readline(void) { GET_LD - bool old; + access_level_t alevel; #ifndef __WINDOWS__ if ( !truePrologFlag(PLFLAG_TTY_CONTROL) || !isatty(0) ) return; #endif - old = systemMode(TRUE); -#if HAVE_DECL_RL_CATCH_SIGNALS + alevel = setAccessLevel(ACCESS_LEVEL_SYSTEM); rl_catch_signals = 0; -#endif rl_readline_name = "Prolog"; rl_attempted_completion_function = prolog_completion; #ifdef __WINDOWS__ @@ -599,6 +602,9 @@ PL_install_readline(void) #if HAVE_RL_INSERT_CLOSE rl_add_defun("insert-close", rl_insert_close, ')'); #endif +#if HAVE_RL_SET_KEYBOARD_INPUT_TIMEOUT /* see (*) */ + rl_set_keyboard_input_timeout(20000); +#endif GD->os.rl_functions = *Sinput->functions; /* structure copy */ GD->os.rl_functions.read = Sread_readline; /* read through readline */ @@ -607,14 +613,17 @@ PL_install_readline(void) Soutput->functions = &GD->os.rl_functions; Serror->functions = &GD->os.rl_functions; - PL_register_foreign("rl_read_init_file", 1, pl_rl_read_init_file, 0); - PL_register_foreign("rl_add_history", 1, pl_rl_add_history, PL_FA_NOTRACE); - PL_register_foreign("rl_write_history", 1, pl_rl_write_history, 0); - PL_register_foreign("rl_read_history", 1, pl_rl_read_history, 0); +#define PRED(name, arity, func, attr) \ + PL_register_foreign_in_module("system", name, arity, func, attr) + + PRED("rl_read_init_file", 1, pl_rl_read_init_file, 0); + PRED("rl_add_history", 1, pl_rl_add_history, PL_FA_NOTRACE); + PRED("rl_write_history", 1, pl_rl_write_history, 0); + PRED("rl_read_history", 1, pl_rl_read_history, 0); PL_set_prolog_flag("readline", PL_BOOL, TRUE); PL_set_prolog_flag("tty_control", PL_BOOL, TRUE); PL_license("gpl", "GNU Readline library"); - systemMode(old); + setAccessLevel(alevel); } #else /*HAVE_LIBREADLINE*/ diff --git a/os/pl-utf8.h b/os/pl-utf8.h index 394585821..233cc8094 100644 --- a/os/pl-utf8.h +++ b/os/pl-utf8.h @@ -19,13 +19,15 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef UTF8_H_INCLUDED #define UTF8_H_INCLUDED +#define PL_MB_LEN_MAX 16 + #define UTF8_MALFORMED_REPLACEMENT 0xfffd #define ISUTF8_MB(c) ((unsigned)(c) >= 0xc0 && (unsigned)(c) <= 0xfd) From abe66214958a5e82978fcffa864b35110d074e88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 16 Jan 2013 11:28:58 +0000 Subject: [PATCH 3/3] SWI update --- C/pl-yap.c | 18 +- H/pl-incl.h | 7 +- os/SWI-Stream.h | 10 +- os/pl-fmt.c | 103 +++++---- os/pl-glob.c | 65 +++--- os/pl-prologflag.c | 206 +++++++++++++----- os/pl-stream.c | 521 +++++++++++++++++++++++++++++---------------- os/pl-string.c | 48 +---- os/pl-string.h | 4 +- os/pl-table.c | 172 +++++++++------ os/pl-utf8.c | 2 +- 11 files changed, 711 insertions(+), 445 deletions(-) diff --git a/C/pl-yap.c b/C/pl-yap.c index a68573bfb..bae92c809 100755 --- a/C/pl-yap.c +++ b/C/pl-yap.c @@ -476,14 +476,11 @@ int raiseStackOverflow(int overflow) * FEATURES * *******************************/ -int PL_set_prolog_flag(const char *name, int type, ...) { va_list args; int rval = TRUE; int flags = (type & FF_MASK); - initPrologFlagTable(); - va_start(args, type); switch(type & ~FF_MASK) { case PL_BOOL: @@ -494,10 +491,8 @@ PL_set_prolog_flag(const char *name, int type, ...) } case PL_ATOM: { const char *v = va_arg(args, const char *); -#ifndef __YAP_PROLOG__ - if ( !GD->initialised ) - initAtoms(); -#endif + // VSC if ( !GD->initialised ) + // VSC initAtoms(); setPrologFlag(name, FT_ATOM|flags, v); break; } @@ -509,13 +504,12 @@ PL_set_prolog_flag(const char *name, int type, ...) default: rval = FALSE; } - va_end(args); + return rval; } - int PL_unify_chars(term_t t, int flags, size_t len, const char *s) { PL_chars_t text; @@ -761,6 +755,12 @@ PL_get_list_nchars(term_t l, size_t *length, char **s, unsigned int flags) fail; } +void * +PL_malloc_uncollectable(size_t sz) +{ + return malloc(sz); +} + int PL_get_list_chars(term_t l, char **s, unsigned flags) { return PL_get_list_nchars(l, NULL, s, flags); diff --git a/H/pl-incl.h b/H/pl-incl.h index 340cf34ab..719aa92cd 100755 --- a/H/pl-incl.h +++ b/H/pl-incl.h @@ -468,9 +468,6 @@ typedef struct #define FT_FROM_VALUE 0x0f /* Determine type from value */ #define FT_MASK 0x0f /* mask to get type */ -#define FF_READONLY 0x10 /* feature is read-only */ -#define FF_KEEP 0x20 /* keep value it already set */ - #define PLFLAG_CHARESCAPE 0x000001 /* handle \ in atoms */ #define PLFLAG_GC 0x000002 /* do GC */ #define PLFLAG_TRACE_GC 0x000004 /* verbose gc */ @@ -540,6 +537,7 @@ typedef enum #define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM) +#define PL_malloc_atomic malloc /* vsc: global variables */ #include "pl-global.h" @@ -702,6 +700,7 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a); extern int _PL_unify_atomic(term_t t, PL_atomic_t a); extern int _PL_unify_string(term_t t, word w); + #define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z) extern IOSTREAM ** /* provide access to Suser_input, */ @@ -911,7 +910,7 @@ COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags, COMMON(bool) systemMode(bool accept); -COMMON(void) initPrologFlagTable(void); +COMMON(void) cleanupPrologFlags(void); COMMON(void) initPrologFlags(void); COMMON(int) raiseStackOverflow(int overflow); diff --git a/os/SWI-Stream.h b/os/SWI-Stream.h index 05f1edd26..82bd49c1d 100755 --- a/os/SWI-Stream.h +++ b/os/SWI-Stream.h @@ -65,6 +65,10 @@ typedef intptr_t ssize_t; /* signed version of size_t */ extern "C" { #endif +#ifndef PL_HAVE_TERM_T +#define PL_HAVE_TERM_T +typedef uintptr_t term_t; +#endif /******************************* * CONSTANTS * *******************************/ @@ -335,14 +339,10 @@ PL_EXPORT(int) Sfpasteof(IOSTREAM *s); PL_EXPORT(int) Sferror(IOSTREAM *s); PL_EXPORT(void) Sclearerr(IOSTREAM *s); PL_EXPORT(void) Sseterr(IOSTREAM *s, int which, const char *message); -#ifdef _FLI_H_INCLUDED PL_EXPORT(void) Sset_exception(IOSTREAM *s, term_t ex); -#else -PL_EXPORT(void) Sset_exception(IOSTREAM *s, intptr_t ex); -#endif PL_EXPORT(int) Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc); PL_EXPORT(int) Sflush(IOSTREAM *s); -PL_EXPORT(long) Ssize(IOSTREAM *s); +PL_EXPORT(int64_t) Ssize(IOSTREAM *s); PL_EXPORT(int) Sseek(IOSTREAM *s, long pos, int whence); PL_EXPORT(long) Stell(IOSTREAM *s); PL_EXPORT(int) Sclose(IOSTREAM *s); diff --git a/os/pl-fmt.c b/os/pl-fmt.c index a4484d040..08c56b5fe 100644 --- a/os/pl-fmt.c +++ b/os/pl-fmt.c @@ -19,7 +19,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -53,9 +53,9 @@ typedef struct struct rubber rub[MAXRUBBER]; } format_state; -#define BUFSIZE 1024 -#define DEFAULT (-1) -#define SHIFT { argc--; argv++; } +#define BUFSIZE 1024 +#define DEFAULT (-1) +#define SHIFT { argc--; argv++; } #define NEED_ARG { if ( argc <= 0 ) \ { FMT_ERROR("not enough arguments"); \ } \ @@ -189,7 +189,8 @@ outtext(format_state *state, PL_chars_t *txt) #define format_predicates (GD->format.predicates) static int update_column(int, Char); -static bool do_format(IOSTREAM *fd, PL_chars_t *fmt, int ac, term_t av); +static bool do_format(IOSTREAM *fd, PL_chars_t *fmt, + int ac, term_t av, Module m); static void distribute_rubber(struct rubber *, int, int); static int emit_rubber(format_state *state); @@ -272,7 +273,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h) static word -format_impl(IOSTREAM *out, term_t format, term_t Args) +format_impl(IOSTREAM *out, term_t format, term_t Args, Module m) { GET_LD term_t argv; int argc = 0; @@ -307,7 +308,7 @@ format_impl(IOSTREAM *out, term_t format, term_t Args) break; } - rval = do_format(out, &fmt, argc, argv); + rval = do_format(out, &fmt, argc, argv, m); PL_free_text(&fmt); if ( !endCritical ) return FALSE; @@ -318,31 +319,20 @@ format_impl(IOSTREAM *out, term_t format, term_t Args) word pl_format3(term_t out, term_t format, term_t args) -{ redir_context ctx; +{ GET_LD + redir_context ctx; word rc; -#if __YAP_PROLOG__ - /* - YAP allows the last argument to format to be of the form - module:[] - */ - YAP_Term mod; -#endif + Module m = NULL; + term_t list = PL_new_term_ref(); - if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) ) { -#if __YAP_PROLOG__ - /* module processing */ - { - args = Yap_fetch_module_for_format(args, &mod); - } -#endif - { if ( (rc = format_impl(ctx.stream, format, args)) ) - rc = closeOutputRedirect(&ctx); - else + if ( !PL_strip_module(args, &m, list) ) + return FALSE; + + if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) ) + { if ( (rc = format_impl(ctx.stream, format, list, m)) ) + rc = closeOutputRedirect(&ctx); + else discardOutputRedirect(&ctx); - } -#if __YAP_PROLOG__ - YAP_SetCurrentModule(mod); -#endif } return rc; @@ -374,7 +364,7 @@ get_chr_from_text(const PL_chars_t *t, int index) ********************************/ static bool -do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) +do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv, Module m) { GET_LD format_state state; /* complete state */ int tab_stop = 0; /* padded tab stop */ @@ -443,7 +433,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) char buf[BUFSIZE]; char *str = buf; size_t bufsize = BUFSIZE; - unsigned int i; + int i; PL_predicate_info(proc, NULL, &arity, NULL); av = PL_new_term_refs(arity); @@ -481,7 +471,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) if ( !PL_get_text(argv, &txt, CVT_ATOMIC) ) FMT_ARG("a", argv); SHIFT; - outtext(&state, &txt); + rc = outtext(&state, &txt); + if ( !rc ) + goto out; here++; break; } @@ -494,7 +486,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) SHIFT; while(times-- > 0) - { outchr(&state, chr); + { rc = outchr(&state, chr); + if ( !rc ) + goto out; } } else FMT_ARG("c", argv); @@ -508,7 +502,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) case 'G': /* shortest of 'f' and 'E' */ { number n; union { - tmp_buffer b; + tmp_buffer b; buffer b1; } u; @@ -525,8 +519,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) initBuffer(&u.b); formatFloat(c, arg, &n, &u.b1); clearNumber(&n); - outstring0(&state, baseBuffer(&u.b, char)); + rc = outstring0(&state, baseBuffer(&u.b, char)); discardBuffer(&u.b); + if ( !rc ) + goto out; here++; break; } @@ -564,8 +560,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) formatNumber(FALSE, 0, arg, c == 'r', &i, (Buffer)&b); } clearNumber(&i); - outstring0(&state, baseBuffer(&b, char)); + rc = outstring0(&state, baseBuffer(&b, char)); discardBuffer(&b); + if ( !rc ) + goto out; here++; break; } @@ -576,8 +574,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) if ( !PL_get_text(argv, &txt, CVT_LIST|CVT_STRING) && !PL_get_text(argv, &txt, CVT_ATOM) ) /* SICStus compat */ FMT_ARG("s", argv); - outtext(&state, &txt); + rc = outtext(&state, &txt); SHIFT; + if ( !rc ) + goto out; here++; break; } @@ -610,8 +610,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) str = buf; tellString(&str, &bufsize, ENC_UTF8); - (*f)(argv); + rc = (*f)(argv); toldString(); + if ( !rc ) + goto out; oututf8(&state, str, bufsize); if ( str != buf ) free(str); @@ -632,8 +634,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) str = buf; tellString(&str, &bufsize, ENC_UTF8); - (*f)(argv); + rc = (*f)(argv); toldString(); + if ( !rc ) + goto out; oututf8(&state, str, bufsize); if ( str != buf ) free(str); @@ -704,7 +708,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) { FMT_ERROR("not enough arguments"); } tellString(&str, &bufsize, ENC_UTF8); - rval = callProlog(NULL, argv, PL_Q_CATCH_EXCEPTION, &ex); + rval = callProlog(m, argv, PL_Q_CATCH_EXCEPTION, &ex); toldString(); oututf8(&state, str, bufsize); if ( str != buf ) @@ -724,7 +728,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) break; } case '~': /* ~ */ - { outchr(&state, '~'); + { rc = outchr(&state, '~'); + if ( !rc ) + goto out; here++; break; } @@ -735,7 +741,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) if ( c == 'N' && state.column == 0 ) arg--; while( arg-- > 0 ) - outchr(&state, '\n'); + { rc = outchr(&state, '\n'); + if ( !rc ) + goto out; + } here++; break; } @@ -790,7 +799,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv) break; /* the '~' switch */ } default: - { outchr(&state, c); + { rc = outchr(&state, c); + if ( !rc ) + goto out; here++; break; } @@ -1032,7 +1043,8 @@ formatFloat(int how, int arg, Number f, Buffer out) while(written >= size) { size = written+1; - growBuffer(out, size); /* reserve for -.e */ + if ( !growBuffer(out, size) ) /* reserve for -.e */ + outOfCore(); written = gmp_snprintf(baseBuffer(out, char), size, tmp, mpf); } mpf_clear(mpf); @@ -1053,7 +1065,8 @@ formatFloat(int how, int arg, Number f, Buffer out) while(written >= size) { size = written+1; - growBuffer(out, size); + if ( !growBuffer(out, size) ) + outOfCore(); written = snprintf(baseBuffer(out, char), size, tmp, f->value.f); } out->top = out->base + written; diff --git a/os/pl-glob.c b/os/pl-glob.c index 1f1107fca..0ea915839 100644 --- a/os/pl-glob.c +++ b/os/pl-glob.c @@ -3,9 +3,10 @@ Part of SWI-Prolog Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl + E-mail: J.Wielemaker@cs.vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam + Copyright (C): 1985-2011, University of Amsterdam + VU University Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -19,7 +20,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "pl-incl.h" @@ -29,9 +30,9 @@ #include #endif -#ifdef __WATCOMC__ -#include -#else /*__WATCOMC__*/ +#ifdef O_XOS +# include "windows/dirent.h" +#else #if HAVE_DIRENT_H # include #else @@ -46,7 +47,7 @@ # include # endif #endif -#endif /*__WATCOMC__*/ +#endif /*O_XOS*/ #ifdef HAVE_SYS_STAT_H #include @@ -326,8 +327,8 @@ PRED_IMPL("wildcard_match", 2, wildcard_match, 0) { char *p, *s; compiled_pattern buf; - if ( !PL_get_chars_ex(A1, &p, CVT_ALL) || - !PL_get_chars_ex(A2, &s, CVT_ALL) ) + if ( !PL_get_chars(A1, &p, CVT_ALL|CVT_EXCEPTION) || + !PL_get_chars(A2, &s, CVT_ALL|CVT_EXCEPTION) ) fail; if ( compilePattern(p, &buf) ) @@ -423,6 +424,7 @@ expand(const char *pattern, GlobInfo info) compiled_pattern cbuf; char prefix[MAXPATHLEN]; /* before first pattern */ char patbuf[MAXPATHLEN]; /* pattern buffer */ + size_t prefix_len; int end, dot; initBuffer(&info->files); @@ -441,20 +443,25 @@ expand(const char *pattern, GlobInfo info) switch( (c=*s++) ) { case EOS: if ( s > pat ) /* something left and expanded */ - { un_escape(prefix, pat, s); + { size_t prefix_len; + + un_escape(prefix, pat, s); + prefix_len = strlen(prefix); end = info->end; for( ; info->start < end; info->start++ ) { char path[MAXPATHLEN]; - size_t plen; + const char *entry = expand_entry(info, info->start); + size_t plen = strlen(entry); - strcpy(path, expand_entry(info, info->start)); - plen = strlen(path); - if ( prefix[0] && plen > 0 && path[plen-1] != '/' ) - path[plen++] = '/'; - strcpy(&path[plen], prefix); - if ( end == 1 || AccessFile(path, ACCESS_EXIST) ) - add_path(path, info); + if ( plen+prefix_len+2 <= MAXPATHLEN ) + { strcpy(path, entry); + if ( prefix[0] && plen > 0 && path[plen-1] != '/' ) + path[plen++] = '/'; + strcpy(&path[plen], prefix); + if ( end == 1 || AccessFile(path, ACCESS_EXIST) ) + add_path(path, info); + } } } succeed; @@ -489,8 +496,9 @@ expand(const char *pattern, GlobInfo info) */ un_escape(prefix, pat, head); un_escape(patbuf, head, tail); + prefix_len = strlen(prefix); - if ( !compilePattern(patbuf, &cbuf) ) /* syntax error */ + if ( !compilePattern(patbuf, &cbuf) ) /* syntax error */ fail; dot = (patbuf[0] == '.'); /* do dots as well */ @@ -502,6 +510,10 @@ expand(const char *pattern, GlobInfo info) char path[MAXPATHLEN]; char tmp[MAXPATHLEN]; const char *current = expand_entry(info, info->start); + size_t clen = strlen(current); + + if ( clen+prefix_len+1 > sizeof(path) ) + continue; strcpy(path, current); strcat(path, prefix); @@ -521,12 +533,11 @@ expand(const char *pattern, GlobInfo info) matchPattern(e->d_name, &cbuf) ) { char newp[MAXPATHLEN]; - strcpy(newp, path); - strcpy(&newp[plen], e->d_name); -/* if ( !tail[0] || ExistsDirectory(newp) ) - Saves memory, but involves one more file-access -*/ + if ( plen+strlen(e->d_name)+1 < sizeof(newp) ) + { strcpy(newp, path); + strcpy(&newp[plen], e->d_name); add_path(newp, info); + } } } closedir(d); @@ -579,11 +590,11 @@ PRED_IMPL("expand_file_name", 2, expand_file_name, 0) term_t head = PL_new_term_ref(); int i; - if ( !PL_get_chars_ex(A1, &s, CVT_ALL|REP_FN) ) + if ( !PL_get_chars(A1, &s, CVT_ALL|REP_FN|CVT_EXCEPTION) ) fail; if ( strlen(s) > sizeof(spec)-1 ) - return PL_error(NULL, 0, "File name too intptr_t", - ERR_DOMAIN, ATOM_pattern, A1); + return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, + ATOM_max_path_length); if ( !expandVars(s, spec, sizeof(spec)) ) fail; diff --git a/os/pl-prologflag.c b/os/pl-prologflag.c index 753af0365..d45a9ca3b 100644 --- a/os/pl-prologflag.c +++ b/os/pl-prologflag.c @@ -1,11 +1,10 @@ -/* $Id$ - - Part of SWI-Prolog +/* Part of SWI-Prolog Author: Jan Wielemaker - E-mail: J.wielemaker@uva.nl + E-mail: J.wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2008, University of Amsterdam + Copyright (C): 1985-2012, University of Amsterdam + VU University Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -19,7 +18,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /*#define O_DEBUG 1*/ @@ -80,6 +79,8 @@ static void setTZPrologFlag(void); static void setVersionPrologFlag(void); #endif static atom_t lookupAtomFlag(atom_t key); +static void initPrologFlagTable(void); + typedef struct _prolog_flag { short flags; /* Type | Flags */ @@ -138,7 +139,7 @@ setPrologFlag(const char *name, int flags, ...) if ( flags & FF_KEEP ) return; } else - { f = allocHeap(sizeof(*f)); + { f = allocHeapOrHalt(sizeof(*f)); f->index = -1; f->flags = flags; addHTable(GD->prolog_flag.table, (void *)an, f); @@ -155,7 +156,8 @@ setPrologFlag(const char *name, int flags, ...) val = (f->value.a == ATOM_true); } else if ( !s ) /* 1st definition */ { f->index = indexOfBoolMask(mask); - DEBUG(2, Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask)); + DEBUG(MSG_PROLOG_FLAG, + Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask)); } f->value.a = (val ? ATOM_true : ATOM_false); @@ -211,12 +213,20 @@ setPrologFlag(const char *name, int flags, ...) } +static void +freePrologFlag(prolog_flag *f) +{ if ( (f->flags & FT_MASK) == FT_TERM ) + PL_erase(f->value.t); + + freeHeap(f, sizeof(*f)); +} + + #ifdef O_PLMT static void copySymbolPrologFlagTable(Symbol s) -{ GET_LD - prolog_flag *f = s->value; - prolog_flag *copy = allocHeap(sizeof(*copy)); +{ prolog_flag *f = s->value; + prolog_flag *copy = allocHeapOrHalt(sizeof(*copy)); *copy = *f; if ( (f->flags & FT_MASK) == FT_TERM ) @@ -227,13 +237,7 @@ copySymbolPrologFlagTable(Symbol s) static void freeSymbolPrologFlagTable(Symbol s) -{ GET_LD - prolog_flag *f = s->value; - - if ( (f->flags & FT_MASK) == FT_TERM ) - PL_erase(f->value.t); - - freeHeap(f, sizeof(*f)); +{ freePrologFlag(s->value); } #endif @@ -267,25 +271,34 @@ setDoubleQuotes(atom_t a, unsigned int *flagp) static int -setUnknown(atom_t a, unsigned int *flagp) -{ unsigned int flags; +setUnknown(term_t value, atom_t a, Module m) +{ unsigned int flags = m->flags & ~(UNKNOWN_MASK); if ( a == ATOM_error ) - flags = UNKNOWN_ERROR; + flags |= UNKNOWN_ERROR; else if ( a == ATOM_warning ) - flags = UNKNOWN_WARNING; + flags |= UNKNOWN_WARNING; else if ( a == ATOM_fail ) - flags = UNKNOWN_FAIL; + flags |= UNKNOWN_FAIL; else - { GET_LD - term_t value = PL_new_term_ref(); - - PL_put_atom(value, a); return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value); + + if ( !(flags&UNKNOWN_ERROR) && (m == MODULE_user || m == MODULE_system) ) + { GET_LD + + if ( m == MODULE_system && !SYSTEM_MODE ) + { term_t key = PL_new_term_ref(); + + PL_put_atom(key, ATOM_unknown); + return PL_error(NULL, 0, NULL, ERR_PERMISSION, + ATOM_modify, ATOM_flag, key); + } + + if ( !SYSTEM_MODE ) + printMessage(ATOM_warning, PL_CHARS, "unknown_in_module_user"); } - *flagp &= ~(UNKNOWN_MASK); - *flagp |= flags; + m->flags = flags; succeed; } @@ -308,6 +321,21 @@ setWriteAttributes(atom_t a) } +static int +setAccessLevelFromAtom(atom_t a) +{ GET_LD + + if ( getAccessLevelMask(a, &LD->prolog_flag.access_level) ) + { succeed; + } else + { term_t value = PL_new_term_ref(); + + PL_put_atom(value, a); + return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_access_level, value); + } +} + + static int getOccursCheckMask(atom_t a, occurs_check_t *val) { if ( a == ATOM_false ) @@ -357,6 +385,30 @@ setEncoding(atom_t a) } +static int +setStreamTypeCheck(atom_t a) +{ GET_LD + st_check check; + + if ( a == ATOM_false ) + check = ST_FALSE; + else if ( a == ATOM_loose ) + check = ST_LOOSE; + else if ( a == ATOM_true ) + check = ST_TRUE; + else + { term_t value = PL_new_term_ref(); + + PL_put_atom(value, a); + return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_type_check, value); + } + + LD->IO.stream_type_check = check; + return TRUE; +} + + + static word set_prolog_flag_unlocked(term_t key, term_t value, int flags) { GET_LD @@ -385,7 +437,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) #ifdef O_PLMT if ( GD->statistics.threads_created > 1 ) - { prolog_flag *f2 = allocHeap(sizeof(*f2)); + { prolog_flag *f2 = allocHeapOrHalt(sizeof(*f2)); *f2 = *f; if ( (f2->flags & FT_MASK) == FT_TERM ) @@ -399,7 +451,8 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) } addHTable(LD->prolog_flag.table, (void *)k, f2); - DEBUG(1, Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k))); + DEBUG(MSG_PROLOG_FLAG, + Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k))); f = f2; } #endif @@ -411,7 +464,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) anyway: PL_register_atom(k); - f = allocHeap(sizeof(*f)); + f = allocHeapOrHalt(sizeof(*f)); f->index = -1; switch( (flags & FT_MASK) ) @@ -437,8 +490,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) goto wrong_type; } if ( !(f->value.t = PL_record(value)) ) - goto wrong_type; - f->value.t = PL_record(value); + { freeHeap(f, sizeof(*f)); + return FALSE; + } } break; } @@ -483,7 +537,10 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) if ( (flags & FF_READONLY) ) f->flags |= FF_READONLY; - addHTable(GD->prolog_flag.table, (void *)k, f); + if ( !addHTable(GD->prolog_flag.table, (void *)k, f) ) + { freePrologFlag(f); + Sdprintf("OOPS; failed to set Prolog flag!?\n"); + } succeed; } else @@ -516,9 +573,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) #ifndef __YAP_PROLOG__ if ( k == ATOM_character_escapes ) { if ( val ) - set(m, CHARESCAPE); + set(m, M_CHARESCAPE); else - clear(m, CHARESCAPE); + clear(m, M_CHARESCAPE); } else if ( k == ATOM_debug ) { if ( val ) { debugmode(DBG_ALL, NULL); @@ -551,15 +608,19 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags) if ( k == ATOM_double_quotes ) { rval = setDoubleQuotes(a, &m->flags); } else if ( k == ATOM_unknown ) - { rval = setUnknown(a, &m->flags); + { rval = setUnknown(value, a, m); } else if ( k == ATOM_write_attributes ) { rval = setWriteAttributes(a); } else if ( k == ATOM_occurs_check ) { rval = setOccursCheck(a); - } else + } else if ( k == ATOM_access_level ) + { rval = setAccessLevelFromAtom(a); + } else #endif if ( k == ATOM_encoding ) { rval = setEncoding(a); + } else if ( k == ATOM_stream_type_check ) + { rval = setStreamTypeCheck(a); } if ( !rval ) fail; @@ -705,7 +766,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val) #ifndef __YAP_PROLOG__ if ( key == ATOM_character_escapes ) - { atom_t v = (true(m, CHARESCAPE) ? ATOM_true : ATOM_false); + { atom_t v = (true(m, M_CHARESCAPE) ? ATOM_true : ATOM_false); return PL_unify_atom(val, v); } else if ( key == ATOM_double_quotes ) @@ -736,6 +797,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val) break; default: assert(0); + return FALSE; } return PL_unify_atom(val, v); @@ -747,6 +809,14 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val) { return PL_unify_bool_ex(val, debugstatus.debugging); } else if ( key == ATOM_debugger_show_context ) { return PL_unify_bool_ex(val, debugstatus.showContext); + } else if ( key == ATOM_break_level ) + { int bl = currentBreakLevel(); + + if ( bl >= 0 ) + return PL_unify_integer(val, bl); + return FALSE; + } else if ( key == ATOM_access_level ) + { return PL_unify_atom(val, accessLevel()); } #endif /* YAP_PROLOG */ @@ -861,7 +931,7 @@ pl_prolog_flag5(term_t key, term_t value, fail; } else if ( PL_is_variable(key) ) - { e = allocHeap(sizeof(*e)); + { e = allocHeapOrHalt(sizeof(*e)); e->module = module; @@ -965,7 +1035,7 @@ pl_prolog_flag(term_t name, term_t value, control_t h) #define SO_PATH "LD_LIBRARY_PATH" #endif -void +static void initPrologFlagTable(void) { if ( !GD->prolog_flag.table ) { @@ -973,7 +1043,7 @@ initPrologFlagTable(void) initPrologThreads(); /* may be called before PL_initialise() */ #endif - GD->prolog_flag.table = newHTable(32); + GD->prolog_flag.table = newHTable(64); } } @@ -983,7 +1053,7 @@ initPrologFlags(void) { GET_LD #ifndef __YAP_PROLOG__ setPrologFlag("iso", FT_BOOL, FALSE, PLFLAG_ISO); - setPrologFlag("arch", FT_ATOM|FF_READONLY, ARCH); + setPrologFlag("arch", FT_ATOM|FF_READONLY, PLARCH); #if __WINDOWS__ setPrologFlag("windows", FT_BOOL|FF_READONLY, TRUE, 0); #endif @@ -996,12 +1066,17 @@ initPrologFlags(void) #if defined(HAVE_GETPID) || defined(EMULATE_GETPID) setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid()); #endif + setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE); setPrologFlag("generate_debug_info", FT_BOOL, - truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO); + truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO); setPrologFlag("last_call_optimisation", FT_BOOL, TRUE, PLFLAG_LASTCALL); - setPrologFlag("c_libs", FT_ATOM|FF_READONLY, C_LIBS); - setPrologFlag("c_cc", FT_ATOM|FF_READONLY, C_CC); - setPrologFlag("c_ldflags", FT_ATOM|FF_READONLY, C_LDFLAGS); + setPrologFlag("warn_override_implicit_import", FT_BOOL, TRUE, + PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT); + setPrologFlag("c_cc", FT_ATOM, C_CC); + setPrologFlag("c_libs", FT_ATOM, C_LIBS); + setPrologFlag("c_libplso", FT_ATOM, C_LIBPLSO); + setPrologFlag("c_ldflags", FT_ATOM, C_LDFLAGS); + setPrologFlag("c_cflags", FT_ATOM, C_CFLAGS); #if defined(O_LARGEFILES) || SIZEOF_LONG == 8 setPrologFlag("large_files", FT_BOOL|FF_READONLY, TRUE, 0); #endif @@ -1041,6 +1116,7 @@ initPrologFlags(void) setPrologFlag("debug_on_error", FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR); setPrologFlag("report_error", FT_BOOL, TRUE, PLFLAG_REPORT_ERROR); #endif + setPrologFlag("break_level", FT_INTEGER|FF_READONLY, 0, 0); setPrologFlag("user_flags", FT_ATOM, "silent"); setPrologFlag("editor", FT_ATOM, "default"); setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0); @@ -1065,28 +1141,39 @@ initPrologFlags(void) setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero"); setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded"); setPrologFlag("answer_format", FT_ATOM, "~p"); + setPrologFlag("colon_sets_calling_context", FT_BOOL, TRUE, 0); setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE); setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION); setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING); setPrologFlag("write_attributes", FT_ATOM, "ignore"); + setPrologFlag("stream_type_check", FT_ATOM, "loose"); setPrologFlag("occurs_check", FT_ATOM, "false"); + setPrologFlag("access_level", FT_ATOM, "user"); setPrologFlag("double_quotes", FT_ATOM, "codes"); setPrologFlag("unknown", FT_ATOM, "error"); setPrologFlag("debug", FT_BOOL, FALSE, 0); setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal"); - setPrologFlag("verbose_load", FT_BOOL, TRUE, 0); + setPrologFlag("verbose_load", FT_ATOM, "normal"); setPrologFlag("verbose_autoload", FT_BOOL, FALSE, 0); setPrologFlag("verbose_file_search", FT_BOOL, FALSE, 0); setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE, ALLOW_VARNAME_FUNCTOR); setPrologFlag("toplevel_var_size", FT_INTEGER, 1000); setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0); + setPrologFlag("toplevel_prompt", FT_ATOM, "~m~d~l~! ?- "); + setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS); + setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS); #ifdef __unix__ setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0); #endif + setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding))); + + setPrologFlag("tty_control", FT_BOOL, + truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL); setPrologFlag("signals", FT_BOOL|FF_READONLY, - truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS); + truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS); + setPrologFlag("readline", FT_BOOL/*|FF_READONLY*/, FALSE, 0); #if defined(__WINDOWS__) && defined(_DEBUG) setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug"); @@ -1124,7 +1211,7 @@ initPrologFlags(void) #ifndef __YAP_PROLOG__ static void -setArgvPrologFlag() +setArgvPrologFlag(void) { GET_LD fid_t fid = PL_open_foreign_frame(); term_t e = PL_new_term_ref(); @@ -1148,7 +1235,7 @@ setArgvPrologFlag() #endif static void -setTZPrologFlag() +setTZPrologFlag(void) { tzset(); setPrologFlag("timezone", FT_INTEGER|FF_READONLY, timezone); @@ -1166,7 +1253,7 @@ setVersionPrologFlag(void) int patch = (PLVERSION%100); if ( !PL_unify_term(t, - PL_FUNCTOR_CHARS, "swi", 4, + PL_FUNCTOR_CHARS, PLNAME, 4, PL_INT, major, PL_INT, minor, PL_INT, patch, @@ -1179,6 +1266,19 @@ setVersionPrologFlag(void) setGITVersion(); } #endif /* YAP_PROLOG */ + +void +cleanupPrologFlags(void) +{ if ( GD->prolog_flag.table ) + { Table t = GD->prolog_flag.table; + + GD->prolog_flag.table = NULL; + t->free_symbol = freeSymbolPrologFlagTable; + destroyHTable(t); + } +} + + /******************************* * PUBLISH PREDICATES * *******************************/ diff --git a/os/pl-stream.c b/os/pl-stream.c index 4ef6e148b..028358d1e 100644 --- a/os/pl-stream.c +++ b/os/pl-stream.c @@ -1,11 +1,10 @@ -/* $Id$ - - Part of SWI-Prolog +/* Part of SWI-Prolog Author: Jan Wielemaker - E-mail: J.Wielemaker@uva.nl + E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2009, University of Amsterdam + Copyright (C): 1985-2012, University of Amsterdam + VU University Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -19,21 +18,21 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#if defined(__WINDOWS__)||defined(__WIN32) -#include -#ifndef _YAP_NOT_INSTALLED_ +#ifdef __WINDOWS__ +#include "windows/uxnt.h" #ifdef WIN64 -#define MD "config/win64.h" +#include "config/win64.h" #else -#define MD "config/win32.h" -#endif +#include "config/win32.h" #endif #include #include "windows/mswchar.h" #define CRLF_MAPPING 1 +#else +#include #endif /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -48,12 +47,6 @@ recursive locks. If a stream handle might be known to another thread locking is required. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#ifdef MD -#include MD -#else -#include -#endif - #if _FILE_OFFSET_BITS == 64 || defined(_LARGE_FILES) #define O_LARGEFILES 1 /* use for conditional code in Prolog */ #else @@ -62,8 +55,9 @@ locking is required. #define PL_KERNEL 1 #include -typedef wchar_t pl_wchar_t; +#define NEEDS_SWINSOCK #include "SWI-Stream.h" +#include "SWI-Prolog.h" #include "pl-utf8.h" #include #ifdef HAVE_SYS_TIME_H @@ -104,7 +98,7 @@ typedef wchar_t pl_wchar_t; #endif #define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1))) -#define UNDO_SIZE ROUND(MB_LEN_MAX, sizeof(wchar_t)) +#define UNDO_SIZE ROUND(PL_MB_LEN_MAX, sizeof(wchar_t)) #ifndef FALSE #define FALSE 0 @@ -127,7 +121,7 @@ static int S__seterror(IOSTREAM *s); #ifdef O_PLMT #define SLOCK(s) if ( s->mutex ) recursiveMutexLock(s->mutex) #define SUNLOCK(s) if ( s->mutex ) recursiveMutexUnlock(s->mutex) -static inline int +inline int STRYLOCK(IOSTREAM *s) { if ( s->mutex && recursiveMutexTryLock(s->mutex) == EBUSY ) @@ -141,13 +135,9 @@ STRYLOCK(IOSTREAM *s) #define STRYLOCK(s) (TRUE) #endif -typedef void *record_t; -typedef void *Module; -typedef intptr_t term_t; -typedef intptr_t atom_t; #include "pl-error.h" -extern int fatalError(const char *fm, ...); +extern int fatalError(const char *fm, ...); extern int PL_handle_signals(void); extern IOENC initEncoding(void); extern int reportStreamError(IOSTREAM *s); @@ -368,6 +358,69 @@ Sunlock(IOSTREAM *s) } + /******************************* + * TIMEOUT * + *******************************/ + +#ifdef HAVE_SELECT + +#ifndef __WINDOWS__ +typedef int SOCKET; +#define INVALID_SOCKET -1 +#define Swinsock(s) Sfileno(s) +#define NFDS(n) (n+1) +#else +#define NFDS(n) (0) /* 1st arg of select is ignored */ +#endif + + +static int +S__wait(IOSTREAM *s) +{ SOCKET fd = Swinsock(s); + fd_set wait; + struct timeval time; + int rc; + + if ( fd == INVALID_SOCKET ) + { errno = EPERM; /* no permission to select */ + s->flags |= SIO_FERR; + return -1; + } + + time.tv_sec = s->timeout / 1000; + time.tv_usec = (s->timeout % 1000) * 1000; + FD_ZERO(&wait); + FD_SET(fd, &wait); + + for(;;) + { if ( (s->flags & SIO_INPUT) ) + rc = select(NFDS(fd), &wait, NULL, NULL, &time); + else + rc = select(NFDS(fd), NULL, &wait, NULL, &time); + + if ( rc < 0 && errno == EINTR ) + { if ( PL_handle_signals() < 0 ) + { errno = EPLEXCEPTION; + return -1; + } + + continue; + } + + break; + } + + if ( rc == 0 ) + { s->flags |= (SIO_TIMEOUT|SIO_FERR); + return -1; + } + + return 0; /* ok, data available */ +} + +#endif /*HAVE_SELECT*/ + + /******************************* * FLUSH/FILL * *******************************/ @@ -385,7 +438,18 @@ S__flushbuf(IOSTREAM *s) while ( from < to ) { size_t size = (size_t)(to - from); - ssize_t n = (*s->functions->write)(s->handle, from, size); + ssize_t n; + +#ifdef HAVE_SELECT + s->flags &= ~SIO_TIMEOUT; + + if ( s->timeout >= 0 ) + { if ( (rc=S__wait(s)) < 0 ) + goto partial; + } +#endif + + n = (*s->functions->write)(s->handle, from, size); if ( n > 0 ) /* wrote some */ { from += n; @@ -398,6 +462,9 @@ S__flushbuf(IOSTREAM *s) } } +#ifdef HAVE_SELECT +partial: +#endif if ( to == from ) /* full flush */ { rc = s->bufp - s->buffer; s->bufp = s->buffer; @@ -442,52 +509,6 @@ S__flushbufc(int c, IOSTREAM *s) } -static int -Swait_for_data(IOSTREAM *s) -{ int fd = Sfileno(s); - fd_set wait; - struct timeval time; - int rc; - - if ( fd < 0 ) - { errno = EPERM; /* no permission to select */ - s->flags |= SIO_FERR; - return -1; - } - - time.tv_sec = s->timeout / 1000; - time.tv_usec = (s->timeout % 1000) * 1000; - FD_ZERO(&wait); -#ifdef __WINDOWS__ - FD_SET((SOCKET)fd, &wait); -#else - FD_SET(fd, &wait); -#endif - - for(;;) - { rc = select(fd+1, &wait, NULL, NULL, &time); - - if ( rc < 0 && errno == EINTR ) - { if ( PL_handle_signals() < 0 ) - { errno = EPLEXCEPTION; - return -1; - } - - continue; - } - - break; - } - - if ( rc == 0 ) - { s->flags |= (SIO_TIMEOUT|SIO_FERR); - return -1; - } - - return 0; /* ok, data available */ -} - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - S__fillbuf() fills the read-buffer, returning the first character of it. It also realises the SWI-Prolog timeout facility. @@ -497,8 +518,11 @@ int S__fillbuf(IOSTREAM *s) { int c; - if ( s->flags & (SIO_FEOF|SIO_FERR) ) - { s->flags |= SIO_FEOF2; /* reading past eof */ + if ( s->flags & (SIO_FEOF|SIO_FERR) ) /* reading past eof */ + { if ( s->flags & SIO_FEOF2ERR ) + s->flags |= (SIO_FEOF2|SIO_FERR); + else + s->flags |= SIO_FEOF2; return -1; } @@ -508,7 +532,7 @@ S__fillbuf(IOSTREAM *s) if ( s->timeout >= 0 && !s->downstream ) { int rc; - if ( (rc=Swait_for_data(s)) < 0 ) + if ( (rc=S__wait(s)) < 0 ) return rc; } #endif @@ -517,7 +541,8 @@ S__fillbuf(IOSTREAM *s) { char chr; ssize_t n; - if ( (n=(*s->functions->read)(s->handle, &chr, 1)) == 1 ) + n = (*s->functions->read)(s->handle, &chr, 1); + if ( n == 1 ) { c = char_to_int(chr); return c; } else if ( n == 0 ) @@ -548,7 +573,8 @@ S__fillbuf(IOSTREAM *s) len = s->bufsize; } - if ( (n=(*s->functions->read)(s->handle, s->limitp, len)) > 0 ) + n = (*s->functions->read)(s->handle, s->limitp, len); + if ( n > 0 ) { s->limitp += n; c = char_to_int(*s->bufp++); return c; @@ -777,7 +803,7 @@ put_code(int c, IOSTREAM *s) } goto simple; case ENC_ANSI: - { char b[MB_LEN_MAX]; + { char b[PL_MB_LEN_MAX]; size_t n; if ( !s->mbstate ) @@ -863,7 +889,10 @@ Sputcode(int c, IOSTREAM *s) if ( s->tee && s->tee->magic == SIO_MAGIC ) Sputcode(c, s->tee); - if ( c == '\n' && (s->flags&SIO_TEXT) && s->newline == SIO_NL_DOS ) + if ( c == '\n' && + (s->flags&SIO_TEXT) && + s->newline == SIO_NL_DOS && + s->lastc != '\r' ) { if ( put_code('\r', s) < 0 ) return -1; } @@ -886,7 +915,7 @@ Scanrepresent(int c, IOSTREAM *s) return -1; case ENC_ANSI: { mbstate_t state; - char b[MB_LEN_MAX]; + char b[PL_MB_LEN_MAX]; memset(&state, 0, sizeof(state)); if ( wcrtomb(b, (wchar_t)c, &state) != (size_t)-1 ) @@ -1072,14 +1101,15 @@ returns \n, but it returns the same for a single \n. Often, we could keep track of bufp and reset this, but we must deal with the case where we fetch a new buffer. In this case, we must copy the few -remaining bytes to the `unbuffer' area. +remaining bytes to the `unbuffer' area. If SIO_USERBUF is set, we do not +have this spare buffer space. This is used for reading from strings, +which cannot fetch a new buffer anyway. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ int Speekcode(IOSTREAM *s) { int c; char *start; - IOPOS *psave = s->position; size_t safe = (size_t)-1; if ( !s->buffer ) @@ -1094,15 +1124,19 @@ Speekcode(IOSTREAM *s) if ( (s->flags & SIO_FEOF) ) return -1; - if ( s->bufp + UNDO_SIZE > s->limitp ) + if ( s->bufp + UNDO_SIZE > s->limitp && !(s->flags&SIO_USERBUF) ) { safe = s->limitp - s->bufp; memcpy(s->buffer-safe, s->bufp, safe); } start = s->bufp; - s->position = NULL; - c = Sgetcode(s); - s->position = psave; + if ( s->position ) + { IOPOS psave = *s->position; + c = Sgetcode(s); + *s->position = psave; + } else + { c = Sgetcode(s); + } if ( Sferror(s) ) return -1; @@ -1110,7 +1144,7 @@ Speekcode(IOSTREAM *s) if ( s->bufp > start ) { s->bufp = start; - } else + } else if ( c != -1 ) { assert(safe != (size_t)-1); s->bufp = s->buffer-safe; } @@ -1341,10 +1375,6 @@ Sfeof(IOSTREAM *s) return -1; } - if ( s->downstream != NULL && - Sfeof(s->downstream)) - return TRUE; - if ( S__fillbuf(s) == -1 ) return TRUE; @@ -1440,6 +1470,11 @@ Ssetenc(IOSTREAM *s, IOENC enc, IOENC *old) } s->encoding = enc; + if ( enc == ENC_OCTET ) + s->flags &= ~SIO_TEXT; + else + s->flags |= SIO_TEXT; + return 0; } @@ -1490,23 +1525,23 @@ Sunit_size(IOSTREAM *s) Return the size of the underlying data object. Should be optimized; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -long +int64_t Ssize(IOSTREAM *s) { if ( s->functions->control ) - { long size; + { int64_t size; if ( (*s->functions->control)(s->handle, SIO_GETSIZE, (void *)&size) == 0 ) return size; } if ( s->functions->seek ) - { long here = Stell(s); - long end; + { int64_t here = Stell64(s); + int64_t end; - if ( Sseek(s, 0, SIO_SEEK_END) == 0 ) - end = Stell(s); + if ( Sseek64(s, 0, SIO_SEEK_END) == 0 ) + end = Stell64(s); else end = -1; - Sseek(s, here, SIO_SEEK_SET); + Sseek64(s, here, SIO_SEEK_SET); return end; } @@ -1667,13 +1702,13 @@ unallocStream(IOSTREAM *s) #ifdef O_PLMT if ( s->mutex ) { recursiveMutexDelete(s->mutex); - free(s->mutex); + PL_free(s->mutex); s->mutex = NULL; } #endif if ( !(s->flags & SIO_STATIC) ) - free(s); + PL_free(s); } @@ -1711,7 +1746,7 @@ Sclose(IOSTREAM *s) #ifdef __WINDOWS__ if ( (s->flags & SIO_ADVLOCK) ) { OVERLAPPED ov; - HANDLE h = (HANDLE)_get_osfhandle((int)s->handle); + HANDLE h = (HANDLE)_get_osfhandle((int)((uintptr_t)s->handle)); memset(&ov, 0, sizeof(ov)); UnlockFileEx(h, 0, 0, 0xffffffff, &ov); @@ -1732,9 +1767,9 @@ Sclose(IOSTREAM *s) if ( rval < 0 ) reportStreamError(s); run_close_hooks(s); /* deletes Prolog registration */ + s->magic = SIO_CMAGIC; SUNLOCK(s); - s->magic = SIO_CMAGIC; if ( s->message ) free(s->message); if ( s->references == 0 ) @@ -1845,11 +1880,23 @@ Svprintf(const char *fm, va_list args) } -#define NEXTCHR(s, c) if ( utf8 ) \ - { (s) = utf8_get_char((s), &(c)); \ - } else \ - { c = *(s)++; c &= 0xff; \ - } +#define NEXTCHR(s, c) \ + switch (enc) \ + { case ENC_ANSI: \ + c = *(s)++; c &= 0xff; \ + break; \ + case ENC_UTF8: \ + (s) = utf8_get_char((s), &(c)); \ + break; \ + case ENC_WCHAR: \ + { wchar_t *_w = (wchar_t*)(s); \ + c = *_w++; \ + (s) = (char*)_w; \ + break; \ + } \ + default: \ + break; \ + } #define OUTCHR(s, c) do { printed++; \ if ( Sputcode((c), (s)) < 0 ) goto error; \ @@ -1911,7 +1958,7 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args) char fbuf[100], *fs = fbuf, *fe = fbuf; int islong = 0; int pad = ' '; - int utf8 = FALSE; + IOENC enc = ENC_ANSI; for(;;) { switch(*fm) @@ -1952,13 +1999,19 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args) { islong++; /* 1: %ld */ fm++; } - if ( *fm == 'l' ) - { islong++; /* 2: %lld */ - fm++; - } - if ( *fm == 'U' ) /* %Us: UTF-8 string */ - { utf8 = TRUE; - fm++; + switch ( *fm ) + { case 'l': + islong++; /* 2: %lld */ + fm++; + break; + case 'U': /* %Us: UTF-8 string */ + enc = ENC_UTF8; + fm++; + break; + case 'W': /* %Ws: wide string */ + enc = ENC_WCHAR; + fm++; + break; } switch(*fm) @@ -1983,41 +2036,53 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args) case 'u': case 'x': case 'X': - { intptr_t v = 0; /* make compiler silent */ - int64_t vl = 0; + { int vi = 0; + long vl = 0; /* make compiler silent */ + int64_t vll = 0; char fmbuf[8], *fp=fmbuf; switch( islong ) { case 0: - v = va_arg(args, int); + vi = va_arg(args, int); break; case 1: - v = va_arg(args, long); + vl = va_arg(args, long); break; case 2: - vl = va_arg(args, int64_t); + vll = va_arg(args, int64_t); break; + default: + assert(0); } *fp++ = '%'; if ( modified ) *fp++ = '#'; - *fp++ = 'l'; - if ( islong < 2 ) - { *fp++ = *fm; - *fp = '\0'; - SNPRINTF3(fmbuf, v); - } else - { + switch( islong ) + { case 0: + *fp++ = *fm; + *fp = '\0'; + SNPRINTF3(fmbuf, vi); + break; + case 1: + *fp++ = 'l'; + *fp++ = *fm; + *fp = '\0'; + SNPRINTF3(fmbuf, vl); + break; + case 2: #ifdef __WINDOWS__ - strcat(fp-1, "I64"); /* Synchronise with INT64_FORMAT! */ - fp += strlen(fp); + *fp++ = 'I'; /* Synchronise with INT64_FORMAT! */ + *fp++ = '6'; + *fp++ = '4'; #else - *fp++ = 'l'; + *fp++ = 'l'; + *fp++ = 'l'; #endif - *fp++ = *fm; - *fp = '\0'; - SNPRINTF3(fmbuf, vl); + *fp++ = *fm; + *fp = '\0'; + SNPRINTF3(fmbuf, vll); + break; } break; @@ -2075,12 +2140,25 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args) { size_t w; if ( fs == fbuf ) - w = fe - fs; - else - w = strlen(fs); - - if ( utf8 ) - w = utf8_strlen(fs, w); + { w = fe - fs; + } else + { switch(enc) + { case ENC_ANSI: + w = strlen(fs); + break; + case ENC_UTF8: + w = strlen(fs); + w = utf8_strlen(fs, w); + break; + case ENC_WCHAR: + w = wcslen((wchar_t*)fs); + break; + default: + assert(0); + w = 0; /* make compiler happy */ + break; + } + } if ( (ssize_t)w < arg1 ) { w = arg1 - w; @@ -2609,7 +2687,7 @@ Scontrol_file(void *handle, int action, void *arg) switch(action) { case SIO_GETSIZE: - { intptr_t *rval = arg; + { int64_t *rval = arg; struct stat buf; if ( fstat(fd, &buf) == 0 ) @@ -2621,6 +2699,11 @@ Scontrol_file(void *handle, int action, void *arg) case SIO_SETENCODING: case SIO_FLUSHOUTPUT: return 0; + case SIO_GETFILENO: + { int *p = arg; + *p = fd; + return 0; + } default: return -1; } @@ -2662,13 +2745,20 @@ 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. + +For now, we use PL_malloc_uncollectable(). In the end, this is really +one of the object-types we want to leave to GC. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ +#ifndef FD_CLOEXEC /* This is not defined in MacOS */ +#define FD_CLOEXEC 1 +#endif + IOSTREAM * Snew(void *handle, int flags, IOFUNCTIONS *functions) { IOSTREAM *s; - if ( !(s = malloc(sizeof(IOSTREAM))) ) + if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) ) { errno = ENOMEM; return NULL; } @@ -2680,7 +2770,11 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions) s->functions = functions; s->timeout = -1; /* infinite */ s->posbuf.lineno = 1; - s->encoding = ENC_ISO_LATIN_1; + if ( (flags&SIO_TEXT) ) + { s->encoding = initEncoding(); + } else + { s->encoding = ENC_OCTET; + } #if CRLF_MAPPING s->newline = SIO_NL_DOS; #endif @@ -2688,8 +2782,8 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions) s->position = &s->posbuf; #ifdef O_PLMT if ( !(flags & SIO_NOMUTEX) ) - { if ( !(s->mutex = malloc(sizeof(recursiveMutex))) ) - { free(s); + { if ( !(s->mutex = PL_malloc(sizeof(recursiveMutex))) ) + { PL_free(s); return NULL; } recursiveMutexInit(s->mutex); @@ -2701,7 +2795,7 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions) if ( (fd = Sfileno(s)) >= 0 ) { if ( isatty(fd) ) s->flags |= SIO_ISATTY; -#if defined(F_SETFD) && defined(FD_CLOEXEC) +#ifdef F_SETFD fcntl(fd, F_SETFD, FD_CLOEXEC); #endif } @@ -2804,13 +2898,23 @@ Sopen_file(const char *path, const char *how) struct flock buf; memset(&buf, 0, sizeof(buf)); - buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK); + buf.l_whence = SEEK_SET; + buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK); - if ( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) < 0 ) - { int save = errno; - close(fd); - errno = save; - return NULL; + while( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) != 0 ) + { if ( errno == EINTR ) + { if ( PL_handle_signals() < 0 ) + { close(fd); + return NULL; + } + continue; + } else + { int save = errno; + + close(fd); + errno = save; + return NULL; + } } #else /* we don't have locking */ #if __WINDOWS__ @@ -2891,12 +2995,10 @@ Sfileno(IOSTREAM *s) if ( s->flags & SIO_FILE ) { intptr_t h = (intptr_t)s->handle; n = (int)h; - } else if ( s->flags & SIO_PIPE ) - { n = fileno((FILE *)s->handle); } else if ( s->functions->control && (*s->functions->control)(s->handle, SIO_GETFILENO, - (void *)&n) == 0 ) + (void *)&n) == 0 ) { ; } else { errno = EINVAL; @@ -2907,6 +3009,30 @@ Sfileno(IOSTREAM *s) } +#ifdef __WINDOWS__ +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +On Windows, type SOCKET is an unsigned int and all values +[0..INVALID_SOCKET) are valid. It is also not allowed to run normal +file-functions on it or the application will crash. There seems to be no +way out except for introducing an extra function at this level :-( +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +SOCKET +Swinsock(IOSTREAM *s) +{ SOCKET n = INVALID_SOCKET; + + if ( s->functions->control && + (*s->functions->control)(s->handle, + SIO_GETWINSOCK, + (void *)&n) == 0 ) + { return n; + } + + errno = EINVAL; + return INVALID_SOCKET; +} +#endif + /******************************* * PIPES * *******************************/ @@ -2915,13 +3041,9 @@ Sfileno(IOSTREAM *s) #ifdef __WINDOWS__ #include "windows/popen.c" -#ifdef popen #undef popen -#endif -#define popen(cmd, how) pt_popen(cmd, how) -#ifdef pclose #undef pclose -#endif +#define popen(cmd, how) pt_popen(cmd, how) #define pclose(fd) pt_pclose(fd) #endif @@ -2958,11 +3080,31 @@ Sclose_pipe(void *handle) } +static int +Scontrol_pipe(void *handle, int action, void *arg) +{ FILE *fp = handle; + + switch(action) + { case SIO_GETFILENO: + { int *ap = arg; + *ap = fileno(fp); + return 0; + } + case SIO_FLUSHOUTPUT: + case SIO_SETENCODING: + return 0; + default: + return -1; + } +} + + IOFUNCTIONS Spipefunctions = { Sread_pipe, Swrite_pipe, (Sseek_function)0, - Sclose_pipe + Sclose_pipe, + Scontrol_pipe }; @@ -2983,9 +3125,9 @@ Sopen_pipe(const char *command, const char *type) { int flags; if ( *type == 'r' ) - flags = SIO_PIPE|SIO_INPUT|SIO_FBUF; + flags = SIO_INPUT|SIO_FBUF; else - flags = SIO_PIPE|SIO_OUTPUT|SIO_FBUF; + flags = SIO_OUTPUT|SIO_FBUF; return Snew((void *)fd, flags, &Spipefunctions); } @@ -3229,12 +3371,20 @@ Sopenmem(char **buffer, size_t *sizep, const char *mode) static ssize_t Sread_string(void *handle, char *buf, size_t size) -{ return 0; /* signal EOF */ +{ (void)handle; + (void)buf; + (void)size; + + return 0; /* signal EOF */ } static ssize_t Swrite_string(void *handle, char *buf, size_t size) -{ errno = ENOSPC; /* signal error */ +{ (void)handle; + (void)buf; + (void)size; + + errno = ENOSPC; /* signal error */ return -1; } @@ -3267,7 +3417,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode) { int flags = SIO_FBUF|SIO_USERBUF; if ( !s ) - { if ( !(s = malloc(sizeof(IOSTREAM))) ) + { if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) ) /* TBD: Use GC */ { errno = ENOMEM; return NULL; } @@ -3310,7 +3460,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode) #define STDIO(n, f) { NULL, NULL, NULL, NULL, \ EOF, SIO_MAGIC, 0, f, {0, 0, 0}, NULL, \ - ((void *)(n)), &Sttyfunctions, \ + (void *)(n), &Sttyfunctions, \ 0, NULL, \ (void (*)(void *))0, NULL, \ -1, \ @@ -3321,7 +3471,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode) #define SIO_STDIO (SIO_FILE|SIO_STATIC|SIO_NOCLOSE|SIO_ISATTY|SIO_TEXT) #define STDIO_STREAMS \ STDIO(0, SIO_STDIO|SIO_LBUF|SIO_INPUT|SIO_NOFEOF), /* Sinput */ \ - STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), /* Soutput */ \ + STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), /* Soutput */ \ STDIO(2, SIO_STDIO|SIO_NBUF|SIO_OUTPUT|SIO_REPPL) /* Serror */ @@ -3335,31 +3485,33 @@ static const IOSTREAM S__iob0[] = }; -/* vsc: Scleanup should reset init done */ -static int done; +static int S__initialised = FALSE; void SinitStreams(void) -{ - - if ( !done++ ) +{ if ( !S__initialised ) { int i; - IOENC enc = initEncoding(); + IOENC enc; + + S__initialised = TRUE; + enc = initEncoding(); for(i=0; i<=2; i++) - { if ( !isatty(i) ) - { S__iob[i].flags &= ~SIO_ISATTY; - S__iob[i].functions = &Sfilefunctions; /* Check for pipe? */ + { IOSTREAM *s = &S__iob[i]; + + if ( !isatty(i) ) + { s->flags &= ~SIO_ISATTY; + s->functions = &Sfilefunctions; /* Check for pipe? */ } - if ( S__iob[i].encoding == ENC_ISO_LATIN_1 ) - S__iob[i].encoding = enc; + if ( s->encoding == ENC_ISO_LATIN_1 ) + s->encoding = enc; #ifdef O_PLMT - S__iob[i].mutex = malloc(sizeof(recursiveMutex)); - recursiveMutexInit(S__iob[i].mutex); + s->mutex = PL_malloc(sizeof(recursiveMutex)); + recursiveMutexInit(s->mutex); #endif #if CRLF_MAPPING _setmode(i, O_BINARY); - S__iob[i].newline = SIO_NL_DOS; + s->newline = SIO_NL_DOS; #endif } @@ -3461,11 +3613,12 @@ Scleanup(void) S__iob[i].mutex = NULL; recursiveMutexDelete(m); - free(m); + PL_free(m); } #endif *s = S__iob0[i]; /* re-initialise */ } - done = 0; + + S__initialised = FALSE; } diff --git a/os/pl-string.c b/os/pl-string.c index 39a2d83ee..1ad6c4dd5 100644 --- a/os/pl-string.c +++ b/os/pl-string.c @@ -19,7 +19,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include "pl-incl.h" @@ -34,45 +34,10 @@ String operations that are needed for the shared IO library. * ALLOCATION * *******************************/ -#ifdef O_DEBUG -#define CHAR_INUSE 0x42 -#define CHAR_FREED 0x41 - char * store_string(const char *s) { if ( s ) - { GET_LD - char *copy = (char *)allocHeap(strlen(s)+2); - - *copy++ = CHAR_INUSE; - strcpy(copy, s); - - return copy; - } else - { return NULL; - } -} - - -void -remove_string(char *s) -{ if ( s ) - { GET_LD - assert(s[-1] == CHAR_INUSE); - - s[-1] = CHAR_FREED; - freeHeap(s-1, strlen(s)+2); - } -} - -#else /*O_DEBUG*/ - -char * -store_string(const char *s) -{ if ( s ) - { GET_LD - - char *copy = (char *)allocHeap(strlen(s)+1); + { char *copy = (char *)allocHeapOrHalt(strlen(s)+1); strcpy(copy, s); return copy; @@ -85,14 +50,9 @@ store_string(const char *s) void remove_string(char *s) { if ( s ) - { GET_LD freeHeap(s, strlen(s)+1); - } } -#endif /*O_DEBUG*/ - - /******************************* * NUMBERS * *******************************/ @@ -239,13 +199,13 @@ int_mbscoll(const char *s1, const char *s2, int icase) if ( l1 < 1024 && (w1 = alloca(sizeof(wchar_t)*(l1+1))) ) { ml1 = FALSE; } else - { w1 = PL_malloc(sizeof(wchar_t)*(l1+1)); + { w1 = PL_malloc_atomic(sizeof(wchar_t)*(l1+1)); ml1 = TRUE; } if ( l2 < 1024 && (w2 = alloca(sizeof(wchar_t)*(l2+1))) ) { ml2 = FALSE; } else - { w2 = PL_malloc(sizeof(wchar_t)*(l2+1)); + { w2 = PL_malloc_atomic(sizeof(wchar_t)*(l2+1)); ml2 = TRUE; } diff --git a/os/pl-string.h b/os/pl-string.h index f102045e9..e63d3e755 100644 --- a/os/pl-string.h +++ b/os/pl-string.h @@ -19,7 +19,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef PL_STRING_H_INCLUDED @@ -27,7 +27,7 @@ COMMON(char *) store_string(const char *s); COMMON(void) remove_string(char *s); -COMMON(char) digitName(int n, int smll); +COMMON(char) digitName(int n, int small); COMMON(int) digitValue(int b, int c); COMMON(bool) strprefix(const char *string, const char *prefix); COMMON(bool) strpostfix(const char *string, const char *postfix); diff --git a/os/pl-table.c b/os/pl-table.c index faf50b142..cef2defee 100644 --- a/os/pl-table.c +++ b/os/pl-table.c @@ -1,11 +1,10 @@ -/* $Id$ - - Part of SWI-Prolog +/* Part of SWI-Prolog Author: Jan Wielemaker - E-mail: jan@swi.psy.uva.nl + E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (C): 1985-2002, University of Amsterdam + Copyright (C): 1985-2012, University of Amsterdam + VU University Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -19,7 +18,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ /*#define O_DEBUG 1*/ @@ -41,35 +40,35 @@ create, advance over and destroy enumerator objects. These objects are used to enumerate the symbols of these tables, used primarily for the pl_current_* predicates. -The enumerators cause two things: (1) as intptr_t enumerators are +The enumerators cause two things: (1) as long as enumerators are associated, the table will not be rehashed and (2) if symbols are deleted that are referenced by an enumerator, the enumerator is -automatically advanced to the next free symbol. This, in general, makes +automatically advanced to the next free symbol. This, in general, makes the enumeration of hash-tables safe. -TODO: abort should delete any pending enumerators. This should be -thread-local, as thread_exit/1 should do the same. +TBD: Resizing hash-tables causes major headaches for concurrent access. +We can avoid this by using a dynamic array for the list of hash-entries. +Ongoing work in the RDF store shows hash-tables that can handle +concurrent lock-free access. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static void -allocHTableEntries(Table ht) -{ GET_LD - int n; +static Symbol * +allocHTableEntries(int buckets) +{ size_t bytes = buckets * sizeof(Symbol); Symbol *p; - ht->entries = allocHeap(ht->buckets * sizeof(Symbol)); + p = allocHeapOrHalt(bytes); + memset(p, 0, bytes); - for(n=0, p = &ht->entries[0]; n < ht->buckets; n++, p++) - *p = NULL; + return p; } Table newHTable(int buckets) -{ GET_LD - Table ht; +{ Table ht; - ht = allocHeap(sizeof(struct table)); + ht = allocHeapOrHalt(sizeof(struct table)); ht->buckets = (buckets & ~TABLE_MASK); ht->size = 0; ht->enumerators = NULL; @@ -79,25 +78,24 @@ newHTable(int buckets) if ( (buckets & TABLE_UNLOCKED) ) ht->mutex = NULL; else - { ht->mutex = allocHeap(sizeof(simpleMutex)); + { ht->mutex = allocHeapOrHalt(sizeof(simpleMutex)); simpleMutexInit(ht->mutex); } #endif - allocHTableEntries(ht); + ht->entries = allocHTableEntries(ht->buckets); return ht; } void destroyHTable(Table ht) -{ GET_LD - +{ #ifdef O_PLMT if ( ht->mutex ) { simpleMutexDelete(ht->mutex); freeHeap(ht->mutex, sizeof(*ht->mutex)); - ht->mutex = NULL; + ht->mutex = NULL; } #endif @@ -107,19 +105,19 @@ destroyHTable(Table ht) } -#if O_DEBUG || O_HASHSTAT -#define HASHSTAT(c) c +#if O_DEBUG static int lookups; static int cmps; void exitTables(int status, void *arg) -{ Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n", +{ (void)status; + (void)arg; + + Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n", lookups, cmps); } -#else -#define HASHSTAT(c) -#endif /*O_DEBUG*/ +#endif void @@ -129,7 +127,7 @@ initTables(void) if ( !done ) { done = TRUE; - HASHSTAT(PL_on_halt(exitTables, NULL)); + DEBUG(MSG_HASH_STAT, PL_on_halt(exitTables, NULL)); } } @@ -138,9 +136,9 @@ Symbol lookupHTable(Table ht, void *name) { Symbol s = ht->entries[pointerHashValue(name, ht->buckets)]; - HASHSTAT(lookups++); + DEBUG(MSG_HASH_STAT, lookups++); for( ; s; s = s->next) - { HASHSTAT(cmps++); + { DEBUG(MSG_HASH_STAT, cmps++); if ( s->name == name ) return s; } @@ -170,41 +168,75 @@ checkHTable(Table ht) /* MT: Locked by calling addHTable() */ -static void -rehashHTable(Table ht) -{ GET_LD - Symbol *oldtab; - int oldbucks; - int i; +static Symbol +rehashHTable(Table ht, Symbol map) +{ Symbol *newentries, *oldentries; + int newbuckets, oldbuckets; + int i; + int safe_copy = (ht->mutex != NULL); - oldtab = ht->entries; - oldbucks = ht->buckets; - ht->buckets *= 2; - allocHTableEntries(ht); + newbuckets = ht->buckets*2; + newentries = allocHTableEntries(newbuckets); - DEBUG(1, Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets)); + DEBUG(MSG_HASH_STAT, + Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets)); - for(i=0; ibuckets; i++) { Symbol s, n; - for(s=oldtab[i]; s; s = n) - { int v = (int)pointerHashValue(s->name, ht->buckets); + if ( safe_copy ) + { for(s=ht->entries[i]; s; s = n) + { int v = (int)pointerHashValue(s->name, newbuckets); + Symbol s2 = allocHeapOrHalt(sizeof(*s2)); - n = s->next; - s->next = ht->entries[v]; - ht->entries[v] = s; + n = s->next; + if ( s == map ) + map = s2; + *s2 = *s; + s2->next = newentries[v]; + newentries[v] = s2; + } + } else + { for(s=ht->entries[i]; s; s = n) + { int v = (int)pointerHashValue(s->name, newbuckets); + + n = s->next; + s->next = newentries[v]; + newentries[v] = s; + } } } - freeHeap(oldtab, oldbucks * sizeof(Symbol)); - DEBUG(0, checkHTable(ht)); + oldentries = ht->entries; + oldbuckets = ht->buckets; + ht->entries = newentries; + ht->buckets = newbuckets; + + if ( safe_copy ) + { /* Here we should be waiting until */ + /* active lookup are finished */ + for(i=0; inext; + + s->next = NULL; /* that causes old readers to stop */ + freeHeap(s, sizeof(*s)); + } + } + } + + freeHeap(oldentries, oldbuckets * sizeof(Symbol)); + DEBUG(CHK_SECURE, checkHTable(ht)); + + return map; } Symbol addHTable(Table ht, void *name, void *value) -{ GET_LD - Symbol s; +{ Symbol s; int v; LOCK_TABLE(ht); @@ -213,7 +245,7 @@ addHTable(Table ht, void *name, void *value) { UNLOCK_TABLE(ht); return NULL; } - s = allocHeap(sizeof(struct symbol)); + s = allocHeapOrHalt(sizeof(struct symbol)); s->name = name; s->value = value; s->next = ht->entries[v]; @@ -223,7 +255,7 @@ addHTable(Table ht, void *name, void *value) ht, name, value, ht->size)); if ( ht->buckets * 2 < ht->size && !ht->enumerators ) - rehashHTable(ht); + s = rehashHTable(ht, s); UNLOCK_TABLE(ht); DEBUG(1, checkHTable(ht)); @@ -237,8 +269,7 @@ Note: s must be in the table! void deleteSymbolHTable(Table ht, Symbol s) -{ GET_LD - int v; +{ int v; Symbol *h; TableEnum e; @@ -255,6 +286,9 @@ deleteSymbolHTable(Table ht, Symbol s) { if ( *h == s ) { *h = (*h)->next; + s->next = NULL; /* force crash */ + s->name = NULL; + s->value = NULL; freeHeap(s, sizeof(struct symbol)); ht->size--; @@ -268,8 +302,7 @@ deleteSymbolHTable(Table ht, Symbol s) void clearHTable(Table ht) -{ GET_LD - int n; +{ int n; TableEnum e; LOCK_TABLE(ht); @@ -309,24 +342,23 @@ Table copyHTable(Table org) Table copyHTable(Table org) -{ GET_LD - Table ht; +{ Table ht; int n; - ht = allocHeap(sizeof(struct table)); + ht = allocHeapOrHalt(sizeof(struct table)); LOCK_TABLE(org); *ht = *org; /* copy all attributes */ #ifdef O_PLMT ht->mutex = NULL; #endif - allocHTableEntries(ht); + ht->entries = allocHTableEntries(ht->buckets); for(n=0; n < ht->buckets; n++) { Symbol s, *q; q = &ht->entries[n]; for(s = org->entries[n]; s; s = s->next) - { Symbol s2 = allocHeap(sizeof(*s2)); + { Symbol s2 = allocHeapOrHalt(sizeof(*s2)); *q = s2; q = &s2->next; @@ -340,7 +372,7 @@ copyHTable(Table org) } #ifdef O_PLMT if ( org->mutex ) - { ht->mutex = allocHeap(sizeof(simpleMutex)); + { ht->mutex = allocHeapOrHalt(sizeof(simpleMutex)); simpleMutexInit(ht->mutex); } #endif @@ -356,8 +388,7 @@ copyHTable(Table org) TableEnum newTableEnum(Table ht) -{ GET_LD - TableEnum e = allocHeap(sizeof(struct table_enum)); +{ TableEnum e = allocHeapOrHalt(sizeof(struct table_enum)); Symbol n; LOCK_TABLE(ht); @@ -378,8 +409,7 @@ newTableEnum(Table ht) void freeTableEnum(TableEnum e) -{ GET_LD - TableEnum *ep; +{ TableEnum *ep; Table ht; if ( !e ) diff --git a/os/pl-utf8.c b/os/pl-utf8.c index 188170ddc..2fe01b7d3 100644 --- a/os/pl-utf8.c +++ b/os/pl-utf8.c @@ -19,7 +19,7 @@ You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ #include /* get size_t */