Skip to content
Snippets Groups Projects
Commit bbb89ea5 authored by rtoy's avatar rtoy
Browse files

compiler/float-tran.lisp:

o Change the following functions to be maybe-inline instead of inline
  so we don't inline them by default unless the user says so by
  specifying (SPACE 0): ADD-DD, MUL-DD-D, MUL-DD, ADD-DD-D, SQR-DD,
  DIV-DD, DIV-DD-D, SQRT-DD

code/irrat-dd.lisp:
o Set (SPACE 0) for these functions so we inline the operations.
  (Should we really inline all of these?)
parent 3aacb9a4
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat-dd.lisp,v 1.2 2006/06/30 18:41:22 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat-dd.lisp,v 1.3 2006/07/07 18:26:43 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -79,7 +79,8 @@ ...@@ -79,7 +79,8 @@
;; Evaluate polynomial ;; Evaluate polynomial
(defun poly-eval (x coef) (defun poly-eval (x coef)
(declare (type double-double-float x) (declare (type double-double-float x)
(type (simple-array double-double-float (*)) coef)) (type (simple-array double-double-float (*)) coef)
(optimize (speed 3) (space 0)))
;; y = C0 + C1*x + C2*x^2 + ... ;; y = C0 + C1*x + C2*x^2 + ...
;; ;;
;; But coefficients are stored in reverse (descending powers) order: ;; But coefficients are stored in reverse (descending powers) order:
...@@ -93,7 +94,8 @@ ...@@ -93,7 +94,8 @@
(defun poly-eval-1 (x coef) (defun poly-eval-1 (x coef)
(declare (type double-double-float x) (declare (type double-double-float x)
(type (simple-array double-double-float (*)) coef)) (type (simple-array double-double-float (*)) coef)
(optimize (speed 3) (space 0)))
;; Like poly-eval, except it assumes coef[N] = 1 and is omitted. ;; Like poly-eval, except it assumes coef[N] = 1 and is omitted.
(let ((y 1w0)) (let ((y 1w0))
(declare (type double-double-float y)) (declare (type double-double-float y))
...@@ -153,7 +155,7 @@ ...@@ -153,7 +155,7 @@
(defun dd-%expm1 (x) (defun dd-%expm1 (x)
"exp(x) - 1" "exp(x) - 1"
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
;; Range reduction is accomplished by separating the argument ;; Range reduction is accomplished by separating the argument
;; into an integer k and fraction f such that ;; into an integer k and fraction f such that
;; ;;
...@@ -282,7 +284,7 @@ ...@@ -282,7 +284,7 @@
;; relative error = 2.2e-37, relative peak error spread = 9.2e-38. ;; relative error = 2.2e-37, relative peak error spread = 9.2e-38.
(defun dd-%exp (x) (defun dd-%exp (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(when (> x max-log) (when (> x max-log)
(return-from dd-%exp (return-from dd-%exp
(kernel:%make-double-double-float #.ext:double-float-positive-infinity (kernel:%make-double-double-float #.ext:double-float-positive-infinity
...@@ -394,7 +396,7 @@ ...@@ -394,7 +396,7 @@
;; ;;
(defun dd-%log (x) (defun dd-%log (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
;; Separate mantissa from exponent ;; Separate mantissa from exponent
(multiple-value-bind (x e) (multiple-value-bind (x e)
(decode-float x) (decode-float x)
...@@ -517,7 +519,8 @@ ...@@ -517,7 +519,8 @@
;; Theoretical peak relative error = 5.3e-37, ;; Theoretical peak relative error = 5.3e-37,
;; relative peak error spread = 2.3e-14 ;; relative peak error spread = 2.3e-14
(defun dd-%log1p (xm1) (defun dd-%log1p (xm1)
(declare (type double-double-float xm1)) (declare (type double-double-float xm1)
(optimize (space 0)))
(let ((x (+ xm1 1)) (let ((x (+ xm1 1))
(z 0w0) (z 0w0)
(y 0w0)) (y 0w0))
...@@ -584,7 +587,7 @@ ...@@ -584,7 +587,7 @@
3.889701475261939961851358705515223019890w14)))) 3.889701475261939961851358705515223019890w14))))
(defun dd-%sinh (x) (defun dd-%sinh (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(let ((a (abs x))) (let ((a (abs x)))
(declare (type double-double-float a)) (declare (type double-double-float a))
(cond ((> a 1) (cond ((> a 1)
...@@ -618,7 +621,8 @@ ...@@ -618,7 +621,8 @@
(* 0.5w0 (+ d (/ d (+ 1 d))))))))) (* 0.5w0 (+ d (/ d (+ 1 d)))))))))
(defun dd-%cosh (x) (defun dd-%cosh (x)
(declare (type double-double-float x)) (declare (type double-double-float x)
(optimize (speed 3) (space 0)))
(let ((y (dd-%exp x))) (let ((y (dd-%exp x)))
(scale-float (+ y (/ y)) -1))) (scale-float (+ y (/ y)) -1)))
...@@ -640,7 +644,7 @@ ...@@ -640,7 +644,7 @@
1.365413143842835040443257277862054198329w8)))) 1.365413143842835040443257277862054198329w8))))
(defun dd-%tanh (x) (defun dd-%tanh (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(let ((z (abs x))) (let ((z (abs x)))
(declare (type double-double-float z)) (declare (type double-double-float z))
(cond ((> z (* 0.5w0 max-log)) (cond ((> z (* 0.5w0 max-log))
...@@ -690,7 +694,7 @@ ...@@ -690,7 +694,7 @@
)))) ))))
(defun dd-%atanh (x) (defun dd-%atanh (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(cond ((minusp x) (cond ((minusp x)
(- (the double-double-float (dd-%atanh (- x))))) (- (the double-double-float (dd-%atanh (- x)))))
((< x 1w-12) ((< x 1w-12)
...@@ -730,7 +734,7 @@ ...@@ -730,7 +734,7 @@
6.226145049170155830806967678679167550122w4)))) 6.226145049170155830806967678679167550122w4))))
(defun dd-%asinh (x) (defun dd-%asinh (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(cond ((minusp x) (cond ((minusp x)
(- (the double-double-float (dd-%asinh (- x))))) (- (the double-double-float (dd-%asinh (- x)))))
#+nil #+nil
...@@ -772,7 +776,7 @@ ...@@ -772,7 +776,7 @@
)))) ))))
(defun dd-%acosh (x) (defun dd-%acosh (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(cond ((> x 1w17) (cond ((> x 1w17)
(+ loge2 (dd-%log x))) (+ loge2 (dd-%log x)))
(t (t
...@@ -813,7 +817,7 @@ ...@@ -813,7 +817,7 @@
)))) ))))
(defun dd-%asin (x) (defun dd-%asin (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(cond ((minusp x) (cond ((minusp x)
(- (the double-double-float (dd-%asin (- x))))) (- (the double-double-float (dd-%asin (- x)))))
#+nil #+nil
...@@ -843,7 +847,7 @@ ...@@ -843,7 +847,7 @@
(defun dd-%acos (x) (defun dd-%acos (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(cond ((< x -0.5w0) (cond ((< x -0.5w0)
(- dd-pi (- dd-pi
(* 2 (dd-%asin (sqrt (* 0.5w0 (+ 1 x))))))) (* 2 (dd-%asin (sqrt (* 0.5w0 (+ 1 x)))))))
...@@ -884,7 +888,7 @@ ...@@ -884,7 +888,7 @@
(declare (type double-double-float t3p8 tp8)) (declare (type double-double-float t3p8 tp8))
(defun dd-%atan (x) (defun dd-%atan (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(when (minusp x) (when (minusp x)
(return-from dd-%atan (- (the double-double-float (dd-%atan (- x)))))) (return-from dd-%atan (- (the double-double-float (dd-%atan (- x))))))
;; range reduction ;; range reduction
...@@ -910,7 +914,7 @@ ...@@ -910,7 +914,7 @@
(defun dd-%atan2 (y x) (defun dd-%atan2 (y x)
(declare (type double-double-float x y) (declare (type double-double-float x y)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(let ((code 0) (let ((code 0)
(w 0w0)) (w 0w0))
(declare (type (integer 0 3) code) (declare (type (integer 0 3) code)
...@@ -1024,7 +1028,8 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1024,7 +1028,8 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
(scale-float (float #b0111101111100101010001100110110011110011010011101001000011000110110011000000101011000010100110110111110010 1w0) (* 4 -106))) (scale-float (float #b0111101111100101010001100110110011110011010011101001000011000110110011000000101011000010100110110111110010 1w0) (* 4 -106)))
(defun dd-%sin (x) (defun dd-%sin (x)
(declare (type double-double-float x)) (declare (type double-double-float x)
(optimize (speed 3) (space 0)))
(when (minusp x) (when (minusp x)
(return-from dd-%sin (- (the double-double-float (dd-%sin (- x)))))) (return-from dd-%sin (- (the double-double-float (dd-%sin (- x))))))
;; y = integer part of x/(pi/4). ;; y = integer part of x/(pi/4).
...@@ -1061,7 +1066,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1061,7 +1066,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
(defun dd-%cos (x) (defun dd-%cos (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(when (minusp x) (when (minusp x)
(return-from dd-%cos (dd-%cos (- x)))) (return-from dd-%cos (dd-%cos (- x))))
;; y = integer part of x/(pi/4). ;; y = integer part of x/(pi/4).
...@@ -1125,7 +1130,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1125,7 +1130,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
)))) ))))
(defun dd-tancot (xx cotflag) (defun dd-tancot (xx cotflag)
(declare (type double-double-float xx) (declare (type double-double-float xx)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(let ((x 0w0) (let ((x 0w0)
(sign 1)) (sign 1))
(declare (type double-double-float x) (declare (type double-double-float x)
...@@ -1237,7 +1242,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1237,7 +1242,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
)))) ))))
(defun dd-%log2 (x) (defun dd-%log2 (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(multiple-value-bind (x e) (multiple-value-bind (x e)
(decode-float x) (decode-float x)
(declare (type double-double-float x) (declare (type double-double-float x)
...@@ -1305,7 +1310,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1305,7 +1310,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
)))) ))))
(defun dd-%exp2 (x) (defun dd-%exp2 (x)
(declare (type double-double-float x) (declare (type double-double-float x)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(when (>= x 1024w0) (when (>= x 1024w0)
(return-from dd-%exp2 (return-from dd-%exp2
(%make-double-double-float ext:double-float-positive-infinity (%make-double-double-float ext:double-float-positive-infinity
...@@ -1327,7 +1332,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1327,7 +1332,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
(defun dd-%powil (x nn) (defun dd-%powil (x nn)
(declare (type double-double-float x) (declare (type double-double-float x)
(fixnum nn) (fixnum nn)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(when (zerop x) (when (zerop x)
(return-from dd-%powil (return-from dd-%powil
(cond ((zerop nn) (cond ((zerop nn)
...@@ -1415,7 +1420,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010 ...@@ -1415,7 +1420,7 @@ pi/4 11001001000011111101101010100010001000010110100011000 010001101001100010
(defun dd-real-pow (x y) (defun dd-real-pow (x y)
(declare (type double-double-float x y) (declare (type double-double-float x y)
(optimize (speed 3))) (optimize (speed 3) (space 0)))
(let ((nflg 0) (let ((nflg 0)
(w (floor y))) (w (floor y)))
;; nflg = 1 if x < 0 raised to integer power ;; nflg = 1 if x < 0 raised to integer power
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.106 2006/07/07 15:11:32 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.107 2006/07/07 18:26:43 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1586,7 +1586,7 @@ ...@@ -1586,7 +1586,7 @@
(- b v)))) (- b v))))
(values s e))) (values s e)))
(declaim (inline add-dd)) (declaim (maybe-inline add-dd))
(defun add-dd (a0 a1 b0 b1) (defun add-dd (a0 a1 b0 b1)
"Add the double-double A0,A1 to the double-double B0,B1" "Add the double-double A0,A1 to the double-double B0,B1"
(declare (double-float a0 a1 b0 b1) (declare (double-float a0 a1 b0 b1)
...@@ -1791,7 +1791,7 @@ ...@@ -1791,7 +1791,7 @@
(* 2 a-hi a-lo)) (* 2 a-hi a-lo))
(* a-lo a-lo)))))) (* a-lo a-lo))))))
(declaim (inline mul-dd-d)) (declaim (maybe-inline mul-dd-d))
(defun mul-dd-d (a0 a1 b) (defun mul-dd-d (a0 a1 b)
(declare (double-float a0 a1 b) (declare (double-float a0 a1 b)
(optimize (speed 3))) (optimize (speed 3)))
...@@ -1803,7 +1803,7 @@ ...@@ -1803,7 +1803,7 @@
;;(format t "mul-dd-d p2 = ~A~%" p2) ;;(format t "mul-dd-d p2 = ~A~%" p2)
(quick-two-sum p1 p2))) (quick-two-sum p1 p2)))
(declaim (inline mul-dd)) (declaim (maybe-inline mul-dd))
(defun mul-dd (a0 a1 b0 b1) (defun mul-dd (a0 a1 b0 b1)
"Multiply the double-double A0,A1 with B0,B1" "Multiply the double-double A0,A1 with B0,B1"
(declare (double-float a0 a1 b0 b1) (declare (double-float a0 a1 b0 b1)
...@@ -1817,7 +1817,7 @@ ...@@ -1817,7 +1817,7 @@
(quick-two-sum p1 p2) (quick-two-sum p1 p2)
(values p1 p2)))) (values p1 p2))))
(declaim (inline add-dd-d)) (declaim (maybe-inline add-dd-d))
(defun add-dd-d (a0 a1 b) (defun add-dd-d (a0 a1 b)
"Add the double-double A0,A1 to the double B" "Add the double-double A0,A1 to the double B"
(declare (double-float a0 a1 b) (declare (double-float a0 a1 b)
...@@ -1828,7 +1828,7 @@ ...@@ -1828,7 +1828,7 @@
(incf s2 a1) (incf s2 a1)
(quick-two-sum s1 s2))) (quick-two-sum s1 s2)))
(declaim (inline sqr-dd)) (declaim (maybe-inline sqr-dd))
(defun sqr-dd (a0 a1) (defun sqr-dd (a0 a1)
(declare (double-float a0 a1) (declare (double-float a0 a1)
(optimize (speed 3))) (optimize (speed 3)))
...@@ -1900,7 +1900,7 @@ ...@@ -1900,7 +1900,7 @@
(float a 1d0)) (float a 1d0))
(kernel:%make-double-double-float hi lo))) (kernel:%make-double-double-float hi lo)))
(declaim (inline div-dd)) (declaim (maybe-inline div-dd))
(defun div-dd (a0 a1 b0 b1) (defun div-dd (a0 a1 b0 b1)
"Divide the double-double A0,A1 by B0,B1" "Divide the double-double A0,A1 by B0,B1"
(declare (double-float a0 a1 b0 b1) (declare (double-float a0 a1 b0 b1)
...@@ -1928,7 +1928,7 @@ ...@@ -1928,7 +1928,7 @@
(quick-two-sum q1 q2) (quick-two-sum q1 q2)
(add-dd-d q1 q2 q3)))))))))) (add-dd-d q1 q2 q3))))))))))
(declaim (inline div-dd-d)) (declaim (maybe-inline div-dd-d))
(defun div-dd-d (a0 a1 b) (defun div-dd-d (a0 a1 b)
(declare (double-float a0 a1 b) (declare (double-float a0 a1 b)
(optimize (speed 3))) (optimize (speed 3)))
...@@ -1969,7 +1969,7 @@ ...@@ -1969,7 +1969,7 @@
(defun mul-d-d (a b) (defun mul-d-d (a b)
(two-prod a b)) (two-prod a b))
(declaim (inline sqrt-dd)) (declaim (maybe-inline sqrt-dd))
(defun sqrt-dd (a0 a1) (defun sqrt-dd (a0 a1)
(declare (type (double-float 0d0) a0) (declare (type (double-float 0d0) a0)
(double-float a1) (double-float a1)
......
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