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@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 ,@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)))
- `(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)))
- (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)
- (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 () (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 ,@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)))
- `(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)))
- (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)
- (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))
usocket-cvs mailing list usocket-cvs@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs