865 lines
22 KiB
C
865 lines
22 KiB
C
|
|
#include "sysbits.h"
|
|
|
|
#if HAVE_SIGINFO_H
|
|
#include <siginfo.h>
|
|
#endif
|
|
#if HAVE_SYS_UCONTEXT_H
|
|
#include <sys/ucontext.h>
|
|
#endif
|
|
|
|
#if HAVE_FPU_CONTROL_H
|
|
#include <fpu_control.h>
|
|
#endif
|
|
|
|
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
|
|
|
|
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET + 0)
|
|
#ifdef O_ATOMGC
|
|
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET + 1)
|
|
#endif
|
|
#define SIG_GC (SIG_PROLOG_OFFSET + 2)
|
|
#ifdef O_PLMT
|
|
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3)
|
|
#endif
|
|
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET + 4)
|
|
#define SIG_PLABORT (SIG_PROLOG_OFFSET + 5)
|
|
|
|
static struct signame {
|
|
int sig;
|
|
const char *name;
|
|
int flags;
|
|
} signames[] = {
|
|
#ifdef SIGHUP
|
|
{SIGHUP, "hup", 0},
|
|
#endif
|
|
{SIGINT, "int", 0},
|
|
#ifdef SIGQUIT
|
|
{SIGQUIT, "quit", 0},
|
|
#endif
|
|
{SIGILL, "ill", 0},
|
|
{SIGABRT, "abrt", 0},
|
|
{SIGFPE, "fpe", 0},
|
|
#ifdef SIGKILL
|
|
{SIGKILL, "kill", 0},
|
|
#endif
|
|
{SIGSEGV, "segv", 0},
|
|
#ifdef SIGPIPE
|
|
{SIGPIPE, "pipe", 0},
|
|
#endif
|
|
#ifdef SIGALRM
|
|
{SIGALRM, "alrm", 0},
|
|
#endif
|
|
{SIGTERM, "term", 0},
|
|
#ifdef SIGUSR1
|
|
{SIGUSR1, "usr1", 0},
|
|
#endif
|
|
#ifdef SIGUSR2
|
|
{SIGUSR2, "usr2", 0},
|
|
#endif
|
|
#ifdef SIGCHLD
|
|
{SIGCHLD, "chld", 0},
|
|
#endif
|
|
#ifdef SIGCONT
|
|
{SIGCONT, "cont", 0},
|
|
#endif
|
|
#ifdef SIGSTOP
|
|
{SIGSTOP, "stop", 0},
|
|
#endif
|
|
#ifdef SIGTSTP
|
|
{SIGTSTP, "tstp", 0},
|
|
#endif
|
|
#ifdef SIGTTIN
|
|
{SIGTTIN, "ttin", 0},
|
|
#endif
|
|
#ifdef SIGTTOU
|
|
{SIGTTOU, "ttou", 0},
|
|
#endif
|
|
#ifdef SIGTRAP
|
|
{SIGTRAP, "trap", 0},
|
|
#endif
|
|
#ifdef SIGBUS
|
|
{SIGBUS, "bus", 0},
|
|
#endif
|
|
#ifdef SIGSTKFLT
|
|
{SIGSTKFLT, "stkflt", 0},
|
|
#endif
|
|
#ifdef SIGURG
|
|
{SIGURG, "urg", 0},
|
|
#endif
|
|
#ifdef SIGIO
|
|
{SIGIO, "io", 0},
|
|
#endif
|
|
#ifdef SIGPOLL
|
|
{SIGPOLL, "poll", 0},
|
|
#endif
|
|
#ifdef SIGXCPU
|
|
{SIGXCPU, "xcpu", 0},
|
|
#endif
|
|
#ifdef SIGXFSZ
|
|
{SIGXFSZ, "xfsz", 0},
|
|
#endif
|
|
#ifdef SIGVTALRM
|
|
{SIGVTALRM, "vtalrm", 0},
|
|
#endif
|
|
#ifdef SIGPROF
|
|
{SIGPROF, "prof", 0},
|
|
#endif
|
|
#ifdef SIGPWR
|
|
{SIGPWR, "pwr", 0},
|
|
#endif
|
|
{SIG_EXCEPTION, "prolog:exception", 0},
|
|
#ifdef SIG_ATOM_GC
|
|
{SIG_ATOM_GC, "prolog:atom_gc", 0},
|
|
#endif
|
|
{SIG_GC, "prolog:gc", 0},
|
|
#ifdef SIG_THREAD_SIGNAL
|
|
{SIG_THREAD_SIGNAL, "prolog:thread_signal", 0},
|
|
#endif
|
|
|
|
{-1, NULL, 0}};
|
|
|
|
#if HAVE_SIGACTION
|
|
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);
|
|
}
|
|
|
|
static void my_signal(int sig, void *handler) {
|
|
struct sigaction sigact;
|
|
|
|
sigact.sa_handler = (void *)handler;
|
|
sigemptyset(&sigact.sa_mask);
|
|
sigact.sa_flags = 0;
|
|
sigaction(sig, &sigact, NULL);
|
|
}
|
|
|
|
#else
|
|
|
|
static void my_signal(int sig, void *handler) {
|
|
#if HAVE_SIGNAL
|
|
signal(sig, handler);
|
|
#endif
|
|
}
|
|
|
|
static void my_signal_info(int sig, void *handler) {
|
|
#if HAVE_SIGNAL
|
|
if (signal(sig, (void *)handler) == SIG_ERR)
|
|
exit(1);
|
|
#endif
|
|
}
|
|
|
|
#endif
|
|
|
|
static void HandleMatherr(int sig, void *sipv, void *uapv) {
|
|
CACHE_REGS
|
|
LOCAL_Error_TYPE = Yap_MathException();
|
|
/* reset the registers so that we don't have trash in abstract machine */
|
|
Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
|
|
}
|
|
|
|
/* SWI emulation */
|
|
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;
|
|
}
|
|
|
|
for (; sn->name; sn++) {
|
|
if (!strcmp(sn->name, name))
|
|
return sn->sig;
|
|
}
|
|
|
|
return -1;
|
|
}
|
|
|
|
#if HAVE_SIGSEGV
|
|
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);
|
|
}
|
|
/* 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");
|
|
}
|
|
|
|
/* 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) {
|
|
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);
|
|
}
|
|
#if (defined(__svr4__) || defined(__SVR4))
|
|
siginfo_t *sip = sipv;
|
|
if (sip->si_code != SI_NOINFO && sip->si_code == SEGV_MAPERR) {
|
|
ptr = sip->si_addr;
|
|
sure = TRUE;
|
|
}
|
|
#elif __linux__
|
|
siginfo_t *sip = sipv;
|
|
ptr = sip->si_addr;
|
|
sure = TRUE;
|
|
#endif
|
|
SearchForTrailFault(ptr, sure);
|
|
}
|
|
#endif /* SIGSEGV */
|
|
|
|
/* 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;
|
|
#elif HAVE_FEENABLEEXCEPT
|
|
/* I shall ignore de-normalization and precision errors */
|
|
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
|
|
#elif defined(__hpux)
|
|
#if HAVE_FESETTRAPENABLE
|
|
/* From HP-UX 11.0 onwards: */
|
|
fesettrapenable(FE_INVALID | FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW);
|
|
#else
|
|
/*
|
|
Up until HP-UX 10.20:
|
|
FP_X_INV invalid operation exceptions
|
|
FP_X_DZ divide-by-zero exception
|
|
FP_X_OFL overflow exception
|
|
FP_X_UFL underflow exception
|
|
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
|
|
#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);
|
|
_FPU_SETCW(v);
|
|
#endif
|
|
#if HAVE_FETESTEXCEPT
|
|
feclearexcept(FE_ALL_EXCEPT);
|
|
#endif
|
|
#ifdef HAVE_SIGFPE
|
|
my_signal(SIGFPE, HandleMatherr);
|
|
#endif
|
|
} else {
|
|
/* do IEEE arithmetic in the way the big boys do */
|
|
#if HAVE_FESETEXCEPTFLAG
|
|
fexcept_t excepts;
|
|
return fesetexceptflag(&excepts, 0) == 0;
|
|
#elif HAVE_FEENABLEEXCEPT
|
|
/* I shall ignore de-normalization and precision errors */
|
|
feenableexcept(0);
|
|
#elif _WIN32
|
|
// Enable zero-divide, overflow and underflow exception
|
|
_controlfp_s(0, (_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW),
|
|
_MCW_EM); // Line B
|
|
#elif defined(__hpux)
|
|
#if HAVE_FESETTRAPENABLE
|
|
fesettrapenable(FE_ALL_EXCEPT);
|
|
#else
|
|
fpsetmask(FP_X_CLEAR);
|
|
#endif
|
|
#endif /* __hpux */
|
|
#if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__)
|
|
/* this will probably not work in older releases of Linux */
|
|
int v = _FPU_IEEE;
|
|
_FPU_SETCW(v);
|
|
#endif
|
|
#ifdef HAVE_SIGFPE
|
|
my_signal(SIGFPE, SIG_IGN);
|
|
#endif
|
|
}
|
|
return true;
|
|
}
|
|
|
|
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__)
|
|
|
|
static void ReceiveSignal(int s, void *x, void *y) {
|
|
CACHE_REGS
|
|
LOCAL_PrologMode |= InterruptMode;
|
|
if (s == SIGINT && (LOCAL_PrologMode & ConsoleGetcMode)) {
|
|
return;
|
|
}
|
|
my_signal(s, ReceiveSignal);
|
|
switch (s) {
|
|
case SIGINT:
|
|
// always direct SIGINT to console
|
|
Yap_HandleSIGINT();
|
|
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;
|
|
#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;
|
|
#endif
|
|
#ifdef SIGUSR1
|
|
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;
|
|
#endif /* defined(SIGUSR2) */
|
|
#ifdef SIGPIPE
|
|
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;
|
|
#endif /* defined(SIGHUP) */
|
|
default:
|
|
fprintf(stderr, "\n[ Unexpected signal ]\n");
|
|
exit(s);
|
|
}
|
|
LOCAL_PrologMode &= ~InterruptMode;
|
|
}
|
|
#endif
|
|
|
|
#if (_MSC_VER || defined(__MINGW32__))
|
|
static BOOL WINAPI MSCHandleSignal(DWORD dwCtrlType) {
|
|
if (
|
|
#if THREADS
|
|
REMOTE_InterruptsDisabled(0)
|
|
#else
|
|
LOCAL_InterruptsDisabled
|
|
#endif
|
|
) {
|
|
return FALSE;
|
|
}
|
|
switch (dwCtrlType) {
|
|
case CTRL_C_EVENT:
|
|
case CTRL_BREAK_EVENT:
|
|
#if THREADS
|
|
Yap_external_signal(0, YAP_WINTIMER_SIGNAL);
|
|
REMOTE_PrologMode(0) |= InterruptMode;
|
|
#else
|
|
Yap_signal(YAP_WINTIMER_SIGNAL);
|
|
LOCAL_PrologMode |= InterruptMode;
|
|
#endif
|
|
return (TRUE);
|
|
default:
|
|
return (FALSE);
|
|
}
|
|
}
|
|
#endif
|
|
|
|
/* 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;
|
|
|
|
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);
|
|
#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 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);
|
|
}
|
|
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);
|
|
#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;
|
|
#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 */
|
|
|
|
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;
|
|
}
|
|
}
|
|
}
|
|
|
|
#endif
|
|
|
|
#if defined(_WIN32)
|
|
|
|
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;
|
|
}
|
|
#endif
|
|
|
|
#if (defined(YAPOR) || defined(THREADS)) && !defined(USE_PTHREAD_LOCKING)
|
|
#ifdef sparc
|
|
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");
|
|
}
|
|
#endif /* sparc */
|
|
|
|
#endif /* YAPOR || THREADS */
|
|
|
|
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))) {
|
|
|
|
feclearexcept(FE_ALL_EXCEPT);
|
|
if (raised & FE_OVERFLOW) {
|
|
return EVALUATION_ERROR_FLOAT_OVERFLOW;
|
|
} else if (raised & FE_DIVBYZERO) {
|
|
return EVALUATION_ERROR_ZERO_DIVISOR;
|
|
} else if (raised & FE_UNDERFLOW) {
|
|
return EVALUATION_ERROR_FLOAT_UNDERFLOW;
|
|
//} else if (raised & (FE_INVALID|FE_INEXACT)) {
|
|
// return EVALUATION_ERROR_UNDEFINED;
|
|
} else {
|
|
return EVALUATION_ERROR_UNDEFINED;
|
|
}
|
|
}
|
|
#elif _WIN32
|
|
unsigned int raised;
|
|
int err;
|
|
|
|
// Show original FP control word and do calculation.
|
|
err = _controlfp_s(&raised, 0, 0);
|
|
if (err) {
|
|
return EVALUATION_ERROR_UNDEFINED;
|
|
}
|
|
if (raised) {
|
|
feclearexcept(FE_ALL_EXCEPT);
|
|
if (raised & FE_OVERFLOW) {
|
|
return EVALUATION_ERROR_FLOAT_OVERFLOW;
|
|
} else if (raised & FE_DIVBYZERO) {
|
|
return EVALUATION_ERROR_ZERO_DIVISOR;
|
|
} else if (raised & FE_UNDERFLOW) {
|
|
return EVALUATION_ERROR_FLOAT_UNDERFLOW;
|
|
//} else if (raised & (FE_INVALID|FE_INEXACT)) {
|
|
// return EVALUATION_ERROR_UNDEFINED;
|
|
} else {
|
|
return EVALUATION_ERROR_UNDEFINED;
|
|
}
|
|
}
|
|
#elif (defined(__svr4__) || defined(__SVR4))
|
|
switch (sip->si_code) {
|
|
case FPE_INTDIV:
|
|
return EVALUATION_ERROR_ZERO_DIVISOR;
|
|
break;
|
|
case FPE_INTOVF:
|
|
return EVALUATION_ERROR_INT_OVERFLOW;
|
|
break;
|
|
case FPE_FLTDIV:
|
|
return EVALUATION_ERROR_ZERO_DIVISOR;
|
|
break;
|
|
case FPE_FLTOVF:
|
|
return EVALUATION_ERROR_FLOAT_OVERFLOW;
|
|
break;
|
|
case FPE_FLTUND:
|
|
return EVALUATION_ERROR_FLOAT_UNDERFLOW;
|
|
break;
|
|
case FPE_FLTRES:
|
|
case FPE_FLTINV:
|
|
case FPE_FLTSUB:
|
|
default:
|
|
return EVALUATION_ERROR_UNDEFINED;
|
|
}
|
|
set_fpu_exceptions(0);
|
|
#endif
|
|
|
|
return LOCAL_Error_TYPE;
|
|
}
|
|
|
|
/* 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);
|
|
#endif
|
|
#ifdef SIGPIPE
|
|
my_signal(SIGPIPE, ReceiveSignal);
|
|
#endif
|
|
#if _MSC_VER || defined(__MINGW32__)
|
|
signal(SIGINT, SIG_IGN);
|
|
SetConsoleCtrlHandler(MSCHandleSignal, TRUE);
|
|
#else
|
|
my_signal(SIGINT, ReceiveSignal);
|
|
#endif
|
|
#ifdef HAVE_SIGFPE
|
|
my_signal(SIGFPE, HandleMatherr);
|
|
#endif
|
|
#if HAVE_SIGSEGV
|
|
my_signal_info(SIGSEGV, HandleSIGSEGV);
|
|
#endif
|
|
#ifdef YAPOR_COW
|
|
signal(SIGCHLD, SIG_IGN); /* avoid ghosts */
|
|
#endif
|
|
}
|
|
}
|
|
|
|
bool Yap_set_fpu_exceptions(Term flag) { return set_fpu_exceptions(flag); }
|
|
|
|
void Yap_InitSignalPreds(void) {
|
|
CACHE_REGS
|
|
Term cm = CurrentModule;
|
|
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;
|
|
}
|