Changeset 11626


Ignore:
Timestamp:
02/05/09 19:40:13 (13 years ago)
Author:
ehuelsmann
Message:

Final and last fix for COERCE.20 and the issue with printing double floats.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/format.lisp

    r11625 r11626  
    254254
    255255
    256 (eval-when (:compile-toplevel :execute)
    257     ;; the code below needs to its floats to be read as long-floats
    258     (defvar *saved-default-float-format* *read-default-float-format*)
    259     (setf *read-default-float-format* 'double-float))
    260 
    261256(defun scale-exponent (original-x)
    262257  (let* ((x (coerce original-x 'long-float)))
    263258    (multiple-value-bind (sig exponent) (decode-float x)
    264259      (declare (ignore sig))
    265       (if (= x 0.0e0)
    266     (values (float 0.0e0 original-x) 1)
     260      (if (= x 0.0l0)
     261    (values (float 0.0l0 original-x) 1)
    267262    (let* ((ex (locally (declare (optimize (safety 0)))
    268263                       (the fixnum
    269                             (round (* exponent (log 2e0 10))))))
     264                            (round (* exponent (log 2l0 10))))))
    270265     (x (if (minusp ex)
    271266      (if (float-denormalized-p x)
    272           (* x 1.0e16 (expt 10.0e0 (- (- ex) 16)))
    273           (* x 10.0e0 (expt 10.0e0 (- (- ex) 1))))
    274       (/ x 10.0e0 (expt 10.0e0 (1- ex))))))
    275       (do ((d 10.0e0 (* d 10.0e0))
     267          (* x 1.0l16 (expt 10.0l0 (- (- ex) 16)))
     268          (* x 10.0l0 (expt 10.0l0 (- (- ex) 1))))
     269      (/ x 10.0l0 (expt 10.0l0 (1- ex))))))
     270      (do ((d 10.0l0 (* d 10.0l0))
    276271     (y x (/ x d))
    277272     (ex ex (1+ ex)))
    278     ((< y 1.0e0)
    279      (do ((m 10.0e0 (* m 10.0e0))
     273    ((< y 1.0l0)
     274     (do ((m 10.0l0 (* m 10.0l0))
    280275          (z y (* y m))
    281276          (ex ex (1- ex)))
    282          ((>= z 0.1e0)
     277         ((>= z 0.1l0)
    283278          (values (float z original-x) ex))
    284279                   (declare (long-float m) (integer ex))))
     
    28742869(setf sys::*simple-format-function* #'format)
    28752870
    2876 (eval-when (:compile-toplevel :execute)
    2877     ;; the code below needs to its floats to be read as long-floats
    2878     (setf *read-default-float-format* *saved-default-float-format*))
    2879 
    28802871
    28812872(provide 'format)
Note: See TracChangeset for help on using the changeset viewer.