Changeset 13535

Timestamp:

08/23/11 20:35:32 (10 years ago)

Author:

ehuelsmann

Message:

Moving huge object serialization from <init>() to <clinit>()
broke the code generation for that special case -- there's no longer
a 'this' variable to be loaded. Replace with <this class>.class.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (2 diffs)
• compiler-types.lisp (modified) (1 diff)
• jvm-class-file.lisp (modified) (2 diffs)
• jvm-instructions.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -1058 +1058 @@
   (let ((*compiler-debug* nil)
         (method (make-jvm-method :static-initializer
-         :void nil :flags '(:public :static))))
+                                 :void nil :flags '(:public :static))))
     ;; We don't normally need to see debugging output for <clinit>.
     (with-code-to-method (class method)
@@ -1206 +1206 @@
                           (list +java-string+) +lisp-object+))
       (t
-       (aload 0) ;; this
-       (emit-invokevirtual +java-object+ "getClass" '() +java-class+)
+        ;; get a 'class literal' for this class
+       (emit 'ldc_w (pool-class *this-class*))
        (let ((pathname
               (compiland-external-constant-resource-name *current-compiland*)))

trunk/abcl/src/org/armedbear/lisp/compiler-types.lisp

@@ -227 +227 @@
 
 (declaim (type hash-table *function-result-types*))
-(defconst *function-result-types* (make-hash-table :test 'equal))
+(defvar *function-result-types* (make-hash-table :test 'equal))
 
 (declaim (ftype (function (t) t) function-result-type))

trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -699 +699 @@
   ;; header
   (write-u4 #xCAFEBABE stream)
-  (write-u2 3 stream)
-  (write-u2 45 stream)
+  (write-u2 0 stream)
+  (write-u2 49 stream)  ;; our <clinit> methods use class literals
+  ;; which require a high enough class file format
+  ;; we used to have 45, but the LDC instruction doesn't support
+  ;; class literals in that version... (49 == Java 1.5)
 
    ;; constants pool
@@ -715 +718 @@
   ;; interfaces
   (if (class-file-interfaces class)
-      (progn 
+      (progn
         (write-u2 (length (class-file-interfaces class)) stream)
         (dolist (interface-ref (class-file-interfaces class))

trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp

@@ -661 +661 @@
         (inst 18 args))))
 
+;; ldc_w
+(define-resolver 19 (instruction)
+  (let* ((args (instruction-args instruction)))
+    (unless (= (length args) 1)
+      (error "Wrong number of args for LDC_W."))
+    (inst 19 (u2 (car args)))))
+
 ;; ldc2_w
 (define-resolver 20 (instruction)