master: loongarch: Implement integer-length without a loop

The branch "master" has been updated in SBCL:
       via  7c1fd2b82f02521736cc8752b2fd7ea1c12f89f2 (commit)
      from  5476c17badff5c9891868899b3b6e1a4af4c3275 (commit)

- Log -----------------------------------------------------------------
commit 7c1fd2b82f02521736cc8752b2fd7ea1c12f89f2
Author: Douglas Katzman <[email protected]>
Date:   Tue Jul 21 23:38:10 2026 +0000

    loongarch: Implement integer-length without a loop
---
 src/compiler/constraint.lisp        |  5 ++---
 src/compiler/loongarch64/arith.lisp | 30 ++++++++++--------------------
 src/compiler/loongarch64/insts.lisp |  7 ++++++-
 3 files changed, 18 insertions(+), 24 deletions(-)

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 6e04e95bc..6c67fe3d9 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -517,10 +517,9 @@
        ;; Some backends do not implement either count-leading-zeros or count-trailing-zeros
        ;; efficiently. For those, iterating over all bits of a simple-bit-vector
        ;; uses potentially fewer cycles than scanning for just the 1 bits.
-       ;; - Loongarch supports these in the base architecture but our vop is deficient
        ;; - Sparc added LZCNT no earlier than V9, but not on all V9 implementations
        ;; - Risc-v only implements something if the Zbb extension is supported
-       #+(and (not sb-xc-host) (not (or sparc loongarch64 riscv)))
+       #+(and (not sb-xc-host) (not (or sparc riscv)))
        ;; Aligning to word boundaries is valid because MIN and MAX are merely hints about where
        ;; nonzero bits exist.
        (let ((,minword (floor (conset-min ,conset) sb-vm:n-word-bits))
@@ -546,7 +545,7 @@
                                            (* ,index sb-vm:n-word-bits))))))
                       ,@body)))
              finally (return ,result)))
-       #-(and (not sb-xc-host) (not (or sparc loongarch64 riscv)))
+       #-(and (not sb-xc-host) (not (or sparc riscv)))
        (loop for ,index from (conset-min ,conset) below (conset-max ,conset)
              do (when (plusp (sbit ,conset-vector ,index))
                   (let ((,constraint (aref ,universe ,index)))
diff --git a/src/compiler/loongarch64/arith.lisp b/src/compiler/loongarch64/arith.lisp
index f54e91d59..98ce428f7 100644
--- a/src/compiler/loongarch64/arith.lisp
+++ b/src/compiler/loongarch64/arith.lisp
@@ -335,27 +335,17 @@
   (:translate integer-length)
   (:note #.(format nil "inline (signed-byte ~a) integer-length" n-machine-word-bits))
   (:policy :fast-safe)
-  (:args (arg :scs (signed-reg) :target shift))
+  (:args (arg :scs (signed-reg)))
   (:arg-types signed-num)
-  (:results (res :scs (any-reg)))
-  (:result-types positive-fixnum)
-  (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift)
-  (:generator 30
-    (let ((loop (gen-label))
-          (test (gen-label)))
-      (move shift arg)
-      (move res zero-tn)
-      (inst bge shift zero-tn test)
-
-      (inst s_xori shift shift -1)
-      (inst j test)
-
-      (emit-label loop)
-      (inst srli.d shift shift 1)
-      (inst addi.d res res (fixnumize 1))
-
-      (emit-label test)
-      (inst bne shift zero-tn loop))))
+  (:results (res :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:temporary (:scs (non-descriptor-reg)) temp)
+  (:generator 5
+    (inst srai.d temp arg 63) ; blast the sign bit across the word
+    (inst xor temp temp arg)
+    (inst clz.d res temp)
+    (inst li temp 64)
+    (inst sub.d res temp res)))
 
 (define-vop (unsigned-byte-64-count)
   (:translate logcount)
diff --git a/src/compiler/loongarch64/insts.lisp b/src/compiler/loongarch64/insts.lisp
index 39e9fafce..433097932 100644
--- a/src/compiler/loongarch64/insts.lisp
+++ b/src/compiler/loongarch64/insts.lisp
@@ -584,7 +584,12 @@
   (define-la-am-instruction llacq.w #b0011100001010111100000)
   (define-la-am-instruction screl.w #b0011100001010111100001)
   (define-la-am-instruction llacq.d #b0011100001010111100010)
-  (define-la-am-instruction screl.d #b0011100001010111100011))
+  (define-la-am-instruction screl.d #b0011100001010111100011)
+  ;; Piggybacking on the atomic memory ops even though these aren't such.
+  (define-la-am-instruction ctz.w   #b0000000000000000000111)
+  (define-la-am-instruction ctz.d   #b0000000000000000001011)
+  (define-la-am-instruction clz.w   #b0000000000000000000101)
+  (define-la-am-instruction clz.d   #b0000000000000000001001))
 
 (define-instruction-macro fstore (&optional format fd rj offset)
   `(case ,format

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL