Re: master: Make EMIT-EA more complicated

What can that be used for? Back patching?

On Sat, Aug 22, 2026 at 1:36 AM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  b5c1bfad94d14e9c9b23afdc8ba9ef338be47fb8 (commit)
>       from  18f8a0c8ea195ce436b3d19046ea6c316a4c37a0 (commit)
>
> - Log -----------------------------------------------------------------
> commit b5c1bfad94d14e9c9b23afdc8ba9ef338be47fb8
> Author: Douglas Katzman <[email protected]>
> Date:   Fri Aug 21 22:26:49 2026 +0000
>
>     Make EMIT-EA more complicated
>
>     because it wasn't bad^H^H^Hflexible enough
> ---
>  src/compiler/x86-64/insts.lisp   | 39 ++++++++++++++++++++++++++-------------
>  tests/x86-64-codegen.impure.lisp | 16 ++++++++++++++++
>  xperfecthash63.lisp-expr         |  3 +++
>  3 files changed, 45 insertions(+), 13 deletions(-)
>
> diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
> index 40ff45d5f..0c8f79296 100644
> --- a/src/compiler/x86-64/insts.lisp
> +++ b/src/compiler/x86-64/insts.lisp
> @@ -884,12 +884,13 @@
>  (declaim (freeze-type label+addend))
>
>  ;;;; the effective-address (ea) structure
> -(defstruct (ea (:constructor %ea (segment disp base index scale))
> +(defstruct (ea (:constructor %ea (segment disp-bits disp base index scale))
>                 (:copier nil))
>    (segment nil :type (member :cs :fs :gs) :read-only t)
>    (base nil :type (or tn null) :read-only t)
>    (index nil :type (or tn null) :read-only t)
>    (scale 1 :type (member 1 2 4 8) :read-only t)
> +  (disp-bits nil :type (member 8 32 nil) :read-only t)
>    (disp 0 :type (or (unsigned-byte 32) (signed-byte 32) fixup
>                      label label+addend)
>            :read-only t))
> @@ -941,11 +942,17 @@
>  ;;;
>  (defun ea (&rest args) ; seg displacement base index scale
>    (declare (dynamic-extent args))
> -  (let ((seg :cs) disp)
> -    (let ((first (car args)))
> -      (case first
> -        ((:fs :gs) (setq seg first) (pop args))
> -        (:cs (pop args))))
> +  (let ((seg :cs) disp-bits disp)
> +    (loop
> +      (let ((is-prefix
> +             (case (car args)
> +               ((:fs :gs) (setq seg (car args)))
> +               (:cs t)
> +               ;; Syntax motivated by ".disp{8,32}" in GNU asm
> +               (:disp8 (setq disp-bits 8))
> +               (:disp32 (setq disp-bits 32))
> +               (t nil))))
> +        (if is-prefix (pop args) (return))))
>      (let ((first (car args)))
>        ;; Rather than checking explicitly for all the things that are legal to be
>        ;; a displacement (i.e. LABEL, FIXUP, INTEGER), look for (NOT (OR TN NULL).)
> @@ -957,14 +964,18 @@
>      ;; The minimal EA is either an absolute address or an unindexed base register.
>      ;; So gotta have at least one of disp or base. Enforce by doing either of two
>      ;; destructuring-binds depending on whether DISP was present.
> -    (if disp
> -        (destructuring-bind (&optional base index (scale 1)) args
> -          (%ea seg disp base index scale))
> -        (destructuring-bind (base &optional index (scale 1)) args
> -          (%ea seg 0 base index scale)))))
> +    (multiple-value-bind (disp base index scale)
> +        (if disp
> +            (destructuring-bind (&optional base index (scale 1)) args
> +              (values disp base index scale))
> +            (destructuring-bind (base &optional index (scale 1)) args
> +              (values 0 base index scale)))
> +      (%ea seg disp-bits disp base index scale))))
>
>  (defun rip-relative-ea (label &optional addend)
> -  (%ea :cs (if addend (make-label+addend label addend) label) rip-tn nil 1))
> +  ;; disp-bits is 32 but using NIL for "automatic" will infer it just like
> +  ;; it always did before adding the ability to choose.
> +  (%ea :cs nil (if addend (make-label+addend label addend) label) rip-tn nil 1))
>
>  (defun emit-byte-displacement-backpatch (segment target)
>    (emit-back-patch segment 1
> @@ -1241,7 +1252,9 @@
>                                    (zerop (mod disp disp-n))
>                                    (let ((q (/ disp disp-n)))
>                                      (and (<= -128 q 127) q))))
> -            (mod (cond ((or (null base) (and (eql disp 0) (/= base-encoding #b101)))
> +            (mod (cond ((ea-disp-bits thing) ; explicit .disp8 or .disp32
> +                        (case (ea-disp-bits thing) (8 #b01) (t #b10)))
> +                       ((or (null base) (and (eql disp 0) (/= base-encoding #b101)))
>                          #b00)
>                         (compressed-disp
>                          #b01)
> diff --git a/tests/x86-64-codegen.impure.lisp b/tests/x86-64-codegen.impure.lisp
> index 27e0f4704..2b24ce40a 100644
> --- a/tests/x86-64-codegen.impure.lisp
> +++ b/tests/x86-64-codegen.impure.lisp
> @@ -1539,3 +1539,19 @@
>      ;; Must keep the single fused memory CMP and avoid separate register CMPs
>      (assert (= mem-cmps 1))
>      (assert (= reg-cmps 0))))
> +
> +(with-test (:name :specifically-sized-ea-disp)
> +  (let* ((lines
> +          (disassembly-lines
> +           (compile
> +            nil
> +            '(lambda ()
> +              sb-vm::(inline-vop (((x int-sse-reg))) ()
> +               (inst movdqa (ea 0 rdx-tn) x)
> +               (inst movdqa (ea :disp8 0 rdx-tn) x)
> +               (inst movdqa (ea :disp32 0 rdx-tn) x))))))
> +         (found (member "MOVDQA [RDX], XMM0" lines :test #'search))
> +         (disp8 (cadr found))
> +         (disp32 (caddr found)))
> +    (assert (search "660F7F4200       MOVDQA [RDX], XMM0" disp8))
> +    (assert (search "660F7F8200000000 MOVDQA [RDX], XMM0" disp32))))
> diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
> index 7f5342f94..ee0a54eab 100644
> --- a/xperfecthash63.lisp-expr
> +++ b/xperfecthash63.lisp-expr
> @@ -1820,5 +1820,8 @@
>  (#(A49305EF D0241AE7 E55E7F8C EE9A5410)
>   "(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECIAL)"
>   "((& (>> val 8) 3))")
> +(#(29085F3F 555EA088 8A2CAA21 922EF550 9A26078C)
> + "(:DISP32 :DISP8 :CS :GS :FS)"
> + "((& (+ (>> val 3) (>> val 17)) 7))")
>  )
>  ;; EOF
>
> -----------------------------------------------------------------------
>
>
> 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