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

SWI update

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-01-16 11:28:58 +00:00
parent 0eacb68907
commit abe6621495
11 changed files with 711 additions and 445 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

7
H/pl-incl.h
View File

@ -468,9 +468,6 @@ typedef struct
#define FT_FROM_VALUE 0x0f /* Determine type from value */
#define FT_MASK 0x0f /* mask to get type */
#define FF_READONLY 0x10 /* feature is read-only */
#define FF_KEEP 0x20 /* keep value it already set */
#define PLFLAG_CHARESCAPE 0x000001 /* handle \ in atoms */
#define PLFLAG_GC 0x000002 /* do GC */
#define PLFLAG_TRACE_GC 0x000004 /* verbose gc */
@ -540,6 +537,7 @@ typedef enum
#define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM)
#define PL_malloc_atomic malloc
/* vsc: global variables */
#include "pl-global.h"
@ -702,6 +700,7 @@ extern int PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_atomic(term_t t, PL_atomic_t a);
extern int _PL_unify_string(term_t t, word w);
#define _PL_get_arg(X,Y,Z) PL_get_arg(X,Y,Z)
extern IOSTREAM ** /* provide access to Suser_input, */
@ -911,7 +910,7 @@ COMMON(Buffer) codes_or_chars_to_buffer(term_t l, unsigned int flags,
COMMON(bool) systemMode(bool accept);
COMMON(void) initPrologFlagTable(void);
COMMON(void) cleanupPrologFlags(void);
COMMON(void) initPrologFlags(void);
COMMON(int) raiseStackOverflow(int overflow);

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

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;

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

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