Changeset 12839


Ignore:
Timestamp:
07/31/10 19:21:20 (12 years ago)
Author:
ehuelsmann
Message:

Backport r12837, resolving merge conflicts along the way.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r12838 r12839  
    309309(declaim (inline emit-push-nil))
    310310(defun emit-push-nil ()
    311   (emit 'getstatic +lisp+ "NIL" +lisp-object+))
     311  (emit-getstatic +lisp+ "NIL" +lisp-object+))
    312312
    313313(defknown emit-push-nil-symbol () t)
    314314(declaim (inline emit-push-nil-symbol))
    315315(defun emit-push-nil-symbol ()
    316   (emit 'getstatic +lisp-nil+ "NIL" +lisp-symbol+))
     316  (emit-getstatic +lisp-nil+ "NIL" +lisp-symbol+))
    317317
    318318(defknown emit-push-t () t)
    319319(declaim (inline emit-push-t))
    320320(defun emit-push-t ()
    321   (emit 'getstatic +lisp+ "T" +lisp-symbol+))
     321  (emit-getstatic +lisp+ "T" +lisp-symbol+))
    322322
    323323(defknown emit-push-false (t) t)
     
    541541      (setf pretty-string (concatenate 'string pretty-string "[]")))
    542542    pretty-string))
     543
     544(declaim (inline emit-getstatic emit-putstatic))
     545(defknown emit-getstatic (t t t) t)
     546(defun emit-getstatic (class-name field-name type)
     547  (let ((index (pool-field (!class-name class-name)
     548                           field-name (!class-ref type))))
     549    (apply #'%emit 'getstatic (u2 index))))
     550
     551(defknown emit-putstatic (t t t) t)
     552(defun emit-putstatic (class-name field-name type)
     553  (let ((index (pool-field (!class-name class-name)
     554                           field-name (!class-ref type))))
     555    (apply #'%emit 'putstatic (u2 index))))
    543556
    544557(defvar type-representations '((:int fixnum)
     
    744757    (emit 'ifne LABEL1)
    745758    (emit-load-local-variable variable)
    746     (emit 'getstatic +lisp-symbol+ expected-type-java-symbol-name
     759    (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name
    747760          +lisp-symbol+)
    748761    (emit-invokestatic +lisp+ "type_error"
     
    804817  (unless (> *speed* *safety*)
    805818    (let ((label1 (gensym)))
    806       (emit 'getstatic +lisp+ "interrupted" "Z")
     819      (emit-getstatic +lisp+ "interrupted" "Z")
    807820      (emit 'ifeq label1)
    808821      (emit-invokestatic +lisp+ "handleInterrupt" nil nil)
     
    11681181;; getstatic, putstatic
    11691182(define-resolver (178 179) (instruction)
    1170   (let* ((args (instruction-args instruction))
    1171          (index (pool-field (!class-name (first args))
    1172                             (second args) (!class-ref (third args)))))
    1173     (inst (instruction-opcode instruction) (u2 index))))
     1183  ;; we used to create the pool-field here; that moved to the emit-* layer
     1184  instruction)
    11741185
    11751186;; bipush, sipush
     
    18111822                 (emit-push-nil)
    18121823                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    1813              (emit 'getstatic +lisp-closure+ "OPTIONAL" "I")
     1824             (emit-getstatic +lisp-closure+ "OPTIONAL" "I")
    18141825             (emit-invokespecial-init +lisp-closure-parameter+
    18151826                                      (list +lisp-symbol+ +lisp-object+
     
    20092020  "Generates code to restore a serialized integer."
    20102021  (cond((<= 0 n 255)
    2011         (emit 'getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+)
     2022        (emit-getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+)
    20122023        (emit-push-constant-int n)
    20132024        (emit 'aaload))
     
    20782089    (cond
    20792090      (name
    2080        (emit 'getstatic class name +lisp-symbol+))
     2091       (emit-getstatic class name +lisp-symbol+))
    20812092      ((null (symbol-package symbol))
    20822093       (emit-push-constant-int (dump-uninterned-symbol-index symbol))
     
    21402151    (let ((existing (assoc object *externalized-objects* :test similarity-fn)))
    21412152      (when existing
    2142         (emit 'getstatic *this-class* (cdr existing) field-type)
     2153        (emit-getstatic *this-class* (cdr existing) field-type)
    21432154        (when cast
    21442155          (emit 'checkcast cast))
     
    21592170           (when (not (eq field-type +lisp-object+))
    21602171             (emit 'checkcast field-type))
    2161            (emit 'putstatic *this-class* field-name field-type)
     2172           (emit-putstatic *this-class* field-name field-type)
    21622173           (setf *static-code* *code*)))
    21632174        (*declare-inline*
    21642175         (funcall dispatch-fn object)
    2165          (emit 'putstatic *this-class* field-name field-type))
     2176         (emit-putstatic *this-class* field-name field-type))
    21662177        (t
    21672178         (let ((*code* *static-code*))
    21682179           (funcall dispatch-fn object)
    2169            (emit 'putstatic *this-class* field-name field-type)
     2180           (emit-putstatic *this-class* field-name field-type)
    21702181           (setf *static-code* *code*))))
    21712182
    2172       (emit 'getstatic *this-class* field-name field-type)
     2183      (emit-getstatic *this-class* field-name field-type)
    21732184      (when cast
    21742185        (emit 'checkcast cast))
     
    22022213         (if (eq class *this-class*)
    22032214             (progn ;; generated by the DECLARE-OBJECT*'s above
    2204                (emit 'getstatic class name +lisp-object+)
     2215               (emit-getstatic class name +lisp-object+)
    22052216               (emit 'checkcast +lisp-symbol+))
    2206              (emit 'getstatic class name +lisp-symbol+))
     2217             (emit-getstatic class name +lisp-symbol+))
    22072218         (emit-invokevirtual +lisp-symbol+
    22082219                             (if setf
     
    22142225         (emit-invokevirtual +lisp-object+
    22152226                             "resolve" nil +lisp-object+)
    2216          (emit 'putstatic *this-class* f +lisp-object+)
     2227         (emit-putstatic *this-class* f +lisp-object+)
    22172228         (if *declare-inline*
    22182229             (setf saved-code *code*)
     
    22412252     (emit 'dup)
    22422253     (emit-invokespecial-init class-name '())
    2243      (emit 'putstatic *this-class* g +lisp-object+)
     2254     (emit-putstatic *this-class* g +lisp-object+)
    22442255     (setf *static-code* *code*)
    22452256     (setf (gethash local-function ht) g))))
     
    22662277      (emit-invokestatic +lisp+ "readObjectFromString"
    22672278                         (list +java-string+) +lisp-object+)
    2268       (emit 'putstatic *this-class* g +lisp-object+)
     2279      (emit-putstatic *this-class* g +lisp-object+)
    22692280      (if *declare-inline*
    22702281          (setf saved-code *code*)
     
    22882299      (emit-invokestatic +lisp+ "loadTimeValue"
    22892300                         (lisp-object-arg-types 1) +lisp-object+)
    2290       (emit 'putstatic *this-class* g +lisp-object+)
     2301      (emit-putstatic *this-class* g +lisp-object+)
    22912302      (if *declare-inline*
    22922303          (setf saved-code *code*)
     
    23102321      (emit-invokestatic +lisp+ "recall"
    23112322                         (list +java-string+) +lisp-object+)
    2312       (emit 'putstatic *this-class* g +lisp-object+)
     2323      (emit-putstatic *this-class* g +lisp-object+)
    23132324      (setf *static-code* *code*)
    23142325      g)))
     
    30333044                         (declare-object
    30343045                          (local-function-function local-function)))))
    3035              (emit 'getstatic *this-class* g +lisp-object+)
     3046             (emit-getstatic *this-class* g +lisp-object+)
    30363047                                        ; Stack: template-function
    30373048             (when *closure-variables*
     
    47544765(defun p2-load-time-value (form target representation)
    47554766  (cond (*file-compilation*
    4756          (emit 'getstatic *this-class*
     4767         (emit-getstatic *this-class*
    47574768               (declare-load-time-value (second form)) +lisp-object+)
    47584769         (fix-boxing representation nil)
     
    48854896(defun emit-make-compiled-closure-for-labels
    48864897    (local-function compiland declaration)
    4887   (emit 'getstatic *this-class* declaration +lisp-object+)
     4898  (emit-getstatic *this-class* declaration +lisp-object+)
    48884899  (let ((parent (compiland-parent compiland)))
    48894900    (when (compiland-closure-register parent)
     
    49704981       (with-open-class-file (f class-file)
    49714982         (compile-and-write-to-stream class-file compiland f))
    4972              (emit 'getstatic *this-class*
     4983             (emit-getstatic *this-class*
    49734984                   (declare-local-function (make-local-function :class-file
    49744985                                                                class-file))
     
    50165027                          (declare-object
    50175028                           (local-function-function local-function)))))
    5018                (emit 'getstatic *this-class* g +lisp-object+)
     5029               (emit-getstatic *this-class* g +lisp-object+)
    50195030                                        ; Stack: template-function
    50205031
     
    50275038          (emit-move-from-stack target))
    50285039         ((inline-ok name)
    5029           (emit 'getstatic *this-class*
     5040          (emit-getstatic *this-class*
    50305041                (declare-function name) +lisp-object+)
    50315042          (emit-move-from-stack target))
     
    50575068                          (declare-object
    50585069                           (local-function-function local-function)))))
    5059                (emit 'getstatic *this-class*
     5070               (emit-getstatic *this-class*
    50605071                     g +lisp-object+))))) ; Stack: template-function
    50615072         ((and (member name *functions-defined-in-current-file* :test #'equal)
    50625073         (not (notinline-p name)))
    5063           (emit 'getstatic *this-class*
     5074          (emit-getstatic *this-class*
    50645075                (declare-setf-function name) +lisp-object+)
    50655076          (emit-move-from-stack target))
     
    74337444    (emit 'instanceof instanceof-class)
    74347445    (emit 'ifne LABEL1)
    7435     (emit 'getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+)
     7446    (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+)
    74367447    (emit-invokestatic +lisp+ "type_error"
    74377448                       (lisp-object-arg-types 2) +lisp-object+)
Note: See TracChangeset for help on using the changeset viewer.