March 2026 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][arm-dev] Set C compiler for arm. Allow using different compiler in elf.h
by Raymond Toy (＠rtoy) 28 Mar '26

28 Mar '26

Raymond Toy pushed to branch arm-dev at cmucl / cmucl Commits: de1ded89 by Raymond Toy at 2026-03-27T17:23:56-07:00 Set C compiler for arm. Allow using different compiler in elf.h For arm/linux, we're building on a Raspberry Pi 5 and a 64-bit raspbian OS. To build and run cmucl we needed the 32-bit compiler and libraries. Hence set the compiler in Config.arm_linux appropriately. Also, let Config specify the compiler to use in elf.h. (Untested on arm, of course.) Otherwise it defaults to "gcc", basically. - - - - - 2 changed files: - src/lisp/Config.arm_linux - src/lisp/elf.h Changes: ===================================== src/lisp/Config.arm_linux ===================================== @@ -105,6 +105,11 @@ OPENLIBM_SRCS = \ $(OPENLIBM_DIR)/s_tanhf.c endif +# We're currently building cmucl on a Raspberry Pi5 running a 64-bit +# raspbian. We had to download the arm32 compiler and libraries to be +# able to build and run cmucl. +CC = arm-linux-gnueabihf-gcc + ifeq ($(filter 2% 3%, $(shell $(CC) -dumpversion)),) CPP_INCLUDE_OPTIONS := -iquote . -iquote $(PATH1) ifndef FEATURE_CORE_MATH @@ -130,7 +135,7 @@ ASSEM_SRC = arm-assem.S undefineds-assem.S OS_SRC += Linux-os.c os-common.c elf.c OS_LIBS = -ldl -lutil OS_LINK_FLAGS = -marm -rdynamic -Wl,-Map,foo -Wl,-z,noexecstack -CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 +CFLAGS += -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -DDEFINE_C_COMPILER=$(CC) EXEC_FINAL_OBJ = exec-final.o ===================================== src/lisp/elf.h ===================================== @@ -34,7 +34,7 @@ */ #if defined(__SUNPRO_C) #define C_COMPILER "cc" -#else +#elif !defined(C_COMPILER) #define C_COMPILER "gcc" #endif View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/de1ded89e4bb8a5bc910f1e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/de1ded89e4bb8a5bc910f1e… 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

1 0

[Git][cmucl/cmucl] Pushed new branch arm-dev
by Raymond Toy (＠rtoy) 28 Mar '26

28 Mar '26

Raymond Toy pushed new branch arm-dev at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/arm-dev 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] 8 commits: Fix bug in storew in receive-unknown-values
by Raymond Toy (＠rtoy) 27 Mar '26

27 Mar '26

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/42756a909b7b7cacb788ec… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/42756a909b7b7cacb788ec… 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] 4 commits: Replace ORR with ADD
by Raymond Toy (＠rtoy) 26 Mar '26

26 Mar '26

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/a232fbc5465510a5247fc4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a232fbc5465510a5247fc4… 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] Fix error in computing fixup kind for movz/movk
by Raymond Toy (＠rtoy) 26 Mar '26

