(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.
\f
;;;; sys/select.h
+(defmacro with-fd-setsize ((n) &body body)
+ `(let ((,n (if (< 0 ,n fd-setsize)
+ ,n
+ (error "Cannot select(2) on ~D: above FD_SETSIZE limit."
+ (1- num-descriptors)))))
+ (declare (type (integer 0 #.fd-setsize) ,n))
+ ,@body))
+
;;;; FIXME: Why have both UNIX-SELECT and UNIX-FAST-SELECT?
;;; Perform the UNIX select(2) system call.
(defun unix-fast-select (num-descriptors
read-fds write-fds exception-fds
timeout-secs timeout-usecs)
- (declare (type (integer 0 #.fd-setsize) num-descriptors)
+ (declare (type integer num-descriptors)
(type (or (alien (* (struct fd-set))) null)
read-fds write-fds exception-fds)
(type (or null (unsigned-byte 31)) timeout-secs timeout-usecs))
- (flet ((select (tv-sap)
- (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
- (* (struct fd-set)) (* (struct timeval)))
- num-descriptors read-fds write-fds exception-fds
- tv-sap)))
- (cond ((or timeout-secs timeout-usecs)
- (with-alien ((tv (struct timeval)))
- (setf (slot tv 'tv-sec) (or timeout-secs 0))
- (setf (slot tv 'tv-usec) (or timeout-usecs 0))
- (select (alien-sap (addr tv)))))
- (t
- (unless *interrupts-enabled*
- (note-dangerous-wait "select(2)"))
- (select (int-sap 0))))))
+ (with-fd-setsize (num-descriptors)
+ (flet ((select (tv-sap)
+ (int-syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+ (* (struct fd-set)) (* (struct timeval)))
+ num-descriptors read-fds write-fds exception-fds
+ tv-sap)))
+ (cond ((or timeout-secs timeout-usecs)
+ (with-alien ((tv (struct timeval)))
+ (setf (slot tv 'tv-sec) (or timeout-secs 0))
+ (setf (slot tv 'tv-usec) (or timeout-usecs 0))
+ (select (alien-sap (addr tv)))))
+ (t
+ (unless *interrupts-enabled*
+ (note-dangerous-wait "select(2)"))
+ (select (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.
;;; 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 nfds)
(type unsigned-byte rdfds wrfds xpfds)
(type (or (unsigned-byte 31) null) to-secs)
(type (unsigned-byte 31) to-usecs)
(optimize (speed 3) (safety 0) (inhibit-warnings 3)))
- (with-alien ((tv (struct timeval))
- (rdf (struct fd-set))
- (wrf (struct fd-set))
- (xpf (struct fd-set)))
- (cond (to-secs
- (setf (slot tv 'tv-sec) to-secs
- (slot tv 'tv-usec) to-usecs))
- ((not *interrupts-enabled*)
- (note-dangerous-wait "select(2)")))
- (num-to-fd-set rdf rdfds)
- (num-to-fd-set wrf wrfds)
- (num-to-fd-set xpf xpfds)
- (macrolet ((frob (lispvar alienvar)
- `(if (zerop ,lispvar)
- (int-sap 0)
- (alien-sap (addr ,alienvar)))))
- (syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
- (* (struct fd-set)) (* (struct timeval)))
- (values result
- (fd-set-to-num nfds rdf)
- (fd-set-to-num nfds wrf)
- (fd-set-to-num nfds xpf))
- nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf)
- (if to-secs (alien-sap (addr tv)) (int-sap 0))))))
+ (with-fd-setsize (nfds)
+ (with-alien ((tv (struct timeval))
+ (rdf (struct fd-set))
+ (wrf (struct fd-set))
+ (xpf (struct fd-set)))
+ (cond (to-secs
+ (setf (slot tv 'tv-sec) to-secs
+ (slot tv 'tv-usec) to-usecs))
+ ((not *interrupts-enabled*)
+ (note-dangerous-wait "select(2)")))
+ (num-to-fd-set rdf rdfds)
+ (num-to-fd-set wrf wrfds)
+ (num-to-fd-set xpf xpfds)
+ (macrolet ((frob (lispvar alienvar)
+ `(if (zerop ,lispvar)
+ (int-sap 0)
+ (alien-sap (addr ,alienvar)))))
+ (syscall ("select" int (* (struct fd-set)) (* (struct fd-set))
+ (* (struct fd-set)) (* (struct timeval)))
+ (values result
+ (fd-set-to-num nfds rdf)
+ (fd-set-to-num nfds wrf)
+ (fd-set-to-num nfds xpf))
+ nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf)
+ (if to-secs (alien-sap (addr tv)) (int-sap 0)))))))
;;; Lisp-side implmentations of FD_FOO macros. Abandon all hope who enters
;;; here...
(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))))
+ (loop while (and (eql sb!unix:eintr
+ (nth-value 1
+ (int-syscall ("nanosleep" (* (struct timespec))
+ (* (struct timespec)))
+ (addr req) (addr rem))))
+ ;; KLUDGE: On Darwin, if an interrupt cases nanosleep to
+ ;; take longer than the requested time, the call will
+ ;; 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.
+ ;;
+ ;; 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)
+ (and (= secs rem-sec) (>= nsecs rem-nsec)))
+ (setf secs rem-sec
+ nsecs rem-nsec)
+ t)))
+ do (rotatef req rem))))
(defun unix-get-seconds-west (secs)
(multiple-value-bind (ignore seconds dst) (get-timezone secs)
projects / sbcl.git / blobdiff