Changeset 12840

Timestamp:

07/31/10 21:33:24 (13 years ago)

Author:

ehuelsmann

Message:

Introduce "dual mode" operation for emit-invoke* and emit-*static,
in order to allow test-writing.

Location:

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

Files:

• compiler-pass2.lisp (modified) (4 diffs)
• jvm-class-file.lisp (modified) (3 diffs)

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

@@ -464 +464 @@
          (stack-effect (cdr info))
          (class-name (!class-name class-name))
-         (index (pool-method class-name method-name descriptor))
+         (index (if (null *current-code-attribute*)
+                    (pool-method class-name method-name descriptor)
+                    (pool-add-method-ref *pool* class-name
+                                         method-name descriptor)))
          (instruction (apply #'%emit 'invokestatic (u2 index))))
     (setf (instruction-stack instruction) stack-effect)))
@@ -487 +490 @@
          (stack-effect (cdr info))
          (class-name (!class-name class-name))
-         (index (pool-method class-name method-name descriptor))
+         (index (if (null *current-code-attribute*)
+                    (pool-method class-name method-name descriptor)
+                    (pool-add-method-ref *pool* class-name
+                                         method-name descriptor)))
          (instruction (apply #'%emit 'invokevirtual (u2 index))))
     (declare (type (signed-byte 8) stack-effect))
@@ -506 +512 @@
          (stack-effect (cdr info))
          (class-name (!class-name class-name))
-         (index (pool-method class-name "<init>" descriptor))
+         (index (if (null *current-code-attribute*)
+                    (pool-method class-name "<init>" descriptor)
+                    (pool-add-method-ref *pool* class-name
+                                         "<init>" descriptor)))
          (instruction (apply #'%emit 'invokespecial (u2 index))))
     (declare (type (signed-byte 8) stack-effect))
@@ -545 +554 @@
 (defknown emit-getstatic (t t t) t)
 (defun emit-getstatic (class-name field-name type)
-  (let ((index (pool-field (!class-name class-name)
-                           field-name (!class-ref type))))
+  (let ((index (if (null *current-code-attribute*)
+                   (pool-field (!class-name class-name)
+                           field-name (!class-ref type))
+                   (pool-add-field-ref *pool* class-name field-name type))))
     (apply #'%emit 'getstatic (u2 index))))
 
 (defknown emit-putstatic (t t t) t)
 (defun emit-putstatic (class-name field-name type)
-  (let ((index (pool-field (!class-name class-name)
-                           field-name (!class-ref type))))
+  (let ((index (if (null *current-code-attribute*)
+                   (pool-field (!class-name class-name)
+                           field-name (!class-ref type))
+                   (pool-add-field-ref *pool* class-name field-name type))))
     (apply #'%emit 'putstatic (u2 index))))
 

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

@@ -876 +876 @@
 
 
-(defvar *current-code-attribute*)
+(defvar *current-code-attribute* nil)
 
 (defun save-code-specials (code)
@@ -890 +890 @@
         *register* (code-current-local code)))
 
-(defmacro with-code-to-method ((method &key safe-nesting) &body body)
+(defmacro with-code-to-method ((class-file method &key safe-nesting) &body body)
   (let ((m (gensym))
         (c (gensym)))
@@ -899 +899 @@
        (let* ((,m ,method)
               (,c (method-ensure-code method))
+              (*pool* (class-file-constants ,class-file))
               (*code* (code-code ,c))
               (*registers-allocated* (code-max-locals ,c))