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

Commits:

1 changed file:

Changes:

  • src/compiler/generic/new-genesis.lisp
    ... ... @@ -148,7 +148,9 @@
    148 148
       "Return a descriptor for a block of LENGTH bytes out of SPACE.  The free
    
    149 149
       pointer is boosted as necessary.  If any additional memory is needed, we
    
    150 150
       vm_allocate it.  The descriptor returned is a pointer of type LOWTAG."
    
    151
    -  (let* ((bytes (round-up length #+(or amd64 arm64) 16 #-(or amd64 arm64) (ash 1 vm:lowtag-bits)))
    
    151
    +  (let* ((bytes (round-up length
    
    152
    +			  #+(or amd64 arm64) 16
    
    153
    +			  #-(or amd64 arm64) (ash 1 vm:lowtag-bits)))
    
    152 154
     	 (offset (space-free-pointer space))
    
    153 155
     	 (new-free-ptr (+ offset (ash bytes (- vm:word-shift)))))
    
    154 156
         (when (> new-free-ptr (space-words-allocated space))
    
    ... ... @@ -443,9 +445,10 @@
    443 445
         (copy-to-system-area bytes (* vm:vector-data-offset
    
    444 446
     				   ;; the word size of the native backend which
    
    445 447
     				   ;; may be different from the target backend
    
    446
    -				   (if (= (c:backend-fasl-file-implementation
    
    447
    -					   c::*native-backend*)
    
    448
    -					  #.c:amd64-fasl-file-implementation)
    
    448
    +				   (if (member (c:backend-fasl-file-implementation
    
    449
    +						c::*native-backend*)
    
    450
    +					       '(#.c:amd64-fasl-file-implementation
    
    451
    +						 #.c:arm64-fasl-file-implementation))
    
    449 452
     				       64
    
    450 453
     				       32))
    
    451 454
     			 (descriptor-sap des)
    
    ... ... @@ -1012,7 +1015,8 @@
    1012 1015
     		     (#.vm:function-header-type
    
    1013 1016
     		      (if (or (c:backend-featurep :sparc)
    
    1014 1017
     			      (c:backend-featurep :ppc)
    
    1015
    -			      (c:backend-featurep :arm))
    
    1018
    +			      (c:backend-featurep :arm)
    
    1019
    +			      (c:backend-featurep :arm64))
    
    1016 1020
     			  defn
    
    1017 1021
     			  (make-random-descriptor
    
    1018 1022
     			   (+ (logandc2 (descriptor-bits defn) vm:lowtag-mask)
    
    ... ... @@ -2174,7 +2178,7 @@
    2174 2178
       (clrhash *cold-foreign-hash*)
    
    2175 2179
       ;; This has gotta be the first entry.  This has to match what
    
    2176 2180
       ;; os_foreign_linkage_init does!
    
    2177
    -  #+(or x86 amd64)
    
    2181
    +  #+(or x86 amd64 arm64)
    
    2178 2182
       (cold-register-foreign-linkage (vm::extern-alien-name "resolve_linkage_tramp") :code)
    
    2179 2183
       #+(or sparc ppc)
    
    2180 2184
       (progn
    
    ... ... @@ -2435,7 +2439,27 @@
    2435 2439
     		(imm4 (ldb (byte 4 12) adjusted-value))
    
    2436 2440
     		(imm12 (ldb (byte 12 0) adjusted-value)))
    
    2437 2441
     	   (setf (sap-ref-32 sap 0)
    
    2438
    -		 (maybe-byte-swap (logior inst (ash imm4 16) imm12))))))))
    
    2442
    +		 (maybe-byte-swap (logior inst (ash imm4 16) imm12))))))
    
    2443
    +      (#.c:arm64-fasl-file-implementation
    
    2444
    +       (let ((inst (maybe-byte-swap (sap-ref-32 sap 0))))
    
    2445
    +	 ;; Grab either the low (:movw) or high (:movt) 16 bits of the
    
    2446
    +	 ;; value. Then smash that value into the inst at the right
    
    2447
    +	 ;; place.
    
    2448
    +	 (let* ((adjusted-value
    
    2449
    +		  (ecase kind
    
    2450
    +		    ((:movz-0 :movk-0)
    
    2451
    +		     (ldb (byte 16 0) value))
    
    2452
    +		    ((:movz-16 :movk-16)
    
    2453
    +		     (ldb (byte 16 16) value))
    
    2454
    +		    ((:movz-32 :movk-32)
    
    2455
    +		     (ldb (byte 16 32) value))
    
    2456
    +		    ((:movz-48 :movk-48)
    
    2457
    +		     (ldb (byte 16 48) value)))))
    
    2458
    +	   (setf (sap-ref-32 0)
    
    2459
    +		 (maybe-byte-swap
    
    2460
    +		  (dpb adjusted-value
    
    2461
    +		      (byte 16 5)
    
    2462
    +		      inst))))))))
    
    2439 2463
       (undefined-value))
    
    2440 2464
     
    
    2441 2465
     (defun linkage-info-to-core ()