math: conform ROUND-TO-ODD to other operations

Name and parameter order.

code/liebler/implementation.lisp

@@ -35,8 +35,8 @@
                     :operation 'quaviver:integer-float
                     :operands (list ,client ',result-type 10
                                     ,significand ,exponent ,sign)))
-           (setf ,significand (,round-to-odd (,expt10 (- ,exponent))
-                                             (ash ,significand shift))
+           (setf ,significand (,round-to-odd (ash ,significand shift)
+                                             (,expt10 (- ,exponent)))
                  k (- k -1 shift)
                  shift (- ,significand-size (integer-length ,significand)))
            (quaviver:integer-float ,client ',result-type 2
@@ -49,19 +49,19 @@
   (%liebler client single-float
             significand exponent sign
             quaviver/math:expt10/32
-            quaviver/math:round-to-odd/32))
+            quaviver/math:round-to-odd/32-64))
 
 (defmethod quaviver:integer-float
     ((client client) (result-type (eql 'double-float)) (base (eql 10)) significand exponent sign)
   (%liebler client double-float
             significand exponent sign
             quaviver/math:expt10/64
-            quaviver/math:round-to-odd/64))
+            quaviver/math:round-to-odd/64-128))
 
 #+quaviver/long-float
 (defmethod quaviver:integer-float
     ((client client) (result-type (eql 'long-float)) (base (eql 10)) significand exponent sign)
   (%liebler client long-float
             significand exponent sign
             quaviver/math:expt10/128
-            quaviver/math:round-to-odd/128))
+            quaviver/math:round-to-odd/128-256))

code/math/implementation.lisp

@@ -131,17 +131,15 @@
 
 ;;; Rest
 
-(declaim (ftype (function ((unsigned-byte 64) (unsigned-byte 32))
+(declaim (ftype (function ((unsigned-byte 32) (arithmetic-word 32 2))
                           (unsigned-byte 32))
-                round-to-odd/32)
-         (ftype (function (#+quaviver/bignum-elision (simple-array (unsigned-byte 64) (2))
-                           #-quaviver/bignum-elision (unsigned-byte 128)
-                           (unsigned-byte 64))
+                round-to-odd/32-64)
+         (ftype (function ((unsigned-byte 64) (arithmetic-word 64 2))
                           (unsigned-byte 64))
-                round-to-odd/64)
-         (ftype (function ((unsigned-byte 256) (unsigned-byte 128))
+                round-to-odd/64-128)
+         (ftype (function ((unsigned-byte 128) (arithmetic-word 128 2))
                           (unsigned-byte 128))
-                round-to-odd/128)
+                round-to-odd/128-256)
          (ftype (function ((unsigned-byte 32) (arithmetic-word 32 2) &optional (integer 0 (32)))
                           (values (unsigned-byte 32) boolean &optional))
                 floor-multiply/32-64q64)
@@ -154,19 +152,17 @@
          (ftype (function ((unsigned-byte 64) (arithmetic-word 64 2) &optional (integer 0 (64)))
                           (values boolean boolean &optional))
                 floor-multiply/evenp/64-128q128)
-         (ftype (function (fixnum) (unsigned-byte 64))
+         (ftype (function (fixnum) (arithmetic-word 32 2))
                 expt10/32)
-         (ftype (function (fixnum)
-                          #+quaviver/bignum-elision (simple-array (unsigned-byte 64) (2))
-                          #-quaviver/bignum-elision (unsigned-byte 128))
+         (ftype (function (fixnum) (arithmetic-word 64 2))
                 expt10/64)
-         (ftype (function (fixnum) (unsigned-byte 256))
+         (ftype (function (fixnum) (arithmetic-word 128 2))
                 expt10/128)
          (ftype (function (fixnum fixnum fixnum &optional boolean) fixnum)
                 floor-log-expt ceiling-log-expt)
-         (inline round-to-odd/32
-                 round-to-odd/64
-                 round-to-odd/128
+         (inline round-to-odd/32-64
+                 round-to-odd/64-128
+                 round-to-odd/128-256
                  floor-multiply/32-64q64
                  floor-multiply/evenp/32-64q64
                  floor-multiply/64-128q128
@@ -177,40 +173,40 @@
                  floor-log-expt
                  ceiling-log-expt))
 
-(defmacro %round-to-odd-1 (g cp size)
-  `(let ((p (* ,g ,cp)))
+(defmacro %round-to-odd-1 (cp g size)
+  `(let ((p (* ,cp ,g)))
      (logior (ldb (byte ,size ,(ash size 1)) p)
              (if (> (ldb (byte ,size ,size) p) 1) 1 0))))
 
-(defmacro %round-to-odd-2 (g cp size)
-  `(let ((p (ash (* ,g ,cp) ,(- size))))
+(defmacro %round-to-odd-2 (cp g size)
+  `(let ((p (ash (* ,cp ,g) ,(- size))))
      (if (ldb-test (byte ,(1- size) 1) p)
          (logior (ash p ,(- size)) 1)
          (ash p ,(- size)))))
 
-(defun round-to-odd/32 (g cp)
+(defun round-to-odd/32-64 (cp g)
   #+quaviver/bignum-elision
   (let ((p (*/32-64/hi64 cp g)))
     (if (ldb-test (byte 31 1) p)
         (logior (ash p -32) 1)
         (ash p -32)))
   #+(and (not quaviver/bignum-elision) (not (or ecl cmucl)))
-  (%round-to-odd-1 g cp 32)
+  (%round-to-odd-1 cp g 32)
   #+(and (not quaviver/bignum-elision) (or ecl cmucl))
-  (%round-to-odd-2 g cp 32))
+  (%round-to-odd-2 cp g 32))
 
-(defun round-to-odd/64 (g cp)
+(defun round-to-odd/64-128 (cp g)
   #+quaviver/bignum-elision
   (multiple-value-bind (ph pl)
       (*/64-128/hi128 cp (aref g 0) (aref g 1))
     (if (ldb-test (byte 63 1) pl)
         (logior ph 1)
         ph))
   #-quaviver/bignum-elision
-  (%round-to-odd-2 g cp 64))
+  (%round-to-odd-2 cp g 64))
 
-(defun round-to-odd/128 (g cp)
-  (%round-to-odd-2 g cp 128))
+(defun round-to-odd/128-256 (cp g)
+  (%round-to-odd-2 cp g 128))
 
 ;;; The FLOOR-MULTIPLY operations return the same type as the initial argument.
 ;;;

code/math/packages.lisp

@@ -4,9 +4,9 @@
            #:expt10/32
            #:expt10/64
            #:expt10/128
-           #:round-to-odd/32
-           #:round-to-odd/64
-           #:round-to-odd/128
+           #:round-to-odd/32-64
+           #:round-to-odd/64-128
+           #:round-to-odd/128-256
            #:floor-multiply/32-64q64
            #:floor-multiply/evenp/32-64q64
            #:floor-multiply/64-128q128

code/schubfach/implementation.lisp

@@ -29,17 +29,17 @@
                           (type (integer 0 4)
                                 h))
                  (setf significand (ash significand 2))
-                 (let ((lower (,round-to-odd expt10
-                                             (ash (if lower-boundary-is-closer
+                 (let ((lower (,round-to-odd (ash (if lower-boundary-is-closer
                                                       (1- significand)
                                                       (- significand 2))
-                                                  h)))
-                       (upper (,round-to-odd expt10
-                                             (ash (+ significand 2)
-                                                  h))))
+                                                  h)
+                                             expt10))
+                       (upper (,round-to-odd (ash (+ significand 2)
+                                                  h)
+                                             expt10)))
                    (declare (type (unsigned-byte ,word-size)
                                   lower upper))
-                   (setf significand (,round-to-odd expt10 (ash significand h)))
+                   (setf significand (,round-to-odd (ash significand h) expt10))
                    (let ((s (ash significand -2)))
                      (declare (type (unsigned-byte ,word-size)
                                     s))
@@ -82,23 +82,23 @@
   (%schubfach client value
               short-float
               quaviver/math:expt10/32
-              quaviver/math:round-to-odd/32))
+              quaviver/math:round-to-odd/32-64))
 
 (defmethod quaviver:float-integer ((client client) (base (eql 10)) (value single-float))
   (%schubfach client value
               single-float
               quaviver/math:expt10/32
-              quaviver/math:round-to-odd/32))
+              quaviver/math:round-to-odd/32-64))
 
 (defmethod quaviver:float-integer ((client client) (base (eql 10)) (value double-float))
   (%schubfach client value
               double-float
               quaviver/math:expt10/64
-              quaviver/math:round-to-odd/64))
+              quaviver/math:round-to-odd/64-128))
 
 #+quaviver/long-float
 (defmethod quaviver:float-integer ((client client) (base (eql 10)) (value long-float))
   (%schubfach client value
               long-float
               quaviver/math:expt10/128
-              quaviver/math:round-to-odd/128))
+              quaviver/math:round-to-odd/128-256))