Re: master: Fix immediate construction on loongarch, riscv

I just want to get things moving, not optimize them.
clang just loads things from memory.

On Sun, Feb 22, 2026 at 1:27 PM Charles Zhang <[email protected]> wrote:
>
> Just a note: If a temp register is allocated anyway, the generic case can just be done by loading the high 32 bits into the temp register, 32 bits into the target register, and adding.
>
> On Sunday, February 22, 2026, 3:59 AM, stassats via Sbcl-commits <[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>       via  fcc91d51a57bc79921d0bbe4ff7b4f2abc372317 (commit)
>       from  5bf2decc30b259ac8dfb3ac1d052fd90e14a4e84 (commit)
>
> - Log -----------------------------------------------------------------
> commit fcc91d51a57bc79921d0bbe4ff7b4f2abc372317
> Author: Stas Boukarev <[email protected]>
> Date:  Sun Feb 22 03:26:59 2026 +0300
>
>     Fix immediate construction on loongarch, riscv
>
>     Where large immediates are constructed by adding and shifting left.
>     Intermediate values might not be properly tagged for a descriptor
>     register.
> ---
> src/assembly/riscv/assem-rtns.lisp  |  4 +-
> src/compiler/loongarch64/insts.lisp | 90 +++++++++++++++++++++----------------
> src/compiler/riscv/insts.lisp      | 87 +++++++++++++++++++----------------
> src/compiler/riscv/vm.lisp          |  9 ++--
> 4 files changed, 109 insertions(+), 81 deletions(-)
>
> diff --git a/src/assembly/riscv/assem-rtns.lisp b/src/assembly/riscv/assem-rtns.lisp
> index f61171d1e..5a1b023b2 100644
> --- a/src/assembly/riscv/assem-rtns.lisp
> +++ b/src/assembly/riscv/assem-rtns.lisp
> @@ -266,7 +266,7 @@
>
>       ;; Don't want these to overlap with C args.
>       (:temp pa-temp non-descriptor-reg nl6-offset)
> -    (:temp temp non-descriptor-reg nl7-offset))
> +    (:temp temp non-descriptor-reg tmp-offset))
>   (save-c-registers)
>
>   (initialize-boxed-regs (list function arg-ptr nargs #+sb-thread tls-ptr))
> @@ -313,7 +313,7 @@
>       (:temp value0-pass (any-reg) (result-reg-offset 0))
>       (:temp value1-pass (any-reg) (result-reg-offset 1))
>       (:temp pa-temp (any-reg) nl6-offset)
> -    (:temp temp (any-reg) nl7-offset))
> +    (:temp temp (unsigned-reg) tmp-offset))
>   ;; The C stack frame and argument registers should have already been
>   ;; set up in Lisp.
>
> diff --git a/src/compiler/loongarch64/insts.lisp b/src/compiler/loongarch64/insts.lisp
> index b74cc318d..df4f1c44c 100644
> --- a/src/compiler/loongarch64/insts.lisp
> +++ b/src/compiler/loongarch64/insts.lisp
> @@ -783,10 +783,11 @@
>       (u-and-i-inst-immediate immediate)
>     (cond ((zerop hi)
>             (inst addi.d rd zero-tn immediate))
> +          ((zerop lo)
> +          (inst lu12i.w rd hi))
>           (t
> -          (inst lu12i.w rd hi)
> -          (unless (zerop lo)
> -            (inst addi.d rd rd lo))))))
> +          (inst lu12i.w t7-tn hi)
> +          (inst addi.d rd t7-tn lo)))))
>
> ;;;; li should optimization by lu32i, lu52i
> (defun %li (reg value)
> @@ -799,63 +800,76 @@
>             (integer-length (integer-length value))
>             (2^k (ash 1 integer-length))
>             (2^.k-1 (ash 1 (1- integer-length)))
> -            (complement (mod (lognot value) (ash 1 64))))
> +            (complement (mod (lognot value) (ash 1 64)))
> +            ;; Intermediate unboxed values might be inappropriate for a
> +            ;; boxed target register
> +            (tmp t7-tn))
>         (cond ((zerop (logand (1+ value) value))
>               ;; Common special case: the immediate is of the form #xfff...
> -              (inst addi.d reg zero-tn -1)
> -              (unless (= integer-length 64)
> -                (inst srli.d reg reg (- 64 integer-length))))
> +              (inst addi.d tmp zero-tn -1)
> +              (aver (/= integer-length 64))
> +              (inst srli.d reg tmp (- 64 integer-length)))
>               ((let ((delta (- 2^k value)))
>                 (and (typep (ash delta (- 64 integer-length)) 'short-immediate)
>                       (logand delta (1- delta))))
>               ;; Common special case: the immediate is of the form
>               ;; #x00fff...00, where there are a small number of
>               ;; zeroes at the end.
> -              (inst addi.d reg zero-tn (ash (- value 2^k) (- 64 integer-length)))
> -              (inst srli.d reg reg (- 64 integer-length)))
> +              (inst addi.d tmp zero-tn (ash (- value 2^k) (- 64 integer-length)))
> +              (inst srli.d reg tmp (- 64 integer-length)))
>               ((zerop (logand complement (1+ complement)))
>               ;; #xfffffff...00000
> -              (inst addi.d reg zero-tn -1)
> -              (inst slli.d reg reg (integer-length complement)))
> +              (inst addi.d tmp zero-tn -1)
> +              (inst slli.d reg tmp (integer-length complement)))
>               ((typep (- value 2^k) 'short-immediate)
>               ;; Common special case: loading an immediate which is a
>               ;; signed 12 bit constant away from a power of 2.
>               (cond ((= integer-length 64)
>                       (inst addi.d reg zero-tn (- value 2^k)))
>                     (t
> -                    (inst addi.d reg zero-tn 1)
> -                    (inst slli.d reg reg integer-length)
> -                    (inst addi.d reg reg (- value 2^k)))))
> +                    (inst addi.d tmp zero-tn 1)
> +                    (inst slli.d tmp tmp integer-length)
> +                    (inst addi.d reg tmp (- value 2^k)))))
>               ((typep (- value 2^.k-1) 'short-immediate)
>               ;; Common special case: loading an immediate which is a
>               ;; signed 12 bit constant away from a power of 2.
> -              (inst addi.d reg zero-tn 1)
> -              (inst slli.d reg reg (1- integer-length))
> -              (unless (= value 2^.k-1)
> -                (inst addi.d reg reg (- value 2^.k-1))))
> +              (inst addi.d tmp zero-tn 1)
> +              (cond ((= value 2^.k-1)
> +                    (inst slli.d reg tmp (1- integer-length)))
> +                    (t
> +                    (inst slli.d tmp tmp (1- integer-length))
> +                    (inst addi.d reg tmp (- value 2^.k-1)))))
>               (t
>               ;; The "generic" case.
>               ;; Load in the first 31 non zero most significant bits.
> -              (let ((chunk (ldb (byte 12 (- integer-length 31)) value)))
> -                (inst lu12i.w reg (ldb (byte 20 (- integer-length 19)) value))
> -                (cond ((= (1- (ash 1 12)) chunk)
> -                      (inst addi.d reg reg (1- (ash 1 11)))
> -                      (inst addi.d reg reg (1- (ash 1 11)))
> -                      (inst addi.d reg reg 1))
> -                      ((logbitp 11 chunk)
> -                      (inst addi.d reg reg (1- (ash 1 11)))
> -                      (inst addi.d reg reg (- chunk (1- (ash 1 11)))))
> -                      (t
> -                      (inst addi.d reg reg chunk))))
> -              ;; Now we need to load in the rest of the bits properly, in
> -              ;; chunks of 11 to avoid sign extension.
> -              (do ((i (- integer-length 31) (- i 11)))
> -                  ((< i 11)
> -                  (inst slli.d reg reg i)
> -                  (unless (zerop (ldb (byte i 0) value))
> -                    (inst addi.d reg reg (ldb (byte i 0) value))))
> -                (inst slli.d reg reg 11)
> -                (inst addi.d reg reg (ldb (byte 11 (- i 11)) value)))))))
> +              (let ((chunk (ldb (byte 12 (- integer-length 31)) value))
> +                    instructions)
> +                (flet ((add-inst (m d o1 o2)
> +                        ;; Gotta know which instruction is the last one
> +                        ;; to put REG as its destination
> +                        (push (list m d o1 o2) instructions)))
> +                  (inst lu12i.w tmp (ldb (byte 20 (- integer-length 19)) value))
> +                  (cond ((= (1- (ash 1 12)) chunk)
> +                        (inst addi.d tmp tmp (1- (ash 1 11)))
> +                        (inst addi.d tmp tmp (1- (ash 1 11)))
> +                        (add-inst 'addi.d tmp tmp 1))
> +                        ((logbitp 11 chunk)
> +                        (inst addi.d tmp tmp (1- (ash 1 11)))
> +                        (add-inst 'addi.d tmp tmp (- chunk (1- (ash 1 11)))))
> +                        (t
> +                        (add-inst 'addi.d tmp tmp chunk)))
> +                  ;; Now we need to load in the rest of the bits properly, in
> +                  ;; chunks of 11 to avoid sign extension.
> +                  (do ((i (- integer-length 31) (- i 11)))
> +                      ((< i 11)
> +                      (add-inst 'slli.d tmp tmp i)
> +                      (unless (zerop (ldb (byte i 0) value))
> +                        (add-inst 'addi.d tmp tmp (ldb (byte i 0) value))))
> +                    (add-inst 'slli.d tmp tmp 11)
> +                    (add-inst 'addi.d tmp tmp (ldb (byte 11 (- i 11)) value)))
> +                  (setf (second (car instructions)) reg)
> +                  (loop for (m d o1 o2) in (reverse instructions)
> +                        do (inst* m d o1 o2))))))))
>     (fixup
>       (inst lu12i.w reg value)
>       (inst addi.d reg reg value))))
> diff --git a/src/compiler/riscv/insts.lisp b/src/compiler/riscv/insts.lisp
> index 04ff8098c..e7135c811 100644
> --- a/src/compiler/riscv/insts.lisp
> +++ b/src/compiler/riscv/insts.lisp
> @@ -19,7 +19,7 @@
>             sb-vm::registers sb-vm::float-registers
>             sb-vm::zero
>             sb-vm::zero-offset
> -            sb-vm::lip-tn sb-vm::zero-tn
> +            sb-vm::lip-tn sb-vm::zero-tn sb-vm::tmp-tn
>             sb-vm::code-tn
>             sb-vm::tn-byte-offset
>             ;; Types
> @@ -441,10 +441,11 @@
>       (u-and-i-inst-immediate immediate)
>     (cond ((zerop hi)
>             (inst addi rd zero-tn immediate))
> +          ((zerop lo)
> +          (inst lui rd hi))
>           (t
> -          (inst lui rd hi)
> -          (unless (zerop lo)
> -            (inst addi rd rd lo))))))
> +          (inst lui tmp-tn hi)
> +          (inst addi rd tmp-tn lo)))))
>
> (defun %li (reg value)
>   (etypecase value
> @@ -457,63 +458,73 @@
>             (integer-length (integer-length value))
>             (2^k (ash 1 integer-length))
>             (2^.k-1 (ash 1 (1- integer-length)))
> -            (complement (mod (lognot value) (ash 1 64))))
> +            (complement (mod (lognot value) (ash 1 64)))
> +            (tmp tmp-tn))
>         (cond ((zerop (logand (1+ value) value))
>               ;; Common special case: the immediate is of the form #xfff...
>               (inst addi reg zero-tn -1)
> -              (unless (= integer-length 64)
> -                (inst srli reg reg (- 64 integer-length))))
> +              (inst srli reg reg (- 64 integer-length)))
>               ((let ((delta (- 2^k value)))
>                 (and (typep (ash delta (- 64 integer-length)) 'short-immediate)
>                       (logand delta (1- delta))))
>               ;; Common special case: the immediate is of the form
>               ;; #x00fff...00, where there are a small number of
>               ;; zeroes at the end.
> -              (inst addi reg zero-tn (ash (- value 2^k) (- 64 integer-length)))
> -              (inst srli reg reg (- 64 integer-length)))
> +              (inst addi tmp zero-tn (ash (- value 2^k) (- 64 integer-length)))
> +              (inst srli reg tmp (- 64 integer-length)))
>               ((zerop (logand complement (1+ complement)))
>               ;; #xfffffff...00000
> -              (inst addi reg zero-tn -1)
> -              (inst slli reg reg (integer-length complement)))
> +              (inst addi tmp zero-tn -1)
> +              (inst slli reg tmp (integer-length complement)))
>               ((typep (- value 2^k) 'short-immediate)
>               ;; Common special case: loading an immediate which is a
>               ;; signed 12 bit constant away from a power of 2.
>               (cond ((= integer-length 64)
>                       (inst addi reg zero-tn (- value 2^k)))
>                     (t
> -                    (inst addi reg zero-tn 1)
> -                    (inst slli reg reg integer-length)
> -                    (inst addi reg reg (- value 2^k)))))
> +                    (inst addi tmp zero-tn 1)
> +                    (inst slli tmp tmp integer-length)
> +                    (inst addi reg tmp (- value 2^k)))))
>               ((typep (- value 2^.k-1) 'short-immediate)
>               ;; Common special case: loading an immediate which is a
>               ;; signed 12 bit constant away from a power of 2.
> -              (inst addi reg zero-tn 1)
> -              (inst slli reg reg (1- integer-length))
> -              (unless (= value 2^.k-1)
> -                (inst addi reg reg (- value 2^.k-1))))
> +              (inst addi tmp zero-tn 1)
> +              (cond ((= value 2^.k-1)
> +                    (inst slli reg tmp (1- integer-length)))
> +                    (t
> +                    (inst slli tmp tmp (1- integer-length))
> +                    (inst addi reg tmp (- value 2^.k-1)))))
>               (t
>               ;; The "generic" case.
>               ;; Load in the first 31 non zero most significant bits.
> -              (let ((chunk (ldb (byte 12 (- integer-length 31)) value)))
> -                (inst lui reg (ldb (byte 20 (- integer-length 19)) value))
> -                (cond ((= (1- (ash 1 12)) chunk)
> -                      (inst addi reg reg (1- (ash 1 11)))
> -                      (inst addi reg reg (1- (ash 1 11)))
> -                      (inst addi reg reg 1))
> -                      ((logbitp 11 chunk)
> -                      (inst addi reg reg (1- (ash 1 11)))
> -                      (inst addi reg reg (- chunk (1- (ash 1 11)))))
> -                      (t
> -                      (inst addi reg reg chunk))))
> -              ;; Now we need to load in the rest of the bits properly, in
> -              ;; chunks of 11 to avoid sign extension.
> -              (do ((i (- integer-length 31) (- i 11)))
> -                  ((< i 11)
> -                  (inst slli reg reg i)
> -                  (unless (zerop (ldb (byte i 0) value))
> -                    (inst addi reg reg (ldb (byte i 0) value))))
> -                (inst slli reg reg 11)
> -                (inst addi reg reg (ldb (byte 11 (- i 11)) value)))))))
> +              (let ((chunk (ldb (byte 12 (- integer-length 31)) value))
> +                    instructions)
> +                (flet ((add-inst (m d o1 o2)
> +                        ;; Gotta know which instruction is the last one
> +                        ;; to put REG as its destination
> +                        (push (list m d o1 o2) instructions)))
> +                  (inst lui tmp (ldb (byte 20 (- integer-length 19)) value))
> +                  (cond ((= (1- (ash 1 12)) chunk)
> +                        (inst addi tmp tmp (1- (ash 1 11)))
> +                        (inst addi tmp tmp (1- (ash 1 11)))
> +                        (add-inst 'addi tmp tmp 1))
> +                        ((logbitp 11 chunk)
> +                        (inst addi tmp tmp (1- (ash 1 11)))
> +                        (add-inst 'addi tmp tmp (- chunk (1- (ash 1 11)))))
> +                        (t
> +                        (add-inst 'addi tmp tmp chunk)))
> +                  ;; Now we need to load in the rest of the bits properly, in
> +                  ;; chunks of 11 to avoid sign extension.
> +                  (do ((i (- integer-length 31) (- i 11)))
> +                      ((< i 11)
> +                      (add-inst 'slli tmp tmp i)
> +                      (unless (zerop (ldb (byte i 0) value))
> +                        (add-inst 'addi tmp tmp (ldb (byte i 0) value))))
> +                    (add-inst 'slli tmp tmp 11)
> +                    (add-inst 'addi tmp tmp (ldb (byte 11 (- i 11)) value)))
> +                  (setf (second (car instructions)) reg)
> +                  (loop for (m d o1 o2) in (reverse instructions)
> +                        do (inst* m d o1 o2))))))))
>     (fixup
>       (inst lui reg value)
>       (inst addi reg reg value))))
> diff --git a/src/compiler/riscv/vm.lisp b/src/compiler/riscv/vm.lisp
> index c0a58f0ae..3950e56ec 100644
> --- a/src/compiler/riscv/vm.lisp
> +++ b/src/compiler/riscv/vm.lisp
> @@ -65,7 +65,8 @@
>   (defreg l0 22)    ; s6
>   (defreg nl6 23)    ; s7
>   (defreg l1 24)    ; s8
> -  (defreg nl7 25)    ; s9
> +  ;; A register needed to load constants into descriptor-regs
> +  (defreg tmp 25)    ; s9
>   (defreg #-sb-thread l2 #+sb-thread thread 26) ; s10
>
>   (defreg cfunc 27)  ; s11
> @@ -74,7 +75,7 @@
>   (defreg code 30)  ; t5
>   (defreg nargs 31)  ; t6
>
> -  (defregset non-descriptor-regs nl0 nl1 nl2 ra nl3 nl4 nl5 nl6 nl7 nargs nfp cfunc)
> +  (defregset non-descriptor-regs nl0 nl1 nl2 ra nl3 nl4 nl5 nl6 nargs nfp cfunc)
>   (defregset descriptor-regs a0 a1 a2 a3 a4 a5 l0 l1 #-sb-thread l2 ocfp lexenv)
>   (defregset reserve-descriptor-regs lexenv)
>   (defregset reserve-non-descriptor-regs cfunc)
> @@ -210,7 +211,9 @@
>   (defregtn ocfp any-reg)
>   (defregtn nfp any-reg)
>
> -  (defregtn ra any-reg))
> +  (defregtn ra any-reg)
> +
> +  (defregtn tmp unsigned-reg))
>
> ;;; If VALUE can be represented as an immediate constant, then return the
> ;;; appropriate SC number, otherwise return NIL.
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits