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

Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

This commit is contained in:
Vitor Santos Costa 2013-01-16 11:29:38 +00:00
parent 5a6f6c09ce abe6621495
commit 298fb62f0c
21 changed files with 1168 additions and 793 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
C/compiler.c
View File

@ -2109,14 +2109,14 @@ c_head(Term t, compiler_struct *cglobs)
if (IsAtomTerm(t)) {
Yap_emit(name_op, (CELL) AtomOfTerm(t), Zero, &cglobs->cint);
#ifdef BEAM
if (EAM) {
Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
}
if (EAM) {
Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
}
#endif
Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
cglobs->space_op = cglobs->cint.cpc;
return;
}
Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
cglobs->space_op = cglobs->cint.cpc;
f = FunctorOfTerm(t);
Yap_emit(name_op, (CELL) NameOfFunctor(f), ArityOfFunctor(f), &cglobs->cint);
#ifdef BEAM
@ -2124,8 +2124,10 @@ c_head(Term t, compiler_struct *cglobs)
Yap_emit(run_op,Zero,(UInt) cglobs->cint.CurrentPred,&cglobs->cint);
}
#endif
if (Yap_ExecutionMode == MIXED_MODE_USER)
if (Yap_ExecutionMode == MIXED_MODE_USER)
Yap_emit(native_op, 0, 0, &cglobs->cint);
Yap_emit(ensure_space_op, Zero , Zero, &cglobs->cint);
cglobs->space_op = cglobs->cint.cpc;
c_args(t, 0, cglobs);
}
@ -3537,6 +3539,10 @@ Yap_cclause(volatile Term inp_clause, Int NOfArgs, Term mod, volatile Term src)
}
if (LOCAL_ErrorMessage)
return (0);
/* make sure we give enough space for the fact */
if (cglobs.space_op)
cglobs.space_op->rnd1 = cglobs.space_used;
#ifdef DEBUG
if (GLOBAL_Option['g' - 96])
Yap_ShowCode(&cglobs.cint);

28
C/pl-yap.c
View File

@ -476,14 +476,11 @@ int raiseStackOverflow(int overflow)
* FEATURES *
*******************************/
int
PL_set_prolog_flag(const char *name, int type, ...)
{ va_list args;
int rval = TRUE;
int flags = (type & FF_MASK);
initPrologFlagTable();
va_start(args, type);
switch(type & ~FF_MASK)
{ case PL_BOOL:
@ -494,10 +491,8 @@ PL_set_prolog_flag(const char *name, int type, ...)
}
case PL_ATOM:
{ const char *v = va_arg(args, const char *);
#ifndef __YAP_PROLOG__
if ( !GD->initialised )
initAtoms();
#endif
// VSC if ( !GD->initialised )
// VSC initAtoms();
setPrologFlag(name, FT_ATOM|flags, v);
break;
}
@ -509,13 +504,12 @@ PL_set_prolog_flag(const char *name, int type, ...)
default:
rval = FALSE;
}
va_end(args);
return rval;
}
int
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text;
@ -761,6 +755,12 @@ PL_get_list_nchars(term_t l, size_t *length, char **s, unsigned int flags)
fail;
}
void *
PL_malloc_uncollectable(size_t sz)
{
return malloc(sz);
}
int
PL_get_list_chars(term_t l, char **s, unsigned flags)
{ return PL_get_list_nchars(l, NULL, s, flags);
@ -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

10
H/pl-global.h
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 */

21
H/pl-incl.h
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
@ -466,9 +468,6 @@ typedef struct
#define FT_FROM_VALUE 0x0f /* Determine type from value */
#define FT_MASK 0x0f /* mask to get type */
#define FF_READONLY 0x10 /* feature is read-only */
#define FF_KEEP 0x20 /* keep value it already set */
#define PLFLAG_CHARESCAPE 0x000001 /* handle \ in atoms */
#define PLFLAG_GC 0x000002 /* do GC */
#define PLFLAG_TRACE_GC 0x000004 /* verbose gc */
@ -531,6 +530,15 @@ 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)
#define PL_malloc_atomic malloc
/* vsc: global variables */
#include "pl-global.h"
@ -682,6 +690,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);
@ -691,6 +700,7 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
extern IOSTREAM ** /* provide access to Suser_input, */
@ -797,6 +807,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 +849,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);
@ -899,7 +910,7 @@ COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags,
COMMON(bool) systemMode(bool accept);
COMMON(void) initPrologFlagTable(void);
COMMON(void) cleanupPrologFlags(void);
COMMON(void) initPrologFlags(void);
COMMON(int) raiseStackOverflow(int overflow);

4
include/SWI-Prolog.h
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, ...);

10
os/SWI-Stream.h
View File

@ -65,6 +65,10 @@ typedef intptr_t ssize_t; /* signed version of size_t */
extern "C" {
#endif
#ifndef PL_HAVE_TERM_T
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
#endif
/*******************************
* CONSTANTS *
*******************************/
@ -335,14 +339,10 @@ PL_EXPORT(int) Sfpasteof(IOSTREAM *s);
PL_EXPORT(int) Sferror(IOSTREAM *s);
PL_EXPORT(void) Sclearerr(IOSTREAM *s);
PL_EXPORT(void) Sseterr(IOSTREAM *s, int which, const char *message);
#ifdef _FLI_H_INCLUDED
PL_EXPORT(void) Sset_exception(IOSTREAM *s, term_t ex);
#else
PL_EXPORT(void) Sset_exception(IOSTREAM *s, intptr_t ex);
#endif
PL_EXPORT(int) Ssetenc(IOSTREAM *s, IOENC new_enc, IOENC *old_enc);
PL_EXPORT(int) Sflush(IOSTREAM *s);
PL_EXPORT(long) Ssize(IOSTREAM *s);
PL_EXPORT(int64_t) Ssize(IOSTREAM *s);
PL_EXPORT(int) Sseek(IOSTREAM *s, long pos, int whence);
PL_EXPORT(long) Stell(IOSTREAM *s);
PL_EXPORT(int) Sclose(IOSTREAM *s);

4
os/pl-ctype.c
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;

90
os/pl-file.c
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__

126
os/pl-files.c
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();

12
os/pl-files.h
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*/

103
os/pl-fmt.c
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
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -53,9 +53,9 @@ typedef struct
struct rubber rub[MAXRUBBER];
} format_state;
#define BUFSIZE 1024
#define DEFAULT (-1)
#define SHIFT { argc--; argv++; }
#define BUFSIZE 1024
#define DEFAULT (-1)
#define SHIFT { argc--; argv++; }
#define NEED_ARG { if ( argc <= 0 ) \
{ FMT_ERROR("not enough arguments"); \
} \
@ -189,7 +189,8 @@ outtext(format_state *state, PL_chars_t *txt)
#define format_predicates (GD->format.predicates)
static int update_column(int, Char);
static bool do_format(IOSTREAM *fd, PL_chars_t *fmt, int ac, term_t av);
static bool do_format(IOSTREAM *fd, PL_chars_t *fmt,
int ac, term_t av, Module m);
static void distribute_rubber(struct rubber *, int, int);
static int emit_rubber(format_state *state);
@ -272,7 +273,7 @@ pl_current_format_predicate(term_t chr, term_t descr, control_t h)
static word
format_impl(IOSTREAM *out, term_t format, term_t Args)
format_impl(IOSTREAM *out, term_t format, term_t Args, Module m)
{ GET_LD
term_t argv;
int argc = 0;
@ -307,7 +308,7 @@ format_impl(IOSTREAM *out, term_t format, term_t Args)
break;
}
rval = do_format(out, &fmt, argc, argv);
rval = do_format(out, &fmt, argc, argv, m);
PL_free_text(&fmt);
if ( !endCritical )
return FALSE;
@ -318,31 +319,20 @@ format_impl(IOSTREAM *out, term_t format, term_t Args)
word
pl_format3(term_t out, term_t format, term_t args)
{ redir_context ctx;
{ GET_LD
redir_context ctx;
word rc;
#if __YAP_PROLOG__
/*
YAP allows the last argument to format to be of the form
module:[]
*/
YAP_Term mod;
#endif
Module m = NULL;
term_t list = PL_new_term_ref();
if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) ) {
#if __YAP_PROLOG__
/* module processing */
{
args = Yap_fetch_module_for_format(args, &mod);
}
#endif
{ if ( (rc = format_impl(ctx.stream, format, args)) )
rc = closeOutputRedirect(&ctx);
else
if ( !PL_strip_module(args, &m, list) )
return FALSE;
if ( (rc=setupOutputRedirect(out, &ctx, FALSE)) )
{ if ( (rc = format_impl(ctx.stream, format, list, m)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
}
#if __YAP_PROLOG__
YAP_SetCurrentModule(mod);
#endif
}
return rc;
@ -374,7 +364,7 @@ get_chr_from_text(const PL_chars_t *t, int index)
********************************/
static bool
do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv, Module m)
{ GET_LD
format_state state; /* complete state */
int tab_stop = 0; /* padded tab stop */
@ -443,7 +433,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
char buf[BUFSIZE];
char *str = buf;
size_t bufsize = BUFSIZE;
unsigned int i;
int i;
PL_predicate_info(proc, NULL, &arity, NULL);
av = PL_new_term_refs(arity);
@ -481,7 +471,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
if ( !PL_get_text(argv, &txt, CVT_ATOMIC) )
FMT_ARG("a", argv);
SHIFT;
outtext(&state, &txt);
rc = outtext(&state, &txt);
if ( !rc )
goto out;
here++;
break;
}
@ -494,7 +486,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
SHIFT;
while(times-- > 0)
{ outchr(&state, chr);
{ rc = outchr(&state, chr);
if ( !rc )
goto out;
}
} else
FMT_ARG("c", argv);
@ -508,7 +502,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
case 'G': /* shortest of 'f' and 'E' */
{ number n;
union {
tmp_buffer b;
tmp_buffer b;
buffer b1;
} u;
@ -525,8 +519,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
initBuffer(&u.b);
formatFloat(c, arg, &n, &u.b1);
clearNumber(&n);
outstring0(&state, baseBuffer(&u.b, char));
rc = outstring0(&state, baseBuffer(&u.b, char));
discardBuffer(&u.b);
if ( !rc )
goto out;
here++;
break;
}
@ -564,8 +560,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
formatNumber(FALSE, 0, arg, c == 'r', &i, (Buffer)&b);
}
clearNumber(&i);
outstring0(&state, baseBuffer(&b, char));
rc = outstring0(&state, baseBuffer(&b, char));
discardBuffer(&b);
if ( !rc )
goto out;
here++;
break;
}
@ -576,8 +574,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
if ( !PL_get_text(argv, &txt, CVT_LIST|CVT_STRING) &&
!PL_get_text(argv, &txt, CVT_ATOM) ) /* SICStus compat */
FMT_ARG("s", argv);
outtext(&state, &txt);
rc = outtext(&state, &txt);
SHIFT;
if ( !rc )
goto out;
here++;
break;
}
@ -610,8 +610,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
str = buf;
tellString(&str, &bufsize, ENC_UTF8);
(*f)(argv);
rc = (*f)(argv);
toldString();
if ( !rc )
goto out;
oututf8(&state, str, bufsize);
if ( str != buf )
free(str);
@ -632,8 +634,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
str = buf;
tellString(&str, &bufsize, ENC_UTF8);
(*f)(argv);
rc = (*f)(argv);
toldString();
if ( !rc )
goto out;
oututf8(&state, str, bufsize);
if ( str != buf )
free(str);
@ -704,7 +708,7 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
{ FMT_ERROR("not enough arguments");
}
tellString(&str, &bufsize, ENC_UTF8);
rval = callProlog(NULL, argv, PL_Q_CATCH_EXCEPTION, &ex);
rval = callProlog(m, argv, PL_Q_CATCH_EXCEPTION, &ex);
toldString();
oututf8(&state, str, bufsize);
if ( str != buf )
@ -724,7 +728,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
break;
}
case '~': /* ~ */
{ outchr(&state, '~');
{ rc = outchr(&state, '~');
if ( !rc )
goto out;
here++;
break;
}
@ -735,7 +741,10 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
if ( c == 'N' && state.column == 0 )
arg--;
while( arg-- > 0 )
outchr(&state, '\n');
{ rc = outchr(&state, '\n');
if ( !rc )
goto out;
}
here++;
break;
}
@ -790,7 +799,9 @@ do_format(IOSTREAM *fd, PL_chars_t *fmt, int argc, term_t argv)
break; /* the '~' switch */
}
default:
{ outchr(&state, c);
{ rc = outchr(&state, c);
if ( !rc )
goto out;
here++;
break;
}
@ -1032,7 +1043,8 @@ formatFloat(int how, int arg, Number f, Buffer out)
while(written >= size)
{ size = written+1;
growBuffer(out, size); /* reserve for -.e<null> */
if ( !growBuffer(out, size) ) /* reserve for -.e<null> */
outOfCore();
written = gmp_snprintf(baseBuffer(out, char), size, tmp, mpf);
}
mpf_clear(mpf);
@ -1053,7 +1065,8 @@ formatFloat(int how, int arg, Number f, Buffer out)
while(written >= size)
{ size = written+1;
growBuffer(out, size);
if ( !growBuffer(out, size) )
outOfCore();
written = snprintf(baseBuffer(out, char), size, tmp, f->value.f);
}
out->top = out->base + written;

65
os/pl-glob.c
View File

@ -3,9 +3,10 @@
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
E-mail: J.Wielemaker@cs.vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
Copyright (C): 1985-2011, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +20,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include "pl-incl.h"
@ -29,9 +30,9 @@
#include <unistd.h>
#endif
#ifdef __WATCOMC__
#include <direct.h>
#else /*__WATCOMC__*/
#ifdef O_XOS
# include "windows/dirent.h"
#else
#if HAVE_DIRENT_H
# include <dirent.h>
#else
@ -46,7 +47,7 @@
# include <ndir.h>
# endif
#endif
#endif /*__WATCOMC__*/
#endif /*O_XOS*/
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
@ -326,8 +327,8 @@ PRED_IMPL("wildcard_match", 2, wildcard_match, 0)
{ char *p, *s;
compiled_pattern buf;
if ( !PL_get_chars_ex(A1, &p, CVT_ALL) ||
!PL_get_chars_ex(A2, &s, CVT_ALL) )
if ( !PL_get_chars(A1, &p, CVT_ALL|CVT_EXCEPTION) ||
!PL_get_chars(A2, &s, CVT_ALL|CVT_EXCEPTION) )
fail;
if ( compilePattern(p, &buf) )
@ -423,6 +424,7 @@ expand(const char *pattern, GlobInfo info)
compiled_pattern cbuf;
char prefix[MAXPATHLEN]; /* before first pattern */
char patbuf[MAXPATHLEN]; /* pattern buffer */
size_t prefix_len;
int end, dot;
initBuffer(&info->files);
@ -441,20 +443,25 @@ expand(const char *pattern, GlobInfo info)
switch( (c=*s++) )
{ case EOS:
if ( s > pat ) /* something left and expanded */
{ un_escape(prefix, pat, s);
{ size_t prefix_len;
un_escape(prefix, pat, s);
prefix_len = strlen(prefix);
end = info->end;
for( ; info->start < end; info->start++ )
{ char path[MAXPATHLEN];
size_t plen;
const char *entry = expand_entry(info, info->start);
size_t plen = strlen(entry);
strcpy(path, expand_entry(info, info->start));
plen = strlen(path);
if ( prefix[0] && plen > 0 && path[plen-1] != '/' )
path[plen++] = '/';
strcpy(&path[plen], prefix);
if ( end == 1 || AccessFile(path, ACCESS_EXIST) )
add_path(path, info);
if ( plen+prefix_len+2 <= MAXPATHLEN )
{ strcpy(path, entry);
if ( prefix[0] && plen > 0 && path[plen-1] != '/' )
path[plen++] = '/';
strcpy(&path[plen], prefix);
if ( end == 1 || AccessFile(path, ACCESS_EXIST) )
add_path(path, info);
}
}
}
succeed;
@ -489,8 +496,9 @@ expand(const char *pattern, GlobInfo info)
*/
un_escape(prefix, pat, head);
un_escape(patbuf, head, tail);
prefix_len = strlen(prefix);
if ( !compilePattern(patbuf, &cbuf) ) /* syntax error */
if ( !compilePattern(patbuf, &cbuf) ) /* syntax error */
fail;
dot = (patbuf[0] == '.'); /* do dots as well */
@ -502,6 +510,10 @@ expand(const char *pattern, GlobInfo info)
char path[MAXPATHLEN];
char tmp[MAXPATHLEN];
const char *current = expand_entry(info, info->start);
size_t clen = strlen(current);
if ( clen+prefix_len+1 > sizeof(path) )
continue;
strcpy(path, current);
strcat(path, prefix);
@ -521,12 +533,11 @@ expand(const char *pattern, GlobInfo info)
matchPattern(e->d_name, &cbuf) )
{ char newp[MAXPATHLEN];
strcpy(newp, path);
strcpy(&newp[plen], e->d_name);
/* if ( !tail[0] || ExistsDirectory(newp) )
Saves memory, but involves one more file-access
*/
if ( plen+strlen(e->d_name)+1 < sizeof(newp) )
{ strcpy(newp, path);
strcpy(&newp[plen], e->d_name);
add_path(newp, info);
}
}
}
closedir(d);
@ -579,11 +590,11 @@ PRED_IMPL("expand_file_name", 2, expand_file_name, 0)
term_t head = PL_new_term_ref();
int i;
if ( !PL_get_chars_ex(A1, &s, CVT_ALL|REP_FN) )
if ( !PL_get_chars(A1, &s, CVT_ALL|REP_FN|CVT_EXCEPTION) )
fail;
if ( strlen(s) > sizeof(spec)-1 )
return PL_error(NULL, 0, "File name too intptr_t",
ERR_DOMAIN, ATOM_pattern, A1);
return PL_error(NULL, 0, NULL, ERR_REPRESENTATION,
ATOM_max_path_length);
if ( !expandVars(s, spec, sizeof(spec)) )
fail;

440
os/pl-os.c
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)

206
os/pl-prologflag.c
View File

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.wielemaker@uva.nl
E-mail: J.wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2008, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/*#define O_DEBUG 1*/
@ -80,6 +79,8 @@ static void setTZPrologFlag(void);
static void setVersionPrologFlag(void);
#endif
static atom_t lookupAtomFlag(atom_t key);
static void initPrologFlagTable(void);
typedef struct _prolog_flag
{ short flags; /* Type | Flags */
@ -138,7 +139,7 @@ setPrologFlag(const char *name, int flags, ...)
if ( flags & FF_KEEP )
return;
} else
{ f = allocHeap(sizeof(*f));
{ f = allocHeapOrHalt(sizeof(*f));
f->index = -1;
f->flags = flags;
addHTable(GD->prolog_flag.table, (void *)an, f);
@ -155,7 +156,8 @@ setPrologFlag(const char *name, int flags, ...)
val = (f->value.a == ATOM_true);
} else if ( !s ) /* 1st definition */
{ f->index = indexOfBoolMask(mask);
DEBUG(2, Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
DEBUG(MSG_PROLOG_FLAG,
Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
}
f->value.a = (val ? ATOM_true : ATOM_false);
@ -211,12 +213,20 @@ setPrologFlag(const char *name, int flags, ...)
}
static void
freePrologFlag(prolog_flag *f)
{ if ( (f->flags & FT_MASK) == FT_TERM )
PL_erase(f->value.t);
freeHeap(f, sizeof(*f));
}
#ifdef O_PLMT
static void
copySymbolPrologFlagTable(Symbol s)
{ GET_LD
prolog_flag *f = s->value;
prolog_flag *copy = allocHeap(sizeof(*copy));
{ prolog_flag *f = s->value;
prolog_flag *copy = allocHeapOrHalt(sizeof(*copy));
*copy = *f;
if ( (f->flags & FT_MASK) == FT_TERM )
@ -227,13 +237,7 @@ copySymbolPrologFlagTable(Symbol s)
static void
freeSymbolPrologFlagTable(Symbol s)
{ GET_LD
prolog_flag *f = s->value;
if ( (f->flags & FT_MASK) == FT_TERM )
PL_erase(f->value.t);
freeHeap(f, sizeof(*f));
{ freePrologFlag(s->value);
}
#endif
@ -267,25 +271,34 @@ setDoubleQuotes(atom_t a, unsigned int *flagp)
static int
setUnknown(atom_t a, unsigned int *flagp)
{ unsigned int flags;
setUnknown(term_t value, atom_t a, Module m)
{ unsigned int flags = m->flags & ~(UNKNOWN_MASK);
if ( a == ATOM_error )
flags = UNKNOWN_ERROR;
flags |= UNKNOWN_ERROR;
else if ( a == ATOM_warning )
flags = UNKNOWN_WARNING;
flags |= UNKNOWN_WARNING;
else if ( a == ATOM_fail )
flags = UNKNOWN_FAIL;
flags |= UNKNOWN_FAIL;
else
{ GET_LD
term_t value = PL_new_term_ref();
PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value);
if ( !(flags&UNKNOWN_ERROR) && (m == MODULE_user || m == MODULE_system) )
{ GET_LD
if ( m == MODULE_system && !SYSTEM_MODE )
{ term_t key = PL_new_term_ref();
PL_put_atom(key, ATOM_unknown);
return PL_error(NULL, 0, NULL, ERR_PERMISSION,
ATOM_modify, ATOM_flag, key);
}
if ( !SYSTEM_MODE )
printMessage(ATOM_warning, PL_CHARS, "unknown_in_module_user");
}
*flagp &= ~(UNKNOWN_MASK);
*flagp |= flags;
m->flags = flags;
succeed;
}
@ -308,6 +321,21 @@ setWriteAttributes(atom_t a)
}
static int
setAccessLevelFromAtom(atom_t a)
{ GET_LD
if ( getAccessLevelMask(a, &LD->prolog_flag.access_level) )
{ succeed;
} else
{ term_t value = PL_new_term_ref();
PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_access_level, value);
}
}
static int
getOccursCheckMask(atom_t a, occurs_check_t *val)
{ if ( a == ATOM_false )
@ -357,6 +385,30 @@ setEncoding(atom_t a)
}
static int
setStreamTypeCheck(atom_t a)
{ GET_LD
st_check check;
if ( a == ATOM_false )
check = ST_FALSE;
else if ( a == ATOM_loose )
check = ST_LOOSE;
else if ( a == ATOM_true )
check = ST_TRUE;
else
{ term_t value = PL_new_term_ref();
PL_put_atom(value, a);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_type_check, value);
}
LD->IO.stream_type_check = check;
return TRUE;
}
static word
set_prolog_flag_unlocked(term_t key, term_t value, int flags)
{ GET_LD
@ -385,7 +437,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
#ifdef O_PLMT
if ( GD->statistics.threads_created > 1 )
{ prolog_flag *f2 = allocHeap(sizeof(*f2));
{ prolog_flag *f2 = allocHeapOrHalt(sizeof(*f2));
*f2 = *f;
if ( (f2->flags & FT_MASK) == FT_TERM )
@ -399,7 +451,8 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
}
addHTable(LD->prolog_flag.table, (void *)k, f2);
DEBUG(1, Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
DEBUG(MSG_PROLOG_FLAG,
Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
f = f2;
}
#endif
@ -411,7 +464,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
anyway:
PL_register_atom(k);
f = allocHeap(sizeof(*f));
f = allocHeapOrHalt(sizeof(*f));
f->index = -1;
switch( (flags & FT_MASK) )
@ -437,8 +490,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
goto wrong_type;
}
if ( !(f->value.t = PL_record(value)) )
goto wrong_type;
f->value.t = PL_record(value);
{ freeHeap(f, sizeof(*f));
return FALSE;
}
}
break;
}
@ -483,7 +537,10 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
if ( (flags & FF_READONLY) )
f->flags |= FF_READONLY;
addHTable(GD->prolog_flag.table, (void *)k, f);
if ( !addHTable(GD->prolog_flag.table, (void *)k, f) )
{ freePrologFlag(f);
Sdprintf("OOPS; failed to set Prolog flag!?\n");
}
succeed;
} else
@ -516,9 +573,9 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
#ifndef __YAP_PROLOG__
if ( k == ATOM_character_escapes )
{ if ( val )
set(m, CHARESCAPE);
set(m, M_CHARESCAPE);
else
clear(m, CHARESCAPE);
clear(m, M_CHARESCAPE);
} else if ( k == ATOM_debug )
{ if ( val )
{ debugmode(DBG_ALL, NULL);
@ -551,15 +608,19 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
if ( k == ATOM_double_quotes )
{ rval = setDoubleQuotes(a, &m->flags);
} else if ( k == ATOM_unknown )
{ rval = setUnknown(a, &m->flags);
{ rval = setUnknown(value, a, m);
} else if ( k == ATOM_write_attributes )
{ rval = setWriteAttributes(a);
} else if ( k == ATOM_occurs_check )
{ rval = setOccursCheck(a);
} else
} else if ( k == ATOM_access_level )
{ rval = setAccessLevelFromAtom(a);
} else
#endif
if ( k == ATOM_encoding )
{ rval = setEncoding(a);
} else if ( k == ATOM_stream_type_check )
{ rval = setStreamTypeCheck(a);
}
if ( !rval )
fail;
@ -705,7 +766,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
#ifndef __YAP_PROLOG__
if ( key == ATOM_character_escapes )
{ atom_t v = (true(m, CHARESCAPE) ? ATOM_true : ATOM_false);
{ atom_t v = (true(m, M_CHARESCAPE) ? ATOM_true : ATOM_false);
return PL_unify_atom(val, v);
} else if ( key == ATOM_double_quotes )
@ -736,6 +797,7 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
break;
default:
assert(0);
return FALSE;
}
return PL_unify_atom(val, v);
@ -747,6 +809,14 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
{ return PL_unify_bool_ex(val, debugstatus.debugging);
} else if ( key == ATOM_debugger_show_context )
{ return PL_unify_bool_ex(val, debugstatus.showContext);
} else if ( key == ATOM_break_level )
{ int bl = currentBreakLevel();
if ( bl >= 0 )
return PL_unify_integer(val, bl);
return FALSE;
} else if ( key == ATOM_access_level )
{ return PL_unify_atom(val, accessLevel());
}
#endif /* YAP_PROLOG */
@ -861,7 +931,7 @@ pl_prolog_flag5(term_t key, term_t value,
fail;
} else if ( PL_is_variable(key) )
{ e = allocHeap(sizeof(*e));
{ e = allocHeapOrHalt(sizeof(*e));
e->module = module;
@ -965,7 +1035,7 @@ pl_prolog_flag(term_t name, term_t value, control_t h)
#define SO_PATH "LD_LIBRARY_PATH"
#endif
void
static void
initPrologFlagTable(void)
{ if ( !GD->prolog_flag.table )
{
@ -973,7 +1043,7 @@ initPrologFlagTable(void)
initPrologThreads(); /* may be called before PL_initialise() */
#endif
GD->prolog_flag.table = newHTable(32);
GD->prolog_flag.table = newHTable(64);
}
}
@ -983,7 +1053,7 @@ initPrologFlags(void)
{ GET_LD
#ifndef __YAP_PROLOG__
setPrologFlag("iso", FT_BOOL, FALSE, PLFLAG_ISO);
setPrologFlag("arch", FT_ATOM|FF_READONLY, ARCH);
setPrologFlag("arch", FT_ATOM|FF_READONLY, PLARCH);
#if __WINDOWS__
setPrologFlag("windows", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
@ -996,12 +1066,17 @@ initPrologFlags(void)
#if defined(HAVE_GETPID) || defined(EMULATE_GETPID)
setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid());
#endif
setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
setPrologFlag("generate_debug_info", FT_BOOL,
truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
setPrologFlag("last_call_optimisation", FT_BOOL, TRUE, PLFLAG_LASTCALL);
setPrologFlag("c_libs", FT_ATOM|FF_READONLY, C_LIBS);
setPrologFlag("c_cc", FT_ATOM|FF_READONLY, C_CC);
setPrologFlag("c_ldflags", FT_ATOM|FF_READONLY, C_LDFLAGS);
setPrologFlag("warn_override_implicit_import", FT_BOOL, TRUE,
PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT);
setPrologFlag("c_cc", FT_ATOM, C_CC);
setPrologFlag("c_libs", FT_ATOM, C_LIBS);
setPrologFlag("c_libplso", FT_ATOM, C_LIBPLSO);
setPrologFlag("c_ldflags", FT_ATOM, C_LDFLAGS);
setPrologFlag("c_cflags", FT_ATOM, C_CFLAGS);
#if defined(O_LARGEFILES) || SIZEOF_LONG == 8
setPrologFlag("large_files", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
@ -1041,6 +1116,7 @@ initPrologFlags(void)
setPrologFlag("debug_on_error", FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR);
setPrologFlag("report_error", FT_BOOL, TRUE, PLFLAG_REPORT_ERROR);
#endif
setPrologFlag("break_level", FT_INTEGER|FF_READONLY, 0, 0);
setPrologFlag("user_flags", FT_ATOM, "silent");
setPrologFlag("editor", FT_ATOM, "default");
setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0);
@ -1065,28 +1141,39 @@ initPrologFlags(void)
setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
setPrologFlag("answer_format", FT_ATOM, "~p");
setPrologFlag("colon_sets_calling_context", FT_BOOL, TRUE, 0);
setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING);
setPrologFlag("write_attributes", FT_ATOM, "ignore");
setPrologFlag("stream_type_check", FT_ATOM, "loose");
setPrologFlag("occurs_check", FT_ATOM, "false");
setPrologFlag("access_level", FT_ATOM, "user");
setPrologFlag("double_quotes", FT_ATOM, "codes");
setPrologFlag("unknown", FT_ATOM, "error");
setPrologFlag("debug", FT_BOOL, FALSE, 0);
setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal");
setPrologFlag("verbose_load", FT_BOOL, TRUE, 0);
setPrologFlag("verbose_load", FT_ATOM, "normal");
setPrologFlag("verbose_autoload", FT_BOOL, FALSE, 0);
setPrologFlag("verbose_file_search", FT_BOOL, FALSE, 0);
setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE,
ALLOW_VARNAME_FUNCTOR);
setPrologFlag("toplevel_var_size", FT_INTEGER, 1000);
setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0);
setPrologFlag("toplevel_prompt", FT_ATOM, "~m~d~l~! ?- ");
setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS);
setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
#ifdef __unix__
setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
setPrologFlag("tty_control", FT_BOOL,
truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
setPrologFlag("signals", FT_BOOL|FF_READONLY,
truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
setPrologFlag("readline", FT_BOOL/*|FF_READONLY*/, FALSE, 0);
#if defined(__WINDOWS__) && defined(_DEBUG)
setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug");
@ -1124,7 +1211,7 @@ initPrologFlags(void)
#ifndef __YAP_PROLOG__
static void
setArgvPrologFlag()
setArgvPrologFlag(void)
{ GET_LD
fid_t fid = PL_open_foreign_frame();
term_t e = PL_new_term_ref();
@ -1148,7 +1235,7 @@ setArgvPrologFlag()
#endif
static void
setTZPrologFlag()
setTZPrologFlag(void)
{ tzset();
setPrologFlag("timezone", FT_INTEGER|FF_READONLY, timezone);
@ -1166,7 +1253,7 @@ setVersionPrologFlag(void)
int patch = (PLVERSION%100);
if ( !PL_unify_term(t,
PL_FUNCTOR_CHARS, "swi", 4,
PL_FUNCTOR_CHARS, PLNAME, 4,
PL_INT, major,
PL_INT, minor,
PL_INT, patch,
@ -1179,6 +1266,19 @@ setVersionPrologFlag(void)
setGITVersion();
}
#endif /* YAP_PROLOG */
void
cleanupPrologFlags(void)
{ if ( GD->prolog_flag.table )
{ Table t = GD->prolog_flag.table;
GD->prolog_flag.table = NULL;
t->free_symbol = freeSymbolPrologFlagTable;
destroyHTable(t);
}
}
/*******************************
* PUBLISH PREDICATES *
*******************************/

73
os/pl-rl.c
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*/

521
os/pl-stream.c
View File

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2009, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,21 +18,21 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#if defined(__WINDOWS__)||defined(__WIN32)
#include <windows/uxnt.h>
#ifndef _YAP_NOT_INSTALLED_
#ifdef __WINDOWS__
#include "windows/uxnt.h"
#ifdef WIN64
#define MD "config/win64.h"
#include "config/win64.h"
#else
#define MD "config/win32.h"
#endif
#include "config/win32.h"
#endif
#include <winsock2.h>
#include "windows/mswchar.h"
#define CRLF_MAPPING 1
#else
#include <config.h>
#endif
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -48,12 +47,6 @@ recursive locks. If a stream handle might be known to another thread
locking is required.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifdef MD
#include MD
#else
#include <config.h>
#endif
#if _FILE_OFFSET_BITS == 64 || defined(_LARGE_FILES)
#define O_LARGEFILES 1 /* use for conditional code in Prolog */
#else
@ -62,8 +55,9 @@ locking is required.
#define PL_KERNEL 1
#include <wchar.h>
typedef wchar_t pl_wchar_t;
#define NEEDS_SWINSOCK
#include "SWI-Stream.h"
#include "SWI-Prolog.h"
#include "pl-utf8.h"
#include <sys/types.h>
#ifdef HAVE_SYS_TIME_H
@ -104,7 +98,7 @@ typedef wchar_t pl_wchar_t;
#endif
#define ROUND(p, n) ((((p) + (n) - 1) & ~((n) - 1)))
#define UNDO_SIZE ROUND(MB_LEN_MAX, sizeof(wchar_t))
#define UNDO_SIZE ROUND(PL_MB_LEN_MAX, sizeof(wchar_t))
#ifndef FALSE
#define FALSE 0
@ -127,7 +121,7 @@ static int S__seterror(IOSTREAM *s);
#ifdef O_PLMT
#define SLOCK(s) if ( s->mutex ) recursiveMutexLock(s->mutex)
#define SUNLOCK(s) if ( s->mutex ) recursiveMutexUnlock(s->mutex)
static inline int
inline int
STRYLOCK(IOSTREAM *s)
{ if ( s->mutex &&
recursiveMutexTryLock(s->mutex) == EBUSY )
@ -141,13 +135,9 @@ STRYLOCK(IOSTREAM *s)
#define STRYLOCK(s) (TRUE)
#endif
typedef void *record_t;
typedef void *Module;
typedef intptr_t term_t;
typedef intptr_t atom_t;
#include "pl-error.h"
extern int fatalError(const char *fm, ...);
extern int fatalError(const char *fm, ...);
extern int PL_handle_signals(void);
extern IOENC initEncoding(void);
extern int reportStreamError(IOSTREAM *s);
@ -368,6 +358,69 @@ Sunlock(IOSTREAM *s)
}
/*******************************
* TIMEOUT *
*******************************/
#ifdef HAVE_SELECT
#ifndef __WINDOWS__
typedef int SOCKET;
#define INVALID_SOCKET -1
#define Swinsock(s) Sfileno(s)
#define NFDS(n) (n+1)
#else
#define NFDS(n) (0) /* 1st arg of select is ignored */
#endif
static int
S__wait(IOSTREAM *s)
{ SOCKET fd = Swinsock(s);
fd_set wait;
struct timeval time;
int rc;
if ( fd == INVALID_SOCKET )
{ errno = EPERM; /* no permission to select */
s->flags |= SIO_FERR;
return -1;
}
time.tv_sec = s->timeout / 1000;
time.tv_usec = (s->timeout % 1000) * 1000;
FD_ZERO(&wait);
FD_SET(fd, &wait);
for(;;)
{ if ( (s->flags & SIO_INPUT) )
rc = select(NFDS(fd), &wait, NULL, NULL, &time);
else
rc = select(NFDS(fd), NULL, &wait, NULL, &time);
if ( rc < 0 && errno == EINTR )
{ if ( PL_handle_signals() < 0 )
{ errno = EPLEXCEPTION;
return -1;
}
continue;
}
break;
}
if ( rc == 0 )
{ s->flags |= (SIO_TIMEOUT|SIO_FERR);
return -1;
}
return 0; /* ok, data available */
}
#endif /*HAVE_SELECT*/
/*******************************
* FLUSH/FILL *
*******************************/
@ -385,7 +438,18 @@ S__flushbuf(IOSTREAM *s)
while ( from < to )
{ size_t size = (size_t)(to - from);
ssize_t n = (*s->functions->write)(s->handle, from, size);
ssize_t n;
#ifdef HAVE_SELECT
s->flags &= ~SIO_TIMEOUT;
if ( s->timeout >= 0 )
{ if ( (rc=S__wait(s)) < 0 )
goto partial;
}
#endif
n = (*s->functions->write)(s->handle, from, size);
if ( n > 0 ) /* wrote some */
{ from += n;
@ -398,6 +462,9 @@ S__flushbuf(IOSTREAM *s)
}
}
#ifdef HAVE_SELECT
partial:
#endif
if ( to == from ) /* full flush */
{ rc = s->bufp - s->buffer;
s->bufp = s->buffer;
@ -442,52 +509,6 @@ S__flushbufc(int c, IOSTREAM *s)
}
static int
Swait_for_data(IOSTREAM *s)
{ int fd = Sfileno(s);
fd_set wait;
struct timeval time;
int rc;
if ( fd < 0 )
{ errno = EPERM; /* no permission to select */
s->flags |= SIO_FERR;
return -1;
}
time.tv_sec = s->timeout / 1000;
time.tv_usec = (s->timeout % 1000) * 1000;
FD_ZERO(&wait);
#ifdef __WINDOWS__
FD_SET((SOCKET)fd, &wait);
#else
FD_SET(fd, &wait);
#endif
for(;;)
{ rc = select(fd+1, &wait, NULL, NULL, &time);
if ( rc < 0 && errno == EINTR )
{ if ( PL_handle_signals() < 0 )
{ errno = EPLEXCEPTION;
return -1;
}
continue;
}
break;
}
if ( rc == 0 )
{ s->flags |= (SIO_TIMEOUT|SIO_FERR);
return -1;
}
return 0; /* ok, data available */
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
S__fillbuf() fills the read-buffer, returning the first character of it.
It also realises the SWI-Prolog timeout facility.
@ -497,8 +518,11 @@ int
S__fillbuf(IOSTREAM *s)
{ int c;
if ( s->flags & (SIO_FEOF|SIO_FERR) )
{ s->flags |= SIO_FEOF2; /* reading past eof */
if ( s->flags & (SIO_FEOF|SIO_FERR) ) /* reading past eof */
{ if ( s->flags & SIO_FEOF2ERR )
s->flags |= (SIO_FEOF2|SIO_FERR);
else
s->flags |= SIO_FEOF2;
return -1;
}
@ -508,7 +532,7 @@ S__fillbuf(IOSTREAM *s)
if ( s->timeout >= 0 && !s->downstream )
{ int rc;
if ( (rc=Swait_for_data(s)) < 0 )
if ( (rc=S__wait(s)) < 0 )
return rc;
}
#endif
@ -517,7 +541,8 @@ S__fillbuf(IOSTREAM *s)
{ char chr;
ssize_t n;
if ( (n=(*s->functions->read)(s->handle, &chr, 1)) == 1 )
n = (*s->functions->read)(s->handle, &chr, 1);
if ( n == 1 )
{ c = char_to_int(chr);
return c;
} else if ( n == 0 )
@ -548,7 +573,8 @@ S__fillbuf(IOSTREAM *s)
len = s->bufsize;
}
if ( (n=(*s->functions->read)(s->handle, s->limitp, len)) > 0 )
n = (*s->functions->read)(s->handle, s->limitp, len);
if ( n > 0 )
{ s->limitp += n;
c = char_to_int(*s->bufp++);
return c;
@ -777,7 +803,7 @@ put_code(int c, IOSTREAM *s)
}
goto simple;
case ENC_ANSI:
{ char b[MB_LEN_MAX];
{ char b[PL_MB_LEN_MAX];
size_t n;
if ( !s->mbstate )
@ -863,7 +889,10 @@ Sputcode(int c, IOSTREAM *s)
if ( s->tee && s->tee->magic == SIO_MAGIC )
Sputcode(c, s->tee);
if ( c == '\n' && (s->flags&SIO_TEXT) && s->newline == SIO_NL_DOS )
if ( c == '\n' &&
(s->flags&SIO_TEXT) &&
s->newline == SIO_NL_DOS &&
s->lastc != '\r' )
{ if ( put_code('\r', s) < 0 )
return -1;
}
@ -886,7 +915,7 @@ Scanrepresent(int c, IOSTREAM *s)
return -1;
case ENC_ANSI:
{ mbstate_t state;
char b[MB_LEN_MAX];
char b[PL_MB_LEN_MAX];
memset(&state, 0, sizeof(state));
if ( wcrtomb(b, (wchar_t)c, &state) != (size_t)-1 )
@ -1072,14 +1101,15 @@ returns \n, but it returns the same for a single \n.
Often, we could keep track of bufp and reset this, but we must deal with
the case where we fetch a new buffer. In this case, we must copy the few
remaining bytes to the `unbuffer' area.
remaining bytes to the `unbuffer' area. If SIO_USERBUF is set, we do not
have this spare buffer space. This is used for reading from strings,
which cannot fetch a new buffer anyway.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
int
Speekcode(IOSTREAM *s)
{ int c;
char *start;
IOPOS *psave = s->position;
size_t safe = (size_t)-1;
if ( !s->buffer )
@ -1094,15 +1124,19 @@ Speekcode(IOSTREAM *s)
if ( (s->flags & SIO_FEOF) )
return -1;
if ( s->bufp + UNDO_SIZE > s->limitp )
if ( s->bufp + UNDO_SIZE > s->limitp && !(s->flags&SIO_USERBUF) )
{ safe = s->limitp - s->bufp;
memcpy(s->buffer-safe, s->bufp, safe);
}
start = s->bufp;
s->position = NULL;
c = Sgetcode(s);
s->position = psave;
if ( s->position )
{ IOPOS psave = *s->position;
c = Sgetcode(s);
*s->position = psave;
} else
{ c = Sgetcode(s);
}
if ( Sferror(s) )
return -1;
@ -1110,7 +1144,7 @@ Speekcode(IOSTREAM *s)
if ( s->bufp > start )
{ s->bufp = start;
} else
} else if ( c != -1 )
{ assert(safe != (size_t)-1);
s->bufp = s->buffer-safe;
}
@ -1341,10 +1375,6 @@ Sfeof(IOSTREAM *s)
return -1;
}
if ( s->downstream != NULL &&
Sfeof(s->downstream))
return TRUE;
if ( S__fillbuf(s) == -1 )
return TRUE;
@ -1440,6 +1470,11 @@ Ssetenc(IOSTREAM *s, IOENC enc, IOENC *old)
}
s->encoding = enc;
if ( enc == ENC_OCTET )
s->flags &= ~SIO_TEXT;
else
s->flags |= SIO_TEXT;
return 0;
}
@ -1490,23 +1525,23 @@ Sunit_size(IOSTREAM *s)
Return the size of the underlying data object. Should be optimized;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
long
int64_t
Ssize(IOSTREAM *s)
{ if ( s->functions->control )
{ long size;
{ int64_t size;
if ( (*s->functions->control)(s->handle, SIO_GETSIZE, (void *)&size) == 0 )
return size;
}
if ( s->functions->seek )
{ long here = Stell(s);
long end;
{ int64_t here = Stell64(s);
int64_t end;
if ( Sseek(s, 0, SIO_SEEK_END) == 0 )
end = Stell(s);
if ( Sseek64(s, 0, SIO_SEEK_END) == 0 )
end = Stell64(s);
else
end = -1;
Sseek(s, here, SIO_SEEK_SET);
Sseek64(s, here, SIO_SEEK_SET);
return end;
}
@ -1667,13 +1702,13 @@ unallocStream(IOSTREAM *s)
#ifdef O_PLMT
if ( s->mutex )
{ recursiveMutexDelete(s->mutex);
free(s->mutex);
PL_free(s->mutex);
s->mutex = NULL;
}
#endif
if ( !(s->flags & SIO_STATIC) )
free(s);
PL_free(s);
}
@ -1711,7 +1746,7 @@ Sclose(IOSTREAM *s)
#ifdef __WINDOWS__
if ( (s->flags & SIO_ADVLOCK) )
{ OVERLAPPED ov;
HANDLE h = (HANDLE)_get_osfhandle((int)s->handle);
HANDLE h = (HANDLE)_get_osfhandle((int)((uintptr_t)s->handle));
memset(&ov, 0, sizeof(ov));
UnlockFileEx(h, 0, 0, 0xffffffff, &ov);
@ -1732,9 +1767,9 @@ Sclose(IOSTREAM *s)
if ( rval < 0 )
reportStreamError(s);
run_close_hooks(s); /* deletes Prolog registration */
s->magic = SIO_CMAGIC;
SUNLOCK(s);
s->magic = SIO_CMAGIC;
if ( s->message )
free(s->message);
if ( s->references == 0 )
@ -1845,11 +1880,23 @@ Svprintf(const char *fm, va_list args)
}
#define NEXTCHR(s, c) if ( utf8 ) \
{ (s) = utf8_get_char((s), &(c)); \
} else \
{ c = *(s)++; c &= 0xff; \
}
#define NEXTCHR(s, c) \
switch (enc) \
{ case ENC_ANSI: \
c = *(s)++; c &= 0xff; \
break; \
case ENC_UTF8: \
(s) = utf8_get_char((s), &(c)); \
break; \
case ENC_WCHAR: \
{ wchar_t *_w = (wchar_t*)(s); \
c = *_w++; \
(s) = (char*)_w; \
break; \
} \
default: \
break; \
}
#define OUTCHR(s, c) do { printed++; \
if ( Sputcode((c), (s)) < 0 ) goto error; \
@ -1911,7 +1958,7 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
char fbuf[100], *fs = fbuf, *fe = fbuf;
int islong = 0;
int pad = ' ';
int utf8 = FALSE;
IOENC enc = ENC_ANSI;
for(;;)
{ switch(*fm)
@ -1952,13 +1999,19 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
{ islong++; /* 1: %ld */
fm++;
}
if ( *fm == 'l' )
{ islong++; /* 2: %lld */
fm++;
}
if ( *fm == 'U' ) /* %Us: UTF-8 string */
{ utf8 = TRUE;
fm++;
switch ( *fm )
{ case 'l':
islong++; /* 2: %lld */
fm++;
break;
case 'U': /* %Us: UTF-8 string */
enc = ENC_UTF8;
fm++;
break;
case 'W': /* %Ws: wide string */
enc = ENC_WCHAR;
fm++;
break;
}
switch(*fm)
@ -1983,41 +2036,53 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
case 'u':
case 'x':
case 'X':
{ intptr_t v = 0; /* make compiler silent */
int64_t vl = 0;
{ int vi = 0;
long vl = 0; /* make compiler silent */
int64_t vll = 0;
char fmbuf[8], *fp=fmbuf;
switch( islong )
{ case 0:
v = va_arg(args, int);
vi = va_arg(args, int);
break;
case 1:
v = va_arg(args, long);
vl = va_arg(args, long);
break;
case 2:
vl = va_arg(args, int64_t);
vll = va_arg(args, int64_t);
break;
default:
assert(0);
}
*fp++ = '%';
if ( modified )
*fp++ = '#';
*fp++ = 'l';
if ( islong < 2 )
{ *fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, v);
} else
{
switch( islong )
{ case 0:
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vi);
break;
case 1:
*fp++ = 'l';
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vl);
break;
case 2:
#ifdef __WINDOWS__
strcat(fp-1, "I64"); /* Synchronise with INT64_FORMAT! */
fp += strlen(fp);
*fp++ = 'I'; /* Synchronise with INT64_FORMAT! */
*fp++ = '6';
*fp++ = '4';
#else
*fp++ = 'l';
*fp++ = 'l';
*fp++ = 'l';
#endif
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vl);
*fp++ = *fm;
*fp = '\0';
SNPRINTF3(fmbuf, vll);
break;
}
break;
@ -2075,12 +2140,25 @@ Svfprintf(IOSTREAM *s, const char *fm, va_list args)
{ size_t w;
if ( fs == fbuf )
w = fe - fs;
else
w = strlen(fs);
if ( utf8 )
w = utf8_strlen(fs, w);
{ w = fe - fs;
} else
{ switch(enc)
{ case ENC_ANSI:
w = strlen(fs);
break;
case ENC_UTF8:
w = strlen(fs);
w = utf8_strlen(fs, w);
break;
case ENC_WCHAR:
w = wcslen((wchar_t*)fs);
break;
default:
assert(0);
w = 0; /* make compiler happy */
break;
}
}
if ( (ssize_t)w < arg1 )
{ w = arg1 - w;
@ -2609,7 +2687,7 @@ Scontrol_file(void *handle, int action, void *arg)
switch(action)
{ case SIO_GETSIZE:
{ intptr_t *rval = arg;
{ int64_t *rval = arg;
struct stat buf;
if ( fstat(fd, &buf) == 0 )
@ -2621,6 +2699,11 @@ Scontrol_file(void *handle, int action, void *arg)
case SIO_SETENCODING:
case SIO_FLUSHOUTPUT:
return 0;
case SIO_GETFILENO:
{ int *p = arg;
*p = fd;
return 0;
}
default:
return -1;
}
@ -2662,13 +2745,20 @@ provide the socket-id through Sfileno, this code crashes on
tcp_open_socket(). As ttys and its detection is of no value on Windows
anyway, we skip this. Second, Windows doesn't have fork(), so FD_CLOEXEC
is of no value.
For now, we use PL_malloc_uncollectable(). In the end, this is really
one of the object-types we want to leave to GC.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef FD_CLOEXEC /* This is not defined in MacOS */
#define FD_CLOEXEC 1
#endif
IOSTREAM *
Snew(void *handle, int flags, IOFUNCTIONS *functions)
{ IOSTREAM *s;
if ( !(s = malloc(sizeof(IOSTREAM))) )
if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) )
{ errno = ENOMEM;
return NULL;
}
@ -2680,7 +2770,11 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
s->functions = functions;
s->timeout = -1; /* infinite */
s->posbuf.lineno = 1;
s->encoding = ENC_ISO_LATIN_1;
if ( (flags&SIO_TEXT) )
{ s->encoding = initEncoding();
} else
{ s->encoding = ENC_OCTET;
}
#if CRLF_MAPPING
s->newline = SIO_NL_DOS;
#endif
@ -2688,8 +2782,8 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
s->position = &s->posbuf;
#ifdef O_PLMT
if ( !(flags & SIO_NOMUTEX) )
{ if ( !(s->mutex = malloc(sizeof(recursiveMutex))) )
{ free(s);
{ if ( !(s->mutex = PL_malloc(sizeof(recursiveMutex))) )
{ PL_free(s);
return NULL;
}
recursiveMutexInit(s->mutex);
@ -2701,7 +2795,7 @@ Snew(void *handle, int flags, IOFUNCTIONS *functions)
if ( (fd = Sfileno(s)) >= 0 )
{ if ( isatty(fd) )
s->flags |= SIO_ISATTY;
#if defined(F_SETFD) && defined(FD_CLOEXEC)
#ifdef F_SETFD
fcntl(fd, F_SETFD, FD_CLOEXEC);
#endif
}
@ -2804,13 +2898,23 @@ Sopen_file(const char *path, const char *how)
struct flock buf;
memset(&buf, 0, sizeof(buf));
buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK);
buf.l_whence = SEEK_SET;
buf.l_type = (lock == lread ? F_RDLCK : F_WRLCK);
if ( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) < 0 )
{ int save = errno;
close(fd);
errno = save;
return NULL;
while( fcntl(fd, wait ? F_SETLKW : F_SETLK, &buf) != 0 )
{ if ( errno == EINTR )
{ if ( PL_handle_signals() < 0 )
{ close(fd);
return NULL;
}
continue;
} else
{ int save = errno;
close(fd);
errno = save;
return NULL;
}
}
#else /* we don't have locking */
#if __WINDOWS__
@ -2891,12 +2995,10 @@ Sfileno(IOSTREAM *s)
if ( s->flags & SIO_FILE )
{ intptr_t h = (intptr_t)s->handle;
n = (int)h;
} else if ( s->flags & SIO_PIPE )
{ n = fileno((FILE *)s->handle);
} else if ( s->functions->control &&
(*s->functions->control)(s->handle,
SIO_GETFILENO,
(void *)&n) == 0 )
(void *)&n) == 0 )
{ ;
} else
{ errno = EINVAL;
@ -2907,6 +3009,30 @@ Sfileno(IOSTREAM *s)
}
#ifdef __WINDOWS__
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
On Windows, type SOCKET is an unsigned int and all values
[0..INVALID_SOCKET) are valid. It is also not allowed to run normal
file-functions on it or the application will crash. There seems to be no
way out except for introducing an extra function at this level :-(
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
SOCKET
Swinsock(IOSTREAM *s)
{ SOCKET n = INVALID_SOCKET;
if ( s->functions->control &&
(*s->functions->control)(s->handle,
SIO_GETWINSOCK,
(void *)&n) == 0 )
{ return n;
}
errno = EINVAL;
return INVALID_SOCKET;
}
#endif
/*******************************
* PIPES *
*******************************/
@ -2915,13 +3041,9 @@ Sfileno(IOSTREAM *s)
#ifdef __WINDOWS__
#include "windows/popen.c"
#ifdef popen
#undef popen
#endif
#define popen(cmd, how) pt_popen(cmd, how)
#ifdef pclose
#undef pclose
#endif
#define popen(cmd, how) pt_popen(cmd, how)
#define pclose(fd) pt_pclose(fd)
#endif
@ -2958,11 +3080,31 @@ Sclose_pipe(void *handle)
}
static int
Scontrol_pipe(void *handle, int action, void *arg)
{ FILE *fp = handle;
switch(action)
{ case SIO_GETFILENO:
{ int *ap = arg;
*ap = fileno(fp);
return 0;
}
case SIO_FLUSHOUTPUT:
case SIO_SETENCODING:
return 0;
default:
return -1;
}
}
IOFUNCTIONS Spipefunctions =
{ Sread_pipe,
Swrite_pipe,
(Sseek_function)0,
Sclose_pipe
Sclose_pipe,
Scontrol_pipe
};
@ -2983,9 +3125,9 @@ Sopen_pipe(const char *command, const char *type)
{ int flags;
if ( *type == 'r' )
flags = SIO_PIPE|SIO_INPUT|SIO_FBUF;
flags = SIO_INPUT|SIO_FBUF;
else
flags = SIO_PIPE|SIO_OUTPUT|SIO_FBUF;
flags = SIO_OUTPUT|SIO_FBUF;
return Snew((void *)fd, flags, &Spipefunctions);
}
@ -3229,12 +3371,20 @@ Sopenmem(char **buffer, size_t *sizep, const char *mode)
static ssize_t
Sread_string(void *handle, char *buf, size_t size)
{ return 0; /* signal EOF */
{ (void)handle;
(void)buf;
(void)size;
return 0; /* signal EOF */
}
static ssize_t
Swrite_string(void *handle, char *buf, size_t size)
{ errno = ENOSPC; /* signal error */
{ (void)handle;
(void)buf;
(void)size;
errno = ENOSPC; /* signal error */
return -1;
}
@ -3267,7 +3417,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
{ int flags = SIO_FBUF|SIO_USERBUF;
if ( !s )
{ if ( !(s = malloc(sizeof(IOSTREAM))) )
{ if ( !(s = PL_malloc_uncollectable(sizeof(IOSTREAM))) ) /* TBD: Use GC */
{ errno = ENOMEM;
return NULL;
}
@ -3310,7 +3460,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
#define STDIO(n, f) { NULL, NULL, NULL, NULL, \
EOF, SIO_MAGIC, 0, f, {0, 0, 0}, NULL, \
((void *)(n)), &Sttyfunctions, \
(void *)(n), &Sttyfunctions, \
0, NULL, \
(void (*)(void *))0, NULL, \
-1, \
@ -3321,7 +3471,7 @@ Sopen_string(IOSTREAM *s, char *buf, size_t size, const char *mode)
#define SIO_STDIO (SIO_FILE|SIO_STATIC|SIO_NOCLOSE|SIO_ISATTY|SIO_TEXT)
#define STDIO_STREAMS \
STDIO(0, SIO_STDIO|SIO_LBUF|SIO_INPUT|SIO_NOFEOF), /* Sinput */ \
STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), /* Soutput */ \
STDIO(1, SIO_STDIO|SIO_LBUF|SIO_OUTPUT|SIO_REPPL), /* Soutput */ \
STDIO(2, SIO_STDIO|SIO_NBUF|SIO_OUTPUT|SIO_REPPL) /* Serror */
@ -3335,31 +3485,33 @@ static const IOSTREAM S__iob0[] =
};
/* vsc: Scleanup should reset init done */
static int done;
static int S__initialised = FALSE;
void
SinitStreams(void)
{
if ( !done++ )
{ if ( !S__initialised )
{ int i;
IOENC enc = initEncoding();
IOENC enc;
S__initialised = TRUE;
enc = initEncoding();
for(i=0; i<=2; i++)
{ if ( !isatty(i) )
{ S__iob[i].flags &= ~SIO_ISATTY;
S__iob[i].functions = &Sfilefunctions; /* Check for pipe? */
{ IOSTREAM *s = &S__iob[i];
if ( !isatty(i) )
{ s->flags &= ~SIO_ISATTY;
s->functions = &Sfilefunctions; /* Check for pipe? */
}
if ( S__iob[i].encoding == ENC_ISO_LATIN_1 )
S__iob[i].encoding = enc;
if ( s->encoding == ENC_ISO_LATIN_1 )
s->encoding = enc;
#ifdef O_PLMT
S__iob[i].mutex = malloc(sizeof(recursiveMutex));
recursiveMutexInit(S__iob[i].mutex);
s->mutex = PL_malloc(sizeof(recursiveMutex));
recursiveMutexInit(s->mutex);
#endif
#if CRLF_MAPPING
_setmode(i, O_BINARY);
S__iob[i].newline = SIO_NL_DOS;
s->newline = SIO_NL_DOS;
#endif
}
@ -3461,11 +3613,12 @@ Scleanup(void)
S__iob[i].mutex = NULL;
recursiveMutexDelete(m);
free(m);
PL_free(m);
}
#endif
*s = S__iob0[i]; /* re-initialise */
}
done = 0;
S__initialised = FALSE;
}

48
os/pl-string.c
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
*/
#include "pl-incl.h"
@ -34,45 +34,10 @@ String operations that are needed for the shared IO library.
* ALLOCATION *
*******************************/
#ifdef O_DEBUG
#define CHAR_INUSE 0x42
#define CHAR_FREED 0x41
char *
store_string(const char *s)
{ if ( s )
{ GET_LD
char *copy = (char *)allocHeap(strlen(s)+2);
*copy++ = CHAR_INUSE;
strcpy(copy, s);
return copy;
} else
{ return NULL;
}
}
void
remove_string(char *s)
{ if ( s )
{ GET_LD
assert(s[-1] == CHAR_INUSE);
s[-1] = CHAR_FREED;
freeHeap(s-1, strlen(s)+2);
}
}
#else /*O_DEBUG*/
char *
store_string(const char *s)
{ if ( s )
{ GET_LD
char *copy = (char *)allocHeap(strlen(s)+1);
{ char *copy = (char *)allocHeapOrHalt(strlen(s)+1);
strcpy(copy, s);
return copy;
@ -85,14 +50,9 @@ store_string(const char *s)
void
remove_string(char *s)
{ if ( s )
{ GET_LD
freeHeap(s, strlen(s)+1);
}
}
#endif /*O_DEBUG*/
/*******************************
* NUMBERS *
*******************************/
@ -239,13 +199,13 @@ int_mbscoll(const char *s1, const char *s2, int icase)
if ( l1 < 1024 && (w1 = alloca(sizeof(wchar_t)*(l1+1))) )
{ ml1 = FALSE;
} else
{ w1 = PL_malloc(sizeof(wchar_t)*(l1+1));
{ w1 = PL_malloc_atomic(sizeof(wchar_t)*(l1+1));
ml1 = TRUE;
}
if ( l2 < 1024 && (w2 = alloca(sizeof(wchar_t)*(l2+1))) )
{ ml2 = FALSE;
} else
{ w2 = PL_malloc(sizeof(wchar_t)*(l2+1));
{ w2 = PL_malloc_atomic(sizeof(wchar_t)*(l2+1));
ml2 = TRUE;
}

4
os/pl-string.h
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_STRING_H_INCLUDED
@ -27,7 +27,7 @@
COMMON(char *) store_string(const char *s);
COMMON(void) remove_string(char *s);
COMMON(char) digitName(int n, int smll);
COMMON(char) digitName(int n, int small);
COMMON(int) digitValue(int b, int c);
COMMON(bool) strprefix(const char *string, const char *prefix);
COMMON(bool) strpostfix(const char *string, const char *postfix);

172
os/pl-table.c
View File

@ -1,11 +1,10 @@
/* $Id$
Part of SWI-Prolog
/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
Copyright (C): 1985-2012, University of Amsterdam
VU University Amsterdam
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
@ -19,7 +18,7 @@
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
/*#define O_DEBUG 1*/
@ -41,35 +40,35 @@ create, advance over and destroy enumerator objects. These objects are
used to enumerate the symbols of these tables, used primarily for the
pl_current_* predicates.
The enumerators cause two things: (1) as intptr_t enumerators are
The enumerators cause two things: (1) as long as enumerators are
associated, the table will not be rehashed and (2) if symbols are
deleted that are referenced by an enumerator, the enumerator is
automatically advanced to the next free symbol. This, in general, makes
automatically advanced to the next free symbol. This, in general, makes
the enumeration of hash-tables safe.
TODO: abort should delete any pending enumerators. This should be
thread-local, as thread_exit/1 should do the same.
TBD: Resizing hash-tables causes major headaches for concurrent access.
We can avoid this by using a dynamic array for the list of hash-entries.
Ongoing work in the RDF store shows hash-tables that can handle
concurrent lock-free access.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
allocHTableEntries(Table ht)
{ GET_LD
int n;
static Symbol *
allocHTableEntries(int buckets)
{ size_t bytes = buckets * sizeof(Symbol);
Symbol *p;
ht->entries = allocHeap(ht->buckets * sizeof(Symbol));
p = allocHeapOrHalt(bytes);
memset(p, 0, bytes);
for(n=0, p = &ht->entries[0]; n < ht->buckets; n++, p++)
*p = NULL;
return p;
}
Table
newHTable(int buckets)
{ GET_LD
Table ht;
{ Table ht;
ht = allocHeap(sizeof(struct table));
ht = allocHeapOrHalt(sizeof(struct table));
ht->buckets = (buckets & ~TABLE_MASK);
ht->size = 0;
ht->enumerators = NULL;
@ -79,25 +78,24 @@ newHTable(int buckets)
if ( (buckets & TABLE_UNLOCKED) )
ht->mutex = NULL;
else
{ ht->mutex = allocHeap(sizeof(simpleMutex));
{ ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
allocHTableEntries(ht);
ht->entries = allocHTableEntries(ht->buckets);
return ht;
}
void
destroyHTable(Table ht)
{ GET_LD
{
#ifdef O_PLMT
if ( ht->mutex )
{ simpleMutexDelete(ht->mutex);
freeHeap(ht->mutex, sizeof(*ht->mutex));
ht->mutex = NULL;
ht->mutex = NULL;
}
#endif
@ -107,19 +105,19 @@ destroyHTable(Table ht)
}
#if O_DEBUG || O_HASHSTAT
#define HASHSTAT(c) c
#if O_DEBUG
static int lookups;
static int cmps;
void
exitTables(int status, void *arg)
{ Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
{ (void)status;
(void)arg;
Sdprintf("hashstat: Anonymous tables: %d lookups using %d compares\n",
lookups, cmps);
}
#else
#define HASHSTAT(c)
#endif /*O_DEBUG*/
#endif
void
@ -129,7 +127,7 @@ initTables(void)
if ( !done )
{ done = TRUE;
HASHSTAT(PL_on_halt(exitTables, NULL));
DEBUG(MSG_HASH_STAT, PL_on_halt(exitTables, NULL));
}
}
@ -138,9 +136,9 @@ Symbol
lookupHTable(Table ht, void *name)
{ Symbol s = ht->entries[pointerHashValue(name, ht->buckets)];
HASHSTAT(lookups++);
DEBUG(MSG_HASH_STAT, lookups++);
for( ; s; s = s->next)
{ HASHSTAT(cmps++);
{ DEBUG(MSG_HASH_STAT, cmps++);
if ( s->name == name )
return s;
}
@ -170,41 +168,75 @@ checkHTable(Table ht)
/* MT: Locked by calling addHTable()
*/
static void
rehashHTable(Table ht)
{ GET_LD
Symbol *oldtab;
int oldbucks;
int i;
static Symbol
rehashHTable(Table ht, Symbol map)
{ Symbol *newentries, *oldentries;
int newbuckets, oldbuckets;
int i;
int safe_copy = (ht->mutex != NULL);
oldtab = ht->entries;
oldbucks = ht->buckets;
ht->buckets *= 2;
allocHTableEntries(ht);
newbuckets = ht->buckets*2;
newentries = allocHTableEntries(newbuckets);
DEBUG(1, Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
DEBUG(MSG_HASH_STAT,
Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
for(i=0; i<oldbucks; i++)
for(i=0; i<ht->buckets; i++)
{ Symbol s, n;
for(s=oldtab[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, ht->buckets);
if ( safe_copy )
{ for(s=ht->entries[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, newbuckets);
Symbol s2 = allocHeapOrHalt(sizeof(*s2));
n = s->next;
s->next = ht->entries[v];
ht->entries[v] = s;
n = s->next;
if ( s == map )
map = s2;
*s2 = *s;
s2->next = newentries[v];
newentries[v] = s2;
}
} else
{ for(s=ht->entries[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, newbuckets);
n = s->next;
s->next = newentries[v];
newentries[v] = s;
}
}
}
freeHeap(oldtab, oldbucks * sizeof(Symbol));
DEBUG(0, checkHTable(ht));
oldentries = ht->entries;
oldbuckets = ht->buckets;
ht->entries = newentries;
ht->buckets = newbuckets;
if ( safe_copy )
{ /* Here we should be waiting until */
/* active lookup are finished */
for(i=0; i<oldbuckets; i++)
{ Symbol s, n;
for(s=oldentries[i]; s; s = n)
{ n = s->next;
s->next = NULL; /* that causes old readers to stop */
freeHeap(s, sizeof(*s));
}
}
}
freeHeap(oldentries, oldbuckets * sizeof(Symbol));
DEBUG(CHK_SECURE, checkHTable(ht));
return map;
}
Symbol
addHTable(Table ht, void *name, void *value)
{ GET_LD
Symbol s;
{ Symbol s;
int v;
LOCK_TABLE(ht);
@ -213,7 +245,7 @@ addHTable(Table ht, void *name, void *value)
{ UNLOCK_TABLE(ht);
return NULL;
}
s = allocHeap(sizeof(struct symbol));
s = allocHeapOrHalt(sizeof(struct symbol));
s->name = name;
s->value = value;
s->next = ht->entries[v];
@ -223,7 +255,7 @@ addHTable(Table ht, void *name, void *value)
ht, name, value, ht->size));
if ( ht->buckets * 2 < ht->size && !ht->enumerators )
rehashHTable(ht);
s = rehashHTable(ht, s);
UNLOCK_TABLE(ht);
DEBUG(1, checkHTable(ht));
@ -237,8 +269,7 @@ Note: s must be in the table!
void
deleteSymbolHTable(Table ht, Symbol s)
{ GET_LD
int v;
{ int v;
Symbol *h;
TableEnum e;
@ -255,6 +286,9 @@ deleteSymbolHTable(Table ht, Symbol s)
{ if ( *h == s )
{ *h = (*h)->next;
s->next = NULL; /* force crash */
s->name = NULL;
s->value = NULL;
freeHeap(s, sizeof(struct symbol));
ht->size--;
@ -268,8 +302,7 @@ deleteSymbolHTable(Table ht, Symbol s)
void
clearHTable(Table ht)
{ GET_LD
int n;
{ int n;
TableEnum e;
LOCK_TABLE(ht);
@ -309,24 +342,23 @@ Table copyHTable(Table org)
Table
copyHTable(Table org)
{ GET_LD
Table ht;
{ Table ht;
int n;
ht = allocHeap(sizeof(struct table));
ht = allocHeapOrHalt(sizeof(struct table));
LOCK_TABLE(org);
*ht = *org; /* copy all attributes */
#ifdef O_PLMT
ht->mutex = NULL;
#endif
allocHTableEntries(ht);
ht->entries = allocHTableEntries(ht->buckets);
for(n=0; n < ht->buckets; n++)
{ Symbol s, *q;
q = &ht->entries[n];
for(s = org->entries[n]; s; s = s->next)
{ Symbol s2 = allocHeap(sizeof(*s2));
{ Symbol s2 = allocHeapOrHalt(sizeof(*s2));
*q = s2;
q = &s2->next;
@ -340,7 +372,7 @@ copyHTable(Table org)
}
#ifdef O_PLMT
if ( org->mutex )
{ ht->mutex = allocHeap(sizeof(simpleMutex));
{ ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
@ -356,8 +388,7 @@ copyHTable(Table org)
TableEnum
newTableEnum(Table ht)
{ GET_LD
TableEnum e = allocHeap(sizeof(struct table_enum));
{ TableEnum e = allocHeapOrHalt(sizeof(struct table_enum));
Symbol n;
LOCK_TABLE(ht);
@ -378,8 +409,7 @@ newTableEnum(Table ht)
void
freeTableEnum(TableEnum e)
{ GET_LD
TableEnum *ep;
{ TableEnum *ep;
Table ht;
if ( !e )

2
os/pl-utf8.c
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
*/
#include <string.h> /* get size_t */

4
os/pl-utf8.h
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)