Changeset 12715


Ignore:
Timestamp:
05/21/10 22:54:55 (12 years ago)
Author:
astalla
Message:

Support for custom defclass options for user-defined metaclasses.
Introduced variable java:*classloader* which holds the classloader used by jclass and friends,
and primitives to create new classloaders and (untested) add new URLs to the classloader at runtime.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/Autoload.java

    r12583 r12715  
    514514        autoload(PACKAGE_JAVA, "%jregister-handler", "JHandler");
    515515        autoload(PACKAGE_JAVA, "%load-java-class-from-byte-array", "RuntimeClass");
     516        autoload(PACKAGE_JAVA, "get-default-classloader", "JavaClassLoader");
    516517        autoload(PACKAGE_MOP, "funcallable-instance-function", "StandardGenericFunction", false);
    517518        autoload(PACKAGE_MOP, "generic-function-name", "StandardGenericFunction", true);
  • trunk/abcl/src/org/armedbear/lisp/Java.java

    r12663 r12715  
    6060    }
    6161
     62    private static final Primitive ENSURE_JAVA_OBJECT = new pf_ensure_java_object();
     63    private static final class pf_ensure_java_object extends Primitive
     64    {
     65        pf_ensure_java_object()
     66        {
     67            super("ensure-java-object", PACKAGE_JAVA, true, "obj");
     68        }
     69
     70        @Override
     71        public LispObject execute(LispObject obj) {
     72      return obj instanceof JavaObject ? obj : new JavaObject(obj);
     73        }
     74    };
     75
    6276    // ### register-java-exception exception-name condition-symbol => T
    6377    private static final Primitive REGISTER_JAVA_EXCEPTION = new pf_register_java_exception();
     
    120134    private static final class pf_jclass extends Primitive
    121135    {
     136
    122137        pf_jclass()
    123138        {
     
    129144        public LispObject execute(LispObject arg)
    130145        {
    131             return JavaObject.getInstance(javaClass(arg));
     146      return JavaObject.getInstance(javaClass(arg, JavaClassLoader.getCurrentClassLoader()));
    132147        }
    133148
     
    136151        {
    137152      ClassLoader loader = (ClassLoader) classLoader.javaInstance(ClassLoader.class);
    138       if(loader != null) {
    139     return JavaObject.getInstance(javaClass(className, loader));
    140       } else {
    141     return JavaObject.getInstance(javaClass(className));
    142       }
     153      return JavaObject.getInstance(javaClass(className, loader));
    143154        }
    144155    };
     
    11771188
    11781189    private static Class javaClass(LispObject obj) {
    1179   return javaClass(obj, null);
     1190  return javaClass(obj, JavaClassLoader.getCurrentClassLoader());
    11801191    }
    11811192
     
    12031214            // Not a primitive Java type.
    12041215            Class c;
    1205       if(classLoader != null) {
    1206     c = classForName(s, classLoader);
    1207       } else {
    1208     c = classForName(s);
    1209       }
     1216      c = classForName(s, classLoader);
    12101217            if (c == null)
    12111218                error(new LispError(s + " does not designate a Java class."));
  • trunk/abcl/src/org/armedbear/lisp/JavaClassLoader.java

    r12298 r12715  
    3939import java.util.HashSet;
    4040import java.util.Set;
     41import java.net.URL;
    4142
    42 public class JavaClassLoader extends ClassLoader {
     43public class JavaClassLoader extends java.net.URLClassLoader {
    4344
    4445    private static JavaClassLoader persistentInstance;
     
    4849    public JavaClassLoader()
    4950    {
    50         super(JavaClassLoader.class.getClassLoader());
     51        this(JavaClassLoader.class.getClassLoader());
     52    }
     53
     54    public JavaClassLoader(ClassLoader parent) {
     55  super(new URL[] {}, parent);
     56    }
     57
     58    public JavaClassLoader(URL[] classpath, ClassLoader parent) {
     59  super(classpath, parent);
    5160    }
    5261
     
    118127        return null;
    119128    }
     129
     130    @Override
     131    public void addURL(URL url) {
     132  super.addURL(url);
     133    }
     134
     135    public static final Symbol CLASSLOADER = PACKAGE_JAVA.intern("*CLASSLOADER*");
     136
     137    private static final Primitive GET_DEFAULT_CLASSLOADER = new pf_get_default_classloader();
     138    private static final class pf_get_default_classloader extends Primitive {
     139 
     140  private final LispObject defaultClassLoader = new JavaObject(new JavaClassLoader());
     141
     142        pf_get_default_classloader() {
     143            super("get-default-classloader", PACKAGE_JAVA, true, "");
     144        }
     145
     146        @Override
     147        public LispObject execute() {
     148      return defaultClassLoader;
     149        }
     150    };
     151
     152    private static final Primitive MAKE_CLASSLOADER = new pf_make_classloader();
     153    private static final class pf_make_classloader extends Primitive
     154    {
     155        pf_make_classloader()
     156        {
     157            super("make-classloader", PACKAGE_JAVA, true, "&optional parent");
     158        }
     159
     160        @Override
     161        public LispObject execute() {
     162      return new JavaObject(new JavaClassLoader(getCurrentClassLoader()));
     163        }
     164
     165        @Override
     166        public LispObject execute(LispObject parent) {
     167      return new JavaObject(new JavaClassLoader((ClassLoader) parent.javaInstance(ClassLoader.class)));
     168        }
     169    };
     170
     171    public static ClassLoader getCurrentClassLoader() {
     172  LispObject classLoader = CLASSLOADER.symbolValueNoThrow();
     173  if(classLoader != null) {
     174      return (ClassLoader) classLoader.javaInstance(ClassLoader.class);
     175  } else {
     176      return Lisp.class.getClassLoader();
     177  }
     178    }
     179
     180
     181
    120182}
  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r12665 r12715  
    252252    ((:documentation :report)
    253253     (list (car option) `',(cadr option)))
    254     (t
    255      (error 'program-error
    256             :format-control "invalid DEFCLASS option ~S"
    257             :format-arguments (list (car option))))))
     254    (t (list (car option) `(quote ,(cdr option))))))
     255;     (error 'program-error
     256;            :format-control "invalid DEFCLASS option ~S"
     257;            :format-arguments (list (car option))))))
    258258
    259259(defun make-initfunction (initform)
     
    542542
    543543(defun make-instance-standard-class (metaclass
     544             &rest initargs
    544545                                     &key name direct-superclasses direct-slots
    545546                                     direct-default-initargs
    546                                      documentation
    547                                      &allow-other-keys)
     547                                     documentation)
    548548  (declare (ignore metaclass))
    549549  (let ((class (std-allocate-instance +the-standard-class+)))
     550    (check-initargs class t initargs)
    550551    (%set-class-name name class)
    551552    (%set-class-layout nil class)
     
    635636                  ;; We're redefining the class.
    636637                  (%make-instances-obsolete old-class)
     638      (check-initargs old-class t all-keys)
    637639                  (apply #'std-after-initialization-for-classes old-class all-keys)
    638640                  old-class)))
     
    23772379      (when (eq (car option) :report)
    23782380        (setf report (cadr option))
     2381  (setf options (delete option options :test #'equal))
    23792382        (return)))
    23802383    (typecase report
  • trunk/abcl/src/org/armedbear/lisp/java.lisp

    r12661 r12715  
    3535(require "PRINT-OBJECT")
    3636
     37(defvar *classloader* (get-default-classloader))
     38
     39(defun add-url-to-classpath (url &optional (classloader *classloader*))
     40  (jcall "addUrl" classloader url))
     41
     42(defun add-urls-to-classpath (&rest urls)
     43  (dolist (url urls)
     44    (add-url-to-classpath url)))
     45
    3746(defun jregister-handler (object event handler &key data count)
    3847  (%jregister-handler object event handler data count))
     
    191200        (setf (apply #'jarray-ref jarray (row-major-to-index dimensions i)) (row-major-aref array i))
    192201        (apply #'(setf jarray-ref) (row-major-aref array i) jarray (row-major-to-index dimensions i))))))
     202
     203(defun jnew-array-from-list (element-type list)
     204  (let ((jarray (jnew-array element-type (length list)))
     205  (i 0))
     206    (dolist (x list)
     207      (setf (jarray-ref jarray i) x
     208      i (1+ i)))
     209    jarray))
    193210
    194211(defun jclass-constructors (class)
Note: See TracChangeset for help on using the changeset viewer.