Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: 8c41e73d by Raymond Toy at 2026-03-26T17:37:22-07:00 Fix bug in storew in receive-unknown-values The lowtag var was missing to temp was being treated as the lowtag. Set lowtag parameter to 0. - - - - - a5e7fa24 by Raymond Toy at 2026-03-26T18:53:21-07:00 Add temp reg for load-symbol-value The assembly routine unwind uses load-symbol-value with a large offset. We need a non-descr temp for load-symbol-value. [skip-ci] - - - - - 84f4fab4 by Raymond Toy at 2026-03-26T18:54:47-07:00 Add the arm64 files that need to be compiled Based on the other versions. [skip-ci] - - - - - 438feef1 by Raymond Toy at 2026-03-26T19:11:10-07:00 Add temp for loadw and fix delay-slot bug loadw needs a temp because the offsets can be much larger than allowed by ldur. Also fix logic bug where an inst was placed after a jump. This is a bug because the sparc version that was used has a delay-slot after the jump this was copied instead of moving the inst from the delay-slot before the jump. - - - - - 374362c8 by Raymond Toy at 2026-03-26T19:24:00-07:00 Add missing named tns compared to sparc We're missing lexenv-tn, cname-tn, and lra-tn that are used alot. Also missing nfp-tn and cfunc-tn that sparc defines. Add these [skip-ci] - - - - - 28aca3d4 by Raymond Toy at 2026-03-26T19:35:05-07:00 Don't use non-existent EORS instr Bad translation by Claude of sparc's xorcc instruction. Arm64 doesn't have an eor that sets flags. [skip-ci] - - - - - 4d3ed443 by Raymond Toy at 2026-03-26T20:31:14-07:00 Tell clean-target about arm64 fasls named arm64f Without this clean-target.sh doesn't remove arm64 fasls! [skip-ci] - - - - - 2fe09d0e by Raymond Toy at 2026-03-26T20:33:56-07:00 We're using :linkage-table for arm64 right now [skip-ci] - - - - - 8 changed files: - bin/clean-target.sh - src/assembly/arm64/arith.lisp - src/assembly/arm64/assem-rtns.lisp - src/compiler/arm64/call.lisp - src/compiler/arm64/vm.lisp - src/tools/cross-scripts/cross-x86-arm64.lisp - src/tools/worldbuild.lisp - src/tools/worldcom.lisp Changes: ===================================== bin/clean-target.sh ===================================== @@ -58,6 +58,7 @@ if [ -n "$KEEP" ]; then fi find $TARGET -name "*.bytef" -o -name "*.lbytef" -o -name "*.assem" \ + -o -name "*.arm64f" \ -o -name "*.armf" \ -o -name "*.axpf" \ -o -name "*.hpf" \ ===================================== src/assembly/arm64/arith.lisp ===================================== @@ -25,7 +25,7 @@ ;;; (inst b :lt/:le/:gt/:ge lbl) (inst b :lt/:le/:gt/:ge lbl) ;;; (inst addcc dst a b) (inst adds dst a b) ;;; (inst subcc dst a b) (inst subs dst a b) -;;; (inst xorcc dst a b) (inst eors dst a b) ; sets flags +;;; (inst xorcc dst a b) (inst eor dst a b) ; then CBZ/CBNZ to branch on zero ;;; (inst sra dst src n) (inst asr dst src n) ;;; (inst srl dst src n) (inst lsr dst src n) ;;; (inst sll dst src n) (inst lsl dst src n) @@ -80,11 +80,13 @@ DO-STATIC-FUN ;; At least one arg is not a fixnum. Tail-call the generic function. - (loadw code-tn null-tn (static-function-offset 'two-arg-+)) + ;; Pass TEMP so loadw can materialise the large static-function offset + ;; via LI + LDR rather than attempting a bare LDUR with imm9. + (loadw code-tn null-tn (static-function-offset 'two-arg-+) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) DONE (move res temp)) @@ -124,11 +126,11 @@ (lisp-return lra :offset 2) DO-STATIC-FUN - (loadw code-tn null-tn (static-function-offset 'two-arg--)) + (loadw code-tn null-tn (static-function-offset 'two-arg--) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) DONE (move res temp)) @@ -170,10 +172,11 @@ ;; Check whether the result fits in a fixnum. ;; It fits iff the high word is just the sign-extension of the low word, - ;; i.e. (ASR lo 63) == hi. Use EORS to test and set flags. + ;; i.e. (ASR lo 63) == hi. EOR leaves zero in temp iff equal; CBZ + ;; branches without disturbing the condition flags. (inst asr temp lo 63) - (inst eors temp temp hi) ; temp = 0 iff hi == sign-ext(lo) - (inst b :eq LOW-FITS-IN-FIXNUM) + (inst eor temp temp hi) + (inst cbz temp LOW-FITS-IN-FIXNUM) ;; Result needs a bignum. Shift the double-word hi:lo right by ;; fixnum-tag-bits to remove the fixnum tag contributed by y. @@ -190,8 +193,8 @@ (let ((one-word (gen-label))) ;; Re-check: does the result actually fit in one bignum digit? (inst asr temp lo 63) - (inst eors temp temp hi) - (inst b :eq one-word) + (inst eor temp temp hi) + (inst cbz temp one-word) ;; Need 2 digits: write the header for a 2-word bignum... (inst li temp (logior (ash 2 type-bits) bignum-type)) (storew hi res (1+ bignum-digits-offset) other-pointer-type) @@ -203,11 +206,11 @@ (lisp-return lra :offset 2) DO-STATIC-FUN - (loadw code-tn null-tn (static-function-offset 'two-arg-*)) + (loadw code-tn null-tn (static-function-offset 'two-arg-*) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) LOW-FITS-IN-FIXNUM (move res lo)) @@ -228,6 +231,7 @@ (:res res descriptor-reg a0-offset) + (:temp temp non-descriptor-reg nl0-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) ;; If x is not a fixnum, go straight to the static function. @@ -240,11 +244,11 @@ (inst cmp x y) ; (pre-load flags for DO-COMPARE) DO-STATIC-FN - (loadw code-tn null-tn (static-function-offset ',static-fn)) + (loadw code-tn null-tn (static-function-offset ',static-fn) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) DO-COMPARE ;; CMP has already been executed above (in the fall-through path @@ -272,6 +276,7 @@ (:res res descriptor-reg a0-offset) + (:temp temp non-descriptor-reg nl0-offset) (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) @@ -290,11 +295,11 @@ (lisp-return lra :offset 2) DO-STATIC-FN - (loadw code-tn null-tn (static-function-offset 'eql)) + (loadw code-tn null-tn (static-function-offset 'eql) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) RETURN-T (load-symbol res t)) @@ -311,6 +316,7 @@ (:res res descriptor-reg a0-offset) + (:temp temp non-descriptor-reg nl0-offset) (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) @@ -326,11 +332,11 @@ (lisp-return lra :offset 2) DO-STATIC-FN - (loadw code-tn null-tn (static-function-offset 'two-arg-=)) + (loadw code-tn null-tn (static-function-offset 'two-arg-=) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) RETURN-T (load-symbol res t)) @@ -347,6 +353,7 @@ (:res res descriptor-reg a0-offset) + (:temp temp non-descriptor-reg nl0-offset) (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) @@ -365,11 +372,11 @@ DO-STATIC-FN ;; Note: SPARC original calls 'two-arg-= here; preserved for fidelity. - (loadw code-tn null-tn (static-function-offset 'two-arg-=)) + (loadw code-tn null-tn (static-function-offset 'two-arg-=) 0 temp) (inst li nargs (fixnumize 2)) (move ocfp cfp-tn) - (lisp-jump code-tn) (move cfp-tn csp-tn) + (lisp-jump code-tn) RETURN-NIL (move res null-tn)) ===================================== src/assembly/arm64/assem-rtns.lisp ===================================== @@ -201,14 +201,17 @@ (:temp lra descriptor-reg lra-offset) (:temp cur-uwp any-reg nl0-offset) (:temp next-uwp any-reg nl1-offset) - (:temp target-uwp any-reg nl2-offset)) + (:temp target-uwp any-reg nl2-offset) + ;; Scratch for load/store-symbol-value address materialisation. + ;; Must be non-descriptor: LI writes a raw pointer into it. + (:temp sym-temp non-descriptor-reg nl3-offset)) (declare (ignore start count)) (let ((error (generate-error-code nil invalid-unwind-error))) (inst cmp block 0) (inst b.eq error)) - (load-symbol-value cur-uwp lisp::*current-unwind-protect-block*) + (load-symbol-value cur-uwp lisp::*current-unwind-protect-block* sym-temp) (loadw target-uwp block vm:unwind-block-current-uwp-slot) (inst cmp cur-uwp target-uwp) (inst b.ne do-uwp) @@ -226,7 +229,7 @@ (loadw next-uwp cur-uwp vm:unwind-block-current-uwp-slot) (inst b do-exit) - (store-symbol-value next-uwp lisp::*current-unwind-protect-block*)) + (store-symbol-value next-uwp lisp::*current-unwind-protect-block* sym-temp)) (define-assembly-routine (throw @@ -240,7 +243,9 @@ (declare (ignore start count)) - (load-symbol-value catch lisp::*current-catch-block*) + ;; temp (nl0) is non-descriptor-reg — safe to pass as scratch to + ;; load-symbol-value for large static-symbol offset materialisation. + (load-symbol-value catch lisp::*current-catch-block* temp) LOOP ===================================== src/compiler/arm64/call.lisp ===================================== @@ -435,7 +435,7 @@ (do ((arg register-arg-tns (rest arg)) (i 0 (1+ i))) ((null arg)) - (storew (first arg) args i temp)) + (storew (first arg) args i 0 temp)) (move start args) (move count nargs) (inst b done) ===================================== src/compiler/arm64/vm.lisp ===================================== @@ -364,6 +364,12 @@ (defregtn csp any-reg) (defregtn cfp any-reg) (defregtn ocfp any-reg) +(defregtn nfp any-reg) +(defregtn cfunc any-reg) + +(defregtn lexenv descriptor-reg) +(defregtn cname descriptor-reg) +(defregtn lra descriptor-reg) ===================================== src/tools/cross-scripts/cross-x86-arm64.lisp ===================================== @@ -52,7 +52,6 @@ ;; Not implemented yet :complex-fp-vops :alien-callback - :linkage-table :random-mt19937 )) ===================================== src/tools/worldbuild.lisp ===================================== @@ -72,7 +72,11 @@ "target:assembly/arm/array.assem" "target:assembly/arm/arith.assem" "target:assembly/arm/alloc.assem")) - + ,@(when (c:backend-featurep :arm64) + '("target:assembly/arm64/assem-rtns.assem" + "target:assembly/arm64/array.assem" + "target:assembly/arm64/arith.assem" + "target:assembly/arm64/alloc.assem")) "target:code/type-boot" "target:code/fdefinition" @@ -184,6 +188,9 @@ '("target:code/sgi-vm")) ,@(when (c:backend-featurep :ppc) '("target:code/ppc-vm")) +;; ,@(when (c:backend-featurep :arm64) +;; '("target:code/arm64-vm")) + "target:code/signal" "target:code/interr" ===================================== src/tools/worldcom.lisp ===================================== @@ -112,6 +112,11 @@ (comf "target:assembly/arm/arith" :assem t) (comf "target:assembly/arm/alloc" :assem t)) +(when (c:backend-featurep :arm64) + (comf "target:assembly/arm64/assem-rtns" :assem t) + (comf "target:assembly/arm64/array" :assem t) + (comf "target:assembly/arm64/arith" :assem t) + (comf "target:assembly/arm64/alloc" :assem t)) ;;; these guys can supposedly come in any order, but not really. ;;; some are put at the end so macros don't run interpreted and stuff. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/42756a909b7b7cacb788ec1... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/42756a909b7b7cacb788ec1... 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