PageRenderTime 68ms CodeModel.GetById 2ms app.highlight 60ms RepoModel.GetById 1ms app.codeStats 1ms

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