signals.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          signals.lisp
   6 ;;;; Purpose:       Signal processing functions
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Jan 2007
   9 ;;;;
  10 ;;;; $Id: processes.lisp 10985 2006-07-26 18:52:03Z kevin $
  11 ;;;; *************************************************************************
  12
  13 (in-package #:kmrcl)
  14
  15 (defun signal-key-to-number (sig)
  16   "These signals and numbers are only valid on POSIX systems, perhaps
  17 some are Linux-specific."
  18   (case sig
  19     (:hup 1)
  20     (:int 2)
  21     (:quit 3)
  22     (:kill 9)
  23     (:usr1 10)
  24     (:usr2 12)
  25     (:pipe 13)
  26     (:alrm 14)
  27     (:term 15)
  28     (t
  29      (error "Signal ~A not known." sig))))
  30
  31
  32 (defun set-signal-handler (sig handler)
  33   "Sets the handler for a signal to a function. Where possible, returns
  34 the old handler for the function for later restoration with remove-signal-handler
  35 below.
  36
  37 To be portable, signal handlers should use (&rest dummy) function signatures
  38 and ignore the value. They should return T to tell some Lisp implementations (Allegro)
  39 that the signal was successfully handled."
  40   (let ((signum (etypecase sig
  41                   (integer sig)
  42                   (keyword (signal-key-to-number sig)))))
  43     #+allegro (excl:add-signal-handler signum handler)
  44     #+cmu (system:enable-interrupt signum handler)
  45     #+(and lispworks unix)
  46     ;; non-documented method to get old handler, works in lispworks 5
  47     (let ((old-handler (when (and (boundp 'system::*signal-handler-functions*)
  48                                   (typep system::*signal-handler-functions* 'array))
  49                          (aref system::*signal-handler-functions* signum))))
  50       (system:set-signal-handler signum handler)
  51       old-handler)
  52     #+sbcl (sb-sys:enable-interrupt signum handler)
  53     #-(or allegro cmu (and lispworks unix) sbcl)
  54     (declare (ignore sig handler))
  55     #-(or allegro cmu (and lispworks unix) sbcl)
  56     (warn "Signal setting not supported on this platform.")))
  57
  58 (defun remove-signal-handler (sig &optional old-handler)
  59   "Removes a handler from signal. Tries, when possible, to restore old-handler."
  60   (let ((signum (etypecase sig
  61                   (integer sig)
  62                   (keyword (signal-key-to-number sig)))))
  63     ;; allegro automatically restores old handler, because set-signal-handler above
  64     ;; actually pushes the new handler onto a list of handlers
  65     #+allegro (declare (ignore old-handler))
  66     #+allegro (excl:remove-signal-handler signum)
  67     #+cmu (system:enable-interrupt signum (or old-handler :default))
  68     ;; lispworks removes handler if old-handler is nil
  69     #+(and lispworks unix) (system:set-signal-handler signum old-handler)
  70     #+sbcl (sb-sys:enable-interrupt signum (or old-handler :default))
  71     #-(or allegro cmu (and lispworks unix) sbcl)
  72     (declare (ignore sig handler))
  73     #-(or allegro cmu (and lispworks unix) sbcl)
  74     (warn "Signal setting not supported on this platform.")))