usocket-cvs

usocket-cvs@common-lisp.net

702 discussions

[usocket-cvs] r258 - usocket/trunk
by ehuelsmann＠common-lisp.net 05 Jun '07

05 Jun '07

Author: ehuelsmann Date: Tue Jun 5 11:07:16 2007 New Revision: 258 Modified: usocket/trunk/usocket.lisp Log: Fix crash where resolution leads to 'no data'. Return NIL instead. Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Tue Jun 5 11:07:16 2007 @@ -296,7 +296,8 @@ (defun get-random-host-by-name (name) (let ((hosts (get-hosts-by-name name))) - (elt hosts (random (length hosts))))) + (when hosts + (elt hosts (random (length hosts)))))) (defun host-to-vector-quad (host) "Translate a host specification (vector quad, dotted quad or domain name)

1 0

[usocket-cvs] r257 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 30 May '07

30 May '07

Author: ehuelsmann Date: Wed May 30 17:10:10 2007 New Revision: 257 Modified: usocket/trunk/backend/armedbear.lisp Log: Two changes: 1) Change socket slot to contain a channel instead of a socket. 2) Optimize wait-for-input-internal for comming abcl optimization where (jmethod ...) is considered constant when it has only string arguments. Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Wed May 30 17:10:10 2007 @@ -199,7 +199,7 @@ (describe sock) (setf usock (make-stream-socket - :socket sock + :socket jchan :stream (ext:get-socket-stream (jdi:jop-deref sock) :element-type element-type))))))) @@ -224,16 +224,17 @@ (jdi:jcoerce sock-addr "java.net.SocketAddress") (jdi:jcoerce backlog :int)) - (make-stream-server-socket sock :element-type element-type))) + (make-stream-server-socket chan :element-type element-type))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (let* ((jsock (socket socket)) - (jacc-sock (jdi:do-jmethod-call jsock "accept")) + (jacc-chan (jdi:do-jmethod-call jsock "accept")) (jacc-stream - (ext:get-socket-stream (jdi:jop-deref jacc-sock) + (ext:get-socket-stream (jdi:jop-deref + (jdi:do-jmethod-call jacc-chan "socket")) :element-type (or element-type (element-type socket))))) - (make-stream-socket :socket jacc-sock + (make-stream-socket :socket jacc-chan :stream jacc-stream))) ;;(defun print-java-exception (e) @@ -242,7 +243,7 @@ (defmethod socket-close ((usocket usocket)) (with-mapped-conditions (usocket) - (ext:socket-close (socket usocket)))) + (jdi:do-method (socket usocket) "close"))) ;; Socket streams are different objects than ;; socket streams. Closing the stream flushes @@ -336,58 +337,79 @@ (t "java.nio.channels.DatagramChannel")))) +(defun socket-channel-class (socket) + (cond + ((stream-usocket-p socket) + "java.nio.channels.SocketChannel") + ((stream-server-usocket-p socket) + "java.nio.channels.ServerSocketChannel") + ((datagram-usocket-p socket) + "java.nio.channels.DatagramChannel"))) + (defun wait-for-input-internal (sockets &key timeout) (let* ((ops (logior (op-read) (op-accept))) (selector (jdi:do-jstatic "java.nio.channels.Selector" "open")) - (channels - (mapcar #'(lambda (s) - (jdi:jcoerce (jdi:do-jmethod-call (socket s) "getChannel") - "java.nio.channels.SocketChannel")) - sockets))) + (channels (mapcar #'socket sockets))) (unwind-protect - (with-mapped-conditions () - (let ((jfalse (jdi:jcoerce nil :boolean))) +;; (with-mapped-conditions () + (progn + (let ((jfalse (java:make-immediate-object nil :boolean)) + (sel (jdi:jop-deref selector))) (dolist (channel channels) - (jdi:do-jmethod channel "configureBlocking" jfalse) - (jdi:do-jmethod channel "register" - selector - (jdi:jcoerce (logand ops (valid-ops channel)) - :int)))) - (let ((ready-count - (jdi:do-jmethod selector "select" (jdi:jcoerce - (truncate (* timeout 1000)) - :long)))) - (when (< 0 ready-count) - ;; we actually have work to do - (let* ((selkeys (jdi:do-jmethod selector "selectedKeys")) - (selkey-iterator (jdi:do-jmethod selkeys "iterator")) - ready-sockets) - (loop while (jdi:do-jmethod selkey-iterator "hasNext") - do (let* ((key (jdi:jcoerce - (jdi:do-jmethod selkey-iterator "next") - "java.nio.channels.SelectionKey")) - (chan (jdi:do-jmethod key "channel"))) - (push (jdi:do-jmethod - (jdi:jcoerce chan - (channel-class chan)) - "socket") - ready-sockets))) - (remove-if #'(lambda (s) - (not (member (socket s) ready-sockets - :key #'jdi:jop-deref - :test #'jdi:jequals))) - sockets))))) + (let ((chan (jdi:jop-deref channel))) + (java:jcall (java:jmethod "java.nio.channels.SelectableChannel" + "configureBlocking" + "boolean") + chan jfalse) + (java:jcall (java:jmethod "java.nio.channels.SelectableChannel" + "register" + "java.nio.channels.Selector" "int") + chan sel (logand ops (valid-ops channel))))) + (let ((ready-count + (java:jcall (java:jmethod "java.nio.channels.Selector" + "select" + "long") + sel (truncate (* timeout 1000))))) + (when (< 0 ready-count) + ;; we actually have work to do + (let* ((selkeys (jdi:do-jmethod selector "selectedKeys")) + (selkey-iterator (jdi:do-jmethod selkeys "iterator")) + ready-sockets) + (loop while (java:jcall + (java:jmethod "java.util.Iterator" "hasNext") + (jdi:jop-deref selkey-iterator)) + do (let* ((key (jdi:jcoerce + (jdi:do-jmethod selkey-iterator "next") + "java.nio.channels.SelectionKey")) + (chan (jdi:jop-deref + (jdi:do-jmethod key "channel")))) + (push chan ready-sockets))) + (remove-if #'(lambda (s) + (not (member (jdi:jop-deref (socket s)) + ready-sockets + :test #'(lambda (x y) + (java:jcall (java:jmethod "java.lang.Object" + "equals" + "java.lang.Object") + x y))))) + sockets)))))) ;; cancel all Selector registrations (let* ((keys (jdi:do-jmethod selector "keys")) (iter (jdi:do-jmethod keys "iterator"))) - (loop while (jdi:do-jmethod iter "hasNext") - do (jdi:do-jmethod (jdi:jcoerce (jdi:do-jmethod iter "next") - "java.nio.channels.SelectionKey") - "cancel"))) + (loop while (java:jcall (java:jmethod "java.util.Iterator" "hasNext") + (jdi:jop-deref iter)) + do (java:jcall + (java:jmethod "java.nio.channels.SelectionKey" "cancel") + (java:jcall (java:jmethod "java.util.Iterator" "next") + (jdi:jop-deref iter))))) ;; close the selector - (jdi:do-jmethod selector "close") + (java:jcall (java:jmethod "java.nio.channels.Selector" "close") + (jdi:jop-deref selector)) ;; make all sockets blocking again. - (let ((jtrue (jdi:jcoerce t :boolean))) + (let ((jtrue (java:make-immediate-object t :boolean))) (dolist (chan channels) - (jdi:do-jmethod chan "configureBlocking" jtrue)))))) + (java:jcall (java:jmethod "java.nio.channels.SelectableChannel" + "configureBlocking" + "boolean") + (jdi:jop-deref chan) jtrue))))))

1 0

[usocket-cvs] r256 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 25 May '07

25 May '07

Author: ehuelsmann Date: Fri May 25 18:27:48 2007 New Revision: 256 Modified: usocket/trunk/backend/armedbear.lisp Log: Finish ArmedBear backend implementation by changing socket-connect to java.nio.channels too. At the same time implement a somewhat more readable FFI. (We'll later abstract it out and make it even better by making it require even fewer type casts\!) Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Fri May 25 18:27:48 2007 @@ -6,6 +6,142 @@ (in-package :usocket) +;;;;; Proposed contribution to the JAVA package + +(defpackage :jdi + (:use :cl) + (:export #:jcoerce + #:jop-deref + #:do-jmethod-call + #:do-jmethod + #:do-jstatic-call + #:do-jstatic + #:do-jnew-call + #:do-jfield + #:jequals)) +;; but still requires the :java package. + +(in-package :jdi) + +(defstruct (java-object-proxy (:conc-name :jop-) + :copier) + value + class) + +(defvar *jm-get-return-type* + (java:jmethod "java.lang.reflect.Method" "getReturnType")) + +(defvar *jf-get-type* + (java:jmethod "java.lang.reflect.Field" "getType")) + +(defvar *jc-get-declaring-class* + (java:jmethod "java.lang.reflect.Constructor" "getDeclaringClass")) + +(declaim (inline make-return-type-proxy)) +(defun make-return-type-proxy (jmethod jreturned-value) + (if (java:java-object-p jreturned-value) + (let ((rt (java:jcall *jm-get-return-type* jmethod))) + (make-java-object-proxy :value jreturned-value + :class rt)) + jreturned-value)) + +(defun make-field-type-proxy (jfield jreturned-value) + (if (java:java-object-p jreturned-value) + (let ((rt (java:jcall *jf-get-type* jfield))) + (make-java-object-proxy :value jreturned-value + :class rt)) + jreturned-value)) + +(defun make-constructor-type-proxy (jconstructor jreturned-value) + (if (java:java-object-p jreturned-value) + (let ((rt (java:jcall *jc-get-declaring-class* jconstructor))) + (make-java-object-proxy :value jreturned-value + :class rt)) + jreturned-value)) + +(defun jcoerce (instance &optional output-type-spec) + (cond + ((java-object-proxy-p instance) + (let ((new-instance (copy-structure (the java-object-proxy instance)))) + (setf (jop-class new-instance) + (java:jclass output-type-spec)) + new-instance)) + ((java:java-object-p instance) + (make-java-object-proxy :class (java:jclass output-type-spec) + :value instance)) + ((stringp instance) + (make-java-object-proxy :class "java.lang.String" + :value instance)) + ((keywordp output-type-spec) + ;; all that remains is creating an immediate type... + (let ((jval (java:make-immediate-object instance output-type-spec))) + (make-java-object-proxy :class output-type-spec + :value jval))) + )) + +(defun jtype-of (instance) ;;instance must be a jop + (cond + ((stringp instance) + "java.lang.String") + ((keywordp (jop-class instance)) + (string-downcase (symbol-name (jop-class instance)))) + (t + (java:jclass-name (jop-class instance))))) + +(defun jop-deref (instance) + (if (java-object-proxy-p instance) + (jop-value instance) + instance)) + +(defun java-value-and-class (object) + (values (jop-deref object) + (jtype-of object))) + +(defun do-jmethod-call (object method-name &rest arguments) + (multiple-value-bind + (instance class-name) + (java-value-and-class object) + (let* ((argument-types (mapcar #'jtype-of arguments)) + (jm (apply #'java:jmethod class-name method-name argument-types)) + (rv (apply #'java:jcall jm instance + (mapcar #'jop-deref arguments)))) + (make-return-type-proxy jm rv)))) + +(defun do-jstatic-call (class-name method-name &rest arguments) + (let* ((argument-types (mapcar #'jtype-of arguments)) + (jm (apply #'java:jmethod class-name method-name argument-types)) + (rv (apply #'java:jstatic jm (java:jclass class-name) + (mapcar #'jop-deref arguments)))) + (make-return-type-proxy jm rv))) + +(defun do-jnew-call (class-name &rest arguments) + (let* ((argument-types (mapcar #'jtype-of arguments)) + (jm (apply #'java:jconstructor class-name argument-types)) + (rv (apply #'java:jnew jm (mapcar #'jop-deref arguments)))) + (make-constructor-type-proxy jm rv))) + +(defun do-jfield (class-or-instance-or-name field-name) + (let* ((class (cond + ((stringp class-or-instance-or-name) + (java:jclass class-or-instance-or-name)) + ((java:java-object-p class-or-instance-or-name) + (java:jclass-of class-or-instance-or-name)) + ((java-object-proxy-p class-or-instance-or-name) + (java:jclass (jtype-of class-or-instance-or-name))))) + (jf (java:jcall (java:jmethod "java.lang.Class" "getField" + "java.lang.String") + class field-name))) + (make-field-type-proxy jf + (java:jfield class field-name)))) ;;class)))) + +(defmacro do-jstatic (&rest arguments) + `(do-jstatic-call ,@arguments)) + +(defmacro do-jmethod (&rest arguments) + `(do-jmethod-call ,@arguments)) + +;; + (defmacro jstatic-call (class-name (method-name &rest arg-spec) &rest args) (let ((class-sym (gensym))) @@ -29,21 +165,21 @@ ,isym ,@args))))) (defun jequals (x y) - (jmethod-call (x "java.lang.Object") - ("equals" "java.lang.Object") - y)) + (do-jmethod-call (jcoerce x "java.lang.Object") "equals" + (jcoerce y "java.lang.Object"))) (defmacro jnew-call ((class &rest arg-spec) &rest args) `(java:jnew (java:jconstructor ,class ,@arg-spec) ,@args)) + + +(in-package :usocket) + (defun get-host-name () - (let ((localAddress (java:jstatic - (java:jmethod "java.net.InetAddress" - "getLocalHost") - (java:jclass "java.net.InetAddress")))) - (java:jcall (java:jmethod "java.net.InetAddress" "getHostName") - localAddress))) + (jdi:do-jmethod-call (jdi:do-jstatic-call "java.net.InetAddress" + "getLocalHost") + "getHostName")) (defun handle-condition (condition &optional socket) (typecase condition @@ -52,11 +188,19 @@ (defun socket-connect (host port &key (element-type 'character)) (let ((usock)) (with-mapped-conditions (usock) - (let ((sock (ext:make-socket (host-to-hostname host) port))) + (let* ((sock-addr (jdi:jcoerce + (jdi:do-jnew-call "java.net.InetSocketAddress" + (host-to-hostname host) + (jdi:jcoerce port :int)) + "java.net.SocketAddress")) + (jchan (jdi:do-jstatic-call "java.nio.channels.SocketChannel" + "open" sock-addr)) + (sock (jdi:do-jmethod-call jchan "socket"))) + (describe sock) (setf usock (make-stream-socket :socket sock - :stream (ext:get-socket-stream sock + :stream (ext:get-socket-stream (jdi:jop-deref sock) :element-type element-type))))))) (defun socket-listen (host port @@ -65,27 +209,28 @@ (backlog 5) (element-type 'character)) (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress)) - (sock-addr (jnew-call ("java.net.InetSocketAddress" - "java.lang.String" "int") - (host-to-hostname host) port)) - (chan (jstatic-call "java.nio.channels.ServerSocketChannel" ("open"))) - (sock (java:jcall - (java:jmethod "java.nio.channels.ServerSocketChannel" - "socket") chan))) + (sock-addr (jdi:do-jnew-call "java.net.InetSocketAddress" + (host-to-hostname host) + (jdi:jcoerce port :int))) + (chan (jdi:do-jstatic-call "java.nio.channels.ServerSocketChannel" + "open")) + (sock (jdi:do-jmethod-call chan "socket"))) (when reuseaddress - (jmethod-call sock - ("setReuseAddress" "boolean") - (java:make-immediate-object reuseaddress :boolean))) - (jmethod-call sock - ("bind" "java.net.SocketAddress" "int") - sock-addr backlog) + (jdi:do-jmethod-call sock + "setReuseAddress" + (jdi:jcoerce reuseaddress :boolean))) + (jdi:do-jmethod-call sock + "bind" + (jdi:jcoerce sock-addr + "java.net.SocketAddress") + (jdi:jcoerce backlog :int)) (make-stream-server-socket sock :element-type element-type))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (let* ((jsock (socket socket)) - (jacc-sock (jmethod-call jsock ("accept"))) + (jacc-sock (jdi:do-jmethod-call jsock "accept")) (jacc-stream - (ext:get-socket-stream jacc-sock + (ext:get-socket-stream (jdi:jop-deref jacc-sock) :element-type (or element-type (element-type socket))))) (make-stream-socket :socket jacc-sock @@ -167,59 +312,20 @@ |# -(defun jsocket-channel (jsocket) - (jmethod-call jsocket ("getChannel"))) - -(defun jselkey-channel (jselectionkey) - (jmethod-call (jselectionkey "java.nio.channels.SelectionKey") - ("channel"))) - (defun op-read () - (java:jfield (java:jclass "java.nio.channels.SelectionKey") - "OP_READ")) + (jdi:do-jfield "java.nio.channels.SelectionKey" + "OP_READ")) (defun op-accept () - (java:jfield (java:jclass "java.nio.channels.SelectionKey") - "OP_ACCEPT")) + (jdi:do-jfield "java.nio.channels.SelectionKey" + "OP_ACCEPT")) (defun op-connect () - (java:jfield (java:jclass "java.nio.channels.SelectionKey") - "OP_CONNECT")) + (jdi:do-jfield "java.nio.channels.SelectionKey" + "OP_CONNECT")) (defun valid-ops (jchannel) - (jmethod-call (jchannel "java.nio.channels.SelectableChannel") - ("validOps"))) - -(defun register (jchannel jselector ops) - (jmethod-call (jchannel "java.nio.channels.SelectableChannel") - ("register" "java.nio.channels.Selector" "int") - jselector ops)) - -(defun toggle-blocking (jchannel mode) - (jmethod-call (jchannel "java.nio.channels.SelectableChannel") - ("configureBlocking" "boolean") - mode)) - -(defun jselector-select (jselector timeout) - (let ((to (truncate (* (or timeout 0) 1000)))) - (if (/= timeout 0) - (jmethod-call (jselector "java.nio.channels.Selector") - ("select" "long") to) - (jmethod-call (jselector "java.nio.channels.Selector") - ("selectNow"))))) - -(defun jselector-selected-keys (jselector) - (jmethod-call (jselector "java.nio.channels.Selector") - ("selectedKeys"))) - -(defun jset-iterator (jset) - (jmethod-call (jset "java.util.Set") ("iterator"))) - -(defun jiterator-has-next (jiterator) - (jmethod-call (jiterator "java.util.Iterator") ("hasNext"))) - -(defun jiterator-next (jiterator) - (jmethod-call (jiterator "java.util.Iterator") ("next"))) + (jdi:do-jmethod-call jchannel "validOps")) (defun channel-class (jchannel) (let ((valid-ops (valid-ops jchannel))) @@ -232,46 +338,56 @@ (defun wait-for-input-internal (sockets &key timeout) (let* ((ops (logior (op-read) (op-accept))) - (selector (jstatic-call "java.nio.channels.Selector" ("open"))) + (selector (jdi:do-jstatic "java.nio.channels.Selector" "open")) (channels (mapcar #'(lambda (s) - (jsocket-channel (socket s))) + (jdi:jcoerce (jdi:do-jmethod-call (socket s) "getChannel") + "java.nio.channels.SocketChannel")) sockets))) (unwind-protect - (progn - (let ((jfalse (java:make-immediate-object nil :boolean))) + (with-mapped-conditions () + (let ((jfalse (jdi:jcoerce nil :boolean))) (dolist (channel channels) - (toggle-blocking channel jfalse) - (register channel selector (logand ops (valid-ops channel))))) + (jdi:do-jmethod channel "configureBlocking" jfalse) + (jdi:do-jmethod channel "register" + selector + (jdi:jcoerce (logand ops (valid-ops channel)) + :int)))) (let ((ready-count - (jselector-select selector timeout))) + (jdi:do-jmethod selector "select" (jdi:jcoerce + (truncate (* timeout 1000)) + :long)))) (when (< 0 ready-count) ;; we actually have work to do - (let* ((selkeys (jselector-selected-keys selector)) - (selkey-iterator (jset-iterator selkeys)) + (let* ((selkeys (jdi:do-jmethod selector "selectedKeys")) + (selkey-iterator (jdi:do-jmethod selkeys "iterator")) ready-sockets) - (loop while (jiterator-has-next selkey-iterator) - do (let* ((key (jiterator-next selkey-iterator)) - (chan (jselkey-channel key))) - (push (jmethod-call (chan (channel-class chan)) - ("socket")) + (loop while (jdi:do-jmethod selkey-iterator "hasNext") + do (let* ((key (jdi:jcoerce + (jdi:do-jmethod selkey-iterator "next") + "java.nio.channels.SelectionKey")) + (chan (jdi:do-jmethod key "channel"))) + (push (jdi:do-jmethod + (jdi:jcoerce chan + (channel-class chan)) + "socket") ready-sockets))) - (print ready-sockets) - (print (remove-if #'(lambda (s) - (not (member (socket s) ready-sockets - :test #'jequals))) - sockets)))))) + (remove-if #'(lambda (s) + (not (member (socket s) ready-sockets + :key #'jdi:jop-deref + :test #'jdi:jequals))) + sockets))))) ;; cancel all Selector registrations - (let* ((keys (jmethod-call (selector "java.nio.channels.Selector") - ("keys"))) - (iter (jset-iterator keys))) - (loop while (jiterator-has-next iter) - do (jmethod-call ((jiterator-next iter) - "java.nio.channels.SelectionKey") - ("cancel")))) - ;; close the selectorx - (jmethod-call (selector "java.nio.channels.Selector") ("close")) + (let* ((keys (jdi:do-jmethod selector "keys")) + (iter (jdi:do-jmethod keys "iterator"))) + (loop while (jdi:do-jmethod iter "hasNext") + do (jdi:do-jmethod (jdi:jcoerce (jdi:do-jmethod iter "next") + "java.nio.channels.SelectionKey") + "cancel"))) + ;; close the selector + (jdi:do-jmethod selector "close") ;; make all sockets blocking again. - (let ((jtrue (java:make-immediate-object t :boolean))) + (let ((jtrue (jdi:jcoerce t :boolean))) (dolist (chan channels) - (toggle-blocking chan jtrue)))))) + (jdi:do-jmethod chan "configureBlocking" jtrue)))))) +

1 0

[usocket-cvs] r255 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 22 May '07

22 May '07

Author: ehuelsmann Date: Tue May 22 17:51:25 2007 New Revision: 255 Modified: usocket/trunk/backend/clisp.lisp Log: Small but important changes to clisp backend as a result of more heavy testing. Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Tue May 22 17:51:25 2007 @@ -129,8 +129,7 @@ (multiple-value-bind (secs musecs) (split-timeout (or timeout 1)) - (let* ((musecs (truncate (* 1000000 sec-frac) 1)) - (request-list (mapcar #'(lambda (x) + (let* ((request-list (mapcar #'(lambda (x) (if (stream-server-usocket-p x) (socket x) (list (socket x) :input)))

1 0

[usocket-cvs] r254 - public_html
by ehuelsmann＠common-lisp.net 22 May '07

22 May '07

Author: ehuelsmann Date: Tue May 22 17:38:08 2007 New Revision: 254 Modified: public_html/index.shtml Log: Resize the table font and add some references. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Tue May 22 17:38:08 2007 @@ -105,7 +105,7 @@ current state of development. </p> -<table rules="all" border="1" cellpadding="3"> +<table rules="all" border="1" cellpadding="3" style="font-size:small"> <caption style="font-weight:bold;font-size:large">Status for the currently targeted backends</caption> <thead class="roadmap-head"> <tr> @@ -273,7 +273,8 @@ <tr> <td rowspan="2">Implement efficient waiting for multiple sockets in one function call (select() like behaviour).</td> - <td>Investigate interfaces provided</td> + <td><a href="http://trac.common-lisp.net/usocket/wiki/SocketSelect"> + Investigate interfaces provided</a></td> <td class="WIP" title="missing on Win32">WIP</td> <td class="DONE">DONE</td> @@ -325,9 +326,9 @@ <td class="TODO">TODO</td> </tr> <tr> - <td>Implement udp socket support.</td> - <td>Investigate API's provided and build on top of that - (or custom ffi).</td> + <td rowspan="2">Implement udp socket support.</td> + <td><a href="http://trac.common-lisp.net/usocket/wiki/DatagramSockets"> + Investigate API's provided</a></td> <td class="WIP">WIP</td> <td class="WIP">WIP</td> <td class="WIP">WIP</td> @@ -338,6 +339,18 @@ <td class="WIP">WIP</td> <td class="WIP">WIP</td> </tr> + <tr> + <td>Build on top of that (or custom ffi).</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + <td class="TODO">TODO</td> + </tr> </tbody> </table> </div>

1 0

[usocket-cvs] r253 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 22 May '07

22 May '07

Author: ehuelsmann Date: Tue May 22 17:35:58 2007 New Revision: 253 Modified: usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp Log: Small but important changes to various backends as a result of more heavy testing. Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Tue May 22 17:35:58 2007 @@ -165,6 +165,7 @@ (defun wait-for-input-internal (sockets &key timeout) (alien:with-alien ((rfds (alien:struct unix:fd-set))) + (unix:fd-zero rfds) (dolist (socket sockets) (unix:fd-set (socket socket) rfds)) (multiple-value-bind @@ -176,12 +177,11 @@ :key #'socket)) (alien:addr rfds) nil nil (when timeout secs) musecs) - (if (= 0 err) + (if (<= 0 count) ;; process the result... - (unless (= 0 count) - (remove-if #'(lambda (x) - (not (unix:fd-isset (socket x) rfds))) - sockets)) + (remove-if #'(lambda (x) + (not (unix:fd-isset (socket x) rfds))) + sockets) (progn ;;###FIXME generate an error, except for EINTR )))))) Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue May 22 17:35:58 2007 @@ -39,18 +39,15 @@ (defun input-available-p (sockets &optional ticks-to-wait) (ccl::rletZ ((tv :timeval)) (ccl::ticks-to-timeval ticks-to-wait tv) - (ccl::%stack-block ((infds ccl::*fd-set-size*) - (errfds ccl::*fd-set-size*)) + (ccl::%stack-block ((infds ccl::*fd-set-size*)) (ccl::fd-zero infds) - (ccl::fd-zero errfds) (let ((max-fd -1)) (dolist (sock sockets) (let ((fd (openmcl-socket:socket-os-fd sock))) (setf max-fd (max max-fd fd)) - (ccl::fd-set fd infds) - (ccl::fd-set fd errfds))) + (ccl::fd-set fd infds))) (let* ((res (ccl::syscall syscalls::select (1+ max-fd) - infds (ccl::%null-ptr) errfds + infds (ccl::%null-ptr) (ccl::%null-ptr) (if ticks-to-wait tv (ccl::%null-ptr))))) (when (> res 0) (remove-if #'(lambda (x) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Tue May 22 17:35:58 2007 @@ -255,6 +255,7 @@ #-win32 (defun wait-for-input-internal (sockets &key timeout) (sb-alien:with-alien ((rfds (sb-alien:struct sb-unix:fd-set))) + (sb-unix:fd-zero rfds) (dolist (socket sockets) (sb-unix:fd-set (sb-bsd-sockets:socket-file-descriptor (socket socket)) rfds)) @@ -268,18 +269,19 @@ :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) - (if (= 0 err) + (if (<= 0 count) ;; process the result... - (unless (= 0 count) - (remove-if - #'(lambda (x) - (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds))) - sockets)) + (remove-if + #'(lambda (x) + (not (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor (socket x)) + rfds))) + sockets) (progn + (unless (= err sb-unix:EINTR) + (error (map-errno-error err)))) ;;###FIXME generate an error, except for EINTR - )))))) + ))))) #+win32 (warn "wait-for-input not (yet!) supported...")

1 0

[usocket-cvs] r252 - public_html
by ehuelsmann＠common-lisp.net 21 May '07

21 May '07

Author: ehuelsmann Date: Mon May 21 17:54:28 2007 New Revision: 252 Modified: public_html/index.shtml Log: Update website with progress. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Mon May 21 17:54:28 2007 @@ -275,15 +275,15 @@ in one function call (select() like behaviour).</td> <td>Investigate interfaces provided</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> - <td class="WIP">WIP</td> + <td class="WIP" title="missing on Win32">WIP</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="WIP" title="missing on Win32">WIP</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="TODO">TODO</td> </tr> <tr> <td>Implement wait-for-input api.</td>

1 0

[usocket-cvs] r251 - public_html
by ehuelsmann＠common-lisp.net 21 May '07

21 May '07

Author: ehuelsmann Date: Mon May 21 17:52:47 2007 New Revision: 251 Modified: public_html/index.shtml Log: Update website with progress. Modified: public_html/index.shtml ============================================================================== --- public_html/index.shtml (original) +++ public_html/index.shtml Mon May 21 17:52:47 2007 @@ -287,14 +287,14 @@ </tr> <tr> <td>Implement wait-for-input api.</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> - <td class="TODO">TODO</td> + <td class="WIP" title="missing on Win32">WIP</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> + <td class="WIP" title="missing on Win32">WIP</td> + <td class="DONE">DONE</td> + <td class="DONE">DONE</td> <td class="TODO">TODO</td> </tr> <tr>

1 0

[usocket-cvs] r250 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 21 May '07

21 May '07

Author: ehuelsmann Date: Mon May 21 16:29:05 2007 New Revision: 250 Modified: usocket/trunk/backend/armedbear.lisp Log: ABCL 'wait-for-input'. Victory\! Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon May 21 16:29:05 2007 @@ -6,12 +6,32 @@ (in-package :usocket) -(defmacro jmethod-call (instance (method &rest arg-spec) &rest args) +(defmacro jstatic-call (class-name (method-name &rest arg-spec) + &rest args) + (let ((class-sym (gensym))) + `(let ((,class-sym ,class-name)) + (java:jstatic + (java:jmethod ,class-sym ,method-name ,@arg-spec) + (java:jclass ,class-sym) ,@args)))) + +(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args) (let ((isym (gensym))) - `(let* ((,isym ,instance) - (class-name (java:jclass-name (java:jclass-of ,isym)))) - (java:jcall (java:jmethod class-name ,method ,@arg-spec) - ,isym ,@args)))) + (multiple-value-bind + (instance class-name) + (if (listp instance-and-class) + (values (first instance-and-class) + (second instance-and-class)) + (values instance-and-class)) + (when (null class-name) + (setf class-name `(java:jclass-name (java:jclass-of ,isym)))) + `(let* ((,isym ,instance)) + (java:jcall (java:jmethod ,class-name ,method ,@arg-spec) + ,isym ,@args))))) + +(defun jequals (x y) + (jmethod-call (x "java.lang.Object") + ("equals" "java.lang.Object") + y)) (defmacro jnew-call ((class &rest arg-spec) &rest args) `(java:jnew (java:jconstructor ,class ,@arg-spec) @@ -48,7 +68,10 @@ (sock-addr (jnew-call ("java.net.InetSocketAddress" "java.lang.String" "int") (host-to-hostname host) port)) - (sock (jnew-call ("java.net.ServerSocket")))) + (chan (jstatic-call "java.nio.channels.ServerSocketChannel" ("open"))) + (sock (java:jcall + (java:jmethod "java.nio.channels.ServerSocketChannel" + "socket") chan))) (when reuseaddress (jmethod-call sock ("setReuseAddress" "boolean") @@ -102,3 +125,153 @@ (defmethod get-peer-name ((usocket stream-usocket)) (values (get-peer-address usocket) (get-peer-port usocket))) + + +#| +Pseudo code version of what we're trying to do: + +We're being called with 2 args: + + - sockets (list) + - timeout (non-negative real) + +Selector := java.nio.channels.Selector.open() + +For all usockets + get the java socket + get its channel + register the channel with the selector + with ops (operations) OP_READ and OP_ACCEPT + +make the selector wait trunc(timeout*1000) miliseconds, + unless (null timeout), because then: + selectNow() + +retrieve the selectedKeys() set from the selector + unless select() returned 0 selected keys. + +for set-iterator.hasNextKey() + with that key + retrieve the channel + retrieve the channel's socket + add the retrieved socket to the list of ready sockets + +for all usockets + check if the associated java object + is in the list of ready sockets + it is? add it to the function result list + +close() the selector + +return the function result list. + +|# + +(defun jsocket-channel (jsocket) + (jmethod-call jsocket ("getChannel"))) + +(defun jselkey-channel (jselectionkey) + (jmethod-call (jselectionkey "java.nio.channels.SelectionKey") + ("channel"))) + +(defun op-read () + (java:jfield (java:jclass "java.nio.channels.SelectionKey") + "OP_READ")) + +(defun op-accept () + (java:jfield (java:jclass "java.nio.channels.SelectionKey") + "OP_ACCEPT")) + +(defun op-connect () + (java:jfield (java:jclass "java.nio.channels.SelectionKey") + "OP_CONNECT")) + +(defun valid-ops (jchannel) + (jmethod-call (jchannel "java.nio.channels.SelectableChannel") + ("validOps"))) + +(defun register (jchannel jselector ops) + (jmethod-call (jchannel "java.nio.channels.SelectableChannel") + ("register" "java.nio.channels.Selector" "int") + jselector ops)) + +(defun toggle-blocking (jchannel mode) + (jmethod-call (jchannel "java.nio.channels.SelectableChannel") + ("configureBlocking" "boolean") + mode)) + +(defun jselector-select (jselector timeout) + (let ((to (truncate (* (or timeout 0) 1000)))) + (if (/= timeout 0) + (jmethod-call (jselector "java.nio.channels.Selector") + ("select" "long") to) + (jmethod-call (jselector "java.nio.channels.Selector") + ("selectNow"))))) + +(defun jselector-selected-keys (jselector) + (jmethod-call (jselector "java.nio.channels.Selector") + ("selectedKeys"))) + +(defun jset-iterator (jset) + (jmethod-call (jset "java.util.Set") ("iterator"))) + +(defun jiterator-has-next (jiterator) + (jmethod-call (jiterator "java.util.Iterator") ("hasNext"))) + +(defun jiterator-next (jiterator) + (jmethod-call (jiterator "java.util.Iterator") ("next"))) + +(defun channel-class (jchannel) + (let ((valid-ops (valid-ops jchannel))) + (cond ((/= 0 (logand valid-ops (op-connect))) + "java.nio.channels.SocketChannel") + ((/= 0 (logand valid-ops (op-accept))) + "java.nio.channels.ServerSocketChannel") + (t + "java.nio.channels.DatagramChannel")))) + +(defun wait-for-input-internal (sockets &key timeout) + (let* ((ops (logior (op-read) (op-accept))) + (selector (jstatic-call "java.nio.channels.Selector" ("open"))) + (channels + (mapcar #'(lambda (s) + (jsocket-channel (socket s))) + sockets))) + (unwind-protect + (progn + (let ((jfalse (java:make-immediate-object nil :boolean))) + (dolist (channel channels) + (toggle-blocking channel jfalse) + (register channel selector (logand ops (valid-ops channel))))) + (let ((ready-count + (jselector-select selector timeout))) + (when (< 0 ready-count) + ;; we actually have work to do + (let* ((selkeys (jselector-selected-keys selector)) + (selkey-iterator (jset-iterator selkeys)) + ready-sockets) + (loop while (jiterator-has-next selkey-iterator) + do (let* ((key (jiterator-next selkey-iterator)) + (chan (jselkey-channel key))) + (push (jmethod-call (chan (channel-class chan)) + ("socket")) + ready-sockets))) + (print ready-sockets) + (print (remove-if #'(lambda (s) + (not (member (socket s) ready-sockets + :test #'jequals))) + sockets)))))) + ;; cancel all Selector registrations + (let* ((keys (jmethod-call (selector "java.nio.channels.Selector") + ("keys"))) + (iter (jset-iterator keys))) + (loop while (jiterator-has-next iter) + do (jmethod-call ((jiterator-next iter) + "java.nio.channels.SelectionKey") + ("cancel")))) + ;; close the selectorx + (jmethod-call (selector "java.nio.channels.Selector") ("close")) + ;; make all sockets blocking again. + (let ((jtrue (java:make-immediate-object t :boolean))) + (dolist (chan channels) + (toggle-blocking chan jtrue))))))

1 0

[usocket-cvs] r249 - usocket/trunk
by ehuelsmann＠common-lisp.net 20 May '07

20 May '07

Author: ehuelsmann Date: Sun May 20 10:16:12 2007 New Revision: 249 Modified: usocket/trunk/README Log: Update README. Modified: usocket/trunk/README ============================================================================== --- usocket/trunk/README (original) +++ usocket/trunk/README Sun May 20 10:16:12 2007 @@ -123,6 +123,8 @@ - interrupted-condition - unkown-condition +(for a description of the API methods and functions see + http://common-lisp.net/project/usocket/api-docs.shtml.) Test suite ========== @@ -146,11 +148,6 @@ meaning there's no way to tell different error conditions apart. All errors are mapped to unknown-error on CMUCL. -- When running the test suite through the run-usocket-tests.sh shell - script, ArmedBear 0.0.9 will report failure - even when it didn't. - You need a CVS version later than 2006-02-11, or later than 0.0.9 - release version for the script to work correctly. - - The ArmedBear backend doesn't do any error mapping (yet). Java defines exceptions at the wrong level (IMO), since the exception reported bares a relation to the function failing, not the actual @@ -160,3 +157,21 @@ map 'BindException' to a meaningfull error in usocket. [This does not mean the backend should not at least map to 'unknown-error'!] +- When using the library with ECL, you need the C compiler installed + to be able to compile and load the Foreign Function Interface. + Not all ECL targets support DFFI yet, so on some targets this would + be the case anyway. By depending on this technique, usocket can + reuse the FFI code on all platforms (including Windows). This benefit + currently outweighs the additional requirement. (hey, it's *Embeddable* + Common Lisp, so, you probably wanted to embed it all along, right?) + +- LispWorks has a bug(?) in wait-for-input-streams which make it + unsuited for waiting for input on stream socket servers, making it + necessary to resort to different means. With the absence of notice-fd + on Windows, that currenty leaves Windows unsupported. + +- SBCL can't use select() on Windows because it would mean porting + the FD_* macros and the select structures which I'm not sure + is the right way yet (if I need to write custom Win32 code anyway...) + The alternative is to use WSAEventSelect() and friends (which don't + have a limited number of sockets).

1 0

← Newer
1
...
42
43
44
45
46
47
48
...
71
Older →

Jump to page:

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-cvs