[usocket-cvs] r556 - in usocket/trunk: . backend

Chun Tian (binghe) ctian at common-lisp.net
Tue Sep 14 08:07:21 UTC 2010 

Author: ctian
Date: Tue Sep 14 04:07:20 2010
New Revision: 556

Log:
ABCL: basically working implementation of SOCKET-SEND/SOCKET-RECEIVE.

Modified:
   usocket/trunk/README
   usocket/trunk/backend/abcl.lisp
   usocket/trunk/package.lisp
   usocket/trunk/usocket.lisp

Modified: usocket/trunk/README
==============================================================================
--- usocket/trunk/README	(original)
+++ usocket/trunk/README	Tue Sep 14 04:07:20 2010
@@ -22,14 +22,14 @@
 
  - SBCL
  - CMUCL
- - ArmedBear (post feb 11th, 2006 CVS or 0.0.10 and higher)
- - clisp
+ - ArmedBear Common Lisp
+ - GNU CLISP
  - Allegro Common Lisp
  - LispWorks
- - OpenMCL
+ - Clozure CL
  - ECL
  - Scieneer Common Lisp
- - <Your favorite Common Lisp here?>
+ - Macintosh Common Lisp
 
 If your favorite common lisp misses in the list above, please contact
 usocket-devel at common-lisp.net and submit a request.  Please include

Modified: usocket/trunk/backend/abcl.lisp
==============================================================================
--- usocket/trunk/backend/abcl.lisp	(original)
+++ usocket/trunk/backend/abcl.lisp	Tue Sep 14 04:07:20 2010
@@ -8,29 +8,15 @@
 
 (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 $*byte (jclass "byte"))
+(defvar $*byte[] (jclass "[B"))
 (defvar $*int (jclass "int"))
 (defvar $*long (jclass "long"))
+(defvar $*|Byte| (jclass "java.lang.Byte"))
 (defvar $*DatagramChannel (jclass "java.nio.channels.DatagramChannel"))
+(defvar $*DatagramPacket (jclass "java.net.DatagramPacket"))
 (defvar $*DatagramSocket (jclass "java.net.DatagramSocket"))
 (defvar $*Inet4Address (jclass "java.net.Inet4Address"))
 (defvar $*InetAddress (jclass "java.net.InetAddress"))
@@ -48,6 +34,9 @@
 (defvar $*String (jclass "java.lang.String"))
 
 ;;; Java Constructor ($%.../n)
+(defvar $%Byte/0 (jconstructor $*|Byte| $*byte))
+(defvar $%DatagramPacket/3 (jconstructor $*DatagramPacket $*byte[] $*int $*int))
+(defvar $%DatagramPacket/5 (jconstructor $*DatagramPacket $*byte[] $*int $*int $*InetAddress $*int))
 (defvar $%DatagramSocket/0 (jconstructor $*DatagramSocket))
 (defvar $%DatagramSocket/1 (jconstructor $*DatagramSocket $*int))
 (defvar $%DatagramSocket/2 (jconstructor $*DatagramSocket $*int $*InetAddress))
@@ -67,6 +56,7 @@
 (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 $@byteValue/0 (jmethod $*|Byte| "byteValue"))
 (defvar $@channel/0 (jmethod $*SelectionKey "channel"))
 (defvar $@close/DatagramSocket/0 (jmethod $*DatagramSocket "close"))
 (defvar $@close/Selector/0 (jmethod $*Selector "close"))
@@ -83,15 +73,19 @@
 (defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel"))
 (defvar $@getChannel/ServerSocket/0 (jmethod $*ServerSocket "getChannel"))
 (defvar $@getChannel/Socket/0 (jmethod $*Socket "getChannel"))
+(defvar $@getAddress/DatagramPacket/0 (jmethod $*DatagramPacket "getAddress"))
 (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 $@getLength/DatagramPacket/0 (jmethod $*DatagramPacket "getLength"))
 (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 $@getOffset/DatagramPacket/0 (jmethod $*DatagramPacket "getOffset"))
+(defvar $@getPort/DatagramPacket/0 (jmethod $*DatagramPacket "getPort"))
 (defvar $@getPort/DatagramSocket/0 (jmethod $*DatagramSocket "getPort"))
 (defvar $@getPort/Socket/0 (jmethod $*Socket "getPort"))
 (defvar $@hasNext/0 (jmethod $*Iterator "hasNext"))
@@ -101,10 +95,12 @@
 (defvar $@open/Selector/0 (jmethod $*Selector "open"))
 (defvar $@open/ServerSocketChannel/0 (jmethod $*ServerSocketChannel "open"))
 (defvar $@open/SocketChannel/0 (jmethod $*SocketChannel "open"))
+(defvar $@receive/1 (jmethod $*DatagramSocket "receive" $*DatagramPacket))
 (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 $@send/1 (jmethod $*DatagramSocket "send" $*DatagramPacket))
 (defvar $@setReuseAddress/1 (jmethod $*ServerSocket "setReuseAddress" $*boolean))
 (defvar $@setSoTimeout/DatagramSocket/1 (jmethod $*DatagramSocket "setSoTimeout" $*int))
 (defvar $@setSoTimeout/Socket/1 (jmethod $*Socket "setSoTimeout" $*int))
@@ -137,6 +133,18 @@
 
 ;;; HANDLE-CONTITION
 
+(defparameter +abcl-error-map+
+  `(("java.net.BindException" . operation-not-permitted-error)
+    ("java.net.ConnectException" . connection-refused-error)
+    ("java.net.NoRouteToHostException" . network-unreachable-error) ; untested
+    ("java.net.PortUnreachableException" . protocol-not-supported-error) ; untested
+    ("java.net.ProtocolException" . protocol-not-supported-error) ; untested
+    ("java.net.SocketException" . socket-type-not-supported-error) ; untested
+    ("java.net.SocketTimeoutException" . timeout-error)))
+
+(defparameter +abcl-nameserver-error-map+
+  `(("java.net.UnknownHostException" . ns-host-not-found-error)))
+
 (defun handle-condition (condition &optional (socket nil))
   (typecase condition
     (java-exception
@@ -153,27 +161,18 @@
 	     (when usock-error
 	       (error usock-error :socket socket))))))))
 
