/* $Id$ Part of SWI-Prolog Author: Jan Wielemaker E-mail: wielemak@science.uva.nl WWW: http://www.swi-prolog.org Copyright (C): 1985-2008, University of Amsterdam This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. 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 */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This module is far too big. It defines a layer around open(), etc. to get opening and closing of files to the symbolic level required for Prolog. It also defines basic I/O predicates, stream based I/O and finally a bundle of operations on files, such as name expansion, renaming, deleting, etc. Most of this module is rather straightforward. If time is there I will have a look at all this to clean it. Notably handling times must be cleaned, but that not only holds for this module. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /*#define O_DEBUG 1*/ /*#define O_DEBUG_MT 1*/ #define EXPERIMENT 1 #include "pl-incl.h" #include "pl-ctype.h" #include "pl-utf8.h" #include #ifdef HAVE_SYS_SELECT_H #include #endif #ifdef HAVE_SYS_TIME_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_SYS_FILE_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_FILE_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_BSTRING_H #include #endif #define LOCK() PL_LOCK(L_FILE) /* MT locking */ #define UNLOCK() PL_UNLOCK(L_FILE) static int bad_encoding(atom_t name); static bool streamStatus(IOSTREAM *s); INIT_DEF(atom_t, standardStreams, 6) ADD_STDSTREAM(ATOM_user_input) /* 0 */ ADD_STDSTREAM(ATOM_user_output) /* 1 */ ADD_STDSTREAM(ATOM_user_error) /* 2 */ ADD_STDSTREAM(ATOM_current_input) /* 3 */ ADD_STDSTREAM(ATOM_current_output) /* 4 */ ADD_STDSTREAM(ATOM_protocol) /* 5 */ END_STDSTREAMS(NULL_ATOM) static int standardStreamIndexFromName(atom_t name) { const atom_t *ap; for(ap=standardStreams; *ap; ap++) { if ( *ap == name ) return (int)(ap - standardStreams); } return -1; } static int standardStreamIndexFromStream(IOSTREAM *s) { GET_LD IOSTREAM **sp = LD->IO.streams; int i = 0; for( ; i<6; i++, sp++ ) { if ( *sp == s ) return i; } return -1; } /******************************* * BOOKKEEPING * *******************************/ static void aliasStream(IOSTREAM *s, atom_t alias); static void unaliasStream(IOSTREAM *s, atom_t name); static Table streamAliases; /* alias --> stream */ static Table streamContext; /* stream --> extra data */ typedef struct _alias { struct _alias *next; atom_t name; } alias; #define IO_TELL 0x001 /* opened by tell/1 */ #define IO_SEE 0x002 /* opened by see/1 */ typedef struct { alias *alias_head; alias *alias_tail; atom_t filename; /* associated filename */ unsigned flags; } stream_context; static stream_context * getStreamContext(IOSTREAM *s) { Symbol symb; if ( !(symb = lookupHTable(streamContext, s)) ) { GET_LD stream_context *ctx = allocHeap(sizeof(*ctx)); DEBUG(1, Sdprintf("Created ctx=%p for stream %p\n", ctx, s)); ctx->alias_head = ctx->alias_tail = NULL; ctx->filename = NULL_ATOM; ctx->flags = 0; addHTable(streamContext, s, ctx); return ctx; } return symb->value; } void aliasStream(IOSTREAM *s, atom_t name) { GET_LD stream_context *ctx; Symbol symb; alias *a; /* ensure name is free (error?) */ if ( (symb = lookupHTable(streamAliases, (void *)name)) ) unaliasStream(symb->value, name); ctx = getStreamContext(s); addHTable(streamAliases, (void *)name, s); PL_register_atom(name); a = allocHeap(sizeof(*a)); a->next = NULL; a->name = name; if ( ctx->alias_tail ) { ctx->alias_tail->next = a; ctx->alias_tail = a; } else { ctx->alias_head = ctx->alias_tail = a; } } /* MT: Locked by freeStream() */ static void unaliasStream(IOSTREAM *s, atom_t name) { GET_LD Symbol symb; if ( name ) { if ( (symb = lookupHTable(streamAliases, (void *)name)) ) { deleteSymbolHTable(streamAliases, symb); if ( (symb=lookupHTable(streamContext, s)) ) { stream_context *ctx = symb->value; alias **a; for(a = &ctx->alias_head; *a; a = &(*a)->next) { if ( (*a)->name == name ) { alias *tmp = *a; *a = tmp->next; freeHeap(tmp, sizeof(*tmp)); if ( tmp == ctx->alias_tail ) ctx->alias_tail = NULL; break; } } } PL_unregister_atom(name); } } else /* delete them all */ { if ( (symb=lookupHTable(streamContext, s)) ) { stream_context *ctx = symb->value; alias *a, *n; for(a = ctx->alias_head; a; a=n) { Symbol s2; n = a->next; if ( (s2 = lookupHTable(streamAliases, (void *)a->name)) ) { deleteSymbolHTable(streamAliases, s2); PL_unregister_atom(a->name); } freeHeap(a, sizeof(*a)); } ctx->alias_head = ctx->alias_tail = NULL; } } } static void freeStream(IOSTREAM *s) { GET_LD Symbol symb; int i; IOSTREAM **sp; DEBUG(1, Sdprintf("freeStream(%p)\n", s)); LOCK(); unaliasStream(s, NULL_ATOM); 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; } freeHeap(ctx, sizeof(*ctx)); deleteSymbolHTable(streamContext, symb); } /* if we are a standard stream */ /* reassociate with standard I/O */ /* NOTE: there may be more! */ for(i=0, sp = LD->IO.streams; i<6; i++, sp++) { if ( *sp == s ) { if ( s->flags & SIO_INPUT ) *sp = Sinput; else if ( sp == &Suser_error ) *sp = Serror; else if ( sp == &Sprotocol ) *sp = NULL; else *sp = Soutput; } } UNLOCK(); } /* MT: locked by caller (openStream()) */ static void setFileNameStream(IOSTREAM *s, atom_t name) { getStreamContext(s)->filename = name; } static atom_t fileNameStream(IOSTREAM *s) { atom_t name; LOCK(); name = getStreamContext(s)->filename; UNLOCK(); return name; } /******************************* * GET HANDLES * *******************************/ #ifdef O_PLMT static inline IOSTREAM * getStream(IOSTREAM *s) { if ( s && s->magic == SIO_MAGIC ) /* TBD: ensure visibility? */ { Slock(s); return s; } return NULL; } static inline IOSTREAM * tryGetStream(IOSTREAM *s) { if ( s && s->magic == SIO_MAGIC && StryLock(s) == 0 ) return s; return NULL; } static inline void releaseStream(IOSTREAM *s) { if ( s->magic == SIO_MAGIC ) Sunlock(s); } #else /*O_PLMT*/ #define getStream(s) (s) #define tryGetStream(s) (s) #define releaseStream(s) #endif /*O_PLMT*/ int PL_release_stream(IOSTREAM *s) { if ( Sferror(s) ) return streamStatus(s); releaseStream(s); return TRUE; } #define SH_ERRORS 0x01 /* generate errors */ #define SH_ALIAS 0x02 /* allow alias */ #define SH_UNLOCKED 0x04 /* don't lock the stream */ #define SH_SAFE 0x08 /* Lookup in table */ static int get_stream_handle__LD(term_t t, IOSTREAM **s, int flags ARG_LD) { atom_t alias; if ( PL_is_functor(t, FUNCTOR_dstream1) ) { void *p; term_t a = PL_new_term_ref(); _PL_get_arg(1, t, a); if ( PL_get_pointer(a, &p) ) { if ( flags & SH_SAFE ) { Symbol symb; LOCK(); symb = lookupHTable(streamContext, p); UNLOCK(); if ( !symb ) goto noent; } if ( flags & SH_UNLOCKED ) { if ( ((IOSTREAM *)p)->magic == SIO_MAGIC ) { *s = p; return TRUE; } goto noent; } if ( (*s = getStream(p)) ) return TRUE; goto noent; } } else if ( PL_get_atom(t, &alias) ) { Symbol symb; if ( !(flags & SH_UNLOCKED) ) LOCK(); if ( (symb=lookupHTable(streamAliases, (void *)alias)) ) { IOSTREAM *stream; uintptr_t n = (uintptr_t)symb->value; if ( n < 6 ) /* standard stream! */ { stream = LD->IO.streams[n]; } else stream = symb->value; if ( !(flags & SH_UNLOCKED) ) UNLOCK(); if ( stream ) { if ( (flags & SH_UNLOCKED) ) { if ( stream->magic == SIO_MAGIC ) { *s = stream; return TRUE; } } else if ( (*s = getStream(stream)) ) return TRUE; goto noent; } } if ( !(flags & SH_UNLOCKED) ) UNLOCK(); goto noent; } if ( flags & SH_ERRORS ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, (flags&SH_ALIAS) ? ATOM_stream_or_alias : ATOM_stream, t); fail; noent: if ( flags & SH_ERRORS ) PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_stream, t); fail; } #define get_stream_handle(t, sp, flags) \ get_stream_handle__LD(t, sp, flags PASS_LD) int PL_get_stream_handle(term_t t, IOSTREAM **s) { GET_LD return get_stream_handle(t, s, SH_ERRORS|SH_ALIAS); } int PL_unify_stream_or_alias(term_t t, IOSTREAM *s) { GET_LD int rval; stream_context *ctx; int i; if ( (i=standardStreamIndexFromStream(s)) >= 0 && i < 3 ) return PL_unify_atom(t, standardStreams[i]); LOCK(); ctx = getStreamContext(s); if ( ctx->alias_head ) { rval = PL_unify_atom(t, ctx->alias_head->name); } 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); } UNLOCK(); return rval; } int PL_unify_stream(term_t t, IOSTREAM *s) { GET_LD stream_context *ctx; term_t a = PL_new_term_ref(); LOCK(); ctx = getStreamContext(s); UNLOCK(); PL_put_pointer(a, s); PL_cons_functor(a, FUNCTOR_dstream1, a); if ( PL_unify(t, a) ) succeed; if ( PL_is_functor(t, FUNCTOR_dstream1) ) fail; return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream, t); } bool /* old FLI name (compatibility) */ PL_open_stream(term_t handle, IOSTREAM *s) { return PL_unify_stream(handle, s); } IOSTREAM ** /* provide access to Suser_input, */ _PL_streams(void) /* Suser_output and Suser_error */ { GET_LD return &Suser_input; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - getInputStream(term_t t, IOSTREAM **s) getOutputStream(term_t t, IOSTREAM **s) These functions are the basis used by all Prolog predicates to get a input or output stream handle. If t = 0, current input/output is returned. This allows us to define the standard-stream based version simply by calling the explicit stream-based version with 0 for the stream argument. MT: The returned stream is always locked and should be returned using releaseStream() or streamStatus(). - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static bool getOutputStream(term_t t, IOSTREAM **stream) { GET_LD atom_t a; IOSTREAM *s; if ( t == 0 ) { *stream = getStream(Scurout); return TRUE; } else if ( PL_get_atom(t, &a) && a == ATOM_user ) { *stream = getStream(Suser_output); return TRUE; } else { *stream = NULL; /* make compiler happy */ } if ( !PL_get_stream_handle(t, &s) ) fail; if ( !(s->flags &SIO_OUTPUT) ) { releaseStream(s); return PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_output, ATOM_stream, t); } *stream = s; succeed; } static bool getInputStream__LD(term_t t, IOSTREAM **stream ARG_LD) { atom_t a; IOSTREAM *s; if ( t == 0 ) { *stream = getStream(Scurin); return TRUE; } else if ( PL_get_atom(t, &a) && a == ATOM_user ) { *stream = getStream(Suser_input); return TRUE; } else { *stream = NULL; /* make compiler happy */ } if ( !get_stream_handle(t, &s, SH_ERRORS|SH_ALIAS) ) fail; if ( !(s->flags &SIO_INPUT) ) { releaseStream(s); return PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_input, ATOM_stream, t); } *stream = s; succeed; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - In windows GUI applications, the IO-streams are not bound. We do not wish to generate an error on the stream errors that may be caused by this. It is a bit of a hack, but the alternative is to define a stream that ignores the error. This might get hairy if the user is playing with these streams too. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifdef __WINDOWS__ static int isConsoleStream(IOSTREAM *s) { int i = standardStreamIndexFromStream(s); return i >= 0 && i < 3; } #else #define isConsoleStream(s) FALSE #endif bool reportStreamError(IOSTREAM *s) { if ( GD->cleaning == CLN_NORMAL && !isConsoleStream(s) && (s->flags & (SIO_FERR|SIO_WARN)) ) { GET_LD atom_t op; term_t stream = PL_new_term_ref(); char *msg; PL_unify_stream_or_alias(stream, 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); PL_erase(s->exception); s->exception = NULL; PL_raise_exception(ex); PL_close_foreign_frame(fid); fail; } if ( s->flags & SIO_INPUT ) { if ( Sfpasteof(s) ) { return PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_input, ATOM_past_end_of_stream, stream); } else if ( (s->flags & SIO_TIMEOUT) ) { PL_error(NULL, 0, NULL, ERR_TIMEOUT, ATOM_read, stream); Sclearerr(s); fail; } else op = ATOM_read; } else op = ATOM_write; msg = s->message ? s->message : MSG_ERRNO; PL_error(NULL, 0, msg, ERR_STREAM_OP, op, stream); if ( (s->flags & SIO_CLEARERR) ) Sseterr(s, SIO_FERR, NULL); fail; } else { printMessage(ATOM_warning, PL_FUNCTOR_CHARS, "io_warning", 2, PL_TERM, stream, PL_CHARS, s->message); Sseterr(s, SIO_WARN, NULL); } } succeed; } bool streamStatus(IOSTREAM *s) { if ( (s->flags & (SIO_FERR|SIO_WARN)) ) { releaseStream(s); return reportStreamError(s); } releaseStream(s); succeed; } /******************************* * TTY MODES * *******************************/ ttybuf ttytab; /* saved terminal status on entry */ int ttymode; /* Current tty mode */ typedef struct input_context * InputContext; typedef struct output_context * OutputContext; struct input_context { IOSTREAM * stream; /* pushed input */ atom_t term_file; /* old term_position file */ int term_line; /* old term_position line */ InputContext previous; /* previous context */ }; struct output_context { IOSTREAM * stream; /* pushed output */ OutputContext previous; /* previous context */ }; #define input_context_stack (LD->IO.input_stack) #define output_context_stack (LD->IO.output_stack) static IOSTREAM *openStream(term_t file, term_t mode, term_t options); void dieIO(void) { if ( GD->io_initialised ) { pl_noprotocol(); closeFiles(TRUE); PopTty(Sinput, &ttytab); } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - closeStream() performs Prolog-level closing. Most important right now is to to avoid closing the user-streams. If a stream cannot be flushed (due to a write-error), an exception is generated. MT: We assume the stream is locked and will unlock it here. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static bool closeStream(IOSTREAM *s) { if ( s == Sinput ) { Sclearerr(s); releaseStream(s); } else if ( s == Soutput || s == Serror ) { if ( Sflush(s) < 0 ) return streamStatus(s); releaseStream(s); } else { if ( !Sferror(s) && Sflush(s) < 0 ) { streamStatus(s); Sclose(s); return FALSE; } if ( Sclose(s) < 0 ) /* will unlock as well */ fail; } succeed; } void closeFiles(int all) { GET_LD TableEnum e; Symbol symb; e = newTableEnum(streamContext); while( (symb=advanceTableEnum(e)) ) { IOSTREAM *s = symb->name; if ( all || !(s->flags & SIO_NOCLOSE) ) { IOSTREAM *s2 = tryGetStream(s); if ( s2 ) { if ( !all ) { term_t t = PL_new_term_ref(); PL_unify_stream_or_alias(t, s2); printMessage(ATOM_informational, PL_FUNCTOR, FUNCTOR_close_on_abort1, PL_TERM, t); PL_reset_term_refs(t); } closeStream(s2); } } } freeTableEnum(e); } void PL_cleanup_fork(void) { TableEnum e; Symbol symb; e = newTableEnum(streamContext); while( (symb=advanceTableEnum(e)) ) { IOSTREAM *s = symb->name; int fd; if ( (fd=Sfileno(s)) >= 3 ) close(fd); } freeTableEnum(e); stopItimer(); } void protocol(const char *str, size_t n) { GET_LD IOSTREAM *s; if ( LD && (s = getStream(Sprotocol)) ) { while( n-- > 0 ) Sputcode(*str++&0xff, s); Sflush(s); releaseStream(s); /* we don not check errors */ } } /******************************* * TEMPORARY I/O * *******************************/ static word pl_push_input_context(void) { GET_LD InputContext c = allocHeap(sizeof(struct input_context)); c->stream = Scurin; c->term_file = source_file_name; c->term_line = source_line_no; c->previous = input_context_stack; input_context_stack = c; succeed; } static word pl_pop_input_context(void) { GET_LD InputContext c = input_context_stack; if ( c ) { Scurin = c->stream; source_file_name = c->term_file; source_line_no = c->term_line; input_context_stack = c->previous; freeHeap(c, sizeof(struct input_context)); succeed; } else { Scurin = Sinput; fail; } } static void pushOutputContext(void) { GET_LD OutputContext c = allocHeap(sizeof(struct output_context)); c->stream = Scurout; c->previous = output_context_stack; output_context_stack = c; } static void popOutputContext(void) { GET_LD OutputContext c = output_context_stack; if ( c ) { if ( c->stream->magic == SIO_MAGIC ) Scurout = c->stream; else { Sdprintf("Oops, current stream closed?"); Scurout = Soutput; } output_context_stack = c->previous; freeHeap(c, sizeof(struct output_context)); } else Scurout = Soutput; } int setupOutputRedirect(term_t to, redir_context *ctx, int redir) { GET_LD atom_t a; ctx->term = to; ctx->redirected = redir; if ( to == 0 ) { ctx->stream = getStream(Scurout); ctx->is_stream = TRUE; } else if ( PL_get_atom(to, &a) && a == ATOM_user ) { ctx->stream = getStream(Suser_output); ctx->is_stream = TRUE; } else if ( get_stream_handle(to, &ctx->stream, SH_SAFE) ) { if ( !(ctx->stream->flags &SIO_OUTPUT) ) { releaseStream(ctx->stream); return PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_output, ATOM_stream, to); } ctx->is_stream = TRUE; } else { if ( PL_is_functor(to, FUNCTOR_codes2) ) { ctx->out_format = PL_CODE_LIST; ctx->out_arity = 2; } else if ( PL_is_functor(to, FUNCTOR_codes1) ) { ctx->out_format = PL_CODE_LIST; ctx->out_arity = 1; } else if ( PL_is_functor(to, FUNCTOR_chars2) ) { ctx->out_format = PL_CHAR_LIST; ctx->out_arity = 2; } else if ( PL_is_functor(to, FUNCTOR_chars1) ) { ctx->out_format = PL_CHAR_LIST; ctx->out_arity = 1; } else if ( PL_is_functor(to, FUNCTOR_string1) ) { ctx->out_format = PL_STRING; ctx->out_arity = 1; } else if ( PL_is_functor(to, FUNCTOR_atom1) ) { ctx->out_format = PL_ATOM; ctx->out_arity = 1; } else { return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_output, to); } ctx->is_stream = FALSE; ctx->data = ctx->buffer; ctx->size = sizeof(ctx->buffer); ctx->stream = Sopenmem(&ctx->data, &ctx->size, "w"); ctx->stream->encoding = ENC_WCHAR; } ctx->magic = REDIR_MAGIC; if ( redir ) { pushOutputContext(); Scurout = ctx->stream; } succeed; } int closeOutputRedirect(redir_context *ctx) { int rval = TRUE; if ( ctx->magic != REDIR_MAGIC ) return rval; /* already done */ ctx->magic = 0; if ( ctx->redirected ) popOutputContext(); if ( ctx->is_stream ) { rval = streamStatus(ctx->stream); } else { GET_LD term_t out = PL_new_term_ref(); term_t diff, tail; closeStream(ctx->stream); _PL_get_arg(1, ctx->term, out); if ( ctx->out_arity == 2 ) { diff = PL_new_term_ref(); _PL_get_arg(2, ctx->term, diff); tail = PL_new_term_ref(); } else { diff = tail = 0; } rval = PL_unify_wchars_diff(out, tail, ctx->out_format, ctx->size/sizeof(wchar_t), (wchar_t*)ctx->data); if ( tail ) rval = PL_unify(tail, diff); if ( ctx->data != ctx->buffer ) free(ctx->data); } return rval; } void discardOutputRedirect(redir_context *ctx) { if ( ctx->magic != REDIR_MAGIC ) return; /* already done */ ctx->magic = 0; if ( ctx->redirected ) popOutputContext(); if ( ctx->is_stream ) { releaseStream(ctx->stream); } else { closeStream(ctx->stream); if ( ctx->data != ctx->buffer ) free(ctx->data); } } static PRED_IMPL("with_output_to", 2, with_output_to, PL_FA_TRANSPARENT) { redir_context outctx; if ( setupOutputRedirect(A1, &outctx, TRUE) ) { term_t ex = 0; int rval; if ( (rval = callProlog(NULL, A2, PL_Q_CATCH_EXCEPTION, &ex)) ) return closeOutputRedirect(&outctx); discardOutputRedirect(&outctx); if ( ex ) return PL_raise_exception(ex); } fail; } void PL_write_prompt(int dowrite) { GET_LD IOSTREAM *s = getStream(Suser_output); if ( s ) { if ( dowrite ) { atom_t a = PrologPrompt(); if ( a ) writeAtomToStream(s, a); } Sflush(s); releaseStream(s); } LD->prompt.next = FALSE; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Get a single character from Sinput without waiting for a return. The character should not be echoed. If TTY_CONTROL_FEATURE is false this function will read the first character and then skip all character upto and including the newline. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static int Sgetcode_intr(IOSTREAM *s, int signals) { int c; #ifdef __WINDOWS__ int newline = s->newline; s->newline = SIO_NL_POSIX; /* avoid blocking \r */ #endif do { Sclearerr(s); c = Sgetcode(s); } while ( c == -1 && errno == EINTR && (!signals || PL_handle_signals() >= 0) ); #ifdef __WINDOWS__ s->newline = newline; #endif return c; } static int getSingleChar(IOSTREAM *stream, int signals) { GET_LD int c; ttybuf buf; // debugstatus.suspendTrace++; WARNING: suspendTrace Slock(stream); Sflush(stream); PushTty(stream, &buf, TTY_RAW); /* just donot prompt */ if ( !trueFeature(TTY_CONTROL_FEATURE) ) { int c2; c2 = Sgetcode_intr(stream, signals); while( c2 == ' ' || c2 == '\t' ) /* skip blanks */ c2 = Sgetcode_intr(stream, signals); c = c2; while( c2 != EOF && c2 != '\n' ) /* read upto newline */ c2 = Sgetcode_intr(stream, signals); } else { if ( stream->position ) { IOPOS oldpos = *stream->position; c = Sgetcode_intr(stream, signals); *stream->position = oldpos; } else c = Sgetcode_intr(stream, signals); } if ( c == 4 || c == 26 ) /* should ask the terminal! */ c = -1; PopTty(stream, &buf); // debugstatus.suspendTrace--; WARNING: suspendTrace Sunlock(stream); return c; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - readLine() reads a line from the terminal. It is used only by the tracer. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifndef DEL #define DEL 127 #endif bool readLine(IOSTREAM *in, IOSTREAM *out, char *buffer) { GET_LD int c; char *buf = &buffer[strlen(buffer)]; ttybuf tbuf; Slock(in); Slock(out); PushTty(in, &tbuf, TTY_RAW); /* just donot prompt */ for(;;) { Sflush(out); switch( (c=Sgetc(in)) ) { case '\n': case '\r': case EOF: *buf++ = EOS; PopTty(in, &tbuf); Sunlock(in); Sunlock(out); return c == EOF ? FALSE : TRUE; case '\b': case DEL: if ( trueFeature(TTY_CONTROL_FEATURE) && buf > buffer ) { Sfputs("\b \b", out); buf--; } default: if ( trueFeature(TTY_CONTROL_FEATURE) ) Sputc(c, out); *buf++ = c; } } } IOSTREAM * PL_current_input() { GET_LD return getStream(Scurin); } IOSTREAM * PL_current_output() { GET_LD return getStream(Scurout); } static word openProtocol(term_t f, bool appnd) { GET_LD IOSTREAM *s; term_t mode = PL_new_term_ref(); pl_noprotocol(); PL_put_atom(mode, appnd ? ATOM_append : ATOM_write); if ( (s = openStream(f, mode, 0)) ) { s->flags |= SIO_NOCLOSE; /* do not close on abort */ Sprotocol = s; Suser_input->tee = s; Suser_output->tee = s; Suser_error->tee = s; return TRUE; } return FALSE; } word pl_noprotocol(void) { GET_LD IOSTREAM *s; if ( (s = getStream(Sprotocol)) ) { TableEnum e; Symbol symb; e = newTableEnum(streamContext); while( (symb=advanceTableEnum(e)) ) { IOSTREAM *p = symb->name; if ( p->tee == s ) p->tee = NULL; } freeTableEnum(e); closeStream(s); Sprotocol = NULL; } succeed; } /******************************* * STREAM ATTRIBUTES * *******************************/ static foreign_t pl_set_stream(term_t stream, term_t attr) { GET_LD IOSTREAM *s; atom_t aname; int arity; if ( !PL_get_stream_handle(stream, &s) ) fail; if ( PL_get_name_arity(attr, &aname, &arity) ) { if ( arity == 1 ) { term_t a = PL_new_term_ref(); _PL_get_arg(1, attr, a); if ( aname == ATOM_alias ) /* alias(name) */ { atom_t alias; int i; if ( !PL_get_atom_ex(a, &alias) ) goto error; if ( (i=standardStreamIndexFromName(alias)) >= 0 ) { LD->IO.streams[i] = s; if ( i == 0 ) LD->prompt.next = TRUE; /* changed standard input: prompt! */ goto ok; } LOCK(); aliasStream(s, alias); UNLOCK(); goto ok; } else if ( aname == ATOM_buffer ) /* buffer(Buffering) */ { atom_t b; #define SIO_ABUF (SIO_FBUF|SIO_LBUF|SIO_NBUF) if ( !PL_get_atom_ex(a, &b) ) goto error; if ( b == ATOM_full ) { s->flags &= ~SIO_ABUF; s->flags |= SIO_FBUF; } else if ( b == ATOM_line ) { s->flags &= ~SIO_ABUF; s->flags |= SIO_LBUF; } else if ( b == ATOM_false ) { Sflush(s); s->flags &= ~SIO_ABUF; s->flags |= SIO_NBUF; } else { PL_error("set_stream", 2, NULL, ERR_DOMAIN, ATOM_buffer, a); goto error; } goto ok; } else if ( aname == ATOM_buffer_size ) { int size; if ( !PL_get_integer_ex(a, &size) ) goto error; if ( size < 1 ) { PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_not_less_than_one, a); goto error; } Ssetbuffer(s, NULL, size); goto ok; } else if ( aname == ATOM_eof_action ) /* eof_action(Action) */ { atom_t action; if ( !PL_get_atom_ex(a, &action) ) fail; if ( action == ATOM_eof_code ) { s->flags &= ~(SIO_NOFEOF|SIO_FEOF2ERR); } else if ( action == ATOM_reset ) { s->flags &= ~SIO_FEOF2ERR; s->flags |= SIO_NOFEOF; } else if ( action == ATOM_error ) { s->flags &= ~SIO_NOFEOF; s->flags |= SIO_FEOF2ERR; } else { PL_error("set_stream", 2, NULL, ERR_DOMAIN, ATOM_eof_action, a); goto error; } goto ok; } else if ( aname == ATOM_close_on_abort ) /* close_on_abort(Bool) */ { int close; if ( !PL_get_bool_ex(a, &close) ) goto error; if ( close ) s->flags &= ~SIO_NOCLOSE; else s->flags |= SIO_NOCLOSE; goto ok; } else if ( aname == ATOM_record_position ) { int rec; if ( !PL_get_bool_ex(a, &rec) ) goto error; if ( rec ) s->position = &s->posbuf; else s->position = NULL; goto ok; } else if ( aname == ATOM_file_name ) /* file_name(Atom) */ { atom_t fn; if ( !PL_get_atom_ex(a, &fn) ) goto error; LOCK(); setFileNameStream(s, fn); UNLOCK(); goto ok; } else if ( aname == ATOM_timeout ) { double f; atom_t v; if ( PL_get_atom(a, &v) && v == ATOM_infinite ) { s->timeout = -1; goto ok; } if ( !PL_get_float_ex(a, &f) ) goto error; s->timeout = (int)(f*1000.0); if ( s->timeout < 0 ) s->timeout = 0; goto ok; } else if ( aname == ATOM_tty ) /* tty(bool) */ { int val; if ( !PL_get_bool_ex(a, &val) ) goto error; if ( val ) set(s, SIO_ISATTY); else clear(s, SIO_ISATTY); goto ok; } else if ( aname == ATOM_encoding ) /* encoding(atom) */ { atom_t val; IOENC enc; if ( !PL_get_atom_ex(a, &val) ) goto error; if ( (enc = atom_to_encoding(val)) == ENC_UNKNOWN ) { bad_encoding(val); goto error; } if ( Ssetenc(s, enc, NULL) == 0 ) goto ok; PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_encoding, ATOM_stream, stream); goto error; } else if ( aname == ATOM_representation_errors ) { atom_t val; if ( !PL_get_atom_ex(a, &val) ) goto error; clear(s, SIO_REPXML|SIO_REPPL); if ( val == ATOM_error ) ; else if ( val == ATOM_xml ) set(s, SIO_REPXML); else if ( val == ATOM_prolog ) set(s, SIO_REPPL); else { PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_representation_errors, a); goto error; } goto ok; } else if ( aname == ATOM_newline ) { atom_t val; if ( !PL_get_atom_ex(a, &val) ) goto error; if ( val == ATOM_posix ) s->newline = SIO_NL_POSIX; else if ( val == ATOM_dos ) s->newline = SIO_NL_DOS; else if ( val == ATOM_detect ) { if ( false(s, SIO_INPUT) ) { PL_error(NULL, 0, "detect only allowed for input streams", ERR_DOMAIN, ATOM_newline, a); goto error; } s->newline = SIO_NL_DETECT; } else { PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_newline, a); goto error; } goto ok; } } } PL_error("set_stream", 2, NULL, ERR_TYPE, PL_new_atom("stream_attribute"), attr); goto error; ok: releaseStream(s); succeed; error: releaseStream(s); fail; } /******************************** * STRING I/O * *********************************/ extern IOFUNCTIONS Smemfunctions; bool tellString(char **s, size_t *size, IOENC enc) { GET_LD IOSTREAM *stream; stream = Sopenmem(s, size, "w"); stream->encoding = enc; pushOutputContext(); Scurout = stream; return TRUE; } bool toldString(void) { GET_LD IOSTREAM *s = getStream(Scurout); if ( !s ) succeed; if ( s->functions == &Smemfunctions ) { closeStream(s); popOutputContext(); } else releaseStream(s); succeed; } /******************************** * WAITING FOR INPUT * ********************************/ #ifndef HAVE_SELECT word pl_wait_for_input(term_t streams, term_t available, term_t timeout) { GET_LD return notImplemented("wait_for_input", 3); } #else typedef struct fdentry { int fd; term_t stream; struct fdentry *next; } fdentry; static inline term_t findmap(fdentry *map, int fd) { for( ; map; map = map->next ) { if ( map->fd == fd ) return map->stream; } assert(0); return 0; } static word pl_wait_for_input(term_t Streams, term_t Available, term_t timeout) { GET_LD fd_set fds; struct timeval t, *to; double time; int n, max = 0, ret, min = 1 << (INTBITSIZE-2); fdentry *map = NULL; term_t head = PL_new_term_ref(); term_t streams = PL_copy_term_ref(Streams); term_t available = PL_copy_term_ref(Available); term_t ahead = PL_new_term_ref(); int from_buffer = 0; atom_t a; FD_ZERO(&fds); while( PL_get_list(streams, head, streams) ) { IOSTREAM *s; int fd; fdentry *e; if ( !PL_get_stream_handle(head, &s) ) fail; if ( (fd=Sfileno(s)) < 0 ) { releaseStream(s); return PL_error("wait_for_input", 3, NULL, ERR_DOMAIN, PL_new_atom("file_stream"), head); } releaseStream(s); /* check for input in buffer */ if ( s->bufp < s->limitp ) { if ( !PL_unify_list(available, ahead, available) || !PL_unify(ahead, head) ) fail; from_buffer++; } e = alloca(sizeof(*e)); e->fd = fd; e->stream = PL_copy_term_ref(head); e->next = map; map = e; #ifdef __WINDOWS__ FD_SET((SOCKET)fd, &fds); #else FD_SET(fd, &fds); #endif if ( fd > max ) max = fd; if( fd < min ) min = fd; } if ( !PL_get_nil(streams) ) return PL_error("wait_for_input", 3, NULL, ERR_TYPE, ATOM_list, Streams); if ( from_buffer > 0 ) return PL_unify_nil(available); if ( PL_get_atom(timeout, &a) && a == ATOM_infinite ) { to = NULL; } else if ( PL_is_integer(timeout) ) { long v; PL_get_long(timeout, &v); if ( v > 0L ) { t.tv_sec = v; t.tv_usec = 0; to = &t; } else if ( v == 0 ) { to = NULL; } else { t.tv_sec = 0; t.tv_usec = 0; to = &t; } } else { if ( !PL_get_float(timeout, &time) ) return PL_error("wait_for_input", 3, NULL, ERR_TYPE, ATOM_float, timeout); if ( time >= 0.0 ) { t.tv_sec = (int)time; t.tv_usec = ((int)(time * 1000000) % 1000000); } else { t.tv_sec = 0; t.tv_usec = 0; } to = &t; } while( (ret=select(max+1, &fds, NULL, NULL, to)) == -1 && errno == EINTR ) { fdentry *e; if ( PL_handle_signals() < 0 ) fail; /* exception */ FD_ZERO(&fds); /* EINTR may leave fds undefined */ for(e=map; e; e=e->next) /* so we rebuild it to be safe */ { #ifdef __WINDOWS__ FD_SET((SOCKET)e->fd, &fds); #else FD_SET(e->fd, &fds); #endif } } switch(ret) { case -1: return PL_error("wait_for_input", 3, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_select, ATOM_stream, Streams); case 0: /* Timeout */ break; default: /* Something happend -> check fds */ for(n=min; n <= max; n++) { if ( FD_ISSET(n, &fds) ) { if ( !PL_unify_list(available, ahead, available) || !PL_unify(ahead, findmap(map, n)) ) fail; } } break; } return PL_unify_nil(available); } #endif /* HAVE_SELECT */ /******************************** * PROLOG CONNECTION * *********************************/ #define MAX_PENDING SIO_BUFSIZE /* 4096 */ static void re_buffer(IOSTREAM *s, const char *from, size_t len) { if ( s->bufp < s->limitp ) { size_t size = s->limitp - s->bufp; memmove(s->buffer, s->bufp, size); s->bufp = s->buffer; s->limitp = &s->bufp[size]; } else { s->bufp = s->limitp = s->buffer; } memcpy(s->bufp, from, len); s->bufp += len; } #ifndef HAVE_MBSNRTOWCS static size_t mbsnrtowcs(wchar_t *dest, const char **src, size_t nms, size_t len, mbstate_t *ps) { wchar_t c; const char *us = *src; const char *es = us+nms; size_t count = 0; assert(dest == NULL); /* incomplete implementation */ while(usflags&SIO_TEXT ) { switch(s->newline) { case SIO_NL_DETECT: s->newline = SIO_NL_DOS; /*FALLTHROUGH*/ case SIO_NL_DOS: return TRUE; } } return FALSE; } static PRED_IMPL("read_pending_input", 3, read_pending_input, 0) { PRED_LD IOSTREAM *s; if ( getInputStream(A1, &s) ) { char buf[MAX_PENDING]; ssize_t n; word gstore, lp; int64_t off0 = Stell64(s); IOPOS pos0; if ( Sferror(s) ) return streamStatus(s); n = Sread_pending(s, buf, sizeof(buf), 0); if ( n < 0 ) /* should not happen */ return streamStatus(s); if ( n == 0 ) /* end-of-file */ { S__fcheckpasteeof(s, -1); return PL_unify(A2, A3); } if ( s->position ) { pos0 = *s->position; } else { memset(&pos0, 0, sizeof(pos0)); /* make compiler happy */ } switch(s->encoding) { case ENC_OCTET: case ENC_ISO_LATIN_1: case ENC_ASCII: { ssize_t i; lp = gstore = INIT_SEQ_CODES(n); // lp = gstore = allocGlobal(1+n*3); /* TBD: shift */ for(i=0; iposition ) S__fupdatefilepos_getc(s, c); gstore = EXTEND_SEQ_CODES(gstore, c); } if ( s->position ) s->position->byteno = pos0.byteno+n; break; } case ENC_ANSI: { size_t count, i; mbstate_t s0; const char *us = buf; const char *es = buf+n; if ( !s->mbstate ) { if ( !(s->mbstate = malloc(sizeof(*s->mbstate))) ) { PL_error(NULL, 0, NULL, ERR_NOMEM); goto failure; } memset(s->mbstate, 0, sizeof(*s->mbstate)); } s0 = *s->mbstate; count = mbsnrtowcs(NULL, &us, n, 0, &s0); if ( count == (size_t)-1 ) { Sseterr(s, SIO_WARN, "Illegal multibyte Sequence"); goto failure; } DEBUG(2, Sdprintf("Got %ld codes from %d bytes; incomplete: %ld\n", count, n, es-us)); lp = gstore = INIT_SEQ_CODES(count); for(us=buf,i=0; imbstate); if ( c == '\r' && skip_cr(s) ) continue; if ( s->position ) S__fupdatefilepos_getc(s, c); gstore = EXTEND_SEQ_CODES(gstore, c); } if ( s->position ) s->position->byteno = pos0.byteno+us-buf; re_buffer(s, us, es-us); break; } case ENC_UTF8: { const char *us = buf; const char *es = buf+n; size_t count = 0, i; while(usposition ) S__fupdatefilepos_getc(s, c); gstore = EXTEND_SEQ_CODES(gstore, c); } if ( s->position ) s->position->byteno = pos0.byteno+us-buf; re_buffer(s, us, es-us); break; } case ENC_UNICODE_BE: case ENC_UNICODE_LE: { size_t count = (size_t)n/2; const char *us = buf; size_t done, i; lp = gstore = INIT_SEQ_CODES(count); for(i=0; iencoding == ENC_UNICODE_BE ) c = ((us[0]&0xff)<<8)+(us[1]&0xff); else c = ((us[1]&0xff)<<8)+(us[0]&0xff); if ( c == '\r' && skip_cr(s) ) continue; if ( s->position ) S__fupdatefilepos_getc(s, c); gstore = EXTEND_SEQ_CODES(gstore, c); } done = count*2; if ( s->position ) s->position->byteno = pos0.byteno+done; re_buffer(s, buf+done, n-done); break; } case ENC_WCHAR: { const pl_wchar_t *ws = (const pl_wchar_t*)buf; size_t count = (size_t)n/sizeof(pl_wchar_t); size_t done, i; lp = gstore = INIT_SEQ_CODES(count); for(i=0; iposition ) S__fupdatefilepos_getc(s, c); gstore = EXTEND_SEQ_CODES(gstore, c); } done = count*sizeof(pl_wchar_t); if ( s->position ) s->position->byteno = pos0.byteno+done; re_buffer(s, buf+done, n-done); break; } case ENC_UNKNOWN: default: assert(0); fail; } if (!CLOSE_SEQ_OF_CODES(gstore, lp, A2, A3)) goto failure; releaseStream(s); succeed; failure: Sseek64(s, off0, SIO_SEEK_SET); /* TBD: error? */ if ( s->position ) *s->position = pos0; releaseStream(s); fail; } fail; } int PL_get_char(term_t c, int *p, int eof) { GET_LD int chr; atom_t name; PL_chars_t text; if ( PL_get_integer(c, &chr) ) { if ( chr >= 0 ) { *p = chr; return TRUE; } if ( eof && chr == -1 ) { *p = chr; return TRUE; } } else if ( PL_get_text(c, &text, CVT_ATOM|CVT_STRING|CVT_LIST) && text.length == 1 ) { *p = text.encoding == ENC_ISO_LATIN_1 ? text.text.t[0]&0xff : text.text.w[0]; return TRUE; } else if ( eof && PL_get_atom(c, &name) && name == ATOM_end_of_file ) { *p = -1; return TRUE; } return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_character, c); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - PL_unify_char(term_t chr, int c, int how) Unify a character. Try to be as flexible as possible, only binding a variable `chr' to a code or one-char-atom. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ int PL_unify_char(term_t chr, int c, int how) { GET_LD int c2 = -1; if ( PL_is_variable(chr) ) { switch(how) { case CHAR_MODE: { atom_t a = (c == -1 ? ATOM_end_of_file : codeToAtom(c)); return PL_unify_atom(chr, a); } case CODE_MODE: case BYTE_MODE: default: return PL_unify_integer(chr, c); } } else if ( PL_get_char(chr, &c2, TRUE) ) return c == c2; fail; } static foreign_t put_byte(term_t stream, term_t byte ARG_LD) { IOSTREAM *s; int c; if ( !PL_get_integer(byte, &c) || c < 0 || c > 255 ) return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_byte, byte); if ( !getOutputStream(stream, &s) ) fail; Sputc(c, s); return streamStatus(s); } static PRED_IMPL("put_byte", 2, put_byte2, 0) { PRED_LD return put_byte(A1, A2 PASS_LD); } static PRED_IMPL("put_byte", 1, put_byte1, 0) { PRED_LD return put_byte(0, A1 PASS_LD); } static foreign_t put_code(term_t stream, term_t chr ARG_LD) { IOSTREAM *s; int c = 0; if ( !PL_get_char(chr, &c, FALSE) ) fail; if ( !getOutputStream(stream, &s) ) fail; Sputcode(c, s); return streamStatus(s); } static PRED_IMPL("put_code", 2, put_code2, 0) { PRED_LD return put_code(A1, A2 PASS_LD); } static PRED_IMPL("put_code", 1, put_code1, 0) { PRED_LD return put_code(0, A1 PASS_LD); } static PRED_IMPL("put", 2, put2, 0) { PRED_LD return put_code(A1, A2 PASS_LD); } static PRED_IMPL("put", 1, put1, 0) { PRED_LD return put_code(0, A1 PASS_LD); } static foreign_t get_nonblank(term_t in, term_t chr ARG_LD) { IOSTREAM *s; if ( getInputStream(in, &s) ) { int c; for(;;) { c = Sgetcode(s); if ( c == EOF ) { TRY(PL_unify_integer(chr, -1)); return streamStatus(s); } if ( !isBlankW(c) ) { releaseStream(s); return PL_unify_integer(chr, c); } } } fail; } static PRED_IMPL("get", 1, get1, 0) { PRED_LD return get_nonblank(0, A1 PASS_LD); } static PRED_IMPL("get", 2, get2, 0) { PRED_LD return get_nonblank(A1, A2 PASS_LD); } static foreign_t skip(term_t in, term_t chr ARG_LD) { int c = -1; int r; IOSTREAM *s; if ( !PL_get_char(chr, &c, FALSE) ) fail; if ( !getInputStream(in, &s) ) fail; while((r=Sgetcode(s)) != c && r != EOF ) ; return streamStatus(s); } static PRED_IMPL("skip", 1, skip1, 0) { PRED_LD return skip(0, A1 PASS_LD); } static PRED_IMPL("skip", 2, skip2, 0) { PRED_LD return skip(A1, A2 PASS_LD); } static word pl_get_single_char(term_t chr) { GET_LD IOSTREAM *s = getStream(Suser_input); int c = getSingleChar(s, TRUE); if ( c == EOF ) { PL_unify_integer(chr, -1); return streamStatus(s); } releaseStream(s); return PL_unify_integer(chr, c); } static foreign_t pl_get_byte2(term_t in, term_t chr ARG_LD) { IOSTREAM *s; if ( getInputStream(in, &s) ) { int c = Sgetc(s); if ( PL_unify_integer(chr, c) ) return streamStatus(s); if ( Sferror(s) ) return streamStatus(s); PL_get_char(chr, &c, TRUE); /* set type-error */ } fail; } static PRED_IMPL("get_byte", 2, get_byte2, 0) { PRED_LD return pl_get_byte2(A1, A2 PASS_LD); } static PRED_IMPL("get_byte", 1, get_byte1, 0) { PRED_LD return pl_get_byte2(0, A1 PASS_LD); } static foreign_t pl_get_code2(term_t in, term_t chr) { GET_LD IOSTREAM *s; if ( getInputStream(in, &s) ) { int c = Sgetcode(s); if ( PL_unify_integer(chr, c) ) return streamStatus(s); if ( Sferror(s) ) return streamStatus(s); PL_get_char(chr, &c, TRUE); /* set type-error */ releaseStream(s); } fail; } static PRED_IMPL("get_code", 2, get_code2, 0) { return pl_get_code2(A1, A2); } static PRED_IMPL("get_code", 1, get_code1, 0) { return pl_get_code2(0, A1); } static foreign_t pl_get_char2(term_t in, term_t chr) { GET_LD IOSTREAM *s; if ( getInputStream(in, &s) ) { int c = Sgetcode(s); if ( PL_unify_atom(chr, c == -1 ? ATOM_end_of_file : codeToAtom(c)) ) return streamStatus(s); if ( Sferror(s) ) return streamStatus(s); PL_get_char(chr, &c, TRUE); /* set type-error */ releaseStream(s); } fail; } static PRED_IMPL("get_char", 2, get_char2, 0) { return pl_get_char2(A1, A2); } static PRED_IMPL("get_char", 1, get_char1, 0) { return pl_get_char2(0, A1); } static word pl_ttyflush(void) { GET_LD IOSTREAM *s = getStream(Suser_output); Sflush(s); return streamStatus(s); } static word pl_protocol(term_t file) { return openProtocol(file, FALSE); } static word pl_protocola(term_t file) { return openProtocol(file, TRUE); } static word pl_protocolling(term_t file) { GET_LD IOSTREAM *s; if ( (s = Sprotocol) ) { atom_t a; if ( (a = fileNameStream(s)) ) return PL_unify_atom(file, a); else return PL_unify_stream_or_alias(file, s); } fail; } static word pl_prompt(term_t old, term_t new) { GET_LD atom_t a; if ( PL_unify_atom(old, LD->prompt.current) && PL_get_atom(new, &a) ) { if ( LD->prompt.current ) PL_unregister_atom(LD->prompt.current); LD->prompt.current = a; PL_register_atom(a); succeed; } fail; } static void prompt1(atom_t prompt) { GET_LD if ( LD->prompt.first != prompt ) { if ( LD->prompt.first ) PL_unregister_atom(LD->prompt.first); LD->prompt.first = prompt; PL_register_atom(LD->prompt.first); } LD->prompt.first_used = FALSE; } static word pl_prompt1(term_t prompt) { GET_LD atom_t a; PL_chars_t txt; if ( PL_get_atom(prompt, &a) ) { prompt1(a); } else if ( PL_get_text(prompt, &txt, CVT_ALL|CVT_EXCEPTION) ) { prompt1(textToAtom(&txt)); } else fail; succeed; } atom_t PrologPrompt() { GET_LD if ( !LD->prompt.first_used && LD->prompt.first ) { LD->prompt.first_used = TRUE; return LD->prompt.first; } if ( Sinput->position && Sinput->position->linepos == 0 ) return LD->prompt.current; else return 0; /* "" */ } static word pl_tab2(term_t out, term_t spaces) { GET_LD number n; int rval = FALSE; IOSTREAM *s; if ( !getOutputStream(out, &s) ) fail; if ( valueExpression(spaces, &n PASS_LD) ) { if ( toIntegerNumber(&n, 0) ) { int64_t m; switch(n.type) { case V_INTEGER: m = n.value.i; break; #ifdef O_GMP case V_MPZ: { if ( !mpz_to_int64(n.value.mpz, &m) ) { PL_error(NULL, 0, NULL, ERR_EVALUATION, ATOM_int_overflow); goto error; } } #endif default: assert(0); } while(m-- > 0) { if ( Sputcode(' ', s) < 0 ) break; } rval = TRUE; } clearNumber(&n); } else { rval = PL_error("tab", 1, NULL, ERR_TYPE, ATOM_integer, spaces); } if ( rval ) return streamStatus(s); #ifdef O_GMP error: #endif (void)streamStatus(s); fail; } static word pl_tab(term_t n) { return pl_tab2(0, n); } /******************************* * ENCODING * *******************************/ typedef struct encname { IOENC code; atom_t name; } encoding_name; INIT_DEF(struct encname, encoding_names, 10) ADD_ENCODING( ENC_UNKNOWN, ATOM_unknown ) ADD_ENCODING( ENC_OCTET, ATOM_octet ) ADD_ENCODING( ENC_ASCII, ATOM_ascii ) ADD_ENCODING( ENC_ISO_LATIN_1, ATOM_iso_latin_1 ) ADD_ENCODING( ENC_ANSI, ATOM_text ) ADD_ENCODING( ENC_UTF8, ATOM_utf8 ) ADD_ENCODING( ENC_UNICODE_BE, ATOM_unicode_be ) ADD_ENCODING( ENC_UNICODE_LE, ATOM_unicode_le ) ADD_ENCODING( ENC_WCHAR, ATOM_wchar_t ) END_ENCODINGS( ENC_UNKNOWN, 0 ) IOENC atom_to_encoding(atom_t a) { struct encname *en; for(en=encoding_names; en->name; en++) { if ( en->name == a ) return en->code; } return ENC_UNKNOWN; } static atom_t encoding_to_atom(IOENC enc) { return encoding_names[enc].name; } static int bad_encoding(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); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - fn_to_atom() translates a 8-bit filename into a unicode atom. The encoding is generic `multibyte' on Unix systems and fixed to UTF-8 on Windows, where the uxnt layer translates the UTF-8 sequences to the Windows *W() functions. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static atom_t fn_to_atom(const char *fn) { PL_chars_t text; atom_t a; text.text.t = (char *)fn; text.encoding = ((REP_FN&REP_UTF8) ? ENC_UTF8 : (REP_FN&REP_MB) ? ENC_ANSI : ENC_ISO_LATIN_1); text.storage = PL_CHARS_HEAP; text.length = strlen(fn); text.canonical = FALSE; a = textToAtom(&text); PL_free_text(&text); return a; } /******************************** * STREAM BASED I/O * *********************************/ INIT_DEF(opt_spec, open4_options, 10) ADD_OPEN4_OPT( ATOM_type, OPT_ATOM ) ADD_OPEN4_OPT( ATOM_reposition, OPT_BOOL ) ADD_OPEN4_OPT( ATOM_alias, OPT_ATOM ) ADD_OPEN4_OPT( ATOM_eof_action, OPT_ATOM ) ADD_OPEN4_OPT( ATOM_close_on_abort, OPT_BOOL ) ADD_OPEN4_OPT( ATOM_buffer, OPT_ATOM ) ADD_OPEN4_OPT( ATOM_lock, OPT_ATOM ) ADD_OPEN4_OPT( ATOM_encoding, OPT_ATOM ) ADD_OPEN4_OPT( ATOM_bom, OPT_BOOL ) END_OPEN4_DEFS(NULL_ATOM, 0) IOSTREAM * openStream(term_t file, term_t mode, term_t options) { GET_LD atom_t mname; atom_t type = ATOM_text; bool reposition = TRUE; atom_t alias = NULL_ATOM; atom_t eof_action = ATOM_eof_code; atom_t buffer = ATOM_full; atom_t lock = ATOM_none; atom_t encoding = NULL_ATOM; bool close_on_abort = TRUE; bool bom = -1; char how[10]; char *h = how; char *path; IOSTREAM *s; IOENC enc; if ( options ) { if ( ! scan_options(options, 0, ATOM_stream_option, open4_options, &type, &reposition, &alias, &eof_action, &close_on_abort, &buffer, &lock, &encoding, &bom) ) fail; } /* MODE */ if ( PL_get_atom(mode, &mname) ) { if ( mname == ATOM_write ) { *h++ = 'w'; } else if ( mname == ATOM_append ) { bom = FALSE; *h++ = 'a'; } else if ( mname == ATOM_update ) { bom = FALSE; *h++ = 'u'; } else if ( mname == ATOM_read ) { *h++ = 'r'; } else { PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_io_mode, mode); return NULL; } } else { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, mode); return NULL; } /* ENCODING */ if ( encoding != NULL_ATOM ) { enc = atom_to_encoding(encoding); if ( enc == ENC_UNKNOWN ) { bad_encoding(encoding); return NULL; } } else if ( type == ATOM_binary ) { enc = ENC_OCTET; bom = FALSE; } else { enc = LD->encoding; } if ( bom == -1 ) bom = (mname == ATOM_read ? TRUE : FALSE); if ( type == ATOM_binary ) *h++ = 'b'; /* LOCK */ if ( lock != ATOM_none ) { *h++ = 'l'; if ( lock == ATOM_read || lock == ATOM_shared ) *h++ = 'r'; else if ( lock == ATOM_write || lock == ATOM_exclusive ) *h++ = 'w'; else { term_t l = PL_new_term_ref(); PL_put_atom(l, lock); PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_lock, l); return NULL; } } *h = EOS; /* FILE */ if ( PL_get_chars(file, &path, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|REP_FN) ) { if ( !(s = Sopen_file(path, how)) ) { PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION, ATOM_open, ATOM_source_sink, file); return NULL; } setFileNameStream(s, fn_to_atom(path)); } #ifdef HAVE_POPEN else if ( PL_is_functor(file, FUNCTOR_pipe1) ) { term_t a = PL_new_term_ref(); char *cmd; 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; } if ( !(s = Sopen_pipe(cmd, how)) ) { PL_error(NULL, 0, OsError(), ERR_FILE_OPERATION, ATOM_open, ATOM_source_sink, file); return NULL; } } #endif /*HAVE_POPEN*/ else { return NULL; } s->encoding = enc; if ( !close_on_abort ) s->flags |= SIO_NOCLOSE; if ( how[0] == 'r' ) { if ( eof_action != ATOM_eof_code ) { if ( eof_action == ATOM_reset ) s->flags |= SIO_NOFEOF; else if ( eof_action == ATOM_error ) s->flags |= SIO_FEOF2ERR; } } else { if ( buffer != ATOM_full ) { s->flags &= ~SIO_FBUF; if ( buffer == ATOM_line ) s->flags |= SIO_LBUF; if ( buffer == ATOM_false ) s->flags |= SIO_NBUF; } } if ( alias != NULL_ATOM ) aliasStream(s, alias); if ( !reposition ) s->position = NULL; if ( bom ) { if ( mname == ATOM_read ) { if ( ScheckBOM(s) < 0 ) { bom_error: streamStatus(getStream(s)); return NULL; } } else { if ( SwriteBOM(s) < 0 ) goto bom_error; } } return s; } static word pl_open4(term_t file, term_t mode, term_t stream, term_t options) { IOSTREAM *s = openStream(file, mode, options); if ( s ) return PL_unify_stream_or_alias(stream, s); fail; } static word pl_open(term_t file, term_t mode, term_t stream) { return pl_open4(file, mode, stream, 0); } /******************************* * EDINBURGH I/O * *******************************/ static IOSTREAM * findStreamFromFile(atom_t name, unsigned int flags) { TableEnum e; Symbol symb; IOSTREAM *s = NULL; e = newTableEnum(streamContext); while( (symb=advanceTableEnum(e)) ) { stream_context *ctx = symb->value; if ( ctx->filename == name && true(ctx, flags) ) { s = symb->name; break; } } freeTableEnum(e); return s; } static word pl_see(term_t f) { GET_LD IOSTREAM *s; atom_t a; term_t mode; LOCK(); if ( get_stream_handle(f, &s, SH_ALIAS|SH_UNLOCKED) ) { Scurin = s; goto ok; } if ( PL_get_atom(f, &a) && a == ATOM_user ) { Scurin = Suser_input; goto ok; } if ( (s = findStreamFromFile(a, IO_SEE)) ) { Scurin = s; goto ok; } mode = PL_new_term_ref(); PL_put_atom(mode, ATOM_read); if ( !(s = openStream(f, mode, 0)) ) { UNLOCK(); fail; } set(getStreamContext(s), IO_SEE); pl_push_input_context(); Scurin = s; ok: UNLOCK(); succeed; } static word pl_seeing(term_t f) { GET_LD if ( Scurin == Suser_input ) return PL_unify_atom(f, ATOM_user); return pl_current_input(f); } static word pl_seen(void) { GET_LD IOSTREAM *s = getStream(Scurin); pl_pop_input_context(); if ( s->flags & SIO_NOFEOF ) succeed; return closeStream(s); } /* MT: Does not create a lock on the stream */ static word do_tell(term_t f, atom_t m) { GET_LD IOSTREAM *s; atom_t a; term_t mode; LOCK(); if ( get_stream_handle(f, &s, SH_UNLOCKED) ) { Scurout = s; goto ok; } if ( PL_get_atom(f, &a) && a == ATOM_user ) { Scurout = Suser_output; goto ok; } if ( (s = findStreamFromFile(a, IO_TELL)) ) { Scurout = s; goto ok; } mode = PL_new_term_ref(); PL_put_atom(mode, m); if ( !(s = openStream(f, mode, 0)) ) { UNLOCK(); fail; } set(getStreamContext(s), IO_TELL); pushOutputContext(); Scurout = s; ok: UNLOCK(); succeed; } static word pl_tell(term_t f) { return do_tell(f, ATOM_write); } static word pl_append(term_t f) { return do_tell(f, ATOM_append); } static word pl_telling(term_t f) { GET_LD if ( Scurout == Suser_output ) return PL_unify_atom(f, ATOM_user); return pl_current_output(f); } static word pl_told(void) { GET_LD IOSTREAM *s = getStream(Scurout); popOutputContext(); if ( s->flags & SIO_NOFEOF ) succeed; return closeStream(s); } /******************************* * NULL-STREAM * *******************************/ static ssize_t Swrite_null(void *handle, char *buf, size_t size) { return size; } static ssize_t Sread_null(void *handle, char *buf, size_t size) { return 0; } static long Sseek_null(void *handle, long offset, int whence) { switch(whence) { case SIO_SEEK_SET: return offset; case SIO_SEEK_CUR: case SIO_SEEK_END: default: return -1; } } static int Sclose_null(void *handle) { return 0; } static const IOFUNCTIONS nullFunctions = { Sread_null, Swrite_null, Sseek_null, Sclose_null }; static word pl_open_null_stream(term_t stream) { int sflags = SIO_NBUF|SIO_RECORDPOS|SIO_OUTPUT; IOSTREAM *s = Snew((void *)NULL, sflags, (IOFUNCTIONS *)&nullFunctions); if ( s ) { s->encoding = ENC_UTF8; return PL_unify_stream_or_alias(stream, s); } fail; } static word pl_close(term_t stream) { IOSTREAM *s; if ( PL_get_stream_handle(stream, &s) ) return closeStream(s); fail; } INIT_DEF(opt_spec, close2_options, 2) ADD_CLOSE2_OPT( ATOM_force, OPT_BOOL ) END_CLOSE2_DEFS( NULL_ATOM, 0 ) static word pl_close2(term_t stream, term_t options) { IOSTREAM *s; bool force = FALSE; if ( !scan_options(options, 0, ATOM_close_option, close2_options, &force) ) fail; if ( !force ) return pl_close(stream); if ( !PL_get_stream_handle(stream, &s) ) fail; if ( s == Sinput ) Sclearerr(s); else if ( s == Soutput || s == Serror ) { Sflush(s); Sclearerr(s); } else { Sflush(s); Sclose(s); } succeed; } /******************************* * STREAM-PROPERTY * *******************************/ static int stream_file_name_propery(IOSTREAM *s, term_t prop ARG_LD) { atom_t name; if ( (name = getStreamContext(s)->filename) ) { return PL_unify_atom(prop, name); } fail; } static int stream_mode_property(IOSTREAM *s, term_t prop ARG_LD) { atom_t mode; if ( s->flags & SIO_INPUT ) mode = ATOM_read; else { assert(s->flags & SIO_OUTPUT); if ( s->flags & SIO_APPEND ) mode = ATOM_append; else if ( s->flags & SIO_UPDATE ) mode = ATOM_update; else mode = ATOM_write; } return PL_unify_atom(prop, mode); } static int stream_input_prop(IOSTREAM *s ARG_LD) { return (s->flags & SIO_INPUT) ? TRUE : FALSE; } static int stream_output_prop(IOSTREAM *s ARG_LD) { return (s->flags & SIO_OUTPUT) ? TRUE : FALSE; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Incomplete: should be non-deterministic if the stream has multiple aliases! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static int stream_alias_prop(IOSTREAM *s, term_t prop ARG_LD) { atom_t name; stream_context *ctx = getStreamContext(s); int i; if ( PL_get_atom(prop, &name) ) { alias *a; for( a = ctx->alias_head; a; a = a->next ) { if ( a->name == name ) return TRUE; } if ( (i=standardStreamIndexFromName(name)) >= 0 && i < 6 && s == LD->IO.streams[i] ) return TRUE; return FALSE; } if ( (i=standardStreamIndexFromStream(s)) >= 0 && i < 3 ) return PL_unify_atom(prop, standardStreams[i]); if ( ctx->alias_head ) return PL_unify_atom(prop, ctx->alias_head->name); return FALSE; } static int stream_position_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( s->position ) { return PL_unify_term(prop, PL_FUNCTOR, FUNCTOR_stream_position4, PL_INT64, s->position->charno, PL_INT, s->position->lineno, PL_INT, s->position->linepos, PL_INT64, s->position->byteno); } fail; } static int stream_end_of_stream_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( s->flags & SIO_INPUT ) { GET_LD atom_t val; if ( s->flags & SIO_FEOF2 ) val = ATOM_past; else if ( s->flags & SIO_FEOF ) val = ATOM_at; else val = ATOM_not; return PL_unify_atom(prop, val); } return FALSE; } static int stream_eof_action_prop(IOSTREAM *s, term_t prop ARG_LD) { atom_t val; if ( s->flags & SIO_NOFEOF ) val = ATOM_reset; else if ( s->flags & SIO_FEOF2ERR ) val = ATOM_error; else val = ATOM_eof_code; return PL_unify_atom(prop, val); } #ifdef HAVE_FSTAT #include #endif #if !defined(S_ISREG) && defined(S_IFREG) #define S_ISREG(m) ((m&S_IFMT) == S_IFREG) #endif static int stream_reposition_prop(IOSTREAM *s, term_t prop ARG_LD) { atom_t val; if ( s->functions->seek ) { #ifdef HAVE_FSTAT int fd = Sfileno(s); struct stat buf; if ( fstat(fd, &buf) == 0 && S_ISREG(buf.st_mode) ) val = ATOM_true; else val = ATOM_false; #else val = ATOM_true; #endif } else val = ATOM_false; return PL_unify_atom(prop, val); } static int stream_close_on_abort_prop(IOSTREAM *s, term_t prop ARG_LD) { return PL_unify_bool_ex(prop, !(s->flags & SIO_NOCLOSE)); } static int stream_type_prop(IOSTREAM *s, term_t prop ARG_LD) { return PL_unify_atom(prop, s->flags & SIO_TEXT ? ATOM_text : ATOM_binary); } static int stream_file_no_prop(IOSTREAM *s, term_t prop ARG_LD) { int fd; if ( (fd = Sfileno(s)) >= 0 ) return PL_unify_integer(prop, fd); fail; } static int stream_tty_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( (s->flags & SIO_ISATTY) ) return PL_unify_bool_ex(prop, TRUE); fail; } static int stream_bom_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( (s->flags & SIO_BOM) ) return PL_unify_bool_ex(prop, TRUE); fail; } static int stream_newline_prop(IOSTREAM *s, term_t prop ARG_LD) { switch ( s->newline ) { case SIO_NL_POSIX: case SIO_NL_DETECT: return PL_unify_atom(prop, ATOM_posix); case SIO_NL_DOS: return PL_unify_atom(prop, ATOM_dos); } fail; } static int stream_encoding_prop(IOSTREAM *s, term_t prop ARG_LD) { return PL_unify_atom(prop, encoding_to_atom(s->encoding)); } static int stream_reperror_prop(IOSTREAM *s, term_t prop ARG_LD) { atom_t a; if ( (s->flags & SIO_REPXML) ) a = ATOM_xml; else if ( (s->flags & SIO_REPPL) ) a = ATOM_prolog; else a = ATOM_error; return PL_unify_atom(prop, a); } static int stream_buffer_prop(IOSTREAM *s, term_t prop ARG_LD) { atom_t b; if ( s->flags & SIO_FBUF ) b = ATOM_full; else if ( s->flags & SIO_LBUF ) b = ATOM_line; else /*if ( s->flags & SIO_NBUF )*/ b = ATOM_false; return PL_unify_atom(prop, b); } static int stream_buffer_size_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( (s->flags & SIO_NBUF) ) fail; return PL_unify_integer(prop, s->bufsize); } static int stream_timeout_prop(IOSTREAM *s, term_t prop ARG_LD) { if ( s->timeout == -1 ) return PL_unify_atom(prop, ATOM_infinite); return PL_unify_float(prop, (double)s->timeout/1000.0); } typedef struct { functor_t functor; /* functor of property */ int (*function)(); /* function to generate */ } sprop; INIT_DEF(sprop, sprop_list, 24) ADD_SPROP( FUNCTOR_file_name1, stream_file_name_propery ) ADD_SPROP( FUNCTOR_mode1, stream_mode_property ) ADD_SPROP( FUNCTOR_input0, stream_input_prop ) ADD_SPROP( FUNCTOR_output0, stream_output_prop ) ADD_SPROP( FUNCTOR_alias1, stream_alias_prop ) ADD_SPROP( FUNCTOR_position1, stream_position_prop ) ADD_SPROP( FUNCTOR_end_of_stream1, stream_end_of_stream_prop ) ADD_SPROP( FUNCTOR_eof_action1, stream_eof_action_prop ) ADD_SPROP( FUNCTOR_reposition1, stream_reposition_prop ) ADD_SPROP( FUNCTOR_type1, stream_type_prop ) ADD_SPROP( FUNCTOR_file_no1, stream_file_no_prop ) ADD_SPROP( FUNCTOR_buffer1, stream_buffer_prop ) ADD_SPROP( FUNCTOR_buffer_size1, stream_buffer_size_prop ) ADD_SPROP( FUNCTOR_close_on_abort1,stream_close_on_abort_prop ) ADD_SPROP( FUNCTOR_tty1, stream_tty_prop ) ADD_SPROP( FUNCTOR_encoding1, stream_encoding_prop ) ADD_SPROP( FUNCTOR_bom1, stream_bom_prop ) ADD_SPROP( FUNCTOR_newline1, stream_newline_prop ) ADD_SPROP( FUNCTOR_representation_errors1, stream_reperror_prop ) ADD_SPROP( FUNCTOR_timeout1, stream_timeout_prop ) END_SPROP_DEFS( 0, NULL) typedef struct { TableEnum e; /* Enumerator on stream-table */ IOSTREAM *s; /* Stream we are enumerating */ const sprop *p; /* Pointer in properties */ int fixed_p; /* Propety is given */ } prop_enum; static foreign_t pl_stream_property(term_t stream, term_t property, control_t h) { GET_LD IOSTREAM *s; prop_enum *pe; fid_t fid; term_t a1; switch( ForeignControl(h) ) { case FRG_FIRST_CALL: a1 = PL_new_term_ref(); if ( PL_is_variable(stream) ) /* generate */ { const sprop *p = sprop_list; int fixed = FALSE; functor_t f; if ( PL_get_functor(property, &f) ) /* test for defined property */ { for( ; p->functor; p++ ) { if ( f == p->functor ) { fixed = TRUE; break; } } if ( !p->functor ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_property, property); } pe = allocHeap(sizeof(*pe)); pe->e = newTableEnum(streamContext); pe->s = NULL; pe->p = p; pe->fixed_p = fixed; break; } LOCK(); /* given stream */ if ( get_stream_handle(stream, &s, SH_ERRORS|SH_UNLOCKED) ) { functor_t f; if ( PL_is_variable(property) ) /* generate properties */ { pe = allocHeap(sizeof(*pe)); pe->e = NULL; pe->s = s; pe->p = sprop_list; pe->fixed_p = FALSE; UNLOCK(); break; } if ( PL_get_functor(property, &f) ) { const sprop *p = sprop_list; for( ; p->functor; p++ ) { if ( f == p->functor ) { int rval; switch(arityFunctor(f)) { case 0: rval = (*p->function)(s PASS_LD); break; case 1: { term_t a1 = PL_new_term_ref(); _PL_get_arg(1, property, a1); rval = (*p->function)(s, a1 PASS_LD); break; } default: assert(0); rval = FALSE; } UNLOCK(); return rval; } } } else { UNLOCK(); return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_property, property); } } UNLOCK(); fail; /* bad stream handle */ case FRG_REDO: { pe = ForeignContextPtr(h); a1 = PL_new_term_ref(); break; } case FRG_CUTTED: { pe = ForeignContextPtr(h); if ( pe ) /* 0 if exception on FRG_FIRST_CALL */ { if ( pe->e ) freeTableEnum(pe->e); freeHeap(pe, sizeof(*pe)); } succeed; } default: assert(0); fail; } fid = PL_open_foreign_frame(); for(;;) { if ( pe->s ) /* given stream */ { fid_t fid2; if ( PL_is_variable(stream) ) { if ( !PL_unify_stream(stream, pe->s) ) goto enum_e; } fid2 = PL_open_foreign_frame(); for( ; pe->p->functor ; pe->p++ ) { if ( PL_unify_functor(property, pe->p->functor) ) { int rval; switch(arityFunctor(pe->p->functor)) { case 0: rval = (*pe->p->function)(pe->s PASS_LD); break; case 1: { _PL_get_arg(1, property, a1); rval = (*pe->p->function)(pe->s, a1 PASS_LD); break; } default: assert(0); rval = FALSE; } if ( rval ) { if ( pe->fixed_p ) pe->s = NULL; else pe->p++; ForeignRedoPtr(pe); } } if ( pe->fixed_p ) break; PL_rewind_foreign_frame(fid2); } PL_close_foreign_frame(fid2); pe->s = NULL; } enum_e: if ( pe->e ) { Symbol symb; while ( (symb=advanceTableEnum(pe->e)) ) { PL_rewind_foreign_frame(fid); if ( PL_unify_stream(stream, symb->name) ) { pe->s = symb->name; if ( !pe->fixed_p ) pe->p = sprop_list; break; } } } if ( !pe->s ) { if ( pe->e ) freeTableEnum(pe->e); freeHeap(pe, sizeof(*pe)); fail; } } } static PRED_IMPL("is_stream", 1, is_stream, 0) { GET_LD IOSTREAM *s; if ( get_stream_handle(A1, &s, SH_SAFE) ) { releaseStream(s); succeed; } fail; } /******************************* * FLUSH * *******************************/ static word pl_flush_output1(term_t out) { IOSTREAM *s; if ( getOutputStream(out, &s) ) { Sflush(s); return streamStatus(s); } fail; } static word pl_flush_output(void) { return pl_flush_output1(0); } static int getStreamWithPosition(term_t stream, IOSTREAM **sp) { IOSTREAM *s; if ( PL_get_stream_handle(stream, &s) ) { if ( !s->position ) { PL_error(NULL, 0, NULL, ERR_PERMISSION, /* non-ISO */ ATOM_property, ATOM_position, stream); releaseStream(s); return FALSE; } *sp = s; return TRUE; } return FALSE; } static int getRepositionableStream(term_t stream, IOSTREAM **sp) { GET_LD IOSTREAM *s; if ( get_stream_handle(stream, &s, SH_ERRORS) ) { if ( !s->position || !s->functions || !s->functions->seek ) { PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_reposition, ATOM_stream, stream); releaseStream(s); return FALSE; } *sp = s; return TRUE; } return FALSE; } static word pl_set_stream_position(term_t stream, term_t pos) { GET_LD IOSTREAM *s; int64_t charno, byteno; long linepos, lineno; term_t a = PL_new_term_ref(); if ( !(getRepositionableStream(stream, &s)) ) fail; if ( !PL_is_functor(pos, FUNCTOR_stream_position4) || !PL_get_arg(1, pos, a) || !PL_get_int64(a, &charno) || !PL_get_arg(2, pos, a) || !PL_get_long(a, &lineno) || !PL_get_arg(3, pos, a) || !PL_get_long(a, &linepos) || !PL_get_arg(4, pos, a) || !PL_get_int64(a, &byteno) ) { releaseStream(s); return PL_error("stream_position", 3, NULL, ERR_DOMAIN, ATOM_stream_position, pos); } if ( Sseek64(s, byteno, SIO_SEEK_SET) != 0 ) return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_reposition, ATOM_stream, stream); s->position->byteno = byteno; s->position->charno = charno; s->position->lineno = (int)lineno; s->position->linepos = (int)linepos; releaseStream(s); succeed; } static word pl_seek(term_t stream, term_t offset, term_t method, term_t newloc) { GET_LD atom_t m; int whence = -1; int64_t off, new; IOSTREAM *s; if ( !(PL_get_atom_ex(method, &m)) ) return FALSE; if ( m == ATOM_bof ) whence = SIO_SEEK_SET; else if ( m == ATOM_current ) whence = SIO_SEEK_CUR; else if ( m == ATOM_eof ) whence = SIO_SEEK_END; else return PL_error("seek", 4, NULL, ERR_DOMAIN, ATOM_seek_method, method); if ( !PL_get_int64(offset, &off) ) return PL_error("seek", 4, NULL, ERR_DOMAIN, ATOM_integer, offset); if ( PL_get_stream_handle(stream, &s) ) { int unit = Sunit_size(s); off *= unit; if ( Sseek64(s, off, whence) < 0 ) { if ( errno == EINVAL ) PL_error("seek", 4, "offset out of range", ERR_DOMAIN, ATOM_position, offset); else PL_error("seek", 4, OsError(), ERR_PERMISSION, ATOM_reposition, ATOM_stream, stream); releaseStream(s); fail; } new = Stell64(s); releaseStream(s); new /= unit; return PL_unify_int64(newloc, new); } fail; } static word pl_set_input(term_t stream) { GET_LD IOSTREAM *s; if ( getInputStream(stream, &s) ) { Scurin = s; releaseStream(s); return TRUE; } return FALSE; } static word pl_set_output(term_t stream) { GET_LD IOSTREAM *s; if ( getOutputStream(stream, &s) ) { Scurout = s; releaseStream(s); return TRUE; } return FALSE; } word pl_current_input(term_t stream) { GET_LD return PL_unify_stream(stream, Scurin); } word pl_current_output(term_t stream) { GET_LD return PL_unify_stream(stream, Scurout); } static PRED_IMPL("byte_count", 2, byte_count, 0) { IOSTREAM *s; if ( getStreamWithPosition(A1, &s) ) { int64_t n = s->position->byteno; releaseStream(s); return PL_unify_int64(A2, n); } fail; } static PRED_IMPL("character_count", 2, character_count, 0) { IOSTREAM *s; if ( getStreamWithPosition(A1, &s) ) { int64_t n = s->position->charno; releaseStream(s); return PL_unify_int64(A2, n); } fail; } static PRED_IMPL("line_count", 2, line_count, 0) { GET_LD IOSTREAM *s; if ( getStreamWithPosition(A1, &s) ) { intptr_t n = s->position->lineno; releaseStream(s); return PL_unify_integer(A2, n); } fail; } static PRED_IMPL("line_position", 2, line_position, 0) { GET_LD IOSTREAM *s; if ( getStreamWithPosition(A1, &s) ) { intptr_t n = s->position->linepos; releaseStream(s); return PL_unify_integer(A2, n); } fail; } static word pl_source_location(term_t file, term_t line) { GET_LD if ( ReadingSource && PL_unify_atom(file, source_file_name) && PL_unify_integer(line, source_line_no) ) succeed; fail; } static word pl_at_end_of_stream1(term_t stream) { GET_LD IOSTREAM *s; if ( getInputStream(stream, &s) ) { int rval = Sfeof(s); if ( rval < 0 ) { PL_error(NULL, 0, "not-buffered stream", ERR_PERMISSION, ATOM_end_of_stream, ATOM_stream, stream); rval = FALSE; } if ( rval && Sferror(s) ) /* due to error */ return streamStatus(s); else releaseStream(s); return rval; } return FALSE; /* exception */ } static word pl_at_end_of_stream0(void) { return pl_at_end_of_stream1(0); } static foreign_t peek(term_t stream, term_t chr, int how) { GET_LD IOSTREAM *s; IOPOS pos; int c; if ( !getInputStream(stream, &s) ) fail; pos = s->posbuf; if ( how == BYTE_MODE ) { c = Sgetc(s); if ( c != EOF ) Sungetc(c, s); } else { c = Sgetcode(s); if ( c != EOF ) Sungetcode(c, s); } s->posbuf = pos; if ( Sferror(s) ) return streamStatus(s); releaseStream(s); return PL_unify_char(chr, c, how); } static PRED_IMPL("peek_byte", 2, peek_byte2, 0) { return peek(A1, A2, BYTE_MODE); } static PRED_IMPL("peek_byte", 1, peek_byte1, 0) { return peek(0, A1, BYTE_MODE); } static PRED_IMPL("peek_code", 2, peek_code2, 0) { return peek(A1, A2, CODE_MODE); } static PRED_IMPL("peek_code", 1, peek_code1, 0) { return peek(0, A1, CODE_MODE); } static PRED_IMPL("peek_char", 2, peek_char2, 0) { return peek(A1, A2, CHAR_MODE); } static PRED_IMPL("peek_char", 1, peek_char1, 0) { return peek(0, A1, CHAR_MODE); } /******************************* * INTERACTION * *******************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - set_prolog_OI(+In, +Out, +Error) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ typedef struct wrappedIO { void *wrapped_handle; /* original handle */ IOFUNCTIONS *wrapped_functions; /* original functions */ IOSTREAM *wrapped_stream; /* stream we wrapped */ IOFUNCTIONS functions; /* new function block */ } wrappedIO; static ssize_t Sread_user(void *handle, char *buf, size_t size) { GET_LD wrappedIO *wio = handle; if ( LD->prompt.next && ttymode != TTY_RAW ) PL_write_prompt(TRUE); else Sflush(Suser_output); size = (*wio->wrapped_functions->read)(wio->wrapped_handle, buf, size); if ( size == 0 ) /* end-of-file */ { Sclearerr(Suser_input); LD->prompt.next = TRUE; } else if ( size > 0 && buf[size-1] == '\n' ) LD->prompt.next = TRUE; return size; } static int closeWrappedIO(void *handle) { wrappedIO *wio = handle; int rval; if ( wio->wrapped_functions->close ) rval = (*wio->wrapped_functions->close)(wio->wrapped_handle); else rval = 0; wio->wrapped_stream->functions = wio->wrapped_functions; wio->wrapped_stream->handle = wio->wrapped_handle; PL_free(wio); return rval; } static void wrapIO(IOSTREAM *s, ssize_t (*read)(void *, char *, size_t), ssize_t (*write)(void *, char *, size_t)) { wrappedIO *wio = PL_malloc(sizeof(*wio)); wio->wrapped_functions = s->functions; wio->wrapped_handle = s->handle; wio->wrapped_stream = s; wio->functions = *s->functions; if ( read ) wio->functions.read = read; if ( write ) wio->functions.write = write; wio->functions.close = closeWrappedIO; s->functions = &wio->functions; s->handle = wio; } static PRED_IMPL("set_prolog_IO", 3, set_prolog_IO, 0) { PRED_LD IOSTREAM *in = NULL, *out = NULL, *error = NULL; int rval = FALSE; if ( !PL_get_stream_handle(A1, &in) || !PL_get_stream_handle(A2, &out) ) goto out; if ( PL_compare(A2, A3) == 0 ) /* == */ { error = getStream(Snew(out->handle, out->flags, out->functions)); error->flags &= ~SIO_ABUF; /* disable buffering */ error->flags |= SIO_NBUF; } else { if ( !PL_get_stream_handle(A3, &error) ) goto out; } LOCK(); 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; UNLOCK(); rval = TRUE; out: if ( in ) releaseStream(in); if ( out ) releaseStream(out); if ( error && error != out ) releaseStream(error); return rval; } /******************************** * FILES * *********************************/ static bool unifyTime(term_t t, intptr_t time) { return PL_unify_float(t, (double)time); } static void add_option(term_t options, functor_t f, atom_t val) { GET_LD term_t 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); } #define CVT_FILENAME (CVT_ATOM|CVT_STRING|CVT_LIST) static int PL_get_file_name(term_t n, char **namep, int flags) { GET_LD char *name; char tmp[MAXPATHLEN]; 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); PL_put_term(av+0, n); 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_unify_nil(options); if ( !PL_call_predicate(NULL, cflags, pred, av) ) fail; return PL_get_chars_ex(av+1, namep, CVT_ATOMIC|BUF_RING|REP_FN); } if ( flags & PL_FILE_NOERRORS ) { if ( !PL_get_chars(n, &name, CVT_FILENAME|REP_FN) ) fail; } else { if ( !PL_get_chars_ex(n, &name, CVT_FILENAME|REP_FN) ) fail; } if ( trueFeature(FILEVARS_FEATURE) ) { if ( !(name = ExpandOneFile(name, tmp)) ) fail; } if ( !(flags & PL_FILE_NOERRORS) ) { atom_t op = 0; if ( (flags&PL_FILE_READ) && !AccessFile(name, ACCESS_READ) ) op = ATOM_read; if ( !op && (flags&PL_FILE_WRITE) && !AccessFile(name, ACCESS_WRITE) ) op = ATOM_write; if ( !op && (flags&PL_FILE_EXECUTE) && !AccessFile(name, ACCESS_EXECUTE) ) op = ATOM_execute; if ( op ) return PL_error(NULL, 0, NULL, ERR_PERMISSION, ATOM_file, op, n); if ( (flags & PL_FILE_EXIST) && !AccessFile(name, ACCESS_EXIST) ) return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_file, n); } if ( flags & PL_FILE_ABSOLUTE ) { if ( !(name = AbsoluteFile(name, tmp)) ) fail; } if ( flags & PL_FILE_OSPATH ) { if ( !(name = OsPath(name, ospath)) ) fail; } *namep = buffer_string(name, BUF_RING); succeed; } static word pl_time_file(term_t name, term_t t) { char *fn; if ( PL_get_file_name(name, &fn, 0) ) { intptr_t time; if ( (time = LastModifiedFile(fn)) == -1 ) return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, ATOM_time, ATOM_file, name); return unifyTime(t, time); } fail; } static word pl_size_file(term_t name, term_t len) { char *n; if ( PL_get_file_name(name, &n, 0) ) { int64_t size; if ( (size = SizeFile(n)) < 0 ) return PL_error("size_file", 2, OsError(), ERR_FILE_OPERATION, ATOM_size, ATOM_file, name); return PL_unify_int64(len, size); } fail; } static word pl_size_stream(term_t stream, term_t len) { GET_LD IOSTREAM *s; int rval; if ( !PL_get_stream_handle(stream, &s) ) fail; rval = PL_unify_integer(len, Ssize(s)); PL_release_stream(s); return rval; } static word pl_access_file(term_t name, term_t mode) { GET_LD char *n; int md; atom_t m; if ( !PL_get_atom(mode, &m) ) return PL_error("access_file", 2, NULL, ERR_TYPE, ATOM_atom, mode); if ( !PL_get_file_name(name, &n, 0) ) fail; if ( m == ATOM_none ) succeed; if ( m == ATOM_write || m == ATOM_append ) md = ACCESS_WRITE; else if ( m == ATOM_read ) md = ACCESS_READ; else if ( m == ATOM_execute ) md = ACCESS_EXECUTE; else if ( m == ATOM_exist ) md = ACCESS_EXIST; else return PL_error("access_file", 2, NULL, ERR_DOMAIN, ATOM_io_mode, mode); if ( AccessFile(n, md) ) succeed; if ( md == ACCESS_WRITE && !AccessFile(n, ACCESS_EXIST) ) { char tmp[MAXPATHLEN]; char *dir = DirName(n, tmp); if ( dir[0] ) { if ( !ExistsDirectory(dir) ) fail; } if ( AccessFile(dir[0] ? dir : ".", md) ) succeed; } fail; } static word pl_read_link(term_t file, term_t link, term_t to) { char *n, *l, *t; char buf[MAXPATHLEN]; if ( !PL_get_file_name(file, &n, 0) ) fail; if ( (l = ReadLink(n, buf)) && PL_unify_atom_chars(link, l) && (t = DeRefLink(n, buf)) && PL_unify_atom_chars(to, t) ) succeed; fail; } word pl_exists_file(term_t name) { char *n; if ( !PL_get_file_name(name, &n, 0) ) fail; return ExistsFile(n); } static word pl_exists_directory(term_t name) { char *n; if ( !PL_get_file_name(name, &n, 0) ) fail; return ExistsDirectory(n); } static word pl_tmp_file(term_t base, term_t name) { GET_LD char *n; 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)); } static word pl_delete_file(term_t name) { char *n; if ( !PL_get_file_name(name, &n, 0) ) fail; if ( RemoveFile(n) ) succeed; return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_delete, ATOM_file, name); } static word pl_delete_directory(term_t name) { char *n; if ( !PL_get_file_name(name, &n, 0) ) fail; if ( rmdir(n) == 0 ) succeed; else return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_delete, ATOM_directory, name); } /* mkdir/2 works in SWI, and not in YAP, why? */ #ifdef __WINDOWS__ #define mkdir(X,Y) mkdir(X) #endif static word pl_make_directory(term_t name) { char *n; if ( !PL_get_file_name(name, &n, 0) ) fail; if ( mkdir(n, 0777) == 0 ) succeed; else return PL_error(NULL, 0, MSG_ERRNO, ERR_FILE_OPERATION, ATOM_create, ATOM_directory, name); } static word pl_same_file(term_t file1, term_t file2) { char *n1, *n2; if ( PL_get_file_name(file1, &n1, 0) && PL_get_file_name(file2, &n2, 0) ) return SameFile(n1, n2); fail; } static word pl_rename_file(term_t old, term_t new) { GET_LD char *o, *n; if ( PL_get_file_name(old, &o, 0) && PL_get_file_name(new, &n, 0) ) { if ( SameFile(o, n) ) { if ( fileerrors ) return PL_error("rename_file", 2, "same file", ERR_PERMISSION, ATOM_rename, ATOM_file, old); fail; } if ( RenameFile(o, n) ) succeed; if ( fileerrors ) return PL_error("rename_file", 2, OsError(), ERR_FILE_OPERATION, ATOM_rename, ATOM_file, old); fail; } fail; } static word pl_fileerrors(term_t old, term_t new) { GET_LD return setBoolean(&fileerrors, old, new); } static word pl_absolute_file_name(term_t name, term_t expanded) { char *n; char tmp[MAXPATHLEN]; if ( PL_get_file_name(name, &n, 0) && (n = AbsoluteFile(n, tmp)) ) return PL_unify_chars(expanded, PL_ATOM|REP_FN, -1, n); fail; } static word pl_is_absolute_file_name(term_t name) { char *n; if ( PL_get_file_name(name, &n, 0) && IsAbsolutePath(n) ) succeed; fail; } static word pl_working_directory(term_t old, term_t new) { GET_LD const char *wd; if ( !(wd = PL_cwd()) ) fail; if ( PL_unify_chars(old, PL_ATOM|REP_FN, -1, wd) ) { if ( PL_compare(old, new) != 0 ) { char *n; if ( PL_get_file_name(new, &n, 0) ) { if ( ChDir(n) ) succeed; if ( fileerrors ) return PL_error(NULL, 0, NULL, ERR_FILE_OPERATION, ATOM_chdir, ATOM_directory, new); fail; } } succeed; } fail; } static word pl_file_base_name(term_t f, term_t b) { char *n; if ( !PL_get_chars_ex(f, &n, CVT_ALL|REP_FN) ) fail; return PL_unify_chars(b, PL_ATOM|REP_FN, -1, BaseName(n)); } static word pl_file_dir_name(term_t f, term_t b) { char *n; char tmp[MAXPATHLEN]; if ( !PL_get_chars_ex(f, &n, CVT_ALL|REP_FN) ) fail; return PL_unify_chars(b, PL_ATOM|REP_FN, -1, DirName(n, tmp)); } static int has_extension(const char *name, const char *ext) { GET_LD const char *s = name + strlen(name); if ( ext[0] == EOS ) succeed; while(*s != '.' && *s != '/' && s > name) s--; if ( *s == '.' && s > name && s[-1] != '/' ) { if ( ext[0] == '.' ) ext++; if ( trueFeature(FILE_CASE_FEATURE) ) return strcmp(&s[1], ext) == 0; else return strcasecmp(&s[1], ext) == 0; } fail; } static int name_too_long(void) { return PL_error(NULL, 0, NULL, ERR_REPRESENTATION, ATOM_max_path_length); } static word pl_file_name_extension(term_t base, term_t ext, term_t full) { GET_LD char *b = NULL, *e = NULL, *f; char buf[MAXPATHLEN]; if ( !PL_is_variable(full) ) { if ( PL_get_chars(full, &f, CVT_ALL|CVT_EXCEPTION|REP_FN) ) { char *s = f + strlen(f); /* ?base, ?ext, +full */ while(*s != '.' && *s != '/' && s > f) s--; if ( *s == '.' ) { if ( PL_get_chars(ext, &e, CVT_ALL|REP_FN) ) { if ( e[0] == '.' ) e++; if ( trueFeature(FILE_CASE_FEATURE) ) { TRY(strcmp(&s[1], e) == 0); } else { TRY(strcasecmp(&s[1], e) == 0); } } else { TRY(PL_unify_chars(ext, PL_ATOM|REP_FN, -1, &s[1])); } if ( s-f > MAXPATHLEN ) return name_too_long(); strncpy(buf, f, s-f); buf[s-f] = EOS; return PL_unify_chars(base, PL_ATOM|REP_FN, -1, buf); } if ( PL_unify_atom_chars(ext, "") && PL_unify(full, base) ) PL_succeed; } PL_fail; } if ( PL_get_chars_ex(base, &b, CVT_ALL|BUF_RING|REP_FN) && PL_get_chars_ex(ext, &e, CVT_ALL|REP_FN) ) { char *s; if ( e[0] == '.' ) /* +Base, +Extension, -full */ e++; if ( has_extension(b, e) ) return PL_unify(base, full); if ( strlen(b) + 1 + strlen(e) + 1 > MAXPATHLEN ) return name_too_long(); strcpy(buf, b); s = buf + strlen(buf); *s++ = '.'; strcpy(s, e); return PL_unify_chars(full, PL_ATOM|REP_FN, -1, buf); } else fail; } static word pl_prolog_to_os_filename(term_t pl, term_t os) { GET_LD #ifdef O_XOS wchar_t *wn; if ( !PL_is_variable(pl) ) { char *n; wchar_t buf[MAXPATHLEN]; if ( PL_get_chars_ex(pl, &n, CVT_ALL|REP_UTF8) ) { if ( !_xos_os_filenameW(n, buf, MAXPATHLEN) ) return name_too_long(); return PL_unify_wchars(os, PL_ATOM, -1, buf); } fail; } if ( PL_get_wchars(os, NULL, &wn, CVT_ALL) ) { wchar_t lbuf[MAXPATHLEN]; char buf[MAXPATHLEN]; _xos_long_file_nameW(wn, lbuf, MAXPATHLEN); _xos_canonical_filenameW(lbuf, buf, MAXPATHLEN, 0); return PL_unify_chars(pl, PL_ATOM|REP_UTF8, -1, buf); } return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, pl); #else /*O_XOS*/ return PL_unify(pl, os); #endif /*O_XOS*/ } static foreign_t pl_mark_executable(term_t path) { char *name; if ( !PL_get_file_name(path, &name, 0) ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_source_sink, path); return MarkExecutable(name); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - copy_stream_data(+StreamIn, +StreamOut, [Len]) Copy all data from StreamIn to StreamOut. Should be somewhere else, and maybe we need something else to copy resources. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ static foreign_t pl_copy_stream_data3(term_t in, term_t out, term_t len) { GET_LD IOSTREAM *i, *o; int c; int count = 0; if ( !getInputStream(in, &i) ) return FALSE; if ( !getOutputStream(out, &o) ) { releaseStream(i); return FALSE; } if ( !len ) { while ( (c = Sgetcode(i)) != EOF ) { if ( (++count % 4096) == 0 && PL_handle_signals() < 0 ) { releaseStream(i); releaseStream(o); fail; } if ( Sputcode(c, o) < 0 ) { releaseStream(i); return streamStatus(o); } } } else { int64_t n; if ( !PL_get_int64_ex(len, &n) ) fail; while ( n-- > 0 && (c = Sgetcode(i)) != EOF ) { if ( (++count % 4096) == 0 && PL_handle_signals() < 0 ) { releaseStream(i); releaseStream(o); fail; } if ( Sputcode(c, o) < 0 ) { releaseStream(i); return streamStatus(o); } } } releaseStream(o); return streamStatus(i); } static foreign_t pl_copy_stream_data2(term_t in, term_t out) { return pl_copy_stream_data3(in, out, 0); } /******************************* * PUBLISH PREDICATES * *******************************/ BeginPredDefs(file) PRED_DEF("swi_set_prolog_IO", 3, set_prolog_IO, 0) PRED_DEF("swi_read_pending_input", 3, read_pending_input, 0) PRED_DEF("swi_get_code", 2, get_code2, PL_FA_ISO) PRED_DEF("swi_get_code", 1, get_code1, PL_FA_ISO) PRED_DEF("swi_get_char", 2, get_char2, PL_FA_ISO) PRED_DEF("swi_get_char", 1, get_char1, PL_FA_ISO) PRED_DEF("swi_get_byte", 2, get_byte2, PL_FA_ISO) PRED_DEF("swi_get_byte", 1, get_byte1, PL_FA_ISO) PRED_DEF("swi_peek_code", 2, peek_code2, PL_FA_ISO) PRED_DEF("swi_peek_code", 1, peek_code1, PL_FA_ISO) PRED_DEF("swi_peek_char", 2, peek_char2, PL_FA_ISO) PRED_DEF("swi_peek_char", 1, peek_char1, PL_FA_ISO) PRED_DEF("swi_peek_byte", 2, peek_byte2, PL_FA_ISO) PRED_DEF("swi_peek_byte", 1, peek_byte1, PL_FA_ISO) PRED_DEF("swi_put_byte", 2, put_byte2, PL_FA_ISO) PRED_DEF("swi_put_byte", 1, put_byte1, PL_FA_ISO) PRED_DEF("swi_put_code", 2, put_code2, PL_FA_ISO) PRED_DEF("swi_put_code", 1, put_code1, PL_FA_ISO) PRED_DEF("swi_put_char", 2, put_code2, PL_FA_ISO) PRED_DEF("swi_put_char", 1, put_code1, PL_FA_ISO) PRED_DEF("swi_put", 2, put2, 0) PRED_DEF("swi_put", 1, put1, 0) PRED_DEF("swi_skip", 1, skip1, 0) PRED_DEF("swi_skip", 2, skip2, 0) PRED_DEF("swi_get", 1, get1, 0) PRED_DEF("swi_get", 2, get2, 0) PRED_DEF("swi_get0", 2, get_code2, 0) PRED_DEF("swi_get0", 1, get_code1, 0) PRED_DEF("swi_is_stream", 1, is_stream, 0) PRED_DEF("swi_byte_count", 2, byte_count, 0) PRED_DEF("swi_character_count", 2, character_count, 0) PRED_DEF("swi_line_count", 2, line_count, 0) PRED_DEF("swi_line_position", 2, line_position, 0) PRED_DEF("swi_with_output_to", 2, with_output_to, PL_FA_TRANSPARENT) EndPredDefs static const PL_extension file_foreigns[] = { FRG("swi_get_single_char", 1, pl_get_single_char, 0), FRG("swi_$push_input_context", 0, pl_push_input_context, 0), FRG("swi_$pop_input_context", 0, pl_pop_input_context, 0), FRG("swi_seeing", 1, pl_seeing, 0), FRG("swi_telling", 1, pl_telling, 0), FRG("swi_seen", 0, pl_seen, 0), FRG("swi_tmp_file", 2, pl_tmp_file, 0), FRG("swi_delete_file", 1, pl_delete_file, 0), FRG("swi_delete_directory", 1, pl_delete_directory, 0), FRG("swi_make_directory", 1, pl_make_directory, 0), FRG("swi_access_file", 2, pl_access_file, 0), FRG("swi_read_link", 3, pl_read_link, 0), FRG("swi_exists_file", 1, pl_exists_file, 0), FRG("swi_exists_directory", 1, pl_exists_directory, 0), FRG("swi_rename_file", 2, pl_rename_file, 0), FRG("swi_same_file", 2, pl_same_file, 0), FRG("swi_time_file", 2, pl_time_file, 0), FRG("swi_told", 0, pl_told, 0), FRG("swi_see", 1, pl_see, 0), FRG("swi_tell", 1, pl_tell, 0), FRG("swi_append", 1, pl_append, 0), FRG("swi_ttyflush", 0, pl_ttyflush, 0), FRG("swi_flush_output", 0, pl_flush_output, 0), FRG("swi_prompt", 2, pl_prompt, 0), FRG("swi_prompt1", 1, pl_prompt1, 0), FRG("swi_$absolute_file_name", 2, pl_absolute_file_name, 0), FRG("swi_is_absolute_file_name", 1, pl_is_absolute_file_name, 0), FRG("swi_file_base_name", 2, pl_file_base_name, 0), FRG("swi_file_directory_name", 2, pl_file_dir_name, 0), FRG("swi_file_name_extension", 3, pl_file_name_extension, 0), FRG("swi_prolog_to_os_filename", 2, pl_prolog_to_os_filename, 0), FRG("swi_set_stream_position", 2, pl_set_stream_position, ISO), FRG("swi_wait_for_input", 3, pl_wait_for_input, 0), FRG("swi_protocol", 1, pl_protocol, 0), FRG("swi_protocola", 1, pl_protocola, 0), FRG("swi_noprotocol", 0, pl_noprotocol, 0), FRG("swi_protocolling", 1, pl_protocolling, 0), FRG("swi_tab", 1, pl_tab, 0), FRG("swi_open", 3, pl_open, ISO), FRG("swi_open", 4, pl_open4, ISO), FRG("swi_open_null_stream", 1, pl_open_null_stream, 0), FRG("swi_close", 1, pl_close, ISO), FRG("swi_close", 2, pl_close2, ISO), FRG("swi_stream_property", 2, pl_stream_property, NDET|ISO), FRG("swi_flush_output", 1, pl_flush_output1, ISO), FRG("swi_set_stream_position", 2, pl_set_stream_position, ISO), FRG("swi_seek", 4, pl_seek, 0), FRG("swi_set_input", 1, pl_set_input, ISO), FRG("swi_set_output", 1, pl_set_output, ISO), FRG("swi_set_stream", 2, pl_set_stream, 0), FRG("swi_current_input", 1, pl_current_input, ISO), FRG("swi_current_output", 1, pl_current_output, ISO), FRG("swi_source_location", 2, pl_source_location, 0), FRG("swi_at_end_of_stream", 1, pl_at_end_of_stream1, ISO), FRG("swi_at_end_of_stream", 0, pl_at_end_of_stream0, ISO), FRG("swi_size_file", 2, pl_size_file, 0), FRG("swi_$size_stream", 2, pl_size_stream, 0), FRG("swi_fileerrors", 2, pl_fileerrors, 0), FRG("swi_working_directory", 2, pl_working_directory, 0), FRG("swi_$mark_executable", 1, pl_mark_executable, 0), FRG("swi_copy_stream_data", 2, pl_copy_stream_data2, 0), FRG("swi_copy_stream_data", 3, pl_copy_stream_data3, 0), /* DO NOT ADD ENTRIES BELOW THIS ONE */ FRG((char *)NULL, 0, NULL, 0) }; static void registerBuiltins(const PL_extension *f) { PL_register_extensions( f); } void initIO(void) { GET_LD const atom_t *np; int i; initCharTypes(); init_standardStreams(); init_encoding_names(); init_open4_options(); init_close2_options(); init_sprop_list(); streamAliases = newHTable(16); streamContext = newHTable(16); registerBuiltins(file_foreigns); registerBuiltins(PL_predicates_from_file); fileerrors = TRUE; #ifdef __unix__ { int fd; if ( (fd=Sfileno(Sinput)) < 0 || !isatty(fd) || (fd=Sfileno(Soutput)) < 0 || !isatty(fd) ) defFeature("tty_control", FT_BOOL, FALSE); } #endif ResetTty(); Sclosehook(freeStream); Sinput->position = &Sinput->posbuf; /* position logging */ Soutput->position = &Sinput->posbuf; Serror->position = &Sinput->posbuf; ttymode = TTY_COOKED; PushTty(Sinput, &ttytab, TTY_SAVE); LD->prompt.current = ATOM_prompt; PL_register_atom(ATOM_prompt); Suser_input = Sinput; Suser_output = Soutput; Suser_error = Serror; Scurin = Sinput; /* see/tell */ Scurout = Soutput; Sprotocol = NULL; /* protocolling */ getStreamContext(Sinput); /* add for enumeration */ getStreamContext(Soutput); getStreamContext(Serror); for( i=0, np = standardStreams; *np; np++, i++ ) addHTable(streamAliases, (void *)*np, (void *)(intptr_t)i); GD->io_initialised = TRUE; }