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

[rtoy]

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

Modified Files:
      Tag: THREE-ARG-BRANCH
	qd-rep.lisp qd.lisp 
Log Message:
o Move compiler macros from qd.lisp to qd-rep.lisp
o Declare add-qd-t, mul-qd-t and div-qd-t as inline functions so that
  everything is still fast on cmucl.


--- /project/oct/cvsroot/oct/qd-rep.lisp	2007/11/02 20:45:32	1.10.2.2
+++ /project/oct/cvsroot/oct/qd-rep.lisp	2007/11/04 02:45:01	1.10.2.3
@@ -233,3 +233,28 @@
   (declare (ignore x))
   nil)
 ) ; end progn
+
+
+(macrolet
+    ((frob (qd qd-t)
+       #+cmu
+       `(define-compiler-macro ,qd (a b &optional c)
+	  (if c
+	      `(setf ,c (,',qd-t ,a ,b nil))
+	      `(,',qd-t ,a ,b nil)))
+       #-cmu
+       `(define-compiler-macro ,qd (a b &optional (c (%make-qd-d 0d0 0d0 0d0 0d0)))
+	  `(,',qd-t ,a ,b ,c))))
+  (frob add-qd add-qd-t)
+  (frob mul-qd mul-qd-t)
+  (frob div-qd div-qd-t))
+
+#+cmu
+(define-compiler-macro sub-qd (a b &optional c)
+  (if c
+      `(setf ,c (add-qd-t ,a (neg-qd ,b) nil))
+      `(add-qd-t ,a (neg-qd ,b) nil)))
+
+#-cmu
+(define-compiler-macro sub-qd (a b &optional c)
+  `(add-qd-t ,a (neg-qd ,b) ,c))
--- /project/oct/cvsroot/oct/qd.lisp	2007/11/02 20:11:42	1.60.2.1
+++ /project/oct/cvsroot/oct/qd.lisp	2007/11/04 02:45:01	1.60.2.2
@@ -161,11 +161,14 @@
 	 add-qd-d
 	 add-qd-dd
 	 add-qd
+	 add-qd-t
 	 mul-qd-d
 	 mul-qd-dd
 	 mul-qd
+	 mul-qd-t
 	 sqr-qd
 	 div-qd
+	 div-qd-t
 	 div-qd-d
 	 div-qd-dd))
 
@@ -187,6 +190,7 @@
 			  mul-qd-t
 			  sqr-qd
 			  div-qd div-qd-d div-qd-dd
+			  div-qd-t
 			  make-qd-dd
 			  ))
 
@@ -394,7 +398,9 @@
 (defun add-qd-t (a b target)
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
-		     (space 0)))
+		     (space 0))
+	   #+cmu
+	   (ignore target))
   ;; This is the version that is NOT IEEE.  Should we use the IEEE
   ;; version?  It's quite a bit more complicated.
   ;;
@@ -454,16 +460,6 @@
 ;; directly.  For CMU, we always replace the parameter C with NIL
 ;; because we don't use it.  For other Lisps, we create the necessary
 ;; object and call add-qd-t.
-#+cmu
-(define-compiler-macro add-qd (a b &optional c)
-  (if c
-      `(setf c (add-qd-t ,a ,b nil))
-      `(add-qd-t ,a ,b nil)))
-
-#-cmu
-(define-compiler-macro add-qd (a b &optional (c (%make-qd-d 0d0 0d0 0d0 0d0)))
-  `(add-qd-t ,a ,b ,c))
-
 (defun neg-qd (a)
   (declare (type %quad-double a))
   (with-qd-parts (a0 a1 a2 a3)
@@ -476,16 +472,6 @@
   (add-qd-t a (neg-qd b) target))
 
 #+cmu
-(define-compiler-macro sub-qd (a b &optional c)
-  (if c
-      `(setf ,c `(add-qd-t ,a (neg-qd ,b) nil))
-      `(add-qd-t ,a (neg-qd ,b) nil)))
-
-#-cmu
-(define-compiler-macro sub-qd (a b &optional (c (%make-qd-d 0d0 0d0 0d0 0d0)))
-  `(add-qd-t ,a (neg-qd ,b) ,c))
-
-#+cmu
 (defun sub-qd-dd (a b)
   (declare (type %quad-double a)
 	   (type double-double-float b))
@@ -699,16 +685,6 @@
 			    (%store-qd-d target p0 0d0 0d0 0d0)
 			    (%store-qd-d target r0 r1 s0 s1))))))))))))))
 
-#+cmu
-(define-compiler-macro mul-qd (a b &optional c)
-  (if c
-      `(setf ,c `(mul-qd-t ,a ,b nil))
-      `(mul-qd-t ,a ,b nil)))
-
-#-cmu
-(define-compiler-macro mul-qd (a b &optional (c (%make-qd-d 0d0 0d0 0d0 0d0)))
-  `(mul-qd-t ,a ,b ,c))
-
 
 ;; This is the non-sloppy version.  I think this works just fine, but
 ;; since qd defaults to the sloppy multiplication version, we do the
@@ -865,7 +841,9 @@
   (declare (type %quad-double a b)
 	   (optimize (speed 3)
 		     (space 0))
-	   (inline float-infinity-p))
+	   (inline float-infinity-p)
+	   #+cmu
+	   (ignore target))
   (let ((a0 (qd-0 a))
 	(b0 (qd-0 b)))
     (let* ((q0 (cl:/ a0 b0))
@@ -882,17 +860,6 @@
 	      (renorm-4 q0 q1 q2 q3)
 	    (%store-qd-d target q0 q1 q2 q3)))))))
 
-#+cmu
-(define-compiler-macro div-qd (a b &optional c)
-  (if c
-      `(setf ,c `(div-qd-t ,a ,b nil))
-      `(div-qd-t ,a ,b nil)))
-
-#-cmu
-(define-compiler-macro div-qd (a b &optional (c (%make-qd-d 0d0 0d0 0d0 0d0)))
-  `(div-qd-t ,a ,b ,c))
-
-
 (declaim (inline invert-qd))
 
 (defun invert-qd(v) ;; a quartic newton iteration for 1/v