Changeset 12836


Ignore:
Timestamp:
07/31/10 12:24:51 (12 years ago)
Author:
ehuelsmann
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12835 r12836  
    495495         (descriptor (car info))
    496496         (stack-effect (cdr info))
    497          (instruction (emit 'invokestatic class-name method-name descriptor)))
     497         (index (pool-method class-name method-name descriptor))
     498         (instruction (apply #'%emit 'invokestatic (u2 index))))
    498499    (setf (instruction-stack instruction) stack-effect)))
     500
     501
     502
     503(declaim (ftype (function t string) pretty-java-class))
     504(defun pretty-java-class (class)
     505  (cond ((equal class +lisp-object-class+)
     506         "LispObject")
     507        ((equal class +lisp-symbol+)
     508         "Symbol")
     509        ((equal class +lisp-thread-class+)
     510         "LispThread")
     511        (t
     512         class)))
     513
     514(defknown emit-invokevirtual (t t t t) t)
     515(defun emit-invokevirtual (class-name method-name arg-types return-type)
     516  (let* ((info (get-descriptor-info arg-types return-type))
     517         (descriptor (car info))
     518         (stack-effect (cdr info))
     519         (index (pool-method class-name method-name descriptor))
     520         (instruction (apply #'%emit 'invokevirtual (u2 index))))
     521    (declare (type (signed-byte 8) stack-effect))
     522    (let ((explain *explain*))
     523      (when (and explain (memq :java-calls explain))
     524        (unless (string= method-name "execute")
     525          (format t ";   call to ~A ~A.~A(~{~A~^,~})~%"
     526                  (pretty-java-type return-type)
     527                  (pretty-java-class class-name)
     528                  method-name
     529                  (mapcar 'pretty-java-type arg-types)))))
     530    (setf (instruction-stack instruction) (1- stack-effect))))
     531
     532(defknown emit-invokespecial-init (string list) t)
     533(defun emit-invokespecial-init (class-name arg-types)
     534  (let* ((info (get-descriptor-info arg-types nil))
     535         (descriptor (car info))
     536         (stack-effect (cdr info))
     537         (index (pool-method class-name "<init>" descriptor))
     538         (instruction (apply #'%emit 'invokespecial (u2 index))))
     539    (declare (type (signed-byte 8) stack-effect))
     540    (setf (instruction-stack instruction) (1- stack-effect))))
     541
    499542
    500543(defknown pretty-java-type (t) string)
     
    660703        (return-from common-representation result)))))
    661704
    662 
    663 
    664 (declaim (ftype (function t string) pretty-java-class))
    665 (defun pretty-java-class (class)
    666   (cond ((equal class +lisp-object-class+)
    667          "LispObject")
    668         ((equal class +lisp-symbol+)
    669          "Symbol")
    670         ((equal class +lisp-thread-class+)
    671          "LispThread")
    672         (t
    673          class)))
    674 
    675 (defknown emit-invokevirtual (t t t t) t)
    676 (defun emit-invokevirtual (class-name method-name arg-types return-type)
    677   (let* ((info (get-descriptor-info arg-types return-type))
    678          (descriptor (car info))
    679          (stack-effect (cdr info))
    680          (instruction (emit 'invokevirtual class-name method-name descriptor)))
    681     (declare (type (signed-byte 8) stack-effect))
    682     (let ((explain *explain*))
    683       (when (and explain (memq :java-calls explain))
    684         (unless (string= method-name "execute")
    685           (format t ";   call to ~A ~A.~A(~{~A~^,~})~%"
    686                   (pretty-java-type return-type)
    687                   (pretty-java-class class-name)
    688                   method-name
    689                   (mapcar 'pretty-java-type arg-types)))))
    690     (setf (instruction-stack instruction) (1- stack-effect))))
    691 
    692 (defknown emit-invokespecial-init (string list) t)
    693 (defun emit-invokespecial-init (class-name arg-types)
    694   (let* ((info (get-descriptor-info arg-types nil))
    695          (descriptor (car info))
    696          (stack-effect (cdr info))
    697          (instruction (emit 'invokespecial class-name "<init>" descriptor)))
    698     (declare (type (signed-byte 8) stack-effect))
    699     (setf (instruction-stack instruction) (1- stack-effect))))
    700705
    701706;; Index of local variable used to hold the current thread.
     
    12101215;; invokevirtual, invokespecial, invokestatic class-name method-name descriptor
    12111216(define-resolver (182 183 184) (instruction)
    1212   (let* ((args (instruction-args instruction))
    1213          (index (pool-method (first args) (second args) (third args))))
    1214     (setf (instruction-args instruction) (u2 index))
    1215     instruction))
     1217  ;; we used to create the pool-method here; that moved to the emit-* layer
     1218  instruction)
    12161219
    12171220;; ldc
Note: See TracChangeset for help on using the changeset viewer.