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

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.

File:

• branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (4 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))))