Changeset 12837


Ignore:
Timestamp:
07/31/10 12:52:40 (11 years ago)
Author:
ehuelsmann
Message:

Introduce EMIT-GETSTATIC and EMIT-PUTSTATIC in order to be able to
make the getstatic and putstatic resolvers side-effect free in terms
of the class file being generated.

File:
1 edited

Legend:

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

    r12836 r12837  
    343343(declaim (inline emit-push-nil))
    344344(defun emit-push-nil ()
    345   (emit 'getstatic +lisp-class+ "NIL" +lisp-object+))
     345  (emit-getstatic +lisp-class+ "NIL" +lisp-object+))
    346346
    347347(defknown emit-push-nil-symbol () t)
    348348(declaim (inline emit-push-nil-symbol))
    349349(defun emit-push-nil-symbol ()
    350   (emit 'getstatic +lisp-nil-class+ "NIL" +lisp-symbol+))
     350  (emit-getstatic +lisp-nil-class+ "NIL" +lisp-symbol+))
    351351
    352352(defknown emit-push-t () t)
    353353(declaim (inline emit-push-t))
    354354(defun emit-push-t ()
    355   (emit 'getstatic +lisp-class+ "T" +lisp-symbol+))
     355  (emit-getstatic +lisp-class+ "T" +lisp-symbol+))
    356356
    357357(defknown emit-push-false (t) t)
     
    570570      (setf pretty-string (concatenate 'string pretty-string "[]")))
    571571    pretty-string))
     572
     573(declaim (inline emit-getstatic emit-putstatic))
     574(defknown emit-getstatic (t t t) t)
     575(defun emit-getstatic (class-name field-name type)
     576  (let ((index (pool-field class-name field-name type)))
     577    (apply #'%emit 'getstatic (u2 index))))
     578
     579(defknown emit-putstatic (t t t) t)
     580(defun emit-putstatic (class-name field-name type)
     581  (let ((index (pool-field class-name field-name type)))
     582    (apply #'%emit 'putstatic (u2 index))))
    572583
    573584(defvar type-representations '((:int fixnum)
     
    773784    (emit 'ifne LABEL1)
    774785    (emit-load-local-variable variable)
    775     (emit 'getstatic +lisp-symbol-class+ expected-type-java-symbol-name
     786    (emit-getstatic +lisp-symbol-class+ expected-type-java-symbol-name
    776787          +lisp-symbol+)
    777788    (emit-invokestatic +lisp-class+ "type_error"
     
    833844  (unless (> *speed* *safety*)
    834845    (let ((label1 (gensym)))
    835       (emit 'getstatic +lisp-class+ "interrupted" "Z")
     846      (emit-getstatic +lisp-class+ "interrupted" "Z")
    836847      (emit 'ifeq label1)
    837848      (emit-invokestatic +lisp-class+ "handleInterrupt" nil nil)
     
    11971208;; getstatic, putstatic
    11981209(define-resolver (178 179) (instruction)
    1199   (let* ((args (instruction-args instruction))
    1200          (index (pool-field (first args) (second args) (third args))))
    1201     (inst (instruction-opcode instruction) (u2 index))))
     1210  ;; we used to create the pool-field here; that moved to the emit-* layer
     1211  instruction)
    12021212
    12031213;; bipush, sipush
     
    18351845                 (emit-push-nil)
    18361846                 (emit-push-t)) ;; we don't need the actual supplied-p symbol
    1837              (emit 'getstatic +lisp-closure-class+ "OPTIONAL" "I")
     1847             (emit-getstatic +lisp-closure-class+ "OPTIONAL" "I")
    18381848             (emit-invokespecial-init +lisp-closure-parameter-class+
    18391849                                      (list +lisp-symbol+ +lisp-object+
     
    20332043  "Generates code to restore a serialized integer."
    20342044  (cond((<= 0 n 255)
    2035         (emit 'getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+)
     2045        (emit-getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+)
    20362046        (emit-push-constant-int n)
    20372047        (emit 'aaload))
     
    21022112    (cond
    21032113      (name
    2104        (emit 'getstatic class name +lisp-symbol+))
     2114       (emit-getstatic class name +lisp-symbol+))
    21052115      ((null (symbol-package symbol))
    21062116       (emit-push-constant-int (dump-uninterned-symbol-index symbol))
     
    21642174    (let ((existing (assoc object *externalized-objects* :test similarity-fn)))
    21652175      (when existing
    2166         (emit 'getstatic *this-class* (cdr existing) field-type)
     2176        (emit-getstatic *this-class* (cdr existing) field-type)
    21672177        (when cast
    21682178          (emit 'checkcast cast))
     
    21832193           (when (string/= field-type +lisp-object+)
    21842194             (emit 'checkcast (subseq field-type 1 (1- (length field-type)))))
    2185            (emit 'putstatic *this-class* field-name field-type)
     2195           (emit-putstatic *this-class* field-name field-type)
    21862196           (setf *static-code* *code*)))
    21872197        (*declare-inline*
    21882198         (funcall dispatch-fn object)
    2189          (emit 'putstatic *this-class* field-name field-type))
     2199         (emit-putstatic *this-class* field-name field-type))
    21902200        (t
    21912201         (let ((*code* *static-code*))
    21922202           (funcall dispatch-fn object)
    2193            (emit 'putstatic *this-class* field-name field-type)
     2203           (emit-putstatic *this-class* field-name field-type)
    21942204           (setf *static-code* *code*))))
    21952205
    2196       (emit 'getstatic *this-class* field-name field-type)
     2206      (emit-getstatic *this-class* field-name field-type)
    21972207      (when cast
    21982208        (emit 'checkcast cast))
     
    22262236         (if (eq class *this-class*)
    22272237             (progn ;; generated by the DECLARE-OBJECT*'s above
    2228                (emit 'getstatic class name +lisp-object+)
     2238               (emit-getstatic class name +lisp-object+)
    22292239               (emit 'checkcast +lisp-symbol-class+))
    2230              (emit 'getstatic class name +lisp-symbol+))
     2240             (emit-getstatic class name +lisp-symbol+))
    22312241         (emit-invokevirtual +lisp-symbol-class+
    22322242                             (if setf
     
    22382248         (emit-invokevirtual +lisp-object-class+
    22392249                             "resolve" nil +lisp-object+)
    2240          (emit 'putstatic *this-class* f +lisp-object+)
     2250         (emit-putstatic *this-class* f +lisp-object+)
    22412251         (if *declare-inline*
    22422252             (setf saved-code *code*)
     
    22742284;     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
    22752285;     (list +java-string+) +lisp-object+)
    2276      (emit 'putstatic *this-class* g +lisp-object+)
     2286     (emit-putstatic *this-class* g +lisp-object+)
    22772287     (setf *static-code* *code*)
    22782288     (setf (gethash local-function ht) g))))
     
    22992309      (emit-invokestatic +lisp-class+ "readObjectFromString"
    23002310                         (list +java-string+) +lisp-object+)
    2301       (emit 'putstatic *this-class* g +lisp-object+)
     2311      (emit-putstatic *this-class* g +lisp-object+)
    23022312      (if *declare-inline*
    23032313          (setf saved-code *code*)
     
    23212331      (emit-invokestatic +lisp-class+ "loadTimeValue"
    23222332                         (lisp-object-arg-types 1) +lisp-object+)
    2323       (emit 'putstatic *this-class* g +lisp-object+)
     2333      (emit-putstatic *this-class* g +lisp-object+)
    23242334      (if *declare-inline*
    23252335          (setf saved-code *code*)
     
    23462356      (when (and obj-class (string/= obj-class +lisp-object-class+))
    23472357        (emit 'checkcast obj-class))
    2348       (emit 'putstatic *this-class* g obj-ref)
     2358      (emit-putstatic *this-class* g obj-ref)
    23492359      (setf *static-code* *code*)
    23502360      g)))
     
    30693079                         (declare-object
    30703080                          (local-function-function local-function)))))
    3071              (emit 'getstatic *this-class* g +lisp-object+)
     3081             (emit-getstatic *this-class* g +lisp-object+)
    30723082                                        ; Stack: template-function
    30733083             (when *closure-variables*
     
    47904800(defun p2-load-time-value (form target representation)
    47914801  (cond (*file-compilation*
    4792          (emit 'getstatic *this-class*
     4802         (emit-getstatic *this-class*
    47934803               (declare-load-time-value (second form)) +lisp-object+)
    47944804         (fix-boxing representation nil)
     
    49214931(defun emit-make-compiled-closure-for-labels
    49224932    (local-function compiland declaration)
    4923   (emit 'getstatic *this-class* declaration +lisp-object+)
     4933  (emit-getstatic *this-class* declaration +lisp-object+)
    49244934  (let ((parent (compiland-parent compiland)))
    49254935    (when (compiland-closure-register parent)
     
    50065016       (with-open-class-file (f class-file)
    50075017         (compile-and-write-to-stream class-file compiland f))
    5008              (emit 'getstatic *this-class*
     5018             (emit-getstatic *this-class*
    50095019                   (declare-local-function (make-local-function :class-file
    50105020                                                                class-file))
     
    50525062                          (declare-object
    50535063                           (local-function-function local-function)))))
    5054                (emit 'getstatic *this-class* g +lisp-object+)
     5064               (emit-getstatic *this-class* g +lisp-object+)
    50555065                                        ; Stack: template-function
    50565066
     
    50635073          (emit-move-from-stack target))
    50645074         ((inline-ok name)
    5065           (emit 'getstatic *this-class*
     5075          (emit-getstatic *this-class*
    50665076                (declare-function name) +lisp-object+)
    50675077          (emit-move-from-stack target))
     
    50935103                          (declare-object
    50945104                           (local-function-function local-function)))))
    5095                (emit 'getstatic *this-class*
     5105               (emit-getstatic *this-class*
    50965106                     g +lisp-object+))))) ; Stack: template-function
    50975107         ((and (member name *functions-defined-in-current-file* :test #'equal)
    50985108         (not (notinline-p name)))
    5099           (emit 'getstatic *this-class*
     5109          (emit-getstatic *this-class*
    51005110                (declare-setf-function name) +lisp-object+)
    51015111          (emit-move-from-stack target))
     
    74697479    (emit 'instanceof instanceof-class)
    74707480    (emit 'ifne LABEL1)
    7471     (emit 'getstatic +lisp-symbol-class+ expected-type-java-symbol-name +lisp-symbol+)
     7481    (emit-getstatic +lisp-symbol-class+ expected-type-java-symbol-name +lisp-symbol+)
    74727482    (emit-invokestatic +lisp-class+ "type_error"
    74737483                       (lisp-object-arg-types 2) +lisp-object+)
Note: See TracChangeset for help on using the changeset viewer.