X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=87f42d1bf544416bf1f29f328fc3a0dae6df448f;hb=11745f006f4eb17fdc6189475f22a79f52bbde6c;hp=1ae74ff50eef1ccac60decc6855ee5716e49f421;hpb=08307967c71c580058a503d46aa087cfefcf8c69;p=sbcl.git diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 1ae74ff..87f42d1 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -18,9 +18,9 @@ ;;;; system calls that deal with signals #!-sb-fluid (declaim (inline real-unix-kill)) -(sb!alien:define-alien-routine ("kill" real-unix-kill) sb!c-call:int - (pid sb!c-call:int) - (signal sb!c-call:int)) +(sb!alien:define-alien-routine ("kill" real-unix-kill) sb!alien:int + (pid sb!alien:int) + (signal sb!alien:int)) ;;; Send the signal SIGNAL to the process with process id PID. SIGNAL ;;; should be a valid signal number or a keyword of the standard UNIX @@ -29,9 +29,9 @@ (real-unix-kill pid (unix-signal-number signal))) #!-sb-fluid (declaim (inline real-unix-killpg)) -(sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!c-call:int - (pgrp sb!c-call:int) - (signal sb!c-call:int)) +(sb!alien:define-alien-routine ("killpg" real-unix-killpg) sb!alien:int + (pgrp sb!alien:int) + (signal sb!alien:int)) ;;; Send the signal SIGNAL to the all the process in process group ;;; PGRP. SIGNAL should be a valid signal number or a keyword of the @@ -47,20 +47,21 @@ ;;; can pull it out of the CMU CL sources, or the old SBCL sources; ;;; but you might also consider doing things the SBCL way and moving ;;; this kind of C-level work down to C wrapper functions.) +#!-sunos (sb!alien:define-alien-routine ("sigsetmask" unix-sigsetmask) - sb!c-call:unsigned-long - (mask sb!c-call:unsigned-long)) + sb!alien:unsigned-long + (mask sb!alien:unsigned-long)) ;;;; C routines that actually do all the work of establishing signal handlers (sb!alien:define-alien-routine ("install_handler" install-handler) - sb!c-call:unsigned-long - (signal sb!c-call:int) - (handler sb!c-call:unsigned-long)) + sb!alien:unsigned-long + (signal sb!alien:int) + (handler sb!alien:unsigned-long)) ;;;; interface to enabling and disabling signal handlers (defun enable-interrupt (signal-designator handler) - (declare (type (or function (member :default :ignore)) handler)) + (declare (type (or function fixnum (member :default :ignore)) handler)) (without-gcing (let ((result (install-handler (unix-signal-number signal-designator) (case handler @@ -71,7 +72,7 @@ handler)))))) (cond ((= result sig_dfl) :default) ((= result sig_ign) :ignore) - (t (the function (sb!kernel:make-lisp-obj result))))))) + (t (the (or function fixnum) (sb!kernel:make-lisp-obj result))))))) (defun default-interrupt (signal) (enable-interrupt signal :default)) @@ -85,7 +86,7 @@ ;;; SIGINT is handled like BREAK, except that ANSI BREAK ignores ;;; *DEBUGGER-HOOK*, but we want SIGINT's BREAK to respect it, so that -;;; SIGINT in --noprogrammer mode will cleanly terminate the system +;;; SIGINT in --disable-debugger mode will cleanly terminate the system ;;; (by respecting the *DEBUGGER-HOOK* established in that mode). (defun sigint-%break (format-string &rest format-arguments) (apply #'%break 'sigint format-string format-arguments)) @@ -113,7 +114,11 @@ #!-linux (define-signal-handler sigsys-handler "bad argument to a system call") (define-signal-handler sigpipe-handler "SIGPIPE") -(define-signal-handler sigalrm-handler "SIGALRM") + +(defun sigalrm-handler (signal info context) + (declare (ignore signal info context)) + (declare (type system-area-pointer context)) + (cerror "Continue" 'sb!ext::timeout)) (defun sigquit-handler (signal code context) (declare (ignore signal code context))