--- /dev/null
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: modlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: signals.lisp
+;;;; Purpose: Signal processing functions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Jan 2007
+;;;;
+;;;; $Id: processes.lisp 10985 2006-07-26 18:52:03Z kevin $
+;;;; *************************************************************************
+
+(in-package #:kmrcl)
+
+(defun signal-key-to-number (sig)
+ "These signals and numbers are only valid on POSIX systems, perhaps
+some are Linux-specific."
+ (case sig
+ (:hup 1)
+ (:int 2)
+ (:quit 3)
+ (:kill 9)
+ (:usr1 10)
+ (:usr2 12)
+ (:pipe 13)
+ (:alrm 14)
+ (:term 15)
+ (t
+ (error "Signal ~A not known." sig))))
+
+
+(defun set-signal-handler (sig handler)
+ "Sets the handler for a signal to a function. Where possible, returns
+the old handler for the function for later restoration with remove-signal-handler
+below.
+
+To be portable, signal handlers should use (&rest dummy) function signatures
+and ignore the value. They should return T to tell some Lisp implementations (Allegro)
+that the signal was successfully handled."
+ (let ((signum (etypecase sig
+ (integer sig)
+ (keyword (signal-key-to-number sig)))))
+ #+allegro (excl:add-signal-handler signum handler)
+ #+cmu (system:enable-interrupt signum handler)
+ #+lispworks
+ ;; non-documented method to get old handler, works in lispworks 5
+ (let ((old-handler (when (and (boundp 'system::*signal-handler-functions*)
+ (typep system::*signal-handler-functions* 'array))
+ (aref system::*signal-handler-functions* signum))))
+ (system:set-signal-handler signum handler)
+ old-handler)
+ #+sbcl (sb-sys:enable-interrupt signum handler)
+ #-(or allegro cmu lispworks sbcl) (warn "Signal setting not supported on this platform.")
+ ))
+
+(defun remove-signal-handler (sig &optional old-handler)
+ "Removes a handler from signal. Tries, when possible, to restore old-handler."
+ (let ((signum (etypecase sig
+ (integer sig)
+ (keyword (signal-key-to-number sig)))))
+ ;; allegro automatically restores old handler, because set-signal-handler above
+ ;; actually pushes the new handler onto a list of handlers
+ #+allegro (declare (ignore old-handler))
+ #+allegro (excl:remove-signal-handler signum)
+ #+cmu (system:enable-interrupt signum (or old-handler :default))
+ ;; lispworks removes handler if old-handler is nil
+ #+lispworks (system:set-signal-handler signum old-handler)
+ #+sbcl (sb-sys:enable-interrupt signum (or old-handler :default))
+ #-(or allegro cmu lispworks sbcl) (warn "Signal setting not supported on this platform.")
+ ))