update PLStream to more recent version of SWI.

This commit is contained in:
Vitor Santos Costa 2010-02-22 09:35:47 +00:00
parent 4fda6b7488
commit 4a53759fc1
12 changed files with 545 additions and 292 deletions

View File

@ -46,7 +46,7 @@ HEADERS=$(srcdir)/atoms.h $(srcdir)/pl-buffer.h $(srcdir)/pl-ctype.h \
$(srcdir)/pl-text.h $(srcdir)/pl-utf8.h \
$(srcdir)/pl-yap.h @ENABLE_WINCONSOLE@ $(srcdir)/uxnt/dirent.h $(srcdir)/uxnt/utf8.h $(srcdir)/pl-utf8.c $(srcdir)/uxnt/uxnt.h
C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-error.c $(srcdir)/pl-feature.c \
$(srcdir)/pl-error.c \
$(srcdir)/pl-file.c $(srcdir)/pl-files.c $(srcdir)/pl-os.c \
$(srcdir)/pl-privitf.c \
$(srcdir)/pl-stream.c $(srcdir)/pl-string.c \
@ -54,7 +54,7 @@ C_SOURCES=$(srcdir)/pl-buffer.c $(srcdir)/pl-ctype.c \
$(srcdir)/pl-text.c \
$(srcdir)/pl-utils.c \
$(srcdir)/pl-yap.c @ENABLE_WINCONSOLE@ $(srcdir)/popen.c $(srcdir)/uxnt/uxnt.c
OBJS=pl-buffer.o pl-ctype.o pl-error.o pl-feature.o \
OBJS=pl-buffer.o pl-ctype.o pl-error.o \
pl-file.o pl-files.o pl-os.o pl-privitf.o \
pl-stream.o pl-string.o pl-table.o \
pl-text.o pl-utils.o pl-utf8.o \

View File

@ -504,6 +504,7 @@
#define ATOM_term_position MK_ATOM("term_position")
#define ATOM_terminal MK_ATOM("terminal")
#define ATOM_terminal_capability MK_ATOM("terminal_capability")
#define ATOM_temporary_files MK_ATOM("temporary_files")
#define ATOM_text MK_ATOM("text")
#define ATOM_thread MK_ATOM("thread")
#define ATOM_thread_cputime MK_ATOM("thread_cputime")

View File

