X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=c5e6ee141952d888e19faec42361c695adeca257;hb=de26f53dce412ab8ae84313d4937045498910d46;hp=39b23eb04df46b1ff6ef8a1ff506d0f2010e4f7c;hpb=c3334d2307b721cfcea29e6abcd33e48487fb1ea;p=sbcl.git

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 39b23eb..c5e6ee1 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -91,6 +91,19 @@
 
 (defmacro int-syscall ((name &rest arg-types) &rest args)
   `(syscall (,name ,@arg-types) (values result 0) ,@args))
+
+(defmacro with-restarted-syscall ((&optional (value (gensym))
+                                             (errno (gensym)))
+                                  syscall-form &rest body)
+  #!+sb-doc
+  "Evaluate BODY with VALUE and ERRNO bound to the return values of
+SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
+  `(let (,value ,errno)
+     (loop (multiple-value-setq (,value ,errno)
+             ,syscall-form)
+        (unless (eql ,errno sb!unix:eintr)
+          (return (values ,value ,errno))))
+     ,@body))
 
 ;;;; hacking the Unix environment
 
@@ -513,7 +526,7 @@
 ;;; they are ready for reading and writing. See the UNIX Programmer's
 ;;; Manual for more information.
 (defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0))
-  (declare (type (integer 0 #.FD-SETSIZE) nfds)
+  (declare (type (integer 0 #.fd-setsize) nfds)
 	   (type unsigned-byte rdfds wrfds xpfds)
 	   (type (or (unsigned-byte 31) null) to-secs)
 	   (type (unsigned-byte 31) to-usecs)
@@ -658,6 +671,18 @@
   (seconds-west sb!alien:int :out)
   (daylight-savings-p sb!alien:boolean :out))
 
+(defun nanosleep (secs nsecs)
+  (with-alien ((req (struct timespec))
+               (rem (struct timespec)))
+    (setf (slot req 'tv-sec) secs)
+    (setf (slot req 'tv-nsec) nsecs)
+    (loop while (eql sb!unix:eintr
+                     (nth-value 1
+                                (int-syscall ("nanosleep" (* (struct timespec))
+                                                          (* (struct timespec)))
+                                             (addr req) (addr rem))))
+       do (rotatef req rem))))
+
 (defun unix-get-seconds-west (secs)
   (multiple-value-bind (ignore seconds dst) (get-timezone secs)
     (declare (ignore ignore) (ignore dst))
@@ -682,7 +707,7 @@
 	       (tz (struct timezone)))
     (syscall* ("gettimeofday" (* (struct timeval))
 			      (* (struct timezone)))
-	      (values T
+	      (values t
 		      (slot tv 'tv-sec)
 		      (slot tv 'tv-usec)
 		      (slot tz 'tz-minuteswest)
@@ -698,11 +723,11 @@
     (it-interval (struct timeval))	; timer interval
     (it-value (struct timeval))))	; current value
 
-(defconstant ITIMER-REAL 0)
-(defconstant ITIMER-VIRTUAL 1)
-(defconstant ITIMER-PROF 2)
+(defconstant itimer-real 0)
+(defconstant itimer-virtual 1)
+(defconstant itimer-prof 2)
 
-(defun unix-getitimer(which)
+(defun unix-getitimer (which)
   "Unix-getitimer returns the INTERVAL and VALUE slots of one of
    three system timers (:real :virtual or :profile). On success,
    unix-getitimer returns 5 values,
@@ -712,12 +737,12 @@
 		   (unsigned-byte 29) (mod 1000000)
 		   (unsigned-byte 29) (mod 1000000)))
   (let ((which (ecase which
-		 (:real ITIMER-REAL)
-		 (:virtual ITIMER-VIRTUAL)
-		 (:profile ITIMER-PROF))))
+		 (:real itimer-real)
+		 (:virtual itimer-virtual)
+		 (:profile itimer-prof))))
     (with-alien ((itv (struct itimerval)))
       (syscall* ("getitimer" int (* (struct itimerval)))
-		(values T
+		(values t
 			(slot (slot itv 'it-interval) 'tv-sec)
 			(slot (slot itv 'it-interval) 'tv-usec)
 			(slot (slot itv 'it-value) 'tv-sec)
@@ -740,9 +765,9 @@
 		   (unsigned-byte 29) (mod 1000000)
 		   (unsigned-byte 29) (mod 1000000)))
   (let ((which (ecase which
-		 (:real ITIMER-REAL)
-		 (:virtual ITIMER-VIRTUAL)
-		 (:profile ITIMER-PROF))))
+		 (:real itimer-real)
+		 (:virtual itimer-virtual)
+		 (:profile itimer-prof))))
     (with-alien ((itvn (struct itimerval))
 		 (itvo (struct itimerval)))
       (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs
@@ -750,7 +775,7 @@
 	    (slot (slot itvn 'it-value   ) 'tv-sec ) val-secs
 	    (slot (slot itvn 'it-value   ) 'tv-usec) val-usec)
       (syscall* ("setitimer" int (* (struct timeval))(* (struct timeval)))
-		(values T
+		(values t
 			(slot (slot itvo 'it-interval) 'tv-sec)
 			(slot (slot itvo 'it-interval) 'tv-usec)
 			(slot (slot itvo 'it-value) 'tv-sec)
@@ -819,10 +844,16 @@ previous timer after the body has finished executing"
 (defun unix-resolve-links (pathname)
   (declare (type simple-base-string pathname))
   (aver (not (relative-unix-pathname? pathname)))
+  ;; KLUDGE: readlink and lstat are unreliable if given symlinks
+  ;; ending in slashes -- fix the issue here instead of waiting for
+  ;; libc to change...
+  (let ((len (length pathname)))
+    (when (and (plusp len) (eql #\/ (schar pathname (1- len))))
+      (setf pathname (subseq pathname 0 (1- len)))))
   (/noshow "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
-	(/noshow pathname previous-pathnames)
-	(let ((link (unix-readlink pathname)))
+       (/noshow pathname previous-pathnames)
+       (let ((link (unix-readlink pathname)))
 	  (/noshow link)
 	  ;; Unlike the old CMU CL code, we handle a broken symlink by
 	  ;; returning the link itself. That way, CL:TRUENAME on a