diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
497cc27003
yap-6.3/os/iopreds.c

1838 lines
43 KiB
C
Raw Normal View History

g;ue
2015-06-18 01:39:03 +01:00
/*************************************************************************
* *
* 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 <stdlib.h>
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#if HAVE_CTYPE_H
#include <ctype.h>
#endif
#if HAVE_WCTYPE_H
#include <wctype.h>
#endif
#if HAVE_SYS_TIME_H
#include <sys/time.h>
#endif
#if HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#include <sys/stat.h>
#endif
#if HAVE_SYS_SELECT_H && !_MSC_VER && !defined(__MINGW32__)
#include <sys/select.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STRING_H
#include <string.h>
#endif
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
#if HAVE_FCNTL_H
/* for O_BINARY and O_TEXT in WIN32 */
#include <fcntl.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#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 <winsock2.h>
#endif
#include <windows.h>
#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();
}
Reference in New Issue Copy Permalink