[slime-cvs] CVS update: slime/swank-clisp.lisp

[Wolfgang Jenkner]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv12769

Modified Files:
	swank-clisp.lisp 
Log Message:
(with-blocked-signals): New macro.
(without-interrupts): Use it.
(*use-dedicated-output-stream*, *redirect-output*): Don't set them
here, use the default settings.
Make :linux one of *features* if we find the "LINUX" package.

Date: Wed Jan 14 18:43:16 2004
Author: wjenkner

Index: slime/swank-clisp.lisp
diff -u slime/swank-clisp.lisp:1.9 slime/swank-clisp.lisp:1.10
--- slime/swank-clisp.lisp:1.9	Tue Jan 13 14:27:24 2004
+++ slime/swank-clisp.lisp	Wed Jan 14 18:43:16 2004
@@ -24,21 +24,31 @@
   (use-package "SOCKET")
   (use-package "GRAY"))
 
-(setq *use-dedicated-output-stream* nil)
-;(setq *redirect-output* nil)
+(eval-when (:compile-toplevel :execute)
+  (when (find-package "LINUX")
+    (pushnew :linux *features*)))
 
 #+linux
+(defmacro with-blocked-signals ((&rest signals) &body body)
+  (ext:with-gensyms ("SIGPROCMASK" ret mask)
+    `(multiple-value-bind (,ret ,mask)
+	 (linux:sigprocmask-set-n-save
+	  ,linux:SIG_BLOCK
+	  ,(do ((sigset (linux:sigset-empty)
+			(linux:sigset-add sigset (the fixnum (pop signals)))))
+	       ((null signals) sigset)))
+       (linux:check-res ,ret 'linux:sigprocmask-set-n-save)
+       (unwind-protect
+	    (progn , at body)
+	 (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
+	
+#+linux
 (defmacro without-interrupts (&body body)
-  `(let ((sigact (linux:signal-action-retrieve linux:SIGINT)))
-     (unwind-protect
-	  (progn
-	    (linux:set-sigprocmask linux:SIG_BLOCK (linux:sa-mask sigact))
-	    , at body)
-       (linux:set-sigprocmask linux:SIG_UNBLOCK (linux:sa-mask sigact)))))
+  `(with-blocked-signals (,linux:SIGINT) , at body))
 
 #-linux
-(defmacro without-interrupts (body)
-  body)
+(defmacro without-interrupts (&body body)
+  `(progn , at body))
 
 (defun without-interrupts* (fun)
   (without-interrupts (funcall fun)))