/common-lisp/3rd-party/usocket/backend/abcl.lisp

https://bitbucket.org/hwo2014/hwo2014-team-876 · Lisp · 431 lines · 342 code · 57 blank · 32 comment · 3 complexity · a8621cf28707be9f9c67a8c21a30262c MD5 · raw file

  1. ;;;; $Id: abcl.lisp 693 2012-08-18 20:59:33Z ehuelsmann $
  2. ;;;; $URL: svn://common-lisp.net/project/usocket/svn/usocket/tags/0.6.1/backend/abcl.lisp $
  3. ;;;; New ABCL networking support (replacement to old armedbear.lisp)
  4. ;;;; Author: Chun Tian (binghe)
  5. ;;;; See LICENSE for licensing information.
  6. (in-package :usocket)
  7. ;;; Java Classes ($*...)
  8. (defvar $*boolean (jclass "boolean"))
  9. (defvar $*byte (jclass "byte"))
  10. (defvar $*byte[] (jclass "[B"))
  11. (defvar $*int (jclass "int"))
  12. (defvar $*long (jclass "long"))
  13. (defvar $*|Byte| (jclass "java.lang.Byte"))
  14. (defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel"))
  15. (defvar $*DatagramPacket (jclass "java.net.DatagramPacket"))
  16. (defvar $*DatagramSocket (jclass "java.net.DatagramSocket"))
  17. (defvar $*Inet4Address (jclass "java.net.Inet4Address"))
  18. (defvar $*InetAddress (jclass "java.net.InetAddress"))
  19. (defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress"))
  20. (defvar $*Iterator (jclass "java.util.Iterator"))
  21. (defvar $*SelectableChannel (jclass "java.nio.channels.SelectableChannel"))
  22. (defvar $*SelectionKey (jclass "java.nio.channels.SelectionKey"))
  23. (defvar $*Selector (jclass "java.nio.channels.Selector"))
  24. (defvar $*ServerSocket (jclass "java.net.ServerSocket"))
  25. (defvar $*ServerSocketChannel (jclass "java.nio.channels.ServerSocketChannel"))
  26. (defvar $*Set (jclass "java.util.Set"))
  27. (defvar $*Socket (jclass "java.net.Socket"))
  28. (defvar $*SocketAddress (jclass "java.net.SocketAddress"))
  29. (defvar $*SocketChannel (jclass "java.nio.channels.SocketChannel"))
  30. (defvar $*String (jclass "java.lang.String"))
  31. ;;; Java Constructor ($%.../n)
  32. (defvar $%Byte/0 (jconstructor $*|Byte| $*byte))
  33. (defvar $%DatagramPacket/3 (jconstructor $*DatagramPacket $*byte[] $*int $*int))
  34. (defvar $%DatagramPacket/5 (jconstructor $*DatagramPacket $*byte[] $*int $*int $*InetAddress $*int))
  35. (defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket))
  36. (defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int))
  37. (defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAddress))
  38. (defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int))
  39. (defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAddress $*int))
  40. (defvar $%ServerSocket/0 (jconstructor $*ServerSocket))
  41. (defvar $%ServerSocket/1 (jconstructor $*ServerSocket $*int))
  42. (defvar $%ServerSocket/2 (jconstructor $*ServerSocket $*int $*int))
  43. (defvar $%ServerSocket/3 (jconstructor $*ServerSocket $*int $*int $*InetAddress))
  44. (defvar $%Socket/0 (jconstructor $*Socket))
  45. (defvar $%Socket/2 (jconstructor $*Socket $*InetAddress $*int))
  46. (defvar $%Socket/4 (jconstructor $*Socket $*InetAddress $*int $*InetAddress $*int))
  47. ;;; Java Methods ($@...[/Class]/n)
  48. (defvar $@accept/0 (jmethod $*ServerSocket "accept"))
  49. (defvar $@bind/DatagramSocket/1 (jmethod $*DatagramSocket "bind" $*SocketAddress))
  50. (defvar $@bind/ServerSocket/1 (jmethod $*ServerSocket "bind" $*SocketAddress))
  51. (defvar $@bind/ServerSocket/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int))
  52. (defvar $@bind/Socket/1 (jmethod $*Socket "bind" $*SocketAddress))
  53. (defvar $@byteValue/0 (jmethod $*|Byte| "byteValue"))
  54. (defvar $@channel/0 (jmethod $*SelectionKey "channel"))
  55. (defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close"))
  56. (defvar $@close/Selector/0 (jmethod $*Selector "close"))
  57. (defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close"))
  58. (defvar $@close/Socket/0 (jmethod $*Socket "close"))
  59. (defvar $@configureBlocking/1 (jmethod $*SelectableChannel "configureBlocking" $*boolean))
  60. (defvar $@connect/DatagramChannel/1 (jmethod $*DatagramChannel "connect" $*SocketAddress))
  61. (defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress))
  62. (defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
  63. (defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*SocketAddress))
  64. (defvar $@getAddress/0 (jmethod $*InetAddress "getAddress"))
  65. (defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String))
  66. (defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String))
  67. (defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel"))
  68. (defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel"))
  69. (defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel"))
  70. (defvar $@getAddress/DatagramPacket/0 (jmethod $*DatagramPacket "getAddress"))
  71. (defvar $@getHostName/0 (jmethod $*InetAddress "getHostName"))
  72. (defvar $@getInetAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getInetAddress"))
  73. (defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress"))
  74. (defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress"))
  75. (defvar $@getLength/DatagramPacket/0 (jmethod $*DatagramPacket "getLength"))
  76. (defvar $@getLocalAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalAddress"))
  77. (defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress"))
  78. (defvar $@getLocalPort/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalPort"))
  79. (defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort"))
  80. (defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort"))
  81. (defvar $@getOffset/DatagramPacket/0 (jmethod $*DatagramPacket "getOffset"))
  82. (defvar $@getPort/DatagramPacket/0 (jmethod $*DatagramPacket "getPort"))
  83. (defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort"))
  84. (defvar $@getPort/Socket/0 (jmethod $*Socket "getPort"))
  85. (defvar $@hasNext/0 (jmethod $*Iterator "hasNext"))
  86. (defvar $@iterator/0 (jmethod $*Set "iterator"))
  87. (defvar $@next/0 (jmethod $*Iterator "next"))
  88. (defvar $@open/DatagramChannel/0 (jmethod $*DatagramChannel "open"))
  89. (defvar $@open/Selector/0 (jmethod $*Selector "open"))
  90. (defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "open"))
  91. (defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open"))
  92. (defvar $@receive/1 (jmethod $*DatagramSocket "receive" $*DatagramPacket))
  93. (defvar $@register/2 (jmethod $*SelectableChannel "register" $*Selector $*int))
  94. (defvar $@select/0 (jmethod $*Selector "select"))
  95. (defvar $@select/1 (jmethod $*Selector "select" $*long))
  96. (defvar $@selectedKeys/0 (jmethod $*Selector "selectedKeys"))
  97. (defvar $@send/1 (jmethod $*DatagramSocket "send" $*DatagramPacket))
  98. (defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean))
  99. (defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSoTimeout" $*int))
  100. (defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int))
  101. (defvar $@setTcpNoDelay/1 (jmethod $*Socket "setTcpNoDelay" $*boolean))
  102. (defvar $@socket/DatagramChannel/0 (jmethod $*DatagramChannel "socket"))
  103. (defvar $@socket/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "socket"))
  104. (defvar $@socket/SocketChannel/0 (jmethod $*SocketChannel "socket"))
  105. (defvar $@validOps/0 (jmethod $*SelectableChannel "validOps"))
  106. ;;; Java Field Variables ($+...)
  107. (defvar $+op-accept (jfield $*SelectionKey "OP_ACCEPT"))
  108. (defvar $+op-connect (jfield $*SelectionKey "OP_CONNECT"))
  109. (defvar $+op-read (jfield $*SelectionKey "OP_READ"))
  110. (defvar $+op-write (jfield $*SelectionKey "OP_WRITE"))
  111. ;;; Wrapper functions (return-type: java-object)
  112. (defun %get-address (address)
  113. (jcall $@getAddress/0 address))
  114. (defun %get-all-by-name (string) ; return a simple vector
  115. (jstatic $@getAllByName/1 $*InetAddress string))
  116. (defun %get-by-name (string)
  117. (jstatic $@getByName/1 $*InetAddress string))
  118. (defun host-to-inet4 (host)
  119. "USOCKET host formats to Java Inet4Address, used internally."
  120. (%get-by-name (host-to-hostname host)))
  121. ;;; HANDLE-CONTITION
  122. (defparameter +abcl-error-map+
  123. `(("java.net.BindException" . operation-not-permitted-error)
  124. ("java.net.ConnectException" . connection-refused-error)
  125. ("java.net.NoRouteToHostException" . network-unreachable-error) ; untested
  126. ("java.net.PortUnreachableException" . protocol-not-supported-error) ; untested
  127. ("java.net.ProtocolException" . protocol-not-supported-error) ; untested
  128. ("java.net.SocketException" . socket-type-not-supported-error) ; untested
  129. ("java.net.SocketTimeoutException" . timeout-error)))
  130. (defparameter +abcl-nameserver-error-map+
  131. `(("java.net.UnknownHostException" . ns-host-not-found-error)))
  132. (defun handle-condition (condition &optional (socket nil))
  133. (typecase condition
  134. (java-exception
  135. (let ((java-cause (java-exception-cause condition)))
  136. (let* ((usock-error (cdr (assoc (jclass-of java-cause) +abcl-error-map+
  137. :test #'string=)))
  138. (usock-error (if (functionp usock-error)
  139. (funcall usock-error condition)
  140. usock-error))
  141. (nameserver-error (cdr (assoc (jclass-of java-cause) +abcl-nameserver-error-map+
  142. :test #'string=))))
  143. (if nameserver-error
  144. (error nameserver-error :host-or-ip nil)
  145. (when usock-error
  146. (error usock-error :socket socket))))))))
  147. ;;; GET-HOSTS-BY-NAME
  148. (defun get-address (address)
  149. (when address
  150. (let* ((array (%get-address address))
  151. (length (jarray-length array)))
  152. (labels ((jbyte (n)
  153. (let ((byte (jarray-ref array n)))
  154. (if (minusp byte) (+ 256 byte) byte))))
  155. (cond
  156. ((= 4 length)
  157. (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)))
  158. ((= 16 length)
  159. (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)
  160. (jbyte 4) (jbyte 5) (jbyte 6) (jbyte 7)))
  161. (t nil)))))) ; neither a IPv4 nor IPv6 address?!
  162. (defun get-hosts-by-name (name)
  163. (with-mapped-conditions ()
  164. (map 'list #'get-address (%get-all-by-name name))))
  165. ;;; GET-HOST-BY-ADDRESS
  166. (defun get-host-by-address (host)
  167. (let ((inet4 (host-to-inet4 host)))
  168. (with-mapped-conditions ()
  169. (jcall $@getHostName/0 inet4))))
  170. ;;; SOCKET-CONNECT
  171. (defun socket-connect (host port &key (protocol :stream) (element-type 'character)
  172. timeout deadline (nodelay t nodelay-supplied-p)
  173. local-host local-port)
  174. (when deadline (unsupported 'deadline 'socket-connect))
  175. (let (socket stream usocket)
  176. (ecase protocol
  177. (:stream ; TCP
  178. (let ((channel (jstatic $@open/SocketChannel/0 $*SocketChannel))
  179. (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
  180. (setq socket (jcall $@socket/SocketChannel/0 channel))
  181. ;; bind to local address if needed
  182. (when (or local-host local-port)
  183. (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
  184. (with-mapped-conditions ()
  185. (jcall $@bind/Socket/1 socket local-address))))
  186. ;; connect to dest address
  187. (with-mapped-conditions ()
  188. (jcall $@connect/SocketChannel/1 channel address))
  189. (setq stream (ext:get-socket-stream socket :element-type element-type)
  190. usocket (make-stream-socket :stream stream :socket socket))
  191. (when nodelay-supplied-p
  192. (jcall $@setTcpNoDelay/1 socket (if nodelay ;; both t and :if-supported mean java:+true+
  193. java:+true+ java:+false+)))
  194. (when timeout
  195. (jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeout))))))
  196. (:datagram ; UDP
  197. (let ((channel (jstatic $@open/DatagramChannel/0 $*DatagramChannel)))
  198. (setq socket (jcall $@socket/DatagramChannel/0 channel))
  199. ;; bind to local address if needed
  200. (when (or local-host local-port)
  201. (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
  202. (with-mapped-conditions ()
  203. (jcall $@bind/DatagramSocket/1 socket local-address))))
  204. ;; connect to dest address if needed
  205. (when (and host port)
  206. (let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
  207. (with-mapped-conditions ()
  208. (jcall $@connect/DatagramChannel/1 channel address))))
  209. (setq usocket (make-datagram-socket socket :connected-p (if (and host port) t nil)))
  210. (when timeout
  211. (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 1000 timeout)))))))
  212. usocket))
  213. ;;; SOCKET-LISTEN
  214. (defun socket-listen (host port &key reuseaddress
  215. (reuse-address nil reuse-address-supplied-p)
  216. (backlog 5 backlog-supplied-p)
  217. (element-type 'character))
  218. (declare (type boolean reuse-address))
  219. (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
  220. (channel (jstatic $@open/ServerSocketChannel/0 $*ServerSocketChannel))
  221. (socket (jcall $@socket/ServerSocketChannel/0 channel))
  222. (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) (or port 0))))
  223. (jcall $@setReuseAddress/1 socket (if reuseaddress java:+true+ java:+false+))
  224. (with-mapped-conditions (socket)
  225. (if backlog-supplied-p
  226. (jcall $@bind/ServerSocket/2 socket endpoint backlog)
  227. (jcall $@bind/ServerSocket/1 socket endpoint)))
  228. (make-stream-server-socket socket :element-type element-type)))
  229. ;;; SOCKET-ACCEPT
  230. (defmethod socket-accept ((usocket stream-server-usocket)
  231. &key (element-type 'character element-type-p))
  232. (with-mapped-conditions (usocket)
  233. (let* ((client-socket (jcall $@accept/0 (socket usocket)))
  234. (element-type (if element-type-p
  235. element-type
  236. (element-type usocket)))
  237. (stream (ext:get-socket-stream client-socket :element-type element-type)))
  238. (make-stream-socket :stream stream :socket client-socket))))
  239. ;;; SOCKET-CLOSE
  240. (defmethod socket-close :before ((usocket usocket))
  241. (when (wait-list usocket)
  242. (remove-waiter (wait-list usocket) usocket)))
  243. (defmethod socket-close ((usocket stream-server-usocket))
  244. (with-mapped-conditions (usocket)
  245. (jcall $@close/ServerSocket/0 (socket usocket))))
  246. (defmethod socket-close ((usocket stream-usocket))
  247. (with-mapped-conditions (usocket)
  248. (close (socket-stream usocket))
  249. (jcall $@close/Socket/0 (socket usocket))))
  250. (defmethod socket-close ((usocket datagram-usocket))
  251. (with-mapped-conditions (usocket)
  252. (jcall $@close/DatagramSocket/0 (socket usocket))))
  253. ;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT
  254. (defmethod get-local-name ((usocket usocket))
  255. (values (get-local-address usocket)
  256. (get-local-port usocket)))
  257. (defmethod get-peer-name ((usocket usocket))
  258. (values (get-peer-address usocket)
  259. (get-peer-port usocket)))
  260. (defmethod get-local-address ((usocket stream-usocket))
  261. (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket))))
  262. (defmethod get-local-address ((usocket stream-server-usocket))
  263. (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket))))
  264. (defmethod get-local-address ((usocket datagram-usocket))
  265. (get-address (jcall $@getLocalAddress/DatagramSocket/0 (socket usocket))))
  266. (defmethod get-peer-address ((usocket stream-usocket))
  267. (get-address (jcall $@getInetAddress/Socket/0 (socket usocket))))
  268. (defmethod get-peer-address ((usocket datagram-usocket))
  269. (get-address (jcall $@getInetAddress/DatagramSocket/0 (socket usocket))))
  270. (defmethod get-local-port ((usocket stream-usocket))
  271. (jcall $@getLocalPort/Socket/0 (socket usocket)))
  272. (defmethod get-local-port ((usocket stream-server-usocket))
  273. (jcall $@getLocalPort/ServerSocket/0 (socket usocket)))
  274. (defmethod get-local-port ((usocket datagram-usocket))
  275. (jcall $@getLocalPort/DatagramSocket/0 (socket usocket)))
  276. (defmethod get-peer-port ((usocket stream-usocket))
  277. (jcall $@getPort/Socket/0 (socket usocket)))
  278. (defmethod get-peer-port ((usocket datagram-usocket))
  279. (jcall $@getPort/DatagramSocket/0 (socket usocket)))
  280. ;;; SOCKET-SEND & SOCKET-RECEIVE
  281. (defun *->byte (data)
  282. (declare (type (unsigned-byte 8) data)) ; required by SOCKET-SEND
  283. (jnew $%Byte/0 (if (> data 127) (- data 256) data)))
  284. (defun byte->* (byte &optional (element-type '(unsigned-byte 8)))
  285. (let* ((ub8 (if (minusp byte) (+ 256 byte) byte)))
  286. (if (eq element-type 'character)
  287. (code-char ub8)
  288. ub8)))
  289. (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
  290. (let* ((socket (socket usocket))
  291. (byte-array (jnew-array $*byte size))
  292. (packet (if (and host port)
  293. (jnew $%DatagramPacket/5 byte-array 0 size (host-to-inet4 host) port)
  294. (jnew $%DatagramPacket/3 byte-array 0 size))))
  295. ;; prepare sending data
  296. (loop for i from offset below (+ size offset)
  297. do (setf (jarray-ref byte-array i) (*->byte (aref buffer i))))
  298. (with-mapped-conditions (usocket)
  299. (jcall $@send/1 socket packet))))
  300. ;;; TODO: return-host and return-port cannot be get ...
  301. (defmethod socket-receive ((usocket datagram-usocket) buffer length
  302. &key (element-type '(unsigned-byte 8)))
  303. (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
  304. (integer 0) ; size
  305. (unsigned-byte 32) ; host
  306. (unsigned-byte 16))) ; port
  307. (let* ((socket (socket usocket))
  308. (real-length (or length +max-datagram-packet-size+))
  309. (byte-array (jnew-array $*byte real-length))
  310. (packet (jnew $%DatagramPacket/3 byte-array 0 real-length)))
  311. (with-mapped-conditions (usocket)
  312. (jcall $@receive/1 socket packet))
  313. (let* ((receive-length (jcall $@getLength/DatagramPacket/0 packet))
  314. (return-buffer (or buffer (make-array receive-length :element-type element-type))))
  315. (loop for i from 0 below receive-length
  316. do (setf (aref return-buffer i)
  317. (byte->* (jarray-ref byte-array i) element-type)))
  318. (let ((return-host (if (connected-p usocket)
  319. (get-peer-address usocket)
  320. (get-address (jcall $@getAddress/DatagramPacket/0 packet))))
  321. (return-port (if (connected-p usocket)
  322. (get-peer-port usocket)
  323. (jcall $@getPort/DatagramPacket/0 packet))))
  324. (values return-buffer
  325. receive-length
  326. return-host
  327. return-port)))))
  328. ;;; WAIT-FOR-INPUT
  329. (defun socket-channel-class (usocket)
  330. (cond ((stream-usocket-p usocket) $*SocketChannel)
  331. ((stream-server-usocket-p usocket) $*ServerSocketChannel)
  332. ((datagram-usocket-p usocket) $*DatagramChannel)))
  333. (defun get-socket-channel (usocket)
  334. (let ((method (cond ((stream-usocket-p usocket) $@getChannel/Socket/0)
  335. ((stream-server-usocket-p usocket) $@getChannel/ServerSocket/0)
  336. ((datagram-usocket-p usocket) $@getChannel/DatagramSocket/0))))
  337. (jcall method (socket usocket))))
  338. (defun wait-for-input-internal (wait-list &key timeout)
  339. (let* ((sockets (wait-list-waiters wait-list))
  340. (ops (logior $+op-read $+op-accept))
  341. (selector (jstatic $@open/Selector/0 $*Selector))
  342. (channels (mapcar #'get-socket-channel sockets)))
  343. (unwind-protect
  344. (with-mapped-conditions ()
  345. (dolist (channel channels)
  346. (jcall $@configureBlocking/1 channel java:+false+)
  347. (jcall $@register/2 channel selector (logand ops (jcall $@validOps/0 channel))))
  348. (let ((ready-count (if timeout
  349. (jcall $@select/1 selector (truncate (* timeout 1000)))
  350. (jcall $@select/0 selector))))
  351. (when (plusp ready-count)
  352. (let* ((keys (jcall $@selectedKeys/0 selector))
  353. (iterator (jcall $@iterator/0 keys))
  354. (%wait (wait-list-%wait wait-list)))
  355. (loop while (jcall $@hasNext/0 iterator)
  356. do (let* ((key (jcall $@next/0 iterator))
  357. (channel (jcall $@channel/0 key)))
  358. (setf (state (gethash channel %wait)) :read)))))))
  359. (jcall $@close/Selector/0 selector)
  360. (dolist (channel channels)
  361. (jcall $@configureBlocking/1 channel java:+true+)))))
  362. ;;; WAIT-LIST
  363. ;;; NOTE from original worker (Erik):
  364. ;;; Note that even though Java has the concept of the Selector class, which
  365. ;;; remotely looks like a wait-list, it requires the sockets to be non-blocking.
  366. ;;; usocket however doesn't make any such guarantees and is therefore unable to
  367. ;;; use the concept outside of the waiting routine itself (blergh!).
  368. (defun %setup-wait-list (wl)
  369. (setf (wait-list-%wait wl)
  370. (make-hash-table :test #'equal :rehash-size 1.3d0)))
  371. (defun %add-waiter (wl w)
  372. (setf (gethash (get-socket-channel w) (wait-list-%wait wl)) w))
  373. (defun %remove-waiter (wl w)
  374. (remhash (get-socket-channel w) (wait-list-%wait wl)))