/************************************************************************* * * * 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" static int get_wchar( int); static int get_wchar_from_file( int); FILE *Yap_stdin; FILE *Yap_stdout; FILE *Yap_stderr; static bool issolutions( Term t) { if (t == TermFirst || t == TermAll ) return true; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "solutions in {first, all}."); return false; } if (IsAtomTerm(t)) { Yap_Error(DOMAIN_ERROR_SOLUTIONS, t, "solutions in {first, all}"); return false; } Yap_Error(TYPE_ERROR_ATOM, t, "solutions in {first, all}}"); return false; } static bool is_file_type( Term t) { if (t == TermTxt || t == TermProlog || t == TermSource|| t == TermExecutable|| t == TermQly|| t == TermDirectory ) return true; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "file_type in {txt,prolog,exe,directory...}"); return false; } if (IsAtomTerm(t)) { Yap_Error(DOMAIN_ERROR_FILE_TYPE, t, "file_type in {txt,prolog,exe,directory...}"); return false; } Yap_Error(TYPE_ERROR_ATOM, t, "file_type in {txt,prolog,exe,directory...}"); return false; } static bool is_file_errors( Term t) { if (t == TermFail || t == TermError ) return true; if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, t, "file_error in {fail,error}."); return false; } if (IsAtomTerm(t)) { Yap_Error(DOMAIN_ERROR_FILE_ERRORS, t, "file_error in {fail,error}."); return false; } Yap_Error(TYPE_ERROR_ATOM, t, "file_error in {fail,error}."); return false; } void Yap_DefaultStreamOps( StreamDesc * st) { st->stream_wputc = put_wchar; if (!(st->status & (Tty_Stream_f|Reset_Eof_Stream_f|Promptable_Stream_f))) st->stream_wgetc = get_wchar_from_file; else st->stream_wgetc = get_wchar; if (GLOBAL_CharConversionTable != NULL) st->stream_wgetc_for_read = ISOWGetc; else st->stream_wgetc_for_read = st->stream_wgetc; if (st->encoding == ENC_ISO_UTF8) st->stream_getc_for_utf8 = st->stream_getc; else st->stream_getc_for_utf8 = GetUTF8; } 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 */ if (!s->file) { s->name = AtomNil; return; } 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_wgetc = get_wchar_from_file; } } s->stream_wputc = put_wchar; s->stream_wgetc = get_wchar; } static void InitStdStream (int sno, SMALLUNSGN flags, FILE * file) { StreamDesc *s = &GLOBAL_Stream[sno]; s->file = file; s->status = flags; s->linepos = 0; s->linecount = 1; s->charcount = 0.; s->encoding = ENC_ISO_UTF8; 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); Yap_DefaultStreamOps( s ); #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 */ } Term Yap_StreamUserName(int sno) { Term atname; StreamDesc *s = &GLOBAL_Stream[sno]; if (s->user_name != 0L) { return (s->user_name); } if ((atname = StreamName(sno))) return atname; return TermNil; } 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__ (const char *file, const char *function, int lineno, yap_error_number type, Term culprit, ...) { if (trueLocalPrologFlag(FILEERRORS_FLAG)|| type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) { va_list args; const char *format; char who[1024]; va_start(args, culprit); format = va_arg(args, char *); if (format) { vsnprintf(who, 1023, format, args); } else { who[0] ='\0'; } va_end( args ); Yap_Error__(file, function, lineno, type, culprit, who); /* 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_DebugErrorPuts(const char *s) { Yap_DebugPuts (stderr, s); } void Yap_DebugPlWrite(Term t) { if (t != 0) Yap_plwrite(t,GLOBAL_Stream+2, 0, 0, 1200); } void Yap_DebugPlWriteln(Term t) Yap_DebugErrorPutc(int c) { Yap_DebugPutc (stderr, c); } void Yap_DebugWriteIndicator( PredEntry *ap ) { CACHE_REGS Term tmod = ap->ModuleOfPred; if (!tmod) tmod = TermProlog; #if THREADS Yap_DebugPlWrite(MkIntegerTerm(worker_id)); Yap_DebugPutc(stderr,' '); #endif Yap_DebugPutc(stderr,'>'); Yap_DebugPutc(stderr,'\t'); Yap_DebugPlWrite(tmod); Yap_DebugPutc(stderr,':'); if (ap->ModuleOfPred == IDB_MODULE) { Term t = Deref(ARG1); if (IsAtomTerm(t)) { Yap_DebugPlWrite(t); } else if (IsIntegerTerm(t)) { Yap_DebugPlWrite(t); } else { Functor f = FunctorOfTerm(t); Atom At = NameOfFunctor(f); Yap_DebugPlWrite(MkAtomTerm(At)); Yap_DebugPutc(stderr,'/'); Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f))); } } else { if (ap->ArityOfPE == 0) { Atom At = (Atom)ap->FunctorOfPred; Yap_DebugPlWrite(MkAtomTerm(At)); } else { Functor f = ap->FunctorOfPred; Atom At = NameOfFunctor(f); Yap_DebugPlWrite(MkAtomTerm(At)); Yap_DebugPutc(stderr,'/'); Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f))); } } Yap_DebugPutc(stderr,'\n'); } #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; Yap_DefaultStreamOps( s ); s->stream_gets = PlGetsFunc(); } /* 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 EOFWGetc(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)) { s->stream_wgetc = get_wchar; return(s->stream_wgetc(sno)); } return 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)) { s->stream_getc = PlGetc; 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->stream_getc = EOFGetc; 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; return EOFCHAR; } int post_process_weof(StreamDesc *s) { s->status |= Eof_Stream_f; s->stream_wgetc = EOFWGetc; 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. It assumes codification in 8 bits. */ 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; } int GetUTF8 (int sno) { StreamDesc *s = &GLOBAL_Stream[sno]; uint64_t bufi = s->utf8_buf; unsigned char *buf = (unsigned char *)&bufi; if (!bufi) { int32_t ch = get_wchar(sno); if (ch < 128) return ch; put_utf8((unsigned char *)&bufi, ch); } else { while (*buf++ == '\0'); } unsigned char c = *buf; buf[0] = '\0'; return c; } 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; } #define wide_char() \ 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;\ return och;\ }\ if (!how_many) {\ return wch;\ }\ }\ }\ break;\ case ENC_UTF16_BE:\ if (how_many) {\ return wch+ch;\ }\ how_many=1;\ wch = ch << 8;\ break;\ case ENC_UTF16_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;\ }\ static 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; } wide_char(); } return EOF; } // layered version static int get_wchar__(int sno) { int ch; wchar_t wch; int how_many = 0; StreamDesc *s = GLOBAL_Stream+sno; while (TRUE) { ch = getc(GLOBAL_Stream[sno].file); if (ch == -1) { if (how_many) { /* error */ } return post_process_weof(s); } wide_char(); } return EOF; } static int get_wchar_from_file(int sno) { return post_process_read_char( get_wchar__( sno ), GLOBAL_Stream+sno ); } #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 bucck 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_UTF16_BE: GLOBAL_Stream[sno].stream_putc(sno, (ch>>8)); return GLOBAL_Stream[sno].stream_putc(sno, (ch&0xff)); case ENC_UTF16_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_UTF16_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_UTF16_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 ch1, ch2, ch3, ch4; ch1 = st->stream_getc(sno); switch(ch1) { case 0x00: { ch2 = st->stream_getc(sno); if ( ch2 != 0x00) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); return; } else { ch3 = st->stream_getc(sno); if (ch3 == EOFCHAR || ch3 != 0xFE) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); ungetc( ch3, st->file ); return; } else { ch4 = st->stream_getc(sno); if (ch4 == EOFCHAR || ch3 != 0xFF) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); ungetc( ch3, st->file ); ungetc( ch4, st->file ); return; } else { st->status |= HAS_BOM_f; st->encoding = ENC_ISO_UTF32_BE; return; } } } } case 0xFE: { ch2 = st->stream_getc(sno); if (ch2 != 0xFF) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); return; } else { st->status |= HAS_BOM_f; st->encoding = ENC_UTF16_BE; return; } } case 0xFF: { ch2 = st->stream_getc(sno); if (ch2 != 0xFE) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); return; } else { ch3 = st->stream_getc(sno); if ( ch3 != 0x00) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); ungetc( ch3, st->file ); return; } else { ch4 = st->stream_getc(sno); if (ch4 != 0x00) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); ungetc( ch3, st->file ); ungetc( ch4, st->file ); return; } else { st->status |= HAS_BOM_f; st->encoding = ENC_ISO_UTF32_LE; return; } } st->status |= HAS_BOM_f; st->encoding = ENC_UTF16_LE; return; } } case 0xEF: ch2 = st->stream_getc(sno); if (ch2 != 0xBB) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); return; } else { ch3 = st->stream_getc(sno); if (ch3 != 0xBF) { ungetc( ch1, st->file ); ungetc( ch2, st->file ); ungetc( ch3, st->file ); return; } else { st->status |= HAS_BOM_f; st->encoding = ENC_ISO_UTF8; return; } } default: ungetc( ch1, st->file ); } } 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 (flags & Binary_Stream_f) { st->encoding = ENC_OCTET; } else { st->encoding = encoding; } 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; if (flags & Pipe_Stream_f) { Yap_PipeOps( st ); Yap_DefaultStreamOps( st); } else if (flags & Tty_Stream_f) { Yap_ConsoleOps( st ); Yap_DefaultStreamOps( st); } else { st->stream_putc = FilePutc; st->stream_getc = PlGetc; unix_upd_stream_info (st); Yap_DefaultStreamOps( st); } st->stream_gets = PlGetsFunc(); 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 do_open ( Term file_name, Term t2, Term tlist USES_REGS ) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ 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; FILE *fd; encoding_t encoding; Term tenc; // 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 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, open_defs, OPEN_END ); if (args == NULL) { if (LOCAL_Error_TYPE) Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, "option handling in open/3"); 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_INTERNAL,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_INTERNAL,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_INTERNAL,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,"%s: %s", fname, strerror(errno))); else return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK,file_name,"%s: %s", fname, strerror(errno))); } #if MAC if (open_mode == AtomWrite) { Yap_SetTextFile (RepAtom (AtomOfTerm (file_name))->StrOfAE); } #endif flags &= ~(Free_Stream_f); 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; } } UNLOCK(st->streamlock); { Term t = Yap_MkStream (sno); return (Yap_unify (ARG3, t)); } } static Int open3 ( USES_REGS1 ) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS ); } static Int open4 ( USES_REGS1 ) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ return do_open(Deref(ARG1), Deref(ARG2), Deref( ARG4 ) PASS_REGS ); } 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_INTERNAL,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_INTERNAL, 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 = PlGets; st->stream_wgetc = get_wchar; st->stream_wgetc_for_read = get_wchar; if (st->encoding == ENC_ISO_UTF8) st->stream_getc_for_utf8 = st->stream_getc; else st->stream_getc_for_utf8 = GetUTF8; 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) { CACHE_REGS 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 ); return sno; } #define CheckStream( arg, kind, msg) CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg) static int CheckStream__ (const char *file, const char *f, int line, 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)) { PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, "ambiguous use of 'user' as a stream"); return (-1); } sname = AtomUserIn; } else { sname = AtomUserOut; } } if ((sno = Yap_CheckAlias(sname)) < 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); return -1; } else { LOCK(GLOBAL_Stream[sno].streamlock); return sno; } } 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); } if (GLOBAL_Stream[sno].status & Free_Stream_f) { PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); return (-1); } LOCK(GLOBAL_Stream[sno].streamlock); if (( GLOBAL_Stream[sno].status & Input_Stream_f) && !(kind & Input_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg); } if ((GLOBAL_Stream[sno].status & (Append_Stream_f|Output_Stream_f)) && ! ( kind & Output_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); } return (sno); } int Yap_CheckStream__ (const char *file, const char *f, int line, Term arg, int kind, const char *msg) { return CheckStream__(file, f, line, arg, kind, msg); } int Yap_CheckTextStream__ (const char *file, const char *f, int line, Term arg, int kind, const char *msg) { int sno; if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0) return -1; if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, msg); UNLOCK(GLOBAL_Stream[sno].streamlock); return -1; } return sno; } /* used from C-interface */ int Yap_GetFreeStreamDForReading(void) { 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; Yap_DefaultStreamOps( s ); UNLOCK(s->streamlock); return sno; } 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)); } #define ABSOLUTE_FILE_NAME_DEFS() \ PAR( "extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ PAR( "relative_to", isatom, ABSOLUTE_FILE_NAME_RELATIVE_TO ), \ PAR( "access", isatom, ABSOLUTE_FILE_NAME_ACCESS ), \ PAR( "file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE ), \ PAR( "file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS ), \ PAR( "solutions", issolutions, ABSOLUTE_FILE_NAME_SOLUTIONS ), \ PAR( "expand", boolean, ABSOLUTE_FILE_NAME_EXPAND ), \ PAR( "verbose_file_search", boolean, ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH), \ PAR( NULL, ok, ABSOLUTE_FILE_NAME_END ) #define PAR(x,y,z) z typedef enum ABSOLUTE_FILE_NAME_enum_ { ABSOLUTE_FILE_NAME_DEFS() } absolute_file_name_choices_t; #undef PAR #define PAR(x,y,z) { x , y, z } static const param_t absolute_file_name_search_defs[] = { ABSOLUTE_FILE_NAME_DEFS() }; #undef PAR static Int abs_file_parameters ( USES_REGS1 ) { Term t[ABSOLUTE_FILE_NAME_END]; Term tlist = Deref(ARG1), tf; /* get options */ xarg *args = Yap_ArgListToVector ( tlist,absolute_file_name_search_defs, ABSOLUTE_FILE_NAME_END ); if (args == NULL) return FALSE; /* done */ if (args[ABSOLUTE_FILE_NAME_EXTENSIONS].used) t[ABSOLUTE_FILE_NAME_EXTENSIONS] = args[ABSOLUTE_FILE_NAME_EXTENSIONS].tvalue; else t[ABSOLUTE_FILE_NAME_EXTENSIONS] = TermNil; if (args[ABSOLUTE_FILE_NAME_RELATIVE_TO].used) t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue; else t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = TermDot; if (args[ABSOLUTE_FILE_NAME_FILE_TYPE].used) t[ABSOLUTE_FILE_NAME_FILE_TYPE] = args[ABSOLUTE_FILE_NAME_FILE_TYPE].tvalue; else t[ABSOLUTE_FILE_NAME_FILE_TYPE] = TermTxt; if (args[ABSOLUTE_FILE_NAME_ACCESS].used) t[ABSOLUTE_FILE_NAME_ACCESS] = args[ABSOLUTE_FILE_NAME_ACCESS].tvalue; else t[ABSOLUTE_FILE_NAME_ACCESS] = TermNone; if (args[ABSOLUTE_FILE_NAME_FILE_ERRORS].used) t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = args[ABSOLUTE_FILE_NAME_FILE_ERRORS].tvalue; else t[ABSOLUTE_FILE_NAME_FILE_ERRORS] = TermError; if (args[ABSOLUTE_FILE_NAME_SOLUTIONS].used) t[ABSOLUTE_FILE_NAME_SOLUTIONS] = args[ABSOLUTE_FILE_NAME_SOLUTIONS].tvalue; else t[ABSOLUTE_FILE_NAME_SOLUTIONS] = TermFirst; if (args[ABSOLUTE_FILE_NAME_EXPAND].used) t[ABSOLUTE_FILE_NAME_EXPAND] = args[ABSOLUTE_FILE_NAME_EXPAND].tvalue; else t[ABSOLUTE_FILE_NAME_EXPAND] = TermFalse; if (args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].used) t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue; else t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] = getYapFlag( TermVerboseFileSearch ); tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt,ABSOLUTE_FILE_NAME_END), ABSOLUTE_FILE_NAME_END, t); return (Yap_unify (ARG2, tf)); } static Int get_abs_file_parameter ( USES_REGS1 ) { Term t = Deref(ARG1), topts = ARG2; /* get options */ /* done */ if (t == TermExtensions) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_EXTENSIONS +1, topts ) ); if (t == TermRelativeTo) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_RELATIVE_TO +1, topts ) ); if (t == TermFileType) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_FILE_TYPE +1, topts ) ); if (t == TermAccess) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_ACCESS +1, topts ) ); if (t == TermFileErrors) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_FILE_ERRORS +1, topts ) ); if (t == TermSolutions) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_SOLUTIONS +1, topts ) ); if (t == TermExpand) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_EXPAND +1, topts ) ); if (t == TermVerboseFileSearch) return Yap_unify( ARG3, ArgOfTerm( ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH +1, topts ) ); return false; } void Yap_InitPlIO (void) { 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, SyncPredFlag); Yap_InitCPred ("open", 3, open3, SyncPredFlag); Yap_InitCPred ("abs_file_parameters", 2, abs_file_parameters, SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("get_abs_file_parameter", 3, get_abs_file_parameter, SafePredFlag|SyncPredFlag|HiddenPredFlag); 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(); }