Skip to content
Snippets Groups Projects
Commit b82f05d5 authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix ticket:80

 * Increase the size of *powers-of-ten* a bit.
 * In expt-ten, handle the case where the exponent exceeds the size of
   the *powers-of-ten* array.
parent c94b32f9
No related branches found
No related tags found
No related merge requests found
...@@ -1837,12 +1837,12 @@ radix-R. If you have a power-list then pass it in as PL." ...@@ -1837,12 +1837,12 @@ radix-R. If you have a power-list then pass it in as PL."
;; Exact powers of ten. Must be large enough to cover the range from ;; Exact powers of ten. Must be large enough to cover the range from
;; least-positive-double-float to most-positive-double-float ;; least-positive-double-float to most-positive-double-float
(declaim (type (simple-array integer (326)) *powers-of-ten*)) (declaim (type (simple-array integer (400)) *powers-of-ten*))
(defparameter *powers-of-ten* (defparameter *powers-of-ten*
(make-array 326 (make-array 400
:initial-contents :initial-contents
(let (p) (let (p)
(dotimes (k 326 (nreverse p)) (dotimes (k 400 (nreverse p))
(push (expt 10 k) p))))) (push (expt 10 k) p)))))
;;; Implementation of Figure 1 from "Printing Floating-Point Numbers ;;; Implementation of Figure 1 from "Printing Floating-Point Numbers
...@@ -1957,9 +1957,11 @@ radix-R. If you have a power-list then pass it in as PL." ...@@ -1957,9 +1957,11 @@ radix-R. If you have a power-list then pass it in as PL."
m- 1))) m- 1)))
(when position (when position
(flet ((expt-ten (e) (flet ((expt-ten (e)
(if (minusp e) (if (> (abs e) (length *powers-of-ten*))
(/ (aref *powers-of-ten* (- e))) (expt 10 e)
(aref *powers-of-ten* e)))) (if (minusp e)
(/ (aref *powers-of-ten* (- e)))
(aref *powers-of-ten* e)))))
(when relativep (when relativep
(let ((r+m (+ r m+))) (let ((r+m (+ r m+)))
;;(format t "r, s = ~A, ~A~%" r s) ;;(format t "r, s = ~A, ~A~%" r s)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment