From fd37652c30bdee48588cd082de0a04b95ca07472 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Mon, 8 Jan 2007 03:04:52 +0000
Subject: [PATCH] r11464: add signal handling functions

---
 ChangeLog    |  4 +++
 kmrcl.asd    |  5 ++--
 package.lisp |  4 +++
 signals.lisp | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 81 insertions(+), 2 deletions(-)
 create mode 100644 signals.lisp

diff --git a/ChangeLog b/ChangeLog
index d3cd924..ac9dc98 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+07 Jan 2007  Kevin Rosenberg <kevin@rosenberg.net>
+	* Version 1.93
+	* signals.lisp: Add new file for signal processing
+	
 31 Dec 2006  Kevin Rosenberg <kevin@rosenberg.net>
 	* impl.lisp, sockets.lisp, equal.lisp, datetime.lisp: Declare ignored variables
 	
diff --git a/kmrcl.asd b/kmrcl.asd
index 0fab1a0..153bf6f 100644
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -29,7 +29,7 @@
     :maintainer "Kevin M. Rosenberg <kmr@debian.org>"
     :licence "LLGPL"
     :depends-on (#+sbcl sb-posix)
-    :components 
+    :components
     ((:file "package")
      (:file "ifstar" :depends-on ("package"))
      (:file "byte-stream" :depends-on ("package"))
@@ -37,7 +37,7 @@
      (:file "functions" :depends-on ("macros"))
      (:file "lists" :depends-on ("macros"))
      (:file "seqs" :depends-on ("macros"))
-     (:file "impl" :depends-on ("macros")) 
+     (:file "impl" :depends-on ("macros"))
      (:file "io" :depends-on ("macros" "impl"))
      (:file "console" :depends-on ("macros"))
      (:file "strings" :depends-on ("macros" "seqs"))
@@ -58,6 +58,7 @@
      (:file "listener" :depends-on ("sockets" "processes" "console"))
      (:file "repl" :depends-on ("listener" "strings"))
      (:file "os" :depends-on ("macros" "impl"))
+     (:file "signals" :depends-on ("package"))
      ))
 
 (defmethod perform ((o test-op) (c (eql (find-system 'kmrcl))))
diff --git a/package.lisp b/package.lisp
index cde77c1..75d7f82 100644
--- a/package.lisp
+++ b/package.lisp
@@ -313,6 +313,10 @@
    #:hsv255-similar
    #:hue-difference
    #:hue-difference-fixnum
+
+   ;; signals.lisp
+   #:set-signal-handler
+   #:remove-signal-handler
    ))
 
 
diff --git a/signals.lisp b/signals.lisp
new file mode 100644
index 0000000..1547aba
--- /dev/null
+++ b/signals.lisp
@@ -0,0 +1,70 @@
+;;;; -*- 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.")
+    ))
-- 
2.34.1