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] 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)