diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

signed wchar

Browse Source
This commit is contained in:
vscosta 2016-04-05 02:53:39 +01:00
parent 4d3d9c408d
commit 71f0076ed6
8 changed files with 2320 additions and 2431 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
os/format.c
View File

@ -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 <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
@ -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;

51
os/getw.h
View File

@ -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,8 +38,8 @@ 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];
@ -53,14 +53,14 @@ case ENC_ISO_UTF8: {
if (c1 == -1)
return post_process_weof(st);
// if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8;
wch = ((ch & 0x1f)<<6) | (c1 & 0x3f);
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]))
// if ((str + 1 >= end) || !utf_cont(*str) || !utf_cont(str[1]))
// return UTF8PROC_ERROR_INVALIDUTF8;
// Check for surrogate chars
//if (ch == 0xed && *str > 0x9f)
// if (ch == 0xed && *str > 0x9f)
// return UTF8PROC_ERROR_INVALIDUTF8;
int c1 = GETC();
if (c1 == -1)
@ -68,7 +68,7 @@ case ENC_ISO_UTF8: {
int c2 = GETC();
if (c2 == -1)
return post_process_weof(st);
wch = ((ch & 0xf)<<12) | ((c1 & 0x3f)<<6) | (c2 & 0x3f);
wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f);
return post_process_read_wchar(wch, 3, st);
} else {
int c1 = GETC();
@ -80,11 +80,12 @@ case ENC_ISO_UTF8: {
int c3 = GETC();
if (c3 == -1)
return post_process_weof(st);
wch = ((ch & 7)<<18) | ((c1 & 0x3f)<<12) | ((c2 & 0x3f)<<6) | (c3 & 0x3f);
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
case ENC_UTF16_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3
// little-endian: start with big shot
{
int wch;
@ -99,21 +100,20 @@ case ENC_UTF16_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3
int c3 = GETC();
if (c3 == -1)
return post_process_weof(st);
wch = wch + (((c3 << 8) + c2)<<wch) + SURROGATE_OFFSET;
wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET;
return post_process_read_wchar(wch, 4, st);
}
return post_process_read_wchar(wch, 2, st);
}
case ENC_UTF16_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3
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);
wch = (c1) + (ch << 8);
if (wch >= 0xd800 && wch < 0xdc00) {
int c3 = GETC();
if (c3 == -1)
@ -134,12 +134,11 @@ case ENC_UTF16_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3
int c1 = GETC();
if (c1 == -1)
return post_process_weof(st);
wch = (c1) + (ch<<8);
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
case ENC_UCS2_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3
// little-endian: start with big shot
{
int wch;
@ -151,7 +150,7 @@ case ENC_UCS2_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3
return post_process_read_wchar(wch, 2, st);
}
case ENC_ISO_UTF32_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3
case ENC_ISO_UTF32_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3
// little-endian: start with big shot
{
int wch = ch;
@ -165,17 +164,17 @@ case ENC_ISO_UTF32_BE: // check http://unicode.org/faq/utf_bom.html#utf16-3
int c1 = GETC();
if (c1 == -1)
return post_process_weof(st);
wch = (wch << 8 )+c1;
wch = (wch << 8) + c1;
}
{
int c1 = GETC();
if (c1 == -1)
return post_process_weof(st);
wch = (wch << 8) +c1;
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
case ENC_ISO_UTF32_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3
// little-endian: start with big shot
{
int wch = ch;
@ -183,21 +182,25 @@ case ENC_ISO_UTF32_LE: // check http://unicode.org/faq/utf_bom.html#utf16-3
int c1 = GETC();
if (c1 == -1)
return post_process_weof(st);
wch += c1<<8;
wch += c1 << 8;
}
{
int c1 = GETC();
if (c1 == -1)
return post_process_weof(st);
wch += c1<<16;
wch += c1 << 16;
}
{
int c1 = GETC();
if (c1 == -1)
return post_process_weof(st);
wch += c1<<24;
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;
}
}

352
os/iopreds.c
View File

@ -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 <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#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"
@ -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,7 +268,6 @@ static void unix_upd_stream_info(StreamDesc *s) {
s->status |= Seekable_Stream_f;
}
static void InitFileIO(StreamDesc *s) {
CACHE_REGS
if (s->status & Socket_Stream_f) {
@ -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,19 +692,18 @@ 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) {
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) {
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;
@ -737,9 +736,9 @@ int PlGetc(int sno) {
(unsigned long int)ch, sno);
return -1;
}
}
}
int put_wchar(int sno, wchar_t ch) {
int put_wchar(int sno, wchar_t ch) {
/* pass the bucck if we can */
switch (GLOBAL_Stream[sno].encoding) {
case ENC_OCTET:
@ -793,8 +792,7 @@ int PlGetc(int sno) {
}
return ch;
break;
case ENC_UTF16_LE:
{
case ENC_UTF16_LE: {
if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch & 0xff));
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -811,8 +809,7 @@ int PlGetc(int sno) {
}
return ch;
}
case ENC_UTF16_BE:
{
case ENC_UTF16_BE: {
// computations
if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -825,12 +822,10 @@ int PlGetc(int sno) {
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:
{
case ENC_UCS2_LE: {
if (ch >= 0x10000) {
return 0;
}
@ -838,8 +833,7 @@ int PlGetc(int sno) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
return ch;
}
case ENC_UCS2_BE:
{
case ENC_UCS2_BE: {
// computations
if (ch < 0x10000) {
GLOBAL_Stream[sno].stream_putc(sno, (ch >> 8));
@ -865,34 +859,34 @@ int PlGetc(int sno) {
}
}
return -1;
}
}
/* used by user-code to read characters from the current input stream */
int Yap_PlGetchar(void) {
/* 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));
}
return (
GLOBAL_Stream[LOCAL_c_input_stream].stream_getc(LOCAL_c_input_stream));
}
int Yap_PlGetWchar(void) {
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) {
/* 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 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) {
/* 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);
@ -904,11 +898,11 @@ int PlGetc(int sno) {
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;
@ -925,9 +919,9 @@ int PlGetc(int sno) {
#else
return (FALSE);
#endif
}
}
static int write_bom(int sno, StreamDesc *st) {
static int write_bom(int sno, StreamDesc *st) {
/* dump encoding */
switch (st->encoding) {
case ENC_ISO_UTF8:
@ -980,9 +974,9 @@ int PlGetc(int sno) {
default:
return true;
}
}
}
static void check_bom(int sno, StreamDesc *st) {
static void check_bom(int sno, StreamDesc *st) {
int ch1, ch2, ch3, ch4;
ch1 = fgetc(st->file);
@ -1076,11 +1070,10 @@ int PlGetc(int sno) {
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) {
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;
@ -1114,9 +1107,9 @@ int PlGetc(int sno) {
Yap_DefaultStreamOps(st);
}
return true;
}
}
static bool open_header(int sno, Atom open_mode) {
static bool open_header(int sno, Atom open_mode) {
if (open_mode == AtomWrite) {
const char *ptr;
const char s[] = "#!";
@ -1143,11 +1136,11 @@ int PlGetc(int sno) {
}
}
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,18 +1155,18 @@ 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;
@ -1263,7 +1256,7 @@ int PlGetc(int sno) {
s_encoding = "default";
}
// default encoding, no bom yet
encoding = enc_id( s_encoding, ENC_OCTET);
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
@ -1279,8 +1272,7 @@ int PlGetc(int sno) {
// Skip scripts that start with !#/.. or similar
bool script =
(args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue
: false);
(args[OPEN_SCRIPT].used ? args[OPEN_SCRIPT].tvalue == TermTrue : false);
// binary type
if (args[OPEN_TYPE].used) {
Term t = args[OPEN_TYPE].tvalue;
@ -1328,11 +1320,11 @@ int PlGetc(int sno) {
fname = LOCAL_FileNameBuf;
UNLOCK(st->streamlock);
if (errno == ENOENT)
return (PlIOError(EXISTENCE_ERROR_SOURCE_SINK, file_name, "%s: %s",
fname, strerror(errno)));
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)));
return (PlIOError(PERMISSION_ERROR_OPEN_SOURCE_SINK, file_name, "%s: %s",
fname, strerror(errno)));
}
}
#if MAC
@ -1341,11 +1333,9 @@ int PlGetc(int sno) {
}
#endif
flags &= ~(Free_Stream_f);
if (!Yap_initStream(sno, fd, fname, file_name, encoding, flags,
open_mode))
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))
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))
@ -1355,10 +1345,10 @@ int PlGetc(int sno) {
}
// follow declaration unless there is v
if (st->status & HAS_BOM_f)
st->encoding = enc_id( s_encoding, st->encoding);
st->encoding = enc_id(s_encoding, st->encoding);
else
st->encoding = encoding;
Yap_DefaultStreamOps( st);
Yap_DefaultStreamOps(st);
if (script)
open_header(sno, open_mode);
@ -1367,102 +1357,101 @@ int PlGetc(int sno) {
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,
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) */
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.
`binary` stream.
+ `reposition(+ _Bool_)` is iso
+ `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.
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).
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 <tt>Name</tt> must be an atom.
The
alias can be used instead of the stream descriptor for every operation
concerning the stream.
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
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 (<em>Byte Order Mark</em>) was
detected while opening the file for reading or a BOM was written while
opening the stream. See BOM for details.
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.
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.
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.
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
@ -1471,14 +1460,12 @@ int PlGetc(int sno) {
permissions as executable. In `append` mode ignore the flag.
*/
static Int open4(
USES_REGS1) { /* '$open'(+File,+Mode,?Stream,-ReturnCode) */
*/
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) */
static Int p_file_expansion(USES_REGS1) { /* '$file_expansion'(+File,-Name) */
Term file_name = Deref(ARG1);
/* we know file_name is bound */
@ -1491,9 +1478,9 @@ int PlGetc(int sno) {
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) {
static Int p_open_null_stream(USES_REGS1) {
Term t;
StreamDesc *st;
int sno = GetFreeStreamD();
@ -1524,9 +1511,9 @@ int PlGetc(int sno) {
UNLOCK(st->streamlock);
t = Yap_MkStream(sno);
return (Yap_unify(ARG1, t));
}
}
int Yap_OpenStream(FILE * fd, char *name, Term file_name, int flags) {
int Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags) {
CACHE_REGS
int sno;
Atom at;
@ -1544,13 +1531,13 @@ int PlGetc(int sno) {
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) {
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)) {
@ -1606,15 +1593,15 @@ int PlGetc(int sno) {
return -1;
}
return sno;
}
}
int Yap_CheckStream__(const char *file, const char *f, int line, Term arg,
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 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;
@ -1629,10 +1616,10 @@ int PlGetc(int sno) {
return -1;
}
return sno;
}
}
/* used from C-interface */
int Yap_GetFreeStreamDForReading(void) {
/* used from C-interface */
int Yap_GetFreeStreamDForReading(void) {
int sno = GetFreeStreamD();
StreamDesc *s;
@ -1646,16 +1633,16 @@ int PlGetc(int sno) {
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) {
static Int always_prompt_user(USES_REGS1) {
StreamDesc *s = GLOBAL_Stream + StdInStream;
s->status |= Promptable_Stream_f;
@ -1669,9 +1656,9 @@ int PlGetc(int sno) {
} else
Yap_ConsoleOps(s, false);
return (TRUE);
}
}
static Int close1 /** @pred close(+ _S_) is iso
static Int close1 /** @pred close(+ _S_) is iso
Closes the stream _S_. If _S_ does not stand for a stream
@ -1683,8 +1670,7 @@ int PlGetc(int sno) {
(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f),
"close/2");
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
if (sno < 0)
return (FALSE);
if (sno <= StdErrStream) {
@ -1694,36 +1680,35 @@ int PlGetc(int sno) {
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) */
*/
static Int close2(USES_REGS1) { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream(
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f),
"close/2");
ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
Term tlist;
if (sno < 0)
return (FALSE);
@ -1747,9 +1732,9 @@ int PlGetc(int sno) {
Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
}
Term read_line(int sno) {
Term read_line(int sno) {
CACHE_REGS
Term tail;
Int ch;
@ -1759,11 +1744,11 @@ int PlGetc(int sno) {
}
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,20 +1761,20 @@ int PlGetc(int sno) {
#define PAR(x, y, z) z
typedef enum ABSOLUTE_FILE_NAME_enum_ {
typedef enum ABSOLUTE_FILE_NAME_enum_ {
ABSOLUTE_FILE_NAME_DEFS()
} absolute_file_name_choices_t;
} absolute_file_name_choices_t;
#undef PAR
#define PAR(x, y, z) \
{ x, y, z }
static const param_t absolute_file_name_search_defs[] = {
static const param_t absolute_file_name_search_defs[] = {
ABSOLUTE_FILE_NAME_DEFS()};
#undef PAR
static Int abs_file_parameters(USES_REGS1) {
static Int abs_file_parameters(USES_REGS1) {
Term t[ABSOLUTE_FILE_NAME_END];
Term tlist = Deref(ARG1), tf;
/* get options */
@ -1817,8 +1802,7 @@ int PlGetc(int sno) {
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;
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)
@ -1831,8 +1815,7 @@ int PlGetc(int sno) {
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;
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)
@ -1849,14 +1832,13 @@ int PlGetc(int sno) {
args[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH].tvalue;
else
t[ABSOLUTE_FILE_NAME_VERBOSE_FILE_SEARCH] =
(trueGlobalPrologFlag(VERBOSE_FILE_SEARCH_FLAG) ? TermTrue
: TermFalse);
(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) {
static Int get_abs_file_parameter(USES_REGS1) {
Term t = Deref(ARG1), topts = ARG2;
/* get options */
/* done */
@ -1866,9 +1848,9 @@ int PlGetc(int sno) {
return Yap_unify(ARG3, ArgOfTerm(i + 1, topts));
Yap_Error(DOMAIN_ERROR_ABSOLUTE_FILE_NAME_OPTION, ARG1, NULL);
return false;
}
}
void Yap_InitPlIO(void) {
void Yap_InitPlIO(void) {
Int i;
Yap_stdin = stdin;
@ -1881,9 +1863,9 @@ int PlGetc(int sno) {
GLOBAL_Stream[i].status = Free_Stream_f;
}
InitStdStreams();
}
}
void Yap_InitIOPreds(void) {
void Yap_InitIOPreds(void) {
/* here the Input/Output predicates */
Yap_InitCPred("always_prompt_user", 0, always_prompt_user,
SafePredFlag | SyncPredFlag);
@ -1918,4 +1900,4 @@ int PlGetc(int sno) {
Yap_InitSignalPreds();
Yap_InitSysPreds();
Yap_InitTimePreds();
}
}

17
os/iopreds.h
View File

@ -18,9 +18,9 @@ static char SccsId[] = "%W% %G%";
#define HAVE_SOCKET 1
#endif
#include <stdlib.h>
#include "Yap.h"
#include "Atoms.h"
#include "Yap.h"
#include <stdlib.h>
/*
* 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_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)(
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;

174
os/mem.c
View File

@ -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 <stdlib.h>
#if HAVE_UNISTD_H
@ -44,7 +44,7 @@ static char SccsId[] = "%W% %G%";
#endif
#include <windows.h>
#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,7 +52,12 @@ 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 __ANDROID__
#undef HAVE_FMEMOPEN
#undef HAVE_OPEN_MEMSTREAM
#endif
#if HAVE_FMEMOPEN
@ -70,12 +75,10 @@ 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)
{
static int MemGetc(int sno) {
register StreamDesc *s = &GLOBAL_Stream[sno];
Int ch;
int spos;
@ -83,8 +86,7 @@ MemGetc(int sno)
spos = s->u.mem_string.pos;
if (spos == s->u.mem_string.max_size) {
return -1;
}
else {
} else {
ch = s->u.mem_string.buf[spos];
s->u.mem_string.pos = ++spos;
}
@ -93,21 +95,18 @@ MemGetc(int sno)
#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)
{
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,10 +114,11 @@ 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;
@ -131,17 +131,19 @@ MemPutc(int sno, int ch)
#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);
LOCAL_Error_Size = new_max_size * sizeof(char);
save_machine_regs();
longjmp(*(jmp_buf *)GLOBAL_Stream[sno].u.mem_string.error_handler,1);
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;
}
@ -151,16 +153,14 @@ MemPutc(int sno, int ch)
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;
@ -170,23 +170,23 @@ MemPutc(int sno, int ch)
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)) {
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);
return (FALSE);
}
}
ti = Deref(ARG1);
@ -244,32 +244,30 @@ 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;
sno = GetFreeStreamD();
if (sno < 0)
return -1;
st = GLOBAL_Stream+sno;
st = GLOBAL_Stream + sno;
st->status = Output_Stream_f | InMemory_Stream_f;
if (!buf) {
if (!nchars) {
nchars = Yap_page_size;
}
buf = malloc( nchars );
buf = malloc(nchars);
st->status |= FreeOnClose_Stream_f;
}
st->nbuf = buf;
if(!st->nbuf) {
if (!st->nbuf) {
return -1;
}
st->nsize = nchars;
@ -280,7 +278,7 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSou
st->encoding = *encp;
else
st->encoding = LOCAL_encoding;
Yap_DefaultStreamOps( st );
Yap_DefaultStreamOps(st);
#if MAY_WRITE
st->file = open_memstream(&st->nbuf, &st->nsize);
st->status |= Seekable_Stream_f;
@ -288,39 +286,39 @@ Yap_open_buf_write_stream(char *buf, size_t nchars, encoding_t *encp, memBufSou
st->u.mem_string.pos = 0;
st->u.mem_string.buf = st->nbuf;
st->u.mem_string.max_size = nchars;
#endif
Yap_MemOps( st );
#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;
while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
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));
}
/**
@ -331,13 +329,10 @@ open_mem_write_stream (USES_REGS1) /* $open_mem_write_stream(-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)
{
if (fflush(GLOBAL_Stream[sno].file) == 0) {
s = GLOBAL_Stream[sno].nbuf;
return s;
}
@ -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,7 +353,7 @@ 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) {
@ -372,14 +366,14 @@ peek_mem_write_stream ( USES_REGS1 )
#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()) ) {
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);
return (FALSE);
}
i = GLOBAL_Stream[sno].u.mem_string.pos;
tf = ARG2;
@ -388,12 +382,10 @@ 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
@ -407,13 +399,12 @@ 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 );
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);
@ -436,15 +427,14 @@ bool Yap_CloseMemoryStream( int sno )
return true;
}
void
Yap_InitMems( void )
{
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;
}

484
os/sig.c
View File

@ -18,173 +18,160 @@ static void HandleMatherr(int sig, void *sipv, void *uapv);
#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[] =
{
} 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++))) {};
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) )
for (; sn->name; sn++) {
if (!strcmp(sn->name, name))
return sn->sig;
}
@ -199,20 +186,19 @@ 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,
/* 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 ((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); */
@ -226,24 +212,21 @@ SearchForTrailFault(void *ptr, int sure)
"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;
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 <fpu_control.h>
#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,27 +314,20 @@ 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) {
@ -372,7 +351,7 @@ Yap_MathException__( USES_REGS1 )
if (err) {
return EVALUATION_ERROR_UNDEFINED;
}
if (raised ) {
if (raised) {
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
return EVALUATION_ERROR_FLOAT_OVERFLOW;
@ -387,7 +366,7 @@ Yap_MathException__( USES_REGS1 )
}
}
#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,42 +402,35 @@ 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)
{
my_signal(s, ReceiveSignal);
switch (s) {
case SIGINT:
// always direct SIGINT to console
Yap_external_signal( 0, YAP_INT_SIGNAL );
Yap_external_signal(0, YAP_INT_SIGNAL);
break;
case SIGALRM:
Yap_external_signal( worker_id, YAP_ALARM_SIGNAL );
Yap_external_signal(worker_id, YAP_ALARM_SIGNAL);
break;
case SIGVTALRM:
Yap_external_signal( worker_id, YAP_VTALARM_SIGNAL );
Yap_external_signal(worker_id, YAP_VTALARM_SIGNAL);
break;
#ifndef MPW
#ifdef HAVE_SIGFPE
case SIGFPE:
Yap_external_signal( worker_id, YAP_FPE_SIGNAL );
Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
break;
#endif
#endif
@ -469,25 +439,25 @@ ReceiveSignal (int s, void *x, void *y)
case SIGQUIT:
case SIGKILL:
LOCAL_PrologMode &= ~InterruptMode;
Yap_Error(INTERRUPT_EVENT,MkIntTerm(s),NULL);
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);
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);
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);
Yap_external_signal(worker_id, YAP_PIPE_SIGNAL);
break;
#endif /* defined(SIGPIPE) */
#ifdef SIGHUP
@ -498,15 +468,14 @@ ReceiveSignal (int s, void *x, void *y)
#endif /* defined(SIGHUP) */
default:
fprintf(stderr, "\n[ Unexpected signal ]\n");
exit (s);
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)
@ -516,7 +485,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
) {
return FALSE;
}
switch(dwCtrlType) {
switch (dwCtrlType) {
case CTRL_C_EVENT:
case CTRL_BREAK_EVENT:
#if THREADS
@ -526,58 +495,52 @@ MSCHandleSignal(DWORD dwCtrlType) {
Yap_signal(YAP_WINTIMER_SIGNAL);
LOCAL_PrologMode |= InterruptMode;
#endif
return(TRUE);
return (TRUE);
default:
return(FALSE);
}
return (FALSE);
}
}
#endif
/* SIGINT can cause problems, if caught before full initialization */
void
Yap_InitOSSignals (int wid)
{
/* 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 */
#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)
{
static DWORD WINAPI DoTimerThread(LPVOID targ) {
Int *time = (Int *)targ;
HANDLE htimer;
LARGE_INTEGER liDueTime;
@ -586,73 +549,67 @@ MSCHandleSignal(DWORD dwCtrlType) {
liDueTime.QuadPart = -10000000;
liDueTime.QuadPart *= time[0];
/* add time in usecs */
liDueTime.QuadPart -= time[1]*10;
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 (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);
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 )
{
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 );
if (!Yap_only_has_signal(YAP_CREEP_SIGNAL))
EventFlag = Unsigned(LCL0);
}
return TRUE;
}
}
static Int
disable_interrupts( USES_REGS1 )
{
static Int disable_interrupts(USES_REGS1) {
LOCAL_InterruptsDisabled++;
CalculateStackGap( PASS_REGS1 );
CalculateStackGap(PASS_REGS1);
return TRUE;
}
}
static Int
alarm4( USES_REGS1 )
{
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);
return (FALSE);
}
if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2");
return(FALSE);
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2");
return(FALSE);
return (FALSE);
}
if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2");
return(FALSE);
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 );
Yap_get_signal(YAP_ALARM_SIGNAL);
#endif
}
#if _MSC_VER || defined(__MINGW32__)
@ -667,8 +624,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
DWORD dwThreadId;
HANDLE hThread;
hThread = CreateThread(
NULL, /* no security attributes */
hThread = CreateThread(NULL, /* no security attributes */
0, /* use default stack size */
DoTimerThread, /* thread function */
(LPVOID)time, /* argument to thread function */
@ -681,7 +637,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
}
}
tout = MkIntegerTerm(0);
return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0));
return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
}
#elif HAVE_SETITIMER && !SUPPORT_CONDOR
{
@ -693,14 +649,15 @@ MSCHandleSignal(DWORD dwCtrlType) {
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));
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));
return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) &&
Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec));
}
#elif HAVE_ALARM && !SUPPORT_CONDOR
{
@ -709,7 +666,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
left = alarm(i1);
tout = MkIntegerTerm(left);
return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0)) ;
return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
}
#else
/* not actually trying to set the alarm */
@ -719,28 +676,26 @@ MSCHandleSignal(DWORD dwCtrlType) {
"alarm not available in this configuration");
return FALSE;
#endif
}
}
static Int
virtual_alarm( USES_REGS1 )
{
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);
return (FALSE);
}
if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2");
return(FALSE);
return (FALSE);
}
if (IsVarTerm(t2)) {
Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2");
return(FALSE);
return (FALSE);
}
if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2");
return(FALSE);
return (FALSE);
}
#if _MSC_VER || defined(__MINGW32__)
{
@ -754,8 +709,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
DWORD dwThreadId;
HANDLE hThread;
hThread = CreateThread(
NULL, /* no security attributes */
hThread = CreateThread(NULL, /* no security attributes */
0, /* use default stack size */
DoTimerThread, /* thread function */
(LPVOID)time, /* argument to thread function */
@ -768,7 +722,7 @@ MSCHandleSignal(DWORD dwCtrlType) {
}
}
tout = MkIntegerTerm(0);
return Yap_unify(ARG3,tout) && Yap_unify(ARG4,MkIntTerm(0));
return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
}
#elif HAVE_SETITIMER && !SUPPORT_CONDOR
{
@ -780,14 +734,15 @@ MSCHandleSignal(DWORD dwCtrlType) {
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));
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));
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 */
@ -797,17 +752,15 @@ MSCHandleSignal(DWORD dwCtrlType) {
"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
{
typedef struct {
int eh;
int flgs;
int ap;
@ -821,40 +774,33 @@ MSCHandleSignal(DWORD dwCtrlType) {
int dummy5;
int dummy6;
int oldpc;
}
}
*VaxFramePtr;
* VaxFramePtr;
VaxFixFrame (dummy)
{
VaxFixFrame(dummy) {
int maxframes = 100;
VaxFramePtr fp = (VaxFramePtr) (((int *) &dummy) - 6);
while (--maxframes)
{
fp = (VaxFramePtr) fp->fp;
if (fp->flgs == 0)
{
VaxFramePtr fp = (VaxFramePtr)(((int *)&dummy) - 6);
while (--maxframes) {
fp = (VaxFramePtr)fp->fp;
if (fp->flgs == 0) {
if (fp->oldfp >= &REGS[6] && fp->oldfp < &REGS[REG_SIZE])
fp->oldfp = vax_absmi_fp;
return;
}
}
}
}
#endif
#if defined(_WIN32)
#include <windows.h>
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)
{
int WINAPI win_yap(HANDLE hinst, DWORD reason, LPVOID reserved) {
switch (reason) {
case DLL_PROCESS_ATTACH:
break;
case DLL_PROCESS_DETACH:
@ -865,20 +811,19 @@ MSCHandleSignal(DWORD dwCtrlType) {
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) {
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. */
/* 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"
__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"
@ -926,28 +871,21 @@ MSCHandleSignal(DWORD dwCtrlType) {
" bne,a ___rw_write_enter_spin_on_wlock\n"
" stb %g0, [%g1 + 3]\n"
" retl\n"
" mov %g4, %o7\n"
);
}
" mov %g4, %o7\n");
}
#endif /* sparc */
#endif /* YAPOR || THREADS */
void
Yap_InitSignalPreds(void)
{
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);
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);
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;
}
}

3
os/sysbits.c
View File

@ -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;

663
os/ypsocks.c
View File

File diff suppressed because it is too large Load Diff