Re: master: Fix immediate construction on loongarch, riscv

And loongarch has lu32i.d lu52i.d instructions.

On Sun, Feb 22, 2026 at 4:56 PM Stas Boukarev <[email protected]> wrote:
>
> 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