Re: master: Fix immediate construction on loongarch, riscv

Charles Zhang via Sbcl-commits <[email protected]> Sun, 22 Feb 2026 15:07:02 +0000 (UTC)
Newsgroups	gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel
Message-ID	<[email protected]>
Depends on the microarch. But almost all immediates will require less than 6-8 instructions to materialize, hence why the gcc backend does it this way. The pattern matcher I implemented for sbcl is very stupid, so it’s going to be suboptimal in some cases.


On Sunday, February 22, 2026, 3:55 PM, Stas Boukarev <[email protected]> wrote:

But are 6/8 instructions better than a memory load?

On Sun, Feb 22, 2026 at 5:54 PM Charles Zhang <[email protected]> wrote:
>
> clang moves from memory, but there’s a todo that’s been there since at least my port in 2019 that they should materialize large immediates without going through memory. GCC will do memory less instruction sequences.
>
> On Sunday, February 22, 2026, 3:52 PM, Stas Boukarev <[email protected]> wrote:
>
> 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