[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