Changeset 12836

Timestamp:

07/31/10 12:24:51 (13 years ago)

Author:

ehuelsmann

Message:

Move emit-invoke* functions closer together, making them a section.

File:

• trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (3 diffs)

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

@@ -495 +495 @@
          (descriptor (car info))
          (stack-effect (cdr info))
-         (instruction (emit 'invokestatic class-name method-name descriptor)))
+         (index (pool-method class-name method-name descriptor))
+         (instruction (apply #'%emit 'invokestatic (u2 index))))
     (setf (instruction-stack instruction) stack-effect)))
+
+
+
+(declaim (ftype (function t string) pretty-java-class))
+(defun pretty-java-class (class)
+  (cond ((equal class +lisp-object-class+)
+         "LispObject")
+        ((equal class +lisp-symbol+)
+         "Symbol")
+        ((equal class +lisp-thread-class+)
+         "LispThread")
+        (t
+         class)))
+
+(defknown emit-invokevirtual (t t t t) t)
+(defun emit-invokevirtual (class-name method-name arg-types return-type)
+  (let* ((info (get-descriptor-info arg-types return-type))
+         (descriptor (car info))
+         (stack-effect (cdr info))
+         (index (pool-method class-name method-name descriptor))
+         (instruction (apply #'%emit 'invokevirtual (u2 index))))
+    (declare (type (signed-byte 8) stack-effect))
+    (let ((explain *explain*))
+      (when (and explain (memq :java-calls explain))
+        (unless (string= method-name "execute")
+          (format t ";   call to ~A ~A.~A(~{~A~^,~})~%"
+                  (pretty-java-type return-type)
+                  (pretty-java-class class-name)
+                  method-name
+                  (mapcar 'pretty-java-type arg-types)))))
+    (setf (instruction-stack instruction) (1- stack-effect))))
+
+(defknown emit-invokespecial-init (string list) t)
+(defun emit-invokespecial-init (class-name arg-types)
+  (let* ((info (get-descriptor-info arg-types nil))
+         (descriptor (car info))
+         (stack-effect (cdr info))
+         (index (pool-method class-name "<init>" descriptor))
+         (instruction (apply #'%emit 'invokespecial (u2 index))))
+    (declare (type (signed-byte 8) stack-effect))
+    (setf (instruction-stack instruction) (1- stack-effect))))
+
 
 (defknown pretty-java-type (t) string)
@@ -660 +703 @@
         (return-from common-representation result)))))
 
-
-
-(declaim (ftype (function t string) pretty-java-class))
-(defun pretty-java-class (class)
-  (cond ((equal class +lisp-object-class+)
-         "LispObject")
-        ((equal class +lisp-symbol+)
-         "Symbol")
-        ((equal class +lisp-thread-class+)
-         "LispThread")
-        (t
-         class)))
-
-(defknown emit-invokevirtual (t t t t) t)
-(defun emit-invokevirtual (class-name method-name arg-types return-type)
-  (let* ((info (get-descriptor-info arg-types return-type))
-         (descriptor (car info))
-         (stack-effect (cdr info))
-         (instruction (emit 'invokevirtual class-name method-name descriptor)))
-    (declare (type (signed-byte 8) stack-effect))
-    (let ((explain *explain*))
-      (when (and explain (memq :java-calls explain))
-        (unless (string= method-name "execute")
-          (format t ";   call to ~A ~A.~A(~{~A~^,~})~%"
-                  (pretty-java-type return-type)
-                  (pretty-java-class class-name)
-                  method-name
-                  (mapcar 'pretty-java-type arg-types)))))
-    (setf (instruction-stack instruction) (1- stack-effect))))
-
-(defknown emit-invokespecial-init (string list) t)
-(defun emit-invokespecial-init (class-name arg-types)
-  (let* ((info (get-descriptor-info arg-types nil))
-         (descriptor (car info))
-         (stack-effect (cdr info))
-         (instruction (emit 'invokespecial class-name "<init>" descriptor)))
-    (declare (type (signed-byte 8) stack-effect))
-    (setf (instruction-stack instruction) (1- stack-effect))))
 
 ;; Index of local variable used to hold the current thread.
@@ -1210 +1215 @@
 ;; invokevirtual, invokespecial, invokestatic class-name method-name descriptor
 (define-resolver (182 183 184) (instruction)
-  (let* ((args (instruction-args instruction))
-         (index (pool-method (first args) (second args) (third args))))
-    (setf (instruction-args instruction) (u2 index))
-    instruction))
+  ;; we used to create the pool-method here; that moved to the emit-* layer
+  instruction)
 
 ;; ldc