- (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))))))
+ (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...
+;;;
+(defmacro fd-set (offset fd-set)
+ (with-unique-names (word bit)
+ `(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))))))
+
+(defmacro fd-clr (offset fd-set)
+ (with-unique-names (word bit)
+ `(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))))))))
+
+(defmacro fd-isset (offset fd-set)
+ (with-unique-names (word bit)
+ `(multiple-value-bind (,word ,bit) (floor ,offset
+ sb!vm:n-machine-word-bits)
+ (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
+
+(defmacro fd-zero (fd-set)
+ `(progn
+ ,@(loop for index upfrom 0 below (/ fd-setsize sb!vm:n-machine-word-bits)
+ collect `(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)))))))