[usocket-cvs] r555 - in usocket/trunk: . backend vendor
Chun Tian (binghe)
ctian at common-lisp.net
Mon Sep 13 15:33:20 UTC 2010
Author: ctian
Date: Mon Sep 13 11:33:20 2010
New Revision: 555
Log:
ABCL: replace old JDI-based implementation with new implementation.
Removed:
usocket/trunk/backend/armedbear.lisp
usocket/trunk/vendor/abcl-jdi.lisp
Modified:
usocket/trunk/backend/abcl.lisp
usocket/trunk/package.lisp
usocket/trunk/usocket.asd
usocket/trunk/usocket.lisp
Modified: usocket/trunk/backend/abcl.lisp
==============================================================================
--- usocket/trunk/backend/abcl.lisp (original)
+++ usocket/trunk/backend/abcl.lisp Mon Sep 13 11:33:20 2010
@@ -8,20 +8,49 @@
(in-package :usocket)
+;;; Symbols in JAVA package
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defparameter *java-package-symbols*
+ '(java:jarray-length
+ java:jarray-ref
+ java:java-exception
+ java:java-exception-cause
+ java:jconstructor
+ java:jcall
+ java:jclass
+ java:jclass-of
+ java:jfield
+ java:jmethod
+ java:jnew
+ java:jstatic
+ java:make-immediate-object))
+ (import *java-package-symbols*))
+
;;; Java Classes ($*...)
(defvar $*boolean (jclass "boolean"))
(defvar $*int (jclass "int"))
+(defvar $*long (jclass "long"))
+(defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel"))
(defvar $*DatagramSocket (jclass "java.net.DatagramSocket"))
(defvar $*Inet4Address (jclass "java.net.Inet4Address"))
(defvar $*InetAddress (jclass "java.net.InetAddress"))
(defvar $*InetSocketAddress (jclass "java.net.InetSocketAddress"))
+(defvar $*Iterator (jclass "java.util.Iterator"))
+(defvar $*SelectableChannel (jclass "java.nio.channels.SelectableChannel"))
+(defvar $*SelectionKey (jclass "java.nio.channels.SelectionKey"))
+(defvar $*Selector (jclass "java.nio.channels.Selector"))
(defvar $*ServerSocket (jclass "java.net.ServerSocket"))
+(defvar $*ServerSocketChannel (jclass "java.nio.channels.ServerSocketChannel"))
+(defvar $*Set (jclass "java.util.Set"))
(defvar $*Socket (jclass "java.net.Socket"))
(defvar $*SocketAddress (jclass "java.net.SocketAddress"))
+(defvar $*SocketChannel (jclass "java.nio.channels.SocketChannel"))
(defvar $*String (jclass "java.lang.String"))
;;; Java Constructor ($%.../n)
(defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket))
+(defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int))
+(defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAddress))
(defvar $%InetSocketAddress/1 (jconstructor $*InetSocketAddress $*int))
(defvar $%InetSocketAddress/2 (jconstructor $*InetSocketAddress $*InetAddress $*int))
(defvar $%ServerSocket/0 (jconstructor $*ServerSocket))
@@ -34,23 +63,65 @@
;;; Java Methods ($@...[/Class]/n)
(defvar $@accept/0 (jmethod $*ServerSocket "accept"))
-(defvar $@bind/1 (jmethod $*ServerSocket "bind" $*SocketAddress))
-(defvar $@bind/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int))
+(defvar $@bind/DatagramSocket/1 (jmethod $*DatagramSocket "bind" $*SocketAddress))
+(defvar $@bind/ServerSocket/1 (jmethod $*ServerSocket "bind" $*SocketAddress))
+(defvar $@bind/ServerSocket/2 (jmethod $*ServerSocket "bind" $*SocketAddress $*int))
+(defvar $@bind/Socket/1 (jmethod $*Socket "bind" $*SocketAddress))
+(defvar $@channel/0 (jmethod $*SelectionKey "channel"))
+(defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close"))
+(defvar $@close/Selector/0 (jmethod $*Selector "close"))
(defvar $@close/ServerSocket/0 (jmethod $*ServerSocket "close"))
(defvar $@close/Socket/0 (jmethod $*Socket "close"))
-(defvar $@connect/1 (jmethod $*Socket "connect" $*SocketAddress))
-(defvar $@connect/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
+(defvar $@configureBlocking/1 (jmethod $*SelectableChannel "configureBlocking" $*boolean))
+(defvar $@connect/DatagramChannel/1 (jmethod $*DatagramChannel "connect" $*SocketAddress))
+(defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress))
+(defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
+(defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*SocketAddress))
(defvar $@getAddress/0 (jmethod $*Inet4Address "getAddress"))
(defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String))
(defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String))
+(defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel"))
+(defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel"))
+(defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel"))
(defvar $@getHostName/0 (jmethod $*InetAddress "getHostName"))
+(defvar $@getInetAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getInetAddress"))
(defvar $@getInetAddress/ServerSocket/0 (jmethod $*ServerSocket "getInetAddress"))
(defvar $@getInetAddress/Socket/0 (jmethod $*Socket "getInetAddress"))
+(defvar $@getLocalAddress/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalAddress"))
(defvar $@getLocalAddress/Socket/0 (jmethod $*Socket "getLocalAddress"))
+(defvar $@getLocalPort/DatagramSocket/0 (jmethod $*DatagramSocket "getLocalPort"))
(defvar $@getLocalPort/ServerSocket/0 (jmethod $*ServerSocket "getLocalPort"))
(defvar $@getLocalPort/Socket/0 (jmethod $*Socket "getLocalPort"))
+(defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort"))
(defvar $@getPort/Socket/0 (jmethod $*Socket "getPort"))
+(defvar $@hasNext/0 (jmethod $*Iterator "hasNext"))
+(defvar $@iterator/0 (jmethod $*Set "iterator"))
+(defvar $@next/0 (jmethod $*Iterator "next"))
+(defvar $@open/DatagramChannel/0 (jmethod $*DatagramChannel "open"))
+(defvar $@open/Selector/0 (jmethod $*Selector "open"))
+(defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "open"))
+(defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open"))
+(defvar $@register/2 (jmethod $*SelectableChannel "register" $*Selector $*int))
+(defvar $@select/0 (jmethod $*Selector "select"))
+(defvar $@select/1 (jmethod $*Selector "select" $*long))
+(defvar $@selectedKeys/0 (jmethod $*Selector "selectedKeys"))
(defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean))
+(defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSoTimeout" $*int))
+(defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int))
+(defvar $@setTcpNoDelay/1 (jmethod $*Socket "setTcpNoDelay" $*boolean))
+(defvar $@socket/DatagramChannel/0 (jmethod $*DatagramChannel "socket"))
+(defvar $@socket/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "socket"))
+(defvar $@socket/SocketChannel/0 (jmethod $*SocketChannel "socket"))
+(defvar $@validOps/0 (jmethod $*SelectableChannel "validOps"))
+
+;;; Java Field Variables ($+...)
+(defvar $+op-accept (jfield $*SelectionKey "OP_ACCEPT"))
+(defvar $+op-connect (jfield $*SelectionKey "OP_CONNECT"))
+(defvar $+op-read (jfield $*SelectionKey "OP_READ"))
+(defvar $+op-write (jfield $*SelectionKey "OP_WRITE"))
+
+(defconstant +java-true+ (make-immediate-object t :boolean))
+(defconstant +java-false+ (make-immediate-object nil :boolean))
;;; Wrapper functions (return-type: java-object)
(defun %get-address (address)
@@ -60,6 +131,10 @@
(defun %get-by-name (string)
(jstatic $@getByName/1 $*InetAddress string))
+(defun host-to-inet4 (host)
+ "USOCKET host formats to Java Inet4Address, used internally."
+ (%get-by-name (host-to-hostname host)))
+
;;; HANDLE-CONTITION
(defun handle-condition (condition &optional (socket nil))
@@ -79,8 +154,7 @@
(error usock-error :socket socket))))))))
(defparameter +abcl-error-map+
- `(;("java.io.IOException" . )
- ("java.net.ConnectException" . connection-refused-error)
+ `(("java.net.ConnectException" . connection-refused-error)
("java.net.SocketTimeoutException" . timeout-error)
("java.net.BindException" . operation-not-permitted-error)))
@@ -105,11 +179,8 @@
(with-mapped-conditions ()
(map 'list #'get-address (%get-all-by-name name))))
-(defun host-to-inet4 (host)
- "USOCKET host formats to Java Inet4Address, used internally."
- (%get-by-name (host-to-hostname host)))
-
;;; GET-HOST-BY-ADDRESS
+
(defun get-host-by-address (host)
(let ((inet4 (host-to-inet4 host)))
(with-mapped-conditions ()
@@ -120,83 +191,192 @@
(defun socket-connect (host port &key (protocol :stream) (element-type 'character)
timeout deadline (nodelay t nodelay-supplied-p)
local-host local-port)
- (declare (type integer timeout))
- (if (eq protocol :stream)
- (let* ((socket (with-mapped-conditions ()
- (if (or local-host local-port)
- (jnew $%Socket/4 (host-to-inet4 host) port (host-to-inet4 local-host) local-port)
- (if timeout
- (let ((socket (jnew $%Socket/0))
- (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
- (jcall $@connect/2 socket address timeout)
- socket)
- (jnew $%Socket/2 (host-to-inet4 host) port)))))
- (stream (ext:get-socket-stream socket :element-type element-type))
- (usocket (make-stream-socket :stream stream :socket socket)))
- usocket)
- (socket-connect-for-udp host port :timeout timeout :local-host local-host :local-port local-port)))
+ (when deadline (unsupported 'deadline 'socket-connect))
+ (let (socket stream usocket)
+ (ecase protocol
+ (:stream ; TCP
+ (let ((channel (jstatic $@open/SocketChannel/0 $*SocketChannel))
+ (address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
+ (setq socket (jcall $@socket/SocketChannel/0 channel))
+ ;; bind to local address if needed
+ (when (or local-host local-port)
+ (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
+ (with-mapped-conditions ()
+ (jcall $@bind/Socket/1 socket local-address))))
+ ;; connect to dest address
+ (with-mapped-conditions ()
+ (jcall $@connect/SocketChannel/1 channel address))
+ (setq stream (ext:get-socket-stream socket :element-type element-type)
+ usocket (make-stream-socket :stream stream :socket socket))
+ (when nodelay-supplied-p
+ (jcall $@setTcpNoDelay/1 socket (if nodelay +java-true+ +java-false+)))
+ (when timeout
+ (jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeout))))))
+ (:datagram ; UDP
+ (let ((channel (jstatic $@open/DatagramChannel/0 $*DatagramChannel)))
+ (setq socket (jcall $@socket/DatagramChannel/0 channel))
+ ;; bind to local address if needed
+ (when (or local-host local-port)
+ (let ((local-address (jnew $%InetSocketAddress/2 (host-to-inet4 local-host) (or local-port 0))))
+ (with-mapped-conditions ()
+ (jcall $@bind/DatagramSocket/1 socket local-address))))
+ ;; connect to dest address if needed
+ (when (and host port)
+ (let ((address (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
+ (with-mapped-conditions ()
+ (jcall $@connect/DatagramChannel/1 channel address))))
+ (setq usocket (make-datagram-socket socket))
+ (when timeout
+ (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 1000 timeout)))))))
+ usocket))
-(defun socket-connect-for-udp (host port &key timeout local-host local-port)
- )
+;;; SOCKET-LISTEN
-(defun socket-listen (host port &key reuseaddress (element-type 'character)
+(defun socket-listen (host port &key (element-type 'character)
(reuse-address nil reuse-address-supplied-p)
(backlog 5 backlog-supplied-p))
- (let ((socket (jnew $%ServerSocket/0))
- (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) port)))
- #+ignore ;; TODO: java.lang.IllegalArgumentException?
+ (declare (type boolean reuse-address))
+ (let* ((channel (jstatic $@open/ServerSocketChannel/0 $*ServerSocketChannel))
+ (socket (jcall $@socket/ServerSocketChannel/0 channel))
+ (endpoint (jnew $%InetSocketAddress/2 (host-to-inet4 host) (or port 0))))
(when reuse-address-supplied-p
- (jcall $@setReuseAddress/1 socket reuse-address))
+ (jcall $@setReuseAddress/1 socket (if reuse-address +java-true+ +java-false+)))
(with-mapped-conditions (socket)
(if backlog-supplied-p
- (jcall $@bind/2 socket endpoint backlog)
- (jcall $@bind/1 socket endpoint)))
+ (jcall $@bind/ServerSocket/2 socket endpoint backlog)
+ (jcall $@bind/ServerSocket/1 socket endpoint)))
(make-stream-server-socket socket :element-type element-type)))
+;;; SOCKET-ACCEPT
+
(defmethod socket-accept ((socket stream-server-usocket) &key (element-type 'character))
(with-mapped-conditions (socket)
(let* ((client-socket (jcall $@accept/0 socket))
(stream (ext:get-socket-stream client-socket :element-type element-type)))
(make-stream-socket :stream stream :socket client-socket))))
+;;; SOCKET-CLOSE
+
(defmethod socket-close :before ((usocket usocket))
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket)))
-(defmethod socket-close ((usocket usocket))
- (with-mapped-conditions (usocket)
- (jcall $@close/Socket/0 (socket usocket))))
-
(defmethod socket-close ((usocket stream-server-usocket))
(with-mapped-conditions (usocket)
(jcall $@close/ServerSocket/0 (socket usocket))))
(defmethod socket-close ((usocket stream-usocket))
(with-mapped-conditions (usocket)
- (close (socket-stream usocket))))
+ (close (socket-stream usocket))
+ (jcall $@close/Socket/0 (socket usocket))))
+
+(defmethod socket-close ((usocket datagram-usocket))
+ (with-mapped-conditions (usocket)
+ (jcall $@close/DatagramSocket/0 (socket usocket))))
+
+;;; GET-LOCAL/PEER-NAME/ADDRESS/PORT
(defmethod get-local-name ((usocket usocket))
(values (get-local-address usocket)
(get-local-port usocket)))
-(defmethod get-peer-name ((usocket stream-usocket))
+(defmethod get-peer-name ((usocket usocket))
(values (get-peer-address usocket)
(get-peer-port usocket)))
-(defmethod get-local-address ((usocket usocket))
+(defmethod get-local-address ((usocket stream-usocket))
(get-address (jcall $@getLocalAddress/Socket/0 (socket usocket))))
(defmethod get-local-address ((usocket stream-server-usocket))
(get-address (jcall $@getInetAddress/ServerSocket/0 (socket usocket))))
-(defmethod get-peer-address ((usocket usocket))
+(defmethod get-local-address ((usocket datagram-usocket))
+ (get-address (jcall $@getLocalAddress/DatagramSocket/0 (socket usocket))))
+
+(defmethod get-peer-address ((usocket stream-usocket))
(get-address (jcall $@getInetAddress/Socket/0 (socket usocket))))
-(defmethod get-local-port ((usocket usocket))
+(defmethod get-peer-address ((usocket datagram-usocket))
+ (get-address (jcall $@getInetAddress/DatagramSocket/0 (socket usocket))))
+
+(defmethod get-local-port ((usocket stream-usocket))
(jcall $@getLocalPort/Socket/0 (socket usocket)))
(defmethod get-local-port ((usocket stream-server-usocket))
(jcall $@getLocalPort/ServerSocket/0 (socket usocket)))
-(defmethod get-peer-port ((usocket usocket))
+(defmethod get-local-port ((usocket datagram-usocket))
+ (jcall $@getLocalPort/DatagramSocket/0 (socket usocket)))
+
+(defmethod get-peer-port ((usocket stream-usocket))
(jcall $@getPort/Socket/0 (socket usocket)))
+
+(defmethod get-peer-port ((usocket datagram-usocket))
+ (jcall $@getPort/DatagramSocket/0 (socket usocket)))
+
+;;; SOCKET-SEND & SOCKET-RECEIVE
+
+(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
+ (with-mapped-conditions (socket)
+ ))
+
+(defmethod socket-receive ((socket datagram-usocket) buffer length
+ &key (element-type '(unsigned-byte 8)))
+ (with-mapped-conditions (socket)
+ ))
+
+;;; WAIT-FOR-INPUT
+
+(defun socket-channel-class (usocket)
+ (cond ((stream-usocket-p usocket) $*SocketChannel)
+ ((stream-server-usocket-p usocket) $*ServerSocketChannel)
+ ((datagram-usocket-p usocket) $*DatagramChannel)))
+
+(defun get-socket-channel (usocket)
+ (let ((method (cond ((stream-usocket-p usocket) $@getChannel/Socket/0)
+ ((stream-server-usocket-p usocket) $@getChannel/ServerSocket/0)
+ ((datagram-usocket-p usocket) $@getChannel/DatagramSocket/0))))
+ (jcall method (socket usocket))))
+
+(defun wait-for-input-internal (wait-list &key timeout)
+ (let* ((sockets (wait-list-waiters wait-list))
+ (ops (logior $+op-read $+op-accept))
+ (selector (jstatic $@open/Selector/0 $*Selector))
+ (channels (mapcar #'get-socket-channel sockets)))
+ (unwind-protect
+ (with-mapped-conditions ()
+ (dolist (channel channels)
+ (jcall $@configureBlocking/1 channel +java-false+)
+ (jcall $@register/2 channel selector (logand ops (jcall $@validOps/0 channel))))
+ (let ((ready-count (if timeout
+ (jcall $@select/1 selector (truncate (* timeout 1000)))
+ (jcall $@select/0 selector))))
+ (when (plusp ready-count)
+ (let* ((keys (jcall $@selectedKeys/0 selector))
+ (iterator (jcall $@iterator/0 keys))
+ (%wait (wait-list-%wait wait-list)))
+ (loop while (jcall $@hasNext/0 iterator)
+ do (let* ((key (jcall $@next/0 iterator))
+ (channel (jcall $@channel/0 key)))
+ (setf (state (gethash channel %wait)) :read)))))))
+ (jcall $@close/Selector/0 selector)
+ (dolist (channel channels)
+ (jcall $@configureBlocking/1 channel +java-true+)))))
+
+;;; WAIT-LIST
+
+;;; NOTE from original worker (Erik):
+;;; Note that even though Java has the concept of the Selector class, which
+;;; remotely looks like a wait-list, it requires the sockets to be non-blocking.
+;;; usocket however doesn't make any such guarantees and is therefore unable to
+;;; use the concept outside of the waiting routine itself (blergh!).
+
+(defun %setup-wait-list (wl)
+ (setf (wait-list-%wait wl)
+ (make-hash-table :test #'equal :rehash-size 1.3d0)))
+
+(defun %add-waiter (wl w)
+ (setf (gethash (get-socket-channel w) (wait-list-%wait wl)) w))
+
+(defun %remove-waiter (wl w)
+ (remhash (get-socket-channel w) (wait-list-%wait wl)))
Modified: usocket/trunk/package.lisp
==============================================================================
--- usocket/trunk/package.lisp (original)
+++ usocket/trunk/package.lisp Mon Sep 13 11:33:20 2010
@@ -5,10 +5,6 @@
(in-package :usocket-system)
-#+lispworks
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (require "comm"))
-
(defpackage :usocket
(:use :common-lisp)
(:export #:*wildcard-host*
Modified: usocket/trunk/usocket.asd
==============================================================================
--- usocket/trunk/usocket.asd (original)
+++ usocket/trunk/usocket.asd Mon Sep 13 11:33:20 2010
@@ -23,20 +23,19 @@
:components ((:file "split-sequence")
#+mcl (:file "kqueue")
#+openmcl (:file "ccl-send")
- #+armedbear (:file "abcl-jdi")
(:file "spawn-thread")))
(:file "usocket" :depends-on ("vendor"))
(:file "condition" :depends-on ("usocket"))
(:module "backend" :depends-on ("condition")
- :components (#+clisp (:file "clisp")
+ :components (#+abcl (:file "abcl")
+ #+clisp (:file "clisp")
#+cmu (:file "cmucl")
#+scl (:file "scl")
#+(or sbcl ecl) (:file "sbcl")
#+lispworks (:file "lispworks")
#+mcl (:file "mcl")
#+openmcl (:file "openmcl")
- #+allegro (:file "allegro")
- #+armedbear (:file "armedbear")))
+ #+allegro (:file "allegro")))
(:file "server" :depends-on ("backend"))))
(defmethod perform ((op test-op) (c (eql (find-system :usocket))))
Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp (original)
+++ usocket/trunk/usocket.lisp Mon Sep 13 11:33:20 2010
@@ -431,7 +431,8 @@
((or (vector t 4)
(array (unsigned-byte 8) (4)))
(vector-quad-to-dotted-quad host))
- (integer (hbo-to-dotted-quad host))))
+ (integer (hbo-to-dotted-quad host))
+ (null "0.0.0.0")))
(defun ip= (ip1 ip2)
(etypecase ip1
@@ -452,7 +453,7 @@
;; DNS helper functions
;;
-#-(or clisp armedbear)
+#-clisp
(progn
(defun get-host-by-name (name)
(let ((hosts (get-hosts-by-name name)))
More information about the usocket-cvs
mailing list