get rid of *EQL-SPECIALIZER-TABLE-LOCK*

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

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 47eba3d..d5ac483 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -111,7 +111,7 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
 (define-alien-routine ("getenv" posix-getenv) c-string
   "Return the \"value\" part of the environment string \"name=value\" which
 corresponds to NAME, or NIL if there is none."
-  (name c-string))
+  (name (c-string :not-null t)))
 \f
 ;;; from stdio.h
 
@@ -120,7 +120,9 @@ corresponds to NAME, or NIL if there is none."
 #!-win32
 (defun unix-rename (name1 name2)
   (declare (type unix-pathname name1 name2))
-  (void-syscall ("rename" c-string c-string) name1 name2))
+  (void-syscall ("rename" (c-string :not-null t)
+                          (c-string :not-null t))
+                name1 name2))
 \f
 ;;; from sys/types.h and gnu/types.h
 
@@ -156,12 +158,13 @@ corresponds to NAME, or NIL if there is none."
   (declare (type unix-pathname path)
            (type fixnum flags)
            (type unix-file-mode mode))
-  (int-syscall ("open" c-string int int)
-               path
-               (logior #!+win32 o_binary
-                       #!+largefile o_largefile
-                       flags)
-               mode))
+  (with-restarted-syscall (value errno)
+    (int-syscall ("open" c-string int int)
+                 path
+                 (logior #!+win32 o_binary
+                         #!+largefile o_largefile
+                         flags)
+                 mode)))
 
 ;;; UNIX-CLOSE accepts a file descriptor and attempts to close the file
 ;;; associated with it.
@@ -445,11 +448,18 @@ corresponds to NAME, or NIL if there is none."
 ;;; Return the namestring of the home directory, being careful to
 ;;; include a trailing #\/
 #!-win32
-(defun uid-homedir (uid)
-  (or (newcharstar-string (alien-funcall (extern-alien "uid_homedir"
-                                                       (function (* char) int))
-                                         uid))
-      (error "failed to resolve home directory for Unix uid=~S" uid)))
+(progn
+  (defun uid-homedir (uid)
+    (or (newcharstar-string (alien-funcall (extern-alien "uid_homedir"
+                                                         (function (* char) int))
+                                           uid))
+        (error "failed to resolve home directory for Unix uid=~S" uid)))
+
+  (defun user-homedir (uid)
+    (or (newcharstar-string (alien-funcall (extern-alien "user_homedir"
+                                                         (function (* char) c-string))
+                                           uid))
+        (error "failed to resolve home directory for Unix uid=~S" uid))))
 
 ;;; Invoke readlink(2) on the file name specified by PATH. Return
 ;;; (VALUES LINKSTRING NIL) on success, or (VALUES NIL ERRNO) on
@@ -926,9 +936,16 @@ corresponds to NAME, or NIL if there is none."
                      ;; return with EINT and (unsigned)-1 seconds in the
                      ;; remainder timespec, which would cause us to enter
                      ;; nanosleep again for ~136 years. So, we check that the
-                     ;; remainder time is actually decreasing. Since the cost
-                     ;; of this check is neglible, do it on all platforms.
-                     ;; http://osdir.com/ml/darwin-kernel/2010-03/msg00007.html
+                     ;; remainder time is actually decreasing.
+                     ;;
+                     ;; It would be neat to do this bit of defensive
+                     ;; programming on all platforms, but unfortunately on
+                     ;; Linux, REM can be a little higher than REQ if the
+                     ;; nanosleep() call is interrupted quickly enough,
+                     ;; probably due to the request being rounded up to the
+                     ;; nearest HZ. This would cause the sleep to return way
+                     ;; too early.
+                     #!+darwin
                      (let ((rem-sec (slot rem 'tv-sec))
                            (rem-nsec (slot rem 'tv-nsec)))
                        (when (or (> secs rem-sec)