Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: 5c9b0b4a by Raymond Toy 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] - - - - - 08bba2a3 by Raymond Toy at 2026-03-26T07:25:19-07:00 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] - - - - - a275ef83 by Raymond Toy at 2026-03-26T07:42:16-07:00 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] - - - - - 42756a90 by Raymond Toy at 2026-03-26T07:55:22-07:00 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] - - - - - 4 changed files: - src/compiler/arm64/alloc.lisp - src/compiler/arm64/float.lisp - src/compiler/arm64/memory.lisp - src/compiler/arm64/system.lisp Changes: ===================================== src/compiler/arm64/alloc.lisp ===================================== @@ -266,7 +266,7 @@ ;; 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 () ===================================== src/compiler/arm64/float.lisp ===================================== @@ -367,6 +367,29 @@ (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 @@ -1353,7 +1376,7 @@ (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) ===================================== src/compiler/arm64/memory.lisp ===================================== @@ -169,7 +169,8 @@ `((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))) ===================================== src/compiler/arm64/system.lisp ===================================== @@ -180,7 +180,7 @@ (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. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a232fbc5465510a5247fc46... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a232fbc5465510a5247fc46... You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications: https://gitlab.common-lisp.net/-/profile/notifications | Help: https://gitlab.common-lisp.net/help