3rdparties/software/usocket-0.8.3/backend/clasp.lisp (5221 bytes)
1 (in-package :usocket) 2 3 #-clasp 4 (progn 5 #-:wsock 6 (ffi:clines 7 "#include <errno.h>" 8 "#include <sys/socket.h>" 9 "#include <unistd.h>") 10 #+:wsock 11 (ffi:clines 12 "#ifndef FD_SETSIZE" 13 "#define FD_SETSIZE 1024" 14 "#endif" 15 "#include <winsock2.h>") 16 (ffi:clines 17 #+:msvc "#include <time.h>" 18 #-:msvc "#include <sys/time.h>" 19 "#include <ecl/ecl-inl.h>")) 20 (progn 21 #-clasp 22 (defun cerrno () 23 (ffi:c-inline () () :int 24 "errno" :one-liner t)) 25 #+clasp 26 (defun cerrno () 27 (sockets-internal:errno)) 28 29 #-clasp 30 (defun fd-setsize () 31 (ffi:c-inline () () :fixnum 32 "FD_SETSIZE" :one-liner t)) 33 #+clasp 34 (defun fd-setsize () (sockets-internal:fd-setsize)) 35 36 #-clasp 37 (defun fdset-alloc () 38 (ffi:c-inline () () :pointer-void 39 "ecl_alloc_atomic(sizeof(fd_set))" :one-liner t)) 40 #+clasp (defun fdset-alloc () (sockets-internal::alloc-atomic-sizeof-fd-set)) 41 42 #-clasp 43 (defun fdset-zero (fdset) 44 (ffi:c-inline (fdset) (:pointer-void) :void 45 "FD_ZERO((fd_set*)#0)" :one-liner t)) 46 #+clasp(defun fdset-zero (fdset) (sockets-internal:fdset-zero fdset)) 47 48 #-clasp 49 (defun fdset-set (fdset fd) 50 (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void 51 "FD_SET(#1,(fd_set*)#0)" :one-liner t)) 52 #+clasp(defun fdset-set (fdset fd) (sockets-internal:fdset-set fd fdset)) 53 54 #-clasp 55 (defun fdset-clr (fdset fd) 56 (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :void 57 "FD_CLR(#1,(fd_set*)#0)" :one-liner t)) 58 #+clasp(defun fdset-clr (fdset fd) (sockets-internal:fdset-clr fd fdset)) 59 60 #-clasp 61 (defun fdset-fd-isset (fdset fd) 62 (ffi:c-inline (fdset fd) (:pointer-void :fixnum) :bool 63 "FD_ISSET(#1,(fd_set*)#0)" :one-liner t)) 64 #+clasp(defun fdset-fd-isset (fdset fd) (sockets-internal:fdset-isset fd fdset)) 65 66 (declaim (inline cerrno 67 fd-setsize 68 fdset-alloc 69 fdset-zero 70 fdset-set 71 fdset-clr 72 fdset-fd-isset)) 73 #-clasp 74 (defun get-host-name () 75 (ffi:c-inline 76 () () :object 77 "{ char *buf = (char *) ecl_alloc_atomic(257); 78 79 if (gethostname(buf,256) == 0) 80 @(return) = make_simple_base_string(buf); 81 else 82 @(return) = Cnil; 83 }" :one-liner nil :side-effects nil)) 84 85 #+clasp 86 (defun get-host-name () 87 (sockets-internal:get-host-name)) 88 89 #-clasp 90 (defun read-select (wl to-secs &optional (to-musecs 0)) 91 (let* ((sockets (wait-list-waiters wl)) 92 (rfds (wait-list-%wait wl)) 93 (max-fd (reduce #'(lambda (x y) 94 (let ((sy (sb-bsd-sockets:socket-file-descriptor 95 (socket y)))) 96 (if (< x sy) sy x))) 97 (cdr sockets) 98 :initial-value (sb-bsd-sockets:socket-file-descriptor 99 (socket (car sockets)))))) 100 (fdset-zero rfds) 101 (dolist (sock sockets) 102 (fdset-set rfds (sb-bsd-sockets:socket-file-descriptor 103 (socket sock)))) 104 (let ((count 105 (ffi:c-inline (to-secs to-musecs rfds max-fd) 106 (t :unsigned-int :pointer-void :int) 107 :int 108 " 109 int count; 110 struct timeval tv; 111 112 if (#0 != Cnil) { 113 tv.tv_sec = fixnnint(#0); 114 tv.tv_usec = #1; 115 } 116 @(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL, 117 (#0 != Cnil) ? &tv : NULL); 118 " :one-liner nil))) 119 (cond 120 ((= 0 count) 121 (values nil nil)) 122 ((< count 0) 123 ;; check for EINTR and EAGAIN; these should not err 124 (values nil (cerrno))) 125 (t 126 (dolist (sock sockets) 127 (when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor 128 (socket sock))) 129 (setf (state sock) :READ)))))))) 130 131 #+clasp 132 (defun read-select (wl to-secs &optional (to-musecs 0)) 133 (let* ((sockets (wait-list-waiters wl)) 134 (rfds (wait-list-%wait wl)) 135 (max-fd (reduce #'(lambda (x y) 136 (let ((sy (sb-bsd-sockets:socket-file-descriptor 137 (socket y)))) 138 (if (< x sy) sy x))) 139 (cdr sockets) 140 :initial-value (sb-bsd-sockets:socket-file-descriptor 141 (socket (car sockets)))))) 142 (fdset-zero rfds) 143 (dolist (sock sockets) 144 (fdset-set rfds (sb-bsd-sockets:socket-file-descriptor 145 (socket sock)))) 146 (let ((count (sockets-internal:do-select to-secs to-musecs rfds max-fd))) 147 (cond 148 ((= 0 count) 149 (values nil nil)) 150 ((< count 0) 151 ;; check for EINTR and EAGAIN; these should not err 152 (values nil (cerrno))) 153 (t 154 (dolist (sock sockets) 155 (when (fdset-fd-isset rfds (sb-bsd-sockets:socket-file-descriptor 156 (socket sock))) 157 (setf (state sock) :READ)))))))) 158 )