usocket-devel August 2010

usocket-devel@common-lisp.net

1 discussions

Re: [usocket-devel] [usocket-cvs] r553 - in usocket/trunk: . backend vendor
by Erik Huelsmann 15 Sep '10

15 Sep '10

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(a)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(a)common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/usocket-cvs >

2 3

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

usocket-devel August 2010