~ chicken-core (chicken-5) 8d05f1f09297c7a8ca75b1440865c33e12ad4ea6
commit 8d05f1f09297c7a8ca75b1440865c33e12ad4ea6
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Oct 7 22:48:21 2012 +0200
Commit: Peter Bex <peter.bex@xs4all.nl>
CommitDate: Sat Oct 27 16:47:49 2012 +0200
catch serious signals (SIGSEGV, SIGILL, SIGBUS, SIGPE)
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
diff --git a/Makefile.bsd b/Makefile.bsd
index 4402c039..fb1f244f 100644
--- a/Makefile.bsd
+++ b/Makefile.bsd
@@ -85,6 +85,7 @@ chicken-config.h: chicken-defaults.h
echo "#define HAVE_MEMORY_H 1" >>$@
echo "#define HAVE_SIGACTION 1" >>$@
echo "#define HAVE_SIGSETJMP 1" >>$@
+ echo "#define HAVE_SIGPROCMASK 1" >>$@
echo "#define HAVE_STDINT_H 1" >>$@
echo "#define HAVE_STDLIB_H 1" >>$@
echo "#define HAVE_STRERROR 1" >>$@
diff --git a/Makefile.haiku b/Makefile.haiku
index 3e1c5585..ff06c5bd 100644
--- a/Makefile.haiku
+++ b/Makefile.haiku
@@ -73,6 +73,7 @@ chicken-config.h: chicken-defaults.h
echo "#define HAVE_MEMORY_H 1" >>$@
echo "#define HAVE_SIGACTION 1" >>$@
echo "#define HAVE_SIGSETJMP 1" >>$@
+ echo "#define HAVE_SIGPROCMASK 1" >>$@
echo "#define HAVE_STDINT_H 1" >>$@
echo "#define HAVE_STDLIB_H 1" >>$@
echo "#define HAVE_STRERROR 1" >>$@
diff --git a/Makefile.linux b/Makefile.linux
index c55d55e9..b04e7f6e 100644
--- a/Makefile.linux
+++ b/Makefile.linux
@@ -74,6 +74,7 @@ chicken-config.h: chicken-defaults.h
echo "#define HAVE_MEMORY_H 1" >>$@
echo "#define HAVE_SIGACTION 1" >>$@
echo "#define HAVE_SIGSETJMP 1" >>$@
+ echo "#define HAVE_SIGPROCMASK 1" >>$@
echo "#define HAVE_STDINT_H 1" >>$@
echo "#define HAVE_STDLIB_H 1" >>$@
echo "#define HAVE_STRERROR 1" >>$@
diff --git a/Makefile.macosx b/Makefile.macosx
index a0a73fae..dbdefe3c 100644
--- a/Makefile.macosx
+++ b/Makefile.macosx
@@ -98,6 +98,7 @@ chicken-config.h: chicken-defaults.h
echo "#define HAVE_MEMORY_H 1" >>$@
echo "#define HAVE_SIGACTION 1" >>$@
echo "#define HAVE_SIGSETJMP 1" >>$@
+ echo "#define HAVE_SIGPROCMASK 1" >>$@
echo "#define HAVE_STDINT_H 1" >>$@
echo "#define HAVE_STDLIB_H 1" >>$@
echo "#define HAVE_STRERROR 1" >>$@
diff --git a/chicken.h b/chicken.h
index a946d0c9..516b607d 100644
--- a/chicken.h
+++ b/chicken.h
@@ -571,6 +571,10 @@ static inline int isinf_ld (long double x)
#define C_BAD_ARGUMENT_TYPE_NO_OUTPUT_PORT_ERROR 41
#define C_PORT_CLOSED_ERROR 42
#define C_ASCIIZ_REPRESENTATION_ERROR 43
+#define C_MEMORY_VIOLATION_ERROR 44
+#define C_FLOATING_POINT_EXCEPTION_ERROR 45
+#define C_ILLEGAL_INSTRUCTION_ERROR 46
+#define C_BUS_ERROR 47
/* Platform information */
@@ -878,12 +882,14 @@ DECL_C_PROC_p0 (128, 1,0,0,0,0,0,0,0)
* so try to use versions that we know won't try to save & restore.
*/
# if defined(HAVE_SIGSETJMP)
-# define C_setjmp(e) sigsetjmp(e, 0)
-# define C_longjmp(e,v) siglongjmp(e, v)
-# else
-# define C_setjmp setjmp
-# define C_longjmp longjmp
+# define C_sigsetjmp sigsetjmp
+# define C_siglongjmp siglongjmp
+# endif
+# ifdef HAVE_SIGPROCMASK
+# define C_sigprocmask sigprocmask
# endif
+# define C_setjmp setjmp
+# define C_longjmp longjmp
# define C_alloca alloca
# define C_strerror strerror
# define C_isalpha isalpha
diff --git a/library.scm b/library.scm
index bd30e624..680687fb 100644
--- a/library.scm
+++ b/library.scm
@@ -4172,6 +4172,10 @@ EOF
((41) (apply ##sys#signal-hook #:type-error loc "bad argument type - not an output-port" args))
((42) (apply ##sys#signal-hook #:file-error loc "port already closed" args))
((43) (apply ##sys#signal-hook #:type-error loc "cannot represent string with NUL bytes as C string" args))
+ ((44) (apply ##sys#signal-hook #:memory-error loc "segmentation violation" args))
+ ((45) (apply ##sys#signal-hook #:arithmetic-error loc "floating-point exception" args))
+ ((46) (apply ##sys#signal-hook #:runtime-error loc "illegal instruction" args))
+ ((47) (apply ##sys#signal-hook #:memory-error loc "bus error" args))
(else (apply ##sys#signal-hook #:runtime-error loc "unknown internal error" args)) ) ) ) )
diff --git a/manual/Exceptions b/manual/Exceptions
index 14bdf436..6c1dc53b 100644
--- a/manual/Exceptions
+++ b/manual/Exceptions
@@ -83,6 +83,13 @@ argument. If the condition does not have a value for the desired property and
if the optional argument is given, no error is signaled and the accessor
returns the third argument.
+* On platforms that support the {{sigprocmask(3)}} POSIX API function,
+the signals {{SIGSEGV}}, {{SIGFPE}}, {{SIGBUS}} and {{SIGILL}} will be
+caught and trigger an exception instead of aborting the process, if
+possible. If the unwinding and handling of the signal raises one of
+these signals once again, the process will abort with an error
+message.
+
=== Additional API
<macro>(condition-case EXPRESSION CLAUSE ...)</macro>
diff --git a/manual/Unit posix b/manual/Unit posix
index 5376149c..66325a6a 100644
--- a/manual/Unit posix
+++ b/manual/Unit posix
@@ -928,6 +928,8 @@ Notes
* {{(set! (signal-handler SIG) PROC)}} can be used as an alternative to {{(set-signal-handler! SIG PROC)}}
+* Any signal handlers for the signals {{signal/segv}}, {{signal/bus}}, {{signal/fpe}} and {{signal/ill}} will be ignored and these signals will always trigger an exception, unless the executable was started with the {{-:S}} runtime option. This feature is only available on platforms that support the {{sigprocmask(3)}} POSIX API function.
+
==== set-signal-mask!
<procedure>(set-signal-mask! SIGLIST)</procedure>
@@ -986,6 +988,7 @@ Unmasks (unblocks) the signal for the code {{SIGNUM}}.
<constant>signal/xfsz</constant><br>
<constant>signal/usr1</constant><br>
<constant>signal/usr2</constant><br>
+<constant>signal/bus</constant><br>
<constant>signal/winch</constant>
These variables contain signal codes for use with {{process-signal}}, {{set-signal-handler!}}, {{signal-handler}}, {{signal-masked?}}, {{signal-mask!}}, or {{signal-unmask!}}.
diff --git a/posix.import.scm b/posix.import.scm
index 0881204c..f22a251e 100644
--- a/posix.import.scm
+++ b/posix.import.scm
@@ -216,6 +216,7 @@
signal/chld
signal/cont
signal/fpe
+ signal/bus
signal/hup
signal/ill
signal/int
diff --git a/posixunix.scm b/posixunix.scm
index 77d8bca4..0277cc59 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -291,6 +291,7 @@ static C_TLS sigset_t C_sigset;
#define C_sigprocmask_set(d) C_fix(sigprocmask(SIG_SETMASK, &C_sigset, NULL))
#define C_sigprocmask_block(d) C_fix(sigprocmask(SIG_BLOCK, &C_sigset, NULL))
#define C_sigprocmask_unblock(d) C_fix(sigprocmask(SIG_UNBLOCK, &C_sigset, NULL))
+#define C_sigprocmask_get(d) C_fix(sigprocmask(SIG_SETMASK, NULL, &C_sigset))
#define C_open(fn, fl, m) C_fix(open(C_c_string(fn), C_unfix(fl), C_unfix(m)))
#define C_read(fd, b, n) C_fix(read(C_unfix(fd), C_data_pointer(b), C_unfix(n)))
@@ -893,6 +894,7 @@ EOF
(define-foreign-variable _sighup int "SIGHUP")
(define-foreign-variable _sigfpe int "SIGFPE")
(define-foreign-variable _sigill int "SIGILL")
+(define-foreign-variable _sigbus int "SIGBUS")
(define-foreign-variable _sigsegv int "SIGSEGV")
(define-foreign-variable _sigabrt int "SIGABRT")
(define-foreign-variable _sigtrap int "SIGTRAP")
@@ -938,6 +940,7 @@ EOF
(define signal/usr1 _sigusr1)
(define signal/usr2 _sigusr2)
(define signal/winch _sigwinch)
+(define signal/bus _sigbus)
(define signals-list
(list
@@ -945,7 +948,7 @@ EOF
signal/segv signal/abrt signal/trap signal/quit signal/alrm signal/vtalrm
signal/prof signal/io signal/urg signal/chld signal/cont signal/stop
signal/tstp signal/pipe signal/xcpu signal/xfsz signal/usr1 signal/usr2
- signal/winch))
+ signal/winch signal/bus))
(define set-signal-mask!
(lambda (sigs)
@@ -957,30 +960,38 @@ EOF
(##core#inline "C_sigaddset" s) )
sigs)
(when (fx< (##core#inline "C_sigprocmask_set" 0) 0)
- (posix-error #:process-error 'set-signal-mask! "cannot set signal mask") ) ) )
+ (posix-error #:process-error 'set-signal-mask! "cannot set signal mask") )))
-(define (signal-mask)
- (let loop ([sigs signals-list] [mask '()])
- (if (null? sigs)
- mask
- (let ([sig (car sigs)])
- (loop (cdr sigs) (if (##core#inline "C_sigismember" sig) (cons sig mask) mask)) ) ) ) )
+(define signal-mask
+ (getter-with-setter
+ (lambda ()
+ (##core#inline "C_sigprocmask_get" 0)
+ (let loop ([sigs signals-list] [mask '()])
+ (if (null? sigs)
+ mask
+ (let ([sig (car sigs)])
+ (loop (cdr sigs)
+ (if (##core#inline "C_sigismember" sig) (cons sig mask) mask)) ) ) ) )
+ set-signal-mask!))
(define (signal-masked? sig)
(##sys#check-exact sig 'signal-masked?)
+ (##core#inline "C_sigprocmask_get" 0)
(##core#inline "C_sigismember" sig) )
(define (signal-mask! sig)
(##sys#check-exact sig 'signal-mask!)
+ (##core#inline "C_sigemptyset" 0)
(##core#inline "C_sigaddset" sig)
(when (fx< (##core#inline "C_sigprocmask_block" 0) 0)
- (posix-error #:process-error 'signal-mask! "cannot block signal") ) )
+ (posix-error #:process-error 'signal-mask! "cannot block signal") ))
(define (signal-unmask! sig)
(##sys#check-exact sig 'signal-unmask!)
- (##core#inline "C_sigdelset" sig)
+ (##core#inline "C_sigemptyset" 0)
+ (##core#inline "C_sigaddset" sig)
(when (fx< (##core#inline "C_sigprocmask_unblock" 0) 0)
- (posix-error #:process-error 'signal-unmask! "cannot unblock signal") ) )
+ (posix-error #:process-error 'signal-unmask! "cannot unblock signal") ) )
;;; Getting system-, group- and user-information:
diff --git a/runtime.c b/runtime.c
index df27e315..1617c2cf 100644
--- a/runtime.c
+++ b/runtime.c
@@ -418,7 +418,9 @@ static C_TLS int
heap_size_changed,
chicken_is_running,
chicken_ran_once,
+ pass_serious_signals = 1,
callback_continuation_level;
+static volatile C_TLS int serious_signal_occurred = 0;
static C_TLS unsigned int
mutation_count,
stack_size,
@@ -498,6 +500,10 @@ static C_ccall void callback_return_continuation(C_word c, C_word self, C_word r
static void become_2(void *dummy) C_noret;
static void copy_closure_2(void *dummy) C_noret;
static void dump_heap_state_2(void *dummy) C_noret;
+static void C_fcall sigsegv_trampoline(void *) C_regparm;
+static void C_fcall sigill_trampoline(void *) C_regparm;
+static void C_fcall sigfpe_trampoline(void *) C_regparm;
+static void C_fcall sigbus_trampoline(void *) C_regparm;
static C_PTABLE_ENTRY *create_initial_ptable();
@@ -536,6 +542,7 @@ int CHICKEN_main(int argc, char *argv[], void *toplevel)
#endif
}
+ pass_serious_signals = 0;
CHICKEN_parse_command_line(argc, argv, &h, &s, &n);
if(!CHICKEN_initialize(h, s, n, toplevel))
@@ -586,6 +593,9 @@ void parse_argv(C_char *cmds)
int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
{
int i;
+#ifdef HAVE_SIGACTION
+ struct sigaction sa;
+#endif
/*FIXME Should have C_tzset in chicken.h? */
#ifdef C_NONUNIX
@@ -693,6 +703,28 @@ int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel)
dlopen_flags = 0;
#endif
+ /* setup signal handlers */
+ if(!pass_serious_signals) {
+#ifdef HAVE_SIGACTION
+ sa.sa_flags = 0;
+ sigemptyset(&sa.sa_mask);
+ sigaddset(&sa.sa_mask, SIGBUS);
+ sigaddset(&sa.sa_mask, SIGFPE);
+ sigaddset(&sa.sa_mask, SIGILL);
+ sigaddset(&sa.sa_mask, SIGSEGV);
+ sa.sa_handler = global_signal_handler;
+ C_sigaction(SIGBUS, &sa, NULL);
+ C_sigaction(SIGFPE, &sa, NULL);
+ C_sigaction(SIGILL, &sa, NULL);
+ C_sigaction(SIGSEGV, &sa, NULL);
+#else
+ C_signal(SIGBUS, global_signal_handler);
+ C_signal(SIGILL, global_signal_handler);
+ C_signal(SIGFPE, global_signal_handler);
+ C_signal(SIGSEGV, global_signal_handler);
+#endif
+ }
+
mutation_count = gc_count_1 = gc_count_1_total = gc_count_2 = 0;
lf_list = NULL;
C_register_lf2(NULL, 0, create_initial_ptable());
@@ -985,12 +1017,71 @@ void initialize_symbol_table(void)
}
+C_regparm void C_fcall
+sigsegv_trampoline(void *dummy)
+{
+ barf(C_MEMORY_VIOLATION_ERROR, NULL);
+}
+
+
+C_regparm void C_fcall
+sigbus_trampoline(void *dummy)
+{
+ barf(C_BUS_ERROR, NULL);
+}
+
+
+C_regparm void C_fcall
+sigfpe_trampoline(void *dummy)
+{
+ barf(C_FLOATING_POINT_EXCEPTION_ERROR, NULL);
+}
+
+
+C_regparm void C_fcall
+sigill_trampoline(void *dummy)
+{
+ barf(C_ILLEGAL_INSTRUCTION_ERROR, NULL);
+}
+
+
/* This is called from POSIX signals: */
void global_signal_handler(int signum)
{
+#if defined(HAVE_SIGPROCMASK)
+ if(signum == SIGSEGV || signum == SIGFPE || signum == SIGILL || signum == SIGBUS) {
+ sigset_t sset;
+
+ if(serious_signal_occurred || !chicken_is_running) {
+ switch(signum) {
+ case SIGSEGV: panic(C_text("unrecoverable segmentation violation"));
+ case SIGFPE: panic(C_text("unrecoverable floating-point exception"));
+ case SIGILL: panic(C_text("unrecoverable illegal instruction error"));
+ case SIGBUS: panic(C_text("unrecoverable bus error"));
+ default: panic(C_text("unrecoverable serious condition"));
+ }
+ }
+ else serious_signal_occurred = 1;
+
+ /* unblock signal to avoid nested invocation of the handler */
+ sigemptyset(&sset);
+ sigaddset(&sset, signum);
+ C_sigprocmask(SIG_UNBLOCK, &sset, NULL);
+
+ switch(signum) {
+ case SIGSEGV: C_reclaim(sigsegv_trampoline, NULL);
+ case SIGFPE: C_reclaim(sigfpe_trampoline, NULL);
+ case SIGILL: C_reclaim(sigill_trampoline, NULL);
+ case SIGBUS: C_reclaim(sigbus_trampoline, NULL);
+ default: panic(C_text("invalid serious signal"));
+ }
+ }
+#endif
+
C_raise_interrupt(signal_mapping_table[ signum ]);
#ifndef HAVE_SIGACTION
+ /* not necessarily needed, but older UNIXen may not leave the handler installed: */
C_signal(signum, global_signal_handler);
#endif
}
@@ -1163,6 +1254,7 @@ void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *st
" -:G force GUI mode\n"
" -:aSIZE set trace-buffer/call-chain size\n"
" -:H dump heap state on exit\n"
+ " -:S do not handle segfaults or other serious conditions\n"
"\n SIZE may have a `k' (`K'), `m' (`M') or `g' (`G') suffix, meaning size\n"
" times 1024, 1048576, and 1073741824, respectively.\n\n");
exit(0);
@@ -1205,6 +1297,10 @@ void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *st
dump_heap_on_exit = 1;
break;
+ case 'S':
+ pass_serious_signals = 1;
+ break;
+
case 's':
*stack = arg_val(ptr);
stack_size_changed = 1;
@@ -1322,7 +1418,13 @@ C_word CHICKEN_run(void *toplevel)
C_dbg(C_text("debug"), C_text("stack bottom is 0x%lx.\n"), (long)stack_bottom);
/* The point of (usually) no return... */
+#ifdef HAVE_SIGSETJMP
+ C_sigsetjmp(C_restart, 0);
+#else
C_setjmp(C_restart);
+#endif
+
+ serious_signal_occurred = 0;
if(!return_to_host)
(C_restart_trampoline)(C_restart_address);
@@ -1649,6 +1751,11 @@ void barf(int code, char *loc, ...)
c = 1;
break;
+ case C_MEMORY_VIOLATION_ERROR:
+ msg = C_text("segmentation violation");
+ c = 0;
+ break;
+
default: panic(C_text("illegal internal error code"));
}
@@ -1797,7 +1904,13 @@ C_word C_fcall C_callback(C_word closure, int argc)
callback_returned_flag = 0;
chicken_is_running = 1;
+#ifdef HAVE_SIGSETJMP
+ if(!C_sigsetjmp(C_restart, 0)) C_do_apply(argc, closure, k);
+#else
if(!C_setjmp(C_restart)) C_do_apply(argc, closure, k);
+#endif
+
+ serious_signal_occurred = 0;
if(!callback_returned_flag) (C_restart_trampoline)(C_restart_address);
else {
@@ -2657,7 +2770,11 @@ C_regparm void C_fcall C_reclaim(void *trampoline, void *proc)
start = C_fromspace_top;
/* Entry point for second-level GC (on explicit request or because of full fromspace): */
+#ifdef HAVE_SIGSETJMP
+ if(C_sigsetjmp(gc_restart, 0) || start >= C_fromspace_limit) {
+#else
if(C_setjmp(gc_restart) || start >= C_fromspace_limit) {
+#endif
if(gc_bell) {
C_putchar(7);
C_fflush(stdout);
@@ -2943,8 +3060,12 @@ C_regparm void C_fcall C_reclaim(void *trampoline, void *proc)
if(C_post_gc_hook != NULL) C_post_gc_hook(gc_mode, (long)tgc);
- /* Jump from the Empire State Building... */
+ /* Unwind stack completely */
+#ifdef HAVE_SIGSETJMP
+ C_siglongjmp(C_restart, 1);
+#else
C_longjmp(C_restart, 1);
+#endif
}
@@ -3011,7 +3132,11 @@ C_regparm void C_fcall really_mark(C_word *x)
bytes = (h & C_BYTEBLOCK_BIT) ? n : n * sizeof(C_word);
if(((C_byte *)p2 + bytes + sizeof(C_word)) > C_fromspace_limit)
+#ifdef HAVE_SIGSETJMP
+ C_siglongjmp(gc_restart, 1);
+#else
C_longjmp(gc_restart, 1);
+#endif
C_fromspace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word);
@@ -3080,7 +3205,11 @@ C_regparm void C_fcall really_mark(C_word *x)
panic(C_text("out of memory - heap full"));
gc_mode = GC_REALLOC;
+#ifdef HAVE_SIGSETJMP
+ C_siglongjmp(gc_restart, 1);
+#else
C_longjmp(gc_restart, 1);
+#endif
}
tospace_top = (C_byte *)p2 + C_align(bytes) + sizeof(C_word);
diff --git a/types.db b/types.db
index 20fc7636..1d92ab9b 100644
--- a/types.db
+++ b/types.db
@@ -1756,6 +1756,7 @@
(signal/ill fixnum)
(signal/int fixnum)
(signal/io fixnum)
+(signal/bus fixnum)
(signal/kill fixnum)
(signal/pipe fixnum)
(signal/prof fixnum)
Trap