929 lines
22 KiB
C
929 lines
22 KiB
C
|
|
||
|
|
|
||
|
|
#include "sysbits.h"
|
||
|
|
|
||
|
|
#if HAVE_SIGNAL_H
|
||
|
|
|
||
|
|
#include <signal.h>
|
||
|
|
|
||
|
|
#ifdef MPW
|
||
|
|
#define signal sigset
|
||
|
|
#endif
|
||
|
|
|
||
|
|
|
||
|
|
#ifdef MSH
|
||
|
|
|
||
|
|
#define SIGFPE SIGDIV
|
||
|
|
|
||
|
|
#endif
|
||
|
|
|
||
|
|
static void HandleMatherr(int sig, void *sipv, void *uapv);
|
||
|
|
|
||
|
|
#define PLSIG_PREPARED 0x01 /* signal is prepared */
|
||
|
|
#define PLSIG_THROW 0x02 /* throw signal(num, name) */
|
||
|
|
#define PLSIG_SYNC 0x04 /* call synchronously */
|
||
|
|
#define PLSIG_NOFRAME 0x08 /* Do not create a Prolog frame */
|
||
|
|
|
||
|
|
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
|
||
|
|
|
||
|
|
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET+0)
|
||
|
|
#ifdef ATOMGC
|
||
|
|
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET+1)
|
||
|
|
#endif
|
||
|
|
#define SIG_GC (SIG_PROLOG_OFFSET+2)
|
||
|
|
#ifdef THREADS
|
||
|
|
#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},
|
||
|
|
#if HAVE_SIGFPE
|
||
|
|
{ SIGFPE, "fpe", PLSIG_THROW},
|
||
|
|
#endif
|
||
|
|
#ifdef SIGKILL
|
||
|
|
{ SIGKILL, "kill", 0},
|
||
|
|
#endif
|
||
|
|
{ SIGSEGV, "segv", 0},
|
||
|
|
#ifdef SIGPIPE
|
||
|
|
{ SIGPIPE, "pipe", 0},
|
||
|
|
#endif
|
||
|
|
#ifdef SIGALRM
|
||
|
|
{ SIGALRM, "alrm", PLSIG_THROW},
|
||
|
|
#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", PLSIG_THROW},
|
||
|
|
#endif
|
||
|
|
#ifdef SIGXFSZ
|
||
|
|
{ SIGXFSZ, "xfsz", PLSIG_THROW},
|
||
|
|
#endif
|
||
|
|
#ifdef SIGVTALRM
|
||
|
|
{ SIGVTALRM, "vtalrm", PLSIG_THROW},
|
||
|
|
#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}
|
||
|
|
};
|
||
|
|
|
||
|
|
typedef void (*signal_handler_t)(int, void *, void *);
|
||
|
|
|
||
|
|
#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)
|
||
|
|
{
|
||
|
|
signal(sig, handler);
|
||
|
|
}
|
||
|
|
|
||
|
|
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;
|
||
|
|
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_SIGINFO_H
|
||
|
|
#include <siginfo.h>
|
||
|
|
#endif
|
||
|
|
#if HAVE_SYS_UCONTEXT_H
|
||
|
|
#include <sys/ucontext.h>
|
||
|
|
#endif
|
||
|
|
|
||
|
|
#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 */
|
||
|
|
|
||
|
|
#if HAVE_SIGFPE
|
||
|
|
|
||
|
|
#if HAVE_FPU_CONTROL_H
|
||
|
|
#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)
|
||
|
|
{
|
||
|
|
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;
|
||
|
|
}
|
||
|
|
|
||
|
|
bool
|
||
|
|
Yap_set_fpu_exceptions(Term flag)
|
||
|
|
{
|
||
|
|
return set_fpu_exceptions(flag);
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
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 && FALSE
|
||
|
|
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_matherror;
|
||
|
|
}
|
||
|
|
|
||
|
|
static Int
|
||
|
|
p_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;
|
||
|
|
}
|
||
|
|
|
||
|
|
static void
|
||
|
|
HandleMatherr(int sig, void *sipv, void *uapv)
|
||
|
|
{
|
||
|
|
CACHE_REGS
|
||
|
|
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 );
|
||
|
|
}
|
||
|
|
|
||
|
|
#endif /* SIGFPE */
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
|
||
|
|
static RETSIGTYPE
|
||
|
|
ReceiveSignal (int s, void *x, void *y)
|
||
|
|
{
|
||
|
|
CACHE_REGS
|
||
|
|
LOCAL_PrologMode |= InterruptMode;
|
||
|
|
my_signal (s, ReceiveSignal);
|
||
|
|
switch (s)
|
||
|
|
{
|
||
|
|
case SIGINT:
|
||
|
|
// always direct SIGINT to console
|
||
|
|
Yap_external_signal( 0, YAP_INT_SIGNAL );
|
||
|
|
break;
|
||
|
|
case SIGALRM:
|
||
|
|
Yap_external_signal( worker_id, YAP_ALARM_SIGNAL );
|
||
|
|
break;
|
||
|
|
case SIGVTALRM:
|
||
|
|
Yap_external_signal( worker_id, YAP_VTALARM_SIGNAL );
|
||
|
|
break;
|
||
|
|
#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
|
||
|
|
|
||
|
|
|
||
|
|
/* 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
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#endif /* HAVE_SIGNAL */
|
||
|
|
|
||
|
|
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)
|
||
|
|
|
||
|
|
#include <windows.h>
|
||
|
|
|
||
|
|
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 */
|
||
|
|
|
||
|
|
void
|
||
|
|
Yap_InitSignalPreds(void)
|
||
|
|
{
|
||
|
|
CACHE_REGS
|
||
|
|
Term cm = CurrentModule;
|
||
|
|
|
||
|
|
Yap_InitCPred ("$fpe_error", 0, p_fpe_error, 0);
|
||
|
|
Yap_InitCPred ("$alarm", 4, alarm4, SafePredFlag|SyncPredFlag);
|
||
|
|
CurrentModule = HACKS_MODULE;
|
||
|
|
Yap_InitCPred ("virtual_alarm", 4, virtual_alarm, SafePredFlag|SyncPredFlag);
|
||
|
|
Yap_InitCPred ("enable_interrupts", 0, enable_interrupts, SafePredFlag);
|
||
|
|
Yap_InitCPred ("disable_interrupts", 0, disable_interrupts, SafePredFlag);
|
||
|
|
CurrentModule = cm;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|