0.8.0.16:
[sbcl.git] / contrib / sb-bsd-sockets / misc.lisp
1 (in-package :sb-bsd-sockets)
2
3 ;;; Miscellaneous things, placed here until I can find a logically more
4 ;;; coherent place to put them
5
6 ;;; I don't want to provide a complete interface to unix file
7 ;;; operations, for example, but being about to set O_NONBLOCK on a
8 ;;; socket is a necessary operation.
9
10 ;;; XXX bad (sizeof (int) ==4 ) assumptions
11
12 (defmethod non-blocking-mode ((socket socket))
13   "Is SOCKET in non-blocking mode?"
14   (let ((fd (socket-file-descriptor socket)))
15     (sb-alien:with-alien ((arg integer))
16                          (> (logand
17                              (sockint::fcntl fd sockint::f-getfl arg)
18                              sockint::o-nonblock)
19                             0))))
20
21 (defmethod (setf non-blocking-mode) (non-blocking-p (socket socket))
22   "Put SOCKET in non-blocking mode - or not, according to NON-BLOCKING-P"
23   (declare (optimize (speed 3)))
24   (let* ((fd (socket-file-descriptor socket))
25          (arg1 (the (signed-byte 32) (sockint::fcntl fd sockint::f-getfl 0)))
26          (arg2
27           (if non-blocking-p
28               (logior arg1 sockint::o-nonblock)
29             (logand (lognot sockint::o-nonblock) arg1))))
30     (when (= (the (signed-byte 32) -1)
31              (the (signed-byte 32) 
32                (sockint::fcntl fd sockint::f-setfl arg2)))
33       (socket-error "fcntl"))
34     non-blocking-p))
35
36