Changeset 12850

Timestamp:

08/02/10 06:41:33 (13 years ago)

Author:

ehuelsmann

Message:

Continue CLASS-NAME integration, define a solution for arrays.

Location:

branches/generic-class-file/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (1 diff)
• jvm-class-file.lisp (modified) (6 diffs)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -211 +211 @@
       (code-add-exception-handler *current-code-attribute*
                                   start end handler type)))
-
-
-(defconstant +lisp-object-array+ "[Lorg/armedbear/lisp/LispObject;")
-(defconstant +closure-binding-array+ "[Lorg/armedbear/lisp/ClosureBinding;")
-(defconstant +lisp-fixnum-array+ "[Lorg/armedbear/lisp/Fixnum;")
-(defconstant +lisp-character-array+ "[Lorg/armedbear/lisp/LispCharacter;")
-(defconstant +lisp-closure-parameter-array+ "[Lorg/armedbear/lisp/Closure$Parameter;")
 
 (defun !class-name (class-name)

branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -83 +83 @@
 (defstruct (class-name (:conc-name class-)
                        (:constructor %make-class-name))
+  "Used for class identification.
+
+The caller should instantiate only one `class-name' per class, as they are
+used as class identifiers and compared using EQ.
+
+Some instructions need a class argument, others need a reference identifier.
+This class is used to abstract from the difference."
   name-internal
   ref
-  array-ref)
+  array-class ;; cached array class reference
+  ;; keeping a reference to the associated array class allows class
+  ;; name comparisons to be EQ: all classes should exist only once,
+  )
 
 (defun make-class-name (name)
@@ -94 +104 @@
   (setf name (substitute #\/ #\. name))
   (%make-class-name :name-internal name
-                    :ref (concatenate 'string "L" name ";")
-                    :array-ref (concatenate 'string "[L" name ";")))
+                    :ref (concatenate 'string "L" name ";")))
+
+(defun class-array (class-name)
+  "Returns a class-name representing an array of `class-name'.
+For multi-dimensional arrays, call this function multiple times, using
+its own result.
+
+This function can be called multiple times on the same `class-name' without
+violating the 'only one instance' requirement: the returned value is cached
+and used on successive calls."
+  (unless (class-array-class class-name)
+    ;; Alessio Stalla found by dumping a class file that the JVM uses
+    ;; the same representation (ie '[L<class-name>;') in CHECKCAST as
+    ;; it does in field references, meaning the class name and class ref
+    ;; are identified by the same string
+    (let ((name-and-ref (concatenate 'string "[" (class-ref class-name))))
+      (setf (class-array-class class-name)
+            (%make-class-name :name-internal name-and-ref
+                              :ref name-and-ref))))
+  (class-array-class class-name))
 
 (defmacro define-class-name (symbol java-dotted-name &optional documentation)
@@ -106 +134 @@
 (define-class-name +java-string+ "java.lang.String")
 (define-class-name +lisp-object+ "org.armedbear.lisp.LispObject")
+(defconstant +lisp-object-array+ (class-array +lisp-object+))
 (define-class-name +lisp-simple-string+ "org.armedbear.lisp.SimpleString")
 (define-class-name +lisp+ "org.armedbear.lisp.Lisp")
@@ -113 +142 @@
 (define-class-name +lisp-thread+ "org.armedbear.lisp.LispThread")
 (define-class-name +lisp-closure-binding+ "org.armedbear.lisp.ClosureBinding")
+(defconstant +closure-binding-array+ (class-array +lisp-closure-binding+))
 (define-class-name +lisp-integer+ "org.armedbear.lisp.LispInteger")
 (define-class-name +lisp-fixnum+ "org.armedbear.lisp.Fixnum")
+(defconstant +lisp-fixnum-array+ (class-array +lisp-fixnum+))
 (define-class-name +lisp-bignum+ "org.armedbear.lisp.Bignum")
 (define-class-name +lisp-single-float+ "org.armedbear.lisp.SingleFloat")
@@ -121 +152 @@
 (define-class-name +lisp-load+ "org.armedbear.lisp.Load")
 (define-class-name +lisp-character+ "org.armedbear.lisp.LispCharacter")
+(defconstant +lisp-character-array+ (class-array +lisp-character+))
 (define-class-name +lisp-structure-object+ "org.armedbear.lisp.StructureObject")
 (define-class-name +lisp-simple-vector+ "org.armedbear.lisp.SimpleVector")
@@ -144 +176 @@
 (define-class-name +lisp-closure-parameter+
     "org.armedbear.lisp.Closure$Parameter")
-(define-class-name +!fasl-loader+ "org.armedbear.lisp.FaslClassLoader")
+(defconstant +lisp-closure-parameter-array+
+  (class-array +lisp-closure-parameter+))
 
 #|