X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Funix.lisp;h=c5e6ee141952d888e19faec42361c695adeca257;hb=de26f53dce412ab8ae84313d4937045498910d46;hp=7da7e555fb39ef778a59c692dff79f84c8f3f93b;hpb=4dc4761909992ceb346d003f3fb19e5c837ee985;p=sbcl.git diff --git a/src/code/unix.lisp b/src/code/unix.lisp index 7da7e55..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 @@ -831,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