SWI update

This commit is contained in:
Vítor Santos Costa 2013-01-16 00:19:07 +00:00
parent 9550393e66
commit 0eacb68907
12 changed files with 467 additions and 344 deletions

View File

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

View File

@ -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 */

View File

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

View File

@ -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, ...);

View File

@ -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*/

View File

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

View File

@ -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__

View File

@ -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();

View File

@ -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*/

View File

@ -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 <os2.h> /* 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 <sys/sysctl.h>
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(); /* 0<n<2^15-1 */
@ -845,19 +814,16 @@ struct canonical_dir
forwards char *canoniseDir(char *);
#endif /*O_CANONISE_DIRS*/
#define CWDdir (LD->os._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<size; n++)
remove_string(vector[n]);
PL_put_atom_chars(tmp, spec);
PL_error(NULL, 0, "ambiguous", ERR_EXISTENCE, ATOM_file, tmp);
return NULL;
}
}
return rc;
}
@ -1507,7 +1446,7 @@ AbsoluteFile(const char *spec, char *path)
if ( !file )
return (char *) NULL;
if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(file = ExpandOneFile(buf, tmp)) )
{ if ( !(file = expandVars(buf, tmp, sizeof(tmp))) )
return (char *) NULL;
}
@ -1530,17 +1469,17 @@ AbsoluteFile(const char *spec, char *path)
}
#endif /*O_HASDRIVES*/
if ( !PL_cwd() )
if ( !PL_cwd(path, MAXPATHLEN) )
return NULL;
if ( (CWDlen + strlen(file) + 1) >= 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)

View File

@ -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*/

View File

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