From 574bb1d2e0ead0447594c86140efe850dcc1c956 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Mon, 23 Jul 1990 18:54:14 +0000
Subject: [PATCH] Moved the signal related stuff from syscall to here.

---
 code/signal.lisp | 222 ++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 202 insertions(+), 20 deletions(-)

diff --git a/code/signal.lisp b/code/signal.lisp
index 438b64987..64c9de3a6 100644
--- a/code/signal.lisp
+++ b/code/signal.lisp
@@ -1,4 +1,4 @@
-;;; -*- Log: code.log; Package: KERNEL -*-
+;;; -*- Log: code.log; Package: MACH -*-
 ;;;
 ;;; **********************************************************************
 ;;; This code was written as part of the Spice Lisp project at
@@ -7,17 +7,177 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.3 1990/07/02 04:37:34 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.4 1990/07/23 18:54:14 wlott Exp $
 ;;;
 ;;; Code for handling UNIX signals.
 ;;; 
 ;;; Written by William Lott.
 ;;;
 
-(in-package "KERNEL")
+(in-package "MACH")
 
-(export '(signal-init))
+(export '(unix-signal-name unix-signal-description unix-signal-number
+	  sigcontext sigmask unix-sigblock unix-sigpause
+	  unix-sigsetmask unix-kill unix-getpid))
 
+(export 'kernel::signal-init (find-package "KERNEL"))
+
+;;; These should probably be somewhere, but I don't know where.
+;;; 
+(defconstant sig_dfl 0)
+(defconstant sig_ign 1)
+
+
+
+;;;; Utilities for dealing with signal names and numbers.
+
+(defstruct (unix-signal
+	    (:constructor make-unix-signal (%name %number %description)))
+  %name				; Signal keyword
+  (%number :type integer)       ; UNIX signal number
+  (%description :type string))  ; Documentation
+
+(defvar *unix-signals* nil
+  "A list of unix signal structures.")
+
+(eval-when (compile eval)
+(defmacro def-unix-signal (name number description)
+  (let ((mach-symbol (intern (symbol-name name))))
+    `(progn
+       (push (make-unix-signal ,name ,number ,description) *unix-signals*)
+       ;; 
+       ;; This is to make the new signal lookup stuff compatible with
+       ;; old code which expects the symbol with the same print name as
+       ;; our keywords to be a constant with a value equal to the signal
+       ;; number.
+       (defconstant ,mach-symbol ,number ,description)
+       (export ',mach-symbol))))
+) ;eval-when
+
+(defun unix-signal-or-lose (arg)
+  (let ((signal (find arg *unix-signals*
+		      :key (etypecase arg
+			     (symbol #'unix-signal-%name)
+			     (number #'unix-signal-%number)))))
+    (unless signal
+      (error "~S is not a valid signal name or number." arg))
+    signal))
+
+(defun unix-signal-name (signal)
+  "Return the name of the signal as a string.  Signal should be a valid
+  signal number or a keyword of the standard UNIX signal name."
+  (symbol-name (unix-signal-%name (unix-signal-or-lose signal))))
+
+(defun unix-signal-description (signal)
+  "Return a string describing signal.  Signal should be a valid signal
+  number or a keyword of the standard UNIX signal name."
+  (unix-signal-%description (unix-signal-or-lose signal)))
+
+(defun unix-signal-number (signal)
+  "Return the number of the given signal.  Signal should be a valid
+  signal number or a keyword of the standard UNIX signal name."
+  (unix-signal-%number (unix-signal-or-lose signal)))
+
+;;; Known signals
+;;; 
+(def-unix-signal :CHECK 0 "Check")
+(def-unix-signal :SIGHUP 1 "Hangup")
+(def-unix-signal :SIGINT 2 "Interrupt")
+(def-unix-signal :SIGQUIT 3 "Quit")
+(def-unix-signal :SIGILL 4 "Illegal instruction")
+(def-unix-signal :SIGTRAP 5 "Trace trap")
+(def-unix-signal :SIGIOT 6 "Iot instruction")
+(def-unix-signal :SIGEMT 7 "Emt instruction")
+(def-unix-signal :SIGFPE 8 "Floating point exception")
+(def-unix-signal :SIGKILL 9 "Kill")
+(def-unix-signal :SIGBUS 10 "Bus error")
+(def-unix-signal :SIGSEGV 11 "Segmentation violation")
+(def-unix-signal :SIGSYS 12 "Bad argument to system call")
+(def-unix-signal :SIGPIPE 13 "Write on a pipe with no one to read it")
+(def-unix-signal :SIGALRM 14 "Alarm clock")
+(def-unix-signal :SIGTERM 15 "Software termination signal")
+(def-unix-signal :SIGURG 16 "Urgent condition present on socket")
+(def-unix-signal :SIGSTOP 17 "Stop")
+(def-unix-signal :SIGTSTP 18 "Stop signal generated from keyboard")
+(def-unix-signal :SIGCONT 19 "Continue after stop")
+(def-unix-signal :SIGCHLD 20 "Child status has changed")
+(def-unix-signal :SIGTTIN 21 "Background read attempted from control terminal")
+(def-unix-signal :SIGTTOU 22 "Background write attempted to control terminal")
+(def-unix-signal :SIGIO 23 "I/O is possible on a descriptor")
+(def-unix-signal :SIGXCPU 24 "Cpu time limit exceeded")
+(def-unix-signal :SIGXFSZ 25 "File size limit exceeded")
+(def-unix-signal :SIGVTALRM 26 "Virtual time alarm")
+(def-unix-signal :SIGPROF 27 "Profiling timer alarm")
+(def-unix-signal :SIGWINCH 28 "Window size change")
+(def-unix-signal :SIGUSR1 30 "User defined signal 1")
+(def-unix-signal :SIGUSR2 31 "User defined signal 2")
+;;; 
+;;; These are Mach Specific
+(def-unix-signal :SIGEMSG 30 "Mach Emergency message")
+(def-unix-signal :SIGMSG 31 "Mach message")
+
+;;; SIGMASK -- Public
+;;;
+(defmacro sigmask (&rest signals)
+  "Returns a mask given a set of signals."
+  (apply #'logior
+	 (mapcar #'(lambda (signal)
+		     (ash 1 (1- (unix-signal-number signal))))
+		 signals)))
+
+
+;;;; System calls that deal with signals.
+
+(proclaim '(inline real-unix-kill))
+
+(def-c-routine ("kill" real-unix-kill) (int)
+  (pid int)
+  (signal int))
+
+(defun unix-kill (pid signal)
+  "Unix-kill sends the signal signal to the process with process 
+   id pid.  Signal should be a valid signal number or a keyword of the
+   standard UNIX signal name."
+  (real-unix-kill pid (unix-signal-number signal)))
+
+
+(proclaim '(inline real-unix-killpg))
+
+(def-c-routine ("killpg" real-unix-killpg) (int)
+  (pgrp int)
+  (signal int))
+
+(defun unix-killpg (pgrp signal)
+  "Unix-killpg sends the signal signal to the all the process in process
+  group PGRP.  Signal should be a valid signal number or a keyword of
+  the standard UNIX signal name."
+  (real-unix-killpg pgrp (unix-signal-number signal)))
+
+
+(def-c-routine ("sigblock" unix-sigblock) (unsigned-long)
+  "Unix-sigblock cause the signals specified in mask to be
+   added to the set of signals currently being blocked from
+   delivery.  The macro sigmask is provided to create masks."
+  (mask unsigned-long))
+
+
+(def-c-routine ("sigpause" unix-sigpause) (void)
+  "Unix-sigpause sets the set of masked signals to its argument
+   and then waits for a signal to arrive, restoring the previous
+   mask upon its return."
+  (mask unsigned-long))
+
+
+(def-c-routine ("sigsetmask" unix-sigsetmask) (unsigned-long)
+  "Unix-sigsetmask sets the current set of masked signals (those
+   begin blocked from delivery) to the argument.  The macro sigmask
+   can be used to create the mask.  The previous value of the signal
+   mask is returned."
+  (mask unsigned-long))
+
+
+
+;;;; C routines that actually do all the work of establishing signal handlers.
 
 (def-c-routine ("install_handler" install-handler)
 	       (int)
@@ -25,6 +185,29 @@
   (handler unsigned-long))
 
 
+
+
+;;;; Interface to enabling and disabling signal handlers.
+
+(defun enable-interrupt (signal handler)
+  (without-gcing
+   (install-handler (unix-signal-number signal)
+		    (di::get-lisp-obj-address handler))))
+
+(defun default-interrupt (signal)
+  (declare (ignore signal))
+  (warn "Can't default interrupts yet."))
+
+(defun ignore-interrupt (signal)
+  (declare (ignore signal))
+  (warn "Can't ignore interrupts yet."))
+
+
+
+;;;; Default LISP signal handlers.
+
+;;; Most of these just call ERROR to report the presence of the signal.
+
 (defmacro define-signal-handler (name what &optional (function 'error))
   `(defun ,name (signal code scp)
      (declare (ignore signal code))
@@ -35,7 +218,8 @@
 		   mach:sigcontext
 		   t))
        (,function ,(concatenate 'simple-string what " at #x~x.")
-		  (alien-access (mach:sigcontext-pc (alien-value sc)))))))
+		  (sap-int
+		   (alien-access (mach:sigcontext-pc (alien-value sc))))))))
 
 (define-signal-handler sigint-handler "Interrupted" break)
 (define-signal-handler sigill-handler "Illegal Instruction")
