- "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))))))
+ "Return the greatest integer less than or equal to the square root of N."
+ (declare (type unsigned-byte n))
+ (macrolet
+ ((isqrt-recursion (arg recurse fixnum-p)
+ ;; Expands into code for the recursive step of the ISQRT
+ ;; calculation. ARG is the input variable and RECURSE the name
+ ;; of the function to recur into. If FIXNUM-P is true, some
+ ;; type declarations are added that, together with ARG being
+ ;; declared as a fixnum outside of here, make the resulting code
+ ;; compile into fixnum-specialized code without any calls to
+ ;; generic arithmetic. Else, the code works for bignums, too.
+ ;; The input must be at least 16 to ensure that RECURSE is called
+ ;; with a strictly smaller number and that the result is correct
+ ;; (provided that RECURSE correctly implements ISQRT, itself).
+ `(macrolet ((if-fixnum-p-truly-the (type expr)
+ ,@(if fixnum-p
+ '(`(truly-the ,type ,expr))
+ '((declare (ignore type))
+ expr))))
+ (let* ((fourth-size (ash (1- (integer-length ,arg)) -2))
+ (significant-half (ash ,arg (- (ash fourth-size 1))))
+ (significant-half-isqrt
+ (if-fixnum-p-truly-the
+ (integer 1 #.(isqrt sb!xc:most-positive-fixnum))
+ (,recurse significant-half)))
+ (zeroth-iteration (ash significant-half-isqrt
+ fourth-size)))
+ (multiple-value-bind (quot rem)
+ (floor ,arg zeroth-iteration)
+ (let ((first-iteration (ash (+ zeroth-iteration quot) -1)))
+ (cond ((oddp quot)
+ first-iteration)
+ ((> (if-fixnum-p-truly-the
+ fixnum
+ (expt (- first-iteration zeroth-iteration) 2))
+ rem)
+ (1- first-iteration))
+ (t
+ first-iteration))))))))
+ (typecase n
+ (fixnum (labels ((fixnum-isqrt (n)
+ (declare (type fixnum n))
+ (cond ((> n 24)
+ (isqrt-recursion n fixnum-isqrt t))
+ ((> n 15) 4)
+ ((> n 8) 3)
+ ((> n 3) 2)
+ ((> n 0) 1)
+ ((= n 0) 0))))
+ (fixnum-isqrt n)))
+ (bignum (isqrt-recursion n isqrt nil)))))