[oct-cvs] Oct commit: oct qd-io.lisp

rtoy rtoy at common-lisp.net
Mon Sep 24 02:37:31 UTC 2007


Update of /project/oct/cvsroot/oct
In directory clnet:/tmp/cvs-serv23811

Modified Files:
	qd-io.lisp 
Log Message:
Use more bits (265 instead of 212) when converting a rational to a
quad-double.  This fixes the issue that converting 10^100 to a
quad-double isn't as accurate as it could be.


--- /project/oct/cvsroot/oct/qd-io.lisp	2007/09/12 02:31:14	1.15
+++ /project/oct/cvsroot/oct/qd-io.lisp	2007/09/24 02:37:31	1.16
@@ -340,29 +340,25 @@
 		   (neg-qd (mul-qd xx yy))
 		   (mul-qd xx yy))))
 	    (t
-	     (let* #+nil
-	       ((hi (ldb (byte 106 (cl:- len 106)) int))
-		(lo (ldb (byte 106 (cl:- len 212)) int))
-		(xx (make-qd-dd (cl:* sign (scale-float (float hi 1w0)
-							(cl:- len 106)))
-				(cl:* sign (scale-float (float lo 1w0)
-							(cl:- len 106 106)))))
-		(yy (npow (make-qd-d 10d0)
-			  power)))
-	       ((q0 (ldb (byte 53 (cl:- len 53)) int))
-		(q1 (ldb (byte 53 (cl:- len (* 2 53))) int))
-		(q2 (ldb (byte 53 (cl:- len (* 3 53))) int))
-		(q3 (ldb (byte 53 (cl:- len (* 4 53))) int))
-		(xx (make-qd-d (scale-float (float q0 1d0)
-					    (cl:- len 53))
-			       (scale-float (float q1 1d0)
-					    (cl:- len (* 2 53)))
-			       (scale-float (float q2 1d0)
-					    (cl:- len (* 3 53)))
-			       (scale-float (float q3 1d0)
-					    (cl:- len (* 4 53)))))
-		(yy (npow (make-qd-d 10d0)
-			  power)))
+	     (let* 
+		 ((q0 (ldb (byte 53 (cl:- len 53)) int))
+		  (q1 (ldb (byte 53 (cl:- len (* 2 53))) int))
+		  (q2 (ldb (byte 53 (cl:- len (* 3 53))) int))
+		  (q3 (ldb (byte 53 (cl:- len (* 4 53))) int))
+		  (q4 (ldb (byte 53 (cl:- len (* 5 53))) int))
+		  (xx (multiple-value-call #'%make-qd-d
+			(renorm-5 (scale-float (float q0 1d0)
+					       (cl:- len 53))
+				  (scale-float (float q1 1d0)
+					       (cl:- len (* 2 53)))
+				  (scale-float (float q2 1d0)
+					       (cl:- len (* 3 53)))
+				  (scale-float (float q3 1d0)
+					       (cl:- len (* 4 53)))
+				  (scale-float (float q4 1d0)
+					       (cl:- len (* 5 53))))))
+		  (yy (npow (make-qd-d 10d0)
+			    power)))
 	       #+(or)
 	       (progn
 		 (format t "xx = ~A~%" xx)




More information about the oct-cvs mailing list