GitLab

at 2026-03-26T07:17:08-07:00

Replace ORR with ADD

In make-other-immediate-type, we were using ORR with an immediate
value that can't be encoded.  Replace ORR with AND which can handle
small constants.

[skip-ci]

Replace ADD with SUB instr

In var-alloc, we were using add with a negative immediate
value (+ (ash -2 type-bits) type).  Arm64 add only accepts positive
values.  Replace with sub.

[skip-ci]

Add complex-double-double-move and fix :move-argument bug

For some reason, Claude didn't add/update the sparc
complex-double-double-move vop.  Add it now.  Also we had

(define-move-vop move-double-double-float-argument :move ...)

But the sparc version used the correct :move-argument.  Don't know why
this was changed.

[skip-ci]

Fix add with negative offset

define-indexer was using the immed value

(- (ash offset word-shift) lowtag)

with an ADD instr.  This is negative when OFFSET is 0.  Fix by
adding the offset part and then subtracting the lowtag.

[skip-ci]

     ;;   because bytes is still a tagged fixnum at this point.

     ;; ARM64: LSL is the equivalent.

     (inst lsl header bytes (- type-bits vm:fixnum-tag-bits))

-    (inst add header header (+ (ash -2 type-bits) type))

+    (inst sub header header (- (ash 2 type-bits) type))

     ;; Round bytes down to a lispobj-aligned boundary.

     (inst and bytes bytes (lognot lowtag-mask))

     (pseudo-atomic ()

 (define-move-vop complex-double-move :move

   (complex-double-reg) (complex-double-reg))

+#+double-double

+(define-vop (complex-double-double-move)

+  (:args (x :scs (complex-double-double-reg)

+            :target y

+            :load-if (not (location= x y))))

+  (:results (y :scs (complex-double-double-reg)

+               :load-if (not (location= x y))))

+  (:note _N"complex double-double float move")

+  (:generator 0

+    (emit-not-implemented)

+    (unless (location= x y)

+      (move-double-reg (complex-double-double-reg-real-hi-tn y)

+                       (complex-double-double-reg-real-hi-tn x))

+      (move-double-reg (complex-double-double-reg-real-lo-tn y)

+                       (complex-double-double-reg-real-lo-tn x))

+      (move-double-reg (complex-double-double-reg-imag-hi-tn y)

+                       (complex-double-double-reg-imag-hi-tn x))

+      (move-double-reg (complex-double-double-reg-imag-lo-tn y)

+                       (complex-double-double-reg-imag-lo-tn x)))))

+#+double-double

+(define-move-vop complex-double-double-move :move

+  (complex-double-double-reg) (complex-double-double-reg))

+

 ;;;; -----------------------------------------------------------------------

 ;;;; Complex float heap coercions

        (let ((offset (* (tn-offset y) word-bytes)))

          (inst stur (double-double-reg-hi-tn x) nfp offset)

          (inst stur (double-double-reg-lo-tn x) nfp (+ offset word-bytes)))))))

-(define-move-vop move-double-double-float-argument :move

+(define-move-vop move-double-double-float-argument :move-argument

   (double-double-reg descriptor-reg) (double-double-reg))

 (define-vop (make/double-double-float)

                `((inst lsr temp index ,(- shift))))

               (t nil))

           (inst add temp ,(if (zerop shift) 'index 'temp)

-                (- (ash offset vm:word-shift) lowtag))

+                (ash offset vm:word-shift))

+          (inst sub temp temp lowtag)

           ;; TEMP holds the byte offset; add to object then load/store at 0.

           (inst add temp object temp)

           (inst ,uop value temp 0)))

     (sc-case type

       (immediate

        (inst lsl temp val vm:type-bits)

-       (inst orr res temp (tn-value type)))

+       (inst add res temp (tn-value type)))

       (t

        ;; TYPE is a fixnum-tagged integer; un-tag it with ASR, then

        ;; shift VAL up and OR the pieces together.

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl

Commits:

4 changed files:

Changes: