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