X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Funix.lisp;h=eace65c5706dc1ccbe6c85322e52c9c56233a631;hb=5277a0cbf1a72243cad6808883a4847acefc8e6b;hp=0c03f2b96c4f1144b145a9603bee320d7bef8c5a;hpb=5e3fb5149366dd84a5cb76bf1cf5f2324c24ca57;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 0c03f2b..eace65c 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -346,26 +346,6 @@
   (declare (type unix-pathname name))
   (void-syscall ("unlink" c-string) name))
 
-;;; Set the tty-process-group for the unix file-descriptor FD to PGRP.
-;;; If not supplied, FD defaults to "/dev/tty".
-(defun %set-tty-process-group (pgrp &optional fd)
-  (let ((old-sigs (unix-sigblock (sigmask :sigttou
-					  :sigttin
-					  :sigtstp
-					  :sigchld))))
-    (declare (type (unsigned-byte 32) old-sigs))
-    (unwind-protect
-	(if fd
-	    (tcsetpgrp fd pgrp)
-	    (multiple-value-bind (tty-fd errno) (unix-open "/dev/tty" o_rdwr 0)
-	      (cond (tty-fd
-		     (multiple-value-prog1
-			 (tcsetpgrp tty-fd pgrp)
-		       (unix-close tty-fd)))
-		    (t
-		     (values nil errno)))))
-      (unix-sigsetmask old-sigs))))
-
 ;;; Return the name of the host machine as a string.
 (defun unix-gethostname ()
   (with-alien ((buf (array char 256)))
@@ -439,36 +419,29 @@
 
 ;;;; sys/select.h
 
-(defmacro unix-fast-select (num-descriptors
-			    read-fds write-fds exception-fds
-			    timeout-secs &optional (timeout-usecs 0))
-  #!+sb-doc
-  "Perform the UNIX select(2) system call."
-  ;; FIXME: These DECLAREs don't belong at macroexpansion time. They
-  ;; should be done at runtime instead. Perhaps we could just redo
-  ;; UNIX-FAST-SELECT as an inline function, and then all the
-  ;; declarations would work nicely.
-  #|
+;;;; FIXME: Why have both UNIX-SELECT and UNIX-FAST-SELECT?
+
+;;; Perform the UNIX select(2) system call.
+(declaim (inline unix-fast-select)) ; (used to be a macro in CMU CL)
+(defun unix-fast-select (num-descriptors
+			 read-fds write-fds exception-fds
+			 timeout-secs &optional (timeout-usecs 0))
   (declare (type (integer 0 #.fd-setsize) num-descriptors)
 	   (type (or (alien (* (struct fd-set))) null)
 		 read-fds write-fds exception-fds)
 	   (type (or null (unsigned-byte 31)) timeout-secs)
 	   (type (unsigned-byte 31) timeout-usecs))
-  |#
   ;; FIXME: CMU CL had
-  ;;   (optimize (speed 3) (safety 0) (inhibit-warnings 3))
-  ;; in the declarations above. If they're important, they should
-  ;; be in a declaration inside the LET expansion, not in the
-  ;; macro compile-time code.
-  `(let ((timeout-secs ,timeout-secs))
-     (with-alien ((tv (struct timeval)))
-       (when timeout-secs
-	 (setf (slot tv 'tv-sec) timeout-secs)
-	 (setf (slot tv 'tv-usec) ,timeout-usecs))
-       (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
-		     (* (struct fd-set)) (* (struct timeval)))
-		    ,num-descriptors ,read-fds ,write-fds ,exception-fds
-		    (if timeout-secs (alien-sap (addr tv)) (int-sap 0))))))
+  ;;   (declare (optimize (speed 3) (safety 0) (inhibit-warnings 3)))
+  ;; here. Is that important for SBCL? If so, why? Profiling might tell us..
+  (with-alien ((tv (struct timeval)))
+    (when timeout-secs
+      (setf (slot tv 'tv-sec) timeout-secs)
+      (setf (slot tv 'tv-usec) timeout-usecs))
+    (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+		  (* (struct fd-set)) (* (struct timeval)))
+		 num-descriptors read-fds write-fds exception-fds
+		 (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))
 
 ;;; UNIX-SELECT accepts sets of file descriptors and waits for an event
 ;;; to happen on one of them or to time out.
@@ -724,11 +697,11 @@
 (defun unix-resolve-links (pathname)
   (declare (type simple-string pathname))
   (aver (not (relative-unix-pathname? pathname)))
-  (/show "entering UNIX-RESOLVE-LINKS")
+  (/noshow "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
-	(/show pathname previous-pathnames)
+	(/noshow pathname previous-pathnames)
 	(let ((link (unix-readlink pathname)))
-	  (/show link)
+	  (/noshow link)
 	  ;; Unlike the old CMU CL code, we handle a broken symlink by
 	  ;; returning the link itself. That way, CL:TRUENAME on a
 	  ;; broken link returns the link itself, so that CL:DIRECTORY
@@ -747,7 +720,7 @@
 							pathname
 							:from-end t)))
 				 (dir (subseq pathname 0 dir-len)))
-			    (/show dir)
+			    (/noshow dir)
 			    (concatenate 'string dir link))
 			  link))))
 		(if (unix-file-kind new-pathname)