From 4f8b6929b986059cd14f14f98eb73241b410b837 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 18 Jun 2015 01:39:03 +0100 Subject: [PATCH] g;ue --- os/iopreds.c | 1837 ++++++++++++++++++++++++++++++++++++++++++++++++++ os/iopreds.h | 416 ++++++++++++ os/streams.c | 1503 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 3756 insertions(+) create mode 100644 os/iopreds.c create mode 100644 os/iopreds.h create mode 100644 os/streams.c diff --git a/os/iopreds.c b/os/iopreds.c new file mode 100644 index 000000000..a261fe11a --- /dev/null +++ b/os/iopreds.c @@ -0,0 +1,1837 @@ +/************************************************************************* + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: iopreds.c * + * Last rev: 5/2/88 * + * mods: * + * comments: Input/Output C implemented predicates * + * * + *************************************************************************/ +#ifdef SCCS +static char SccsId[] = "%W% %G%"; +#endif + +/* + * This file includes the definition of a miscellania of standard predicates + * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, + * + */ + +#include "Yap.h" +#include "Yatom.h" +#include "YapHeap.h" +#include "yapio.h" +#include "eval.h" +#include "YapText.h" +#include +#if HAVE_STDARG_H +#include +#endif +#if HAVE_CTYPE_H +#include +#endif +#if HAVE_WCTYPE_H +#include +#endif +#if HAVE_SYS_TIME_H +#include +#endif +#if HAVE_SYS_TYPES_H +#include +#endif +#ifdef HAVE_SYS_STAT_H +#include +#endif +#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) +#include +#endif +#ifdef HAVE_UNISTD_H +#include +#endif +#if HAVE_STRING_H +#include +#endif +#if HAVE_SIGNAL_H +#include +#endif +#if HAVE_FCNTL_H +/* for O_BINARY and O_TEXT in WIN32 */ +#include +#endif +#ifdef _WIN32 +#if HAVE_IO_H +/* Windows */ +#include +#endif +#endif +#if !HAVE_STRNCAT +#define strncat(X,Y,Z) strcat(X,Y) +#endif +#if !HAVE_STRNCPY +#define strncpy(X,Y,Z) strcpy(X,Y) +#endif +#if _MSC_VER || defined(__MINGW32__) +#if HAVE_SOCKET +#include +#endif +#include +#ifndef S_ISDIR +#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) +#endif +#endif +#include "iopreds.h" + +FILE *Yap_stdin; +FILE *Yap_stdout; +FILE *Yap_stderr; + + +void +Yap_DefaultStreamOps( StreamDesc * st) +{ + st->stream_wputc = put_wchar; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + if (GLOBAL_CharConversionTable != NULL) + st->stream_wgetc_for_read = ISOWGetc; + else + st->stream_wgetc_for_read = st->stream_wgetc; +} + +static void +unix_upd_stream_info (StreamDesc * s) +{ + if (s->status & InMemory_Stream_f) { + s->status |= Seekable_Stream_f; + return; + } + Yap_socketStream( s ); +#if _MSC_VER || defined(__MINGW32__) + { + if ( + _isatty(_fileno(s->u.file.file)) + ) { + s->status |= Tty_Stream_f|Reset_Eof_Stream_f|Promptable_Stream_f; + /* make all console descriptors unbuffered */ + setvbuf(s->u.file.file, NULL, _IONBF, 0); + return; + } +#if _MSC_VER + /* standard error stream should never be buffered */ + else if (StdErrStream == s-Stream) { + setvbuf(s->u.file.file, NULL, _IONBF, 0); + } +#endif + s->status |= Seekable_Stream_f; + return; + } +#else +#if HAVE_ISATTY +#if __simplescalar__ + /* isatty does not seem to work with simplescar. I'll assume the first + three streams will probably be ttys (pipes are not thatg different) */ + if (s-Stream < 3) { + s->name = AtomTty; + s->status |= Tty_Stream_f|Reset_Eof_Stream_f|Promptable_Stream_f; + } +#else + { + int filedes; /* visualc */ + filedes = fileno (s->file); + if (isatty (filedes)) { +#if HAVE_TTYNAME + char *ttys = ttyname(filedes); + if (ttys == NULL) + s->name = AtomTty; + else + s->name = AtomTtys; +#else + s->name = AtomTty; +#endif + s->status |= Tty_Stream_f|Reset_Eof_Stream_f|Promptable_Stream_f; + return; + } + } +#endif +#endif /* HAVE_ISATTY */ +#endif /* _MSC_VER */ + s->status |= Seekable_Stream_f; +} + +GetsFunc +PlGetsFunc(void) +{ + if (GLOBAL_CharConversionTable) + return DefaultGets; + else + return PlGets; +} + +static void +InitFileIO(StreamDesc *s) +{ + s->stream_gets = PlGetsFunc(); + if (s->status & Socket_Stream_f) { + /* Console is a socket and socket will prompt */ + Yap_ConsoleSocketOps( s ); + s->stream_wputc = put_wchar; + } else if (s->status & Pipe_Stream_f) { + /* Console is a socket and socket will prompt */ + Yap_ConsolePipeOps(s); + s->stream_wputc = put_wchar; + } else if (s->status & InMemory_Stream_f) { + Yap_MemOps( s ); + s->stream_wputc = put_wchar; + } else { + /* check if our console is promptable: may be tty or pipe */ + if (s->status & (Promptable_Stream_f)) { + Yap_ConsoleOps( s ); + } else { + /* we are reading from a file, no need to check for prompts */ + s->stream_putc = FilePutc; + s->stream_wputc = put_wchar; + s->stream_getc = PlGetc; + s->stream_gets = PlGetsFunc(); + } + } + s->stream_wputc = put_wchar; + s->stream_wgetc = get_wchar; +} + + +static void +InitStdStream (int sno, SMALLUNSGN flags, FILE * file) +{ + CACHE_REGS + StreamDesc *s = &GLOBAL_Stream[sno]; + s->file = file; + s->status = flags; + s->linepos = 0; + s->linecount = 1; + s->charcount = 0; + s->encoding = LOCAL_encoding; + INIT_LOCK(s->streamlock); + unix_upd_stream_info(s); + /* Getting streams to prompt is a mess because we need for cooperation + between readers and writers to the stream :-( + */ + InitFileIO(s); + switch(sno) { + case 0: + s->name=AtomUserIn; + break; + case 1: + s->name=AtomUserOut; + break; + default: + s->name=AtomUserErr; + break; + } + s->user_name = MkAtomTerm (s->name); + if (GLOBAL_CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; +#if LIGHT + s->status |= Tty_Stream_f|Promptable_Stream_f; +#endif +#if HAVE_SETBUF + if (s->status & Tty_Stream_f && + sno == 0) { + /* make sure input is unbuffered if it comes from stdin, this + makes life simpler for interrupt handling */ + setbuf (stdin, NULL); + // fprintf(stderr,"here I am\n"); + } +#endif /* HAVE_SETBUF */ + +} + + +static void +InitStdStreams (void) +{ + CACHE_REGS + if (LOCAL_sockets_io) { + InitStdStream (StdInStream, Input_Stream_f, NULL); + InitStdStream (StdOutStream, Output_Stream_f, NULL); + InitStdStream (StdErrStream, Output_Stream_f, NULL); + } else { + InitStdStream (StdInStream, Input_Stream_f, stdin); + InitStdStream (StdOutStream, Output_Stream_f, stdout); + InitStdStream (StdErrStream, Output_Stream_f, stderr); + } + GLOBAL_Stream[StdInStream].name = Yap_LookupAtom("user_input"); + GLOBAL_Stream[StdOutStream].name = Yap_LookupAtom("user_output"); + GLOBAL_Stream[StdErrStream].name = Yap_LookupAtom("user_error"); + LOCAL_c_input_stream = StdInStream; + LOCAL_c_output_stream = StdOutStream; + LOCAL_c_error_stream = StdErrStream; +} + +void +Yap_InitStdStreams (void) +{ + InitStdStreams(); +} + +Int +PlIOError (yap_error_number type, Term culprit, char *who, ...) +{ + if (trueLocalPrologFlag(FILEERRORS_FLAG) == MkIntTerm(1) || + type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) { + va_list args; + + va_start(args, who); + Yap_Error(type, culprit, who); + va_end( args ); + /* and fail */ + return FALSE; + } else { + return FALSE; + } +} + + +#ifdef DEBUG + +static int eolflg = 1; + + + +static char my_line[200] = {0}; +static char *lp = my_line; + +FILE * curfile, *Yap_logfile; + +bool Yap_Option[256]; + +#ifdef MACC + +static void +InTTYLine(char *line) +{ + char *p = line; + char ch; + while ((ch = InKey()) != '\n' && ch != '\r') + if (ch == 8) { + if (line < p) + BackupTTY(*--p); + } else + TTYChar(*p++ = ch); + TTYChar('\n'); + *p = 0; +} + +#endif + +void +Yap_DebugSetIFile(char *fname) +{ + if (curfile) + fclose(curfile); + curfile = fopen(fname, "r"); + if (curfile == NULL) { + curfile = stdin; + fprintf(stderr,"%% YAP Warning: can not open %s for input\n", fname); + } +} + +void +Yap_DebugEndline() +{ + *lp = 0; + +} + +int +Yap_DebugGetc() +{ + int ch; + if (eolflg) { + if (curfile != NULL) { + if (fgets(my_line, 200, curfile) == 0) + curfile = NULL; + } + if (curfile == NULL) + if (fgets(my_line, 200, stdin) == NULL) { + return EOF; + } + eolflg = 0; + lp = my_line; + } + if ((ch = *lp++) == 0) + ch = '\n', eolflg = 1; + if (Yap_Option['l' - 96]) + putc(ch, Yap_logfile); + return (ch); +} + +int +Yap_DebugPutc( FILE *s, wchar_t ch) +{ + if (Yap_Option['l' - 96]) + (void) putc(ch, Yap_logfile); + return (putc(ch, s)); +} + +int +Yap_DebugPuts( FILE *s, const char *sch) +{ + if (Yap_Option['l' - 96]) + (void) fputs(sch, Yap_logfile); + return (fputs(sch, s)); +} + +void +Yap_DebugPlWrite(Term t) +{ + if (t != 0) + Yap_plwrite(t, NULL, 0, 0, 1200); +} + +void +Yap_DebugErrorPutc(int c) +{ + Yap_DebugPutc (stderr, c); +} + +void +Yap_DebugErrorPuts(const char *s) +{ + Yap_DebugPuts (stderr, s); +} + +#endif + +/* static */ +int FilePutc(int sno, int ch) +{ + StreamDesc *s = &GLOBAL_Stream[sno]; +#if MAC || _MSC_VER + if (ch == 10) + { + ch = '\n'; + } +#endif + putc(ch, s->file); +#if MAC || _MSC_VER + if (ch == 10) + { + fflush(s->file); + } +#endif + count_output_char(ch,s); + return ((int) ch); +} + +static int +NullPutc (int sno, int ch) +{ + StreamDesc *s = &GLOBAL_Stream[sno]; +#if MAC || _MSC_VER + if (ch == 10) + { + ch = '\n'; + } +#endif + count_output_char(ch,s); + return ((int) ch); +} + +int +ResetEOF(StreamDesc *s) { + if (s->status & Eof_Error_Stream_f) { + Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM,MkAtomTerm(s->name), + "GetC"); + return FALSE; + } else if (s->status & Reset_Eof_Stream_f) { + /* reset the eof indicator on file */ + if (feof (s->file)) + clearerr (s->file); + /* reset our function for reading input */ +#if HAVE_SOCKET + if (s->status & Socket_Stream_f) { + if (s->status & Promptable_Stream_f) + Yap_ConsoleSocketOps( s ); + else + Yap_SocketOps( s ); + s->stream_wputc = put_wchar; + } else +#endif + if (s->status & Pipe_Stream_f) { + if (s->status & Promptable_Stream_f) + Yap_ConsolePipeOps( s ); + else + Yap_PipeOps( s ); + } else if (s->status & InMemory_Stream_f) { + Yap_MemOps( s ); + } else if (s->status & Promptable_Stream_f) { + Yap_ConsoleOps( s ); + } else { + s->stream_getc = PlGetc; + s->stream_gets = PlGetsFunc(); + } + s->stream_wgetc = get_wchar; + s->stream_wputc = put_wchar; + if (GLOBAL_CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + /* next, reset our own error indicator */ + s->status &= ~Eof_Stream_f; + /* try reading again */ + return TRUE; + } else { + s->status |= Past_Eof_Stream_f; + return FALSE; + } +} + +/* handle reading from a stream after having found an EOF */ +static int +EOFGetc(int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + + if (s->status & Push_Eof_Stream_f) { + /* ok, we have pushed an EOF, send it away */ + s->status &= ~Push_Eof_Stream_f; + return EOF; + } + if (ResetEOF(s)) { + return(s->stream_getc(sno)); + } + return EOF; +} + +/* check if we read a LOCAL_newline or an EOF */ +int +console_post_process_eof(StreamDesc *s) +{ + CACHE_REGS + s->status |= Eof_Stream_f; + s->stream_getc = EOFGetc; + s->stream_wgetc = get_wchar; + if (GLOBAL_CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + LOCAL_newline = FALSE; + return EOFCHAR; +} + +/* check if we read a newline or an EOF */ +int +post_process_read_char(int ch, StreamDesc *s) +{ + ++s->charcount; + ++s->linepos; + if (ch == '\n') { + ++s->linecount; + s->linepos = 0; + /* don't convert if the stream is binary */ + if (!(s->status & Binary_Stream_f)) + ch = 10; + } + return ch; +} + +/* check if we read a newline or an EOF */ +int +post_process_eof(StreamDesc *s) +{ + s->status |= Eof_Stream_f; + s->stream_getc = EOFGetc; + s->stream_wgetc = get_wchar; + if (GLOBAL_CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + return EOFCHAR; +} + +/* standard routine, it should read from anything pointed by a FILE *. + It could be made more efficient by doing our own buffering and avoiding + post_process_read_char, something to think about */ +int +PlGetc (int sno) +{ + StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + ch = getc (s->file); + if (ch == EOF) { + return post_process_eof(s); + } + return post_process_read_char(ch, s); +} + +/* standard routine, it should read from anything pointed by a FILE *. + It could be made more efficient by doing our own buffering and avoiding + post_process_read_char, something to think about */ +int +PlGets (int sno, UInt size, char *buf) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + UInt len; + + if (fgets (buf, size, s->file) == NULL) { + return post_process_eof(s); + } + len = strlen(buf); + s->charcount += len-1; + post_process_read_char(buf[len-2], s); + return strlen(buf); +} + +/* standard routine, it should read from anything pointed by a FILE *. + It could be made more efficient by doing our own buffering and avoiding + post_process_read_char, something to think about */ +int +DefaultGets (int sno, UInt size, char *buf) +{ + StreamDesc *s = &GLOBAL_Stream[sno]; + char ch; + char *pt = buf; + + + if (!size) + return 0; + while((ch = *buf++ = s->stream_getc(sno)) != + -1 && ch != 10 && --size); + *buf++ = '\0'; + return (buf-pt)-1; +} + +/* reads a character from a buffer and does the rest */ +int +PlUnGetc (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc) + return(s->stream_getc(sno)); + ch = s->och; + if (s->status & InMemory_Stream_f) { + Yap_MemOps( s ); + s->stream_wputc = put_wchar; + } else if (s->status & Socket_Stream_f) { + Yap_SocketOps( s ); + s->stream_wputc = put_wchar; + } else if (s->status & Promptable_Stream_f) { + Yap_ConsoleOps( s ); + s->stream_wputc = put_wchar; + } else { + s->stream_getc = PlGetc; + s->stream_gets = PlGetsFunc(); + } + return(ch); +} + +/* give back 0376+ch */ +static int +PlUnGetc376 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc376) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc; + ch = s->och; + s->och = 0xFE; + return ch; +} + +/* give back 0376+ch */ +static int +PlUnGetc00 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc00) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc; + ch = s->och; + s->och = 0x00; + return ch; +} + +/* give back 0377+ch */ +static int +PlUnGetc377 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc377) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc; + ch = s->och; + s->och = 0xFF; + return ch; +} + +/* give back 0357+ch */ +static int +PlUnGetc357 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc357) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc; + ch = s->och; + s->och = 0xEF; + return ch; +} + +/* give back 0357+0273+ch */ +static int +PlUnGetc357273 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc357273) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc357; + ch = s->och; + s->och = 0xBB; + return ch; +} + +/* give back 000+000+ch */ +static int +PlUnGetc0000 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc0000) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc00; + ch = s->och; + s->och = 0x00; + return ch; +} + +/* give back 000+000+ch */ +static int +PlUnGetc0000fe (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc0000fe) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc0000; + ch = s->och; + s->och = 0xfe; + return ch; +} + +/* give back 0377+0376+ch */ +static int +PlUnGetc377376 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc377376) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc377; + ch = s->och; + s->och = 0xFE; + return ch; +} + +/* give back 0377+0376+000+ch */ +static int +PlUnGetc37737600 (int sno) +{ + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + + if (s->stream_getc != PlUnGetc37737600) + return(s->stream_getc(sno)); + s->stream_getc = PlUnGetc377376; + ch = s->och; + s->och = 0x00; + return ch; +} + +static int +utf8_nof(char ch) +{ + if (!(ch & 0x20)) + return 1; + if (!(ch & 0x10)) + return 2; + if (!(ch & 0x08)) + return 3; + if (!(ch & 0x04)) + return 4; + return 5; +} + +int +get_wchar(int sno) +{ + int ch; + wchar_t wch; + int how_many = 0; + + while (TRUE) { + ch = GLOBAL_Stream[sno].stream_getc(sno); + if (ch == -1) { + if (how_many) { + /* error */ + } + return EOF; + } + switch (GLOBAL_Stream[sno].encoding) { + case ENC_OCTET: + return ch; + case ENC_ISO_LATIN1: + return ch; + case ENC_ISO_ASCII: + if (ch & 0x80) { + /* error */ + } + return ch; + case ENC_ISO_ANSI: + { + char buf[1]; + int out; + + if (!how_many) { + memset((void *)&(GLOBAL_Stream[sno].mbstate), 0, sizeof(mbstate_t)); + } + buf[0] = ch; + if ((out = mbrtowc(&wch, buf, 1, &(GLOBAL_Stream[sno].mbstate))) == 1) + return wch; + if (out == -1) { + /* error */ + } + how_many++; + break; + } + case ENC_ISO_UTF8: + { + if (!how_many) { + if (ch & 0x80) { + how_many = utf8_nof(ch); + /* + keep a backup of the start character in case we meet an error, + useful if we are scanning ISO files. + */ + GLOBAL_Stream[sno].och = ch; + wch = (ch & ((1<<(6-how_many))-1))<<(6*how_many); + } else { + return ch; + } + } else { + how_many--; + if ((ch & 0xc0) == 0x80) { + wch += (ch & ~0xc0) << (how_many*6); + } else { + /* error */ + /* try to recover character, assume this is our first character */ + wchar_t och = GLOBAL_Stream[sno].och; + + GLOBAL_Stream[sno].och = ch; + GLOBAL_Stream[sno].stream_getc = PlUnGetc; + GLOBAL_Stream[sno].stream_wgetc = get_wchar; + GLOBAL_Stream[sno].stream_gets = DefaultGets; + return och; + } + if (!how_many) { + return wch; + } + } + } + break; + case ENC_UNICODE_BE: + if (how_many) { + return wch+ch; + } + how_many=1; + wch = ch << 8; + break; + case ENC_UNICODE_LE: + if (how_many) { + return wch+(ch<<8); + } + how_many=1; + wch = ch; + break; + case ENC_ISO_UTF32_LE: + if (!how_many) { + how_many = 4; + wch = 0; + } + how_many--; + wch += ((unsigned char) (ch & 0xff)) << (how_many*8); + if (how_many == 0) + return wch; + break; + case ENC_ISO_UTF32_BE: + if (!how_many) { + how_many = 4; + wch = 0; + } + how_many--; + wch += ((unsigned char) (ch & 0xff)) << ((3-how_many)*8); + if (how_many == 0) + return wch; + break; + } + } + return EOF; +} + +#ifndef MB_LEN_MAX +#define MB_LEN_MAX 6 +#endif + +static int +handle_write_encoding_error(int sno, wchar_t ch) +{ + if (GLOBAL_Stream[sno].status & RepError_Xml_f) { + /* use HTML/XML encoding in ASCII */ + int i = ch, digits = 1; + GLOBAL_Stream[sno].stream_putc(sno, '&'); + GLOBAL_Stream[sno].stream_putc(sno, '#'); + while (digits < i) + digits *= 10; + if (digits > i) + digits /= 10; + while (i) { + GLOBAL_Stream[sno].stream_putc(sno, i/digits); + i %= 10; + digits /= 10; + } + GLOBAL_Stream[sno].stream_putc(sno, ';'); + return ch; + } else if (GLOBAL_Stream[sno].status & RepError_Prolog_f) { + /* write quoted */ + GLOBAL_Stream[sno].stream_putc(sno, '\\'); + GLOBAL_Stream[sno].stream_putc(sno, 'u'); + GLOBAL_Stream[sno].stream_putc(sno, ch>>24); + GLOBAL_Stream[sno].stream_putc(sno, 256&(ch>>16)); + GLOBAL_Stream[sno].stream_putc(sno, 256&(ch>>8)); + GLOBAL_Stream[sno].stream_putc(sno, 256&ch); + return ch; + } else { + CACHE_REGS + Yap_Error(REPRESENTATION_ERROR_CHARACTER, MkIntegerTerm(ch),"charater %ld cannot be encoded in stream %d",(unsigned long int)ch,sno); + return -1; + } +} + +int +put_wchar(int sno, wchar_t ch) +{ + + /* pass the bug if we can */ + switch (GLOBAL_Stream[sno].encoding) { + case ENC_OCTET: + return GLOBAL_Stream[sno].stream_putc(sno, ch); + case ENC_ISO_LATIN1: + if (ch >= 0xff) { + return handle_write_encoding_error(sno,ch); + } + return GLOBAL_Stream[sno].stream_putc(sno, ch); + case ENC_ISO_ASCII: + if (ch >= 0x80) { + return handle_write_encoding_error(sno,ch); + } + return GLOBAL_Stream[sno].stream_putc(sno, ch); + case ENC_ISO_ANSI: + { + char buf[MB_LEN_MAX]; + int n; + + memset((void *)&(GLOBAL_Stream[sno].mbstate), 0, sizeof(mbstate_t)); + if ( (n = wcrtomb(buf, ch, &(GLOBAL_Stream[sno].mbstate))) < 0 ) { + /* error */ + GLOBAL_Stream[sno].stream_putc(sno, ch); + return -1; + } else { + int i; + + for (i =0; i< n; i++) { + GLOBAL_Stream[sno].stream_putc(sno, buf[i]); + } + return ch; + } + case ENC_ISO_UTF8: + if (ch < 0x80) { + return GLOBAL_Stream[sno].stream_putc(sno, ch); + } else if (ch < 0x800) { + GLOBAL_Stream[sno].stream_putc(sno, 0xC0 | ch>>6); + return GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } + else if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, 0xE0 | ch>>12); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch>>6 & 0x3F)); + return GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } else if (ch < 0x200000) { + GLOBAL_Stream[sno].stream_putc(sno, 0xF0 | ch>>18); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch>>12 & 0x3F)); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch>>6 & 0x3F)); + return GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } else { + /* should never happen */ + return -1; + } + break; + case ENC_UNICODE_BE: + GLOBAL_Stream[sno].stream_putc(sno, (ch>>8)); + return GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff)); + case ENC_UNICODE_LE: + GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff)); + return GLOBAL_Stream[sno].stream_putc(sno, (ch>>8)); + case ENC_ISO_UTF32_BE: + GLOBAL_Stream[sno].stream_putc(sno, (ch>>24) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch>>16) &0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch>>8) & 0xff); + return GLOBAL_Stream[sno].stream_putc(sno, ch&0xff); + case ENC_ISO_UTF32_LE: + GLOBAL_Stream[sno].stream_putc(sno, ch&0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch>>8) & 0xff); + GLOBAL_Stream[sno].stream_putc(sno, (ch>>16) &0xff); + return GLOBAL_Stream[sno].stream_putc(sno, (ch>>24) & 0xff); + } + } + return -1; +} + +/* used by user-code to read characters from the current input stream */ +int +Yap_PlGetchar (void) +{ + CACHE_REGS + return(GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(LOCAL_c_input_stream)); +} + +int +Yap_PlGetWchar (void) +{ + CACHE_REGS + return get_wchar(LOCAL_c_input_stream); +} + +/* avoid using a variable to call a function */ +int +Yap_PlFGetchar (void) +{ + CACHE_REGS + return(PlGetc(LOCAL_c_input_stream)); +} + + +Term +Yap_MkStream (int n) +{ + Term t[1]; + t[0] = MkIntTerm (n); + return (Yap_MkApplTerm (FunctorStream, 1, t)); +} + +/* given a stream index, get the corresponding fd */ +Int +GetStreamFd(int sno) +{ +#if HAVE_SOCKET + if (GLOBAL_Stream[sno].status & Socket_Stream_f) { + return(GLOBAL_Stream[sno].u.socket.fd); + } else +#endif + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { +#if _MSC_VER || defined(__MINGW32__) + return((Int)(GLOBAL_Stream[sno].u.pipe.hdl)); +#else + return(GLOBAL_Stream[sno].u.pipe.fd); +#endif + } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { + return(-1); + } + return(fileno(GLOBAL_Stream[sno].file)); +} + +Int +Yap_GetStreamFd(int sno) +{ + return GetStreamFd(sno); +} + + +static int +binary_file(char *file_name) +{ +#if HAVE_STAT +#if _MSC_VER || defined(__MINGW32__) + struct _stat ss; + if (_stat(file_name, &ss) != 0) +#else + struct stat ss; + if (stat(file_name, &ss) != 0) +#endif + { + /* ignore errors while checking a file */ + return(FALSE); + } + return (S_ISDIR(ss.st_mode)); +#else + return(FALSE); +#endif + } + + static int + write_bom(int sno, StreamDesc *st) + { + /* dump encoding */ + switch (st->encoding) { + case ENC_ISO_UTF8: + if (st->stream_putc(sno,0xEF)<0) + return FALSE; + if (st->stream_putc(sno,0xBB)<0) + return FALSE; + if (st->stream_putc(sno,0xBF)<0) + return FALSE; + st->status |= HAS_BOM_f; + return TRUE; + case ENC_UNICODE_BE: + if (st->stream_putc(sno,0xFE)<0) + return FALSE; + if (st->stream_putc(sno,0xFF)<0) + return FALSE; + st->status |= HAS_BOM_f; + return TRUE; + case ENC_UNICODE_LE: + if (st->stream_putc(sno,0xFF)<0) + return FALSE; + if (st->stream_putc(sno,0xFE)<0) + return FALSE; + case ENC_ISO_UTF32_BE: + if (st->stream_putc(sno,0x00)<0) + return FALSE; + if (st->stream_putc(sno,0x00)<0) + return FALSE; + if (st->stream_putc(sno,0xFE)<0) + return FALSE; + if (st->stream_putc(sno,0xFF)<0) + return FALSE; + case ENC_ISO_UTF32_LE: + if (st->stream_putc(sno,0xFF)<0) + return FALSE; + if (st->stream_putc(sno,0xFE)<0) + return FALSE; + if (st->stream_putc(sno,0x00)<0) + return FALSE; + if (st->stream_putc(sno,0x00)<0) + return FALSE; + default: + return TRUE; + } + } + + + static void + check_bom(int sno, StreamDesc *st) + { + + int ch; + + ch = st->stream_getc(sno); + if (ch == EOFCHAR) { + st->och = ch; + st->stream_getc = PlUnGetc; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } + switch(ch) { + case 0x00: + { + ch = st->stream_getc(sno); + if (ch == EOFCHAR || ch != 0x00) { + st->och = ch; + st->stream_getc = PlUnGetc00; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + ch = st->stream_getc(sno); + if (ch == EOFCHAR || ch != 0xFE) { + st->och = ch; + st->stream_getc = PlUnGetc0000; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + ch = st->stream_getc(sno); + if (ch == EOFCHAR || ch != 0xFF) { + st->och = ch; + st->stream_getc = PlUnGetc0000fe; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF32_BE; + return; + } + } + } + } + case 0xFE: + { + ch = st->stream_getc(sno); + if (ch != 0xFF) { + st->och = ch; + st->stream_getc = PlUnGetc376; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + st->status |= HAS_BOM_f; + st->encoding = ENC_UNICODE_BE; + return; + } + } + case 0xFF: + { + ch = st->stream_getc(sno); + if (ch != 0xFE) { + st->och = ch; + st->stream_getc = PlUnGetc377; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + ch = st->stream_getc(sno); + if (ch == EOFCHAR || ch != 0x00) { + st->och = ch; + st->stream_getc = PlUnGetc377376; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + } else { + ch = st->stream_getc(sno); + if (ch == EOFCHAR || ch != 0x00) { + st->och = ch; + st->stream_getc = PlUnGetc37737600; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + } else { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF32_LE; + return; + } + } + st->status |= HAS_BOM_f; + st->encoding = ENC_UNICODE_LE; + return; + } + } + case 0xEF: + ch = st->stream_getc(sno); + if (ch != 0xBB) { + st->och = ch; + st->stream_getc = PlUnGetc357; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + ch = st->stream_getc(sno); + if (ch != 0xBF) { + st->och = ch; + st->stream_getc = PlUnGetc357273; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } else { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF8; + return; + } + } + default: + st->och = ch; + st->stream_getc = PlUnGetc; + st->stream_wgetc = get_wchar; + st->stream_gets = DefaultGets; + return; + } + } + + static bool + initStream(int sno, FILE *fd, const char *name, Term file_name, encoding_t encoding, stream_flags_t flags, Atom open_mode ) + { + StreamDesc *st = &GLOBAL_Stream[sno]; + st->status = flags; + + st->charcount = 0; + st->linecount = 1; + if (name == NULL) { + char buf[YAP_FILENAME_MAX+1]; + name = Yap_guessFileName(fileno(fd), sno, buf, YAP_FILENAME_MAX); + st->name = Yap_LookupAtom(name); + } + st->user_name = file_name; + st->file = fd; + st->linepos = 0; + st->stream_gets = PlGetsFunc(); + if (flags & Pipe_Stream_f) { + Yap_PipeOps( st ); + } else if (flags & Tty_Stream_f) { + Yap_ConsoleOps( st ); + } else { + st->stream_putc = FilePutc; + st->stream_getc = PlGetc; + unix_upd_stream_info (st); + } + st->stream_wgetc = get_wchar; + st->stream_wputc = put_wchar; + if (flags & Binary_Stream_f) { + st->encoding = ENC_OCTET; + } else { + st->encoding = encoding; + } + if (GLOBAL_CharConversionTable != NULL) + st->stream_wgetc_for_read = ISOWGetc; + else + st->stream_wgetc_for_read = st->stream_wgetc; + if (GLOBAL_CharConversionTable != NULL) + st->stream_wgetc_for_read = ISOWGetc; + return true; +} + + +#define OPEN_DEFS() \ + PAR( "alias", isatom, OPEN_ALIAS), \ + PAR( "bom", boolean, OPEN_BOM ), \ + PAR( "buffer", isatom, OPEN_BUFFER ), \ + PAR( "close_on_abort", boolean, OPEN_CLOSE_ON_ABORT ), \ + PAR( "create", isatom, OPEN_CREATE ), \ + PAR( "encoding", isatom, OPEN_ENCODING ), \ + PAR( "eof_action", isatom, OPEN_EOF_ACTION ), \ + PAR( "expand_filename", boolean, OPEN_EXPAND_FILENAME ), \ + PAR( "file_name", isatom, OPEN_FILE_NAME ), \ + PAR( "input", ok, OPEN_INPUT ), \ + PAR( "locale", isatom, OPEN_LOCALE ), \ + PAR( "lock", isatom, OPEN_LOCK ), \ + PAR( "mode", isatom, OPEN_MODE ), \ + PAR( "output", ok, OPEN_OUTPUT ), \ + PAR( "representation_errors", boolean, OPEN_REPRESENTATION_ERRORS ), \ + PAR( "reposition", boolean, OPEN_REPOSITION ), \ + PAR( "type", isatom, OPEN_TYPE ), \ + PAR( "wait", boolean, OPEN_WAIT ), \ + PAR( NULL, ok, OPEN_END ) + +#define PAR(x,y,z) z + + typedef enum open_enum_choices + { + OPEN_DEFS() + } open_choices_t; + +#undef PAR + +#define PAR(x,y,z) { x , y, z } + + + static const param_t open_defs[] = + { + OPEN_DEFS() + }; +#undef PAR + + + static Int + open4 ( USES_REGS1 ) + { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ + Term file_name, t2, tenc; + Atom open_mode; + int sno; + SMALLUNSGN s; + char io_mode[8]; + StreamDesc *st; + bool avoid_bom = false, needs_bom = true, bin = false; + char *fname; + stream_flags_t flags; + Term tlist; + FILE *fd; + encoding_t encoding; + + file_name = Deref(ARG1); + // original file name + if (IsVarTerm (file_name)) { + Yap_Error(INSTANTIATION_ERROR,file_name, "open/3"); + return FALSE; + } + if (!IsAtomTerm (file_name)) { + if (IsStringTerm( file_name )) { + fname = (char *)StringOfTerm( file_name ); + } else { + Yap_Error(DOMAIN_ERROR_SOURCE_SINK,file_name, "open/3"); + return FALSE; + } + } else { + fname = RepAtom (AtomOfTerm (file_name))->StrOfAE; + } + // open mode + t2 = Deref (ARG2); + if (IsVarTerm (t2)) { + Yap_Error(INSTANTIATION_ERROR,t2, "open/3"); + return FALSE; + } + if (!IsAtomTerm (t2)) { + if (IsStringTerm( t2 )) { + open_mode = Yap_LookupAtom( StringOfTerm( t2 ) ); + } else { + Yap_Error(TYPE_ERROR_ATOM,t2, "open/3"); + return(FALSE); + } + } else { + open_mode = AtomOfTerm (t2); + } + // read, write, append + if (open_mode == AtomRead) { + strncpy(io_mode,"rb", 8); + s = Input_Stream_f; + } else if (open_mode == AtomWrite) { + strncpy(io_mode,"w",8); + s = Output_Stream_f; + } else if (open_mode == AtomAppend) { + strncpy(io_mode,"a",8); + s = Append_Stream_f | Output_Stream_f; + } else { + Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "open/3"); + return(FALSE); + } + /* get options */ + xarg *args = Yap_ArgListToVector ( (tlist = Deref(ARG4) ), open_defs, OPEN_END ); + if (args == NULL) + return FALSE; + /* done */ + sno = GetFreeStreamD(); + if (sno < 0) + return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "open/3")); + st = &GLOBAL_Stream[sno]; + st->user_name = file_name; + st->name = Yap_LookupAtom(Yap_AbsoluteFile(fname, NULL)); + flags = s; + // user requested encoding? + if (args[OPEN_ALIAS].used) { + Atom al = AtomOfTerm(args[OPEN_ALIAS].tvalue); + if (!Yap_AddAlias(al,sno)) + return false; + } else { + st->encoding = LOCAL_encoding; + } + if (args[OPEN_ENCODING].used) { + tenc = args[OPEN_ENCODING].tvalue; + encoding = enc_id( RepAtom(AtomOfTerm(tenc))->StrOfAE ); + } else { + encoding = LOCAL_encoding; + } + // expand file name? + if (args[OPEN_EXPAND_FILENAME].used) { + Term t = args[OPEN_TYPE].tvalue; + if (t == TermTrue) { + fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf); + } else { + if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX)) + return (PlIOError (SYSTEM_ERROR,file_name,"file name is too long in open/3")); + } + } else if (trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG)) { + fname = Yap_AbsoluteFile( fname, LOCAL_FileNameBuf); + } else { + if (!strncpy(LOCAL_FileNameBuf, fname, YAP_FILENAME_MAX)) { + return PlIOError (SYSTEM_ERROR,file_name,"file name is too long in open/3"); + } + } + // binary type + if ((args[OPEN_TYPE].used)) { + Term t = args[OPEN_TYPE].tvalue; + bool bin = ( t == TermBinary ); + if (bin) { +#ifdef _WIN32 + strncat(io_mode, "b", 8); +#endif + flags |= Binary_Stream_f; + encoding = ENC_OCTET; + avoid_bom = true; + } else if ( t == TermText ) { +#ifdef _WIN32 + strncat(io_mode, "t", 8); +#endif + /* note that this matters for UNICODE style conversions */ +#if MAC + if (open_mode == AtomWrite) + { + Yap_SetTextFile (RepAtom (AtomOfTerm (file_name))->StrOfAE); + } +#endif + } else { + Yap_Error(DOMAIN_ERROR_STREAM, tlist, "type is ~a, must be one of binary or text", t); + } + } + // BOM mess + if (encoding == ENC_ISO_ASCII || + encoding == ENC_ISO_LATIN1 || + bin) { + avoid_bom = true; + } + if (args[OPEN_BOM].used) { + if (args[OPEN_BOM].tvalue == TermTrue) { + needs_bom = true; + if (avoid_bom) { + return (PlIOError (SYSTEM_ERROR,file_name,"BOM not compatible with encoding")); + } + } + else if (args[OPEN_BOM].tvalue == TermFalse) { + needs_bom = false; + avoid_bom = true; + } else { + Yap_Error(DOMAIN_ERROR_STREAM, tlist, "bom is ~a, should be one of true or false", args[OPEN_BOM].tvalue); + } + }else if (st-GLOBAL_Stream < 3) { + flags |= RepError_Prolog_f; + } + if ((fd = fopen (fname, io_mode)) == NULL || + (!(flags & Binary_Stream_f) && binary_file(fname))) + { + UNLOCK(st->streamlock); + if (errno == ENOENT) + return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK,ARG6,"open/3")); + else + return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK,file_name,"open/3")); + } +#if MAC + if (open_mode == AtomWrite) + { + Yap_SetTextFile (RepAtom (AtomOfTerm (file_name))->StrOfAE); + } +#endif + if (!initStream( sno, fd, fname, file_name, encoding, flags, open_mode )) + return false; + if (open_mode == AtomWrite ) { + if (needs_bom && !write_bom(sno,st)) + return FALSE; + } else if ((open_mode == AtomRead) && + !avoid_bom && + (needs_bom || (flags & Seekable_Stream_f))) { + check_bom(sno, st); // can change encoding + if (st->encoding == ENC_ISO_UTF32_BE) { + Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (BE) stream encoding unsupported"); + return FALSE; + } else if (st->encoding == ENC_ISO_UTF32_LE) { + Yap_Error(DOMAIN_ERROR_STREAM_ENCODING, ARG1, "UTF-32 (LE) stream encoding unsupported"); + return FALSE; + } + } + + + flags &= ~(Free_Stream_f); + UNLOCK(st->streamlock); + { + Term t = Yap_MkStream (sno); + return (Yap_unify (ARG3, t)); + } + } + + static Int + open3 ( USES_REGS1 ) + { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ + ARG4 = TermNil; + return open4( PASS_REGS1 ); + } + + static Int + p_file_expansion (USES_REGS1) + { /* '$file_expansion'(+File,-Name) */ + Term file_name = Deref(ARG1); + + /* we know file_name is bound */ + if (!IsAtomTerm (file_name)) { + PlIOError(TYPE_ERROR_ATOM, file_name, "absolute_file_name/3"); + return(FALSE); + } + if (!Yap_TrueFileName (RepAtom (AtomOfTerm (file_name))->StrOfAE, LOCAL_FileNameBuf, FALSE)) + return (PlIOError (EXISTENCE_ERROR_SOURCE_SINK,file_name,"absolute_file_name/3")); + return(Yap_unify(ARG2,MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)))); + } + + static Int + p_open_null_stream (USES_REGS1) + { + Term t; + StreamDesc *st; + int sno = GetFreeStreamD(); + if (sno < 0) + return (PlIOError (SYSTEM_ERROR,TermNil, "new stream not available for open_null_stream/1")); + st = &GLOBAL_Stream[sno]; + st->status = Append_Stream_f | Output_Stream_f | Null_Stream_f; +#if _WIN32 + st->file = fopen("NUL","w"); +#else + st->file = fopen("/dev/null","w"); +#endif + if (st->file == NULL) { + Yap_Error( SYSTEM_ERROR, TermNil, "Could not open NULL stream (/dev/null,NUL)" ); + return false; + } + st->linepos = 0; + st->charcount = 0; + st->linecount = 1; + st->stream_putc = NullPutc; + st->stream_wputc = put_wchar; + st->stream_getc = PlGetc; + st->stream_gets = PlGetsFunc(); + st->stream_wgetc = get_wchar; + st->stream_wgetc_for_read = get_wchar; + st->user_name = MkAtomTerm (st->name = AtomDevNull); + UNLOCK(st->streamlock); + t = Yap_MkStream (sno); + return (Yap_unify (ARG1, t)); + } + + int + Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) + { + int sno; + Atom at; + + sno = GetFreeStreamD(); + if (sno < 0) + return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,file_name, "new stream not available for opening")); + if (flags & Output_Stream_f) { + if (flags & Append_Stream_f) + at = AtomAppend; + else + at = AtomWrite; + } else + at = AtomRead; + initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at ); + UNLOCK(st->streamlock); + return sno; + } + + static int + CheckStream (Term arg, int kind, const char *msg) + { + int sno = -1; + arg = Deref (arg); + if (IsVarTerm (arg)) { + Yap_Error(INSTANTIATION_ERROR, arg, msg); + return -1; + } else if (IsAtomTerm (arg)) { + Atom sname = AtomOfTerm (arg); + + if (sname == AtomUser) { + if (kind & Input_Stream_f) { + if (kind & (Output_Stream_f|Append_Stream_f)) { + Yap_Error(PERMISSION_ERROR_INPUT_STREAM, arg, + "ambiguous use of 'user' as a stream"); + return (-1); + } + sname = AtomUserIn; + } else { + sname = AtomUserOut; + } + } + if ((sno = Yap_CheckAlias(sname)) == -1) { + Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); + return -1; + } + } else if (IsApplTerm (arg) && FunctorOfTerm (arg) == FunctorStream) { + arg = ArgOfTerm (1, arg); + if (!IsVarTerm (arg) && IsIntegerTerm (arg)) { + sno = IntegerOfTerm(arg); + } + } + if (sno < 0) + { + Yap_Error(DOMAIN_ERROR_STREAM_OR_ALIAS, arg, msg); + return (-1); + } + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Free_Stream_f) + { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); + return (-1); + } + if ((GLOBAL_Stream[sno].status & kind) == 0) + { + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (kind & Input_Stream_f) + Yap_Error(PERMISSION_ERROR_INPUT_STREAM, arg, msg); + else + Yap_Error(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); + return (-1); + } + return (sno); + } + + int + Yap_CheckStream (Term arg, int kind, const char *msg) + { + return CheckStream(arg, kind, (char *)msg); + } + + + + static Int + always_prompt_user( USES_REGS1 ) + { + StreamDesc *s = GLOBAL_Stream+StdInStream; + + s->status |= Promptable_Stream_f; +#if USE_SOCKET + if (s->status & Socket_Stream_f) { + Yap_ConsoleSocketOps( s ); + } else +#endif + if (s->status & Pipe_Stream_f) { + Yap_ConsolePipeOps( s ); + } else + Yap_ConsoleOps( s ); + return(TRUE); + } + + + static Int + close1 (USES_REGS1) + { /* '$close'(+GLOBAL_Stream) */ + Int sno = CheckStream (ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); + if (sno < 0) + return (FALSE); + if (sno <= StdErrStream) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return TRUE; + } + Yap_CloseStream(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); + } + +#define CLOSE_DEFS() \ + PAR( "force", boolean, CLOSE_FORCE), \ + PAR( NULL, ok, CLOSE_END ) + +#define PAR(x,y,z) z + + typedef enum close_enum_choices + { + CLOSE_DEFS() + } close_choices_t; + +#undef PAR + +#define PAR(x,y,z) { x , y, z } + + + static const param_t close_defs[] = + { + CLOSE_DEFS() + }; +#undef PAR + + static Int + close2 (USES_REGS1) + { /* '$close'(+GLOBAL_Stream) */ + Int sno = CheckStream (ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); + Term tlist; + if (sno < 0) + return (FALSE); + if (sno <= StdErrStream) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return TRUE; + } + xarg *args = Yap_ArgListToVector ( (tlist = Deref(ARG2) ), close_defs, CLOSE_END ); + if (args == NULL) + return FALSE; + // if (args[CLOSE_FORCE].used) { + // } + Yap_CloseStream(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); + } + + + Term + read_line(int sno) + { + CACHE_REGS + Term tail; + Int ch; + + if ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) == 10) { + return(TermNil); + } + tail = read_line(sno); + return(MkPairTerm(MkIntTerm(ch),tail)); + } + + + + void + Yap_InitPlIO (void) + { + CACHE_REGS + + Int i; + + Yap_stdin = stdin; + Yap_stdout = stdout; + Yap_stderr = stderr; + GLOBAL_Stream = (StreamDesc *)Yap_AllocCodeSpace(sizeof(StreamDesc)*MaxStreams); + for (i = 0; i < MaxStreams; ++i) { + INIT_LOCK(GLOBAL_Stream[i].streamlock); + GLOBAL_Stream[i].status = Free_Stream_f; + } + InitStdStreams(); + } + + void + Yap_InitIOPreds(void) + { + /* here the Input/Output predicates */ + Yap_InitCPred ("always_prompt_user", 0, always_prompt_user, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("close", 1, close1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("close", 2, close2, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("open", 4, open4, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("open", 3, open3, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$file_expansion", 2, p_file_expansion, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$open_null_stream", 1, p_open_null_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitIOStreams(); + Yap_InitCharsio(); + Yap_InitChtypes(); + Yap_InitConsole(); + Yap_InitReadUtil (); + Yap_InitMems(); + Yap_InitPipes( ); + Yap_InitFiles(); + Yap_InitWriteTPreds(); + Yap_InitReadTPreds(); + Yap_InitFormat(); + Yap_InitReadline(); + Yap_InitSockets(); + Yap_InitSysPreds(); + } diff --git a/os/iopreds.h b/os/iopreds.h new file mode 100644 index 000000000..902973a8c --- /dev/null +++ b/os/iopreds.h @@ -0,0 +1,416 @@ +/************************************************************************** + * * + * File: iopreds.h * + * Last rev: 5/2/88 * + * mods: * + * comments: Input/Output C implemented predicates * + * * + *************************************************************************/ +#ifdef SCCS +static char SccsId[] = "%W% %G%"; +#endif + +#ifndef IOPREDS_H +#define IOPREDS_H 1 + +/* + * This file defines main data-structure for stream management, + * + */ + +extern size_t Yap_page_size; + +#if defined(_MSC_VER) || defined(__MINGW32__) + +#include + +#endif + +#include + +#if HAVE_SOCKET +extern int Yap_sockets_io; + +/****************** defines for sockets *********************************/ + +typedef enum{ /* in YAP, sockets may be in one of 4 possible status */ + new_socket, + server_socket, + client_socket, + server_session_socket, + closed_socket +} socket_info; + +typedef enum{ /* we accept two domains for the moment, IPV6 may follow */ + af_inet, /* IPV4 */ + af_unix /* or AF_FILE */ +} socket_domain; + +extern Term Yap_InitSocketStream(int, socket_info, socket_domain); +extern int Yap_CheckStream(Term, int, const char *); +extern int Yap_CheckSocketStream(Term, const char *); +extern socket_domain Yap_GetSocketDomain(int); +extern socket_info Yap_GetSocketStatus(int); +extern void Yap_UpdateSocketStream(int, socket_info, socket_domain); + +/* routines in ypsocks.c */ +Int Yap_CloseSocket(int, socket_info, socket_domain); + +#endif /* USE_SOCKET */ + +/************ SWI compatible support for unicode representations ************/ +typedef struct yap_io_position +{ int64_t byteno; /* byte-position in file */ + int64_t charno; /* character position in file */ + long int lineno; /* lineno in file */ + long int linepos; /* position in line */ + intptr_t reserved[2]; /* future extensions */ +} yapIOPOS; + +#ifndef _PL_STREAM_H +typedef struct +{ Atom file; /* current source file */ + yapIOPOS position; /* Line, line pos, char and byte */ +} yapSourceLocation; +#endif + +#define RD_MAGIC 0xefebe128 + + +typedef struct vlist_struct_t { + struct VARSTRUCT *ve; + struct vlist_struct_t *next; +} vlist_t; + +typedef struct qq_struct_t { + unsigned char *text; + yapIOPOS start, mid, end; + vlist_t *vlist; + struct qq_struct_t *next; +} qq_t; + + +typedef struct read_data_t +{ unsigned char *here; /* current character */ + unsigned char *base; /* base of clause */ + unsigned char *end; /* end of the clause */ + unsigned char *token_start; /* start of most recent read token */ + + int magic; /* RD_MAGIC */ + struct stream_desc *stream; + FILE *f; /* file. of known */ + Term position; /* Line, line pos, char and byte */ + void *posp; /* position pointer */ + size_t posi; /* position number */ + + Term subtpos; /* Report Subterm positions */ + bool cycles; /* Re-establish cycles */ + yapSourceLocation start_of_term; /* Position of start of term */ + ModEntry* module; /* Current source module */ + unsigned int flags; /* Module syntax flags */ + int styleCheck; /* style-checking mask */ + bool backquoted_string; /* Read `hello` as string */ + + int *char_conversion_table; /* active conversion table */ + + Atom on_error; /* Handling of syntax errors */ + int has_exception; /* exception is raised */ + + Term exception; /* raised exception */ + Term variables; /* report variables */ + Term singles; /* Report singleton variables */ + Term varnames; /* Report variables+names */ + int strictness; /* Strictness level */ + +#ifdef O_QUASIQUOTATIONS + Term quasi_quotations; /* User option quasi_quotations(QQ) */ + Term qq; /* Quasi quoted list */ + Term qq_tail; /* Tail of the quoted stuff */ +#endif + + Term comments; /* Report comments */ + +} read_data, *ReadData; + +Term Yap_read_term(int inp_stream, Term opts, int nargs); +Term Yap_Parse( UInt prio ); + +void init_read_data(ReadData _PL_rd, struct stream_desc *s); + +typedef int (*GetsFunc)(int, UInt, char *); + +#if HAVE_SYS_TYPES_H +#include +#endif +#if HAVE_SYS_SOCKET_H +#include +#endif + +typedef +struct mem_desc { + char *buf; /* where the file is being read from/written to */ + int src; /* where the space comes from, 0 code space, 1 malloc */ + Int max_size; /* maximum buffer size (may be changed dynamically) */ + UInt pos; /* cursor */ + volatile void *error_handler; +} memHandle; + +typedef struct stream_desc +{ + Atom name; + Term user_name; + FILE* file; + union { + struct { +#if defined(__MINGW32__) || defined(_MSC_VER) +#define PLGETC_BUF_SIZE 4096 + char *buf, *ptr; + int left; +#endif + } file; + memHandle mem_string; + struct { +#if defined(__MINGW32__) || defined(_MSC_VER) + HANDLE hdl; +#else + int fd; +#endif + } pipe; +#if HAVE_SOCKET + struct { + socket_domain domain; + socket_info flags; + int fd; + } socket; +#endif + struct { + const char *buf, *ptr; + } irl; + } u; + Int charcount, linecount, linepos; + stream_flags_t status; + int och; +#if defined(YAPOR) || defined(THREADS) + lockvar streamlock; /* protect stream access */ +#endif + int (* stream_putc)(int, int); /* function the stream uses for writing */ + int (* stream_getc)(int); /* function the stream uses for reading */ + GetsFunc stream_gets; /* function the stream uses for reading a sequence of characters */ + /* function the stream uses for parser. It may be different if the ISO + character conversion is on */ + int (* stream_wgetc_for_read)(int); + int (* stream_wgetc)(int); + int (* stream_wputc)(int,wchar_t); + encoding_t encoding; + mbstate_t mbstate; +} + StreamDesc; + +static inline bool +IsStreamTerm(Term t) +{ + return !IsVarTerm(t) && + (IsAtomTerm(t) || (IsApplTerm(t) && (FunctorOfTerm(t) == FunctorStream))); +} + +static inline StreamDesc * +Yap_GetStreamHandle(Term t) +{ + int sno = Yap_CheckStream( t , 0, "stream search"); + if (sno < 0) + return NULL; + return GLOBAL_Stream+sno; +} + + +#define YAP_ERROR NIL + +#define MaxStreams 64 + +#define EXPAND_FILENAME 0x000080 + +#define StdInStream 0 +#define StdOutStream 1 +#define StdErrStream 2 + +#define ALIASES_BLOCK_SIZE 8 + +void Yap_InitStdStreams (void); +Term Yap_StreamPosition (int); + +static inline int +GetCurInpPos (StreamDesc * inp_stream) +{ + return (inp_stream->linecount); +} + +Int PlIOError( yap_error_number, Term, char *, ...); +int GetFreeStreamD(void); +Term Yap_MkStream (int n); + + +void Yap_plwrite(Term, struct stream_desc *, int, int, int); +int Yap_FormatFloat( Float f, const char *s, size_t sz ); +void Yap_WriteAtom(struct stream_desc *s, Atom atom); + +Term Yap_scan_num(struct stream_desc *); + +void Yap_DefaultStreamOps( StreamDesc *st ); +void Yap_PipeOps( StreamDesc *st ); +void Yap_MemOps( StreamDesc *st ); +void Yap_ConsolePipeOps( StreamDesc *st ); +void Yap_SocketOps( StreamDesc *st ); +void Yap_ConsoleSocketOps( StreamDesc *st ); +bool Yap_ReadlineOps( StreamDesc *st ); +int Yap_OpenBufWriteStream(void); +void Yap_ConsoleOps( StreamDesc *s ); + +void Yap_init_socks(char *host, long interface_port); +void Yap_InitPipes( void ); +void Yap_InitMem( void ); +void Yap_InitSockets( void ); +void Yap_InitSocketLayer(void); +void Yap_InitMems( void ); +void Yap_InitConsole( void ); +void Yap_InitReadline( void ); +void Yap_InitChtypes(void); +void Yap_InitCharsio(void); +void Yap_InitFormat(void); +void Yap_InitFiles(void); +void Yap_InitIOStreams(void); +void Yap_InitWriteTPreds(void); +void Yap_InitReadTPreds(void); +void Yap_socketStream( StreamDesc *s ); +void Yap_ReadlineFlush( int sno ); +int Yap_ReadlineForSIGINT(void); +bool Yap_ReadlinePrompt( StreamDesc * s ); + +Term Yap_syntax_error (TokEntry * tokptr, int sno); + +int console_post_process_read_char( int, StreamDesc *); +int console_post_process_eof( StreamDesc *); +int post_process_read_char( int, StreamDesc *); +int post_process_eof( StreamDesc *); + +bool is_same_tty(FILE *f1, FILE *f2); + +int ISOWGetc (int sno); +Term read_line(int sno); +int PlUnGetc( int); +int PlGets (int sno, UInt size, char *buf); +GetsFunc PlGetsFunc(void); +int PlGetc (int sno); +int FilePutc (int sno, int c); +int DefaultGets( int,UInt,char*); +int get_wchar( int); +int put_wchar(int sno, wchar_t ch); +Int GetStreamFd(int sno); +int ResetEOF(StreamDesc *s); + +void Yap_SetAlias (Atom arg, int sno); +bool Yap_AddAlias (Atom arg, int sno); +int Yap_CheckAlias (Atom arg); +int Yap_RemoveAlias (Atom arg, int snoinline); +void Yap_SetAlias (Atom arg, int sno); +void Yap_InitAliases(void); +void Yap_DeleteAliases (int sno); +bool Yap_FindStreamForAlias (Atom al); +bool Yap_FetchStreamAlias (int sno, Term t2 USES_REGS); + +INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s); + +INLINE_ONLY inline EXTERN void +count_output_char(int ch, StreamDesc *s) +{ + if (ch == '\n') + { +#if MPWSHELL + if (mpwshell && (sno == StdOutStream || sno == + StdErrStream) && + !(s->status & Null_Stream_f)) + { + putc (MPWSEP, s->file); + if (!(GLOBAL_Stream[LOCAL_output_stream].status & Null_Stream_f)) + fflush (stdout); + } +#endif + /* Inform that we have written a newline */ + ++s->charcount; + ++s->linecount; + s->linepos = 0; } + else { +#if MAC + if ((sno == StdOutStream || sno == StdErrStream) + && s->linepos > 200) + sno->stream_putc(sno, '\n'); +#endif + ++s->charcount; + ++s->linepos; + } +} + +inline static Term +StreamName(int i) +{ + return(GLOBAL_Stream[i].user_name); +} + +inline static void +console_count_output_char(int ch, StreamDesc *s) +{ + CACHE_REGS + if (ch == '\n') + { +#if MPWSHELL + if (mpwshell && (sno == StdOutStream || sno == + StdErrStream) && + !(s->status & Null_Stream_f)) + { + putc (MPWSEP, s->file); + if (!(GLOBAL_Stream[LOCAL_output_stream].status & Null_Stream_f)) + fflush (stdout); + } +#endif + ++s->charcount; + ++s->linecount; + s->linepos = 0; + LOCAL_newline = TRUE; + /* Inform we are not at the start of a newline */ + } + else { + LOCAL_newline = FALSE; +#if MAC + if ((sno == StdOutStream || sno == StdErrStream) + && s->linepos > 200) + sno->stream_putc(sno, '\n'); +#endif + ++s->charcount; + ++s->linepos; + } +} + +inline static Term +StreamPosition(int sno) +{ +CACHE_REGS + Term sargs[5]; + Int cpos; + cpos = GLOBAL_Stream[sno].charcount; + if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { + cpos--; + } + sargs[0] = MkIntegerTerm (cpos); + sargs[1] = MkIntegerTerm (LOCAL_StartLine = GLOBAL_Stream[sno].linecount); + sargs[2] = MkIntegerTerm (GLOBAL_Stream[sno].linepos); + sargs[3] = sargs[4] = MkIntTerm (0); + return Yap_MkApplTerm (FunctorStreamPos, 5, sargs); +} + + + +extern FILE *Yap_stdin; +extern FILE *Yap_stdout; +extern FILE *Yap_stderr; + + +#endif diff --git a/os/streams.c b/os/streams.c new file mode 100644 index 000000000..3c45cbb21 --- /dev/null +++ b/os/streams.c @@ -0,0 +1,1503 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: iopreds.c * +* Last rev: 5/2/88 * +* mods: * +* comments: Input/Output C implemented predicates * +* * +*************************************************************************/ +#ifdef SCCS +static char SccsId[] = "%W% %G%"; +#endif + +/* + * This file includes the definition of a miscellania of standard predicates + * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, + * + */ + +#include "Yap.h" +#if HAVE_FCNTL_H +/* for O_BINARY and O_TEXT in WIN32 */ +#include +#endif +#include "Yatom.h" +#include "YapHeap.h" +#include "yapio.h" +#include "eval.h" +#include "YapText.h" +#include +#if HAVE_STDARG_H +#include +#endif +#ifdef HAVE_UNISTD_H +#include +#endif +#if HAVE_CTYPE_H +#include +#endif +#if HAVE_WCTYPE_H +#include +#endif +#if HAVE_SYS_PARAM_H +#include +#endif +#if HAVE_SYS_TIME_H +#include +#endif +#if HAVE_SYS_TYPES_H +#include +#endif +#ifdef HAVE_SYS_STAT_H +#include +#endif +#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__) +#include +#endif +#if HAVE_STRING_H +#include +#endif +#if HAVE_SIGNAL_H +#include +#endif +#ifdef _WIN32 +#if HAVE_IO_H +/* Windows */ +#include +#endif +#endif +#if !HAVE_STRNCAT +#define strncat(X,Y,Z) strcat(X,Y) +#endif +#if !HAVE_STRNCPY +#define strncpy(X,Y,Z) strcpy(X,Y) +#endif +#if _MSC_VER || defined(__MINGW32__) +#if HAVE_SOCKET +#include +#endif +#include +#ifndef S_ISDIR +#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) +#endif +#endif +#include "iopreds.h" + +#if _MSC_VER || defined(__MINGW32__) +#define SYSTEM_STAT _stat +#else +#define SYSTEM_STAT stat +#endif + +static void CloseStream(int sno); + +FILE *Yap_GetInputStream(Term t, const char *msg) +{ + int sno = Yap_CheckStream (t, Input_Stream_f, msg); + + if(!(GLOBAL_Stream[sno].status & (Tty_Stream_f|Socket_Stream_f|Pipe_Stream_f))) + return GLOBAL_Stream[sno].file; + return NULL; +} + +FILE *Yap_GetOutputStream(Term t, const char *msg) +{ + int sno = Yap_CheckStream (t, Output_Stream_f, msg); + + if(!(GLOBAL_Stream[sno].status & (Tty_Stream_f|Socket_Stream_f))) + return GLOBAL_Stream[sno].file; + + return NULL; +} + +int +GetFreeStreamD(void) +{ + CACHE_REGS + int sno; + + for (sno = 0; sno < MaxStreams; ++sno) { + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Free_Stream_f) { + break; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + } + if (sno == MaxStreams) { + return -1; + } + GLOBAL_Stream[sno].encoding = LOCAL_encoding; + return sno; +} + +int +Yap_GetFreeStreamD(void) +{ + return GetFreeStreamD(); +} + +/* used from C-interface */ +int +Yap_GetFreeStreamDForReading(void) +{ + CACHE_REGS + int sno = GetFreeStreamD(); + StreamDesc *s; + + if (sno < 0) return sno; + s = GLOBAL_Stream+sno; + s->status |= User_Stream_f|Input_Stream_f; + s->charcount = 0; + s->linecount = 1; + s->linepos = 0; + s->stream_wgetc = get_wchar; + s->stream_wputc = put_wchar; + s->encoding = LOCAL_encoding; + if (GLOBAL_CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + UNLOCK(s->streamlock); + return sno; +} + + +static Int +p_stream_flags ( USES_REGS1 ) +{ /* '$stream_flags'(+N,-Flags) */ + Term trm; + trm = Deref (ARG1); + if (IsVarTerm (trm) || !IsIntTerm (trm)) + return (FALSE); + return (Yap_unify_constant (ARG2, MkIntTerm (GLOBAL_Stream[IntOfTerm (trm)].status))); +} + + + +static Int +p_check_stream (USES_REGS1) +{ /* '$check_stream'(Stream,Mode) */ + Term mode = Deref (ARG2); + int sno = Yap_CheckStream (ARG1, + AtomOfTerm (mode) == AtomRead ? Input_Stream_f : Output_Stream_f, + "check_stream/2"); + if (sno != -1) + UNLOCK(GLOBAL_Stream[sno].streamlock); + return sno != -1; +} + +static Int +p_check_if_stream (USES_REGS1) +{ /* '$check_stream'(Stream) */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f | Socket_Stream_f, "check_stream/1"); + if (sno != -1) + UNLOCK(GLOBAL_Stream[sno].streamlock); + return sno != -1; +} + + +static Int +is_input ( int sno USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + bool rc = GLOBAL_Stream[sno].status & Input_Stream_f; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return rc; +} + +static Int +is_output ( int sno USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + bool rc = GLOBAL_Stream[sno].status & (Output_Stream_f|Append_Stream_f); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return rc; +} + +static Int +has_bom ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f; + if (!IsVarTerm(t2) && !boolean(t2)) { + return FALSE; + } + if (rc) { + return Yap_unify_constant(t2,TermTrue); + } else { + return Yap_unify_constant(t2, TermFalse); + } +} +static Int +has_reposition ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f; + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !boolean(t2)) { + return FALSE; + } + if (rc) { + return Yap_unify_constant(t2,TermTrue); + } else { + return Yap_unify_constant(t2, TermFalse); + } +} + + char * + Yap_guessFileName(int f, int sno, char *nameb, size_t max) +{ +#if __linux__ + char path[256]; + if (snprintf(path, 255, "/proc/self/fd/~d",f) && + readlink( path, nameb, max) ) + return nameb; +#elif __APPLE__ + if (fcntl(f, F_GETPATH, nameb) != -1) + { + return nameb; + } +#elif __WIN32_ + FILE_NAME_INFO *fni = (FILE_NAME_INFO *)malloc(sizeof(FILE_NAME_INFO)+sizeof(WCHAR)*MAXPATHLEN); + HANDLE handle = (HANDLE)_get_osfhandle(f); + if (GetFileInformationByHandleEx(handle, FileNameInfo, &fni, max)) + { + int i; + char *ptr = nameb; + for(i=0; iFileNameLength; i++) + *ptr = _PL__utf8_put_char(ptr,fni->FileName[i]); + *ptr = '\0'; + return nameb; + } +#endif + return RepAtom(AtomOfTerm(StreamName(sno)))->StrOfAE; +} + + +static Int +representation_error ( int sno, Term t2 USES_REGS ) +{ + stream_flags_t flags = GLOBAL_Stream[sno].status & (RepError_Xml_f|RepError_Prolog_f); + /* '$representation_error'(+Stream,-ErrorMessage) */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && isatom(t2)) { + return false; + } + if (flags & RepError_Xml_f) { + return Yap_unify( t2, TermXml ); + } + if (flags & RepError_Prolog_f) { + return Yap_unify( t2, TermProlog ); + } + return Yap_unify( t2, TermError ); +} + +static Int +file_name ( int sno, Term t2 USES_REGS ) +{ + char s[MAXPATHLEN+1]; + int f = Yap_GetStreamFd(sno); + Term rc; + char *name = Yap_guessFileName(f, sno, s, MAXPATHLEN); + if (name) + rc = MkAtomTerm(Yap_LookupAtom(name)); + else + return false; + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !isatom(t2)) { + return FALSE; + } + return Yap_unify_constant(t2,rc); +} + +static Int +file_no ( int sno, Term t2 USES_REGS ) +{ + int f = Yap_GetStreamFd(sno); + Term rc = MkIntTerm(f) ; + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !IsIntTerm(t2)) { + return false; + } + return Yap_unify_constant(t2,rc); +} + +static bool +SetCloseOnAbort( int sno, bool close ) +{ + if (close) { + GLOBAL_Stream[sno].status |= DoNotCloseOnAbort_Stream_f; + } else { + GLOBAL_Stream[sno].status &= ~DoNotCloseOnAbort_Stream_f; + } + return true; +} + +static Int +has_close_on_abort ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + bool rc = GLOBAL_Stream[sno].status & DoNotCloseOnAbort_Stream_f; + if (!IsVarTerm(t2)) { + return t2 ==(rc ? TermTrue : TermFalse ) ; + } + if (rc) { + return Yap_unify_constant(t2,TermTrue); + } else { + return Yap_unify_constant(t2, TermFalse); + } +} + +static bool +has_encoding ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !(isatom(t2))) { + return FALSE; + } + if (0 && IsAtomTerm(t2)) { + encoding_t e = enc_id(RepAtom(AtomOfTerm(t2))->StrOfAE); + GLOBAL_Stream[sno].encoding = e; + return true; + } else { + const char *s = enc_name( LOCAL_encoding ); + return Yap_unify( t2, MkAtomTerm(Yap_LookupAtom( s ))); + } +} + + + +static bool +found_eof ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + stream_flags_t flags = GLOBAL_Stream[sno].status & (Past_Eof_Stream_f|Eof_Stream_f); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !(isatom(t2))) { + return FALSE; + } + if (flags & Past_Eof_Stream_f) + return Yap_unify( t2, MkAtomTerm(AtomPast)); + if (flags & Eof_Stream_f) + return Yap_unify( t2, MkAtomTerm(AtomAt)); + return Yap_unify( t2, MkAtomTerm(AtomNot)); +} + + +static bool +stream_mode ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + stream_flags_t flags = GLOBAL_Stream[sno].status & (Input_Stream_f|Output_Stream_f|Append_Stream_f); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !(isatom(t2))) { + return FALSE; + } + if (flags & Input_Stream_f) + return Yap_unify( t2, TermRead); + if (flags & Output_Stream_f) + return Yap_unify( t2, TermWrite); + if (flags & Append_Stream_f) + return Yap_unify( t2, TermAppend); + return false; +} + +static bool +stream_tty ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + stream_flags_t flags = GLOBAL_Stream[sno].status & (Tty_Stream_f); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !(isatom(t2))) { + return FALSE; + } + if (flags & Tty_Stream_f) + return Yap_unify( t2, TermTrue); + return Yap_unify( t2, TermFalse); +} + +static bool +stream_type ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + stream_flags_t flags = GLOBAL_Stream[sno].status & (Binary_Stream_f); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !(isatom(t2))) { + return FALSE; + } + if (flags & Binary_Stream_f) + return Yap_unify( t2, TermBinary); + return Yap_unify( t2, TermText); +} + +static bool +stream_position ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + Term tout = StreamPosition(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify (t2, tout); +} + +static bool +SetBuffering ( int sno, Atom at ) +{ /* '$set_bufferingt'(+Stream,-ErrorMessage) */ + if (at == AtomFull) { + if (setvbuf( GLOBAL_Stream[sno].file, NULL, _IOFBF, 0) < 0) + return PlIOError( SYSTEM_ERROR, Yap_MkStream( sno ), "could not set buffer"); + } else if (at == AtomLine) { + if (setvbuf( GLOBAL_Stream[sno].file, NULL, _IOLBF, 0) < 0) + return PlIOError( SYSTEM_ERROR, Yap_MkStream( sno ), "could not set line buffering"); + } else if (at == AtomFalse) { + if (setvbuf( GLOBAL_Stream[sno].file, NULL, _IONBF, 0) < 0) + return PlIOError( SYSTEM_ERROR, Yap_MkStream( sno ), "could not set disable buffering"); + } else { + LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; + LOCAL_ErrorMessage = "in set_stream/2:buffer"; + return false; + } + return true; +} + +static bool +SetBuffer ( int sno, Int sz ) +{ /* '$set_bufferingt'(+Stream,-ErrorMessage) */ + if (setvbuf( GLOBAL_Stream[sno].file, NULL, _IOFBF, sz) < 0) { + return PlIOError( SYSTEM_ERROR, Yap_MkStream( sno ), "could not set buffer"); + } + return true; +} + + + +static bool +eof_action ( int sno, Term t2 USES_REGS ) +{ /* '$set_output'(+Stream,-ErrorMessage) */ + stream_flags_t flags = GLOBAL_Stream[sno].status & (Eof_Error_Stream_f|Reset_Eof_Stream_f|Push_Eof_Stream_f); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (!IsVarTerm(t2) && !(isatom(t2))) { + return FALSE; + } + if (flags & Eof_Error_Stream_f) { + return Yap_unify( t2, TermError); + } + if (flags & Reset_Eof_Stream_f) { + return Yap_unify( t2, TermReset); + } + return Yap_unify( t2, TermEOfCode); + +} + +#define STREAM_PROPERTY_DEFS() \ + PAR( "alias", filler, STREAM_PROPERTY_ALIAS ), \ + PAR( "bom", filler, STREAM_PROPERTY_BOM ), \ + PAR( "close_on_abort", filler, STREAM_PROPERTY_CLOSE_ON_ABORT ), \ + PAR( "encoding", filler, STREAM_PROPERTY_ENCODING ), \ + PAR( "end_of_stream", filler, STREAM_PROPERTY_END_OF_STREAM ), \ + PAR( "eof_action", filler, STREAM_PROPERTY_EOF_ACTION ), \ + PAR( "file_name", filler, STREAM_PROPERTY_FILE_NAME), \ + PAR( "file_no", filler, STREAM_PROPERTY_FILE_NO), \ + PAR( "input", ok, STREAM_PROPERTY_INPUT ), \ + PAR( "mode", filler, STREAM_PROPERTY_MODE ), \ + PAR( "output", filler, STREAM_PROPERTY_OUTPUT ), \ + PAR( "position", isatom, STREAM_PROPERTY_POSITION ), \ + PAR( "reposition", filler, STREAM_PROPERTY_REPOSITION ), \ + PAR( "representation_errors", filler, STREAM_PROPERTY_REPRESENTATION_ERRORS ), \ + PAR( "type", filler, STREAM_PROPERTY_TYPE ), \ + PAR( "tty", filler, STREAM_PROPERTY_TTY ), \ + PAR( NULL, ok, STREAM_PROPERTY_END ) + +#define PAR(x,y,z) z + + typedef enum stream_property_enum_choices + { + STREAM_PROPERTY_DEFS() + } stream_property_choices_t; + +#undef PAR + +#define PAR(x,y,z) { x , y, z } + + + static const param_t stream_property_defs[] = + { + STREAM_PROPERTY_DEFS() + }; +#undef PAR + + + +static bool +do_stream_property (int sno, Term opts USES_REGS) +{ /* Init current_stream */ + xarg *args; + stream_property_choices_t i; + bool rc = true; + + + args = Yap_ArgListToVector ( opts, stream_property_defs, STREAM_PROPERTY_END ); + if (args == NULL) { + return false; + } + for (i=0; i < STREAM_PROPERTY_END; i ++) { + if (args[i].used) { + switch (i) { + case STREAM_PROPERTY_ALIAS: + rc = rc && + Yap_FetchStreamAlias ( sno, args[STREAM_PROPERTY_ALIAS].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_BOM: + rc = rc && + has_bom ( sno, args[STREAM_PROPERTY_BOM].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_CLOSE_ON_ABORT: + rc = rc && + has_close_on_abort ( sno, args[STREAM_PROPERTY_CLOSE_ON_ABORT].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_ENCODING: + rc = rc && + has_encoding ( sno, args[STREAM_PROPERTY_ENCODING].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_END_OF_STREAM: + rc = rc && + found_eof ( sno, args[STREAM_PROPERTY_END_OF_STREAM].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_EOF_ACTION: + rc = rc && + eof_action ( sno, args[STREAM_PROPERTY_EOF_ACTION].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_FILE_NAME: + rc = rc && + file_name ( sno, args[STREAM_PROPERTY_FILE_NAME].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_FILE_NO: + rc = rc && + file_no ( sno, args[STREAM_PROPERTY_FILE_NO].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_INPUT: + rc = rc && + is_input ( sno PASS_REGS); + break; + case STREAM_PROPERTY_MODE: + rc = rc && + stream_mode ( sno, args[STREAM_PROPERTY_MODE].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_OUTPUT: + rc = rc && + is_output ( sno PASS_REGS); + break; + case STREAM_PROPERTY_POSITION: + rc = rc && + stream_position ( sno, args[STREAM_PROPERTY_MODE].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_REPOSITION: + rc = rc && + has_reposition ( sno, args[STREAM_PROPERTY_MODE].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_REPRESENTATION_ERRORS: + rc = rc && + representation_error ( sno, args[STREAM_PROPERTY_REPRESENTATION_ERRORS].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_TYPE: + rc = rc && + stream_type ( sno, args[STREAM_PROPERTY_TYPE].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_TTY: + rc = rc && + stream_tty ( sno, args[STREAM_PROPERTY_TTY].tvalue PASS_REGS); + break; + case STREAM_PROPERTY_END: + rc = false; + break; + } + } + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + return rc; +} + +static Int +cont_stream_property (USES_REGS1) +{ /* current_stream */ + int i = IntOfTerm (EXTRA_CBACK_ARG (2, 1)), i0; + LOCK(GLOBAL_Stream[i].streamlock); + i0=i; + while (i < MaxStreams) { + if (GLOBAL_Stream[i].status & Free_Stream_f) { + ++i; + continue; + } + if (i != i0) { + LOCK(GLOBAL_Stream[i].streamlock); + UNLOCK(GLOBAL_Stream[i0].streamlock); + } + ++i; + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (i); + if (i == MaxStreams) + do_cut( true ); + Yap_unify(ARG1, Yap_MkStream(i-1)); + return do_stream_property(i-1, Deref(ARG2) PASS_REGS); + } + UNLOCK(GLOBAL_Stream[i0].streamlock); + cut_fail(); +} + +static Int +stream_property (USES_REGS1) +{ /* Init current_stream */ + Term t1 = Deref(ARG1); + /* make valgrind happy by always filling in memory */ + EXTRA_CBACK_ARG (2, 1) = MkIntTerm (0); + if (!IsVarTerm(t1)) { + Int i; + i = Yap_CheckStream (t1, Input_Stream_f|Output_Stream_f|Append_Stream_f, "current_stream/3"); + do_cut(0); + if (i < 0) + return false; + return do_stream_property( i, Deref(ARG2) PASS_REGS); + } else { + return (cont_stream_property (PASS_REGS1)); + } +} + +#define SET_STREAM_DEFS() \ + PAR( "alias", isatom, SET_STREAM_ALIAS ), \ + PAR( "buffer", boolean, SET_STREAM_BUFFER ), \ + PAR( "buffer_size", nat, SET_STREAM_BUFFER_SIZE ), \ + PAR( "close_on_abort", boolean, SET_STREAM_CLOSE_ON_ABORT ), \ + PAR( "encoding", isatom, SET_STREAM_ENCODING ), \ + PAR( "eof_action", isatom, SET_STREAM_EOF_ACTION ), \ + PAR( "file_name", isatom, SET_STREAM_FILE_NAME), \ + PAR( "line_position", nat, SET_STREAM_LINE_POSITION ), \ + PAR( "newline", filler, SET_STREAM_NEWLINE), \ + PAR( "record_position", isatom, SET_STREAM_RECORD_POSITION ), \ + PAR( "representation_errors", isatom, SET_STREAM_REPRESENTATION_ERRORS ), \ + PAR( "type", isatom, SET_STREAM_TYPE ), \ + PAR( "tty", filler, SET_STREAM_TTY ), \ + PAR( NULL, ok, SET_STREAM_END ) + +#define PAR(x,y,z) z + + typedef enum set_stream_enum_choices + { + SET_STREAM_DEFS() + } set_stream_enum_choices_t; + +#undef PAR + +#define PAR(x,y,z) { x , y, z } + + + static const param_t set_stream_defs[] = + { + SET_STREAM_DEFS() + }; +#undef PAR + + + +static bool +do_set_stream (int sno, Term opts USES_REGS) +{ /* Init current_stream */ + xarg *args; + set_stream_enum_choices_t i; + bool rc = true; + + + args = Yap_ArgListToVector ( opts, set_stream_defs, SET_STREAM_END ); + if (args == NULL) { + return false; + } + for (i=0; i < SET_STREAM_END; i ++) { + if (args[i].used) { + Term t = args[i].tvalue; + switch (i) { + case SET_STREAM_ALIAS: + rc = rc && + Yap_AddAlias ( AtomOfTerm(t), sno ); + break; + case SET_STREAM_BUFFER: + rc = rc && + SetBuffering ( sno, AtomOfTerm(t) ); + break; + case SET_STREAM_BUFFER_SIZE: + rc = rc && + SetBuffer ( sno, IntegerOfTerm(t) ); + break; + case SET_STREAM_CLOSE_ON_ABORT: + rc = rc && + SetCloseOnAbort ( sno, (args[SET_STREAM_CLOSE_ON_ABORT].tvalue == TermTrue) PASS_REGS); + break; + case SET_STREAM_ENCODING: + GLOBAL_Stream[sno]. encoding = enc_id(AtomOfTerm(args[SET_STREAM_ENCODING].tvalue)->StrOfAE); + has_encoding ( sno, args[SET_STREAM_ENCODING].tvalue PASS_REGS); + break; + case SET_STREAM_EOF_ACTION: + { + Term t2 = args[SET_STREAM_EOF_ACTION].tvalue; + if (t2 == TermError) { + GLOBAL_Stream[sno].status |= Eof_Error_Stream_f; + GLOBAL_Stream[sno].status &= ~Reset_Eof_Stream_f; + } else if (t2 == TermReset) {GLOBAL_Stream[sno].status |= + GLOBAL_Stream[sno].status &= ~Eof_Error_Stream_f; + GLOBAL_Stream[sno].status |= Reset_Eof_Stream_f; + } else if (t2 == TermEOfCode) { + GLOBAL_Stream[sno].status &= ~Eof_Error_Stream_f; + GLOBAL_Stream[sno].status &= ~Reset_Eof_Stream_f; + } else { + LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; + LOCAL_ErrorMessage = "in set_stream/2:eof_action"; + return false; + } + break; + case SET_STREAM_FILE_NAME: + GLOBAL_Stream[sno].user_name = args[SET_STREAM_FILE_NAME].tvalue; + break; + case SET_STREAM_LINE_POSITION: + GLOBAL_Stream[sno].linepos = IntegerOfTerm(args[SET_STREAM_FILE_NAME].tvalue); + break; + case SET_STREAM_NEWLINE: + printf("not yet\n"); + break; + case SET_STREAM_RECORD_POSITION: + if (args[SET_STREAM_RECORD_POSITION].tvalue == TermTrue) + GLOBAL_Stream[sno].status |= Seekable_Stream_f; + else + GLOBAL_Stream[sno].status &= ~Seekable_Stream_f; + break; + case SET_STREAM_REPRESENTATION_ERRORS: + { + Term t2 = args[SET_STREAM_EOF_ACTION].tvalue; + if (t2 == TermXml) { + GLOBAL_Stream[sno].status |= RepError_Xml_f; + GLOBAL_Stream[sno].status &= ~RepError_Prolog_f; + } else if (t2 == TermError) {GLOBAL_Stream[sno].status |= + GLOBAL_Stream[sno].status &= ~RepError_Xml_f; + GLOBAL_Stream[sno].status |= RepError_Prolog_f; + } else if (t2 == TermEOfCode) { + GLOBAL_Stream[sno].status &= ~RepError_Xml_f; + GLOBAL_Stream[sno].status |= RepError_Prolog_f; + } else { + LOCAL_Error_TYPE = DOMAIN_ERROR_OUT_OF_RANGE; + LOCAL_ErrorMessage = "in set_stream/2:eof_action"; + return false; + } + } + break; + case SET_STREAM_TYPE: + rc &= + stream_type ( sno, args[SET_STREAM_TYPE].tvalue PASS_REGS); + break; + case SET_STREAM_TTY: + rc &= + stream_tty ( sno, args[SET_STREAM_TTY].tvalue PASS_REGS); + break; + case SET_STREAM_END: + rc = false; + break; + } + } + } + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + return rc; +} + +static Int +set_stream (USES_REGS1) +{ /* Init current_stream */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "set_stream_position/2"); + if (sno < 0) { + return (FALSE); + } + return do_set_stream( sno, Deref(ARG2) PASS_REGS); +} + + +/* + * Called when you want to close all open streams, except for stdin, stdout + * and stderr + */ +void +Yap_CloseStreams (int loud) +{ + CACHE_REGS + int sno; + for (sno = 3; sno < MaxStreams; ++sno) { + if (GLOBAL_Stream[sno].status & Free_Stream_f) + continue; + if ((GLOBAL_Stream[sno].status & Popen_Stream_f)) + pclose (GLOBAL_Stream[sno].file); +#if _MSC_VER || defined(__MINGW32__) + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) + CloseHandle (GLOBAL_Stream[sno].u.pipe.hdl); +#else + if (GLOBAL_Stream[sno].status & (Pipe_Stream_f|Socket_Stream_f)) + close (GLOBAL_Stream[sno].u.pipe.fd); +#endif + else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) { + Yap_CloseSocket(GLOBAL_Stream[sno].u.socket.fd, + GLOBAL_Stream[sno].u.socket.flags, + GLOBAL_Stream[sno].u.socket.domain); + } + else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { + if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) { + Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); + } else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { + free(GLOBAL_Stream[sno].u.mem_string.buf); + } + } else if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) { + fclose (GLOBAL_Stream[sno].file); + } else { + if (loud) + fprintf (Yap_stderr, "%% YAP Error: while closing stream: %s\n", RepAtom (GLOBAL_Stream[sno].name)->StrOfAE); + } + if (LOCAL_c_input_stream == sno) { + LOCAL_c_input_stream = StdInStream; + } else if (LOCAL_c_output_stream == sno) { + LOCAL_c_output_stream = StdOutStream; + } + GLOBAL_Stream[sno].status = Free_Stream_f; + } +} + + +static void +CloseStream(int sno) +{ + CACHE_REGS + if (!(GLOBAL_Stream[sno].status & (Null_Stream_f|Socket_Stream_f|InMemory_Stream_f|Pipe_Stream_f))) + fclose (GLOBAL_Stream[sno].file); +#if HAVE_SOCKET + else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) { + Yap_CloseSocket(GLOBAL_Stream[sno].u.socket.fd, + GLOBAL_Stream[sno].u.socket.flags, + GLOBAL_Stream[sno].u.socket.domain); + } +#endif + else if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { +#if _MSC_VER || defined(__MINGW32__) + CloseHandle (GLOBAL_Stream[sno].u.pipe.hdl); +#else + close(GLOBAL_Stream[sno].u.pipe.fd); +#endif + } + else if (GLOBAL_Stream[sno].status & (InMemory_Stream_f)) { + if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) + Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf); + else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) { + free(GLOBAL_Stream[sno].u.mem_string.buf); + } + } + GLOBAL_Stream[sno].status = Free_Stream_f; + Yap_DeleteAliases(sno); + if (LOCAL_c_input_stream == sno) + { + LOCAL_c_input_stream = StdInStream; + } + else if (LOCAL_c_output_stream == sno) + { + LOCAL_c_output_stream = StdOutStream; + } + else if (LOCAL_c_error_stream == sno) + { + LOCAL_c_error_stream = StdErrStream; + } + /* if (st->status == Socket_Stream_f|Input_Stream_f|Output_Stream_f) { + Yap_CloseSocket(); + } + */ +} + +void +Yap_CloseStream(int sno) +{ + CloseStream(sno); +} + + +void +Yap_ReleaseStream(int sno) +{ + CACHE_REGS + GLOBAL_Stream[sno].status = Free_Stream_f; + Yap_DeleteAliases(sno); + if (LOCAL_c_input_stream == sno) + { + LOCAL_c_input_stream = StdInStream; + } + else if (LOCAL_c_output_stream == sno) + { + LOCAL_c_output_stream = StdOutStream; + } + else if (LOCAL_c_error_stream == sno) + { + LOCAL_c_error_stream = StdErrStream; + } + /* if (st->status == Socket_Stream_f|Input_Stream_f|Output_Stream_f) { + Yap_CloseSocket(); + } + */ +} + + +static Int +current_input ( USES_REGS1 ) +{ /* current_input(?Stream) */ + Term t1 = Deref(ARG1); + if (IsVarTerm(t1)) { + Term t = Yap_MkStream (LOCAL_c_input_stream); + YapBind(VarOfTerm(t1), t); + return TRUE; + } else if (!IsApplTerm(t1) || + FunctorOfTerm(t1) != FunctorStream || + !IsIntTerm((t1=ArgOfTerm(1,t1)))) { + Yap_Error(DOMAIN_ERROR_STREAM,t1,"current_input/1"); + return FALSE; + } else { + return LOCAL_c_input_stream == IntOfTerm(t1); + } +} + +/** @pred set_input(+ _S_) is iso + * Set stream _S_ as the current input stream. Predicates like read/1 + * and get/1 will start using stream _S_ by default. + * + * + * @param Input-mode stream + * + */ +static Int +set_input ( USES_REGS1 ) +{ /* '$show_stream_position'(+Stream,Pos) */ + int sno = + Yap_CheckStream (ARG1, Input_Stream_f, "set_input/1"); + if (sno < 0) + return false; + LOCAL_c_input_stream = sno; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return true; +} + +static Int +current_output ( USES_REGS1 ) +{ /* current_output(?Stream) */ + Term t1 = Deref(ARG1); + if (IsVarTerm(t1)) { + Term t = Yap_MkStream (LOCAL_c_output_stream); + YapBind(VarOfTerm(t1), t); + return TRUE; + } else if (!IsApplTerm(t1) || + FunctorOfTerm(t1) != FunctorStream || + !IsIntTerm((t1=ArgOfTerm(1,t1)))) { + Yap_Error(DOMAIN_ERROR_STREAM,t1,"current_output/1"); + return FALSE; + } else { + return(LOCAL_c_output_stream == IntOfTerm(t1)); + } +} + +/** @pred set_input(+ _S_) is iso + * Set stream _S_ as the current input stream. Predicates like read/1 + * and get/1 will start using stream _S_ by default. + * + * + * @param Output-mode stream + * + */ +static Int +set_output ( USES_REGS1 ) +{ /* '$show_stream_position'(+Stream,Pos) */ + int sno = + Yap_CheckStream (ARG1, Output_Stream_f | Append_Stream_f, "set_output/2"); + if (sno < 0) + return false; + LOCAL_c_output_stream = sno; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return true; +} + +static Int +p_user_file_name ( USES_REGS1 ) +{ + Term tout; + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"user_file_name/2"); + if (sno < 0) + return (FALSE); +#if HAVE_SOCKET + if (GLOBAL_Stream[sno].status & Socket_Stream_f) + tout = MkAtomTerm(AtomSocket); + else +#endif + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) + tout = MkAtomTerm(AtomPipe); + else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) + tout = MkAtomTerm(AtomCharsio); + else + tout = GLOBAL_Stream[sno].user_name; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, tout)); +} + +static Int +p_file_name ( USES_REGS1 ) +{ + Term tout; + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"file_name/2"); + if (sno < 0) + return (FALSE); +#if HAVE_SOCKET + if (GLOBAL_Stream[sno].status & Socket_Stream_f) + tout = MkAtomTerm(AtomSocket); + else +#endif + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) + tout = MkAtomTerm(AtomPipe); + else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) + tout = MkAtomTerm(AtomCharsio); + else + tout = MkAtomTerm(GLOBAL_Stream[sno].name); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify_constant (ARG2, tout); +} + +static Int +p_cur_line_no ( USES_REGS1 ) +{ /* '$current_line_number'(+Stream,-N) */ + Term tout; + int sno = + Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f,"current_line_number/2"); + if (sno < 0) + return (FALSE); + /* one has to be somewhat more careful because of terminals */ + if (GLOBAL_Stream[sno].status & Tty_Stream_f) + { + Int no = 1; + int i; + Atom my_stream; +#if HAVE_SOCKET + if (GLOBAL_Stream[sno].status & Socket_Stream_f) + my_stream = AtomSocket; + else +#endif + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) + my_stream = AtomPipe; + else + if (GLOBAL_Stream[sno].status & InMemory_Stream_f) + my_stream = AtomCharsio; + else + my_stream = GLOBAL_Stream[sno].name; + for (i = 0; i < MaxStreams; i++) + { + if (!(GLOBAL_Stream[i].status & (Free_Stream_f|Socket_Stream_f|Pipe_Stream_f|InMemory_Stream_f)) && + GLOBAL_Stream[i].name == my_stream) + no += GLOBAL_Stream[i].linecount - 1; + } + tout = MkIntTerm (no); + } + else + tout = MkIntTerm (GLOBAL_Stream[sno].linecount); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, tout)); +} + +static Int +p_line_position ( USES_REGS1 ) +{ /* '$line_position'(+Stream,-N) */ + Term tout; + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "line_position/2"); + if (sno < 0) + return (FALSE); + if (GLOBAL_Stream[sno].status & Tty_Stream_f) + { + Int no = 0; + int i; + Atom my_stream = GLOBAL_Stream[sno].name; + for (i = 0; i < MaxStreams; i++) + { + if (!(GLOBAL_Stream[i].status & Free_Stream_f) && + GLOBAL_Stream[i].name == my_stream) + no += GLOBAL_Stream[i].linepos; + } + tout = MkIntTerm (no); + } + else + tout = MkIntTerm (GLOBAL_Stream[sno].linepos); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, tout)); +} + +static Int +p_character_count ( USES_REGS1 ) +{ /* '$character_count'(+Stream,-N) */ + Term tout; + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "character_count/2"); + if (sno < 0) + return (FALSE); + if (GLOBAL_Stream[sno].status & Tty_Stream_f) + { + Int no = 0; + int i; + Atom my_stream = GLOBAL_Stream[sno].name; + for (i = 0; i < MaxStreams; i++) + { + if (!(GLOBAL_Stream[i].status & Free_Stream_f) && + GLOBAL_Stream[i].name == my_stream) + no += GLOBAL_Stream[i].charcount; + } + tout = MkIntTerm (no); + } + else if (GLOBAL_Stream[sno].status & Null_Stream_f) + tout = MkIntTerm (GLOBAL_Stream[sno].charcount); + else + tout = MkIntTerm (ftell (GLOBAL_Stream[sno].file)); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, tout)); +} + +static Int +p_show_stream_flags( USES_REGS1 ) +{ /* '$show_stream_flags'(+Stream,Pos) */ + Term tout; + int sno = + Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "stream_property/2"); + if (sno < 0) + return (FALSE); + tout = MkIntTerm(GLOBAL_Stream[sno].status); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify (ARG2, tout)); +} + + +Term +Yap_StreamPosition(int sno) +{ + return StreamPosition(sno); +} + +static Int +p_show_stream_position ( USES_REGS1 ) +{ /* '$show_stream_position'(+Stream,Pos) */ + Term tout; + int sno = + Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "stream_position/2"); + if (sno < 0) + return (FALSE); + tout = StreamPosition(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify (ARG2, tout); +} + + +static Int +set_stream_position ( USES_REGS1 ) +{ /* '$set_stream_position'(+Stream,Pos) */ + Term tin, tp; + Int char_pos; + int sno = Yap_CheckStream (ARG1, Input_Stream_f | Output_Stream_f | Append_Stream_f, "set_stream_position/2"); + if (sno < 0) { + return (FALSE); + } + tin = Deref (ARG2); + if (IsVarTerm (tin)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(INSTANTIATION_ERROR, tin, "set_stream_position/2"); + return (FALSE); + } else if (!(IsApplTerm (tin))) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(DOMAIN_ERROR_STREAM_POSITION, tin, "set_stream_position/2"); + return (FALSE); + } + if (FunctorOfTerm (tin) == FunctorStreamPos) { + if (IsVarTerm (tp = ArgOfTerm (1, tin))) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(INSTANTIATION_ERROR, tp, "set_stream_position/2"); + return (FALSE); + } else if (!IsIntTerm (tp)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(DOMAIN_ERROR_STREAM_POSITION, tin, "set_stream_position/2"); + return (FALSE); + } + if (!(GLOBAL_Stream[sno].status & Seekable_Stream_f) ) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_REPOSITION_STREAM, ARG1,"set_stream_position/2"); + return(FALSE); + } + char_pos = IntOfTerm (tp); + if (IsVarTerm (tp = ArgOfTerm (2, tin))) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(INSTANTIATION_ERROR, tp, "set_stream_position/2"); + return (FALSE); + } else if (!IsIntTerm (tp)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(DOMAIN_ERROR_STREAM_POSITION, tin, "set_stream_position/2"); + return (FALSE); + } + GLOBAL_Stream[sno].charcount = char_pos; + GLOBAL_Stream[sno].linecount = IntOfTerm (tp); + if (IsVarTerm (tp = ArgOfTerm (3, tin))) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(INSTANTIATION_ERROR, tp, "set_stream_position/2"); + return (FALSE); + } else if (!IsIntTerm (tp)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(DOMAIN_ERROR_STREAM_POSITION, tin, "set_stream_position/2"); + return (FALSE); + } + GLOBAL_Stream[sno].linepos = IntOfTerm (tp); + if (fseek (GLOBAL_Stream[sno].file, (long) (char_pos), 0) == -1) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(SYSTEM_ERROR, tp, + "fseek failed for set_stream_position/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_getc = PlGetc; + GLOBAL_Stream[sno].stream_gets = PlGetsFunc(); + } else if (FunctorOfTerm (tin) == FunctorStreamEOS) { + if (IsVarTerm (tp = ArgOfTerm (1, tin))) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(INSTANTIATION_ERROR, tp, "set_stream_position/2"); + return (FALSE); + } else if (tp != MkAtomTerm(AtomAt)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(DOMAIN_ERROR_STREAM_POSITION, tin, "set_stream_position/2"); + return (FALSE); + } + if (!(GLOBAL_Stream[sno].status & Seekable_Stream_f) ) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_REPOSITION_STREAM, ARG1,"set_stream_position/2"); + return(FALSE); + } + if (fseek (GLOBAL_Stream[sno].file, 0L, SEEK_END) == -1) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(SYSTEM_ERROR, tp, + "fseek failed for set_stream_position/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_getc = PlGetc; + GLOBAL_Stream[sno].stream_gets = PlGetsFunc(); + /* reset the counters */ + GLOBAL_Stream[sno].linepos = 0; + GLOBAL_Stream[sno].linecount = 1; + GLOBAL_Stream[sno].charcount = 0; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + + +#if HAVE_SELECT +/* stream_select(+Streams,+TimeOut,-Result) */ +static Int +p_stream_select( USES_REGS1 ) +{ + Term t1 = Deref(ARG1), t2; + fd_set readfds, writefds, exceptfds; + struct timeval timeout, *ptime; + +#if _MSC_VER + u_int fdmax=0; +#else + int fdmax=0; +#endif + Term tout = TermNil, ti, Head; + + if (IsVarTerm(t1)) { + Yap_Error(INSTANTIATION_ERROR,t1,"stream_select/3"); + return FALSE; + } + if (!IsPairTerm(t1)) { + Yap_Error(TYPE_ERROR_LIST,t1,"stream_select/3"); + return(FALSE); + } + FD_ZERO(&readfds); + FD_ZERO(&writefds); + FD_ZERO(&exceptfds); + ti = t1; + while (ti != TermNil) { +#if _MSC_VER + u_int fd; +#else + int fd; +#endif + int sno; + + Head = HeadOfTerm(ti); + sno = Yap_CheckStream(Head, Input_Stream_f, "stream_select/3"); + if (sno < 0) + return(FALSE); + fd = GetStreamFd(sno); + FD_SET(fd, &readfds); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (fd > fdmax) + fdmax = fd; + ti = TailOfTerm(ti); + } + t2 = Deref(ARG2); + if (IsVarTerm(t2)) { + Yap_Error(INSTANTIATION_ERROR,t2,"stream_select/3"); + return(FALSE); + } + if (IsAtomTerm(t2)) { + if (t2 == MkAtomTerm(AtomOff)) { + /* wait indefinitely */ + ptime = NULL; + } else { + Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t1,"stream_select/3"); + return(FALSE); + } + } else { + Term t21, t22; + + if (!IsApplTerm(t2) || FunctorOfTerm(t2) != FunctorModule) { + Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3"); + return(FALSE); + } + t21 = ArgOfTerm(1, t2); + if (IsVarTerm(t21)) { + Yap_Error(INSTANTIATION_ERROR,t2,"stream_select/3"); + return(FALSE); + } + if (!IsIntegerTerm(t21)) { + Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3"); + return(FALSE); + } + timeout.tv_sec = IntegerOfTerm(t21); + if (timeout.tv_sec < 0) { + Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3"); + return(FALSE); + } + t22 = ArgOfTerm(2, t2); + if (IsVarTerm(t22)) { + Yap_Error(INSTANTIATION_ERROR,t2,"stream_select/3"); + return(FALSE); + } + if (!IsIntegerTerm(t22)) { + Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3"); + return(FALSE); + } + timeout.tv_usec = IntegerOfTerm(t22); + if (timeout.tv_usec < 0) { + Yap_Error(DOMAIN_ERROR_TIMEOUT_SPEC,t2,"stream_select/3"); + return(FALSE); + } + ptime = &timeout; + } + /* do the real work */ + if (select(fdmax+1, &readfds, &writefds, &exceptfds, ptime) < 0) { +#if HAVE_STRERROR + Yap_Error(SYSTEM_ERROR, TermNil, + "stream_select/3 (select: %s)", strerror(errno)); +#else + Yap_Error(SYSTEM_ERROR, TermNil, + "stream_select/3 (select)"); +#endif + } + while (t1 != TermNil) { + int fd; + int sno; + + Head = HeadOfTerm(t1); + sno = Yap_CheckStream(Head, Input_Stream_f, "stream_select/3"); + fd = GetStreamFd(sno); + if (FD_ISSET(fd, &readfds)) + tout = MkPairTerm(Head,tout); + else + tout = MkPairTerm(TermNil,tout); + UNLOCK(GLOBAL_Stream[sno].streamlock); + t1 = TailOfTerm(t1); + } + /* we're done, just pass the info back */ + return(Yap_unify(ARG3,tout)); + +} +#endif + + +Int +Yap_StreamToFileNo(Term t) +{ + int sno = + Yap_CheckStream(t, (Input_Stream_f|Output_Stream_f), "StreamToFileNo"); + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); +#if _MSC_VER || defined(__MINGW32__) + return((Int)(GLOBAL_Stream[sno].u.pipe.hdl)); +#else + return(GLOBAL_Stream[sno].u.pipe.fd); +#endif +#if HAVE_SOCKET + } else if (GLOBAL_Stream[sno].status & Socket_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return(GLOBAL_Stream[sno].u.socket.fd); +#endif + } else if (GLOBAL_Stream[sno].status & (Null_Stream_f|InMemory_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return(-1); + } else { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return(fileno(GLOBAL_Stream[sno].file)); + } +} + +static Int +p_stream( USES_REGS1 ) +{ + Term in = Deref(ARG1); + if (IsVarTerm(in)) + return(FALSE); + if (IsAtomTerm(in)) + return(Yap_CheckAlias(AtomOfTerm(in)) >= 0); + if (IsApplTerm(in)) + return(FunctorOfTerm(in) == FunctorStream); + return(FALSE); +} + + +FILE * +Yap_FileDescriptorFromStream(Term t) +{ + int sno = Yap_CheckStream (t, Input_Stream_f|Output_Stream_f, "FileDescriptorFromStream"); + if (sno < 0) + return NULL; + if (GLOBAL_Stream[sno].status & (Null_Stream_f| + InMemory_Stream_f| + Socket_Stream_f| + Pipe_Stream_f| + Free_Stream_f)) + return NULL; + return GLOBAL_Stream[sno].file; +} + +void + +Yap_InitBackIO (void) +{ + Yap_InitCPredBack ("stream_property", 2, 1, stream_property, cont_stream_property, SafePredFlag|SyncPredFlag); +} + + +void +Yap_InitIOStreams(void) +{ + Yap_InitCPred ("$stream_flags", 2, p_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$check_stream", 2, p_check_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$check_stream", 1, p_check_if_stream, SafePredFlag|SyncPredFlag|HiddenPredFlag|HiddenPredFlag); + Yap_InitCPred ("$current_line_number", 2, p_cur_line_no, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$line_position", 2, p_line_position, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$character_count", 2, p_character_count, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$show_stream_flags", 2, p_show_stream_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("$user_file_name", 2, p_user_file_name, SafePredFlag|SyncPredFlag), + Yap_InitCPred ("$file_name", 2, p_file_name, SafePredFlag|SyncPredFlag), + Yap_InitCPred ("current_input", 1, current_input, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("current_output", 1, current_output, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("set_input", 1, set_input, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("set_output", 1, set_output, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$stream", 1, p_stream, SafePredFlag|TestPredFlag); + Yap_InitCPred ("$stream", 1, p_stream, SafePredFlag|TestPredFlag); +#if HAVE_SELECT + Yap_InitCPred ("stream_select", 3, p_stream_select, SafePredFlag|SyncPredFlag); +#endif + Yap_InitCPred ("$show_stream_position", 2, p_show_stream_position, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("set_stream_position", 2, set_stream_position, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("set_stream", 2, set_stream, SafePredFlag|SyncPredFlag); + }