YAP 7.1.0
sig.c
1#include "sysbits.h"
2
3#if HAVE_SIGINFO_H
4#include <siginfo.h>
5#endif
6#if HAVE_SYS_UCONTEXT_H
7#include <sys/ucontext.h>
8#endif
9#if HAVE_FENV_H
10#include <fenv.h>
11#ifdef __APPLE__
12#pragma STDC FENV_ACCESS ON
13#endif
14#endif
15#if HAVE_FPU_CONTROL_H
16#include <fpu_control.h>
17#endif
18
19#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
20
21#define SIG_EXCEPTION (SIG_PROLOG_OFFSET + 0)
22#ifdef O_ATOMGC
23#define SIG_ATOM_GC (SIG_PROLOG_OFFSET + 1)
24#endif
25#define SIG_GC (SIG_PROLOG_OFFSET + 2)
26#ifdef O_PLMT
27#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET + 3)
28#endif
29#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET + 4)
30#define SIG_PLABORT (SIG_PROLOG_OFFSET + 5)
31
32static struct signame {
33 int sig;
34 const char *name;
35 int flags;
36} signames[] = {
37#ifdef SIGHUP
38 {SIGHUP, "hup", 0},
39#endif
40 {SIGINT, "int", 0},
41#ifdef SIGQUIT
42 {SIGQUIT, "quit", 0},
43#endif
44 {SIGILL, "ill", 0},
45 // {SIGABRT, "abrt", 0},
46 {SIGFPE, "fpe", 0},
47#ifdef SIGKILL
48 {SIGKILL, "kill", 0},
49#endif
50 {SIGSEGV, "segv", 0},
51#ifdef SIGPIPE
52 {SIGPIPE, "pipe", 0},
53#endif
54#ifdef SIGALRM
55 {SIGALRM, "alrm", 0},
56#endif
57 {SIGTERM, "term", 0},
58#ifdef SIGUSR1
59 {SIGUSR1, "usr1", 0},
60#endif
61#ifdef SIGUSR2
62 {SIGUSR2, "usr2", 0},
63#endif
64#ifdef SIGCHLD
65 {SIGCHLD, "chld", 0},
66#endif
67#ifdef SIGCONT
68 {SIGCONT, "cont", 0},
69#endif
70#ifdef SIGSTOP
71 {SIGSTOP, "stop", 0},
72#endif
73#ifdef SIGTSTP
74 {SIGTSTP, "tstp", 0},
75#endif
76#ifdef SIGTTIN
77 {SIGTTIN, "ttin", 0},
78#endif
79#ifdef SIGTTOU
80 {SIGTTOU, "ttou", 0},
81#endif
82#ifdef SIGTRAP
83 {SIGTRAP, "trap", 0},
84#endif
85#ifdef SIGBUS
86 {SIGBUS, "bus", 0},
87#endif
88#ifdef SIGSTKFLT
89 {SIGSTKFLT, "stkflt", 0},
90#endif
91#ifdef SIGURG
92 {SIGURG, "urg", 0},
93#endif
94#ifdef SIGIO
95 {SIGIO, "io", 0},
96#endif
97#ifdef SIGPOLL
98 {SIGPOLL, "poll", 0},
99#endif
100#ifdef SIGXCPU
101 {SIGXCPU, "xcpu", 0},
102#endif
103#ifdef SIGXFSZ
104 {SIGXFSZ, "xfsz", 0},
105#endif
106#ifdef SIGVTALRM
107 {SIGVTALRM, "vtalrm", 0},
108#endif
109#ifdef SIGPROF
110 {SIGPROF, "prof", 0},
111#endif
112#ifdef SIGPWR
113 {SIGPWR, "pwr", 0},
114#endif
115 {SIG_EXCEPTION, "prolog:exception", 0},
116#ifdef SIG_ATOM_GC
117 {SIG_ATOM_GC, "prolog:atom_gc", 0},
118#endif
119 {SIG_GC, "prolog:gc", 0},
120#ifdef SIG_THREAD_SIGNAL
121 {SIG_THREAD_SIGNAL, "prolog:thread_signal", 0},
122#endif
123
124 {-1, NULL, 0}};
125
126#if HAVE_SIGACTION
127static void my_signal_info(int sig, void *handler) {
128 struct sigaction sigact;
129
130 sigact.sa_handler = handler;
131 sigemptyset(&sigact.sa_mask);
132 sigact.sa_flags = SA_SIGINFO;
133
134 sigaction(sig, &sigact, NULL);
135}
136
137static void my_signal(int sig, void *handler) {
138 struct sigaction sigact;
139
140 sigact.sa_handler = (void *)handler;
141 sigemptyset(&sigact.sa_mask);
142 sigact.sa_flags = 0;
143 sigaction(sig, &sigact, NULL);
144}
145
146 int Yap_set_sigaction(int sig, void *handler) {
147 struct sigaction sigact;
148
149 sigact.sa_handler = (void *)handler;
150 sigemptyset(&sigact.sa_mask);
151 sigact.sa_flags = 0;
152 sigaction(sig, &sigact,NULL);
153}
154#else
155
156static void my_signal(int sig, void *handler) {
157#if HAVE_SIGNAL
158 signal(sig, handler);
159#endif
160}
161
162static void my_signal_info(int sig, void *handler) {
163#if HAVE_SIGNAL
164 if (signal(sig, (void *)handler) == SIG_ERR)
165 exit(1);
166#endif
167}
168
169#endif
170
171static void HandleMatherr(int sig, void *sipv, void *uapv) {
172 CACHE_REGS
173 LOCAL_Error_TYPE = Yap_MathException();
174 /* reset the registers so that we don't have trash in abstract machine */
175 Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
176}
177
178/* SWI emulation */
179int Yap_signal_index(const char *name) {
180 struct signame *sn = signames;
181 char tmp[12];
182
183 if (strncmp(name, "SIG", 3) == 0 && strlen(name) < 12) {
184 char *p = (char *)name + 3, *q = tmp;
185 while ((*q++ = tolower(*p++))) {
186 };
187 name = tmp;
188 }
189
190 for (; sn->name; sn++) {
191 if (!strcmp(sn->name, name))
192 return sn->sig;
193 }
194
195 return -1;
196}
197
198#if HAVE_SIGSEGV
199static void SearchForTrailFault(void *ptr, int sure) {
200
201/* If the TRAIL is very close to the top of mmaped allocked space,
202 then we can try increasing the TR space and restarting the
203 instruction. In the worst case, the system will
204 crash again
205*/
206#if OS_HANDLES_TR_OVERFLOW && !USE_SYSTEM_MALLOC
207 if ((ptr > (void *)LOCAL_TrailTop - 1024 &&
208 TR < (tr_fr_ptr)LOCAL_TrailTop + (64 * 1024))) {
209 if (!Yap_growtrail(64 * 1024, TRUE)) {
210 Yap_Error(RESOURCE_ERROR_TRAIL, TermNil,
211 "YAP failed to reserve %ld bytes in growtrail", K64);
212 }
213 /* just in case, make sure the OS keeps the signal handler. */
214 /* my_signal_info(SIGSEGV, HandleSIGSEGV); */
215 } else
216#endif /* OS_HANDLES_TR_OVERFLOW */
217 if (sure)
218 Yap_Error(SYSTEM_ERROR_FATAL, TermNil,
219 "tried to access illegal address %p!!!!", ptr);
220 else
221 Yap_Error(SYSTEM_ERROR_FATAL, TermNil,
222 "likely bug in YAP, segmentation violation");
223}
224
225/* This routine believes there is a continuous space starting from the
226 HeapBase and ending on TrailTop */
227static void
228HandleSIGSEGV(int sig, void *sipv, void *uap) {
229 CACHE_REGS
230
231 void *ptr = TR;
232 int sure = FALSE;
233 if (LOCAL_PrologMode & ExtendStackMode) {
234 Yap_Error(SYSTEM_ERROR_FATAL, TermNil,
235 "OS memory allocation crashed at address %p, bailing out\n",
236 LOCAL_TrailTop);
237 }
238#if (defined(__svr4__) || defined(__SVR4))
239 siginfo_t *sip = sipv;
240 if (sip->si_code != SI_NOINFO && sip->si_code == SEGV_MAPERR) {
241 ptr = sip->si_addr;
242 sure = TRUE;
243 }
244#elif __linux__
245 siginfo_t *sip = sipv;
246 ptr = sip->si_addr;
247 sure = TRUE;
248#endif
249 SearchForTrailFault(ptr, sure);
250}
251#endif /* SIGSEGV */
252
253/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend
254 * it is not. */
255bool Yap_set_fpu_exceptions(Term flag) {
256 if (flag == TermTrue) {
257#if HAVE_FENV_H
258 fexcept_t excepts = 0;
259 return fesetexceptflag(&excepts,
260 FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW) == 0;
261#elif HAVE_FEENABLEEXCEPTFLAG
262 /* I shall ignore de-normalization and precision errors */
263 feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW);
264#elif _WIN32
265 // Enable zero-divide, overflow and underflow exception
266 _controlfp_s(0, ~(_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW),
267 _MCW_EM); // Line B
268#elif defined(__hpux)
269#if HAVE_FESETTRAPENABLE
270 /* From HP-UX 11.0 onwards: */
271 fesettrapenable(FE_INVALID | FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW);
272#else
273 /*
274 Up until HP-UX 10.20:
275 FP_X_INV invalid operation exceptions
276 FP_X_DZ divide-by-zero exception
277 FP_X_OFL overflow exception
278 FP_X_UFL underflow exception
279 FP_X_IMP imprecise (inexact result)
280 FP_X_CLEAR simply zero to clear all flags
281 */
282 fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL | FP_X_UFL);
283#endif/* __hpux */
284#elif HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__)
285 /* I shall ignore denormalization and precision errors */
286 int v = _FPU_IEEE &
287 ~(_FPU_MASK_IM | _FPU_MASK_ZM | _FPU_MASK_OM | _FPU_MASK_UM);
288 _FPU_SETCW(v);
289#elif HAVE_FENV_H
290 feclearexcept(FE_ALL_EXCEPT);
291#endif
292#ifdef HAVE_SIGFPE
293 my_signal(SIGFPE, HandleMatherr);
294#endif
295 } else {
296/* do IEEE arithmetic in the way the big boys do */
297#if HAVE_FESETEXCEPTFLAG
298 fexcept_t excepts;
299 return fesetexceptflag(&excepts, 0) == 0;
300#elif HAVE_FEENABLEEXCEPT
301 /* I shall ignore de-normalization and precision errors */
302 feenableexcept(0);
303#elif _WIN32
304 // Enable zero-divide, overflow and underflow exception
305 _controlfp_s(0, (_EM_ZERODIVIDE | _EM_UNDERFLOW | _EM_OVERFLOW),
306 _MCW_EM); // Line B
307#elif defined(__hpux)
308#if HAVE_FESETTRAPENABLE
309 fesettrapenable(FE_ALL_EXCEPT);
310#else
311 fpsetmask(FP_X_CLEAR);
312#endif
313#endif /* __hpux */
314#if HAVE_FPU_CONTROL_H && i386 && defined(__GNUC__)
315 /* this will probably not work in older releases of Linux */
316 int v = _FPU_IEEE;
317 _FPU_SETCW(v);
318#endif
319#ifdef HAVE_SIGFPE
320 my_signal(SIGFPE, SIG_IGN);
321#endif
322 }
323 return true;
324}
325
326static void ReceiveSignal(int s, void *x, void *y) {
327 CACHE_REGS
328 LOCAL_PrologMode |= InterruptMode;
329#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__)
330
331 if (s == SIGINT && (LOCAL_PrologMode & ConsoleGetcMode)) {
332 return;
333 }
334#if !NOT_SIGACTION
335 my_signal(s, ReceiveSignal);
336#endif
337 switch (s) {
338 case SIGINT:
339 // always direct SIGINT to console
340 Yap_external_signal(worker_id, YAP_INT_SIGNAL);
341 break;
342 case SIGALRM:
343 Yap_external_signal(worker_id, YAP_ALARM_SIGNAL);
344 break;
345 case SIGVTALRM:
346 Yap_external_signal(worker_id, YAP_VTALARM_SIGNAL);
347 break;
348#ifndef MPW
349#ifdef HAVE_SIGFPE
350 case SIGFPE:
351 Yap_external_signal(worker_id, YAP_FPE_SIGNAL);
352 break;
353#endif
354#endif
355#if !defined(LIGHT) && !defined(_WIN32)
356 /* These signals are not handled by WIN32 and not the Macintosh */
357 case SIGQUIT:
358 case SIGKILL:
359 LOCAL_PrologMode &= ~InterruptMode;
360 Yap_Error(INTERRUPT_EVENT, MkIntTerm(s), NULL);
361 break;
362#endif
363#ifdef SIGUSR1
364 case SIGUSR1:
365 /* force the system to creep */
366 Yap_external_signal(worker_id, YAP_USR1_SIGNAL);
367 break;
368#endif /* defined(SIGUSR1) */
369#ifdef SIGUSR2
370 case SIGUSR2:
371 /* force the system to creep */
372 Yap_external_signal(worker_id, YAP_USR2_SIGNAL);
373 break;
374#endif /* defined(SIGUSR2) */
375#ifdef SIGPIPE
376 case SIGPIPE:
377 /* force the system to creep */
378 Yap_external_signal(worker_id, YAP_PIPE_SIGNAL);
379 break;
380#endif /* defined(SIGPIPE) */
381#ifdef SIGHUP
382 case SIGHUP:
383 /* force the system to creep */
384 /* Just ignore SUGHUP Yap_signal (YAP_HUP_SIGNAL); */
385 break;
386#endif /* defined(SIGHUP) */
387 default:
388 fprintf(stderr, "\n[ Unexpected signal ]\n");
389 exit(s);
390 }
391#endif
392 LOCAL_PrologMode &= ~InterruptMode;
393}
394
395#if (_MSC_VER || defined(__MINGW32__))
396static BOOL WINAPI MSCHandleSignal(DWORD dwCtrlType) {
397 if (
398#if THREADS
399 REMOTE_InterruptsDisabled(0)
400#else
401 LOCAL_InterruptsDisabled
402#endif
403 ) {
404 return FALSE;
405 }
406 switch (dwCtrlType) {
407 case CTRL_C_EVENT:
408 case CTRL_BREAK_EVENT:
409#if THREADS
410 Yap_external_signal(0, YAP_WINTIMER_SIGNAL);
411 REMOTE_PrologMode(0) |= InterruptMode;
412#else
413 Yap_signal(YAP_WINTIMER_SIGNAL);
414 LOCAL_PrologMode |= InterruptMode;
415#endif
416 return (TRUE);
417 default:
418 return (FALSE);
419 }
420}
421#endif
422
423/* wrapper for alarm system call */
424#if _MSC_VER || defined(__MINGW32__)
425
426static DWORD WINAPI DoTimerThread(LPVOID targ) {
427 Int *time = (Int *)targ;
428 HANDLE htimer;
429 LARGE_INTEGER liDueTime;
430
431 htimer = CreateWaitableTimer(NULL, FALSE, NULL);
432 liDueTime.QuadPart = -10000000;
433 liDueTime.QuadPart *= time[0];
434 /* add time in usecs */
435 liDueTime.QuadPart -= time[1] * 10;
436 /* Copy the relative time into a LARGE_INTEGER. */
437 if (SetWaitableTimer(htimer, &liDueTime, 0, NULL, NULL, 0) == 0) {
438 return (FALSE);
439 }
440 if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0)
441 fprintf(stderr, "WaitForSingleObject failed (%ld)\n", GetLastError());
442 Yap_signal(YAP_WINTIMER_SIGNAL);
443 /* now, say what is going on */
444 Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
445 ExitThread(1);
446#if _MSC_VER
447 return (0L);
448#endif
449}
450
451#endif
452
453static Int enable_interrupts(USES_REGS1) {
454 LOCAL_InterruptsDisabled--;
455 if (LOCAL_Signals && !LOCAL_InterruptsDisabled) {
456 CreepFlag = Unsigned(LCL0);
457 if (!Yap_only_has_signal(YAP_CREEP_SIGNAL))
458 EventFlag = Unsigned(LCL0);
459 }
460 return TRUE;
461}
462
463static Int disable_interrupts(USES_REGS1) {
464 LOCAL_InterruptsDisabled++;
465 CalculateStackGap(PASS_REGS1);
466 return TRUE;
467}
468
469
470
471static Int alarm4(USES_REGS1) {
472 Term t = Deref(ARG1);
473 Term t2 = Deref(ARG2);
474 Int i1, i2;
475 if (IsVarTerm(t)) {
476 Yap_Error(INSTANTIATION_ERROR, t, "alarm/2");
477 return (FALSE);
478 }
479 if (!IsIntegerTerm(t)) {
480 Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2");
481 return (FALSE);
482 }
483 if (IsVarTerm(t2)) {
484 Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2");
485 return (FALSE);
486 }
487 if (!IsIntegerTerm(t2)) {
488 Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2");
489 return (FALSE);
490 }
491 i1 = IntegerOfTerm(t);
492 i2 = IntegerOfTerm(t2);
493 if (i1 == 0 && i2 == 0) {
494#if _WIN32
495 Yap_get_signal(YAP_WINTIMER_SIGNAL);
496#else
497 Yap_get_signal(YAP_ALARM_SIGNAL);
498#endif
499 }
500#if _MSC_VER || defined(__MINGW32__)
501 {
502 Term tout;
503 Int time[2];
504
505 time[0] = i1;
506 time[1] = i2;
507
508 if (time[0] != 0 && time[1] != 0) {
509 DWORD dwThreadId;
510 HANDLE hThread;
511
512 hThread = CreateThread(NULL, /* no security attributes */
513 0, /* use default stack size */
514 DoTimerThread, /* thread function */
515 (LPVOID)time, /* argument to thread function */
516 0, /* use default creation flags */
517 &dwThreadId); /* returns the thread identifier */
518
519 /* Check the return value for success. */
520 if (hThread == NULL) {
521 Yap_WinError("trying to use alarm");
522 }
523 }
524 tout = MkIntTerm(0);
525 return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
526 }
527#elif HAVE_SETITIMER && !SUPPORT_CONDOR
528 {
529 struct itimerval new, old;
530
531 new.it_interval.tv_sec = 0;
532 new.it_interval.tv_usec = 0;
533 new.it_value.tv_sec = i1;
534 new.it_value.tv_usec = i2;
535 // Yap_do_low_level_trace=1;
536
537 if (setitimer(ITIMER_REAL, &new, &old) < 0) {
538#if HAVE_STRERROR
539 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s",
540 strerror(errno));
541#else
542 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno);
543#endif
544 return FALSE;
545 }
546 return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) &&
547 Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec));
548 }
549#elif HAVE_ALARM && !SUPPORT_CONDOR
550 {
551 Int left;
552 Term tout;
553
554 left = alarm(i1);
555 tout = MkIntegerTerm(left);
556 return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
557 }
558#else
559 /* not actually trying to set the alarm */
560 if (IntegerOfTerm(t) == 0)
561 return TRUE;
562 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
563 "alarm not available in this configuration");
564 return FALSE;
565#endif
566}
567
568static Int virtual_alarm(USES_REGS1) {
569 Term t = Deref(ARG1);
570 Term t2 = Deref(ARG2);
571 if (IsVarTerm(t)) {
572 Yap_Error(INSTANTIATION_ERROR, t, "alarm/2");
573 return (FALSE);
574 }
575 if (!IsIntegerTerm(t)) {
576 Yap_Error(TYPE_ERROR_INTEGER, t, "alarm/2");
577 return (FALSE);
578 }
579 if (IsVarTerm(t2)) {
580 Yap_Error(INSTANTIATION_ERROR, t2, "alarm/2");
581 return (FALSE);
582 }
583 if (!IsIntegerTerm(t2)) {
584 Yap_Error(TYPE_ERROR_INTEGER, t2, "alarm/2");
585 return (FALSE);
586 }
587#if _MSC_VER || defined(__MINGW32__)
588 {
589 Term tout;
590 Int time[2];
591
592 time[0] = IntegerOfTerm(t);
593 time[1] = IntegerOfTerm(t2);
594
595 if (time[0] != 0 && time[1] != 0) {
596 DWORD dwThreadId;
597 HANDLE hThread;
598
599 hThread = CreateThread(NULL, /* no security attributes */
600 0, /* use default stack size */
601 DoTimerThread, /* thread function */
602 (LPVOID)time, /* argument to thread function */
603 0, /* use default creation flags */
604 &dwThreadId); /* returns the thread identifier */
605
606 /* Check the return value for success. */
607 if (hThread == NULL) {
608 Yap_WinError("trying to use alarm");
609 }
610 }
611 tout = MkIntTerm(0);
612 return Yap_unify(ARG3, tout) && Yap_unify(ARG4, MkIntTerm(0));
613 }
614#elif HAVE_SETITIMER && !SUPPORT_CONDOR
615 {
616 struct itimerval new, old;
617
618 new.it_interval.tv_sec = 0;
619 new.it_interval.tv_usec = 0;
620 new.it_value.tv_sec = IntegerOfTerm(t);
621 new.it_value.tv_usec = IntegerOfTerm(t2);
622 if (setitimer(ITIMER_VIRTUAL, &new, &old) < 0) {
623#if HAVE_STRERROR
624 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer: %s",
625 strerror(errno));
626#else
627 Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1, "setitimer %d", errno);
628#endif
629 return FALSE;
630 }
631 return Yap_unify(ARG3, MkIntegerTerm(old.it_value.tv_sec)) &&
632 Yap_unify(ARG4, MkIntegerTerm(old.it_value.tv_usec));
633 }
634#else
635 /* not actually trying to set the alarm */
636 if (IntegerOfTerm(t) == 0)
637 return TRUE;
638 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
639 "alarm not available in this configuration");
640 return FALSE;
641#endif
642}
643
644#ifdef VAX
645
646/* avoid longjmp botch */
647
648int vax_absmi_fp;
649
650typedef struct {
651 int eh;
652 int flgs;
653 int ap;
654 int fp;
655 int pc;
656 int dummy1;
657 int dummy2;
658 int dummy3;
659 int oldfp;
660 int dummy4;
661 int dummy5;
662 int dummy6;
663 int oldpc;
664}
665
666 * VaxFramePtr;
667
668VaxFixFrame(dummy) {
669 int maxframes = 100;
670 VaxFramePtr fp = (VaxFramePtr)(((int *)&dummy) - 6);
671 while (--maxframes) {
672 fp = (VaxFramePtr)fp->fp;
673 if (fp->flgs == 0) {
674 if (fp->oldfp >= &REGS[6] && fp->oldfp < &REGS[REG_SIZE])
675 fp->oldfp = vax_absmi_fp;
676 return;
677 }
678 }
679}
680
681#endif
682
683#if defined(_WIN32)
684
685int WINAPI win_yap(HANDLE, DWORD, LPVOID);
686
687int WINAPI win_yap(HANDLE hinst, DWORD reason, LPVOID reserved) {
688 switch (reason) {
689 case DLL_PROCESS_ATTACH:
690 break;
691 case DLL_PROCESS_DETACH:
692 break;
693 case DLL_THREAD_ATTACH:
694 break;
695 case DLL_THREAD_DETACH:
696 break;
697 }
698 return 1;
699}
700#endif
701
702#if (defined(YAPOR) || defined(THREADS)) && !defined(USE_PTHREAD_LOCKING)
703#ifdef sparc
704void rw_lock_voodoo(void);
705
706void rw_lock_voodoo(void) {
707 /* code taken from the Linux kernel, it handles shifting between locks */
708 /* Read/writer locks, as usual this is overly clever to make it as fast as
709 * possible. */
710 /* caches... */
711 __asm__ __volatile__("___rw_read_enter_spin_on_wlock:\n"
712 " orcc %g2, 0x0, %g0\n"
713 " be,a ___rw_read_enter\n"
714 " ldstub [%g1 + 3], %g2\n"
715 " b ___rw_read_enter_spin_on_wlock\n"
716 " ldub [%g1 + 3], %g2\n"
717 "___rw_read_exit_spin_on_wlock:\n"
718 " orcc %g2, 0x0, %g0\n"
719 " be,a ___rw_read_exit\n"
720 " ldstub [%g1 + 3], %g2\n"
721 " b ___rw_read_exit_spin_on_wlock\n"
722 " ldub [%g1 + 3], %g2\n"
723 "___rw_write_enter_spin_on_wlock:\n"
724 " orcc %g2, 0x0, %g0\n"
725 " be,a ___rw_write_enter\n"
726 " ldstub [%g1 + 3], %g2\n"
727 " b ___rw_write_enter_spin_on_wlock\n"
728 " ld [%g1], %g2\n"
729 "\n"
730 " .globl ___rw_read_enter\n"
731 "___rw_read_enter:\n"
732 " orcc %g2, 0x0, %g0\n"
733 " bne,a ___rw_read_enter_spin_on_wlock\n"
734 " ldub [%g1 + 3], %g2\n"
735 " ld [%g1], %g2\n"
736 " add %g2, 1, %g2\n"
737 " st %g2, [%g1]\n"
738 " retl\n"
739 " mov %g4, %o7\n"
740 " .globl ___rw_read_exit\n"
741 "___rw_read_exit:\n"
742 " orcc %g2, 0x0, %g0\n"
743 " bne,a ___rw_read_exit_spin_on_wlock\n"
744 " ldub [%g1 + 3], %g2\n"
745 " ld [%g1], %g2\n"
746 " sub %g2, 0x1ff, %g2\n"
747 " st %g2, [%g1]\n"
748 " retl\n"
749 " mov %g4, %o7\n"
750 " .globl ___rw_write_enter\n"
751 "___rw_write_enter:\n"
752 " orcc %g2, 0x0, %g0\n"
753 " bne ___rw_write_enter_spin_on_wlock\n"
754 " ld [%g1], %g2\n"
755 " andncc %g2, 0xff, %g0\n"
756 " bne,a ___rw_write_enter_spin_on_wlock\n"
757 " stb %g0, [%g1 + 3]\n"
758 " retl\n"
759 " mov %g4, %o7\n");
760}
761#endif /* sparc */
762
763#endif /* YAPOR || THREADS */
764
765yap_error_number Yap_MathException__(USES_REGS1) {
766#if HAVE_FETESTEXCEPT
767 int raised;
768
769 // #pragma STDC FENV_ACCESS ON
770 if ((raised = fetestexcept(FE_DIVBYZERO | FE_OVERFLOW | FE_UNDERFLOW))) {
771
772 feclearexcept(FE_ALL_EXCEPT);
773 if (raised & FE_OVERFLOW) {
774 return EVALUATION_ERROR_FLOAT_OVERFLOW;
775 } else if (raised & FE_DIVBYZERO) {
776 return EVALUATION_ERROR_ZERO_DIVISOR;
777 } else if (raised & FE_UNDERFLOW) {
778 return EVALUATION_ERROR_FLOAT_UNDERFLOW;
779 //} else if (raised & (FE_INVALID|FE_INEXACT)) {
780 // return EVALUATION_ERROR_UNDEFINED;
781 } else {
782 return EVALUATION_ERROR_UNDEFINED;
783 }
784 }
785#elif _WIN32
786 unsigned int raised;
787 int err;
788
789 // Show original FP control word and do calculation.
790 err = _controlfp_s(&raised, 0, 0);
791 if (err) {
792 return EVALUATION_ERROR_UNDEFINED;
793 }
794 if (raised) {
795 feclearexcept(FE_ALL_EXCEPT);
796 if (raised & FE_OVERFLOW) {
797 return EVALUATION_ERROR_FLOAT_OVERFLOW;
798 } else if (raised & FE_DIVBYZERO) {
799 return EVALUATION_ERROR_ZERO_DIVISOR;
800 } else if (raised & FE_UNDERFLOW) {
801 return EVALUATION_ERROR_FLOAT_UNDERFLOW;
802 //} else if (raised & (FE_INVALID|FE_INEXACT)) {
803 // return EVALUATION_ERROR_UNDEFINED;
804 } else {
805 return EVALUATION_ERROR_UNDEFINED;
806 }
807 }
808#elif (defined(__svr4__) || defined(__SVR4))
809 switch (sip->si_code) {
810 case FPE_INTDIV:
811 return EVALUATION_ERROR_ZERO_DIVISOR;
812 break;
813 case FPE_INTOVF:
814 return EVALUATION_ERROR_INT_OVERFLOW;
815 break;
816 case FPE_FLTDIV:
817 return EVALUATION_ERROR_ZERO_DIVISOR;
818 break;
819 case FPE_FLTOVF:
820 return EVALUATION_ERROR_FLOAT_OVERFLOW;
821 break;
822 case FPE_FLTUND:
823 return EVALUATION_ERROR_FLOAT_UNDERFLOW;
824 break;
825 case FPE_FLTRES:
826 case FPE_FLTINV:
827 case FPE_FLTSUB:
828 default:
829 return EVALUATION_ERROR_UNDEFINED;
830 }
831 Yap_set_fpu_exceptions(0);
832#endif
833
834 return LOCAL_Error_TYPE;
835}
836
845bool Yap_InitSIGSEGV(Term enable) {
846#if HAVE_SIGSEGV
847 if (GLOBAL_PrologShouldHandleInterrupts || enable == TermFalse || enable == TermOff) {
848 my_signal(SIGSEGV, SIG_DFL);
849 } else {
850 my_signal_info(SIGSEGV, HandleSIGSEGV);
851 }
852 return true;
853#else
854return false;
855#endif
856}
857
858
868void Yap_InitOSSignals(int wid) {
869 void * hdl;
870 if (GLOBAL_PrologShouldHandleInterrupts) {
871 hdl = ReceiveSignal;
872
873#if !defined(LIGHT) && !_MSC_VER && !defined(__MINGW32__) && !defined(LIGHT)
874 my_signal(SIGQUIT, hdl);
875 my_signal(SIGKILL, hdl);
876 my_signal(SIGUSR1, hdl);
877 my_signal(SIGUSR2, hdl);
878 my_signal(SIGHUP, hdl);
879 my_signal(SIGALRM, hdl);
880 my_signal(SIGVTALRM, hdl);
881#endif
882#ifdef SIGPIPE
883 my_signal(SIGPIPE, hdl);
884#endif
885#if _MSC_VER || defined(__MINGW32__)
886 signal(SIGINT, SIG_IGN);
887 SetConsoleCtrlHandler(MSCHandleSignal, TRUE);
888#else
889 my_signal(SIGINT, hdl);
890#endif
891 }
892#ifdef HAVE_SIGFPE
893 if (GLOBAL_PrologShouldHandleInterrupts) {
894 my_signal(SIGFPE, HandleMatherr);
895 } else {
896 my_signal(SIGFPE, hdl);
897 }
898#endif
899#if HAVE_SIGSEGV
900 if (GLOBAL_PrologShouldHandleInterrupts) {
901 my_signal_info(SIGSEGV, HandleSIGSEGV);
902 } else {
903 my_signal(SIGFPE, hdl);
904 }
905#endif
906#ifdef YAPOR_COW
907 signal(SIGCHLD, SIG_IGN); /* avoid ghosts */
908#endif
909}
910
911
915void Yap_InitSignalPreds(void) {
916 CACHE_REGS
917 Term cm = CurrentModule;
918 Yap_InitCPred("alarm", 4, alarm4, SyncPredFlag);
919 Yap_InitCPred("virtual_alarm", 4, virtual_alarm, SyncPredFlag);
920 CurrentModule = HACKS_MODULE;
921 Yap_InitCPred("enable_interrupts", 0, enable_interrupts, SafePredFlag);
922 Yap_InitCPred("disable_interrupts", 0, disable_interrupts, SafePredFlag);
923 my_signal_info(SIGSEGV, HandleSIGSEGV);
924 CurrentModule = cm;
925 Yap_set_fpu_exceptions(TermFalse);
926}
bool Yap_InitSIGSEGV(Term enable)
This function implements the sigsegv prolog flag.
Definition: sig.c:845