This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/os/sig.c

892 lines
23 KiB
C
Raw Normal View History

#include "sysbits.h"
#if HAVE_SIGNAL
#ifdef MSH
2016-04-05 02:53:39 +01:00
#define SIGFPE SIGDIV
#endif
2016-04-05 02:53:39 +01:00
static void HandleMatherr(int sig, void *sipv, void *uapv);
2016-04-05 02:53:39 +01:00
#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 */
2016-04-05 02:53:39 +01:00
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
2016-04-05 02:53:39 +01:00
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET + 0)
#ifdef ATOMGC
2016-04-05 02:53:39 +01:00
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET + 1)
#endif
2016-04-05 02:53:39 +01:00
#define SIG_GC (SIG_PROLOG_OFFSET + 2)
#ifdef THREADS
2016-04-05 02:53:39 +01:00
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3)
#endif
2016-04-05 02:53:39 +01:00
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET + 4)
#define SIG_PLABORT (SIG_PROLOG_OFFSET + 5)
2016-04-05 02:53:39 +01:00
static struct signame {
int sig;
const char *name;
2016-04-05 02:53:39 +01:00
int flags;
} signames[] = {
#ifdef SIGHUP
2016-04-05 02:53:39 +01:00
{SIGHUP, "hup", 0},
#endif
2016-04-05 02:53:39 +01:00
{SIGINT, "int", 0},
#ifdef SIGQUIT
2016-04-05 02:53:39 +01:00
{SIGQUIT, "quit", 0},
#endif
2016-04-05 02:53:39 +01:00
{SIGILL, "ill", 0},
{SIGABRT, "abrt", 0},
#if HAVE_SIGFPE
2016-04-05 02:53:39 +01:00
{SIGFPE, "fpe", PLSIG_THROW},
#endif
#ifdef SIGKILL
2016-04-05 02:53:39 +01:00
{SIGKILL, "kill", 0},
#endif
2016-04-05 02:53:39 +01:00
{SIGSEGV, "segv", 0},
#ifdef SIGPIPE
2016-04-05 02:53:39 +01:00
{SIGPIPE, "pipe", 0},
#endif
#ifdef SIGALRM
2016-04-05 02:53:39 +01:00
{SIGALRM, "alrm", PLSIG_THROW},
#endif
2016-04-05 02:53:39 +01:00
{SIGTERM, "term", 0},
#ifdef SIGUSR1
2016-04-05 02:53:39 +01:00
{SIGUSR1, "usr1", 0},
#endif
#ifdef SIGUSR2
2016-04-05 02:53:39 +01:00
{SIGUSR2, "usr2", 0},
#endif
#ifdef SIGCHLD
2016-04-05 02:53:39 +01:00
{SIGCHLD, "chld", 0},
#endif
#ifdef SIGCONT
2016-04-05 02:53:39 +01:00
{SIGCONT, "cont", 0},
#endif
#ifdef SIGSTOP
2016-04-05 02:53:39 +01:00
{SIGSTOP, "stop", 0},
#endif
#ifdef SIGTSTP
2016-04-05 02:53:39 +01:00
{SIGTSTP, "tstp", 0},
#endif
#ifdef SIGTTIN
2016-04-05 02:53:39 +01:00
{SIGTTIN, "ttin", 0},
#endif
#ifdef SIGTTOU
2016-04-05 02:53:39 +01:00
{SIGTTOU, "ttou", 0},
#endif
#ifdef SIGTRAP
2016-04-05 02:53:39 +01:00
{SIGTRAP, "trap", 0},
#endif
#ifdef SIGBUS
2016-04-05 02:53:39 +01:00
{SIGBUS, "bus", 0},
#endif
#ifdef SIGSTKFLT
2016-04-05 02:53:39 +01:00
{SIGSTKFLT, "stkflt", 0},
#endif
#ifdef SIGURG
2016-04-05 02:53:39 +01:00
{SIGURG, "urg", 0},
#endif
#ifdef SIGIO
2016-04-05 02:53:39 +01:00
{SIGIO, "io", 0},
#endif
#ifdef SIGPOLL
2016-04-05 02:53:39 +01:00
{SIGPOLL, "poll", 0},
#endif
#ifdef SIGXCPU
2016-04-05 02:53:39 +01:00
{SIGXCPU, "xcpu", PLSIG_THROW},
#endif
#ifdef SIGXFSZ
2016-04-05 02:53:39 +01:00
{SIGXFSZ, "xfsz", PLSIG_THROW},
#endif
#ifdef SIGVTALRM
2016-04-05 02:53:39 +01:00
{SIGVTALRM, "vtalrm", PLSIG_THROW},
#endif
#ifdef SIGPROF
2016-04-05 02:53:39 +01:00
{SIGPROF, "prof", 0},
#endif
#ifdef SIGPWR
2016-04-05 02:53:39 +01:00
{SIGPWR, "pwr", 0},
#endif
2016-04-05 02:53:39 +01:00
{SIG_EXCEPTION, "prolog:exception", 0},
#ifdef SIG_ATOM_GC
2016-04-05 02:53:39 +01:00
{SIG_ATOM_GC, "prolog:atom_gc", 0},
#endif
2016-04-05 02:53:39 +01:00
{SIG_GC, "prolog:gc", 0},
#ifdef SIG_THREAD_SIGNAL
2016-04-05 02:53:39 +01:00
{SIG_THREAD_SIGNAL, "prolog:thread_signal", 0},
#endif
2016-04-05 02:53:39 +01:00
{-1, NULL, 0}};
typedef void (*signal_handler_t)(int, void *, void *);
#if HAVE_SIGACTION
2016-04-05 02:53:39 +01:00
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;
2016-04-05 02:53:39 +01:00
sigaction(sig, &sigact, NULL);
}
2016-04-05 02:53:39 +01:00
static void my_signal(int sig, void *handler) {
struct sigaction sigact;
2016-04-05 02:53:39 +01:00
sigact.sa_handler = (void *)handler;
sigemptyset(&sigact.sa_mask);
sigact.sa_flags = 0;
2016-04-05 02:53:39 +01:00
sigaction(sig, &sigact, NULL);
}
#else
2016-04-05 02:53:39 +01:00
static void my_signal(int sig, void *handler) { signal(sig, handler); }
2016-04-05 02:53:39 +01:00
static void my_signal_info(int sig, void *handler) {
if (signal(sig, (void *)handler) == SIG_ERR)
exit(1);
}
#endif
/* SWI emulation */
2016-04-05 02:53:39 +01:00
int Yap_signal_index(const char *name) {
struct signame *sn = signames;
char tmp[12];
2016-04-05 02:53:39 +01:00
if (strncmp(name, "SIG", 3) == 0 && strlen(name) < 12) {
char *p = (char *)name + 3, *q = tmp;
while ((*q++ = tolower(*p++))) {
};
name = tmp;
}
2016-04-05 02:53:39 +01:00
for (; sn->name; sn++) {
if (!strcmp(sn->name, name))
return sn->sig;
}
return -1;
}
#if HAVE_SIGINFO_H
#include <siginfo.h>
#endif
#if HAVE_SYS_UCONTEXT_H
#include <sys/ucontext.h>
#endif
#if HAVE_SIGSEGV
2016-04-05 02:53:39 +01:00
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 */
2016-04-05 02:53:39 +01:00
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 */
2016-04-05 02:53:39 +01:00
static void HandleSIGSEGV(int sig, void *sipv, void *uap) {
CACHE_REGS
2016-04-05 02:53:39 +01:00
void *ptr = TR;
int sure = FALSE;
if (LOCAL_PrologMode & ExtendStackMode) {
2016-04-05 02:53:39 +01:00
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;
2016-04-05 02:53:39 +01:00
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
2016-04-05 02:53:39 +01:00
SearchForTrailFault(ptr, sure);
}
#endif /* SIGSEGV */
#if HAVE_SIGFPE
#if HAVE_FPU_CONTROL_H
#include <fpu_control.h>
#endif
2016-04-05 02:53:39 +01:00
/* 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;
2016-04-05 02:53:39 +01:00
return fesetexceptflag(&excepts,
FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW) == 0;
#elif HAVE_FEENABLEEXCEPT
/* I shall ignore de-normalization and precision errors */
2016-04-05 02:53:39 +01:00
feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW);
#elif _WIN32
// Enable zero-divide, overflow and underflow exception
2016-04-05 02:53:39 +01:00
_controlfp_s(0, ~(_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW),
_MCW_EM); // Line B
#elif defined(__hpux)
2016-04-05 02:53:39 +01:00
#if HAVE_FESETTRAPENABLE
/* From HP-UX 11.0 onwards: */
2016-04-05 02:53:39 +01:00
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
*/
2016-04-05 02:53:39 +01:00
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 */
2016-04-05 02:53:39 +01:00
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
2016-04-05 02:53:39 +01:00
my_signal(SIGFPE, HandleMatherr);
#endif
} else {
2016-04-05 02:53:39 +01:00
/* 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
2016-04-05 02:53:39 +01:00
_controlfp_s(0, (_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW),
_MCW_EM); // Line B
#elif defined(__hpux)
2016-04-05 02:53:39 +01:00
#if HAVE_FESETTRAPENABLE
fesettrapenable(FE_ALL_EXCEPT);
2016-04-05 02:53:39 +01:00
#else
fpsetmask(FP_X_CLEAR);
2016-04-05 02:53:39 +01:00
#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
2016-04-05 02:53:39 +01:00
my_signal(SIGFPE, SIG_IGN);
#endif
}
return true;
}
2016-04-05 02:53:39 +01:00
bool Yap_set_fpu_exceptions(Term flag) { return set_fpu_exceptions(flag); }
2016-04-05 02:53:39 +01:00
yap_error_number Yap_MathException__(USES_REGS1) {
#if HAVE_FETESTEXCEPT
int raised;
// #pragma STDC FENV_ACCESS ON
2016-04-05 02:53:39 +01:00
if ((raised = fetestexcept(FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW))) {
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & FE_DIVBYZERO) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_FLOAT_UNDERFLOW;
//} else if (raised & (FE_INVALID|FE_INEXACT)) {
// return EVALUATION_ERROR_UNDEFINED;
} else {
2016-04-05 02:53:39 +01:00
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) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_UNDEFINED;
}
2016-04-05 02:53:39 +01:00
if (raised) {
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_FLOAT_OVERFLOW;
} else if (raised & FE_DIVBYZERO) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_ZERO_DIVISOR;
} else if (raised & FE_UNDERFLOW) {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_FLOAT_UNDERFLOW;
//} else if (raised & (FE_INVALID|FE_INEXACT)) {
// return EVALUATION_ERROR_UNDEFINED;
} else {
2016-04-05 02:53:39 +01:00
return EVALUATION_ERROR_UNDEFINED;
}
}
#elif (defined(__svr4__) || defined(__SVR4))
2016-04-05 02:53:39 +01:00
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_matherror;
}
2016-04-05 02:53:39 +01:00
static Int fpe_error(USES_REGS1) {
Yap_Error(LOCAL_matherror, LOCAL_mathtt, LOCAL_mathstring);
LOCAL_matherror = YAP_NO_ERROR;
LOCAL_mathtt = TermNil;
LOCAL_mathstring = NULL;
return FALSE;
}
2016-04-05 02:53:39 +01:00
static void HandleMatherr(int sig, void *sipv, void *uapv) {
CACHE_REGS
2016-04-05 02:53:39 +01:00
LOCAL_matherror = Yap_MathException();
/* reset the registers so that we don't have trash in abstract machine */
2016-04-05 02:53:39 +01:00
Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
}
#endif /* SIGFPE */
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
2016-04-05 02:53:39 +01:00
static RETSIGTYPE ReceiveSignal(int s, void *x, void *y) {
CACHE_REGS
2016-04-05 02:53:39 +01:00
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
2016-04-05 02:53:39 +01:00
case SIGFPE:
Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
break;
#endif
#endif
#if !defined(LIGHT) && !defined(_WIN32)
2016-04-05 02:53:39 +01:00
/* 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
2016-04-05 02:53:39 +01:00
case SIGUSR1:
/* force the system to creep */
Yap_external_signal(worker_id, YAP_USR1_SIGNAL);
break;
#endif /* defined(SIGUSR1) */
#ifdef SIGUSR2
2016-04-05 02:53:39 +01:00
case SIGUSR2:
/* force the system to creep */
Yap_external_signal(worker_id, YAP_USR2_SIGNAL);
break;
#endif /* defined(SIGUSR2) */
#ifdef SIGPIPE
2016-04-05 02:53:39 +01:00
case SIGPIPE:
/* force the system to creep */
Yap_external_signal(worker_id, YAP_PIPE_SIGNAL);
break;
#endif /* defined(SIGPIPE) */
#ifdef SIGHUP
2016-04-05 02:53:39 +01:00
case SIGHUP:
/* force the system to creep */
/* Just ignore SUGHUP Yap_signal (YAP_HUP_SIGNAL); */
break;
#endif /* defined(SIGHUP) */
2016-04-05 02:53:39 +01:00
default:
fprintf(stderr, "\n[ Unexpected signal ]\n");
exit(s);
}
LOCAL_PrologMode &= ~InterruptMode;
}
#endif
#if (_MSC_VER || defined(__MINGW32__))
2016-04-05 02:53:39 +01:00
static BOOL WINAPI MSCHandleSignal(DWORD dwCtrlType) {
if (
#if THREADS
REMOTE_InterruptsDisabled(0)
2016-04-05 02:53:39 +01:00
#else
LOCAL_InterruptsDisabled
#endif
2016-04-05 02:53:39 +01:00
) {
return FALSE;
}
2016-04-05 02:53:39 +01:00
switch (dwCtrlType) {
case CTRL_C_EVENT:
case CTRL_BREAK_EVENT:
#if THREADS
2016-04-05 02:53:39 +01:00
Yap_external_signal(0, YAP_WINTIMER_SIGNAL);
REMOTE_PrologMode(0) |= InterruptMode;
#else
2016-04-05 02:53:39 +01:00
Yap_signal(YAP_WINTIMER_SIGNAL);
LOCAL_PrologMode |= InterruptMode;
#endif
2016-04-05 02:53:39 +01:00
return (TRUE);
default:
return (FALSE);
}
2016-04-05 02:53:39 +01:00
}
#endif
2016-04-05 02:53:39 +01:00
/* 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)
2016-04-05 02:53:39 +01:00
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
2016-04-05 02:53:39 +01:00
my_signal(SIGPIPE, ReceiveSignal);
#endif
#if _MSC_VER || defined(__MINGW32__)
2016-04-05 02:53:39 +01:00
signal(SIGINT, SIG_IGN);
SetConsoleCtrlHandler(MSCHandleSignal, TRUE);
#else
2016-04-05 02:53:39 +01:00
my_signal(SIGINT, ReceiveSignal);
#endif
#ifdef HAVE_SIGFPE
2016-04-05 02:53:39 +01:00
my_signal(SIGFPE, HandleMatherr);
#endif
#if HAVE_SIGSEGV
2016-04-05 02:53:39 +01:00
my_signal_info(SIGSEGV, HandleSIGSEGV);
#endif
#ifdef YAPOR_COW
2016-04-05 02:53:39 +01:00
signal(SIGCHLD, SIG_IGN); /* avoid ghosts */
#endif
}
2016-04-05 02:53:39 +01:00
}
#endif /* HAVE_SIGNAL */
2016-04-05 02:53:39 +01:00
/* wrapper for alarm system call */
#if _MSC_VER || defined(__MINGW32__)
2016-04-05 02:53:39 +01:00
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
2016-04-05 02:53:39 +01:00
return (0L);
#endif
2016-04-05 02:53:39 +01:00
}
#endif
2016-04-05 02:53:39 +01:00
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);
}
2016-04-05 02:53:39 +01:00
return TRUE;
}
2016-04-05 02:53:39 +01:00
static Int disable_interrupts(USES_REGS1) {
LOCAL_InterruptsDisabled++;
CalculateStackGap(PASS_REGS1);
return TRUE;
}
2016-04-05 02:53:39 +01:00
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
2016-04-05 02:53:39 +01:00
Yap_get_signal(YAP_WINTIMER_SIGNAL);
#else
2016-04-05 02:53:39 +01:00
Yap_get_signal(YAP_ALARM_SIGNAL);
#endif
2016-04-05 02:53:39 +01:00
}
#if _MSC_VER || defined(__MINGW32__)
2016-04-05 02:53:39 +01:00
{
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");
}
}
2016-04-05 02:53:39 +01:00
tout = MkIntegerTerm(0);
return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
}
#elif HAVE_SETITIMER && !SUPPORT_CONDOR
2016-04-05 02:53:39 +01:00
{
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
2016-04-05 02:53:39 +01:00
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s",
strerror(errno));
#else
2016-04-05 02:53:39 +01:00
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno);
#endif
2016-04-05 02:53:39 +01:00
return FALSE;
}
2016-04-05 02:53:39 +01:00
return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) &&
Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec));
}
#elif HAVE_ALARM && !SUPPORT_CONDOR
2016-04-05 02:53:39 +01:00
{
Int left;
Term tout;
2016-04-05 02:53:39 +01:00
left = alarm(i1);
tout = MkIntegerTerm(left);
return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
}
#else
2016-04-05 02:53:39 +01:00
/* 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
2016-04-05 02:53:39 +01:00
}
2016-04-05 02:53:39 +01:00
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__)
2016-04-05 02:53:39 +01:00
{
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");
}
}
2016-04-05 02:53:39 +01:00
tout = MkIntegerTerm(0);
return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
}
#elif HAVE_SETITIMER && !SUPPORT_CONDOR
2016-04-05 02:53:39 +01:00
{
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
2016-04-05 02:53:39 +01:00
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s",
strerror(errno));
#else
2016-04-05 02:53:39 +01:00
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno);
#endif
2016-04-05 02:53:39 +01:00
return FALSE;
}
2016-04-05 02:53:39 +01:00
return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) &&
Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec));
}
#else
2016-04-05 02:53:39 +01:00
/* 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
2016-04-05 02:53:39 +01:00
}
#ifdef VAX
2016-04-05 02:53:39 +01:00
/* 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;
}
2016-04-05 02:53:39 +01:00
* 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 >= &REGS[6] && fp->oldfp < &REGS[REG_SIZE])
fp->oldfp = vax_absmi_fp;
return;
}
}
2016-04-05 02:53:39 +01:00
}
#endif
#if defined(_WIN32)
#include <windows.h>
2016-04-05 02:53:39 +01:00
int WINAPI win_yap(HANDLE, DWORD, LPVOID);
2016-04-05 02:53:39 +01:00
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;
}
2016-04-05 02:53:39 +01:00
return 1;
}
#endif
#if (defined(YAPOR) || defined(THREADS)) && !defined(USE_PTHREAD_LOCKING)
#ifdef sparc
2016-04-05 02:53:39 +01:00
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 */
2016-04-05 02:53:39 +01:00
void Yap_InitSignalPreds(void) {
CACHE_REGS
Term cm = CurrentModule;
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;
}