[usocket-devel] [usocket-cvs] r553 - in usocket/trunk: . backend vendor
Erik Huelsmann
ehuels at gmail.com
Tue Jul 20 10:49:04 UTC 2010
Hi Chun,
I think the JDI stuff I added way back when, isn't needed anymore. You
could try removing it. Before, it wasn't always possible to
dynamically determine retrieve a method from a JavaObject. Now, since
it has an IntendedClass slot, the information that JDI was trying to
capture, has been added to the base JavaObject class.
If you want, I can help to phase out JDI.
With kind regards,
Erik.
On Tue, Jul 20, 2010 at 7:48 AM, Chun Tian <ctian at common-lisp.net> wrote:
> Author: ctian
> Date: Tue Jul 20 01:48:39 2010
> New Revision: 553
>
> Log:
> ABCL: move JDI into vendor directory.
>
> Added:
> usocket/trunk/vendor/abcl-jdi.lisp (contents, props changed)
> Modified:
> usocket/trunk/backend/armedbear.lisp
> usocket/trunk/usocket.asd
>
> Modified: usocket/trunk/backend/armedbear.lisp
> ==============================================================================
> --- usocket/trunk/backend/armedbear.lisp (original)
> +++ usocket/trunk/backend/armedbear.lisp Tue Jul 20 01:48:39 2010
> @@ -5,178 +5,6 @@
>
> (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)))))
> -
> -(declaim (inline jop-deref))
> -(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 , at arguments))
> -
> -(defmacro do-jmethod (&rest arguments)
> - `(do-jmethod-call , at arguments))
> -
> -;;
> -
> -(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 , at arg-spec)
> - (java:jclass ,class-sym) , at args))))
> -
> -(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args)
> - (let ((isym (gensym)))
> - (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 , at arg-spec)
> - ,isym , at args)))))
> -
> -(defun jequals (x 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 , at arg-spec)
> - , at args))
> -
> -
> -
> -(in-package :usocket)
> -
> (defun get-host-name ()
> (jdi:do-jmethod-call (jdi:do-jstatic-call "java.net.InetAddress"
> "getLocalHost")
>
> Modified: usocket/trunk/usocket.asd
> ==============================================================================
> --- usocket/trunk/usocket.asd (original)
> +++ usocket/trunk/usocket.asd Tue Jul 20 01:48:39 2010
> @@ -23,6 +23,7 @@
> :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"))
>
> Added: usocket/trunk/vendor/abcl-jdi.lisp
> ==============================================================================
> --- (empty file)
> +++ usocket/trunk/vendor/abcl-jdi.lisp Tue Jul 20 01:48:39 2010
> @@ -0,0 +1,170 @@
> +;;;; $Id$
> +;;;; $URL$
> +
> +;;;; Proposed contribution to the JAVA package, by Erik Huelsmann
> +
> +(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)))))
> +
> +(declaim (inline jop-deref))
> +(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 , at arguments))
> +
> +(defmacro do-jmethod (&rest arguments)
> + `(do-jmethod-call , at arguments))
> +
> +;;
> +
> +(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 , at arg-spec)
> + (java:jclass ,class-sym) , at args))))
> +
> +(defmacro jmethod-call (instance-and-class (method &rest arg-spec) &rest args)
> + (let ((isym (gensym)))
> + (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 , at arg-spec)
> + ,isym , at args)))))
> +
> +(defun jequals (x 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 , at arg-spec)
> + , at args))
>
> _______________________________________________
> usocket-cvs mailing list
> usocket-cvs at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs
>
More information about the usocket-devel
mailing list