- (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-select)))
- (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))))))
+ (optimize (speed 3) (safety 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 ("sb_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.
+(declaim (inline fd-set fd-clr fd-isset fd-zero))
+(defun fd-set (offset fd-set)
+ (multiple-value-bind (word bit) (floor offset
+ sb!vm:n-machine-word-bits)
+ (setf (deref (slot fd-set 'fds-bits) word)
+ (logior (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits)
+ (ash 1 bit))
+ (deref (slot fd-set 'fds-bits) word)))))
+
+(defun fd-clr (offset fd-set)
+ (multiple-value-bind (word bit) (floor offset
+ sb!vm:n-machine-word-bits)
+ (setf (deref (slot fd-set 'fds-bits) word)
+ (logand (deref (slot fd-set 'fds-bits) word)
+ (sb!kernel:word-logical-not
+ (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits)
+ (ash 1 bit)))))))
+
+(defun fd-isset (offset fd-set)
+ (multiple-value-bind (word bit) (floor offset
+ sb!vm:n-machine-word-bits)
+ (logbitp bit (deref (slot fd-set 'fds-bits) word))))
+
+(defun fd-zero (fd-set)
+ (loop for index below (/ fd-setsize sb!vm:n-machine-word-bits)
+ do (setf (deref (slot fd-set 'fds-bits) index) 0)))
+
+#!-os-provides-poll
+(defun unix-simple-poll (fd direction to-msec)
+ (multiple-value-bind (to-sec to-usec)
+ (if (minusp to-msec)
+ (values nil nil)
+ (multiple-value-bind (to-sec to-msec2) (truncate to-msec 1000)
+ (values to-sec (* to-msec2 1000))))
+ (sb!unix:with-restarted-syscall (count errno)
+ (sb!alien:with-alien ((fds (sb!alien:struct sb!unix:fd-set)))
+ (sb!unix:fd-zero fds)
+ (sb!unix:fd-set fd fds)
+ (multiple-value-bind (read-fds write-fds)
+ (ecase direction
+ (:input
+ (values (addr fds) nil))
+ (:output
+ (values nil (addr fds))))
+ (sb!unix:unix-fast-select (1+ fd)
+ read-fds write-fds nil
+ to-sec to-usec)))
+ (case count
+ ((1) t)
+ ((0) nil)
+ (otherwise
+ (error "Syscall select(2) failed on fd ~D: ~A" fd (strerror)))))))