26 Mar '26

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: a232fbc5 by Raymond Toy at 2026-03-26T07:02:22-07:00 Fix error in computing fixup kind for movz/movk Was calling intern on a symbol (symbolicate). Replace it with a simple format that returns a string for intern. [skip-ci] - - - - - 1 changed file: - src/compiler/arm64/insts.lisp Changes: ===================================== src/compiler/arm64/insts.lisp ===================================== @@ -1995,10 +1995,8 @@ (emit-format-move-wide segment ,sf ,opc #b100101 hw src (reg-tn-encoding rd))) (fixup - (let ((fixup-name (intern - (symbolicate (symbol-name ,fixup-kind) - (format nil "-~D" lsl)) - :keyword))) + (let ((fixup-name (intern (format nil "~A-~D" ,fixup-kind lsl) + :keyword))) ;; Fixup names are like :movz-0, :movz-16, :movz-32, :movz-48. (note-fixup segment fixup-name src)) (emit-format-move-wide segment ,sf ,opc #b100101 hw 0 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a232fbc5465510a5247fc46… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/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

1 0

[Git][cmucl/cmucl][arm64-dev-1] Updates for arm64
by Raymond Toy (＠rtoy) 26 Mar '26

26 Mar '26

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: bf1c1a9b by Raymond Toy at 2026-03-25T21:21:29-07:00 Updates for arm64 Not sure these are right, but we follow some of the amd64 changes. Fixups are implemented for arm64. I thinks this is right. ARM64 uses the same cold-fset as sparc which stores an fdefn object in the raw-addr-slot. [skip-ci] - - - - - 1 changed file: - src/compiler/generic/new-genesis.lisp Changes: ===================================== src/compiler/generic/new-genesis.lisp ===================================== @@ -148,7 +148,9 @@ "Return a descriptor for a block of LENGTH bytes out of SPACE. The free pointer is boosted as necessary. If any additional memory is needed, we vm_allocate it. The descriptor returned is a pointer of type LOWTAG." - (let* ((bytes (round-up length #+(or amd64 arm64) 16 #-(or amd64 arm64) (ash 1 vm:lowtag-bits))) + (let* ((bytes (round-up length + #+(or amd64 arm64) 16 + #-(or amd64 arm64) (ash 1 vm:lowtag-bits))) (offset (space-free-pointer space)) (new-free-ptr (+ offset (ash bytes (- vm:word-shift))))) (when (> new-free-ptr (space-words-allocated space)) @@ -443,9 +445,10 @@ (copy-to-system-area bytes (* vm:vector-data-offset ;; the word size of the native backend which ;; may be different from the target backend - (if (= (c:backend-fasl-file-implementation - c::*native-backend*) - #.c:amd64-fasl-file-implementation) + (if (member (c:backend-fasl-file-implementation + c::*native-backend*) + '(#.c:amd64-fasl-file-implementation + #.c:arm64-fasl-file-implementation)) 64 32)) (descriptor-sap des) @@ -1012,7 +1015,8 @@ (#.vm:function-header-type (if (or (c:backend-featurep :sparc) (c:backend-featurep :ppc) - (c:backend-featurep :arm)) + (c:backend-featurep :arm) + (c:backend-featurep :arm64)) defn (make-random-descriptor (+ (logandc2 (descriptor-bits defn) vm:lowtag-mask) @@ -2174,7 +2178,7 @@ (clrhash *cold-foreign-hash*) ;; This has gotta be the first entry. This has to match what ;; os_foreign_linkage_init does! - #+(or x86 amd64) + #+(or x86 amd64 arm64) (cold-register-foreign-linkage (vm::extern-alien-name "resolve_linkage_tramp") :code) #+(or sparc ppc) (progn @@ -2435,7 +2439,27 @@ (imm4 (ldb (byte 4 12) adjusted-value)) (imm12 (ldb (byte 12 0) adjusted-value))) (setf (sap-ref-32 sap 0) - (maybe-byte-swap (logior inst (ash imm4 16) imm12)))))))) + (maybe-byte-swap (logior inst (ash imm4 16) imm12)))))) + (#.c:arm64-fasl-file-implementation + (let ((inst (maybe-byte-swap (sap-ref-32 sap 0)))) + ;; Grab either the low (:movw) or high (:movt) 16 bits of the + ;; value. Then smash that value into the inst at the right + ;; place. + (let* ((adjusted-value + (ecase kind + ((:movz-0 :movk-0) + (ldb (byte 16 0) value)) + ((:movz-16 :movk-16) + (ldb (byte 16 16) value)) + ((:movz-32 :movk-32) + (ldb (byte 16 32) value)) + ((:movz-48 :movk-48) + (ldb (byte 16 48) value))))) + (setf (sap-ref-32 0) + (maybe-byte-swap + (dpb adjusted-value + (byte 16 5) + inst)))))))) (undefined-value)) (defun linkage-info-to-core () View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bf1c1a9bd6b214f9930cdf5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bf1c1a9bd6b214f9930cdf5… 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] 4 commits: Change foreign-linkage-space-start type for arm64
by Raymond Toy (＠rtoy) 26 Mar '26

26 Mar '26

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: dc770902 by Raymond Toy at 2026-03-25T17:53:45-07:00 Change foreign-linkage-space-start type for arm64 Used to be (unsigned-byte 32), but for arm64, we want (unsigned-byte 64). We could just use unsigned-byte, but for compatibility with existing ports, use 32-bits except for arm64. Compiling this causes a restartable error about BACKEND being defined incompatibility. Select the clobber-it restart. (We should fix this.) - - - - - 99e299f9 by Raymond Toy at 2026-03-25T17:56:39-07:00 Oops. Forgot a closing paren. - - - - - d599bf13 by Raymond Toy at 2026-03-25T17:56:55-07:00 Set up space address for arm64 We can't use the low 4GB address space. Use large values for our spaces, including linkage. Somewhat arbitrary right now. - - - - - b324b23c by Raymond Toy at 2026-03-25T19:26:38-07:00 Update the fixup names for movz and friends I think we need to know how much the value was shifted in movz. So the fixup names include the the shift used. Thus, instead of just :movz, we have :movz-0, :movz-16, :movz-32, and :movz-48. new-genesis needs to make a note of this too. [skip-ci] - - - - - 3 changed files: - src/compiler/arm64/insts.lisp - src/compiler/arm64/parms.lisp - src/compiler/backend.lisp Changes: ===================================== src/compiler/arm64/insts.lisp ===================================== @@ -1995,7 +1995,12 @@ (emit-format-move-wide segment ,sf ,opc #b100101 hw src (reg-tn-encoding rd))) (fixup - (note-fixup segment ,fixup-kind src) + (let ((fixup-name (intern + (symbolicate (symbol-name ,fixup-kind) + (format nil "-~D" lsl)) + :keyword))) + ;; Fixup names are like :movz-0, :movz-16, :movz-32, :movz-48. + (note-fixup segment fixup-name src)) (emit-format-move-wide segment ,sf ,opc #b100101 hw 0 (reg-tn-encoding rd))))))))) (def movn 0 1 :movn) ; Move with NOT, 64-bit @@ -3815,7 +3820,7 @@ (inst movk temp (ldb (byte 16 16) delta) :lsl 16) (inst movk temp (ldb (byte 16 32) delta) :lsl 32) (inst movk temp (ldb (byte 16 48) delta) :lsl 48) - (inst add dst src temp))))))) + (inst add dst src temp)))))) ;; code = fn - fn-ptr-type - header - label-offset + other-pointer-tag (define-instruction compute-code-from-fn (segment dst src label temp) @@ -3883,8 +3888,12 @@ (unless (zerop hw2) (inst movk reg hw2 :lsl 32)) (unless (zerop hw3) (inst movk reg hw3 :lsl 48)))))) (fixup + ;; Pass the fixup to each instruction -- movz/movk note the fixup + ;; internally with the appropriate LSL-encoded name. (inst movz reg value) - (inst movk reg value :lsl 16)))) + (inst movk reg value :lsl 16) + (inst movk reg value :lsl 32) + (inst movk reg value :lsl 48)))) (define-instruction-macro li (reg value) `(%li ,reg ,value)) ===================================== src/compiler/arm64/parms.lisp ===================================== @@ -45,7 +45,7 @@ ;;; ADRP + ADD + BR sequence (3 instructions = 12 bytes), rounded up to ;;; 16 bytes for alignment. (setf (c::backend-foreign-linkage-space-start *target-backend*) - #x0f800000 + #x600000000000 (c::backend-foreign-linkage-entry-size *target-backend*) 16) @@ -245,14 +245,13 @@ ;;; Where to put the different spaces. Must match the C code (arm64-validate.h)! ;;; ;;; AArch64 virtual address space is 48 bits (256 TiB) with the low -;;; half available to user-space processes. We place the Lisp spaces -;;; in the first gigabyte, mirroring the SPARC layout but noting that -;;; on AArch64 the upper 16 bits of a 64-bit address must match bit 47 +;;; half available to user-space processes. Note that on AArch64 the +;;; upper 16 bits of a 64-bit address must match bit 47 ;;; (tagged-address extension); user-space addresses are therefore in ;;; the range 0x0000_0000_0000_0000 – 0x0000_7FFF_FFFF_FFFF. -(defconstant target-read-only-space-start #x10000000) -(defconstant target-static-space-start #x28000000) -(defconstant target-dynamic-space-start #x40000000) +(defconstant target-read-only-space-start #x610000000000) +(defconstant target-static-space-start #x620000000000) +(defconstant target-dynamic-space-start #x630000000000) (defconstant target-foreign-linkage-space-start (c:backend-foreign-linkage-space-start *target-backend*)) ===================================== src/compiler/backend.lisp ===================================== @@ -236,7 +236,8 @@ ;; The foreign linkage space start and size - (foreign-linkage-space-start 0 :type (unsigned-byte 32)) + (foreign-linkage-space-start 0 :type (unsigned-byte #-arm64 32 + #+arm64 64)) (foreign-linkage-entry-size 0 :type index)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/27162e939502ce0ab10c47… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/27162e939502ce0ab10c47… 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] Define arm64 fasl file version number and name.
by Raymond Toy (＠rtoy) 24 Mar '26

24 Mar '26

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: 81a7dd3d by Raymond Toy at 2026-03-24T15:36:50-07:00 Define arm64 fasl file version number and name. [skip-ci] - - - - - 1 changed file: - src/compiler/generic/vm-macs.lisp Changes: ===================================== src/compiler/generic/vm-macs.lisp ===================================== @@ -239,7 +239,8 @@ sgi-fasl-file-implementation ppc-fasl-file-implementation amd64-fasl-file-implementation - arm-fasl-file-implementation)) + arm-fasl-file-implementation + arm64-fasl-file-implementation)) ;;; Constants for the different implementations. These are all defined in ;;; one place to make sure they are all unique. @@ -247,7 +248,8 @@ (defparameter fasl-file-implementations '(nil "Pmax" "Sparc" "RT" "RT/AFPA" "x86" "HPPA" "Big-endian byte-code" "Little-endian byte-code" "Alpha" "SGI" "PPC" "AMD64" - "ARM")) + "ARM" + "ARM64/aarch64")) (defconstant pmax-fasl-file-implementation 1) (defconstant sparc-fasl-file-implementation 2) (defconstant rt-fasl-file-implementation 3) @@ -261,6 +263,7 @@ (defconstant ppc-fasl-file-implementation 11) (defconstant amd64-fasl-file-implementation 12) (defconstant arm-fasl-file-implementation 13) +(defconstant arm64-fasl-file-implementation 14) ;;; The maximum number of SCs in any implementation. (defconstant sc-number-limit 32) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/81a7dd3d43e8ba5b2bfaee4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/81a7dd3d43e8ba5b2bfaee4… 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] 2 commits: Document integer-with-a-bite-out
by Raymond Toy (＠rtoy) 24 Mar '26

24 Mar '26

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: f7324a79 by Raymond Toy at 2026-03-24T15:03:35-07:00 Document integer-with-a-bite-out Not used in arm64, but let's just document what it does for posterity. I always wondered what it did. - - - - - 8555c8f4 by Raymond Toy at 2026-03-24T15:31:33-07:00 Update and fix positive-fixnum-bits. Used Claude to update this. Only major change was that currently fixnums are only 30 bits long, not more to match current 32-bit lisps. (Hopefully that will change some day.) Documented the fpcr/fpsr layout which is pretty helpful. And we're little-endian, not big-endian. [skip-ci] - - - - - 2 changed files: - src/compiler/arm64/arith.lisp - src/compiler/arm64/parms.lisp Changes: ===================================== src/compiler/arm64/arith.lisp ===================================== @@ -772,6 +772,14 @@ (:affected) (:policy :fast-safe)) +;;; INTEGER-WITH-A-BITE-OUT -- the full signed S-bit range with the top BITE +;;; values removed from the upper end. That is: +;;; (integer -(2^(s-1)) (2^(s-1) - bite - 1)) +;;; +;;; Useful for immediate constants where the maximum positive value must be +;;; avoided to prevent overflow in subsequent arithmetic. Examples: +;;; (integer-with-a-bite-out 14 4) => (integer -8192 8187) ; 14-bit signed, top 4 missing +;;; (integer-with-a-bite-out 8 1) => (integer -128 126) ; 8-bit signed, top 1 missing (deftype integer-with-a-bite-out (s bite) (cond ((eq s '*) 'integer) ((and (integerp s) (> s 1)) ===================================== src/compiler/arm64/parms.lisp ===================================== @@ -1,4 +1,4 @@ -;;; -*- Package: SPARC -*- +;;; -*- Package: ARM64 -*- ;;; ;;; ********************************************************************** ;;; This code was written as part of the CMU Common Lisp project at @@ -10,49 +10,53 @@ ;;; ********************************************************************** ;;; ;;; This file contains some parameterizations of various VM -;;; attributes for ARM. This file is separate from other stuff so -;;; that it can be compiled and loaded earlier. +;;; attributes for the ARM64 (AArch64) architecture. This file is +;;; separate from other stuff so that it can be compiled and loaded +;;; earlier. ;;; -;;; Converted from SPARC to ARM. +;;; Written by Rob MacLachlan (original SPARC version). +;;; Converted to ARM64 by [ARM64 port contributors]. +;;; Derived from the SPARC and PPC ports. ;;; (in-package "ARM64") -;;(intl:textdomain "cmucl-sparc-vm") +(intl:textdomain "cmucl-arm64-vm") (use-package "C") - + ;;;; Compiler constants. (eval-when (compile eval load) -(adjoin :linux (backend-features *target-backend*)) (setf (backend-name *target-backend*) "ARM64") -(setf (backend-version *target-backend*) - "ARM64/Linux") - +(setf (backend-version *target-backend*) "ARM64/AArch64") (setf (backend-fasl-file-type *target-backend*) "arm64f") (setf (backend-fasl-file-implementation *target-backend*) - arm-fasl-file-implementation) + arm64-fasl-file-implementation) (setf (backend-fasl-file-version *target-backend*) byte-fasl-file-version) (setf (backend-register-save-penalty *target-backend*) 3) - -;; Only supporting little-endian ARM for now. +;; AArch64 is a little-endian architecture by default (BE8 mode exists +;; but is uncommon and not targeted here). (setf (backend-byte-order *target-backend*) :little-endian) (setf (backend-page-size *target-backend*) 4096) +;;; Foreign linkage space. The start address must match arm64-validate.h +;;; and the entry size must agree with arm64-arch.c. Each entry is a +;;; ADRP + ADD + BR sequence (3 instructions = 12 bytes), rounded up to +;;; 16 bytes for alignment. (setf (c::backend-foreign-linkage-space-start *target-backend*) - #x0f000000 + #x0f800000 (c::backend-foreign-linkage-entry-size *target-backend*) - ;; FIXME: Update this when we figure out how to do - ;; linkage-tables on ARM. 16) + ); eval-when (pushnew :new-assembler *features*) - + ;;;; Machine Architecture parameters: +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(word-bits byte-bits char-bits word-shift word-bytes char-bytes fixnum-tag-bits fixnum-tag-mask positive-fixnum-bits @@ -76,10 +80,13 @@ #+double-double (export '(double-double-float-digits)) - +) ; eval-when + (eval-when (compile load eval) +;;; AArch64 is a 64-bit architecture: one Lisp descriptor occupies one +;;; 64-bit word. (defconstant word-bits 64 "Number of bits per word where a word holds one lisp descriptor.") @@ -92,21 +99,22 @@ (defconstant char-bytes (truncate char-bits byte-bits) "Number of bytes needed to represent a character") +;;; word-shift = log2(word-bytes) = log2(8) = 3 (defconstant word-shift (1- (integer-length (/ word-bits byte-bits))) "Number of bits to shift between word addresses and byte addresses.") (defconstant word-bytes (/ word-bits byte-bits) "Number of bytes in a word.") +;;; AArch64 uses the same 3-bit lowtag scheme as SPARC/PPC. (defconstant lowtag-bits 3 "Number of bits at the low end of a pointer used for type information.") (defconstant lowtag-mask (1- (ash 1 lowtag-bits)) "Mask to extract the low tag bits from a pointer.") - + (defconstant lowtag-limit (ash 1 lowtag-bits) - "Exclusive upper bound on the value of the low tag bits from a - pointer.") + "Exclusive upper bound on the value of the low tag bits from a pointer.") (defconstant fixnum-tag-bits (1- lowtag-bits) "Number of tag bits used for a fixnum") @@ -114,15 +122,20 @@ (defconstant fixnum-tag-mask (1- (ash 1 fixnum-tag-bits)) "Mask to get the fixnum tag") -(defconstant positive-fixnum-bits (- word-bits fixnum-tag-bits 1) - "Maximum number of bits in a positive fixnum") +(defconstant positive-fixnum-bits (- 32 fixnum-tag-bits 1) + "Maximum number of bits in a positive fixnum. + Although the machine word is 64 bits, fixnums are kept within a + signed 32-bit range for compatibility with the rest of CMU CL.") -;; FIXME: All of the IEEE-754 float parms should probably be split -;; into a separate file to be shared by all platforms using standard -;; IEEE-754 single and double precision floats. +;;; Float layout constants. IEEE 754 applies uniformly across +;;; architectures; only the sign-bit position changes with word width. +;;; For AArch64 (64-bit word) we use bit 63 as the float sign bit, but +;;; for the 32-bit single-float representation the sign is still bit 31 +;;; within the 32-bit encoding word. (defconstant float-sign-shift 31) -(defconstant single-float-bytes 4) ; Bytes to hold a single-float +;;; Single-float (32-bit IEEE 754 binary32). Identical to SPARC/PPC. +(defconstant single-float-bytes 4) (defconstant single-float-bias 126) (defconstant single-float-exponent-byte (byte 8 23)) (defconstant single-float-significand-byte (byte 23 0)) @@ -131,7 +144,8 @@ (defconstant single-float-hidden-bit (ash 1 23)) (defconstant single-float-trapping-nan-bit (ash 1 22)) -(defconstant double-float-bytes 8) ; Bytes to hold a double-float +;;; Double-float (64-bit IEEE 754 binary64). Identical to SPARC/PPC. +(defconstant double-float-bytes 8) (defconstant double-float-bias 1022) (defconstant double-float-exponent-byte (byte 11 20)) (defconstant double-float-significand-byte (byte 20 0)) @@ -143,63 +157,101 @@ (defconstant single-float-digits (+ (byte-size single-float-significand-byte) 1)) +;;; double-float-digits = 20 + 32 + 1 = 53 (IEEE 754 binary64). +;;; The literal 32 matches the SPARC formula; word-bits cannot be used +;;; here because on ARM64 word-bits is 64, which would give the wrong answer. (defconstant double-float-digits - (+ (byte-size double-float-significand-byte) word-bits 1)) + (+ (byte-size double-float-significand-byte) 32 1)) #+double-double (defconstant double-double-float-digits (* 2 double-float-digits)) -;; ARM specific information -;; See B6.1.39: FPSCR, Floating-point Status and Control Regiser, PMSA -(defconstant float-denormal-trap-bit (ash 1 15)) ; IDE bit[15] -(defconstant float-inexact-trap-bit (ash 1 12)) ; IXE bit[12] -(defconstant float-underflow-trap-bit (ash 1 11)) ; UFE bit[11] -(defconstant float-overflow-trap-bit (ash 1 10)) ; OFE bit[10] -(defconstant float-divide-by-zero-trap-bit (ash 1 9)) ; DZE bit[9] -(defconstant float-invalid-trap-bit (ash 1 8)) ; IOE bit[8] - -(defconstant float-round-to-nearest 0) ; #b00 Round to Nearest -(defconstant float-round-to-positive 1) ; #b01 Round towards Plus Infinity -(defconstant float-round-to-negative 2) ; #b10 Round towards Minus Infinity -(defconstant float-round-to-zero 3) ; #b11 Round towards Zero - -(defconstant float-rounding-mode (byte 2 22)) ; RMode bits[23:22] - -;; The trap enable bits are split with the IDE bit separate from the -;; rest of the enable bits. We're ignoring the IDE bit for now until -;; float-traps support it. -(defconstant float-traps-byte (byte 5 8)) ; Trap enable bits -;; There doesn't appear to be separate accrued (sticky) and current -;; exceptions. We also ignore the IDC bit. -(defconstant float-sticky-bits (byte 5 0)) ; Cumulative excection bits Bits[4:0] -(defconstant float-exceptions-byte (byte 5 0)) ; Same as cumulative - -;; Flush-to-zero bit -(defconstant float-fast-bit (ash 1 24)) +;;; AArch64 FPCR/FPSR trap and rounding-mode bits. +;;; +;;; FPCR layout (Floating-Point Control Register): +;;; [26] IDE – Input Denormal exception trap enable +;;; [25] IXE – Inexact trap enable +;;; [24] UFE – Underflow trap enable +;;; [23] OFE – Overflow trap enable +;;; [22] DZE – Divide-by-Zero trap enable +;;; [21] IOE – Invalid Operation trap enable +;;; [23:22] RMode – Rounding mode +;;; +;;; FPSR layout (Floating-Point Status Register): +;;; [4] QC – Cumulative saturation (SIMD) +;;; [3] IDC – Input Denormal cumulative +;;; [2:0] – (reserved) +;;; Bits 0-4 of the low byte carry the IEEE exception sticky flags: +;;; [4] IXC – Inexact +;;; [3] UFC – Underflow +;;; [2] OFC – Overflow +;;; [1] DZC – Divide-by-Zero +;;; [0] IOC – Invalid Operation +;;; +;;; The trap-enable bits in FPCR use the same bit positions as FPSR +;;; sticky flags, offset by 8. We follow the SPARC convention and +;;; name the FPCR trap-enable fields here; the runtime uses them when +;;; installing/querying the floating-point environment. + +;;; Exception / trap-enable bit positions within their respective +;;; FPCR byte (bits 8..13) and FPSR byte (bits 0..4). +(defconstant float-inexact-trap-bit (ash 1 4)) ; IXE / IXC +(defconstant float-underflow-trap-bit (ash 1 3)) ; UFE / UFC +(defconstant float-overflow-trap-bit (ash 1 2)) ; OFE / OFC +(defconstant float-divide-by-zero-trap-bit (ash 1 1)) ; DZE / DZC +(defconstant float-invalid-trap-bit (ash 1 0)) ; IOE / IOC +(defconstant float-imprecise-trap-bit float-inexact-trap-bit) + +;;; Rounding mode encoding in FPCR bits [23:22]. +(defconstant float-round-to-nearest 0) ; RN (ties to even) +(defconstant float-round-to-positive 1) ; RP +(defconstant float-round-to-negative 2) ; RM +(defconstant float-round-to-zero 3) ; RZ + +;;; Byte descriptors for fields within the 32-bit FPCR value. +(defconstant float-rounding-mode (byte 2 22)) ; RMode field +(defconstant float-traps-byte (byte 6 8)) ; trap-enable bits 8..13 +(defconstant float-exceptions-byte (byte 6 0)) ; FPSR sticky bits 0..5 +(defconstant float-sticky-bits (byte 6 0)) ; alias for exceptions + +;;; Flush-to-zero / fast mode bit in FPCR. +;;; When set, AArch64 flushes denormal inputs/outputs to zero +;;; (equivalent to the SPARC EFM bit). +(defconstant float-fast-bit (ash 1 24)) ; FZ bit in FPCR ); eval-when ;;; NUMBER-STACK-DISPLACEMENT ;;; ;;; The number of bytes reserved above the number stack pointer. -;;; -;;; FIXME: Use the right value! +;;; AArch64 does not have SPARC-style register windows, so no window- +;;; spill area is needed. We reserve one word (8 bytes) as a +;;; red-zone / alignment pad to match common ABI expectations. (defconstant number-stack-displacement - 0) - + (* 1 vm:word-bytes)) + + ;;;; Description of the target address space. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(target-read-only-space-start target-static-space-start target-dynamic-space-start target-foreign-linkage-space-start target-foreign-linkage-entry-size)) +) -;;; Where to put the different spaces. Must match the C code! -;;; +;;; Where to put the different spaces. Must match the C code (arm64-validate.h)! +;;; +;;; AArch64 virtual address space is 48 bits (256 TiB) with the low +;;; half available to user-space processes. We place the Lisp spaces +;;; in the first gigabyte, mirroring the SPARC layout but noting that +;;; on AArch64 the upper 16 bits of a 64-bit address must match bit 47 +;;; (tagged-address extension); user-space addresses are therefore in +;;; the range 0x0000_0000_0000_0000 – 0x0000_7FFF_FFFF_FFFF. (defconstant target-read-only-space-start #x10000000) -(defconstant target-static-space-start #x30000000) +(defconstant target-static-space-start #x28000000) (defconstant target-dynamic-space-start #x40000000) (defconstant target-foreign-linkage-space-start @@ -207,12 +259,12 @@ (defconstant target-foreign-linkage-entry-size (c:backend-foreign-linkage-entry-size *target-backend*)) - + ;;;; Other random constants. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(halt-trap pending-interrupt-trap error-trap cerror-trap breakpoint-trap function-end-breakpoint-trap - not-implemented-trap after-breakpoint-trap allocation-trap pseudo-atomic-trap object-not-list-trap object-not-instance-trap @@ -222,12 +274,15 @@ #+heap-overflow-check (export '(dynamic-space-overflow-error-trap dynamic-space-overflow-warning-trap)) +) -;; These values are used as the immediate value in a UDF instruction. -;; Note that Linux on arm appears to use udf 16 as its trace/breakpoint -;; trap, so we shouldn't use this for Lisp. -(defenum (:suffix -trap :start 4) - function-header ; This value must be a multiple of 4! +;;; Trap codes are encoded as the immediate operand of the UDF (Undefined +;;; instruction) used to signal synchronous traps to the runtime. The +;;; encoding must match arm64-arch.c. +;;; +;;; We start at 8 (same as SPARC) to leave room for low values that may +;;; be used by the OS or debugger. +(defenum (:suffix -trap :start 8) halt pending-interrupt error @@ -239,14 +294,10 @@ dynamic-space-overflow-warning #+heap-overflow-check dynamic-space-overflow-error - not-implemented - ;; This is the trap number to use when a pseudo-atomic section has - ;; been interrupted. - pseudo-atomic ) ;; Make sure this starts AFTER the last element of the above enum! -(defenum (:prefix object-not- :suffix -trap :start 20) +(defenum (:prefix object-not- :suffix -trap :start 16) list instance) @@ -256,10 +307,12 @@ function-prologue function-epilogue) - + ;;;; Static symbols. +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(static-symbols static-functions)) +) ;;; These symbols are loaded into static space directly after NIL so ;;; that the system can compute their address by adding a constant @@ -303,8 +356,6 @@ lisp::*free-interrupt-context-index* unix::*interrupts-enabled* unix::*interrupt-pending* - lisp::*pseudo-atomic-atomic* - lisp::*pseudo-atomic-interrupted* ;; Foreign linkage stuff #+linkage-table @@ -314,22 +365,11 @@ lisp::*cmucl-lib* lisp::*cmucl-core-path* - *binding-stack-pointer* - - ;; The real C stack pointer - *number-stack-pointer* - - ;; The number frame pointer (aka NFP) - *number-frame-pointer* - - ;; Gc - #-gencgc - lisp::*allocation-pointer* - ;; Gencgc - ;; #+gencgc *current-region-free-pointer* + ;; current-region-end-addr is a 64-bit physical address; when read + ;; back from Lisp it is a fixnum shifted left by fixnum-tag-bits. #+gencgc *current-region-end-addr* @@ -342,9 +382,13 @@ :key-and-value :key-or-value + ;; FP constants + *fp-constant-0d0* + *fp-constant-0f0* + lisp::*unidata-path* lisp::*lisp-implementation-version* - + ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. @@ -368,31 +412,51 @@ )) - ;;;; Assembler parameters: -;;; The number of bits per element in the assemblers code vector. -;;; +;;; The number of bits per element in the assembler's code vector. +;;; AArch64 instructions are always 32 bits wide (4 bytes), but the +;;; assembler code-vector element unit is still 8-bit bytes, matching +;;; every other CMU CL port. (defparameter *assembly-unit-length* 8) - -(export '(pseudo-atomic-trap + +(eval-when (:compile-toplevel :load-toplevel :execute) +(export '(pseudo-atomic-trap allocation-trap pseudo-atomic-value pseudo-atomic-interrupted-value)) +) + +;;;; Pseudo-atomic trap number. +;;;; +;;;; On AArch64 we encode synchronous traps with UDF (permanently +;;;; undefined instruction), whose 16-bit immediate is the trap code. +;;;; There is no software-trap instruction analogous to SPARC's TRAP, +;;;; so pseudo-atomic-trap is an alias for the pending-interrupt-trap +;;;; UDF code. The value must match arm64-arch.c. +(defconstant pseudo-atomic-trap pending-interrupt-trap) + +;;;; Allocation trap number. +;;;; +;;;; This is the UDF immediate used when inline allocation overflows +;;;; the current region. Must match arm64-arch.c. +(defconstant allocation-trap + ;; allocation-trap is encoded as the UDF immediate in macros.lisp. + ;; Re-export the value used there so C code and Lisp agree. + ;; + ;; The numeric value 31 (same as SPARC) is chosen to be distinct from + ;; all values in the halt..after-breakpoint range (8..14) and the + ;; object-not-*-trap range (16..17). + 31) + ;;;; Pseudo-atomic flag ;;;; -;;;; This value is added to *pseudo-atomic-atomic* to indicate a -;;;; pseudo-atomic section. +;;;; This value is ORed into ALLOC-TN (X14) to mark a pseudo-atomic +;;;; section, matching the SPARC and PPC convention of using the bit +;;;; just below the lowtag field. (defconstant pseudo-atomic-value (ash 1 (1- vm::lowtag-bits))) ;;;; Pseudo-atomic-interrupted-mask ;;;; -;;;; This is a mask used to check if a pseudo-atomic section was -;;;; interrupted. This is indicated by least-significant bit of -;;;; *pseudo-atomic-atomic* being 1. -;;;; -;;;; FIXME: This is based on the sparc port where the pseudo-atomic -;;;; stuff is implemented as bits on the alloc-tn. We don't have an -;;;; alloc-tn on ARM. So should we emulate that using -;;;; *pseudo-atomic-atomic* or use *pseudo-atomic-interrupted* as on -;;;; x86? +;;;; AArch64 (like SPARC) signals a pseudo-atomic interrupt via the +;;;; least-significant bit of ALLOC-TN. (defconstant pseudo-atomic-interrupted-value 1) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ba1a3d4c081ff5f3765baa… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ba1a3d4c081ff5f3765baa… 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

1 0

[Git][cmucl/cmucl][arm64-dev-1] word-index-ref is word64-index-ref on arm64
by Raymond Toy (＠rtoy) 23 Mar '26

23 Mar '26

Raymond Toy pushed to branch arm64-dev-1 at cmucl / cmucl Commits: aec50997 by Raymond Toy at 2026-03-23T16:24:28-07:00 word-index-ref is word64-index-ref on arm64 [skip-ci] - - - - - 1 changed file: - src/compiler/arm64/call.lisp Changes: ===================================== src/compiler/arm64/call.lisp ===================================== @@ -1183,7 +1183,7 @@ ;;; More args are stored consecutively on the stack, starting immediately at ;;; the context pointer. The context pointer is not typed, so the lowtag is 0. ;;; -(define-vop (more-arg word-index-ref) +(define-vop (more-arg word64-index-ref) (:variant 0 0) (:translate %more-arg)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/aec509979db4c98eb0601c6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/aec509979db4c98eb0601c6… 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

1 0