math: add ceiling-log

code/math/log.lisp

@@ -0,0 +1,62 @@
+(in-package #:quaviver.math)
+
+(declaim (ftype (function ((integer 2 36) unsigned-byte) (unsigned-byte 22))
+                ceiling-log
+                count-digits)
+         (inline ceiling-log
+                 count-digits))
+
+(defvar *ceiling-log-table*
+  (compute-ceiling-log +min-base+ +max-base+
+                       (quaviver:arithmetic-size #+quaviver/long-float
+                                                 'long-float
+                                                 #-quaviver/long-float
+                                                 'double-float)))
+
+(defun ceiling-log (base value)
+  (declare (optimize speed))
+  (cond ((eql base 2)
+         (integer-length value))
+        ((= (logcount base) 1)
+         (values (ceiling (integer-length value)
+                          (1- (integer-length base)))))
+        (t
+         (let* ((value-length (integer-length value))
+                (lower (ceiling-log-expt base 2 (1- value-length)))
+                (upper (ceiling-log-expt base 2 value-length)))
+           (if (or (= lower upper)
+                   (< value
+                      (let ((table (svref *ceiling-log-table* (- base +min-base+))))
+                        (if (< lower (length table))
+                            (svref table lower)
+                            (cl:expt base lower)))))
+                  lower
+                  upper)))))
+
+(define-compiler-macro ceiling-log (&whole whole base value)
+  (cond ((not (constantp base))
+         whole)
+        ((eql base 2)
+         `(integer-length ,value))
+        ((= (logcount base) 1)
+         `(values (ceiling (integer-length ,value)
+                           ,(1- (integer-length base)))))
+        (t
+         `(let* ((value ,value)
+                 (value-length (integer-length value))
+                 (lower (ceiling-log-expt ,base 2 (1- value-length)))
+                 (upper (ceiling-log-expt ,base 2 value-length)))
+            (declare (optimize speed))
+            (if (or (= lower upper)
+                    (< value
+                       (let ((table ,(svref *ceiling-log-table* (- base +min-base+))))
+                         (if (< lower (length table))
+                             (svref table lower)
+                             (cl:expt ,base lower)))))
+                lower
+                upper)))))
+
+(defun count-digits (base value)
+  (declare (optimize speed))
+  (max (ceiling-log base value)
+       1))

code/math/utility.lisp

@@ -47,3 +47,13 @@
         do (setf (getf tables arithmetic-size)
                  (max (getf tables arithmetic-size 0)
                       bound))))
+
+(defun compute-ceiling-log (min-base max-base width)
+  (make-array (- max-base min-base -1)
+              :initial-contents
+              (loop for base from min-base upto max-base
+                    for max-power = (floor (log (ash 1 (1- width)) base))
+                    collect (make-array (1+ max-power)
+                                        :initial-contents
+                                        (loop for power from 0 upto max-power
+                                              collect (cl:expt base power))))))

code/packages.lisp

@@ -69,7 +69,9 @@
            #:floor-multiply/64-128q128
            #:floor-multiply/evenp/64-128q128
            #:floor-log-expt
-           #:ceiling-log-expt))
+           #:ceiling-log-expt
+           #:ceiling-log
+           #:count-digits))
 
 #+sbcl
 (pushnew :quaviver.math/smallnum *features*)

quaviver.asd

@@ -27,6 +27,7 @@
                               :serial t
                               :components ((:file "log-expt")
                                            (:file "utility")
+                                           (:file "log")
                                            (:file "implementation")
                                            (:file "expt")
                                            (:file "round-to-odd")))