-(defparameter +abcl-error-map+
-  `(("java.net.ConnectException" . connection-refused-error)
-    ("java.net.SocketTimeoutException" . timeout-error)
-    ("java.net.BindException" . operation-not-permitted-error)))
-
-(defparameter +abcl-nameserver-error-map+
-  `(("java.net.UnknownHostException" . ns-host-not-found-error)))
-
 ;;; GET-HOSTS-BY-NAME
 
 (defun get-address (address)
-  (let* ((array (%get-address address))
-	 (length (jarray-length array)))
-    (labels ((jbyte (n)
-	       (let ((byte (jarray-ref array n)))
-		 (if (plusp byte)
-		     byte
-		     (+ 256 byte)))))
-      (if (= 4 length)
-	  (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3))
-	  nil)))) ; not a IPv4 address?!
+  (when address
+    (let* ((array (%get-address address))
+	   (length (jarray-length array)))
+      (labels ((jbyte (n)
+		 (let ((byte (jarray-ref array n)))
+		   (if (minusp byte) (+ 256 byte) byte))))
+	(if (= 4 length)
+	    (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3))
+	    nil))))) ; not a IPv4 address?!
 
 (defun get-hosts-by-name (name)
   (with-mapped-conditions ()
@@ -225,7 +224,7 @@
 	   (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))
+	 (setq usocket (make-datagram-socket socket :connected-p (if (and host port) t nil)))
 	 (when timeout
 	   (jcall $@setSoTimeout/DatagramSocket/1 socket (truncate (* 1000 timeout)))))))
     usocket))
@@ -316,14 +315,54 @@
 
 ;;; SOCKET-SEND & SOCKET-RECEIVE
 
-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
-  (with-mapped-conditions (socket)
-    ))
+(defun *->byte (data)
+  (declare (type (unsigned-byte 8) data)) ; required by SOCKET-SEND
+  (jnew $%Byte/0 (if (> data 127) (- data 256) data)))
+
+(defun byte->* (byte &optional (element-type '(unsigned-byte 8)))
+  (let* ((ub8 (if (minusp byte) (+ 256 byte) byte)))
+    (if (eq element-type 'character)
+	(code-char ub8)
+	ub8)))
+
+(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port)
+  (let* ((socket (socket usocket))
+	 (real-length (or length (length buffer)))
+	 (byte-array (jnew-array $*byte real-length))
+	 (packet (if (and host port)
+		     (jnew $%DatagramPacket/5 byte-array 0 real-length (host-to-inet4 host) port)
+		     (jnew $%DatagramPacket/3 byte-array 0 real-length))))
+    ;; prepare sending data
+    (loop for i from 0 below real-length
+       do (setf (jarray-ref byte-array i) (*->byte (aref buffer i))))
+    (with-mapped-conditions (usocket)
+      (jcall $@send/1 socket packet))
+    real-length))
 
-(defmethod socket-receive ((socket datagram-usocket) buffer length
+;;; TODO: return-host and return-port cannot be get ...
+(defmethod socket-receive ((usocket datagram-usocket) buffer length
 			   &key (element-type '(unsigned-byte 8)))
-  (with-mapped-conditions (socket)
-    ))
+  (let* ((socket (socket usocket))
+	 (real-length (or length +max-datagram-packet-size+))
+	 (byte-array (jnew-array $*byte real-length))
+	 (packet (jnew $%DatagramPacket/3 byte-array 0 real-length)))
+    (with-mapped-conditions (usocket)
+      (jcall $@receive/1 socket packet))
+    (let* ((receive-length (jcall $@getLength/DatagramPacket/0 packet))
+	   (return-buffer (or buffer (make-array receive-length :element-type element-type))))
+      (loop for i from 0 below receive-length
+	 do (setf (aref return-buffer i)
+		  (byte->* (jarray-ref byte-array i) element-type)))
+      (let ((return-host (if (connected-p usocket)
+			     (get-peer-address usocket)
+			     (get-address (jcall $@getAddress/DatagramPacket/0 packet))))
+	    (return-port (if (connected-p usocket)
+			     (get-peer-port usocket)
+			     (jcall $@getPort/DatagramPacket/0 packet))))
+	(values return-buffer
+		receive-length
+		return-host
+		return-port)))))
 
 ;;; WAIT-FOR-INPUT
 

Modified: usocket/trunk/package.lisp
==============================================================================
--- usocket/trunk/package.lisp	(original)
+++ usocket/trunk/package.lisp	Tue Sep 14 04:07:20 2010
@@ -6,7 +6,7 @@
 (in-package :usocket-system)
 
 (defpackage :usocket
-  (:use :common-lisp)
+  (:use :common-lisp #+abcl :java)
   (:export   #:*wildcard-host*
              #:*auto-port*
 

Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp	(original)
+++ usocket/trunk/usocket.lisp	Tue Sep 14 04:07:20 2010
@@ -11,7 +11,7 @@
 (defparameter *auto-port* 0
   "Port number to pass when an auto-assigned port number is wanted.")
 
-(defconstant +max-datagram-packet-size+ 65536)
+(defconstant +max-datagram-packet-size+ 65507)
 
 (defclass usocket ()
   ((socket

More information about the usocket-cvs mailing list