[Git][cmucl/cmucl][rtoy-amd64-p1] 3 commits: Update make-ea to be qword instead of dword

[Raymond Toy]

Raymond Toy pushed to branch rtoy-amd64-p1 at cmucl / cmucl


Commits:
a7036919 by Raymond Toy at 2020-08-14T21:53:19-07:00
Update make-ea to be qword instead of dword

The effective addresses should be qwords instead of dwords for the
base tn.

- - - - -
de0474f9 by Raymond Toy at 2020-08-14T21:54:05-07:00
Update reg-tn-encoding to handle float regs

Copied over from the x86 version.

- - - - -
26a395fd by Raymond Toy at 2020-08-14T21:55:31-07:00
Add xmm regs to single-reg and update printer

Update the printer to print out xmm registers using "XMM" instead of
"FR", which was pretty confusing.  But if you remember FR8 is XMM0,
everything works out.  But better to use XMM0.

- - - - -


3 changed files:

- src/compiler/amd64/float-sse2.lisp
- src/compiler/amd64/insts.lisp
- src/compiler/amd64/vm.lisp


Changes:

=====================================
src/compiler/amd64/float-sse2.lisp
=====================================
@@ -30,7 +30,7 @@
 
 (macrolet ((ea-for-xf-desc (tn slot)
 	     `(make-ea
-	       :dword :base ,tn
+	       :qword :base ,tn
 	       :disp (- (* ,slot vm:word-bytes) vm:other-pointer-type))))
   (defun ea-for-sf-desc (tn)
     (ea-for-xf-desc tn vm:single-float-value-slot))
@@ -70,7 +70,7 @@
 
 (macrolet ((ea-for-xf-stack (tn kind)
 	     `(make-ea
-	       :dword :base rbp-tn
+	       :qword :base rbp-tn
 	       :disp (- (* (+ (tn-offset ,tn)
 			      (ecase ,kind (:single 1) (:double 2) (:long 3)))
 			 vm:word-bytes)))))
@@ -605,12 +605,12 @@
 		      (,stack-sc
 		       (if (= (tn-offset fp) esp-offset)
 			   (let* ((offset (* (tn-offset y) word-bytes))
-				  (ea (make-ea :dword :base fp :disp offset)))
+				  (ea (make-ea :qword :base fp :disp offset)))
 			     ,@(ecase format
 				      (:single '((inst movss ea x)))
 				      (:double '((inst movsd ea x)))))
 			   (let ((ea (make-ea
-				      :dword :base fp
+				      :qword :base fp
 				      :disp (- (* (+ (tn-offset y)
 						     ,(case format
 							    (:single 1)


=====================================
src/compiler/amd64/insts.lisp
=====================================
@@ -82,10 +82,16 @@
 
 (defun reg-tn-encoding (tn)
   (declare (type tn tn))
-  (assert (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
-  (let ((offset (tn-offset tn)))
-    (logior (ash (logand offset 1) 2)
-	    (ash offset -1))))
+  ;; ea only has space for three bits of register number: regs r8
+  ;; and up are selected by a REX prefix byte which caller is responsible
+  ;; for having emitted where necessary already
+  (ecase (sb-name (sc-sb (tn-sc tn)))
+    (registers
+     (let ((offset (mod (tn-offset tn) 16)))
+       (logior (ash (logand offset 1) 2)
+               (ash offset -1))))
+    (float-registers
+     (mod (tn-offset tn) 8))))
 
 (defstruct (ea
 	    (:constructor make-ea (size &key base index scale disp))


=====================================
src/compiler/amd64/vm.lisp
=====================================
@@ -427,7 +427,9 @@
 (def-random-reg-tns byte-reg al ah bl bh cl ch dl dh)
 
 ;; added by jrd
-(def-random-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
+(def-random-reg-tns single-reg
+    fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7
+    xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
 
 ;; Added by pw.
 
@@ -526,7 +528,11 @@
 		  (< -1 offset (length name-vec))
 		  (svref name-vec offset))
 	     (format nil "<Unknown Reg: off=~D, sc=~A>" offset sc-name))))
-      (float-registers (format nil "FR~D" offset))
+      (float-registers
+       (format nil (if (< offset 8)
+		       "FR~D"
+		       "XMM~D")
+	       (mod offset 8)))
       (stack (format nil "S~D" offset))
       (constant (format nil "Const~D" offset))
       (immediate-constant "Immed")



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9e953fef8e75ea6d302ce5529c8369a571ebb817...26a395fd35b99ec9c9e78ef13190c52c8f2edeca

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9e953fef8e75ea6d302ce5529c8369a571ebb817...26a395fd35b99ec9c9e78ef13190c52c8f2edeca
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20200815/9a01d536/attachment-0001.htm>