diff --git a/os/format.c b/os/format.c index 08684e412..5dd6b43cf 100644 --- a/os/format.c +++ b/os/format.c @@ -233,10 +233,10 @@ output is directed to the stream used by format/2. */ #include "Yap.h" -#include "Yatom.h" #include "YapHeap.h" -#include "yapio.h" #include "YapText.h" +#include "Yatom.h" +#include "yapio.h" #include #if HAVE_UNISTD_H #include @@ -257,8 +257,8 @@ output is directed to the stream used by format/2. #define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR) #endif #endif -#include "iopreds.h" #include "eval.h" +#include "iopreds.h" #define FORMAT_MAX_SIZE 1024 @@ -618,7 +618,8 @@ static Int doformat(volatile Term otail, volatile Term oargs, goto do_type_atom_error; yhandle_t sl = Yap_StartSlots(); // stream is already locked. - Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, GLOBAL_MaxPriority); + Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, + GLOBAL_MaxPriority); Yap_CloseSlots(sl); break; case 'c': { @@ -810,8 +811,8 @@ static Int doformat(volatile Term otail, volatile Term oargs, char *pt, *res; tmpbase = tmp1; - while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, - radix))) { + while (!( + res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) { if (tmpbase == tmp1) { tmpbase = NULL; } else { @@ -871,7 +872,8 @@ static Int doformat(volatile Term otail, volatile Term oargs, t = targs[targ++]; yhandle_t sl = Yap_StartSlots(); Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Quote_illegal_f | Ignore_ops_f | To_heap_f, GLOBAL_MaxPriority); + Quote_illegal_f | Ignore_ops_f | To_heap_f, + GLOBAL_MaxPriority); Yap_CloseSlots(sl); break; case '@': @@ -910,7 +912,8 @@ static Int doformat(volatile Term otail, volatile Term oargs, { Int sl = Yap_InitSlot(args); Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Handle_vars_f | Use_portray_f | To_heap_f, GLOBAL_MaxPriority); + Handle_vars_f | Use_portray_f | To_heap_f, + GLOBAL_MaxPriority); args = Yap_GetFromSlot(sl); Yap_CloseSlots(sl); } @@ -936,7 +939,8 @@ static Int doformat(volatile Term otail, volatile Term oargs, t = targs[targ++]; yhandle_t sl0 = Yap_StartSlots(); Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Handle_vars_f | Quote_illegal_f | To_heap_f, GLOBAL_MaxPriority); + Handle_vars_f | Quote_illegal_f | To_heap_f, + GLOBAL_MaxPriority); Yap_CloseSlots(sl0); break; case 'w': @@ -1022,8 +1026,7 @@ static Int doformat(volatile Term otail, volatile Term oargs, else finfo.pad_entries[finfo.padders].filler = fptr[-2]; finfo.padders++; - } - break; + } break; do_instantiation_error: LOCAL_Error_TYPE = INSTANTIATION_ERROR; goto do_default_error; diff --git a/os/getw.h b/os/getw.h index d06fe0d8f..7b48f8d0b 100644 --- a/os/getw.h +++ b/os/getw.h @@ -1,5 +1,5 @@ -/// compose a wide char from a sequence of getchars +/// compose a wide char from a sequence of getchars /// this is a slow lane routine, called if no specialised code /// isavailable. static int GETW(int sno) { @@ -24,12 +24,12 @@ static int GETW(int sno) { case ENC_ISO_ANSI: { char buf[8]; int out; - int wch; + wchar_t wch; mbstate_t mbstate; memset((void *)&(mbstate), 0, sizeof(mbstate_t)); buf[0] = ch; - int n=1; + int n = 1; while ((out = mbrtowc(&wch, buf, 1, &(mbstate))) != 1) { int ch = buf[0] = GETC(); n++; @@ -38,166 +38,169 @@ static int GETW(int sno) { } return post_process_read_wchar(wch, n, st); } -// UTF-8 works o 8 bits. -case ENC_ISO_UTF8: { + // UTF-8 works o 8 bits. + case ENC_ISO_UTF8: { int wch; - unsigned char buf[8]; + unsigned char buf[8]; - if (ch < 0x80) { - return post_process_read_wchar(ch, 1, st); - } - // if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8; - if (ch < 0xe0) { // 2-byte sequence - // Must have valid continuation character - int c1 = buf[0] = GETC(); - if (c1 == -1) + if (ch < 0x80) { + return post_process_read_wchar(ch, 1, st); + } + // if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8; + if (ch < 0xe0) { // 2-byte sequence + // Must have valid continuation character + int c1 = buf[0] = GETC(); + if (c1 == -1) return post_process_weof(st); - // if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8; - wch = ((ch & 0x1f)<<6) | (c1 & 0x3f); - return post_process_read_wchar(wch, 2, st); - } - if (ch < 0xf0) { // 3-byte sequence - //if ((str + 1 >= end) || !utf_cont(*str) || !utf_cont(str[1])) - // return UTF8PROC_ERROR_INVALIDUTF8; - // Check for surrogate chars - //if (ch == 0xed && *str > 0x9f) - // return UTF8PROC_ERROR_INVALIDUTF8; - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - int c2 = GETC(); - if (c2 == -1) - return post_process_weof(st); - wch = ((ch & 0xf)<<12) | ((c1 & 0x3f)<<6) | (c2 & 0x3f); - return post_process_read_wchar(wch, 3, st); - } else { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - int c2 = GETC(); - if (c2 == -1) - return post_process_weof(st); - int c3 = GETC(); - if (c3 == -1) - return post_process_weof(st); - wch = ((ch & 7)<<18) | ((c1 & 0x3f)<<12) | ((c2 & 0x3f)<<6) | (c3 & 0x3f); - return post_process_read_wchar(wch, 4, st); - } - } -case ENC_UTF16_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3 - // little-endian: start with big shot - { - int wch; + // if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8; + wch = ((ch & 0x1f) << 6) | (c1 & 0x3f); + return post_process_read_wchar(wch, 2, st); + } + if (ch < 0xf0) { // 3-byte sequence + // if ((str + 1 >= end) || !utf_cont(*str) || !utf_cont(str[1])) + // return UTF8PROC_ERROR_INVALIDUTF8; + // Check for surrogate chars + // if (ch == 0xed && *str > 0x9f) + // return UTF8PROC_ERROR_INVALIDUTF8; int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch = (c1 << 8) + ch; - if (wch >= 0xd800 && wch < 0xdc00) { - int c2 = GETC(); - if (c2 == -1) - return post_process_weof(st); - int c3 = GETC(); - if (c3 == -1) - return post_process_weof(st); - wch = wch + (((c3 << 8) + c2)<= 0xd800 && wch < 0xdc00) { - int c3 = GETC(); - if (c3 == -1) - return post_process_weof(st); - int c2 = GETC(); - if (c2 == -1) - return post_process_weof(st); - wch = (((c3 << 8) + c2) << 10) + wch + SURROGATE_OFFSET; + if (c1 == -1) + return post_process_weof(st); + int c2 = GETC(); + if (c2 == -1) + return post_process_weof(st); + int c3 = GETC(); + if (c3 == -1) + return post_process_weof(st); + wch = ((ch & 7) << 18) | ((c1 & 0x3f) << 12) | ((c2 & 0x3f) << 6) | + (c3 & 0x3f); + return post_process_read_wchar(wch, 4, st); + } + } + case ENC_UTF16_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3 + // little-endian: start with big shot + { + int wch; + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch = (c1 << 8) + ch; + if (wch >= 0xd800 && wch < 0xdc00) { + int c2 = GETC(); + if (c2 == -1) + return post_process_weof(st); + int c3 = GETC(); + if (c3 == -1) + return post_process_weof(st); + wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET; return post_process_read_wchar(wch, 4, st); - } - return post_process_read_wchar(wch, 2, st); - } - + } + return post_process_read_wchar(wch, 2, st); + } + + case ENC_UTF16_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3 + // little-endian: start with big shot + { + int wch; + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch = (c1) + (ch << 8); + if (wch >= 0xd800 && wch < 0xdc00) { + int c3 = GETC(); + if (c3 == -1) + return post_process_weof(st); + int c2 = GETC(); + if (c2 == -1) + return post_process_weof(st); + wch = (((c3 << 8) + c2) << 10) + wch + SURROGATE_OFFSET; + return post_process_read_wchar(wch, 4, st); + } + return post_process_read_wchar(wch, 2, st); + } + case ENC_UCS2_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3 - // little-endian: start with big shot - { - int wch; + // little-endian: start with big shot + { + int wch; int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch = (c1) + (ch<<8); - return post_process_read_wchar(wch, 2, st); - } - - -case ENC_UCS2_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3 - // little-endian: start with big shot - { - int wch; - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch = (c1 << 8) + ch; + if (c1 == -1) + return post_process_weof(st); + wch = (c1) + (ch << 8); + return post_process_read_wchar(wch, 2, st); + } - return post_process_read_wchar(wch, 2, st); - } + case ENC_UCS2_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3 + // little-endian: start with big shot + { + int wch; + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch = (c1 << 8) + ch; -case ENC_ISO_UTF32_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3 - // little-endian: start with big shot - { - int wch = ch; - { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch = wch + c1; + return post_process_read_wchar(wch, 2, st); } - { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch = (wch << 8 )+c1; + + case ENC_ISO_UTF32_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3 + // little-endian: start with big shot + { + int wch = ch; + { + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch = wch + c1; + } + { + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch = (wch << 8) + c1; + } + { + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch = (wch << 8) + c1; + } + return post_process_read_wchar(wch, 4, st); } - { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch = (wch << 8) +c1; - } - return post_process_read_wchar(wch, 4, st); + case ENC_ISO_UTF32_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3 + // little-endian: start with big shot + { + int wch = ch; + { + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch += c1 << 8; + } + { + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch += c1 << 16; + } + { + int c1 = GETC(); + if (c1 == -1) + return post_process_weof(st); + wch += c1 << 24; + } + return post_process_read_wchar(wch, 4, st); + } + default: + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, MkIntTerm(st->encoding), + "Bad Encoding\n"); + return -1; } -case ENC_ISO_UTF32_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3 - // little-endian: start with big shot - { - int wch = ch; - { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch += c1<<8; - } - { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch += c1<<16; - } - { - int c1 = GETC(); - if (c1 == -1) - return post_process_weof(st); - wch += c1<<24; - } - return post_process_read_wchar(wch, 4, st); - } - } } diff --git a/os/iopreds.c b/os/iopreds.c index 89bcca213..9f355dffd 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -33,12 +33,15 @@ static char SccsId[] = "%W% %G%"; */ #include "Yap.h" -#include "Yatom.h" #include "YapHeap.h" -#include "yapio.h" -#include "eval.h" #include "YapText.h" +#include "Yatom.h" +#include "eval.h" +#include "yapio.h" #include +#if HAVE_UNISTD_H +#include +#endif #if HAVE_STDARG_H #include #endif @@ -96,7 +99,6 @@ static char SccsId[] = "%W% %G%"; #endif #include "iopreds.h" - #define GETW get_wchar_from_FILE #define GETC() fgetwc(st->file) #include "getw.h" @@ -190,7 +192,7 @@ static bool is_file_errors(Term t) { } void Yap_DefaultStreamOps(StreamDesc *st) { - CACHE_REGS + CACHE_REGS st->stream_wputc = put_wchar; st->stream_wgetc = get_wchar; if (st->status & (Promptable_Stream_f)) { @@ -248,7 +250,7 @@ static void unix_upd_stream_info(StreamDesc *s) { filedes = fileno(s->file); if (isatty(filedes)) { #if HAVE_TTYNAME - char *ttys = ttyname(filedes); + char *ttys = ttyname_r(filedes, LOCAL_FileNameBuf, YAP_FILENAME_MAX - 1); if (ttys == NULL) s->name = AtomTty; else @@ -266,9 +268,8 @@ static void unix_upd_stream_info(StreamDesc *s) { s->status |= Seekable_Stream_f; } - static void InitFileIO(StreamDesc *s) { - CACHE_REGS + CACHE_REGS if (s->status & Socket_Stream_f) { /* Console is a socket and socket will prompt */ Yap_ConsoleSocketOps(s); @@ -587,7 +588,7 @@ int ResetEOF(StreamDesc *s) { } else { s->stream_getc = PlGetc; Yap_DefaultStreamOps(s); - } + } /* next, reset our own error indicator */ s->status &= ~Eof_Stream_f; /* try reading again */ @@ -646,7 +647,7 @@ int console_post_process_eof(StreamDesc *s) { /* check if we read a newline or an EOF */ int post_process_read_wchar(int ch, size_t n, StreamDesc *s) { if (ch == EOF) { - return post_process_weof(s); + return post_process_weof(s); } s->charcount += n; s->linepos += n; @@ -660,7 +661,6 @@ int post_process_read_wchar(int ch, size_t n, StreamDesc *s) { return ch; } - int post_process_weof(StreamDesc *s) { if (!ResetEOF(s)) { s->status |= Eof_Stream_f; @@ -692,462 +692,455 @@ int PlGetc(int sno) { return fgetc(s->file); } +// layered version +static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); } - // layered version - static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); } - - static int get_wchar_from_file(int sno) { - return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno); - } +static int get_wchar_from_file(int sno) { + return post_process_read_wchar(get_wchar__(sno), 1, 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; - } +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]; - mbstate_t mbstate; - int n; +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]; + mbstate_t mbstate; + int n; - memset((void *)&mbstate, 0, sizeof(mbstate_t)); - if ((n = wcrtomb(buf, ch, &mbstate)) < 0) { - /* error */ - GLOBAL_Stream[sno].stream_putc(sno, ch); - return -1; - } else { - int i; + memset((void *)&mbstate, 0, sizeof(mbstate_t)); + if ((n = wcrtomb(buf, ch, &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) { - GLOBAL_Stream[sno].stream_putc(sno, ch); - } else if (ch < 0x800) { - GLOBAL_Stream[sno].stream_putc(sno, 0xC0 | ch >> 6); - 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)); - 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)); - GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); - } else { - /* should never happen */ - return -1; - } - return ch; - break; - case ENC_UTF16_LE: - { - if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - } else { - // computations - uint16_t ich = ch; - uint16_t lead = LEAD_OFFSET + (ich >> 10); - uint16_t trail = 0xDC00 + (ich & 0x3FF); - - GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); - } - return ch; - } - case ENC_UTF16_BE: - { - // computations - if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - } else { - uint16_t lead = (uint16_t)LEAD_OFFSET + ((uint16_t)ch >> 10); - uint16_t trail = 0xDC00 + ((uint16_t)ch & 0x3FF); - - GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); - - } - return ch; - } - case ENC_UCS2_LE: - { - if (ch >= 0x10000) { - return 0; - } - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - return ch; - } - case ENC_UCS2_BE: - { - // computations - if (ch < 0x10000) { - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); - GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); - return ch; - } else { - return 0; - } - } - - 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); - GLOBAL_Stream[sno].stream_putc(sno, ch & 0xff); - return ch; - 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); - GLOBAL_Stream[sno].stream_putc(sno, (ch >> 24) & 0xff); - return ch; - } + for (i = 0; i < n; i++) { + GLOBAL_Stream[sno].stream_putc(sno, buf[i]); } + return ch; + } + case ENC_ISO_UTF8: + if (ch < 0x80) { + GLOBAL_Stream[sno].stream_putc(sno, ch); + } else if (ch < 0x800) { + GLOBAL_Stream[sno].stream_putc(sno, 0xC0 | ch >> 6); + 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)); + 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)); + GLOBAL_Stream[sno].stream_putc(sno, 0x80 | (ch & 0x3F)); + } else { + /* should never happen */ return -1; } + return ch; + break; + case ENC_UTF16_LE: { + if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + } else { + // computations + uint16_t ich = ch; + uint16_t lead = LEAD_OFFSET + (ich >> 10); + uint16_t trail = 0xDC00 + (ich & 0x3FF); - /* 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)); + GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); } + return ch; + } + case ENC_UTF16_BE: { + // computations + if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + } else { + uint16_t lead = (uint16_t)LEAD_OFFSET + ((uint16_t)ch >> 10); + uint16_t trail = 0xDC00 + ((uint16_t)ch & 0x3FF); - int Yap_PlGetWchar(void) { - CACHE_REGS - return get_wchar(LOCAL_c_input_stream); + GLOBAL_Stream[sno].stream_putc(sno, (lead >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (lead & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (trail >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (trail & 0xff)); } - - /* avoid using a variable to call a function */ - int Yap_PlFGetchar(void) { - CACHE_REGS - return (PlGetc(LOCAL_c_input_stream)); + return ch; + } + case ENC_UCS2_LE: { + if (ch >= 0x10000) { + return 0; } - - Term Yap_MkStream(int n) { - Term t[1]; - t[0] = MkIntTerm(n); - return (Yap_MkApplTerm(FunctorStream, 1, t)); + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + return ch; + } + case ENC_UCS2_BE: { + // computations + if (ch < 0x10000) { + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8)); + GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff)); + return ch; + } else { + return 0; } + } - /* given a stream index, get the corresponding fd */ - Int GetStreamFd(int sno) { + 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); + GLOBAL_Stream[sno].stream_putc(sno, ch & 0xff); + return ch; + 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); + GLOBAL_Stream[sno].stream_putc(sno, (ch >> 24) & 0xff); + return ch; + } + } + 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 + 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) { - return (GLOBAL_Stream[sno].u.pipe.fd); - } else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { - return (-1); - } - return (fileno(GLOBAL_Stream[sno].file)); - } + if (GLOBAL_Stream[sno].status & Pipe_Stream_f) { + return (GLOBAL_Stream[sno].u.pipe.fd); + } 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); } +Int Yap_GetStreamFd(int sno) { return GetStreamFd(sno); } - static int binary_file(const char *file_name) { +static int binary_file(const char *file_name) { #if HAVE_STAT #if _MSC_VER || defined(__MINGW32__) - struct _stat ss; - if (_stat(file_name, &ss) != 0) + struct _stat ss; + if (_stat(file_name, &ss) != 0) #else - struct stat ss; - if (stat(file_name, &ss) != 0) + struct stat ss; + if (stat(file_name, &ss) != 0) #endif - { - /* ignore errors while checking a file */ - return (FALSE); - } - return (S_ISDIR(ss.st_mode)); + { + /* ignore errors while checking a file */ + return (FALSE); + } + return (S_ISDIR(ss.st_mode)); #else - return (FALSE); + 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: - case ENC_UCS2_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: - case ENC_UCS2_LE: - if (st->stream_putc(sno, 0xFF) < 0) - return false; - if (st->stream_putc(sno, 0xFE) < 0) - return false; - st->status |= HAS_BOM_f; - return true; - 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; - st->status |= HAS_BOM_f; - return true; - 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; - st->status |= HAS_BOM_f; - return true; - default: - return true; - } - } +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: + case ENC_UCS2_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: + case ENC_UCS2_LE: + if (st->stream_putc(sno, 0xFF) < 0) + return false; + if (st->stream_putc(sno, 0xFE) < 0) + return false; + st->status |= HAS_BOM_f; + return true; + 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; + st->status |= HAS_BOM_f; + return true; + 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; + st->status |= HAS_BOM_f; + return true; + default: + return true; + } +} - static void check_bom(int sno, StreamDesc *st) { - int ch1, ch2, ch3, ch4; +static void check_bom(int sno, StreamDesc *st) { + int ch1, ch2, ch3, ch4; - ch1 = fgetc(st->file); - switch (ch1) { - case 0x00: { - ch2 = fgetc(st->file); - if (ch2 != 0x00) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - return; - } else { - ch3 = fgetc(st->file); - if (ch3 == EOFCHAR || ch3 != 0xFE) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - ungetc(ch3, st->file); - return; - } else { - ch4 = fgetc(st->file); - 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 = fgetc(st->file); - if (ch2 != 0xFF) { + ch1 = fgetc(st->file); + switch (ch1) { + case 0x00: { + ch2 = fgetc(st->file); + if (ch2 != 0x00) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + return; + } else { + ch3 = fgetc(st->file); + if (ch3 == EOFCHAR || ch3 != 0xFE) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + ungetc(ch3, st->file); + return; + } else { + ch4 = fgetc(st->file); + 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_UTF16_BE; + st->encoding = ENC_ISO_UTF32_BE; return; } } - case 0xFF: { - ch2 = fgetc(st->file); - if (ch2 != 0xFE) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); + } + } + case 0xFE: { + ch2 = fgetc(st->file); + 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 = fgetc(st->file); + if (ch2 != 0xFE) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + return; + } else { + ch3 = fgetc(st->file); + if (ch3 != 0x00) { + ungetc(ch3, st->file); + } else { + ch4 = fgetc(st->file); + if (ch4 == 0x00) { + st->status |= HAS_BOM_f; + st->encoding = ENC_ISO_UTF32_LE; return; } else { - ch3 = fgetc(st->file); - if (ch3 != 0x00) { - ungetc(ch3, st->file); - } else { - ch4 = fgetc(st->file); - if (ch4 == 0x00) { - st->status |= HAS_BOM_f; - st->encoding = ENC_ISO_UTF32_LE; - return; - } else { - ungetc(ch4, st->file); - ungetc(0x00, st->file); - } - } + ungetc(ch4, st->file); + ungetc(0x00, st->file); } + } + } + st->status |= HAS_BOM_f; + st->encoding = ENC_UTF16_LE; + return; + } + case 0xEF: + ch2 = fgetc(st->file); + if (ch2 != 0xBB) { + ungetc(ch1, st->file); + ungetc(ch2, st->file); + return; + } else { + ch3 = fgetc(st->file); + 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_UTF16_LE; + st->encoding = ENC_ISO_UTF8; return; } - case 0xEF: - ch2 = fgetc(st->file); - if (ch2 != 0xBB) { - ungetc(ch1, st->file); - ungetc(ch2, st->file); - return; - } else { - ch3 = fgetc(st->file); - 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); - } } + default: + ungetc(ch1, st->file); + } +} - bool Yap_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; +bool Yap_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; - } + 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); - if (name) - 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, false); - Yap_DefaultStreamOps(st); - } else { - st->stream_putc = FilePutc; - st->stream_getc = PlGetc; - unix_upd_stream_info(st); - Yap_DefaultStreamOps(st); - } - return true; - } - - static bool open_header(int sno, Atom open_mode) { - if (open_mode == AtomWrite) { - const char *ptr; - const char s[] = "#!"; - int ch; - - ptr = s; - while ((ch = *ptr++)) - GLOBAL_Stream[sno].stream_wputc(sno, ch); - const char *b = Yap_FindExecutable(); - ptr = b; - while ((ch = *ptr++)) - GLOBAL_Stream[sno].stream_wputc(sno, ch); - const char *l = " -L --\n\n YAP script\n#\n# .\n"; - ptr = l; - while ((ch = *ptr++)) - GLOBAL_Stream[sno].stream_wputc(sno, ch); - - } else if (open_mode == AtomRead) { - // skip header - int ch; - while ((ch = Yap_peek(sno)) == '#') { - while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != 10 && ch != -1) - ; - } - } - return true; + if (name == NULL) { + char buf[YAP_FILENAME_MAX + 1]; + name = Yap_guessFileName(fileno(fd), sno, buf, YAP_FILENAME_MAX); + if (name) + 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, false); + Yap_DefaultStreamOps(st); + } else { + st->stream_putc = FilePutc; + st->stream_getc = PlGetc; + unix_upd_stream_info(st); + Yap_DefaultStreamOps(st); + } + return true; +} + +static bool open_header(int sno, Atom open_mode) { + if (open_mode == AtomWrite) { + const char *ptr; + const char s[] = "#!"; + int ch; + + ptr = s; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc(sno, ch); + const char *b = Yap_FindExecutable(); + ptr = b; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc(sno, ch); + const char *l = " -L --\n\n YAP script\n#\n# .\n"; + ptr = l; + while ((ch = *ptr++)) + GLOBAL_Stream[sno].stream_wputc(sno, ch); + + } else if (open_mode == AtomRead) { + // skip header + int ch; + while ((ch = Yap_peek(sno)) == '#') { + while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != 10 && ch != -1) + ; } + } + return true; +} #define OPEN_DEFS() \ - PAR("alias", isatom, OPEN_ALIAS), PAR("bom", booleanFlag, OPEN_BOM), \ - PAR("buffer", isatom, OPEN_BUFFER), \ + PAR("alias", isatom, OPEN_ALIAS) \ + , PAR("bom", booleanFlag, OPEN_BOM), PAR("buffer", isatom, OPEN_BUFFER), \ PAR("close_on_abort", booleanFlag, OPEN_CLOSE_ON_ABORT), \ PAR("create", isatom, OPEN_CREATE), \ PAR("encoding", isatom, OPEN_ENCODING), \ @@ -1162,608 +1155,600 @@ int PlGetc(int sno) { PAR("wait", booleanFlag, OPEN_WAIT), PAR(NULL, ok, OPEN_END) #define PAR(x, y, z) z - typedef enum open_enum_choices { OPEN_DEFS() } open_choices_t; +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()}; +static const param_t open_defs[] = {OPEN_DEFS()}; #undef PAR - static Int do_open( - Term file_name, Term t2, +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 = false; - const char *fname; - stream_flags_t flags; - FILE *fd; - const char *s_encoding; - encoding_t encoding; - Term tenc; + Atom open_mode; + int sno; + SMALLUNSGN s; + char io_mode[8]; + StreamDesc *st; + bool avoid_bom = false, needs_bom = false; + const char *fname; + stream_flags_t flags; + FILE *fd; + const char *s_encoding; + 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_NO_ERROR) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) - LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION; - 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; - flags = s; - // user requested encoding? - if (args[OPEN_ALIAS].used) { - Atom al = AtomOfTerm(args[OPEN_ALIAS].tvalue); - if (!Yap_AddAlias(al, sno)) - return false; - } - if (args[OPEN_ENCODING].used) { - tenc = args[OPEN_ENCODING].tvalue; - s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; - } else { - s_encoding = "default"; - } - // default encoding, no bom yet - encoding = enc_id( s_encoding, ENC_OCTET); - // only set encoding after getting BOM - bool ok = (args[OPEN_EXPAND_FILENAME].used - ? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue - : false) || - trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); - // expand file name? - fname = Yap_AbsoluteFile(fname, ok); - if (fname) { - st->name = Yap_LookupAtom(fname); - } else { - PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL); - } + // 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_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_OPEN_OPTION; + 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; + flags = s; + // user requested encoding? + if (args[OPEN_ALIAS].used) { + Atom al = AtomOfTerm(args[OPEN_ALIAS].tvalue); + if (!Yap_AddAlias(al, sno)) + return false; + } + if (args[OPEN_ENCODING].used) { + tenc = args[OPEN_ENCODING].tvalue; + s_encoding = RepAtom(AtomOfTerm(tenc))->StrOfAE; + } else { + s_encoding = "default"; + } + // default encoding, no bom yet + encoding = enc_id(s_encoding, ENC_OCTET); + // only set encoding after getting BOM + bool ok = (args[OPEN_EXPAND_FILENAME].used + ? args[OPEN_EXPAND_FILENAME].tvalue == TermTrue + : false) || + trueGlobalPrologFlag(OPEN_EXPANDS_FILENAME_FLAG); + // expand file name? + fname = Yap_AbsoluteFile(fname, ok); + if (fname) { + st->name = Yap_LookupAtom(fname); + } else { + PlIOError(EXISTENCE_ERROR_SOURCE_SINK, ARG1, NULL); + } - // Skip scripts that start with !#/.. or similar - bool script = - (args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue - : false); - // binary type - if (args[OPEN_TYPE].used) { - Term t = args[OPEN_TYPE].tvalue; - bool bin = (t == TermBinary); - if (bin) { + // Skip scripts that start with !#/.. or similar + bool script = + (args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue : false); + // 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); + strncat(io_mode, "b", 8); #endif - flags |= Binary_Stream_f; - encoding = ENC_OCTET; - avoid_bom = true; - needs_bom = false; - } else if (t == TermText) { + flags |= Binary_Stream_f; + encoding = ENC_OCTET; + avoid_bom = true; + needs_bom = false; + } else if (t == TermText) { #ifdef _WIN32 - strncat(io_mode, "t", 8); + strncat(io_mode, "t", 8); #endif - /* note that this matters for UNICODE style conversions */ - } else { - Yap_Error(DOMAIN_ERROR_STREAM, tlist, - "type is ~a, must be one of binary or text", t); - } - } - // BOM mess - if (encoding == ENC_UTF16_BE || encoding == ENC_UTF16_LE || - encoding == ENC_UCS2_BE || encoding == ENC_UCS2_LE || - encoding == ENC_ISO_UTF32_BE || encoding == ENC_ISO_UTF32_LE) { - needs_bom = true; - } - if (args[OPEN_BOM].used) { - if (args[OPEN_BOM].tvalue == TermTrue) { - avoid_bom = false; - needs_bom = true; - } else if (args[OPEN_BOM].tvalue == TermFalse) { - avoid_bom = true; - needs_bom = false; - } - } - if (st - GLOBAL_Stream < 3) { - flags |= RepError_Prolog_f; - } - if ((fd = fopen(fname, io_mode)) == NULL || - (!(flags & Binary_Stream_f) && binary_file(fname))) { - strncpy(LOCAL_FileNameBuf, fname, MAXPATHLEN); - free((void *)fname); - fname = LOCAL_FileNameBuf; - UNLOCK(st->streamlock); - if (errno == ENOENT) - return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s", - fname, strerror(errno))); - else { - return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, - "%s: %s", fname, strerror(errno))); - } - } + /* note that this matters for UNICODE style conversions */ + } else { + Yap_Error(DOMAIN_ERROR_STREAM, tlist, + "type is ~a, must be one of binary or text", t); + } + } + // BOM mess + if (encoding == ENC_UTF16_BE || encoding == ENC_UTF16_LE || + encoding == ENC_UCS2_BE || encoding == ENC_UCS2_LE || + encoding == ENC_ISO_UTF32_BE || encoding == ENC_ISO_UTF32_LE) { + needs_bom = true; + } + if (args[OPEN_BOM].used) { + if (args[OPEN_BOM].tvalue == TermTrue) { + avoid_bom = false; + needs_bom = true; + } else if (args[OPEN_BOM].tvalue == TermFalse) { + avoid_bom = true; + needs_bom = false; + } + } + if (st - GLOBAL_Stream < 3) { + flags |= RepError_Prolog_f; + } + if ((fd = fopen(fname, io_mode)) == NULL || + (!(flags & Binary_Stream_f) && binary_file(fname))) { + strncpy(LOCAL_FileNameBuf, fname, MAXPATHLEN); + free((void *)fname); + fname = LOCAL_FileNameBuf; + UNLOCK(st->streamlock); + if (errno == ENOENT) + return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%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); - } + if (open_mode == AtomWrite) { + Yap_SetTextFile(RepAtom(AtomOfTerm(file_name))->StrOfAE); + } #endif - flags &= ~(Free_Stream_f); - if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, - open_mode)) - return false; - if (!Yap_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) { - check_bom(sno, st); // can change encoding - } - // follow declaration unless there is v - if (st->status & HAS_BOM_f) - st->encoding = enc_id( s_encoding, st->encoding); - else - st->encoding = encoding; - Yap_DefaultStreamOps( st); - if (script) - open_header(sno, open_mode); + flags &= ~(Free_Stream_f); + if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags, open_mode)) + return false; + if (!Yap_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) { + check_bom(sno, st); // can change encoding + } + // follow declaration unless there is v + if (st->status & HAS_BOM_f) + st->encoding = enc_id(s_encoding, st->encoding); + else + st->encoding = encoding; + Yap_DefaultStreamOps(st); + if (script) + open_header(sno, open_mode); - UNLOCK(st->streamlock); - { - Term t = Yap_MkStream(sno); - return (Yap_unify(ARG3, t)); - } - } + UNLOCK(st->streamlock); + { + Term t = Yap_MkStream(sno); + return (Yap_unify(ARG3, t)); + } +} - /** @pred open(+ _F_,+ _M_,- _S_) is iso +/** @pred open(+ _F_,+ _M_,- _S_) is iso - Opens the file with name _F_ in mode _M_ (`read`, `write` or - `append`), returning _S_ unified with the stream name. +Opens the file with name _F_ in mode _M_ (`read`, `write` or +`append`), returning _S_ unified with the stream name. - Yap allows 64 streams opened at the same time. If you need more, - redefine the MaxStreams constant. Each stream is either an input or - an output stream but not both. There are always 3 open streams: - user_input for reading, user_output for writing and user_error for - writing. If there is no ambiguity, the atoms user_input and - user_output may be referred to as `user`. +Yap allows 64 streams opened at the same time. If you need more, + redefine the MaxStreams constant. Each stream is either an input or + an output stream but not both. There are always 3 open streams: + user_input for reading, user_output for writing and user_error for + writing. If there is no ambiguity, the atoms user_input and + user_output may be referred to as `user`. - The `file_errors` flag controls whether errors are reported when in - mode `read` or `append` the file _F_ does not exist or is not - readable, and whether in mode `write` or `append` the file is not - writable. +The `file_errors` flag controls whether errors are reported when in +mode `read` or `append` the file _F_ does not exist or is not +readable, and whether in mode `write` or `append` the file is not +writable. - */ +*/ - static Int open3( - USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ - return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); - } +static Int open3(USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ + return do_open(Deref(ARG1), Deref(ARG2), TermNil PASS_REGS); +} - /** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso +/** @pred open(+ _F_,+ _M_,- _S_,+ _Opts_) is iso - Opens the file with name _F_ in mode _M_ (`read`, `write` or - `append`), returning _S_ unified with the stream name, and following - these options: +Opens the file with name _F_ in mode _M_ (`read`, `write` or +`append`), returning _S_ unified with the stream name, and following +these options: - + `type(+ _T_)` is iso ++ `type(+ _T_)` is iso - Specify whether the stream is a `text` stream (default), or a - `binary` stream. + Specify whether the stream is a `text` stream (default), or a +`binary` stream. - + `reposition(+ _Bool_)` is iso - Specify whether it is possible to reposition the stream (`true`), or - not (`false`). By default, YAP enables repositioning for all - files, except terminal files and sockets. ++ `reposition(+ _Bool_)` is iso + Specify whether it is possible to reposition the stream (`true`), or +not (`false`). By default, YAP enables repositioning for all +files, except terminal files and sockets. - + `eof(+ _Action_)` is iso ++ `eof(+ _Action_)` is iso - Specify the action to take if attempting to input characters from a - stream where we have previously found an `end_of_file`. The possible - actions are `error`, that raises an error, `reset`, that tries to - reset the stream and is used for `tty` type files, and `eof_code`, - which generates a new `end_of_file` (default for non-tty files). + Specify the action to take if attempting to input characters from a +stream where we have previously found an `end_of_file`. The possible +actions are `error`, that raises an error, `reset`, that tries to +reset the stream and is used for `tty` type files, and `eof_code`, +which generates a new `end_of_file` (default for non-tty files). - + `alias(+ _Name_)` is iso ++ `alias(+ _Name_)` is iso - Specify an alias to the stream. The alias Name must be an atom. - The - alias can be used instead of the stream descriptor for every operation - concerning the stream. + Specify an alias to the stream. The alias Name must be an atom. +The +alias can be used instead of the stream descriptor for every operation +concerning the stream. - The operation will fail and give an error if the alias name is already - in use. YAP allows several aliases for the same file, but only - one is returned by stream_property/2 + The operation will fail and give an error if the alias name is already +in use. YAP allows several aliases for the same file, but only +one is returned by stream_property/2 - + `bom(+ _Bool_)` ++ `bom(+ _Bool_)` - If present and `true`, a BOM (Byte Order Mark) was - detected while opening the file for reading or a BOM was written while - opening the stream. See BOM for details. + If present and `true`, a BOM (Byte Order Mark) was +detected while opening the file for reading or a BOM was written while +opening the stream. See BOM for details. - + `encoding(+ _Encoding_)` ++ `encoding(+ _Encoding_)` - Set the encoding used for text. See Encoding for an overview of - wide character and encoding issues. +Set the encoding used for text. See Encoding for an overview of +wide character and encoding issues. - + `representation_errors(+ _Mode_)` ++ `representation_errors(+ _Mode_)` - Change the behaviour when writing characters to the stream that cannot - be represented by the encoding. The behaviour is one of `error` - (throw and Input/Output error exception), `prolog` (write `\u...\` - escape code or `xml` (write `\&#...;` XML character entity). - The initial mode is `prolog` for the user streams and - `error` for all other streams. See also Encoding. + Change the behaviour when writing characters to the stream that cannot +be represented by the encoding. The behaviour is one of `error` +(throw and Input/Output error exception), `prolog` (write `\u...\` +escape code or `xml` (write `\&#...;` XML character entity). +The initial mode is `prolog` for the user streams and +`error` for all other streams. See also Encoding. - + `expand_filename(+ _Mode_)` ++ `expand_filename(+ _Mode_)` - If _Mode_ is `true` then do filename expansion, then ask Prolog - to do file name expansion before actually trying to opening the file: - this includes processing `~` characters and processing `$` - environment variables at the beginning of the file. Otherwise, just try - to open the file using the given name. + If _Mode_ is `true` then do filename expansion, then ask Prolog +to do file name expansion before actually trying to opening the file: +this includes processing `~` characters and processing `$` +environment variables at the beginning of the file. Otherwise, just try +to open the file using the given name. - The default behavior is given by the Prolog flag - open_expands_filename. + The default behavior is given by the Prolog flag +open_expands_filename. - + `script( + _Boolean_ )` YAP extension. ++ `script( + _Boolean_ )` YAP extension. - The file may be a Prolog script. In `read` mode just check for - initial lines if they start with the hash symbol, and skip them. In - `write` mode output an header that can be used to launch the file by - calling `yap -l file -- $*`. Note that YAP will not set file - permissions as executable. In `append` mode ignore the flag. + The file may be a Prolog script. In `read` mode just check for + initial lines if they start with the hash symbol, and skip them. In + `write` mode output an header that can be used to launch the file by + calling `yap -l file -- $*`. Note that YAP will not set file + permissions as executable. In `append` mode ignore the flag. - */ - static Int open4( - USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */ - return do_open(Deref(ARG1), Deref(ARG2), Deref(ARG4) 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); +static Int p_file_expansion(USES_REGS1) { /* '$file_expansion'(+File,-Name) */ + Term file_name = Deref(ARG1); - /* we know file_name is bound */ - if (IsVarTerm(file_name)) { - PlIOError(INSTANTIATION_ERROR, file_name, "absolute_file_name/3"); - return (FALSE); - } - if (!Yap_locateFile(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)))); - } + /* we know file_name is bound */ + if (IsVarTerm(file_name)) { + PlIOError(INSTANTIATION_ERROR, file_name, "absolute_file_name/3"); + return (FALSE); + } + if (!Yap_locateFile(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; +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"); + st->file = fopen("NUL", "w"); #else - st->file = fopen("/dev/null", "w"); + 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_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)); - } + 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_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) { - CACHE_REGS - int sno; - Atom at; +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; - Yap_initStream(sno, fd, name, file_name, LOCAL_encoding, flags, at); - return sno; - } + 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; + Yap_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); +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_OUTPUT_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); - } - } else if (IsApplTerm(arg) && FunctorOfTerm(arg) == FunctorStream) { - arg = ArgOfTerm(1, arg); - if (!IsVarTerm(arg) && IsIntegerTerm(arg)) { - sno = IntegerOfTerm(arg); + if (sname == AtomUser) { + if (kind & Input_Stream_f) { + if (kind & (Output_Stream_f | Append_Stream_f)) { + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, + "ambiguous use of 'user' as a stream"); + return (-1); } + sname = AtomUserIn; + } else { + sname = AtomUserOut; } - 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_OUTPUT_STREAM, arg, msg); - return -1; - } - 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_INPUT_STREAM, arg, msg); - return -1; - } - 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)) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - if (kind == Input_Stream_f) - PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, - msg); - else - PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_BINARY_STREAM, arg, - msg); - 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; - } - - /** - * @pred always_prompt_user - * - * Ensure that the stream always prompts before asking the standard input - stream for data. - - */ - 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, false); - return (TRUE); - } - - static Int close1 /** @pred close(+ _S_) is iso - - - Closes the stream _S_. If _S_ does not stand for a stream - currently opened an error is reported. The streams user_input, - user_output, and user_error can never be closed. - - - */ - - (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); + if ((sno = Yap_CheckAlias(sname)) < 0) { UNLOCK(GLOBAL_Stream[sno].streamlock); - return (TRUE); + PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg); + return -1; + } else { + LOCK(GLOBAL_Stream[sno].streamlock); } + } 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_OUTPUT_STREAM, arg, msg); + return -1; + } + 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_INPUT_STREAM, arg, msg); + return -1; + } + 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)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (kind == Input_Stream_f) + PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, + msg); + else + PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_BINARY_STREAM, arg, + msg); + 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; +} + +/** + * @pred always_prompt_user + * + * Ensure that the stream always prompts before asking the standard input + stream for data. + + */ +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, false); + return (TRUE); +} + +static Int close1 /** @pred close(+ _S_) is iso + + + Closes the stream _S_. If _S_ does not stand for a stream + currently opened an error is reported. The streams user_input, + user_output, and user_error can never be closed. + + + */ + + (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", booleanFlag, CLOSE_FORCE), PAR(NULL, ok, CLOSE_END) #define PAR(x, y, z) z - typedef enum close_enum_choices { CLOSE_DEFS() } close_choices_t; +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()}; +static const param_t close_defs[] = {CLOSE_DEFS()}; #undef PAR - /** @pred close(+ _S_,+ _O_) is iso +/** @pred close(+ _S_,+ _O_) is iso - Closes the stream _S_, following options _O_. +Closes the stream _S_, following options _O_. - The only valid options are `force(true)` and `force(false)`. - YAP currently ignores these options. +The only valid options are `force(true)` and `force(false)`. +YAP currently ignores these options. - */ - 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) { - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) - LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION; - Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); - } - return false; - return FALSE; - } - // if (args[CLOSE_FORCE].used) { - // } - Yap_CloseStream(sno); - UNLOCK(GLOBAL_Stream[sno].streamlock); - return (TRUE); +*/ +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) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_CLOSE_OPTION; + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, NULL); } + return false; + 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; +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)); - } + 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("access", isatom, ABSOLUTE_FILE_NAME_ACCESS), \ - PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \ + PAR("access", isatom, ABSOLUTE_FILE_NAME_ACCESS) \ + , PAR("expand", booleanFlag, ABSOLUTE_FILE_NAME_EXPAND), \ PAR("extensions", ok, ABSOLUTE_FILE_NAME_EXTENSIONS), \ PAR("file_errors", is_file_errors, ABSOLUTE_FILE_NAME_FILE_ERRORS), \ PAR("file_type", is_file_type, ABSOLUTE_FILE_NAME_FILE_TYPE), \ @@ -1776,146 +1761,143 @@ int PlGetc(int sno) { #define PAR(x, y, z) z - typedef enum ABSOLUTE_FILE_NAME_enum_ { - ABSOLUTE_FILE_NAME_DEFS() - } absolute_file_name_choices_t; +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()}; +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) { - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) - LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION; - Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, 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] = - gethdir(args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue); - } else { - t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(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_GLOB].used) { - t[ABSOLUTE_FILE_NAME_GLOB] = args[ABSOLUTE_FILE_NAME_GLOB].tvalue; - t[ABSOLUTE_FILE_NAME_EXPAND] = TermTrue; - } else - t[ABSOLUTE_FILE_NAME_GLOB] = TermEmptyAtom; - 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] = - (trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue - : TermFalse); - tf = Yap_MkApplTerm(Yap_MkFunctor(AtomOpt, ABSOLUTE_FILE_NAME_END), - ABSOLUTE_FILE_NAME_END, t); - return (Yap_unify(ARG2, tf)); +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) { + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + if (LOCAL_Error_TYPE == DOMAIN_ERROR_PROLOG_FLAG) + LOCAL_Error_TYPE = DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION; + Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, 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] = + gethdir(args[ABSOLUTE_FILE_NAME_RELATIVE_TO].tvalue); + } else { + t[ABSOLUTE_FILE_NAME_RELATIVE_TO] = gethdir(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_GLOB].used) { + t[ABSOLUTE_FILE_NAME_GLOB] = args[ABSOLUTE_FILE_NAME_GLOB].tvalue; + t[ABSOLUTE_FILE_NAME_EXPAND] = TermTrue; + } else + t[ABSOLUTE_FILE_NAME_GLOB] = TermEmptyAtom; + 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] = + (trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue : TermFalse); + 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 */ - int i = Yap_ArgKey(AtomOfTerm(t), absolute_file_name_search_defs, - ABSOLUTE_FILE_NAME_END); - if (i >= 0) - return Yap_unify(ARG3, ArgOfTerm(i + 1, topts)); - Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL); - return false; - } +static Int get_abs_file_parameter(USES_REGS1) { + Term t = Deref(ARG1), topts = ARG2; + /* get options */ + /* done */ + int i = Yap_ArgKey(AtomOfTerm(t), absolute_file_name_search_defs, + ABSOLUTE_FILE_NAME_END); + if (i >= 0) + return Yap_unify(ARG3, ArgOfTerm(i + 1, topts)); + Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL); + return false; +} - void Yap_InitPlIO(void) { - Int i; +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(); - } + 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_InitRandomPreds(); +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_InitRandomPreds(); #if USE_READLINE - Yap_InitReadlinePreds(); + Yap_InitReadlinePreds(); #endif - Yap_InitSockets(); - Yap_InitSignalPreds(); - Yap_InitSysPreds(); - Yap_InitTimePreds(); - } + Yap_InitSockets(); + Yap_InitSignalPreds(); + Yap_InitSysPreds(); + Yap_InitTimePreds(); +} diff --git a/os/iopreds.h b/os/iopreds.h index 732155453..27bcad48b 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -18,9 +18,9 @@ static char SccsId[] = "%W% %G%"; #define HAVE_SOCKET 1 #endif -#include -#include "Yap.h" #include "Atoms.h" +#include "Yap.h" +#include /* * This file defines main data-structure for stream management, @@ -206,12 +206,17 @@ typedef struct stream_desc { #if defined(YAPOR) || defined(THREADS) lockvar streamlock; /* protect stream access */ #endif - int (*stream_putc)(int, int); /** function the stream uses for writing a single octet */ - int (*stream_wputc)(int, int); /** function the stream uses for writing a character */ - int (*stream_getc)(int); /** function the stream uses for reading an octet. */ - int (*stream_wgetc)(int); /** function the stream uses for reading a character. */ + int (*stream_putc)( + int, int); /** function the stream uses for writing a single octet */ + int (*stream_wputc)( + int, wchar_t); /** function the stream uses for writing a character */ + int (*stream_getc)(int); /** function the stream uses for reading an octet. */ + int (*stream_wgetc)( + int); /** function the stream uses for reading a character. */ - int (*stream_wgetc_for_read)(int); /* function the stream uses for parser. It may be different from above if the ISO character conversion is on */ + int (*stream_wgetc_for_read)( + int); /* function the stream uses for parser. It may be different + from above if the ISO character conversion is on */ encoding_t encoding; /** current encoding for stream */ } StreamDesc; @@ -270,7 +275,7 @@ void Yap_ConsolePipeOps(StreamDesc *st); void Yap_SocketOps(StreamDesc *st); void Yap_ConsoleSocketOps(StreamDesc *st); bool Yap_ReadlineOps(StreamDesc *st); -int Yap_OpenBufWriteStream(USES_REGS1); +int Yap_OpenBufWriteStream(USES_REGS1); void Yap_ConsoleOps(StreamDesc *s, bool recursive); void Yap_InitRandomPreds(void); diff --git a/os/mem.c b/os/mem.c index fe3325743..6de70a98b 100644 --- a/os/mem.c +++ b/os/mem.c @@ -8,7 +8,7 @@ * * ************************************************************************** * * -* File: sockets.c * +* File: sockets.c * * Last rev: 5/2/88 * * mods: * * comments: Input/Output C implemented predicates * @@ -24,8 +24,8 @@ static char SccsId[] = "%W% %G%"; */ #include "Yap.h" -#include "Yatom.h" #include "YapHeap.h" +#include "Yatom.h" #include "yapio.h" #include #if HAVE_UNISTD_H @@ -38,13 +38,13 @@ static char SccsId[] = "%W% %G%"; #if HAVE_IO_H /* Windows */ #include -#endif +#endif #if HAVE_SOCKET #include #endif #include #ifndef S_ISDIR -#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) +#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR) #endif #endif #include "iopreds.h" @@ -52,14 +52,19 @@ static char SccsId[] = "%W% %G%"; #include "fmemopen.h" #define HAVE_FMEMOPEN 1 #define HAVE_OPEN_MEMSTREAM 1 -FILE * open_memstream (char **buf, size_t *len); +FILE *open_memstream(char **buf, size_t *len); #endif -#if HAVE_FMEMOPEN +#if __ANDROID__ +#undef HAVE_FMEMOPEN +#undef HAVE_OPEN_MEMSTREAM +#endif + +#if HAVE_FMEMOPEN #define MAY_READ 1 #endif -#if HAVE_OPEN_MEMSTREAM +#if HAVE_OPEN_MEMSTREAM #define MAY_READ 1 #define MAY_WRITE 1 #endif @@ -70,44 +75,38 @@ FILE * open_memstream (char **buf, size_t *len); #endif #if !MAY_READ -static int MemGetc( int); +static int MemGetc(int); /* read from memory */ -static int -MemGetc(int sno) -{ - register StreamDesc *s = &GLOBAL_Stream[sno]; - Int ch; - int spos; +static int MemGetc(int sno) { + register StreamDesc *s = &GLOBAL_Stream[sno]; + Int ch; + int spos; - spos = s->u.mem_string.pos; - if (spos == s->u.mem_string.max_size) { - return -1; - } - else { - ch = s->u.mem_string.buf[spos]; - s->u.mem_string.pos = ++spos; - } - return ch; + spos = s->u.mem_string.pos; + if (spos == s->u.mem_string.max_size) { + return -1; + } else { + ch = s->u.mem_string.buf[spos]; + s->u.mem_string.pos = ++spos; + } + return ch; } #endif #if !MAY_WRITE -static int MemPutc( int, int); +static int MemPutc(int, int); /* static */ -static int -MemPutc(int sno, int ch) -{ +static int MemPutc(int sno, int ch) { StreamDesc *s = &GLOBAL_Stream[sno]; #if MAC || _MSC_VER - if (ch == 10) - { - ch = '\n'; - } + if (ch == 10) { + ch = '\n'; + } #endif s->u.mem_string.buf[s->u.mem_string.pos++] = ch; - if (s->u.mem_string.pos >= s->u.mem_string.max_size -8) { + if (s->u.mem_string.pos >= s->u.mem_string.max_size - 8) { int old_src = s->u.mem_string.src, new_src; /* oops, we have reached an overflow */ @@ -115,78 +114,79 @@ MemPutc(int sno, int ch) char *newbuf; if (old_src == MEM_BUF_CODE && - (newbuf = Yap_AllocAtomSpace(new_max_size*sizeof(char))) != NULL) { + (newbuf = Yap_AllocAtomSpace(new_max_size * sizeof(char))) != NULL) { new_src = MEM_BUF_CODE; #if HAVE_MEMMOVE - memmove((void *)newbuf, (void *)s->u.mem_string.buf, (size_t)((s->u.mem_string.pos)*sizeof(char))); + memmove((void *)newbuf, (void *)s->u.mem_string.buf, + (size_t)((s->u.mem_string.pos) * sizeof(char))); #else - { - Int n = s->u.mem_string.pos; - char *to = newbuf; - char *from = s->u.mem_string.buf; - while (n-- >= 0) { - *to++ = *from++; + { + Int n = s->u.mem_string.pos; + char *to = newbuf; + char *from = s->u.mem_string.buf; + while (n-- >= 0) { + *to++ = *from++; + } } - } #endif Yap_FreeAtomSpace(s->u.mem_string.buf); #if !HAVE_SYSTEM_MALLOC - } else if ((newbuf = (ADDR)realloc(s->u.mem_string.buf, new_max_size*sizeof(char))) != NULL) { + } else if ((newbuf = (ADDR)realloc(s->u.mem_string.buf, + new_max_size * sizeof(char))) != NULL) { new_src = MEM_BUF_MALLOC; #endif } else { if (GLOBAL_Stream[sno].u.mem_string.error_handler) { - CACHE_REGS - LOCAL_Error_Size = new_max_size*sizeof(char); - save_machine_regs(); - longjmp(*(jmp_buf *)GLOBAL_Stream[sno].u.mem_string.error_handler,1); + CACHE_REGS + LOCAL_Error_Size = new_max_size * sizeof(char); + save_machine_regs(); + longjmp(*(jmp_buf *)GLOBAL_Stream[sno].u.mem_string.error_handler, 1); } else { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP could not grow heap for writing to string"); + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, + "YAP could not grow heap for writing to string"); } return -1; } - if (old_src == MEM_BUF_CODE) { + if (old_src == MEM_BUF_CODE) { } s->u.mem_string.buf = newbuf; s->u.mem_string.max_size = new_max_size; s->u.mem_string.src = new_src; } - count_output_char(ch,s); - return ((int) ch); + count_output_char(ch, s); + return ((int)ch); } #endif - - int - Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t *encp, memBufSource src) -{ +int Yap_open_buf_read_stream(const char *nbuf, size_t nchars, encoding_t *encp, + memBufSource src) { CACHE_REGS int sno; StreamDesc *st; FILE *f; encoding_t encoding; stream_flags_t flags; - + sno = GetFreeStreamD(); if (sno < 0) - return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_mem_read_stream/1")); - st = GLOBAL_Stream+sno; + return (PlIOError(RESOURCE_ERROR_MAX_STREAMS, TermNil, + "new stream not available for open_mem_read_stream/1")); + st = GLOBAL_Stream + sno; if (encp) encoding = *encp; else encoding = LOCAL_encoding; #if MAY_READ // like any file stream. - f = fmemopen( (void *)nbuf, nchars, "r"); + f = fmemopen((void *)nbuf, nchars, "r"); flags = Input_Stream_f | InMemory_Stream_f | Seekable_Stream_f; #else f = NULL; flags = Input_Stream_f | InMemory_Stream_f; #endif - Yap_initStream(sno, f, NULL, TermNil, - encoding, flags, AtomRead); - // like any file stream. + Yap_initStream(sno, f, NULL, TermNil, encoding, flags, AtomRead); +// like any file stream. #if !MAY_READ /* currently these streams are not seekable */ st->status = Input_Stream_f | InMemory_Stream_f; @@ -196,13 +196,13 @@ MemPutc(int sno, int ch) st->u.mem_string.error_handler = NULL; st->u.mem_string.src = src; #endif - Yap_MemOps( st ); + Yap_MemOps(st); UNLOCK(st->streamlock); return sno; } static Int -open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ + open_mem_read_stream(USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ { Term t, ti; int sno; @@ -222,10 +222,10 @@ open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ ti = TailOfTerm(ti); } } - while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) { - if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); - return(FALSE); + while ((nbuf = (char *)Yap_AllocAtomSpace((sl + 1) * sizeof(char))) == NULL) { + if (!Yap_growheap(FALSE, (sl + 1) * sizeof(char), NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); + return (FALSE); } } ti = Deref(ARG1); @@ -244,101 +244,96 @@ open_mem_read_stream (USES_REGS1) /* $open_mem_read_stream(+List,-Stream) */ } nbuf[nchars] = '\0'; sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE); - t = Yap_MkStream (sno); - return (Yap_unify (ARG2, t)); + t = Yap_MkStream(sno); + return (Yap_unify(ARG2, t)); } -int -Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSource sr) -{ +int Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, + memBufSource sr) { CACHE_REGS - int sno; - StreamDesc *st; + int sno; + StreamDesc *st; - - sno = GetFreeStreamD(); - if (sno < 0) - return -1; - st = GLOBAL_Stream+sno; - st->status = Output_Stream_f | InMemory_Stream_f; - if (!buf) { - if (!nchars) { - nchars = Yap_page_size; - } - buf = malloc( nchars ); - st->status |= FreeOnClose_Stream_f; + sno = GetFreeStreamD(); + if (sno < 0) + return -1; + st = GLOBAL_Stream + sno; + st->status = Output_Stream_f | InMemory_Stream_f; + if (!buf) { + if (!nchars) { + nchars = Yap_page_size; } - st->nbuf = buf; - if(!st->nbuf) { - return -1; - } - st->nsize = nchars; - st->linepos = 0; - st->charcount = 0; - st->linecount = 1; - if (encp) - st->encoding = *encp; - else - st->encoding = LOCAL_encoding; - Yap_DefaultStreamOps( st ); + buf = malloc(nchars); + st->status |= FreeOnClose_Stream_f; + } + st->nbuf = buf; + if (!st->nbuf) { + return -1; + } + st->nsize = nchars; + st->linepos = 0; + st->charcount = 0; + st->linecount = 1; + if (encp) + st->encoding = *encp; + else + st->encoding = LOCAL_encoding; + Yap_DefaultStreamOps(st); #if MAY_WRITE - st->file = open_memstream(&st->nbuf, &st->nsize); - st->status |= Seekable_Stream_f; + st->file = open_memstream(&st->nbuf, &st->nsize); + st->status |= Seekable_Stream_f; #else - st->u.mem_string.pos = 0; - st->u.mem_string.buf = st->nbuf; - st->u.mem_string.max_size = nchars; - #endif - Yap_MemOps( st ); - UNLOCK(st->streamlock); - return sno; + st->u.mem_string.pos = 0; + st->u.mem_string.buf = st->nbuf; + st->u.mem_string.max_size = nchars; +#endif + Yap_MemOps(st); + UNLOCK(st->streamlock); + return sno; } -int -Yap_OpenBufWriteStream( USES_REGS1 ) -{ +int Yap_OpenBufWriteStream(USES_REGS1) { char *nbuf; - size_t sz = Yap_page_size; + size_t sz = Yap_page_size; - - while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) { - if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) { - Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); + while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size * sizeof(char))) == + NULL) { + if (!Yap_growheap(FALSE, Yap_page_size * sizeof(char), NULL)) { + Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage); return -1; } } - return Yap_open_buf_write_stream(nbuf, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); + return Yap_open_buf_write_stream( + nbuf, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); } static Int -open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-Stream) */ + open_mem_write_stream(USES_REGS1) /* $open_mem_write_stream(-Stream) */ { Term t; int sno; - sno = Yap_OpenBufWriteStream( PASS_REGS1 ); + sno = Yap_OpenBufWriteStream(PASS_REGS1); if (sno == -1) - return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "new stream not available for open_mem_read_stream/1")); - t = Yap_MkStream (sno); - return (Yap_unify (ARG1, t)); + return (PlIOError(SYSTEM_ERROR_INTERNAL, TermNil, + "new stream not available for open_mem_read_stream/1")); + t = Yap_MkStream(sno); + return (Yap_unify(ARG1, t)); } -/** +/** * Yap_PeekMemwriteStream() shows the current buffer for a memory stream. - * + * * @param sno, the in-memory stream - * + * * @return temporary buffer, discarded by close and may be moved away * by other writes.. */ -char * -Yap_MemExportStreamPtr( int sno ) -{ +char *Yap_MemExportStreamPtr(int sno) { #if MAY_WRITE char *s; - if (fflush(GLOBAL_Stream[sno].file) == 0) - { - s = GLOBAL_Stream[sno].nbuf; + if (fflush(GLOBAL_Stream[sno].file) == 0) { + s = GLOBAL_Stream[sno].nbuf; return s; } return NULL; @@ -347,11 +342,10 @@ Yap_MemExportStreamPtr( int sno ) #endif } - -static Int -peek_mem_write_stream ( USES_REGS1 ) -{ /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */ - Int sno = Yap_CheckStream (ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2"); +static Int peek_mem_write_stream( + USES_REGS1) { /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */ + Int sno = + Yap_CheckStream(ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2"); Int i; Term tf = ARG2; CELL *HI; @@ -359,27 +353,27 @@ peek_mem_write_stream ( USES_REGS1 ) if (sno < 0) return (FALSE); - restart: +restart: HI = HR; #if MAY_WRITE if (fflush(GLOBAL_Stream[sno].file) == 0) { - ptr = GLOBAL_Stream[sno].nbuf; - i = GLOBAL_Stream[sno].nsize; - } + ptr = GLOBAL_Stream[sno].nbuf; + i = GLOBAL_Stream[sno].nsize; + } #else - ptr = GLOBAL_Stream[sno].u.mem_string.buf; - i = GLOBAL_Stream[sno].u.mem_string.pos; + ptr = GLOBAL_Stream[sno].u.mem_string.buf; + i = GLOBAL_Stream[sno].u.mem_string.pos; #endif while (i > 0) { --i; - tf = MkPairTerm(MkIntTerm(ptr[i]),tf); + tf = MkPairTerm(MkIntTerm(ptr[i]), tf); if (HR + 1024 >= ASP) { UNLOCK(GLOBAL_Stream[sno].streamlock); HR = HI; - if (!Yap_gcl((ASP-HI)*sizeof(CELL), 3, ENV, Yap_gcP()) ) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return(FALSE); + if (!Yap_gcl((ASP - HI) * sizeof(CELL), 3, ENV, Yap_gcP())) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); + return (FALSE); } i = GLOBAL_Stream[sno].u.mem_string.pos; tf = ARG2; @@ -388,16 +382,14 @@ peek_mem_write_stream ( USES_REGS1 ) } } UNLOCK(GLOBAL_Stream[sno].streamlock); - return (Yap_unify(ARG3,tf)); + return (Yap_unify(ARG3, tf)); } -void - Yap_MemOps( StreamDesc *st ) -{ +void Yap_MemOps(StreamDesc *st) { #if MAY_WRITE st->stream_putc = FilePutc; #else - st->stream_putc = MemPutc; + st->stream_putc = MemPutc; #endif #if MAY_READ @@ -407,44 +399,42 @@ void #endif } -bool Yap_CloseMemoryStream( int sno ) -{ - if (!(GLOBAL_Stream[sno].status & Output_Stream_f) ) { +bool Yap_CloseMemoryStream(int sno) { + if (!(GLOBAL_Stream[sno].status & Output_Stream_f)) { #if MAY_WRITE - fclose(GLOBAL_Stream[sno].file); - if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f) - free( GLOBAL_Stream[sno].nbuf ); -#else - 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); - } -#endif - } else { -#if MAY_READ - fclose(GLOBAL_Stream[sno].file); - Yap_FreeAtomSpace(GLOBAL_Stream[sno].nbuf); + fclose(GLOBAL_Stream[sno].file); + if (GLOBAL_Stream[sno].status & FreeOnClose_Stream_f) + free(GLOBAL_Stream[sno].nbuf); #else - if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) + 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); } -#endif - } - return true; +#endif + } else { +#if MAY_READ + fclose(GLOBAL_Stream[sno].file); + Yap_FreeAtomSpace(GLOBAL_Stream[sno].nbuf); +#else + 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); + } +#endif + } + return true; } -void -Yap_InitMems( void ) -{ - CACHE_REGS +void Yap_InitMems(void) { + CACHE_REGS Term cm = CurrentModule; CurrentModule = CHARSIO_MODULE; - Yap_InitCPred ("open_mem_read_stream", 2, open_mem_read_stream, SyncPredFlag); - Yap_InitCPred ("open_mem_write_stream", 1, open_mem_write_stream, SyncPredFlag); - Yap_InitCPred ("peek_mem_write_stream", 3, peek_mem_write_stream, SyncPredFlag); + Yap_InitCPred("open_mem_read_stream", 2, open_mem_read_stream, SyncPredFlag); + Yap_InitCPred("open_mem_write_stream", 1, open_mem_write_stream, + SyncPredFlag); + Yap_InitCPred("peek_mem_write_stream", 3, peek_mem_write_stream, + SyncPredFlag); CurrentModule = cm; } - diff --git a/os/sig.c b/os/sig.c index 0dfa7e304..5e2e6c6bb 100644 --- a/os/sig.c +++ b/os/sig.c @@ -5,188 +5,175 @@ #ifdef MSH -#define SIGFPE SIGDIV +#define SIGFPE SIGDIV #endif -static void HandleMatherr(int sig, void *sipv, void *uapv); +static void HandleMatherr(int sig, void *sipv, void *uapv); -#define PLSIG_PREPARED 0x01 /* signal is prepared */ -#define PLSIG_THROW 0x02 /* throw signal(num, name) */ -#define PLSIG_SYNC 0x04 /* call synchronously */ -#define PLSIG_NOFRAME 0x08 /* Do not create a Prolog frame */ +#define PLSIG_PREPARED 0x01 /* signal is prepared */ +#define PLSIG_THROW 0x02 /* throw signal(num, name) */ +#define PLSIG_SYNC 0x04 /* call synchronously */ +#define PLSIG_NOFRAME 0x08 /* Do not create a Prolog frame */ -#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */ +#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */ -#define SIG_EXCEPTION (SIG_PROLOG_OFFSET+0) +#define SIG_EXCEPTION (SIG_PROLOG_OFFSET + 0) #ifdef ATOMGC -#define SIG_ATOM_GC (SIG_PROLOG_OFFSET+1) +#define SIG_ATOM_GC (SIG_PROLOG_OFFSET + 1) #endif -#define SIG_GC (SIG_PROLOG_OFFSET+2) +#define SIG_GC (SIG_PROLOG_OFFSET + 2) #ifdef THREADS -#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET+3) +#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3) #endif -#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4) -#define SIG_PLABORT (SIG_PROLOG_OFFSET+5) +#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET + 4) +#define SIG_PLABORT (SIG_PROLOG_OFFSET + 5) -static struct signame -{ int sig; +static struct signame { + int sig; const char *name; - int flags; -} signames[] = - { + int flags; +} signames[] = { #ifdef SIGHUP - { SIGHUP, "hup", 0}, + {SIGHUP, "hup", 0}, #endif - { SIGINT, "int", 0}, + {SIGINT, "int", 0}, #ifdef SIGQUIT - { SIGQUIT, "quit", 0}, + {SIGQUIT, "quit", 0}, #endif - { SIGILL, "ill", 0}, - { SIGABRT, "abrt", 0}, + {SIGILL, "ill", 0}, + {SIGABRT, "abrt", 0}, #if HAVE_SIGFPE - { SIGFPE, "fpe", PLSIG_THROW}, + {SIGFPE, "fpe", PLSIG_THROW}, #endif #ifdef SIGKILL - { SIGKILL, "kill", 0}, + {SIGKILL, "kill", 0}, #endif - { SIGSEGV, "segv", 0}, + {SIGSEGV, "segv", 0}, #ifdef SIGPIPE - { SIGPIPE, "pipe", 0}, + {SIGPIPE, "pipe", 0}, #endif #ifdef SIGALRM - { SIGALRM, "alrm", PLSIG_THROW}, + {SIGALRM, "alrm", PLSIG_THROW}, #endif - { SIGTERM, "term", 0}, + {SIGTERM, "term", 0}, #ifdef SIGUSR1 - { SIGUSR1, "usr1", 0}, + {SIGUSR1, "usr1", 0}, #endif #ifdef SIGUSR2 - { SIGUSR2, "usr2", 0}, + {SIGUSR2, "usr2", 0}, #endif #ifdef SIGCHLD - { SIGCHLD, "chld", 0}, + {SIGCHLD, "chld", 0}, #endif #ifdef SIGCONT - { SIGCONT, "cont", 0}, + {SIGCONT, "cont", 0}, #endif #ifdef SIGSTOP - { SIGSTOP, "stop", 0}, + {SIGSTOP, "stop", 0}, #endif #ifdef SIGTSTP - { SIGTSTP, "tstp", 0}, + {SIGTSTP, "tstp", 0}, #endif #ifdef SIGTTIN - { SIGTTIN, "ttin", 0}, + {SIGTTIN, "ttin", 0}, #endif #ifdef SIGTTOU - { SIGTTOU, "ttou", 0}, + {SIGTTOU, "ttou", 0}, #endif #ifdef SIGTRAP - { SIGTRAP, "trap", 0}, + {SIGTRAP, "trap", 0}, #endif #ifdef SIGBUS - { SIGBUS, "bus", 0}, + {SIGBUS, "bus", 0}, #endif #ifdef SIGSTKFLT - { SIGSTKFLT, "stkflt", 0}, + {SIGSTKFLT, "stkflt", 0}, #endif #ifdef SIGURG - { SIGURG, "urg", 0}, + {SIGURG, "urg", 0}, #endif #ifdef SIGIO - { SIGIO, "io", 0}, + {SIGIO, "io", 0}, #endif #ifdef SIGPOLL - { SIGPOLL, "poll", 0}, + {SIGPOLL, "poll", 0}, #endif #ifdef SIGXCPU - { SIGXCPU, "xcpu", PLSIG_THROW}, + {SIGXCPU, "xcpu", PLSIG_THROW}, #endif #ifdef SIGXFSZ - { SIGXFSZ, "xfsz", PLSIG_THROW}, + {SIGXFSZ, "xfsz", PLSIG_THROW}, #endif #ifdef SIGVTALRM - { SIGVTALRM, "vtalrm", PLSIG_THROW}, + {SIGVTALRM, "vtalrm", PLSIG_THROW}, #endif #ifdef SIGPROF - { SIGPROF, "prof", 0}, + {SIGPROF, "prof", 0}, #endif #ifdef SIGPWR - { SIGPWR, "pwr", 0}, + {SIGPWR, "pwr", 0}, #endif - { SIG_EXCEPTION, "prolog:exception", 0 }, + {SIG_EXCEPTION, "prolog:exception", 0}, #ifdef SIG_ATOM_GC - { SIG_ATOM_GC, "prolog:atom_gc", 0 }, + {SIG_ATOM_GC, "prolog:atom_gc", 0}, #endif - { SIG_GC, "prolog:gc", 0 }, + {SIG_GC, "prolog:gc", 0}, #ifdef SIG_THREAD_SIGNAL - { SIG_THREAD_SIGNAL, "prolog:thread_signal", 0 }, + {SIG_THREAD_SIGNAL, "prolog:thread_signal", 0}, #endif - { -1, NULL, 0} - }; + {-1, NULL, 0}}; typedef void (*signal_handler_t)(int, void *, void *); #if HAVE_SIGACTION -static void -my_signal_info(int sig, void * handler) -{ +static void my_signal_info(int sig, void *handler) { struct sigaction sigact; sigact.sa_handler = handler; sigemptyset(&sigact.sa_mask); sigact.sa_flags = SA_SIGINFO; - sigaction(sig,&sigact,NULL); + sigaction(sig, &sigact, NULL); } -static void -my_signal(int sig, void * handler) -{ +static void my_signal(int sig, void *handler) { struct sigaction sigact; - sigact.sa_handler= (void *)handler; + sigact.sa_handler = (void *)handler; sigemptyset(&sigact.sa_mask); sigact.sa_flags = 0; - sigaction(sig,&sigact,NULL); + sigaction(sig, &sigact, NULL); } #else -static void -my_signal(int sig, void *handler) -{ - signal(sig, handler); -} +static void my_signal(int sig, void *handler) { signal(sig, handler); } -static void -my_signal_info(int sig, void *handler) -{ - if(signal(sig, (void *)handler) == SIG_ERR) +static void my_signal_info(int sig, void *handler) { + if (signal(sig, (void *)handler) == SIG_ERR) exit(1); } #endif - /* SWI emulation */ -int -Yap_signal_index(const char *name) -{ struct signame *sn = signames; +int Yap_signal_index(const char *name) { + struct signame *sn = signames; char tmp[12]; - if ( strncmp(name, "SIG", 3) == 0 && strlen(name) < 12 ) - { char *p = (char *)name+3, *q = tmp; - while ((*q++ = tolower(*p++))) {}; - name = tmp; - } + if (strncmp(name, "SIG", 3) == 0 && strlen(name) < 12) { + char *p = (char *)name + 3, *q = tmp; + while ((*q++ = tolower(*p++))) { + }; + name = tmp; + } - for( ; sn->name; sn++ ) - { if ( !strcmp(sn->name, name) ) - return sn->sig; - } + for (; sn->name; sn++) { + if (!strcmp(sn->name, name)) + return sn->sig; + } return -1; } @@ -199,51 +186,47 @@ Yap_signal_index(const char *name) #endif #if HAVE_SIGSEGV -static void -SearchForTrailFault(void *ptr, int sure) -{ +static void SearchForTrailFault(void *ptr, int sure) { - /* If the TRAIL is very close to the top of mmaped allocked space, - then we can try increasing the TR space and restarting the - instruction. In the worst case, the system will - crash again - */ -#if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC - if ((ptr > (void *)LOCAL_TrailTop-1024 && - TR < (tr_fr_ptr) LOCAL_TrailTop+(64*1024))) { - if (!Yap_growtrail(64*1024, TRUE)) { - Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, "YAP failed to reserve %ld bytes in growtrail", K64); +/* If the TRAIL is very close to the top of mmaped allocked space, + then we can try increasing the TR space and restarting the + instruction. In the worst case, the system will + crash again +*/ +#if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC + if ((ptr > (void *)LOCAL_TrailTop - 1024 && + TR < (tr_fr_ptr)LOCAL_TrailTop + (64 * 1024))) { + if (!Yap_growtrail(64 * 1024, TRUE)) { + Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, + "YAP failed to reserve %ld bytes in growtrail", K64); } /* just in case, make sure the OS keeps the signal handler. */ /* my_signal_info(SIGSEGV, HandleSIGSEGV); */ } else #endif /* OS_HANDLES_TR_OVERFLOW */ - if (sure) - Yap_Error(SYSTEM_ERROR_FATAL, TermNil, - "tried to access illegal address %p!!!!", ptr); - else - Yap_Error(SYSTEM_ERROR_FATAL, TermNil, - "likely bug in YAP, segmentation violation"); + if (sure) + Yap_Error(SYSTEM_ERROR_FATAL, TermNil, + "tried to access illegal address %p!!!!", ptr); + else + Yap_Error(SYSTEM_ERROR_FATAL, TermNil, + "likely bug in YAP, segmentation violation"); } - /* This routine believes there is a continuous space starting from the HeapBase and ending on TrailTop */ -static void -HandleSIGSEGV(int sig, void *sipv, void *uap) -{ +static void HandleSIGSEGV(int sig, void *sipv, void *uap) { CACHE_REGS - void *ptr = TR; + void *ptr = TR; int sure = FALSE; if (LOCAL_PrologMode & ExtendStackMode) { - Yap_Error(SYSTEM_ERROR_FATAL, TermNil, "OS memory allocation crashed at address %p, bailing out\n",LOCAL_TrailTop); + Yap_Error(SYSTEM_ERROR_FATAL, TermNil, + "OS memory allocation crashed at address %p, bailing out\n", + LOCAL_TrailTop); } #if (defined(__svr4__) || defined(__SVR4)) siginfo_t *sip = sipv; - if ( - sip->si_code != SI_NOINFO && - sip->si_code == SEGV_MAPERR) { + if (sip->si_code != SI_NOINFO && sip->si_code == SEGV_MAPERR) { ptr = sip->si_addr; sure = TRUE; } @@ -252,7 +235,7 @@ HandleSIGSEGV(int sig, void *sipv, void *uap) ptr = sip->si_addr; sure = TRUE; #endif - SearchForTrailFault( ptr, sure ); + SearchForTrailFault(ptr, sure); } #endif /* SIGSEGV */ @@ -262,25 +245,26 @@ HandleSIGSEGV(int sig, void *sipv, void *uap) #include #endif -/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */ -static bool -set_fpu_exceptions(Term flag) -{ +/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend + * it is not. */ +static bool set_fpu_exceptions(Term flag) { if (flag == TermTrue) { #if HAVE_FESETEXCEPTFLAG fexcept_t excepts; - return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0; + return fesetexceptflag(&excepts, + FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW) == 0; #elif HAVE_FEENABLEEXCEPT /* I shall ignore de-normalization and precision errors */ - feenableexcept(FE_DIVBYZERO| FE_INVALID|FE_OVERFLOW); + feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW); #elif _WIN32 // Enable zero-divide, overflow and underflow exception - _controlfp_s(0, ~(_EM_ZERODIVIDE|_EM_UNDERFLOW|_EM_OVERFLOW), _MCW_EM); // Line B + _controlfp_s(0, ~(_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW), + _MCW_EM); // Line B #elif defined(__hpux) -# if HAVE_FESETTRAPENABLE +#if HAVE_FESETTRAPENABLE /* From HP-UX 11.0 onwards: */ - fesettrapenable(FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW|FE_UNDERFLOW); -# else + fesettrapenable(FE_INVALID | FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW); +#else /* Up until HP-UX 10.20: FP_X_INV invalid operation exceptions @@ -290,22 +274,23 @@ set_fpu_exceptions(Term flag) FP_X_IMP imprecise (inexact result) FP_X_CLEAR simply zero to clear all flags */ - fpsetmask(FP_X_INV|FP_X_DZ|FP_X_OFL|FP_X_UFL); -# endif + fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL | FP_X_UFL); +#endif #endif /* __hpux */ #if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__) /* I shall ignore denormalization and precision errors */ - int v = _FPU_IEEE & ~(_FPU_MASK_IM|_FPU_MASK_ZM|_FPU_MASK_OM|_FPU_MASK_UM); + int v = _FPU_IEEE & + ~(_FPU_MASK_IM | _FPU_MASK_ZM | _FPU_MASK_OM | _FPU_MASK_UM); _FPU_SETCW(v); #endif #if HAVE_FETESTEXCEPT feclearexcept(FE_ALL_EXCEPT); #endif #ifdef HAVE_SIGFPE - my_signal (SIGFPE, HandleMatherr); + my_signal(SIGFPE, HandleMatherr); #endif } else { - /* do IEEE arithmetic in the way the big boys do */ +/* do IEEE arithmetic in the way the big boys do */ #if HAVE_FESETEXCEPTFLAG fexcept_t excepts; return fesetexceptflag(&excepts, 0) == 0; @@ -314,13 +299,14 @@ set_fpu_exceptions(Term flag) feenableexcept(0); #elif _WIN32 // Enable zero-divide, overflow and underflow exception - _controlfp_s(0, (_EM_ZERODIVIDE|_EM_UNDERFLOW|_EM_OVERFLOW), _MCW_EM); // Line B + _controlfp_s(0, (_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW), + _MCW_EM); // Line B #elif defined(__hpux) -# if HAVE_FESETTRAPENABLE +#if HAVE_FESETTRAPENABLE fesettrapenable(FE_ALL_EXCEPT); -# else +#else fpsetmask(FP_X_CLEAR); -# endif +#endif #endif /* __hpux */ #if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__) /* this will probably not work in older releases of Linux */ @@ -328,39 +314,32 @@ set_fpu_exceptions(Term flag) _FPU_SETCW(v); #endif #ifdef HAVE_SIGFPE - my_signal (SIGFPE, SIG_IGN); + my_signal(SIGFPE, SIG_IGN); #endif } return true; } -bool -Yap_set_fpu_exceptions(Term flag) -{ - return set_fpu_exceptions(flag); -} +bool Yap_set_fpu_exceptions(Term flag) { return set_fpu_exceptions(flag); } - -yap_error_number -Yap_MathException__( USES_REGS1 ) -{ +yap_error_number Yap_MathException__(USES_REGS1) { #if HAVE_FETESTEXCEPT int raised; // #pragma STDC FENV_ACCESS ON - if ((raised = fetestexcept( FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW)) ) { + if ((raised = fetestexcept(FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW))) { feclearexcept(FE_ALL_EXCEPT); if (raised & FE_OVERFLOW) { - return EVALUATION_ERROR_FLOAT_OVERFLOW; + return EVALUATION_ERROR_FLOAT_OVERFLOW; } else if (raised & FE_DIVBYZERO) { - return EVALUATION_ERROR_ZERO_DIVISOR; + return EVALUATION_ERROR_ZERO_DIVISOR; } else if (raised & FE_UNDERFLOW) { - return EVALUATION_ERROR_FLOAT_UNDERFLOW; + return EVALUATION_ERROR_FLOAT_UNDERFLOW; //} else if (raised & (FE_INVALID|FE_INEXACT)) { // return EVALUATION_ERROR_UNDEFINED; } else { - return EVALUATION_ERROR_UNDEFINED; + return EVALUATION_ERROR_UNDEFINED; } } #elif _WIN32 @@ -370,24 +349,24 @@ Yap_MathException__( USES_REGS1 ) // Show original FP control word and do calculation. err = _controlfp_s(&raised, 0, 0); if (err) { - return EVALUATION_ERROR_UNDEFINED; + return EVALUATION_ERROR_UNDEFINED; } - if (raised ) { + if (raised) { feclearexcept(FE_ALL_EXCEPT); if (raised & FE_OVERFLOW) { - return EVALUATION_ERROR_FLOAT_OVERFLOW; + return EVALUATION_ERROR_FLOAT_OVERFLOW; } else if (raised & FE_DIVBYZERO) { - return EVALUATION_ERROR_ZERO_DIVISOR; + return EVALUATION_ERROR_ZERO_DIVISOR; } else if (raised & FE_UNDERFLOW) { - return EVALUATION_ERROR_FLOAT_UNDERFLOW; + return EVALUATION_ERROR_FLOAT_UNDERFLOW; //} else if (raised & (FE_INVALID|FE_INEXACT)) { // return EVALUATION_ERROR_UNDEFINED; } else { - return EVALUATION_ERROR_UNDEFINED; + return EVALUATION_ERROR_UNDEFINED; } } #elif (defined(__svr4__) || defined(__SVR4)) - switch(sip->si_code) { + switch (sip->si_code) { case FPE_INTDIV: return EVALUATION_ERROR_ZERO_DIVISOR; break; @@ -415,9 +394,7 @@ Yap_MathException__( USES_REGS1 ) return LOCAL_matherror; } -static Int -p_fpe_error( USES_REGS1 ) -{ +static Int fpe_error(USES_REGS1) { Yap_Error(LOCAL_matherror, LOCAL_mathtt, LOCAL_mathstring); LOCAL_matherror = YAP_NO_ERROR; LOCAL_mathtt = TermNil; @@ -425,529 +402,490 @@ p_fpe_error( USES_REGS1 ) return FALSE; } -static void -HandleMatherr(int sig, void *sipv, void *uapv) -{ +static void HandleMatherr(int sig, void *sipv, void *uapv) { CACHE_REGS - LOCAL_matherror = Yap_MathException( ); + LOCAL_matherror = Yap_MathException(); /* reset the registers so that we don't have trash in abstract machine */ - Yap_external_signal( worker_id, YAP_FPE_SIGNAL ); + Yap_external_signal(worker_id, YAP_FPE_SIGNAL); } #endif /* SIGFPE */ - - #if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT) -static RETSIGTYPE -ReceiveSignal (int s, void *x, void *y) -{ +static RETSIGTYPE ReceiveSignal(int s, void *x, void *y) { CACHE_REGS - LOCAL_PrologMode |= InterruptMode; - my_signal (s, ReceiveSignal); - switch (s) - { - case SIGINT: - // always direct SIGINT to console - Yap_external_signal( 0, YAP_INT_SIGNAL ); - break; - case SIGALRM: - Yap_external_signal( worker_id, YAP_ALARM_SIGNAL ); - break; - case SIGVTALRM: - Yap_external_signal( worker_id, YAP_VTALARM_SIGNAL ); - break; + LOCAL_PrologMode |= InterruptMode; + my_signal(s, ReceiveSignal); + switch (s) { + case SIGINT: + // always direct SIGINT to console + Yap_external_signal(0, YAP_INT_SIGNAL); + break; + case SIGALRM: + Yap_external_signal(worker_id, YAP_ALARM_SIGNAL); + break; + case SIGVTALRM: + Yap_external_signal(worker_id, YAP_VTALARM_SIGNAL); + break; #ifndef MPW #ifdef HAVE_SIGFPE - case SIGFPE: - Yap_external_signal( worker_id, YAP_FPE_SIGNAL ); - break; + case SIGFPE: + Yap_external_signal(worker_id, YAP_FPE_SIGNAL); + break; #endif #endif #if !defined(LIGHT) && !defined(_WIN32) - /* These signals are not handled by WIN32 and not the Macintosh */ - case SIGQUIT: - case SIGKILL: - LOCAL_PrologMode &= ~InterruptMode; - Yap_Error(INTERRUPT_EVENT,MkIntTerm(s),NULL); - break; + /* These signals are not handled by WIN32 and not the Macintosh */ + case SIGQUIT: + case SIGKILL: + LOCAL_PrologMode &= ~InterruptMode; + Yap_Error(INTERRUPT_EVENT, MkIntTerm(s), NULL); + break; #endif #ifdef SIGUSR1 - case SIGUSR1: - /* force the system to creep */ - Yap_external_signal ( worker_id, YAP_USR1_SIGNAL); - break; + case SIGUSR1: + /* force the system to creep */ + Yap_external_signal(worker_id, YAP_USR1_SIGNAL); + break; #endif /* defined(SIGUSR1) */ #ifdef SIGUSR2 - case SIGUSR2: - /* force the system to creep */ - Yap_external_signal ( worker_id, YAP_USR2_SIGNAL); - break; + case SIGUSR2: + /* force the system to creep */ + Yap_external_signal(worker_id, YAP_USR2_SIGNAL); + break; #endif /* defined(SIGUSR2) */ #ifdef SIGPIPE - case SIGPIPE: - /* force the system to creep */ - Yap_external_signal ( worker_id, YAP_PIPE_SIGNAL); - break; + case SIGPIPE: + /* force the system to creep */ + Yap_external_signal(worker_id, YAP_PIPE_SIGNAL); + break; #endif /* defined(SIGPIPE) */ #ifdef SIGHUP - case SIGHUP: - /* force the system to creep */ - /* Just ignore SUGHUP Yap_signal (YAP_HUP_SIGNAL); */ - break; + case SIGHUP: + /* force the system to creep */ + /* Just ignore SUGHUP Yap_signal (YAP_HUP_SIGNAL); */ + break; #endif /* defined(SIGHUP) */ - default: - fprintf(stderr, "\n[ Unexpected signal ]\n"); - exit (s); - } + default: + fprintf(stderr, "\n[ Unexpected signal ]\n"); + exit(s); + } LOCAL_PrologMode &= ~InterruptMode; } #endif #if (_MSC_VER || defined(__MINGW32__)) -static BOOL WINAPI -MSCHandleSignal(DWORD dwCtrlType) { +static BOOL WINAPI MSCHandleSignal(DWORD dwCtrlType) { if ( #if THREADS REMOTE_InterruptsDisabled(0) -#else +#else LOCAL_InterruptsDisabled #endif - ) { + ) { return FALSE; } - switch(dwCtrlType) { - case CTRL_C_EVENT: - case CTRL_BREAK_EVENT: + switch (dwCtrlType) { + case CTRL_C_EVENT: + case CTRL_BREAK_EVENT: #if THREADS - Yap_external_signal(0, YAP_WINTIMER_SIGNAL); - REMOTE_PrologMode(0) |= InterruptMode; + Yap_external_signal(0, YAP_WINTIMER_SIGNAL); + REMOTE_PrologMode(0) |= InterruptMode; #else - Yap_signal(YAP_WINTIMER_SIGNAL); - LOCAL_PrologMode |= InterruptMode; + Yap_signal(YAP_WINTIMER_SIGNAL); + LOCAL_PrologMode |= InterruptMode; #endif - return(TRUE); - default: - return(FALSE); - } + return (TRUE); + default: + return (FALSE); } +} #endif - - /* SIGINT can cause problems, if caught before full initialization */ - void - Yap_InitOSSignals (int wid) - { - if (GLOBAL_PrologShouldHandleInterrupts) { +/* SIGINT can cause problems, if caught before full initialization */ +void Yap_InitOSSignals(int wid) { + if (GLOBAL_PrologShouldHandleInterrupts) { #if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT) - my_signal (SIGQUIT, ReceiveSignal); - my_signal (SIGKILL, ReceiveSignal); - my_signal (SIGUSR1, ReceiveSignal); - my_signal (SIGUSR2, ReceiveSignal); - my_signal (SIGHUP, ReceiveSignal); - my_signal (SIGALRM, ReceiveSignal); - my_signal (SIGVTALRM, ReceiveSignal); + my_signal(SIGQUIT, ReceiveSignal); + my_signal(SIGKILL, ReceiveSignal); + my_signal(SIGUSR1, ReceiveSignal); + my_signal(SIGUSR2, ReceiveSignal); + my_signal(SIGHUP, ReceiveSignal); + my_signal(SIGALRM, ReceiveSignal); + my_signal(SIGVTALRM, ReceiveSignal); #endif #ifdef SIGPIPE - my_signal (SIGPIPE, ReceiveSignal); + my_signal(SIGPIPE, ReceiveSignal); #endif #if _MSC_VER || defined(__MINGW32__) - signal (SIGINT, SIG_IGN); - SetConsoleCtrlHandler(MSCHandleSignal,TRUE); + signal(SIGINT, SIG_IGN); + SetConsoleCtrlHandler(MSCHandleSignal, TRUE); #else - my_signal (SIGINT, ReceiveSignal); + my_signal(SIGINT, ReceiveSignal); #endif #ifdef HAVE_SIGFPE - my_signal (SIGFPE, HandleMatherr); + my_signal(SIGFPE, HandleMatherr); #endif #if HAVE_SIGSEGV - my_signal_info (SIGSEGV, HandleSIGSEGV); + my_signal_info(SIGSEGV, HandleSIGSEGV); #endif #ifdef YAPOR_COW - signal(SIGCHLD, SIG_IGN); /* avoid ghosts */ + signal(SIGCHLD, SIG_IGN); /* avoid ghosts */ #endif - } } +} #endif /* HAVE_SIGNAL */ - - /* wrapper for alarm system call */ +/* wrapper for alarm system call */ #if _MSC_VER || defined(__MINGW32__) - static DWORD WINAPI - DoTimerThread(LPVOID targ) - { - Int *time = (Int *)targ; - HANDLE htimer; - LARGE_INTEGER liDueTime; +static DWORD WINAPI DoTimerThread(LPVOID targ) { + Int *time = (Int *)targ; + HANDLE htimer; + LARGE_INTEGER liDueTime; - htimer = CreateWaitableTimer(NULL, FALSE, NULL); - liDueTime.QuadPart = -10000000; - liDueTime.QuadPart *= time[0]; - /* add time in usecs */ - liDueTime.QuadPart -= time[1]*10; - /* Copy the relative time into a LARGE_INTEGER. */ - if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) { - return(FALSE); - } - if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0) - fprintf(stderr,"WaitForSingleObject failed (%ld)\n", GetLastError()); - Yap_signal (YAP_WINTIMER_SIGNAL); - /* now, say what is going on */ - Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue)); - ExitThread(1); + htimer = CreateWaitableTimer(NULL, FALSE, NULL); + liDueTime.QuadPart = -10000000; + liDueTime.QuadPart *= time[0]; + /* add time in usecs */ + liDueTime.QuadPart -= time[1] * 10; + /* Copy the relative time into a LARGE_INTEGER. */ + if (SetWaitableTimer(htimer, &liDueTime, 0, NULL, NULL, 0) == 0) { + return (FALSE); + } + if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0) + fprintf(stderr, "WaitForSingleObject failed (%ld)\n", GetLastError()); + Yap_signal(YAP_WINTIMER_SIGNAL); + /* now, say what is going on */ + Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue)); + ExitThread(1); #if _MSC_VER - return(0L); + return (0L); #endif - } +} #endif - static Int - enable_interrupts( USES_REGS1 ) - { - LOCAL_InterruptsDisabled--; - if (LOCAL_Signals && !LOCAL_InterruptsDisabled) { - CreepFlag = Unsigned(LCL0); - if ( !Yap_only_has_signal( YAP_CREEP_SIGNAL ) ) - EventFlag = Unsigned( LCL0 ); - } - return TRUE; +static Int enable_interrupts(USES_REGS1) { + LOCAL_InterruptsDisabled--; + if (LOCAL_Signals && !LOCAL_InterruptsDisabled) { + CreepFlag = Unsigned(LCL0); + if (!Yap_only_has_signal(YAP_CREEP_SIGNAL)) + EventFlag = Unsigned(LCL0); } + return TRUE; +} - static Int - disable_interrupts( USES_REGS1 ) - { - LOCAL_InterruptsDisabled++; - CalculateStackGap( PASS_REGS1 ); - return TRUE; +static Int disable_interrupts(USES_REGS1) { + LOCAL_InterruptsDisabled++; + CalculateStackGap(PASS_REGS1); + return TRUE; +} + +static Int alarm4(USES_REGS1) { + Term t = Deref(ARG1); + Term t2 = Deref(ARG2); + Int i1, i2; + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); + return (FALSE); } - - static Int - alarm4( USES_REGS1 ) - { - Term t = Deref(ARG1); - Term t2 = Deref(ARG2); - Int i1, i2; - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2"); - return(FALSE); - } - i1 = IntegerOfTerm(t); - i2 = IntegerOfTerm(t2); - if (i1 == 0 && i2 == 0) { + if (!IsIntegerTerm(t)) { + Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); + return (FALSE); + } + if (IsVarTerm(t2)) { + Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2"); + return (FALSE); + } + if (!IsIntegerTerm(t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2"); + return (FALSE); + } + i1 = IntegerOfTerm(t); + i2 = IntegerOfTerm(t2); + if (i1 == 0 && i2 == 0) { #if _WIN32 - Yap_get_signal( YAP_WINTIMER_SIGNAL ); + Yap_get_signal(YAP_WINTIMER_SIGNAL); #else - Yap_get_signal( YAP_ALARM_SIGNAL ); -#endif - } -#if _MSC_VER || defined(__MINGW32__) - { - Term tout; - Int time[2]; - - time[0] = i1; - time[1] = i2; - - if (time[0] != 0 && time[1] != 0) { - DWORD dwThreadId; - HANDLE hThread; - - hThread = CreateThread( - NULL, /* no security attributes */ - 0, /* use default stack size */ - DoTimerThread, /* thread function */ - (LPVOID)time, /* argument to thread function */ - 0, /* use default creation flags */ - &dwThreadId); /* returns the thread identifier */ - - /* Check the return value for success. */ - if (hThread == NULL) { - Yap_WinError("trying to use alarm"); - } - } - tout = MkIntegerTerm(0); - return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)); - } -#elif HAVE_SETITIMER && !SUPPORT_CONDOR - { - struct itimerval new, old; - - new.it_interval.tv_sec = 0; - new.it_interval.tv_usec = 0; - new.it_value.tv_sec = i1; - new.it_value.tv_usec = i2; - if (setitimer(ITIMER_REAL, &new, &old) < 0) { -#if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s", strerror(errno)); -#else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno); -#endif - return FALSE; - } - return Yap_unify(ARG3,MkIntegerTerm(old.it_value.tv_sec)) && - Yap_unify(ARG4,MkIntegerTerm(old.it_value.tv_usec)); - } -#elif HAVE_ALARM && !SUPPORT_CONDOR - { - Int left; - Term tout; - - left = alarm(i1); - tout = MkIntegerTerm(left); - return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)) ; - } -#else - /* not actually trying to set the alarm */ - if (IntegerOfTerm(t) == 0) - return TRUE; - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "alarm not available in this configuration"); - return FALSE; + Yap_get_signal(YAP_ALARM_SIGNAL); #endif } - - static Int - virtual_alarm( USES_REGS1 ) +#if _MSC_VER || defined(__MINGW32__) { - Term t = Deref(ARG1); - Term t2 = Deref(ARG2); - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); - return(FALSE); - } - if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2"); - return(FALSE); - } - if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2"); - return(FALSE); - } -#if _MSC_VER || defined(__MINGW32__) - { - Term tout; - Int time[2]; + Term tout; + Int time[2]; - time[0] = IntegerOfTerm(t); - time[1] = IntegerOfTerm(t2); + time[0] = i1; + time[1] = i2; - if (time[0] != 0 && time[1] != 0) { - DWORD dwThreadId; - HANDLE hThread; + if (time[0] != 0 && time[1] != 0) { + DWORD dwThreadId; + HANDLE hThread; - hThread = CreateThread( - NULL, /* no security attributes */ - 0, /* use default stack size */ - DoTimerThread, /* thread function */ - (LPVOID)time, /* argument to thread function */ - 0, /* use default creation flags */ - &dwThreadId); /* returns the thread identifier */ + hThread = CreateThread(NULL, /* no security attributes */ + 0, /* use default stack size */ + DoTimerThread, /* thread function */ + (LPVOID)time, /* argument to thread function */ + 0, /* use default creation flags */ + &dwThreadId); /* returns the thread identifier */ - /* Check the return value for success. */ - if (hThread == NULL) { - Yap_WinError("trying to use alarm"); - } + /* Check the return value for success. */ + if (hThread == NULL) { + Yap_WinError("trying to use alarm"); } - tout = MkIntegerTerm(0); - return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)); } -#elif HAVE_SETITIMER && !SUPPORT_CONDOR - { - struct itimerval new, old; - - new.it_interval.tv_sec = 0; - new.it_interval.tv_usec = 0; - new.it_value.tv_sec = IntegerOfTerm(t); - new.it_value.tv_usec = IntegerOfTerm(t2); - if (setitimer(ITIMER_VIRTUAL, &new, &old) < 0) { -#if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s", strerror(errno)); -#else - Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno); -#endif - return FALSE; - } - return Yap_unify(ARG3,MkIntegerTerm(old.it_value.tv_sec)) && - Yap_unify(ARG4,MkIntegerTerm(old.it_value.tv_usec)); - } -#else - /* not actually trying to set the alarm */ - if (IntegerOfTerm(t) == 0) - return TRUE; - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "virtual_alarm not available in this configuration"); - return FALSE; -#endif + tout = MkIntegerTerm(0); + return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0)); } +#elif HAVE_SETITIMER && !SUPPORT_CONDOR + { + struct itimerval new, old; + new.it_interval.tv_sec = 0; + new.it_interval.tv_usec = 0; + new.it_value.tv_sec = i1; + new.it_value.tv_usec = i2; + if (setitimer(ITIMER_REAL, &new, &old) < 0) { +#if HAVE_STRERROR + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s", + strerror(errno)); +#else + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno); +#endif + return FALSE; + } + return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) && + Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec)); + } +#elif HAVE_ALARM && !SUPPORT_CONDOR + { + Int left; + Term tout; + + left = alarm(i1); + tout = MkIntegerTerm(left); + return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0)); + } +#else + /* not actually trying to set the alarm */ + if (IntegerOfTerm(t) == 0) + return TRUE; + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "alarm not available in this configuration"); + return FALSE; +#endif +} + +static Int virtual_alarm(USES_REGS1) { + Term t = Deref(ARG1); + Term t2 = Deref(ARG2); + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR, t, "alarm/2"); + return (FALSE); + } + if (!IsIntegerTerm(t)) { + Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2"); + return (FALSE); + } + if (IsVarTerm(t2)) { + Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2"); + return (FALSE); + } + if (!IsIntegerTerm(t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2"); + return (FALSE); + } +#if _MSC_VER || defined(__MINGW32__) + { + Term tout; + Int time[2]; + + time[0] = IntegerOfTerm(t); + time[1] = IntegerOfTerm(t2); + + if (time[0] != 0 && time[1] != 0) { + DWORD dwThreadId; + HANDLE hThread; + + hThread = CreateThread(NULL, /* no security attributes */ + 0, /* use default stack size */ + DoTimerThread, /* thread function */ + (LPVOID)time, /* argument to thread function */ + 0, /* use default creation flags */ + &dwThreadId); /* returns the thread identifier */ + + /* Check the return value for success. */ + if (hThread == NULL) { + Yap_WinError("trying to use alarm"); + } + } + tout = MkIntegerTerm(0); + return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0)); + } +#elif HAVE_SETITIMER && !SUPPORT_CONDOR + { + struct itimerval new, old; + + new.it_interval.tv_sec = 0; + new.it_interval.tv_usec = 0; + new.it_value.tv_sec = IntegerOfTerm(t); + new.it_value.tv_usec = IntegerOfTerm(t2); + if (setitimer(ITIMER_VIRTUAL, &new, &old) < 0) { +#if HAVE_STRERROR + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s", + strerror(errno)); +#else + Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno); +#endif + return FALSE; + } + return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) && + Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec)); + } +#else + /* not actually trying to set the alarm */ + if (IntegerOfTerm(t) == 0) + return TRUE; + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "virtual_alarm not available in this configuration"); + return FALSE; +#endif +} #ifdef VAX - /* avoid longjmp botch */ +/* avoid longjmp botch */ - int vax_absmi_fp; +int vax_absmi_fp; - typedef struct - { - int eh; - int flgs; - int ap; - int fp; - int pc; - int dummy1; - int dummy2; - int dummy3; - int oldfp; - int dummy4; - int dummy5; - int dummy6; - int oldpc; - } - - *VaxFramePtr; - - - VaxFixFrame (dummy) - { - int maxframes = 100; - VaxFramePtr fp = (VaxFramePtr) (((int *) &dummy) - 6); - while (--maxframes) - { - fp = (VaxFramePtr) fp->fp; - if (fp->flgs == 0) - { - if (fp->oldfp >= ®S[6] && fp->oldfp < ®S[REG_SIZE]) - fp->oldfp = vax_absmi_fp; - return; - } - } +typedef struct { + int eh; + int flgs; + int ap; + int fp; + int pc; + int dummy1; + int dummy2; + int dummy3; + int oldfp; + int dummy4; + int dummy5; + int dummy6; + int oldpc; +} + + * VaxFramePtr; + +VaxFixFrame(dummy) { + int maxframes = 100; + VaxFramePtr fp = (VaxFramePtr)(((int *)&dummy) - 6); + while (--maxframes) { + fp = (VaxFramePtr)fp->fp; + if (fp->flgs == 0) { + if (fp->oldfp >= ®S[6] && fp->oldfp < ®S[REG_SIZE]) + fp->oldfp = vax_absmi_fp; + return; + } } +} #endif - #if defined(_WIN32) #include - int WINAPI win_yap(HANDLE, DWORD, LPVOID); +int WINAPI win_yap(HANDLE, DWORD, LPVOID); - int WINAPI win_yap(HANDLE hinst, DWORD reason, LPVOID reserved) - { - switch (reason) - { - case DLL_PROCESS_ATTACH: - break; - case DLL_PROCESS_DETACH: - break; - case DLL_THREAD_ATTACH: - break; - case DLL_THREAD_DETACH: - break; - } - return 1; +int WINAPI win_yap(HANDLE hinst, DWORD reason, LPVOID reserved) { + switch (reason) { + case DLL_PROCESS_ATTACH: + break; + case DLL_PROCESS_DETACH: + break; + case DLL_THREAD_ATTACH: + break; + case DLL_THREAD_DETACH: + break; } + return 1; +} #endif #if (defined(YAPOR) || defined(THREADS)) && !defined(USE_PTHREAD_LOCKING) #ifdef sparc - void rw_lock_voodoo(void); +void rw_lock_voodoo(void); - void - rw_lock_voodoo(void) { - /* code taken from the Linux kernel, it handles shifting between locks */ - /* Read/writer locks, as usual this is overly clever to make it as fast as possible. */ - /* caches... */ - __asm__ __volatile__( - "___rw_read_enter_spin_on_wlock:\n" - " orcc %g2, 0x0, %g0\n" - " be,a ___rw_read_enter\n" - " ldstub [%g1 + 3], %g2\n" - " b ___rw_read_enter_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - "___rw_read_exit_spin_on_wlock:\n" - " orcc %g2, 0x0, %g0\n" - " be,a ___rw_read_exit\n" - " ldstub [%g1 + 3], %g2\n" - " b ___rw_read_exit_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - "___rw_write_enter_spin_on_wlock:\n" - " orcc %g2, 0x0, %g0\n" - " be,a ___rw_write_enter\n" - " ldstub [%g1 + 3], %g2\n" - " b ___rw_write_enter_spin_on_wlock\n" - " ld [%g1], %g2\n" - "\n" - " .globl ___rw_read_enter\n" - "___rw_read_enter:\n" - " orcc %g2, 0x0, %g0\n" - " bne,a ___rw_read_enter_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - " ld [%g1], %g2\n" - " add %g2, 1, %g2\n" - " st %g2, [%g1]\n" - " retl\n" - " mov %g4, %o7\n" - " .globl ___rw_read_exit\n" - "___rw_read_exit:\n" - " orcc %g2, 0x0, %g0\n" - " bne,a ___rw_read_exit_spin_on_wlock\n" - " ldub [%g1 + 3], %g2\n" - " ld [%g1], %g2\n" - " sub %g2, 0x1ff, %g2\n" - " st %g2, [%g1]\n" - " retl\n" - " mov %g4, %o7\n" - " .globl ___rw_write_enter\n" - "___rw_write_enter:\n" - " orcc %g2, 0x0, %g0\n" - " bne ___rw_write_enter_spin_on_wlock\n" - " ld [%g1], %g2\n" - " andncc %g2, 0xff, %g0\n" - " bne,a ___rw_write_enter_spin_on_wlock\n" - " stb %g0, [%g1 + 3]\n" - " retl\n" - " mov %g4, %o7\n" - ); - } +void rw_lock_voodoo(void) { + /* code taken from the Linux kernel, it handles shifting between locks */ + /* Read/writer locks, as usual this is overly clever to make it as fast as + * possible. */ + /* caches... */ + __asm__ __volatile__("___rw_read_enter_spin_on_wlock:\n" + " orcc %g2, 0x0, %g0\n" + " be,a ___rw_read_enter\n" + " ldstub [%g1 + 3], %g2\n" + " b ___rw_read_enter_spin_on_wlock\n" + " ldub [%g1 + 3], %g2\n" + "___rw_read_exit_spin_on_wlock:\n" + " orcc %g2, 0x0, %g0\n" + " be,a ___rw_read_exit\n" + " ldstub [%g1 + 3], %g2\n" + " b ___rw_read_exit_spin_on_wlock\n" + " ldub [%g1 + 3], %g2\n" + "___rw_write_enter_spin_on_wlock:\n" + " orcc %g2, 0x0, %g0\n" + " be,a ___rw_write_enter\n" + " ldstub [%g1 + 3], %g2\n" + " b ___rw_write_enter_spin_on_wlock\n" + " ld [%g1], %g2\n" + "\n" + " .globl ___rw_read_enter\n" + "___rw_read_enter:\n" + " orcc %g2, 0x0, %g0\n" + " bne,a ___rw_read_enter_spin_on_wlock\n" + " ldub [%g1 + 3], %g2\n" + " ld [%g1], %g2\n" + " add %g2, 1, %g2\n" + " st %g2, [%g1]\n" + " retl\n" + " mov %g4, %o7\n" + " .globl ___rw_read_exit\n" + "___rw_read_exit:\n" + " orcc %g2, 0x0, %g0\n" + " bne,a ___rw_read_exit_spin_on_wlock\n" + " ldub [%g1 + 3], %g2\n" + " ld [%g1], %g2\n" + " sub %g2, 0x1ff, %g2\n" + " st %g2, [%g1]\n" + " retl\n" + " mov %g4, %o7\n" + " .globl ___rw_write_enter\n" + "___rw_write_enter:\n" + " orcc %g2, 0x0, %g0\n" + " bne ___rw_write_enter_spin_on_wlock\n" + " ld [%g1], %g2\n" + " andncc %g2, 0xff, %g0\n" + " bne,a ___rw_write_enter_spin_on_wlock\n" + " stb %g0, [%g1 + 3]\n" + " retl\n" + " mov %g4, %o7\n"); +} #endif /* sparc */ - #endif /* YAPOR || THREADS */ - void - Yap_InitSignalPreds(void) - { - CACHE_REGS - Term cm = CurrentModule; +void Yap_InitSignalPreds(void) { + CACHE_REGS + Term cm = CurrentModule; - Yap_InitCPred ("$fpe_error", 0, p_fpe_error, 0); - Yap_InitCPred ("$alarm", 4, alarm4, SafePredFlag|SyncPredFlag); - CurrentModule = HACKS_MODULE; - Yap_InitCPred ("virtual_alarm", 4, virtual_alarm, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("enable_interrupts", 0, enable_interrupts, SafePredFlag); - Yap_InitCPred ("disable_interrupts", 0, disable_interrupts, SafePredFlag); - CurrentModule = cm; - } - - - + Yap_InitCPred("$fpe_error", 0, fpe_error, 0); + Yap_InitCPred("$alarm", 4, alarm4, SafePredFlag | SyncPredFlag); + CurrentModule = HACKS_MODULE; + Yap_InitCPred("virtual_alarm", 4, virtual_alarm, SafePredFlag | SyncPredFlag); + Yap_InitCPred("enable_interrupts", 0, enable_interrupts, SafePredFlag); + Yap_InitCPred("disable_interrupts", 0, disable_interrupts, SafePredFlag); + CurrentModule = cm; +} diff --git a/os/sysbits.c b/os/sysbits.c index e7c534b41..42b7b753e 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -635,6 +635,7 @@ static Term do_glob(const char *spec, bool glob_vs_wordexp) { CACHE_REGS char u[YAP_FILENAME_MAX + 1]; + char *espec = u; if (spec == NULL) { return TermNil; } @@ -642,7 +643,6 @@ static Term { WIN32_FIND_DATA find; HANDLE hFind; - const char *espec; CELL *dest; Term tf; @@ -673,7 +673,6 @@ static Term return tf; } #elif HAVE_WORDEXP || HAVE_GLOB - char *espec = u; strncpy(espec, spec, sizeof(u)); /* Expand the string for the program to run. */ size_t pathcount; diff --git a/os/ypsocks.c b/os/ypsocks.c index c304d92b3..64f1b37ac 100755 --- a/os/ypsocks.c +++ b/os/ypsocks.c @@ -15,10 +15,9 @@ * * *************************************************************************/ - #include "sysbits.h" -#if HAVE_SOCKET +#if HAVE_SOCKET #if HAVE_UNISTD_H && !defined(__MINGW32__) && !_MSC_VER #include @@ -176,148 +175,151 @@ #define invalid_socket_fd(fd) (fd) < 0 #endif -void -Yap_init_socks(char *host, long interface_port) -{ - int s; - int r; - struct sockaddr_in soadr; - struct in_addr adr; - struct hostent *he; +void Yap_init_socks(char *host, long interface_port) { + int s; + int r; + struct sockaddr_in soadr; + struct in_addr adr; + struct hostent *he; - -#if HAVE_SOCKET - he = gethostbyname(host); - if (he == NULL) { +#if HAVE_SOCKET + he = gethostbyname(host); + if (he == NULL) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "can not get address for host %s: %s", host, strerror(h_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "can not get address for host %s: %s", host, strerror(h_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "can not get address for host"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "can not get address for host"); #endif - return; - } + return; + } - (void) memset((void *) &soadr, '\0', sizeof(struct sockaddr_in)); - soadr.sin_family = AF_INET; - soadr.sin_port = htons((short) interface_port); + (void)memset((void *)&soadr, '\0', sizeof(struct sockaddr_in)); + soadr.sin_family = AF_INET; + soadr.sin_port = htons((short)interface_port); - if (he != NULL) { - memcpy((char *) &adr, - (char *) he->h_addr_list[0], (size_t) he->h_length); - } else { - adr.s_addr = inet_addr(host); - } - soadr.sin_addr.s_addr = adr.s_addr; + if (he != NULL) { + memcpy((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length); + } else { + adr.s_addr = inet_addr(host); + } + soadr.sin_addr.s_addr = adr.s_addr; - s = socket ( AF_INET, SOCK_STREAM, 0); - if (s<0) { + s = socket(AF_INET, SOCK_STREAM, 0); + if (s < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket: %s", strerror(errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket: %s", + strerror(errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not create socket"); #endif - return; - } + return; + } #if ENABLE_SO_LINGER - struct linger ling; /* disables socket lingering. */ - ling.l_onoff = 1; - ling.l_linger = 0; - if (setsockopt(s, SOL_SOCKET, SO_LINGER, (void *) &ling, - sizeof(ling)) < 0) { + struct linger ling; /* disables socket lingering. */ + ling.l_onoff = 1; + ling.l_linger = 0; + if (setsockopt(s, SOL_SOCKET, SO_LINGER, (void *)&ling, sizeof(ling)) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (setsockopt_linger: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (setsockopt_linger)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (setsockopt_linger)"); #endif - return; - } + return; + } #endif - r = connect ( s, (struct sockaddr *) &soadr, sizeof(soadr)); - if (r<0) { + r = connect(s, (struct sockaddr *)&soadr, sizeof(soadr)); + if (r < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "connect failed, could not connect to interface: %s", strerror(errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "connect failed, could not connect to interface: %s", + strerror(errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "connect failed, could not connect to interface"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "connect failed, could not connect to interface"); #endif - return; - } - /* now reopen stdin stdout and stderr */ + return; + } +/* now reopen stdin stdout and stderr */ #if HAVE_DUP2 && !defined(__MINGW32__) - if(dup2(s,0)<0) { + if (dup2(s, 0) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin: %s", strerror(errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin: %s", + strerror(errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdin"); #endif - return; - } - if(dup2(s,1)<0) { + return; + } + if (dup2(s, 1) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout: %s", strerror(errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout: %s", + strerror(errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stdout"); #endif - return; - } - if(dup2(s,2)<0) { + return; + } + if (dup2(s, 2) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr: %s", strerror(errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr: %s", + strerror(errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "could not dup2 stderr"); #endif - return; - } + return; + } #elif _MSC_VER || defined(__MINGW32__) - if(_dup2(s,0)<0) { - fprintf(stderr,"could not dup2 stdin\n"); - return; - } - if(_dup2(s,1)<0) { - fprintf(stderr,"could not dup2 stdout\n"); - return; - } - if(_dup2(s,2)<0) { - fprintf(stderr,"could not dup2 stderr\n"); - return; - } + if (_dup2(s, 0) < 0) { + fprintf(stderr, "could not dup2 stdin\n"); + return; + } + if (_dup2(s, 1) < 0) { + fprintf(stderr, "could not dup2 stdout\n"); + return; + } + if (_dup2(s, 2) < 0) { + fprintf(stderr, "could not dup2 stderr\n"); + return; + } #else - if(dup2(s,0)<0) { - fprintf(stderr,"could not dup2 stdin\n"); - return; - } - yp_iob[0].cnt = 0; - yp_iob[0].flags = _YP_IO_SOCK | _YP_IO_READ; - if(dup2(s,1)<0) { - fprintf(stderr,"could not dup2 stdout\n"); - return; - } - yp_iob[1].cnt = 0; - yp_iob[1].flags = _YP_IO_SOCK | _YP_IO_WRITE; - if(dup2(s,2)<0) { - fprintf(stderr,"could not dup2 stderr\n"); - return; - } - yp_iob[2].cnt = 0; - yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE; + if (dup2(s, 0) < 0) { + fprintf(stderr, "could not dup2 stdin\n"); + return; + } + yp_iob[0].cnt = 0; + yp_iob[0].flags = _YP_IO_SOCK | _YP_IO_READ; + if (dup2(s, 1) < 0) { + fprintf(stderr, "could not dup2 stdout\n"); + return; + } + yp_iob[1].cnt = 0; + yp_iob[1].flags = _YP_IO_SOCK | _YP_IO_WRITE; + if (dup2(s, 2) < 0) { + fprintf(stderr, "could not dup2 stderr\n"); + return; + } + yp_iob[2].cnt = 0; + yp_iob[2].flags = _YP_IO_SOCK | _YP_IO_WRITE; #endif - // Yap_sockets_io = 1; +// Yap_sockets_io = 1; #if _MSC_VER || defined(__MINGW32__) - _close(s); + _close(s); #else - close(s); + close(s); #endif -#else /* HAVE_SOCKET */ - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sockets not installed", strerror(errno)); +#else /* HAVE_SOCKET */ + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "sockets not installed", + strerror(errno)); #endif /* HAVE_SOCKET */ } -static Int -p_socket(USES_REGS1) -{ +static Int p_socket(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term t3 = Deref(ARG3); @@ -327,32 +329,32 @@ p_socket(USES_REGS1) Term out; if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"socket/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t1, "socket/4"); + return (FALSE); } if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM,t1,"socket/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, t1, "socket/4"); + return (FALSE); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket/4"); + return (FALSE); } if (!IsAtomTerm(t2)) { - Yap_Error(TYPE_ERROR_ATOM,t2,"socket/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, t2, "socket/4"); + return (FALSE); } if (IsVarTerm(t3)) { - Yap_Error(INSTANTIATION_ERROR,t3,"socket/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t3, "socket/4"); + return (FALSE); } if (!IsIntTerm(t3)) { - Yap_Error(TYPE_ERROR_ATOM,t3,"socket/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, t3, "socket/4"); + return (FALSE); } sdomain = RepAtom(AtomOfTerm(t1))->StrOfAE; if (sdomain[0] != 'A' || sdomain[1] != 'F' || sdomain[2] != '_') - return(FALSE); /* Error */ + return (FALSE); /* Error */ sdomain += 3; switch (sdomain[0]) { case 'A': @@ -425,121 +427,112 @@ p_socket(USES_REGS1) break; } stype = RepAtom(AtomOfTerm(t2))->StrOfAE; - if (stype[0] != 'S' || stype[1] != 'O' || stype[2] != 'C' || stype[3] != 'K' || stype[4] != '_') - return(FALSE); /* Error */ + if (stype[0] != 'S' || stype[1] != 'O' || stype[2] != 'C' || + stype[3] != 'K' || stype[4] != '_') + return (FALSE); /* Error */ stype += 5; - if (strcmp(stype,"STREAM") == 0) + if (strcmp(stype, "STREAM") == 0) type = SOCK_STREAM; - else if (strcmp(stype,"DGRAM") == 0) + else if (strcmp(stype, "DGRAM") == 0) type = SOCK_DGRAM; - else if (strcmp(stype,"RAW") == 0) + else if (strcmp(stype, "RAW") == 0) type = SOCK_RAW; - else if (strcmp(stype,"RDM") == 0) + else if (strcmp(stype, "RDM") == 0) type = SOCK_RDM; - else if (strcmp(stype,"SEQPACKET") == 0) + else if (strcmp(stype, "SEQPACKET") == 0) type = SOCK_SEQPACKET; - else if (strcmp(stype,"PACKET") == 0) + else if (strcmp(stype, "PACKET") == 0) type = SOCK_PACKET; else - return(FALSE); + return (FALSE); protocol = IntOfTerm(t3); if (protocol < 0) - return(FALSE); + return (FALSE); fd = socket(domain, type, protocol); if (invalid_socket_fd(fd)) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket/4 (socket: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket/4 (socket: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket/4 (socket)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket/4 (socket)"); #endif - return(FALSE); + return (FALSE); } - if (domain == AF_UNIX || domain == AF_LOCAL ) + if (domain == AF_UNIX || domain == AF_LOCAL) out = Yap_InitSocketStream(fd, new_socket, af_unix); - else if (domain == AF_INET ) + else if (domain == AF_INET) out = Yap_InitSocketStream(fd, new_socket, af_inet); else { - /* ok, we currently don't support these sockets */ +/* ok, we currently don't support these sockets */ #if _MSC_VER || defined(__MINGW32__) - _close(fd); + _close(fd); #else close(fd); #endif - return(FALSE); + return (FALSE); } - if (out == TermNil) return(FALSE); - return(Yap_unify(out,ARG4)); + if (out == TermNil) + return (FALSE); + return (Yap_unify(out, ARG4)); } -Int -Yap_CloseSocket(int fd, socket_info status, socket_domain domain) -{ +Int Yap_CloseSocket(int fd, socket_info status, socket_domain domain) { #if _MSC_VER || defined(__MINGW32__) /* prevent further writing to the socket */ - if (status == server_session_socket || - status == client_socket) { + if (status == server_session_socket || status == client_socket) { char bfr; if (shutdown(fd, 1) != 0) { - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (close)"); - return(FALSE); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); + return (FALSE); } /* read all pending characters from the socket */ - while( recv( fd, &bfr, 1, 0 ) > 0 ); + while (recv(fd, &bfr, 1, 0) > 0) + ; /* prevent further reading from the socket */ - if (shutdown(fd, 0) < 0) { - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (close)"); - return(FALSE); + if (shutdown(fd, 0) < 0) { + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); + return (FALSE); } /* close the socket */ if (closesocket(fd) != 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (close: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (close)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); #endif } #else - if (status == server_session_socket || - status == client_socket) { - if (shutdown(fd,2) < 0) { + if (status == server_session_socket || status == client_socket) { + if (shutdown(fd, 2) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (shutdown: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (shutdown: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (shutdown)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (shutdown)"); #endif - return(FALSE); + return (FALSE); } } if (close(fd) != 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (close: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_close/1 (close)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_close/1 (close)"); #endif #endif - return(FALSE); + return (FALSE); } - return(TRUE); + return (TRUE); } -static Int -p_socket_close(USES_REGS1) -{ +static Int p_socket_close(USES_REGS1) { Term t1 = Deref(ARG1); int sno; @@ -547,12 +540,10 @@ p_socket_close(USES_REGS1) return (FALSE); } Yap_CloseStream(sno); - return(TRUE); + return (TRUE); } -static Int -p_socket_bind(USES_REGS1) -{ +static Int p_socket_bind(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); int sno; @@ -567,15 +558,15 @@ p_socket_bind(USES_REGS1) fd = Yap_GetStreamFd(sno); if (status != new_socket) { /* ok, this should be an error, as you are trying to bind */ - return(FALSE); + return (FALSE); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_bind/2"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_bind/2"); + return (FALSE); } if (!IsApplTerm(t2)) { - Yap_Error(DOMAIN_ERROR_STREAM,t2,"socket_bind/2"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_STREAM, t2, "socket_bind/2"); + return (FALSE); } fun = FunctorOfTerm(t2); #if HAVE_SYS_UN_H @@ -586,63 +577,60 @@ p_socket_bind(USES_REGS1) int len; if (IsVarTerm(taddr)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_bind/2"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_bind/2"); + return (FALSE); } if (!IsAtomTerm(taddr)) { - Yap_Error(TYPE_ERROR_ATOM,taddr,"socket_bind/2"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, taddr, "socket_bind/2"); + return (FALSE); } s = RepAtom(AtomOfTerm(taddr))->StrOfAE; sock.sun_family = AF_UNIX; if ((len = strlen(s)) > 107) /* hit me with a broomstick */ { - Yap_Error(DOMAIN_ERROR_STREAM,taddr,"socket_bind/2"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_STREAM, taddr, "socket_bind/2"); + return (FALSE); } - sock.sun_family=AF_UNIX; - strcpy(sock.sun_path,s); - if (bind(fd, - (struct sockaddr *)(&sock), - ((size_t) (((struct sockaddr_un *) 0)->sun_path) + len)) - < 0) { + sock.sun_family = AF_UNIX; + strcpy(sock.sun_path, s); + if (bind(fd, (struct sockaddr *)(&sock), + ((size_t)(((struct sockaddr_un *)0)->sun_path) + len)) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (bind: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (bind)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind)"); #endif - return(FALSE); + return (FALSE); } Yap_UpdateSocketStream(sno, server_socket, af_unix); - return(TRUE); + return (TRUE); } else #endif - if (fun == FunctorAfInet) { + if (fun == FunctorAfInet) { Term thost = ArgOfTerm(1, t2); Term tport = ArgOfTerm(2, t2); char *shost; struct hostent *he; struct sockaddr_in saddr; - Int port; + Int port; - memset((void *)&saddr,(int) 0, sizeof(saddr)); + memset((void *)&saddr, (int)0, sizeof(saddr)); if (IsVarTerm(thost)) { saddr.sin_addr.s_addr = INADDR_ANY; } else if (!IsAtomTerm(thost)) { - Yap_Error(TYPE_ERROR_ATOM,thost,"socket_bind/2"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, thost, "socket_bind/2"); + return (FALSE); } else { shost = RepAtom(AtomOfTerm(thost))->StrOfAE; - if((he=gethostbyname(shost))==NULL) { + if ((he = gethostbyname(shost)) == NULL) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (gethostbyname: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_bind/2 (gethostbyname: %s)", strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (gethostbyname)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_bind/2 (gethostbyname)"); #endif - return(FALSE); + return (FALSE); } memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length); } @@ -653,47 +641,44 @@ p_socket_bind(USES_REGS1) } saddr.sin_port = htons(port); saddr.sin_family = AF_INET; - if(bind(fd,(struct sockaddr *)&saddr, sizeof(saddr))==-1) { + if (bind(fd, (struct sockaddr *)&saddr, sizeof(saddr)) == -1) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (bind: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (bind)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_bind/2 (bind)"); #endif - return(FALSE); + return (FALSE); } if (IsVarTerm(tport)) { - /* get the port number */ +/* get the port number */ #if _WIN32 || defined(__MINGW32__) int namelen; #else - unsigned int namelen; + socklen_t namelen; #endif Term t; if (getsockname(fd, (struct sockaddr *)&saddr, &namelen) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (getsockname: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_bind/2 (getsockname: %s)", strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_bind/2 (getsockname)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_bind/2 (getsockname)"); #endif - return(FALSE); + return (FALSE); } t = MkIntTerm(ntohs(saddr.sin_port)); - Yap_unify(ArgOfTermCell(2, t2),t); + Yap_unify(ArgOfTermCell(2, t2), t); } Yap_UpdateSocketStream(sno, server_socket, af_inet); - return(TRUE); + return (TRUE); } else - return(FALSE); + return (FALSE); } -static Int -p_socket_connect(USES_REGS1) -{ +static Int p_socket_connect(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Functor fun; @@ -707,19 +692,19 @@ p_socket_connect(USES_REGS1) return (FALSE); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_connect/3"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_connect/3"); + return (FALSE); } if (!IsApplTerm(t2)) { - Yap_Error(DOMAIN_ERROR_STREAM,t2,"socket_connect/3"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_STREAM, t2, "socket_connect/3"); + return (FALSE); } fun = FunctorOfTerm(t2); fd = Yap_GetStreamFd(sno); status = Yap_GetSocketStatus(sno); if (status != new_socket) { /* ok, this should be an error, as you are trying to bind */ - return(FALSE); + return (FALSE); } #if HAVE_SYS_UN_H if (fun == FunctorAfUnix) { @@ -729,38 +714,36 @@ p_socket_connect(USES_REGS1) int len; if (IsVarTerm(taddr)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_connect/3"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_connect/3"); + return (FALSE); } if (!IsAtomTerm(taddr)) { - Yap_Error(TYPE_ERROR_ATOM,taddr,"socket_connect/3"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, taddr, "socket_connect/3"); + return (FALSE); } s = RepAtom(AtomOfTerm(taddr))->StrOfAE; sock.sun_family = AF_UNIX; if ((len = strlen(s)) > 107) /* beat me with a broomstick */ { - Yap_Error(DOMAIN_ERROR_STREAM,taddr,"socket_connect/3"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_STREAM, taddr, "socket_connect/3"); + return (FALSE); } - sock.sun_family=AF_UNIX; - strcpy(sock.sun_path,s); - if ((flag = connect(fd, - (struct sockaddr *)(&sock), - ((size_t) (((struct sockaddr_un *) 0)->sun_path) + len))) - < 0) { + sock.sun_family = AF_UNIX; + strcpy(sock.sun_path, s); + if ((flag = connect( + fd, (struct sockaddr *)(&sock), + ((size_t)(((struct sockaddr_un *)0)->sun_path) + len))) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (connect: %s)", strerror(socket_errno)); + "socket_connect/3 (connect: %s)", strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (connect)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect)"); #endif - return(FALSE); + return (FALSE); } Yap_UpdateSocketStream(sno, client_socket, af_unix); } else #endif - if (fun == FunctorAfInet) { + if (fun == FunctorAfInet) { Term thost = ArgOfTerm(1, t2); Term tport = ArgOfTerm(2, t2); char *shost; @@ -768,33 +751,34 @@ p_socket_connect(USES_REGS1) struct sockaddr_in saddr; unsigned short int port; - memset((void *)&saddr,(int) 0, sizeof(saddr)); + memset((void *)&saddr, (int)0, sizeof(saddr)); if (IsVarTerm(thost)) { - Yap_Error(INSTANTIATION_ERROR,thost,"socket_connect/3"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, thost, "socket_connect/3"); + return (FALSE); } else if (!IsAtomTerm(thost)) { - Yap_Error(TYPE_ERROR_ATOM,thost,"socket_connect/3"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, thost, "socket_connect/3"); + return (FALSE); } else { shost = RepAtom(AtomOfTerm(thost))->StrOfAE; - if((he=gethostbyname(shost))==NULL) { + if ((he = gethostbyname(shost)) == NULL) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (gethostbyname: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (gethostbyname: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (gethostbyname)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (gethostbyname)"); #endif - return(FALSE); + return (FALSE); } memcpy((void *)&saddr.sin_addr, (void *)he->h_addr_list[0], he->h_length); } if (IsVarTerm(tport)) { - Yap_Error(INSTANTIATION_ERROR,tport,"socket_connect/3"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, tport, "socket_connect/3"); + return (FALSE); } else if (!IsIntegerTerm(tport)) { - Yap_Error(TYPE_ERROR_INTEGER,tport,"socket_connect/3"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, tport, "socket_connect/3"); + return (FALSE); } else { port = (unsigned short int)IntegerOfTerm(tport); } @@ -802,60 +786,60 @@ p_socket_connect(USES_REGS1) saddr.sin_family = AF_INET; #if ENABLE_SO_LINGER { - struct linger ling; /* For making sockets linger. */ - /* disabled: I see why no reason why we should throw things away by default!! */ + struct linger ling; /* For making sockets linger. */ + /* disabled: I see why no reason why we should throw things away by + * default!! */ ling.l_onoff = 1; ling.l_linger = 0; - if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (void *) &ling, - sizeof(ling)) < 0) { + if (setsockopt(fd, SOL_SOCKET, SO_LINGER, (void *)&ling, sizeof(ling)) < + 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (setsockopt_linger: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (setsockopt_linger: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (setsockopt_linger)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (setsockopt_linger)"); #endif - return FALSE; + return FALSE; } } #endif { - int one = 1; /* code by David MW Powers */ + int one = 1; /* code by David MW Powers */ if (setsockopt(fd, SOL_SOCKET, SO_BROADCAST, (void *)&one, sizeof(one))) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (setsockopt_broadcast: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (setsockopt_broadcast: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (setsockopt_broadcast)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "socket_connect/3 (setsockopt_broadcast)"); #endif - return FALSE; + return FALSE; } } - flag = connect(fd,(struct sockaddr *)&saddr, sizeof(saddr)); - if(flag<0) { + flag = connect(fd, (struct sockaddr *)&saddr, sizeof(saddr)); + if (flag < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (connect: %s)", strerror(socket_errno)); + "socket_connect/3 (connect: %s)", strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_connect/3 (connect)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_connect/3 (connect)"); #endif return FALSE; } Yap_UpdateSocketStream(sno, client_socket, af_inet); } else - return(FALSE); + return (FALSE); out = t1; - return(Yap_unify(out,ARG3)); + return (Yap_unify(out, ARG3)); } -static Int -p_socket_listen(USES_REGS1) -{ +static Int p_socket_listen(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); int sno; @@ -867,39 +851,36 @@ p_socket_listen(USES_REGS1) return (FALSE); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_listen/2"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_listen/2"); + return (FALSE); } if (!IsIntTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"socket_listen/2"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "socket_listen/2"); + return (FALSE); } j = IntOfTerm(t2); if (j < 0) { - Yap_Error(DOMAIN_ERROR_STREAM,t1,"socket_listen/2"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_STREAM, t1, "socket_listen/2"); + return (FALSE); } fd = Yap_GetStreamFd(sno); status = Yap_GetSocketStatus(sno); if (status != server_socket) { /* ok, this should be an error, as you are trying to bind */ - return(FALSE); + return (FALSE); } - if (listen(fd,j) < 0) { + if (listen(fd, j) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_listen/2 (listen: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_listen/2 (listen: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_listen/2 (listen)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_listen/2 (listen)"); #endif } - return(TRUE); + return (TRUE); } -static Int -p_socket_accept(USES_REGS1) -{ +static Int p_socket_accept(USES_REGS1) { Term t1 = Deref(ARG1); int sno; socket_info status; @@ -914,72 +895,64 @@ p_socket_accept(USES_REGS1) status = Yap_GetSocketStatus(sno); if (status != server_socket) { /* ok, this should be an error, as you are trying to bind */ - return(FALSE); + return (FALSE); } domain = Yap_GetSocketDomain(sno); #if HAVE_SYS_UN_H if (domain == af_unix) { struct sockaddr_un caddr; - unsigned int len; + socklen_t len; - memset((void *)&caddr,(int) 0, sizeof(caddr)); - if ((fd=accept(ofd, (struct sockaddr *)&caddr, &len)) < 0) { + memset((void *)&caddr, (int)0, sizeof(caddr)); + if ((fd = accept(ofd, (struct sockaddr *)&caddr, &len)) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_accept/3 (accept: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_accept/3 (accept)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept)"); #endif } /* ignore 2nd argument */ - out = Yap_InitSocketStream(fd, server_session_socket, af_unix ); + out = Yap_InitSocketStream(fd, server_session_socket, af_unix); } else #endif - if (domain == af_inet) { + if (domain == af_inet) { struct sockaddr_in caddr; Term tcli; char *s; -#if _WIN32 || defined(__MINGW32__) - int len; -#else - unsigned int len; -#endif + socklen_t len; len = sizeof(caddr); - memset((void *)&caddr,(int) 0, sizeof(caddr)); - if (invalid_socket_fd(fd=accept(ofd, (struct sockaddr *)&caddr, &len))) { + memset((void *)&caddr, (int)0, sizeof(caddr)); + if (invalid_socket_fd(fd = accept(ofd, (struct sockaddr *)&caddr, &len))) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_accept/3 (accept: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_accept/3 (accept)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (accept)"); #endif - return(FALSE); + return (FALSE); } if ((s = inet_ntoa(caddr.sin_addr)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_accept/3 (inet_ntoa: %s)", strerror(socket_errno)); + "socket_accept/3 (inet_ntoa: %s)", strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_accept/3 (inet_ntoa)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_accept/3 (inet_ntoa)"); #endif } tcli = MkAtomTerm(Yap_LookupAtom(s)); - if (!Yap_unify(ARG2,tcli)) - return(FALSE); - out = Yap_InitSocketStream(fd, server_session_socket, af_inet ); + if (!Yap_unify(ARG2, tcli)) + return (FALSE); + out = Yap_InitSocketStream(fd, server_session_socket, af_inet); } else - return(FALSE); - if (out == TermNil) return(FALSE); - return(Yap_unify(out,ARG3)); + return (FALSE); + if (out == TermNil) + return (FALSE); + return (Yap_unify(out, ARG3)); } -static Int -p_socket_buffering(USES_REGS1) -{ +static Int p_socket_buffering(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term t4 = Deref(ARG4); @@ -988,23 +961,22 @@ p_socket_buffering(USES_REGS1) int writing; #if _WIN32 || defined(__MINGW32__) int bufsize; - int len; #else unsigned int bufsize; - unsigned int len; #endif int sno; + socklen_t len; if ((sno = Yap_CheckSocketStream(t1, "socket_buffering/4")) < 0) { return (FALSE); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_buffering/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_buffering/4"); + return (FALSE); } if (!IsAtomTerm(t2)) { - Yap_Error(TYPE_ERROR_ATOM,t2,"socket_buffering/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, t2, "socket_buffering/4"); + return (FALSE); } mode = AtomOfTerm(t2); if (mode == AtomRead) @@ -1012,8 +984,8 @@ p_socket_buffering(USES_REGS1) else if (mode == AtomWrite) writing = TRUE; else { - Yap_Error(DOMAIN_ERROR_IO_MODE,t2,"socket_buffering/4"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_IO_MODE, t2, "socket_buffering/4"); + return (FALSE); } fd = Yap_GetStreamFd(sno); if (writing) { @@ -1021,20 +993,20 @@ p_socket_buffering(USES_REGS1) } else { getsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, &len); } - if (!Yap_unify(ARG3,MkIntegerTerm(bufsize))) - return(FALSE); + if (!Yap_unify(ARG3, MkIntegerTerm(bufsize))) + return (FALSE); if (IsVarTerm(t4)) { bufsize = BUFSIZ; } else { Int siz; if (!IsIntegerTerm(t4)) { - Yap_Error(TYPE_ERROR_INTEGER,t4,"socket_buffering/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t4, "socket_buffering/4"); + return (FALSE); } siz = IntegerOfTerm(t4); if (siz < 0) { - Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,t4,"socket_buffering/4"); - return(FALSE); + Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t4, "socket_buffering/4"); + return (FALSE); } bufsize = siz; } @@ -1043,32 +1015,28 @@ p_socket_buffering(USES_REGS1) } else { setsockopt(fd, SOL_SOCKET, SO_RCVBUF, (void *)&bufsize, sizeof(bufsize)); } - return(TRUE); + return (TRUE); } -static Term -select_out_list(Term t1, fd_set *readfds_ptr USES_REGS) -{ +static Term select_out_list(Term t1, fd_set *readfds_ptr USES_REGS) { if (t1 == TermNil) { - return(TermNil); + return (TermNil); } else { int fd; int sno; Term next = select_out_list(TailOfTerm(t1), readfds_ptr PASS_REGS); Term Head = HeadOfTerm(t1); - sno = Yap_CheckIOStream(Head,"stream_select/5"); + sno = Yap_CheckIOStream(Head, "stream_select/5"); fd = Yap_GetStreamFd(sno); if (FD_ISSET(fd, readfds_ptr)) - return(MkPairTerm(Head,next)); + return (MkPairTerm(Head, next)); else - return(MkPairTerm(TermNil,next)); + return (MkPairTerm(TermNil, next)); } } -static Int -p_socket_select(USES_REGS1) -{ +static Int p_socket_select(USES_REGS1) { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); Term t3 = Deref(ARG3); @@ -1076,36 +1044,36 @@ p_socket_select(USES_REGS1) struct timeval timeout, *ptime; #if _MSC_VER || defined(__MINGW32__) - u_int fdmax=0; + u_int fdmax = 0; #else - int fdmax=0; + int fdmax = 0; #endif Int tsec, tusec; Term tout = TermNil, ti, Head; if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"socket_select/5"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t1, "socket_select/5"); + return (FALSE); } if (!IsPairTerm(t1)) { - Yap_Error(TYPE_ERROR_LIST,t1,"socket_select/5"); - return(FALSE); + Yap_Error(TYPE_ERROR_LIST, t1, "socket_select/5"); + return (FALSE); } if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"socket_select/5"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "socket_select/5"); + return (FALSE); } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"socket_select/5"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "socket_select/5"); + return (FALSE); } if (IsVarTerm(t3)) { - Yap_Error(INSTANTIATION_ERROR,t3,"socket_select/5"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t3, "socket_select/5"); + return (FALSE); } if (!IsIntegerTerm(t3)) { - Yap_Error(TYPE_ERROR_INTEGER,t3,"socket_select/5"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t3, "socket_select/5"); + return (FALSE); } FD_ZERO(&readfds); FD_ZERO(&writefds); @@ -1114,16 +1082,16 @@ p_socket_select(USES_REGS1) ti = t1; while (ti != TermNil) { #if _MSC_VER || defined(__MINGW32__) - u_int fd; + u_int fd; #else int fd; #endif int sno; Head = HeadOfTerm(ti); - sno = Yap_CheckIOStream(Head,"stream_select/5"); + sno = Yap_CheckIOStream(Head, "stream_select/5"); if (sno < 0) - return(FALSE); + return (FALSE); fd = Yap_GetStreamFd(sno); FD_SET(fd, &readfds); if (fd > fdmax) @@ -1141,90 +1109,86 @@ p_socket_select(USES_REGS1) ptime = &timeout; } /* do the real work */ - if (select(fdmax+1, &readfds, &writefds, &exceptfds, ptime) < 0) { + if (select(fdmax + 1, &readfds, &writefds, &exceptfds, ptime) < 0) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_select/5 (select: %s)", strerror(socket_errno)); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_select/5 (select: %s)", + strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "socket_select/5 (select)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "socket_select/5 (select)"); #endif } tout = select_out_list(t1, &readfds PASS_REGS); /* we're done, just pass the info back */ - return(Yap_unify(ARG4,tout)); + return (Yap_unify(ARG4, tout)); } - -static Int -p_current_host(USES_REGS1) { +static Int p_current_host(USES_REGS1) { char oname[MAXHOSTNAMELEN], *name; Term t1 = Deref(ARG1), out; if (!IsVarTerm(t1) && !IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM,t1,"current_host/2"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, t1, "current_host/2"); + return (FALSE); } name = oname; if (gethostname(name, sizeof(oname)) < 0) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "current_host/2 (gethostname: %s)", strerror(socket_errno)); + "current_host/2 (gethostname: %s)", strerror(socket_errno)); #else - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "current_host/2 (gethostname)"); + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "current_host/2 (gethostname)"); #endif - return(FALSE); + return (FALSE); } - if ((strrchr(name,'.') == NULL)) { + if ((strrchr(name, '.') == NULL)) { struct hostent *he; /* not a fully qualified name, ask the name server */ - if((he=gethostbyname(name))==NULL) { + if ((he = gethostbyname(name)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "current_host/2 (gethostbyname: %s)", strerror(socket_errno)); + "current_host/2 (gethostbyname: %s)", strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "current_host/2 (gethostbyname)"); + "current_host/2 (gethostbyname)"); #endif - return(FALSE); + return (FALSE); } name = (char *)(he->h_name); } if (IsAtomTerm(t1)) { char *sin = RepAtom(AtomOfTerm(t1))->StrOfAE; - int faq = (strrchr(sin,'.') != NULL); + int faq = (strrchr(sin, '.') != NULL); if (faq) #if _MSC_VER || defined(__MINGW32__) - return(_stricmp(name,sin) == 0); + return (_stricmp(name, sin) == 0); #else - return(strcasecmp(name,sin) == 0); + return (strcasecmp(name, sin) == 0); #endif else { int isize = strlen(sin); if (isize >= 256) { - Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, - "current_host/2 (input longer than longest FAQ host name)"); - return(FALSE); + Yap_Error(SYSTEM_ERROR_INTERNAL, ARG1, + "current_host/2 (input longer than longest FAQ host name)"); + return (FALSE); } - if (name[isize] != '.') return(FALSE); + if (name[isize] != '.') + return (FALSE); name[isize] = '\0'; #if _MSC_VER || defined(__MINGW32__) - return(_stricmp(name,sin) == 0); + return (_stricmp(name, sin) == 0); #else - return(strcasecmp(name,sin) == 0); + return (strcasecmp(name, sin) == 0); #endif } } else { out = MkAtomTerm(Yap_LookupAtom(name)); - return(Yap_unify(ARG1,out)); + return (Yap_unify(ARG1, out)); } } -static Int -p_hostname_address(USES_REGS1) { +static Int p_hostname_address(USES_REGS1) { char *s; Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); @@ -1233,69 +1197,74 @@ p_hostname_address(USES_REGS1) { if (!IsVarTerm(t1)) { if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM,t1,"hostname_address/2"); - return(FALSE); - } else tin = t1; + Yap_Error(TYPE_ERROR_ATOM, t1, "hostname_address/2"); + return (FALSE); + } else + tin = t1; } else if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t1,"hostname_address/5"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t1, "hostname_address/5"); + return (FALSE); } else if (!IsAtomTerm(t2)) { - Yap_Error(TYPE_ERROR_ATOM,t2,"hostname_address/2"); - return(FALSE); - } else tin = t2; + Yap_Error(TYPE_ERROR_ATOM, t2, "hostname_address/2"); + return (FALSE); + } else + tin = t2; s = RepAtom(AtomOfTerm(tin))->StrOfAE; if (IsVarTerm(t1)) { if ((he = gethostbyaddr(s, strlen(s), AF_INET)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "hostname_address/2 (gethostbyname: %s)", strerror(socket_errno)); + "hostname_address/2 (gethostbyname: %s)", + strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "hostname_address/2 (gethostbyname)"); + "hostname_address/2 (gethostbyname)"); #endif } out = MkAtomTerm(Yap_LookupAtom((char *)(he->h_name))); - return(Yap_unify(out, ARG1)); + return (Yap_unify(out, ARG1)); } else { struct in_addr adr; if ((he = gethostbyname(s)) == NULL) { #if HAVE_STRERROR Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "hostname_address/2 (gethostbyname: %s)", strerror(socket_errno)); + "hostname_address/2 (gethostbyname: %s)", + strerror(socket_errno)); #else Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "hostname_address/2 (gethostbyname)"); + "hostname_address/2 (gethostbyname)"); #endif } - memcpy((char *) &adr, - (char *) he->h_addr_list[0], (size_t) he->h_length); + memcpy((char *)&adr, (char *)he->h_addr_list[0], (size_t)he->h_length); out = MkAtomTerm(Yap_LookupAtom(inet_ntoa(adr))); - return(Yap_unify(out, ARG2)); + return (Yap_unify(out, ARG2)); } } #endif -void -Yap_InitSocketLayer(void) -{ -#ifdef HAVE_SOCKET - Yap_InitCPred("socket", 4, p_socket, SafePredFlag|SyncPredFlag); - Yap_InitCPred("socket_close", 1, p_socket_close, SafePredFlag|SyncPredFlag); - Yap_InitCPred("socket_bind", 2, p_socket_bind, SafePredFlag|SyncPredFlag); - Yap_InitCPred("socket_connect", 3, p_socket_connect, SafePredFlag|SyncPredFlag); - Yap_InitCPred("socket_listen", 2, p_socket_listen, SafePredFlag|SyncPredFlag); - Yap_InitCPred("socket_accept", 3, p_socket_accept, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$socket_buffering", 4, p_socket_buffering, SafePredFlag|SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("$socket_select", 4, p_socket_select, SafePredFlag|SyncPredFlag|HiddenPredFlag); +void Yap_InitSocketLayer(void) { +#ifdef HAVE_SOCKET + Yap_InitCPred("socket", 4, p_socket, SafePredFlag | SyncPredFlag); + Yap_InitCPred("socket_close", 1, p_socket_close, SafePredFlag | SyncPredFlag); + Yap_InitCPred("socket_bind", 2, p_socket_bind, SafePredFlag | SyncPredFlag); + Yap_InitCPred("socket_connect", 3, p_socket_connect, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("socket_listen", 2, p_socket_listen, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("socket_accept", 3, p_socket_accept, + SafePredFlag | SyncPredFlag); + Yap_InitCPred("$socket_buffering", 4, p_socket_buffering, + SafePredFlag | SyncPredFlag | HiddenPredFlag); + Yap_InitCPred("$socket_select", 4, p_socket_select, + SafePredFlag | SyncPredFlag | HiddenPredFlag); Yap_InitCPred("current_host", 1, p_current_host, SafePredFlag); Yap_InitCPred("hostname_address", 2, p_hostname_address, SafePredFlag); #if _MSC_VER || defined(__MINGW32__) { WSADATA info; - if (WSAStartup(MAKEWORD(2,1), &info) != 0) + if (WSAStartup(MAKEWORD(2, 1), &info) != 0) exit(1); } #endif #endif } -