@ -298,7 +298,8 @@ unify_char_type(term_t type, const char_type *ct, int context, int how)
static foreign_t
do_char_type(term_t chr, term_t class, control_t h, int how)
{ generator *gen;
{ GET_LD
generator *gen;
fid_t fid;
switch( ForeignControl(h) )
@ -399,7 +400,9 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
succeed;
}
fid = PL_open_foreign_frame();
if ( !(fid = PL_open_foreign_frame()) )
goto error;
for(;;)
{ int rval;
@ -412,7 +415,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
{ if ( rval < 0 ||
!unify_char_type(class, gen->class, rval, how) )
goto next;
} else if ( gen->do_enum & ENUM_CLASS )
{ if ( !unify_char_type(class, gen->class, rval, how) )
goto next;
@ -432,6 +435,7 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
break;
}
error:
freeHeap(gen, sizeof(*gen));
fail;
}
@ -440,13 +444,13 @@ do_char_type(term_t chr, term_t class, control_t h, int how)
static
PRED_IMPL("char_type", 2, char_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CHAR_MODE);
{ return do_char_type(A1, A2, PL__ctx, PL_CHAR);
}
static
PRED_IMPL("code_type", 2, code_type, PL_FA_NONDETERMINISTIC)
{ return do_char_type(A1, A2, PL__ctx, CODE_MODE);
{ return do_char_type(A1, A2, PL__ctx, PL_CODE);
}
@ -513,7 +517,8 @@ get_chr_from_text(const PL_chars_t *t, size_t index)
static foreign_t
modify_case_atom(term_t in, term_t out, int down)
{ PL_chars_t tin, tout;
{ GET_LD
PL_chars_t tin, tout;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE;
@ -578,7 +583,7 @@ modify_case_atom(term_t in, term_t out, int down)
{ tout.text.t[i] = (char)c;
}
}
}
}
} else
{ if ( down )
{ for(i=0; i<tin.length; i++)
@ -619,7 +624,8 @@ PRED_IMPL("upcase_atom", 2, upcase_atom, 0)
static int
write_normalize_space(IOSTREAM *out, term_t in)
{ PL_chars_t tin;
{ GET_LD
PL_chars_t tin;
size_t i, end;
if ( !PL_get_text(in, &tin, CVT_ATOMIC|CVT_EXCEPTION) )
@ -655,18 +661,12 @@ PRED_IMPL("normalize_space", 2, normalize_space, 0)
{ redir_context ctx;
word rc;
EXCEPTION_GUARDED(/*code*/
if ( setupOutputRedirect(A1, &ctx, FALSE) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
} else
rc = FALSE;
/*cleanup*/,
DEBUG(1, Sdprintf("Cleanup after throw()\n"));
discardOutputRedirect(&ctx);
rc = PL_rethrow(););
if ( (rc = setupOutputRedirect(A1, &ctx, FALSE)) )
{ if ( (rc = write_normalize_space(ctx.stream, A2)) )
rc = closeOutputRedirect(&ctx);
else
discardOutputRedirect(&ctx);
}
return rc;
}
@ -730,7 +730,8 @@ static lccat lccats[] =
static
PRED_IMPL("setlocale", 3, setlocale, 0)
{ char *what;
{ PRED_LD
char *what;
char *locale;
const lccat *lcp;
@ -794,28 +795,28 @@ EndPredDefs
const char _PL_char_types[] = {
/* ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O 0-15 */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_ 16-31 */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* sp ! " # $ % & ' ( ) * + , - . / 32-47 */
SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY,
SP, SO, DQ, SY, SY, SO, SY, SQ, PU, PU, SY, SY, PU, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? 48-63 */
DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY,
DI, DI, DI, DI, DI, DI, DI, DI, DI, DI, SY, SO, SY, SY, SY, SY,
/* @ A B C D E F G H I J K L M N O 64-79 */
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
SY, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
/* P Q R S T U V W X Y Z [ \ ] ^ _ 80-95 */
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, PU, SY, PU, SY, UC,
/* ` a b c d e f g h i j k l m n o 96-111 */
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
SY, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
/* p q r s t u v w x y z { | } ~ ^? 112-127 */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, PU, PU, PU, SY, CT,
/* 128-159 (C1 controls) */
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT, CT,
/* 160-255 (G1 graphics) */
/* ISO Latin 1 is assumed */
SP, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
SO, SO, SO, SO, SO, SO, SO, SO, SO, SO, LC, SO, SO, SO, SO, SO,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC, SO, UC, UC, UC, UC, UC, UC, UC, LC,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
@ -840,7 +841,9 @@ static const enc_map map[] =
IOENC
initEncoding(void)
{ if ( LD )
{ GET_LD
if ( LD )
{ if ( !LD->encoding )
{ char *enc;
@ -882,7 +885,8 @@ initCharTypes(void)
#if __SWI_PROLOG__
bool
systemMode(bool accept)
{ bool old = SYSTEM_MODE ? TRUE : FALSE;
{ GET_LD
bool old = SYSTEM_MODE ? TRUE : FALSE;
if ( accept )
debugstatus.styleCheck |= DOLLAR_STYLE;

View File

@ -1,10 +0,0 @@
int defFeature(const char *c, int f, ...) {
/**** add extra flags to engine: nowadays PL_set_prolog_flag */
return 0;
}
int trueFeature(int f) {
/**** define whether the feature is set or not */
return 0;
}

View File

@ -69,7 +69,7 @@ handling times must be cleaned, but that not only holds for this module.
#undef LD /* fetch LD once per function */
#define LD LOCAL_LD
static int bad_encoding(atom_t name);
static int bad_encoding(const char *msg, atom_t name);
static int noprotocol(void);
static int streamStatus(IOSTREAM *s);
@ -261,9 +261,13 @@ freeStream(IOSTREAM *s)
if ( (symb=lookupHTable(streamContext, s)) )
{ stream_context *ctx = symb->value;
if ( ctx->filename == source_file_name )
{ source_file_name = NULL_ATOM; /* TBD: pop? */
source_line_no = -1;
if ( ctx->filename != NULL_ATOM )
{ PL_unregister_atom(ctx->filename);
if ( ctx->filename == source_file_name )
{ source_file_name = NULL_ATOM; /* TBD: pop? */
source_line_no = -1;
}
}
freeHeap(ctx, sizeof(*ctx));
@ -289,10 +293,18 @@ freeStream(IOSTREAM *s)
/* MT: locked by caller (openStream()) */
/* name must be registered by the caller */
static void
setFileNameStream(IOSTREAM *s, atom_t name)
{ getStreamContext(s)->filename = name;
{ stream_context *ctx = getStreamContext(s);
if ( ctx->filename )
{ PL_unregister_atom(ctx->filename);
ctx->filename = NULL_ATOM;
}
if ( name != NULL_ATOM )
ctx->filename = name;
}
@ -520,13 +532,17 @@ PL_unify_stream_or_alias(term_t t, IOSTREAM *s)
} else
{ term_t a = PL_new_term_ref();
PL_put_pointer(a, s);
PL_cons_functor(a, FUNCTOR_dstream1, a);
rval = PL_unify(t, a);
rval = ( (a=PL_new_term_ref()) &&
PL_put_pointer(a, s) &&
PL_cons_functor(a, FUNCTOR_dstream1, a) &&
PL_unify(t, a)
);
}
UNLOCK();
if ( !rval && !PL_is_variable(t) )
return PL_error(NULL, 0, "stream-argument", ERR_MUST_BE_VAR, 0);
return rval;
}
@ -541,8 +557,10 @@ PL_unify_stream(term_t t, IOSTREAM *s)
ctx = getStreamContext(s);
UNLOCK();
PL_put_pointer(a, s);
PL_cons_functor(a, FUNCTOR_dstream1, a);
if ( !(a = PL_new_term_ref()) ||
!PL_put_pointer(a, s) ||
!PL_cons_functor(a, FUNCTOR_dstream1, a) )
return FALSE; /* resource error */
if ( PL_unify(t, a) )
return TRUE;
@ -666,14 +684,21 @@ reportStreamError(IOSTREAM *s)
if ( (s->flags & SIO_FERR) )
{ if ( s->exception )
{ fid_t fid = PL_open_foreign_frame();
term_t ex = PL_new_term_ref();
PL_recorded(s->exception, ex);
{ fid_t fid;
term_t ex;
int rc;
LD->exception.processing = TRUE; /* allow using spare stack */
if ( !(fid = PL_open_foreign_frame()) )
return FALSE;
ex = PL_new_term_ref();
rc = PL_recorded(s->exception, ex);
PL_erase(s->exception);
s->exception = NULL;
PL_raise_exception(ex);
if ( rc )
rc = PL_raise_exception(ex);
PL_close_foreign_frame(fid);
return FALSE;
return rc;
}
if ( s->flags & SIO_INPUT )
@ -1038,11 +1063,11 @@ closeOutputRedirect(redir_context *ctx)
rval = PL_unify_wchars_diff(out, tail, ctx->out_format,
ctx->size/sizeof(wchar_t),
(wchar_t*)ctx->data);
if ( tail )
if ( rval && tail )
rval = PL_unify(tail, diff);
if ( ctx->data != ctx->buffer )
free(ctx->data);
Sfree(ctx->data);
}
return rval;
@ -1064,7 +1089,7 @@ discardOutputRedirect(redir_context *ctx)
} else
{ closeStream(ctx->stream);
if ( ctx->data != ctx->buffer )
free(ctx->data);
Sfree(ctx->data);
}
}
@ -1397,6 +1422,22 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
goto error;
}
goto ok;
} else if ( aname == ATOM_type ) /* type(Type) */
{ atom_t type;
if ( !PL_get_atom_ex(a, &type) )
return FALSE;
if ( type == ATOM_text )
{ s->flags |= SIO_TEXT;
} else if ( type == ATOM_binary )
{ s->flags &= ~SIO_TEXT;
} else
{ PL_error("set_stream", 2, NULL, ERR_DOMAIN,
ATOM_type, a);
goto error;
}
goto ok;
} else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */
{ int close;
@ -1428,6 +1469,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
if ( !PL_get_atom_ex(a, &fn) )
goto error;
PL_register_atom(fn);
LOCK();
setFileNameStream(s, fn);
UNLOCK();
@ -1467,7 +1509,7 @@ PRED_IMPL("set_stream", 2, set_stream, 0)
if ( !PL_get_atom_ex(a, &val) )
goto error;
if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN )
{ bad_encoding(val);
{ bad_encoding(NULL, val);
goto error;
}
@ -2191,7 +2233,12 @@ PRED_IMPL("get_single_char", 1, get_single_char, 0)
int c = getSingleChar(s, TRUE);
if ( c == EOF )
{ PL_unify_integer(A1, -1);
{ if ( PL_exception(0) )
{ releaseStream(s);
return FALSE;
}
PL_unify_integer(A1, -1);
return streamStatus(s);
}
@ -2512,12 +2559,12 @@ encoding_to_atom(IOENC enc)
static int
bad_encoding(atom_t name)
bad_encoding(const char *msg, atom_t name)
{ GET_LD
term_t t = PL_new_term_ref();
PL_put_atom(t, name);
return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, t);
return PL_error(NULL, 0, msg, ERR_DOMAIN, ATOM_encoding, t);
}
@ -2630,10 +2677,23 @@ openStream(term_t file, term_t mode, term_t options)
if ( encoding != NULL_ATOM )
{ enc = atom_to_encoding(encoding);
if ( enc == ENC_UNKNOWN )
{ bad_encoding(encoding);
{ bad_encoding(NULL, encoding);
return NULL;
}
if ( type == ATOM_binary && enc != ENC_OCTET )
{ bad_encoding("type(binary) implies encoding(octet)", encoding);
return NULL;
}
switch(enc) /* explicitely specified: do not */
{ case ENC_OCTET: /* switch to Unicode. For implicit */
case ENC_ASCII: /* and unicode types we must detect */
case ENC_ISO_LATIN_1: /* and skip the BOM */
case ENC_WCHAR:
bom = FALSE;
break;
default:
;
}
} else if ( type == ATOM_binary )
{ enc = ENC_OCTET;
bom = FALSE;
@ -2675,10 +2735,12 @@ openStream(term_t file, term_t mode, term_t options)
}
#ifdef HAVE_POPEN
else if ( PL_is_functor(file, FUNCTOR_pipe1) )
{ term_t a = PL_new_term_ref();
{ term_t a;
char *cmd;
PL_get_arg(1, file, a);
PL_clear_exception();
a = PL_new_term_ref();
_PL_get_arg(1, file, a);
if ( !PL_get_chars(a, &cmd, CVT_ATOM|CVT_STRING|REP_FN) )
{ PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, a);
return NULL;
@ -3520,7 +3582,15 @@ PRED_IMPL("stream_property", 2, stream_property,
}
fid = PL_open_foreign_frame();
if ( !(fid = PL_open_foreign_frame()) )
{ error:
if ( pe->e )
freeTableEnum(pe->e);
freeHeap(pe, sizeof(*pe));
return FALSE;
}
for(;;)
{ if ( pe->s ) /* given stream */
@ -3531,7 +3601,8 @@ PRED_IMPL("stream_property", 2, stream_property,
goto enum_e;
}
fid2 = PL_open_foreign_frame();
if ( !(fid2 = PL_open_foreign_frame()) )
goto error;
for( ; pe->p->functor ; pe->p++ )
{ if ( PL_unify_functor(property, pe->p->functor) )
{ int rval;
@ -3559,6 +3630,9 @@ PRED_IMPL("stream_property", 2, stream_property,
}
}
if ( exception_term )
goto error;
if ( pe->fixed_p )
break;
PL_rewind_foreign_frame(fid2);
@ -3579,6 +3653,8 @@ PRED_IMPL("stream_property", 2, stream_property,
pe->p = sprop_list;
break;
}
if ( exception_term )
goto error;
}
}
@ -4081,11 +4157,16 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0)
{ PRED_LD
IOSTREAM *in = NULL, *out = NULL, *error = NULL;
int rval = FALSE;
int wrapin = FALSE;
if ( !PL_get_stream_handle(A1, &in) ||
!PL_get_stream_handle(A2, &out) )
if ( !get_stream_handle(A1, &in, SH_ERRORS|SH_ALIAS|SH_UNLOCKED) ||
!get_stream_handle(A2, &out, SH_ERRORS|SH_ALIAS) )
goto out;
wrapin = (LD->IO.streams[0] != in);
if ( wrapin )
in = getStream(in); /* lock it */
if ( PL_compare(A2, A3) == 0 ) /* == */
{ error = getStream(Snew(out->handle, out->flags, out->functions));
error->flags &= ~SIO_ABUF; /* disable buffering */
@ -4099,20 +4180,22 @@ PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0)
out->flags &= ~SIO_ABUF; /* output: line buffered */
out->flags |= SIO_LBUF;
LD->IO.streams[0] = in; /* user_input */
LD->IO.streams[1] = out; /* user_output */
LD->IO.streams[2] = error; /* user_error */
LD->IO.streams[3] = in; /* current_input */
LD->IO.streams[4] = out; /* current_output */
wrapIO(in, Sread_user, NULL);
LD->prompt.next = TRUE;
if ( wrapin )
{ LD->IO.streams[3] = in; /* current_input */
LD->IO.streams[0] = in; /* user_input */
wrapIO(in, Sread_user, NULL);
LD->prompt.next = TRUE;
}
UNLOCK();
rval = TRUE;
out:
if ( in )
if ( wrapin && in )
releaseStream(in);
if ( out )
releaseStream(out);

View File

@ -351,21 +351,25 @@ MarkExecutable(const char *name)
* FIND FILES FROM C *
*********************************/
int
static int
unifyTime(term_t t, time_t time)
{ return PL_unify_float(t, (double)time);
}
static void
static int
add_option(term_t options, functor_t f, atom_t val)
{ GET_LD
term_t head = PL_new_term_ref();
term_t head;
PL_unify_list(options, head, options);
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val);
if ( (head=PL_new_term_ref()) &&
PL_unify_list(options, head, options) &&
PL_unify_term(head, PL_FUNCTOR, f, PL_ATOM, val) )
{ PL_reset_term_refs(head);
return TRUE;
}
PL_reset_term_refs(head);
return FALSE;
}
#define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST)
@ -378,29 +382,36 @@ PL_get_file_name(term_t n, char **namep, int flags)
char ospath[MAXPATHLEN];
if ( flags & PL_FILE_SEARCH )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system");
term_t av = PL_new_term_refs(3);
term_t options = PL_copy_term_ref(av+2);
int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
: PL_Q_PASS_EXCEPTION);
{ fid_t fid;
PL_put_term(av+0, n);
if ( (fid = PL_open_foreign_frame()) )
{ predicate_t pred = PL_predicate("absolute_file_name", 3, "system");
term_t av = PL_new_term_refs(3);
term_t options = PL_copy_term_ref(av+2);
int rc = TRUE;
int cflags = ((flags&PL_FILE_NOERRORS) ? PL_Q_CATCH_EXCEPTION
: PL_Q_PASS_EXCEPTION);
if ( flags & PL_FILE_EXIST )
add_option(options, FUNCTOR_access1, ATOM_exist);
if ( flags & PL_FILE_READ )
add_option(options, FUNCTOR_access1, ATOM_read);
if ( flags & PL_FILE_WRITE )
add_option(options, FUNCTOR_access1, ATOM_write);
if ( flags & PL_FILE_EXECUTE )
add_option(options, FUNCTOR_access1, ATOM_execute);
PL_put_term(av+0, n);
PL_unify_nil(options);
if ( rc && flags & PL_FILE_EXIST )
rc = add_option(options, FUNCTOR_access1, ATOM_exist);
if ( rc && flags & PL_FILE_READ )
rc = add_option(options, FUNCTOR_access1, ATOM_read);
if ( rc && flags & PL_FILE_WRITE )
rc = add_option(options, FUNCTOR_access1, ATOM_write);
if ( rc && flags & PL_FILE_EXECUTE )
rc = add_option(options, FUNCTOR_access1, ATOM_execute);
if ( !PL_call_predicate(NULL, cflags, pred, av) )
return FALSE;
if ( rc ) rc = PL_unify_nil(options);
if ( rc ) rc = PL_call_predicate(NULL, cflags, pred, av);
if ( rc ) rc = PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN);
return PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN);
PL_discard_foreign_frame(fid);
return rc;
}
return FALSE;
}
if ( flags & PL_FILE_NOERRORS )
@ -642,9 +653,51 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
if ( !PL_get_chars(base, &n, CVT_ALL) )
return PL_error("tmp_file", 2, NULL, ERR_TYPE, ATOM_atom, base);
return PL_unify_atom(name, TemporaryFile(n));
return PL_unify_atom(name, TemporaryFile(n, NULL));
}
/** tmp_file_stream(+Mode, -File, -Stream)
*/
static
PRED_IMPL("tmp_file_stream", 3, tmp_file_stream, 0)
{ PRED_LD
atom_t fn;
int fd;
IOENC enc;
atom_t encoding;
const char *mode;
if ( !PL_get_atom_ex(A1, &encoding) )
return FALSE;
if ( (enc = atom_to_encoding(encoding)) == ENC_UNKNOWN )
{ if ( encoding == ATOM_binary )
{ enc = ENC_OCTET;
mode = "wb";
} else
{ return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, A1);
}
} else
{ mode = "w";
}
if ( (fn=TemporaryFile("", &fd)) )
{ IOSTREAM *s;
if ( !PL_unify_atom(A2, fn) )
{ close(fd);
return PL_error(NULL, 0, NULL, ERR_MUST_BE_VAR, 2);
}
s = Sfdopen(fd, mode);
s->encoding = enc;
return PL_unify_stream(A3, s);
} else
{ return PL_error(NULL, 0, NULL, ERR_RESOURCE, ATOM_temporary_files);
}
}
/*******************************
* CHANGE FILESYSTEM *
@ -653,7 +706,13 @@ PRED_IMPL("tmp_file", 2, tmp_file, 0)
static
PRED_IMPL("delete_file", 1, delete_file, 0)
{ char *n;
{ PRED_LD
char *n;
atom_t aname;
if ( PL_get_atom(A1, &aname) &&
DeleteTemporaryFile(aname) )
return TRUE;
if ( !PL_get_file_name(A1, &n, 0) )
return FALSE;
@ -662,7 +721,7 @@ PRED_IMPL("delete_file", 1, delete_file, 0)
return TRUE;
return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION,
ATOM_delete, ATOM_file, A1);
ATOM_delete, ATOM_file, A1);
}
@ -799,7 +858,7 @@ has_extension(const char *name, const char *ext)
static int
name_too_long()
name_too_long(void)
{ return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length);
}
@ -941,6 +1000,7 @@ BeginPredDefs(files)
PRED_DEF("exists_file", 1, exists_file, 0)
PRED_DEF("exists_directory", 1, exists_directory, 0)
PRED_DEF("tmp_file", 2, tmp_file, 0)
PRED_DEF("tmp_file_stream", 3, tmp_file_stream, 0)
PRED_DEF("delete_file", 1, delete_file, 0)
PRED_DEF("delete_directory", 1, delete_directory, 0)
PRED_DEF("make_directory", 1, make_directory, 0)

View File

@ -109,8 +109,7 @@ typedef struct {
} prolog_flag;
struct
{ TempFile _tmpfile_head;
TempFile _tmpfile_tail;
{ Table tmp_files; /* Known temporary files */
CanonicalDir _canonical_dirlist;
char * myhome; /* expansion of ~ */
char * fred; /* last expanded ~user */
@ -123,6 +122,25 @@ typedef struct {
IOFUNCTIONS rl_functions; /* IO+Terminal+Readline functions */
} os;
struct
{ size_t heap; /* heap in use */
size_t atoms; /* No. of atoms defined */
size_t atomspace; /* # bytes used to store atoms */
size_t stack_space; /* # bytes on stacks */
#ifdef O_ATOMGC
size_t atomspacefreed; /* Freed atom-space */
#endif
int functors; /* No. of functors defined */
int predicates; /* No. of predicates defined */
int modules; /* No. of modules in the system */
intptr_t codes; /* No. of byte codes generated */
#ifdef O_PLMT
int threads_created; /* # threads created */
int threads_finished; /* # finished threads */
double thread_cputime; /* Total CPU time of threads */
#endif
} statistics;
struct
{ atom_t * array; /* index --> atom */
size_t count; /* elements in array */
@ -136,6 +154,8 @@ extern gds_t gds;
#define GD (&gds)
#define GLOBAL_LD (&gds)
typedef struct
{ unsigned long flags; /* Fast access to some boolean Prolog flags */
} pl_features_t;
@ -280,6 +300,7 @@ typedef struct PL_local_data {
term_t tmp; /* tmp for errors */
term_t pending; /* used by the debugger */
int in_hook; /* inside exception_hook() */
int processing; /* processing an exception */
exception_frame *throw_environment; /* PL_throw() environments */
} exception;
const char *float_format; /* floating point format */
@ -290,6 +311,8 @@ typedef struct PL_local_data {
} PL_local_data_t;
#define usedStack(D) 0
#define features (LD->feature.mask)
extern PL_local_data_t lds;
@ -586,6 +609,8 @@ extern int get_atom_ptr_text(Atom a, PL_chars_t *text);
/**** stuff from pl-files.c ****/
void initFiles(void);
int RemoveFile(const char *path);
int PL_get_file_name(term_t n, char **namep, int flags);
/* empty stub */
void setPrologFlag(const char *name, int flags, ...);

View File

@ -119,7 +119,8 @@ have to be dropped. See the header of pl-incl.h for details.
bool
initOs(void)
{ DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
{ GET_LD
DEBUG(1, Sdprintf("OS:initExpand() ...\n"));
initExpand();
DEBUG(1, Sdprintf("OS:initEnviron() ...\n"));
initEnviron();
@ -409,10 +410,10 @@ setOSPrologFlags(void)
* MEMORY *
*******************************/
#if __SWI_PROLOG__
uintptr_t
UsedMemory(void)
{
{ GET_LD
#if defined(HAVE_GETRUSAGE) && defined(HAVE_RU_IDRSS)
struct rusage usage;
@ -427,23 +428,15 @@ UsedMemory(void)
usedStack(local) +
usedStack(trail));
}
#else
uintptr_t
UsedMemory(void)
{
return 0;
}
#endif
uintptr_t
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;
@ -511,7 +504,9 @@ setRandom(unsigned int *seedp)
uint64_t
_PL_Random(void)
{ if ( !LD->os.rand_initialised )
{ GET_LD
if ( !LD->os.rand_initialised )
{ setRandom(NULL);
LD->os.rand_initialised = TRUE;
}
@ -530,9 +525,9 @@ _PL_Random(void)
#else
{ uint64_t l = rand(); /* 0<n<2^15-1 */
l ^= rand()<<15;
l ^= rand()<<30;
l ^= rand()<<45;
l ^= (uint64_t)rand()<<15;
l ^= (uint64_t)rand()<<30;
l ^= (uint64_t)rand()<<45;
return l;
}
@ -552,7 +547,7 @@ available to the Prolog user based on these functions. These functions
are in this module as non-UNIX OS probably don't have getpid() or put
temporaries on /tmp.
atom_t TemporaryFile(const char *id)
atom_t TemporaryFile(const char *id, int *fdp)
The return value of this call is an atom, whose string represents
the path name of a unique file that can be used as temporary file.
@ -566,14 +561,6 @@ temporaries on /tmp.
not be created at all, or might already have been deleted.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
struct tempfile
{ atom_t name;
TempFile next;
}; /* chain of temporary files */
#define tmpfile_head (GD->os._tmpfile_head)
#define tmpfile_tail (GD->os._tmpfile_tail)
#ifndef DEFTMPDIR
#ifdef __WINDOWS__
#define DEFTMPDIR "c:/tmp"
@ -582,22 +569,64 @@ struct tempfile
#endif
#endif
static int
free_tmp_symbol(Symbol s)
{ int rc;
atom_t tname = (atom_t)s->name;
PL_chars_t txt;
get_atom_text(tname, &txt);
PL_mb_text(&txt, REP_FN);
rc = RemoveFile(txt.text.t);
PL_free_text(&txt);
PL_unregister_atom(tname);
return rc;
}
static void
void_free_tmp_symbol(Symbol s)
{ (void)free_tmp_symbol(s);
}
#ifndef O_EXCL
#define O_EXCL 0
#endif
#ifndef O_BINARY
#define O_BINARY 0
#endif
atom_t
TemporaryFile(const char *id)
TemporaryFile(const char *id, int *fdp)
{ char temp[MAXPATHLEN];
TempFile tf = allocHeap(sizeof(struct tempfile));
char envbuf[MAXPATHLEN];
char *tmpdir;
static char *tmpdir = NULL;
atom_t tname;
int retries = 0;
if ( !((tmpdir = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
(tmpdir = Getenv("TMP", envbuf, sizeof(envbuf)))) )
tmpdir = DEFTMPDIR;
if ( !tmpdir )
{ LOCK();
if ( !tmpdir )
{ char envbuf[MAXPATHLEN];
char *td;
if ( (td = Getenv("TEMP", envbuf, sizeof(envbuf))) ||
(td = Getenv("TMP", envbuf, sizeof(envbuf))) )
tmpdir = strdup(td);
else
tmpdir = DEFTMPDIR;
}
UNLOCK();
}
retry:
#ifdef __unix__
{ static int MTOK_temp_counter = 0;
const char *sep = id[0] ? "_" : "";
Ssprintf(temp, "%s/pl_%s_%d_%d",
tmpdir, id, (int) getpid(), MTOK_temp_counter++);
Ssprintf(temp, "%s/pl_%s%s%d_%d",
tmpdir, id, sep, (int) getpid(), MTOK_temp_counter++);
}
#endif
@ -612,49 +641,74 @@ TemporaryFile(const char *id)
#endif
{ PrologPath(tmp, temp, sizeof(temp));
} else
Ssprintf(temp, "%s/pl_%s_%d", tmpdir, id, temp_counter++);
}
#endif
{ const char *sep = id[0] ? "_" : "";
#if EMX
static int temp_counter = 0;
char *foo;
if ( (foo = tempnam(".", (const char *)id)) )
{ strcpy(temp, foo);
free(foo);
} else
Ssprintf(temp, "pl_%s_%d_%d", id, getpid(), temp_counter++);
#endif
tf->name = PL_new_atom(temp); /* locked: ok! */
tf->next = NULL;
startCritical;
if ( !tmpfile_tail )
{ tmpfile_head = tmpfile_tail = tf;
} else
{ tmpfile_tail->next = tf;
tmpfile_tail = tf;
Ssprintf(temp, "%s/pl_%s%s%d", tmpdir, id, sep, temp_counter++);
}
endCritical;
return tf->name;
}
#endif
if ( fdp )
{ int fd;
if ( (fd=open(temp, O_CREAT|O_EXCL|O_WRONLY|O_BINARY, 0600)) < 0 )
{ if ( ++retries < 10000 )
goto retry;
else
return NULL_ATOM;
}
*fdp = fd;
}
tname = PL_new_atom(temp); /* locked: ok! */
LOCK();
if ( !GD->os.tmp_files )
{ GD->os.tmp_files = newHTable(4);
GD->os.tmp_files->free_symbol = void_free_tmp_symbol;
}
UNLOCK();
addHTable(GD->os.tmp_files, (void*)tname, (void*)TRUE);
return tname;
}
int
DeleteTemporaryFile(atom_t name)
{ int rc = FALSE;
if ( GD->os.tmp_files )
{ LOCK();
if ( GD->os.tmp_files && GD->os.tmp_files->size > 0 )
{ Symbol s = lookupHTable(GD->os.tmp_files, (void*)name);
if ( s )
{ rc = free_tmp_symbol(s);
deleteSymbolHTable(GD->os.tmp_files, s);
}
}
UNLOCK();
}
return rc;
}
void
RemoveTemporaryFiles(void)
{ TempFile tf, tf2;
{ LOCK();
if ( GD->os.tmp_files )
{ Table t = GD->os.tmp_files;
startCritical;
for(tf = tmpfile_head; tf; tf = tf2)
{ RemoveFile(stringAtom(tf->name));
tf2 = tf->next;
freeHeap(tf, sizeof(struct tempfile));
GD->os.tmp_files = NULL;
UNLOCK();
destroyHTable(t);
} else
{ UNLOCK();
}
tmpfile_head = tmpfile_tail = NULL;
endCritical;
}
@ -756,7 +810,8 @@ OsPath(const char *p, char *buf)
#if O_XOS
char *
PrologPath(const char *p, char *buf, size_t len)
{ int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
{ GET_LD
int flags = (truePrologFlag(PLFLAG_FILE_CASE) ? 0 : XOS_DOWNCASE);
return _xos_canonical_filename(p, buf, len, flags);
}
@ -813,7 +868,7 @@ forwards char *canoniseDir(char *);
static void
initExpand(void)
{
{ GET_LD
#ifdef O_CANONISE_DIRS
char *dir;
char *cpaths;
@ -923,6 +978,7 @@ verify_entry(CanonicalDir d)
d->inode = buf.st_ino;
d->device = buf.st_dev;
return TRUE;
} else
{ DEBUG(1, Sdprintf("%s: no longer exists\n", d->canonical));
@ -939,6 +995,9 @@ verify_entry(CanonicalDir d)
}
}
remove_string(d->name);
if ( d->canonical != d->name )
remove_string(d->canonical);
free(d);
}
@ -1139,7 +1198,9 @@ utf8_strlwr(char *s)
char *
canonisePath(char *path)
{ if ( !truePrologFlag(PLFLAG_FILE_CASE) )
{ GET_LD
if ( !truePrologFlag(PLFLAG_FILE_CASE) )
utf8_strlwr(path);
canoniseFileName(path);
@ -1186,7 +1247,8 @@ takeWord(const char **string, char *wrd, int maxlen)
bool
expandVars(const char *pattern, char *expanded, int maxlen)
{ int size = 0;
{ GET_LD
int size = 0;
char wordbuf[MAXPATHLEN];
if ( *pattern == '~' )
@ -1338,7 +1400,8 @@ ExpandFile(const char *pattern, char **vector)
char *
ExpandOneFile(const char *spec, char *file)
{ char *vector[256];
{ GET_LD
char *vector[256];
int size;
switch( (size=ExpandFile(spec, vector)) )
@ -1437,10 +1500,13 @@ IsAbsolutePath(const char *p)
char *
AbsoluteFile(const char *spec, char *path)
{ char tmp[MAXPATHLEN];
{ GET_LD
char tmp[MAXPATHLEN];
char buf[MAXPATHLEN];
char *file = PrologPath(spec, buf, sizeof(buf));
if ( !file )
return (char *) NULL;
if ( truePrologFlag(PLFLAG_FILEVARS) )
{ if ( !(file = ExpandOneFile(buf, tmp)) )
return (char *) NULL;
@ -1485,7 +1551,9 @@ AbsoluteFile(const char *spec, char *path)
void
PL_changed_cwd(void)
{ if ( CWDdir )
{ GET_LD
if ( CWDdir )
remove_string(CWDdir);
CWDdir = NULL;
CWDlen = 0;
@ -1494,7 +1562,9 @@ PL_changed_cwd(void)
const char *
PL_cwd(void)
{ if ( CWDlen == 0 )
{ GET_LD
if ( CWDlen == 0 )
{ char buf[MAXPATHLEN];
char *rval;
@ -1583,7 +1653,8 @@ DirName(const char *f, char *dir)
bool
ChDir(const char *path)
{ char ospath[MAXPATHLEN];
{ GET_LD
char ospath[MAXPATHLEN];
char tmp[MAXPATHLEN];
OsPath(path, ospath);
@ -1681,7 +1752,8 @@ ResetStdin(void)
static ssize_t
Sread_terminal(void *handle, char *buf, size_t size)
{ intptr_t h = (intptr_t)handle;
{ GET_LD
intptr_t h = (intptr_t)handle;
int fd = (int)h;
source_location oldsrc = LD->read_source;
@ -1708,7 +1780,8 @@ Sread_terminal(void *handle, char *buf, size_t size)
void
ResetTty()
{ startCritical;
{ GET_LD
startCritical;
ResetStdin();
if ( !GD->os.iofunctions.read )
@ -1736,7 +1809,8 @@ ResetTty()
bool
PushTty(IOSTREAM *s, ttybuf *buf, int mode)
{ struct termios tio;
{ GET_LD
struct termios tio;
int fd;
buf->mode = ttymode;
@ -1803,7 +1877,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool
PopTty(IOSTREAM *s, ttybuf *buf)
{ int fd;
{ GET_LD
int fd;
ttymode = buf->mode;
if ( (fd = Sfileno(s)) < 0 || !isatty(fd) )
@ -1898,7 +1973,8 @@ PushTty(IOSTREAM *s, ttybuf *buf, int mode)
bool
PopTty(IOSTREAM *s, ttybuf *buf)
{ ttymode = buf->mode;
{ GET_LD
ttymode = buf->mode;
if ( ttymode != TTY_RAW )
LD->prompt.next = TRUE;
@ -2204,7 +2280,8 @@ argument to wait()
int
System(char *cmd)
{ int pid;
{ GET_LD
int pid;
char *shell = "/bin/sh";
int rval;
void (*old_int)();

View File

@ -245,8 +245,9 @@ extern char *Getenv(const char *, char *buf, size_t buflen);
extern char *BaseName(const char *f);
extern time_t LastModifiedFile(const char *f);
extern bool ExistsFile(const char *path);
extern atom_t TemporaryFile(const char *id);
extern int RemoveFile(const char *path);
extern atom_t TemporaryFile(const char *id, int *fdp);
extern atom_t TemporaryFile(const char *id, int *fdp);
extern int DeleteTemporaryFile(atom_t name);
extern bool ChDir(const char *path);
extern char *PrologPath(const char *ospath, char *path, size_t len);

View File

@ -93,16 +93,40 @@ PL_save_text(PL_chars_t *text, int flags)
addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING;
}
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PL_from_stack_text() moves a string from the stack, so it won't get
corrupted if GC/shift comes along.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static void
PL_from_stack_text(PL_chars_t *text)
{ if ( text->storage == PL_CHARS_STACK )
{ size_t bl = bufsize_text(text, text->length+1);
if ( bl < sizeof(text->buf) )
{ memcpy(text->buf, text->text.t, bl);
text->text.t = text->buf;
text->storage = PL_CHARS_LOCAL;
} else
{ Buffer b = findBuffer(BUF_RING);
addMultipleBuffer(b, text->text.t, bl, char);
text->text.t = baseBuffer(b, char);
text->storage = PL_CHARS_RING;
}
}
}
int
PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
{
Word w = valHandle(l);
{ word w = valHandle(l);
if ( (flags & CVT_ATOM) && isAtom(w) )
{ if ( !get_atom_text(w, text) )
@ -110,6 +134,7 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
} else if ( (flags & CVT_STRING) && isString(w) )
{ if ( !get_string_text(w, text PASS_LD) )
goto maybe_write;
PL_from_stack_text(text);
} else if ( (flags & CVT_INTEGER) && isInteger(w) )
{ number n;
@ -141,8 +166,8 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
}
text->encoding = ENC_ISO_LATIN_1;
text->canonical = TRUE;
} else if ( (flags & CVT_FLOAT) && isReal(w) )
{ format_float(valReal(w), text->buf, LD->float_format);
} else if ( (flags & CVT_FLOAT) && isFloat(w) )
{ format_float(valFloat(w), text->buf, LD->float_format);
text->text.t = text->buf;
text->length = strlen(text->text.t);
text->encoding = ENC_ISO_LATIN_1;
@ -182,11 +207,11 @@ PL_get_text__LD(term_t l, PL_chars_t *text, int flags ARG_LD)
encodings[0] = ENC_ISO_LATIN_1;
encodings[1] = ENC_WCHAR;
encodings[2] = ENC_UNKNOWN;
for(enc = encodings; *enc != ENC_UNKNOWN; enc++)
{ size_t size;
IOSTREAM *fd;
r = text->buf;
size = sizeof(text->buf);
fd = Sopenmem(&r, &size, "w");
@ -228,6 +253,9 @@ maybe_write:
goto case_write;
error:
if ( canBind(w) && (flags & CVT_VARNOFAIL) )
return 2;
if ( (flags & CVT_EXCEPTION) )
{ atom_t expected;
@ -237,7 +265,7 @@ error:
expected = ATOM_atomic;
else
expected = ATOM_atom;
return PL_error(NULL, 0, NULL, ERR_TYPE, expected, l);
}
@ -277,7 +305,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
{ case PL_ATOM:
{ atom_t a = textToAtom(text);
int rval = _PL_unify_atomic(term, a);
PL_unregister_atom(a);
return rval;
}
@ -285,7 +313,10 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
#if __SWI_PROLOG__
{ word w = textToString(text);
return _PL_unify_atomic(term, w);
if ( w )
return _PL_unify_atomic(term, w);
else
return FALSE;
}
#endif
case PL_CODE_LIST:
@ -300,35 +331,40 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
}
} else
{ GET_LD
word p0, p;
term_t l = PL_new_term_ref();
Word p0, p;
switch(text->encoding)
{ case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char *)text->text.t;
const unsigned char *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length);
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
return FALSE;
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break;
}
case ENC_WCHAR:
{ const pl_wchar_t *s = (const pl_wchar_t *)text->text.t;
const pl_wchar_t *e = &s[text->length];
p0 = p = INIT_SEQ_CODES(text->length);
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
if ( !(p0 = p = INIT_SEQ_CODES(text->length)) )
return FALSE;
if ( type == PL_CODE_LIST ) {
for( ; s < e; s++)
p = EXTEND_SEQ_CODES(p, *s);
} else {
for( ; s < e; s++)
p = EXTEND_SEQ_ATOMS(p, *s);
}
break;
}
case ENC_UTF8:
@ -336,22 +372,24 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
const char *e = &s[text->length];
size_t len = utf8_strlen(s, text->length);
p0 = p = INIT_SEQ_CODES(len);
if ( type == PL_CODE_LIST ) {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_CODES(p, chr);
}
} else {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_ATOMS(p, chr);
}
}
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
return FALSE;
if ( type == PL_CODE_LIST ) {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_CODES(p, chr);
}
} else {
while (s < e) {
int chr;
s = utf8_get_char(s, &chr);
p = EXTEND_SEQ_ATOMS(p, chr);
}
}
break;
}
case ENC_ANSI:
@ -367,18 +405,21 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
n -= rc;
s += rc;
}
p0 = p = INIT_SEQ_CODES(len);
if ( !(p0 = p = INIT_SEQ_CODES(len)) )
return FALSE;
memset(&mbs, 0, sizeof(mbs));
n = text->length;
while(n > 0) {
rc = mbrtowc(&wc, s, n, &mbs);
while(n > 0)
{ rc = mbrtowc(&wc, s, n, &mbs);
if ( type == PL_CODE_LIST )
p = EXTEND_SEQ_CODES(p, wc);
else
p = EXTEND_SEQ_ATOMS(p, wc);
s += rc;
n -= rc;
}
@ -391,7 +432,7 @@ PL_unify_text(term_t term, term_t tail, PL_chars_t *text, int type)
}
}
return CLOSE_SEQ_OF_CODES(p, p0, tail, term );
return CLOSE_SEQ_OF_CODES(p, p0, tail, term, l );
}
}
default:
@ -430,7 +471,7 @@ PL_unify_text_range(term_t term, PL_chars_t *text,
rc = PL_unify_text(term, 0, &sub, type);
PL_free_text(&sub);
return rc;
}
}
@ -458,7 +499,7 @@ PL_promote_text(PL_chars_t *text)
PL_free(text->text.t);
text->text.w = new;
text->encoding = ENC_WCHAR;
} else if ( text->storage == PL_CHARS_LOCAL &&
(text->length+1)*sizeof(pl_wchar_t) < sizeof(text->buf) )
@ -512,7 +553,7 @@ PL_demote_text(PL_chars_t *text)
PL_free(text->text.t);
text->text.t = new;
text->encoding = ENC_ISO_LATIN_1;
} else if ( text->storage == PL_CHARS_LOCAL )
{ pl_wchar_t buf[sizeof(text->buf)/sizeof(pl_wchar_t)];
@ -601,7 +642,7 @@ utf8tobuffer(wchar_t c, Buffer buf)
{ char b[6];
char *e = b;
const char *s;
e = utf8_put_char(e, c);
for(s=b; s<e; s++)
addBuffer(buf, *s, char);
@ -617,7 +658,7 @@ PL_mb_text(PL_chars_t *text, int flags)
if ( text->encoding != target )
{ Buffer b = findBuffer(BUF_RING);
switch(text->encoding)
{ case ENC_ISO_LATIN_1:
{ const unsigned char *s = (const unsigned char*)text->text.t;
@ -658,7 +699,7 @@ PL_mb_text(PL_chars_t *text, int flags)
addBuffer(b, 0, char);
} else /* if ( target == ENC_MB ) */
{ mbstate_t mbs;
memset(&mbs, 0, sizeof(mbs));
for( ; w<e; w++)
{ if ( !wctobuffer(*w, &mbs, b) )
@ -692,7 +733,7 @@ rep_error:
sprintf(msg,
"Cannot represent char U%04x using %s encoding",
norep,
norep,
target == ENC_ISO_LATIN_1 ? "ISO Latin-1" : "current locale");
return PL_error(NULL, 0, msg, ERR_REPRESENTATION, ATOM_encoding);
@ -711,7 +752,7 @@ PL_canonise_text(PL_chars_t *text)
case ENC_WCHAR:
{ const pl_wchar_t *w = (const pl_wchar_t*)text->text.w;
const pl_wchar_t *e = &w[text->length];
for(; w<e; w++)
{ if ( *w > 0xff )
return FALSE;
@ -1013,7 +1054,7 @@ PL_cmp_text(PL_chars_t *t1, size_t o1, PL_chars_t *t2, size_t o2,
return ifeq;
else
return *s > *q ? 1 : -1;
}
}
}
@ -1098,35 +1139,3 @@ Sopen_text(PL_chars_t *txt, const char *mode)
return stream;
}
int
PL_unify_chars(term_t t, int flags, size_t len, const char *s)
{ PL_chars_t text;
term_t tail;
int rc;
if ( len == (size_t)-1 )
len = strlen(s);
text.text.t = (char *)s;
text.encoding = ((flags&REP_UTF8) ? ENC_UTF8 : \
(flags&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1);
text.storage = PL_CHARS_HEAP;
text.length = len;
text.canonical = FALSE;
flags &= ~(REP_UTF8|REP_MB|REP_ISO_LATIN_1);
if ( (flags & PL_DIFF_LIST) )
{ tail = t+1;
flags &= (~PL_DIFF_LIST);
} else
{ tail = 0;
}
rc = PL_unify_text(t, tail, &text, flags);
PL_free_text(&text);
return rc;
}

View File

@ -250,7 +250,7 @@ scan_options(term_t options, int flags, atom_t optype,
term_t val = PL_new_term_ref();
int n;
if ( trueFeature(ISO_FEATURE) )
if ( truePrologFlag(PLFLAG_ISO) )
flags |= OPT_ALL;
va_start(args, specs);

View File

@ -148,7 +148,7 @@ EXTEND_SEQ_ATOMS(word gstore, int c) {
}
static inline int
CLOSE_SEQ_OF_CODES(word gstore, word lp, word arg2, word arg3) {
CLOSE_SEQ_OF_CODES(word gstore, word lp, word arg2, word arg3, term_t l) {
if (arg3 == (word)ATOM_nil) {
if (!YAP_CloseList((YAP_Term)gstore, YAP_TermNil()))
return FALSE;
@ -172,14 +172,17 @@ valHandle(term_t tt)
#define isAtom(A) YAP_IsAtomTerm((A))
#define isList(A) YAP_IsPairTerm((A))
#define isNil(A) ((A) == YAP_TermNil())
#define isReal(A)YAP_IsFloatTerm((A))
#define isReal(A) YAP_IsFloatTerm((A))
#define isFloat(A) YAP_IsFloatTerm((A))
#define isVar(A) YAP_IsVarTerm((A))
#define varName(l, buf) buf
#define valReal(w) YAP_FloatOfTerm((w))
#define valFloat(w) YAP_FloatOfTerm((w))
#define AtomLength(w) YAP_AtomNameLength(w)
#define atomValue(atom) ((YAP_Atom)atom)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) (t = YAP_Deref(t))
#define canBind(t) FALSE
#define clearNumber(n)