tabcl.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) LICENSE
---
tabcl.lisp (20241B)
---
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))
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 :host-or-ip nil)
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 ()
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 ()
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 ()
207 (jcall $@bind/Socket/1 socket local-address))))
208 ;; connect to dest address
209 (with-mapped-conditions ()
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 ()
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 ()
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)
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 :before ((usocket usocket))
269 (when (wait-list usocket)
270 (remove-waiter (wait-list usocket) usocket)))
271
272 (defmethod socket-close ((usocket stream-server-usocket))
273 (with-mapped-conditions (usocket)
274 (jcall $@close/ServerSocket/0 (socket usocket))))
275
276 (defmethod socket-close ((usocket stream-usocket))
277 (with-mapped-conditions (usocket)
278 (close (socket-stream usocket))
279 (jcall $@close/Socket/0 (socket usocket))))
280
281 (defmethod socket-close ((usocket datagram-usocket))
282 (with-mapped-conditions (usocket)
283 (jcall $@close/DatagramSocket/0 (socket usocket))))
284
285 (defmethod socket-shutdown ((usocket stream-usocket) direction)
286 (with-mapped-conditions (usocket)
287 (ecase direction
288 (:input
289 (jcall $@shutdownInput/Socket/0 (socket usocket)))
290 (:output
291 (jcall $@shutdownOutput/Socket/0 (socket usocket))))))
292
293 ;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT
294
295 (defmethod get-local-name ((usocket usocket))
296 (values (get-local-address usocket)
297 (get-local-port usocket)))
298
299 (defmethod get-peer-name ((usocket usocket))
300 (values (get-peer-address usocket)
301 (get-peer-port usocket)))
302
303 (defmethod get-local-address ((usocket stream-usocket))
304 (get-address (jcall $@getLocalAddress/Socket/0 (socket usocket))))
305
306 (defmethod get-local-address ((usocket stream-server-usocket))
307 (get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket))))
308
309 (defmethod get-local-address ((usocket datagram-usocket))
310 (get-address (jcall $@getLocalAddress/DatagramSocket/0 (socket usocket))))
311
312 (defmethod get-peer-address ((usocket stream-usocket))
313 (get-address (jcall $@getInetAddress/Socket/0 (socket usocket))))
314
315 (defmethod get-peer-address ((usocket datagram-usocket))
316 (get-address (jcall $@getInetAddress/DatagramSocket/0 (socket usocket))))
317
318 (defmethod get-local-port ((usocket stream-usocket))
319 (jcall $@getLocalPort/Socket/0 (socket usocket)))
320
321 (defmethod get-local-port ((usocket stream-server-usocket))
322 (jcall $@getLocalPort/ServerSocket/0 (socket usocket)))
323
324 (defmethod get-local-port ((usocket datagram-usocket))
325 (jcall $@getLocalPort/DatagramSocket/0 (socket usocket)))
326
327 (defmethod get-peer-port ((usocket stream-usocket))
328 (jcall $@getPort/Socket/0 (socket usocket)))
329
330 (defmethod get-peer-port ((usocket datagram-usocket))
331 (jcall $@getPort/DatagramSocket/0 (socket usocket)))
332
333 ;;; SOCKET-SEND & SOCKET-RECEIVE
334
335 (defun *->byte (data)
336 (declare (type (unsigned-byte 8) data)) ; required by SOCKET-SEND
337 (jnew $%Byte/0 (if (> data 127) (- data 256) data)))
338
339 (defun byte->* (byte &optional (element-type '(unsigned-byte 8)))
340 (let* ((ub8 (if (minusp byte) (+ 256 byte) byte)))
341 (if (eq element-type 'character)
342 (code-char ub8)
343 ub8)))
344
345 (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
346 (let* ((socket (socket usocket))
347 (byte-array (jnew-array $*byte size))
348 (packet (if (and host port)
349 (jnew $%DatagramPacket/5 byte-array 0 size (host-to-inet4 host) port)
350 (jnew $%DatagramPacket/3 byte-array 0 size))))
351 ;; prepare sending data
352 (loop for i from offset below (+ size offset)
353 do (setf (jarray-ref byte-array i) (*->byte (aref buffer i))))
354 (with-mapped-conditions (usocket)
355 (jcall $@send/1 socket packet))))
356
357 ;;; TODO: return-host and return-port cannot be get ...
358 (defmethod socket-receive ((usocket datagram-usocket) buffer length
359 &key (element-type '(unsigned-byte 8)))
360 (declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
361 (integer 0) ; size
362 (unsigned-byte 32) ; host
363 (unsigned-byte 16))) ; port
364 (let* ((socket (socket usocket))
365 (real-length (or length +max-datagram-packet-size+))
366 (byte-array (jnew-array $*byte real-length))
367 (packet (jnew $%DatagramPacket/3 byte-array 0 real-length)))
368 (with-mapped-conditions (usocket)
369 (jcall $@receive/1 socket packet))
370 (let* ((receive-length (jcall $@getLength/DatagramPacket/0 packet))
371 (return-buffer (or buffer (make-array receive-length :element-type element-type))))
372 (loop for i from 0 below receive-length
373 do (setf (aref return-buffer i)
374 (byte->* (jarray-ref byte-array i) element-type)))
375 (let ((return-host (if (connected-p usocket)
376 (get-peer-address usocket)
377 (get-address (jcall $@getAddress/DatagramPacket/0 packet))))
378 (return-port (if (connected-p usocket)
379 (get-peer-port usocket)
380 (jcall $@getPort/DatagramPacket/0 packet))))
381 (values return-buffer
382 receive-length
383 return-host
384 return-port)))))
385
386 ;;; WAIT-FOR-INPUT
387
388 (defun socket-channel-class (usocket)
389 (cond ((stream-usocket-p usocket) $*SocketChannel)
390 ((stream-server-usocket-p usocket) $*ServerSocketChannel)
391 ((datagram-usocket-p usocket) $*DatagramChannel)))
392
393 (defun get-socket-channel (usocket)
394 (let ((method (cond ((stream-usocket-p usocket) $@getChannel/Socket/0)
395 ((stream-server-usocket-p usocket) $@getChannel/ServerSocket/0)
396 ((datagram-usocket-p usocket) $@getChannel/DatagramSocket/0))))
397 (jcall method (socket usocket))))
398
399 (defun wait-for-input-internal (wait-list &key timeout)
400 (let* ((sockets (wait-list-waiters wait-list))
401 (ops (logior $+op-read $+op-accept))
402 (selector (jstatic $@open/Selector/0 $*Selector))
403 (channels (mapcar #'get-socket-channel sockets)))
404 (unwind-protect
405 (with-mapped-conditions ()
406 (dolist (channel channels)
407 (jcall $@configureBlocking/1 channel java:+false+)
408 (jcall $@register/2 channel selector (logand ops (jcall $@validOps/0 channel))))
409 (let ((ready-count (if timeout
410 (jcall $@select/1 selector (truncate (* timeout 1000)))
411 (jcall $@select/0 selector))))
412 (when (plusp ready-count)
413 (let* ((keys (jcall $@selectedKeys/0 selector))
414 (iterator (jcall $@iterator/0 keys))
415 (%wait (wait-list-%wait wait-list)))
416 (loop while (jcall $@hasNext/0 iterator)
417 do (let* ((key (jcall $@next/0 iterator))
418 (channel (jcall $@channel/0 key)))
419 (setf (state (gethash channel %wait)) :read)))))))
420 (jcall $@close/Selector/0 selector)
421 (dolist (channel channels)
422 (jcall $@configureBlocking/1 channel java:+true+)))))
423
424 ;;; WAIT-LIST
425
426 ;;; NOTE from original worker (Erik):
427 ;;; Note that even though Java has the concept of the Selector class, which
428 ;;; remotely looks like a wait-list, it requires the sockets to be non-blocking.
429 ;;; usocket however doesn't make any such guarantees and is therefore unable to
430 ;;; use the concept outside of the waiting routine itself (blergh!).
431
432 (defun %setup-wait-list (wl)
433 (setf (wait-list-%wait wl)
434 (make-hash-table :test #'equal :rehash-size 1.3d0)))
435
436 (defun %add-waiter (wl w)
437 (setf (gethash (get-socket-channel w) (wait-list-%wait wl)) w))
438
439 (defun %remove-waiter (wl w)
440 (remhash (get-socket-channel w) (wait-list-%wait wl)))