Changeset 11571


Ignore:
Timestamp:
01/19/09 20:29:38 (12 years ago)
Author:
ehuelsmann
Message:

Implement some building blocks for compilation of float math to byte code:

  • Constant compilation to specific representations
  • Boxing/unboxing of float/double values

See #41.

File:
1 edited

Legend:

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

    r11569 r11571  
    765765         (emit-unbox-boolean))
    766766        ((eq required-representation :long)
    767          (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))))
     767         (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))
     768        ((eq required-representation :float)
     769         (emit-invokevirtual +lisp-object-class+ "floatValue" nil "F"))
     770        ((eq required-representation :double)
     771         (emit-invokevirtual +lisp-object-class+ "doubleValue" nil "D"))
     772        (t (assert nil))))
    768773
    769774(defknown emit-box-long () t)
     
    771776  (declare (optimize speed))
    772777  (emit-invokestatic +lisp-class+ "number" '("J") +lisp-object+))
     778
     779(defknown emit-box-float () t)
     780(defun emit-box-float ()
     781  (emit 'new +lisp-single-float-class+)
     782  (emit 'dup_x1)
     783  (emit-invokespecial-init +lisp-single-float-class+ '("F")))
     784
     785(defknown emit-box-double () t)
     786(defun emit-box-double ()
     787  (emit 'new +lisp-double-float-class+)
     788  (emit 'dup_x2)
     789  (emit-invokespecial-init +lisp-double-float-class+ '("D")))
    773790
    774791(defknown convert-long (t) t)
     
    796813  (declare (optimize speed))
    797814  (cond ((null target)
    798          (emit 'pop))
     815         (case representation
     816           ((:long :double)
     817            (emit 'pop2))
     818           (t
     819            (emit 'pop))))
    799820        ((eq target 'stack)) ; Nothing to do.
    800821        ((fixnump target)
     
    806827            (:long
    807828             'lstore)
     829            (:float
     830             'fstore)
     831            (:double
     832             'dstore)
    808833            (t
    809834             'astore))
     
    22502275     (emit (if form 'iconst_1 'iconst_0))
    22512276     (emit-move-from-stack target representation)
    2252      (return-from compile-constant)))
     2277     (return-from compile-constant))
     2278    (:float
     2279     (cond ((fixnump form)
     2280            (compile-constant form 'stack :int)
     2281            (emit 'i2f))
     2282           ((and (integerp form)
     2283                 (<= most-negative-java-long form most-positive-java-long))
     2284            (compile-constant form 'stack :long)
     2285            (emit 'l2f))
     2286           ((integerp form)
     2287            (emit 'getfield *this-class* (declare-bignum form)
     2288                  +lisp-bignum+)
     2289            (emit-invokevirtual +lisp-bignum-class+ "floatValue" nil "F"))
     2290           ((typep form 'single-float)
     2291            (emit 'ldc (declare-float form)))
     2292           ((typep form 'double-float)
     2293            (emit 'ldc2_w (declare-double form))
     2294            (emit 'd2f))
     2295           (t (assert nil)))
     2296     (emit-move-from-stack target representation)
     2297     (return-from compile-constant))
     2298    (:double
     2299     (cond ((fixnump form)
     2300            (compile-constant form 'stack :int)
     2301            (emit 'i2d))
     2302           ((and (integerp form)
     2303                 (<= most-negative-java-long form most-positive-java-long))
     2304            (compile-constant form 'stack :long)
     2305            (emit 'l2d))
     2306           ((integerp form)
     2307            (emit 'getfield *this-class* (declare-bignum form)
     2308                  +lisp-bignum+)
     2309            (emit-invokevirtual +lisp-bignum-class+ "doubleValue" nil "D")
     2310           ((typep form 'single-float)
     2311            (emit 'ldc (declare-float form))
     2312            (emit 'f2d))
     2313           ((typep form 'double-float)
     2314            (emit 'ldc2_w (declare-double form)))
     2315           (t (assert nil)))
     2316     (emit-move-from-stack target representation)
     2317     (return-from compile-constant))))
    22532318  (cond ((fixnump form)
    22542319         (let ((translation (case form
Note: See TracChangeset for help on using the changeset viewer.