GitLab

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.

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]

Add the arm64 files that need to be compiled

Based on the other versions.

[skip-ci]

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.

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]

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]

Tell clean-target about arm64 fasls named arm64f

Without this clean-target.sh doesn't remove arm64 fasls!

[skip-ci]

We're using :linkage-table for arm64 right now

[skip-ci]

 fi

 find $TARGET -name "*.bytef" -o -name "*.lbytef" -o -name "*.assem" \

+	-o -name "*.arm64f" \

 	-o -name "*.armf" \

 	-o -name "*.axpf" \

 	-o -name "*.hpf" \

 ;;;   (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)

   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))

   (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))

   ;; 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.

     (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)

   (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))

 				  (: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.

 	  (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

 			  (: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))

   (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))

 			  (: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))

   (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))

 			  (: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))

   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))
                           (: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)

   (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

   (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

       (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)

 (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)

      ;; Not implemented yet

      :complex-fp-vops

      :alien-callback

-     :linkage-table

      :random-mt19937

      ))

 	  "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"

 	'("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"

   (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.

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

Commits:

8 changed files:

Changes: