0.pre7.86.flaky7.22:

[sbcl.git] / src / code / unix.lisp

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 0a405ca..eace65c 100644 (file)
--- 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,30 +419,29 @@
 \f
 ;;;; 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."
-  (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)
+;;;; 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) )
+          (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.
@@ -718,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
@@ -741,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)