1.0.47.6: marginally faster ISQRT

  Thanks to Robert Smith, lp#713343.

diff --git a/NEWS b/NEWS
index 3a71c91..07b3e42 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,7 @@ changes relative to sbcl-1.0.47:
   * enhancement: read() and write() have been added to SB-POSIX.
   * enhancement: types of DEFSTRUCT constructors are proclaimed more
     accurately, allowing better typechecking of call-sites.
+  * optimization: slightly faster ISQRT. (lp#713343)
   * bug fix: TRACE behaves better when attempting to trace undefined
     functions. (lp#740717)
 

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 58fdb29..f4b1994 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1384,29 +1384,31 @@ the first."
            ((fixnum bignum)
             (bignum-gcd (make-small-bignum u) v))))))
 \f
-;;; From discussion on comp.lang.lisp and Akira Kurihara.
+;;;; from Robert Smith
 (defun isqrt (n)
   #!+sb-doc
   "Return the root of the nearest integer less than n which is a perfect
    square."
-  (declare (type unsigned-byte n) (values unsigned-byte))
-  ;; Theoretically (> n 7), i.e., n-len-quarter > 0.
-  (if (and (fixnump n) (<= n 24))
-      (cond ((> n 15) 4)
-            ((> n  8) 3)
-            ((> n  3) 2)
-            ((> n  0) 1)
-            (t 0))
-      (let* ((n-len-quarter (ash (integer-length n) -2))
-             (n-half (ash n (- (ash n-len-quarter 1))))
-             (n-half-isqrt (isqrt n-half))
-             (init-value (ash (1+ n-half-isqrt) n-len-quarter)))
-        (loop
-          (let ((iterated-value
-                 (ash (+ init-value (truncate n init-value)) -1)))
-            (unless (< iterated-value init-value)
-              (return init-value))
-            (setq init-value iterated-value))))))
+  (declare (type unsigned-byte n))
+  (cond
+    ((> n 24)
+     (let* ((n-fourth-size (ash (1- (integer-length n)) -2))
+            (n-significant-half (ash n (- (ash n-fourth-size 1))))
+            (n-significant-half-isqrt (isqrt-fast n-significant-half))
+            (zeroth-iteration (ash n-significant-half-isqrt n-fourth-size))
+            (qr (multiple-value-list (floor n zeroth-iteration)))
+            (first-iteration (ash (+ zeroth-iteration (first qr)) -1)))
+       (cond ((oddp (first qr))
+              first-iteration)
+             ((> (expt (- first-iteration zeroth-iteration) 2) (second qr))
+              (1- first-iteration))
+             (t
+              first-iteration))))
+    ((> n 15) 4)
+    ((> n  8) 3)
+    ((> n  3) 2)
+    ((> n  0) 1)
+    ((= n  0) 0)))
 \f
 ;;;; miscellaneous number predicates
 

diff --git a/version.lisp-expr b/version.lisp-expr
index f6aa8f1..4834d4f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.47.5"
+"1.0.47.6"