Ignore:
Timestamp:
01/19/09 09:36:06 (13 years ago)
Author:
ehuelsmann
Message:

Eliminate float-serializing ambiguities: if you need a float/double, store one
(instead of reading it from a string).

File:
1 edited

Legend:

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

    r11564 r11569  
    130130  (pool-get (list 3 n)))
    131131
     132(defknown pool-float (single-float) (integer 1 65535))
     133(defun pool-float (n)
     134  (declare (optimize speed))
     135  (pool-get (list 4 (%float-bits n))))
     136
    132137(defknown pool-long (integer) (integer 1 65535))
    133138(defun pool-long (n)
     
    153158    index))
    154159
     160(defknown pool-double (double-float) (integer 1 65535))
     161(defun pool-double (n)
     162  (declare (optimize speed))
     163  (let* ((n (%float-bits n))
     164         (entry (list 6
     165                      (logand (ash n -32) #xffffffff)
     166                      (logand n #xffffffff)))
     167         (ht *pool-entries*)
     168         (index (gethash1 entry ht)))
     169    (declare (type hash-table ht))
     170    (unless index
     171      (setf index *pool-count*)
     172      (push entry *pool*)
     173      (setf (gethash entry ht) index)
     174      ;; The Java Virtual Machine Specification, Section 4.4.5: "All 8-byte
     175      ;; constants take up two entries in the constant_pool table of the class
     176      ;; file. If a CONSTANT_Long_info or CONSTANT_Double_info structure is the
     177      ;; item in the constant_pool table at index n, then the next usable item in
     178      ;; the pool is located at index n+2. The constant_pool index n+1 must be
     179      ;; valid but is considered unusable." So:
     180      (setf *pool-count* (+ index 2)))
     181    index))
     182
    155183(defknown u2 (fixnum) cons)
    156184(defun u2 (n)
     
    200228(defconstant +lisp-bignum-class+ "org/armedbear/lisp/Bignum")
    201229(defconstant +lisp-bignum+ "Lorg/armedbear/lisp/Bignum;")
     230(defconstant +lisp-single-float-class+ "org/armedbear/lisp/SingleFloat")
     231(defconstant +lisp-single-float+ "Lorg/armedbear/lisp/SingleFloat;")
     232(defconstant +lisp-double-float-class+ "org/armedbear/lisp/DoubleFloat")
     233(defconstant +lisp-double-float+ "Lorg/armedbear/lisp/DoubleFloat;")
    202234(defconstant +lisp-character-class+ "org/armedbear/lisp/LispCharacter")
    203235(defconstant +lisp-character+ "Lorg/armedbear/lisp/LispCharacter;")
     
    15541586  (declare (type (unsigned-byte 16) n))
    15551587  (declare (type stream stream))
    1556   (write-8-bits (ash n -8) stream)
     1588  (write-8-bits (logand (ash n -8) #xFF) stream)
    15571589  (write-8-bits (logand n #xFF) stream))
    15581590
     
    15611593  (declare (optimize speed))
    15621594  (declare (type (unsigned-byte 32) n))
    1563   (write-u2 (ash n -16) stream)
     1595  (write-u2 (logand (ash n -16) #xFFFF) stream)
    15641596  (write-u2 (logand n #xFFFF) stream))
    15651597
     
    16311663      (1 ; UTF8
    16321664       (write-utf8 (third entry) stream))
    1633       (3 ; int
    1634        (write-s4 (second entry) stream))
    1635       ((5 6)
     1665      ((3 4) ; int
     1666       (write-u4 (second entry) stream))
     1667      ((5 6) ; long double
    16361668       (write-u4 (second entry) stream)
    16371669       (write-u4 (third entry) stream))
    1638       ((9 10 11 12)
     1670      ((9 10 11 12) ; fieldref methodref InterfaceMethodref nameAndType
    16391671       (write-u2 (second entry) stream)
    16401672       (write-u2 (third entry) stream))
    1641       ((7 8)
     1673      ((7 8) ; class string
    16421674       (write-u2 (second entry) stream))
    16431675      (t
     
    20142046      (setf *static-code* *code*))))
    20152047   (setf (gethash n ht) g)))
     2048
     2049(defknown declare-float (single-float) string)
     2050(defun declare-float (s)
     2051  (declare-with-hashtable
     2052   s *declared-floats* ht g
     2053   (let* ((*code* *static-code*))
     2054     (setf g (concatenate 'string "FLOAT_" (symbol-name (gensym))))
     2055     (declare-field g +lisp-single-float+)
     2056     (emit 'new +lisp-single-float-class+)
     2057     (emit 'dup)
     2058     (emit 'ldc (pool-float s))
     2059     (emit-invokespecial-init +lisp-single-float-class+ '("F"))
     2060     (emit 'putstatic *this-class* g +lisp-single-float+)
     2061     (setf *static-code* *code*))
     2062   (setf (gethash s ht) g)))
     2063
     2064(defknown declare-double (double-float) string)
     2065(defun declare-double (d)
     2066  (declare-with-hashtable
     2067   d *declared-doubles* ht g
     2068   (let ((*code* *static-code*))
     2069     (setf g (concatenate 'string "DOUBLE_" (symbol-name (gensym))))
     2070     (declare-field g +lisp-double-float+)
     2071     (emit 'new +lisp-double-float-class+)
     2072     (emit 'dup)
     2073     (emit 'ldc2_w (pool-double d))
     2074     (emit-invokespecial-init +lisp-double-float-class+ '("D"))
     2075     (emit 'putstatic *this-class* g +lisp-double-float+)
     2076     (setf *static-code* *code*))
     2077   (setf (gethash d ht) g)))
    20162078
    20172079(defknown declare-character (t) string)
     
    22022264         ;; A bignum.
    22032265         (emit 'getstatic *this-class* (declare-bignum form) +lisp-bignum+))
     2266        ((typep form 'single-float)
     2267         (emit 'getstatic *this-class*
     2268               (declare-float form) +lisp-single-float+))
     2269        ((typep form 'double-float)
     2270         (emit 'getstatic *this-class*
     2271               (declare-double form) +lisp-double-float+))
    22042272        ((numberp form)
    22052273         ;; A number, but not a fixnum.
Note: See TracChangeset for help on using the changeset viewer.