@@ -54,19 +238,17 @@
 
 
 (defun signal-init ()
-  (macrolet ((frob (signal handler)
-	       `(install-handler ,(mach:unix-signal-number signal)
-				 (di::get-lisp-obj-address ,handler))))
-    #+nil (frob :sigint #'sigint-handler)
-    (frob :sigquit #'sigquit-handler)
-    (frob :sigill #'sigill-handler)
-    (frob :sigtrap #'internal-error)
-    (frob :sigiot #'sigiot-handler)
-    (frob :sigemt #'sigemt-handler)
-    #+nil (frob :sigfpe #'sigfpe-handler)
-    (frob :sigbus #'sigbus-handler)
-    (frob :sigsegv #'sigsegv-handler)
-    (frob :sigsys #'sigsys-handler)
-    (frob :sigpipe #'sigpipe-handler)
-    (frob :sigalrm #'sigalrm-handler))
+  "Enable all the default signals that Lisp knows how to deal with."
+  #+nil (enable-interrupt :sigint #'sigint-handler)
+  (enable-interrupt :sigquit #'sigquit-handler)
+  (enable-interrupt :sigill #'sigill-handler)
+  (enable-interrupt :sigtrap #'kernel::internal-error)
+  (enable-interrupt :sigiot #'sigiot-handler)
+  (enable-interrupt :sigemt #'sigemt-handler)
+  #+nil (enable-interrupt :sigfpe #'sigfpe-handler)
+  (enable-interrupt :sigbus #'sigbus-handler)
+  (enable-interrupt :sigsegv #'sigsegv-handler)
+  (enable-interrupt :sigsys #'sigsys-handler)
+  (enable-interrupt :sigpipe #'sigpipe-handler)
+  (enable-interrupt :sigalrm #'sigalrm-handler)
   nil)
-- 
GitLab