(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))
\f
;;;; hacking the Unix environment
;;; 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)
(rem (struct timespec)))
(setf (slot req 'tv-sec) secs)
(setf (slot req 'tv-nsec) nsecs)
- (loop while (eql sb!unix:EINTR
+ (loop while (eql sb!unix:eintr
(nth-value 1
(int-syscall ("nanosleep" (* (struct timespec))
(* (struct timespec)))
(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)
(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,
(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)
(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
(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)
(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