Raymond Toy pushed to branch rtoy-amd64-p1 at cmucl / cmucl
Commits:
-
a7036919
by Raymond Toy at 2020-08-14T21:53:19-07:00
-
de0474f9
by Raymond Toy at 2020-08-14T21:54:05-07:00
-
26a395fd
by Raymond Toy at 2020-08-14T21:55:31-07:00
3 changed files:
Changes:
... | ... | @@ -30,7 +30,7 @@ |
30 | 30 |
|
31 | 31 |
(macrolet ((ea-for-xf-desc (tn slot)
|
32 | 32 |
`(make-ea
|
33 |
- :dword :base ,tn
|
|
33 |
+ :qword :base ,tn
|
|
34 | 34 |
:disp (- (* ,slot vm:word-bytes) vm:other-pointer-type))))
|
35 | 35 |
(defun ea-for-sf-desc (tn)
|
36 | 36 |
(ea-for-xf-desc tn vm:single-float-value-slot))
|
... | ... | @@ -70,7 +70,7 @@ |
70 | 70 |
|
71 | 71 |
(macrolet ((ea-for-xf-stack (tn kind)
|
72 | 72 |
`(make-ea
|
73 |
- :dword :base rbp-tn
|
|
73 |
+ :qword :base rbp-tn
|
|
74 | 74 |
:disp (- (* (+ (tn-offset ,tn)
|
75 | 75 |
(ecase ,kind (:single 1) (:double 2) (:long 3)))
|
76 | 76 |
vm:word-bytes)))))
|
... | ... | @@ -605,12 +605,12 @@ |
605 | 605 |
(,stack-sc
|
606 | 606 |
(if (= (tn-offset fp) esp-offset)
|
607 | 607 |
(let* ((offset (* (tn-offset y) word-bytes))
|
608 |
- (ea (make-ea :dword :base fp :disp offset)))
|
|
608 |
+ (ea (make-ea :qword :base fp :disp offset)))
|
|
609 | 609 |
,@(ecase format
|
610 | 610 |
(:single '((inst movss ea x)))
|
611 | 611 |
(:double '((inst movsd ea x)))))
|
612 | 612 |
(let ((ea (make-ea
|
613 |
- :dword :base fp
|
|
613 |
+ :qword :base fp
|
|
614 | 614 |
:disp (- (* (+ (tn-offset y)
|
615 | 615 |
,(case format
|
616 | 616 |
(:single 1)
|
... | ... | @@ -82,10 +82,16 @@ |
82 | 82 |
|
83 | 83 |
(defun reg-tn-encoding (tn)
|
84 | 84 |
(declare (type tn tn))
|
85 |
- (assert (eq (sb-name (sc-sb (tn-sc tn))) 'registers))
|
|
86 |
- (let ((offset (tn-offset tn)))
|
|
87 |
- (logior (ash (logand offset 1) 2)
|
|
88 |
- (ash offset -1))))
|
|
85 |
+ ;; ea only has space for three bits of register number: regs r8
|
|
86 |
+ ;; and up are selected by a REX prefix byte which caller is responsible
|
|
87 |
+ ;; for having emitted where necessary already
|
|
88 |
+ (ecase (sb-name (sc-sb (tn-sc tn)))
|
|
89 |
+ (registers
|
|
90 |
+ (let ((offset (mod (tn-offset tn) 16)))
|
|
91 |
+ (logior (ash (logand offset 1) 2)
|
|
92 |
+ (ash offset -1))))
|
|
93 |
+ (float-registers
|
|
94 |
+ (mod (tn-offset tn) 8))))
|
|
89 | 95 |
|
90 | 96 |
(defstruct (ea
|
91 | 97 |
(:constructor make-ea (size &key base index scale disp))
|
... | ... | @@ -427,7 +427,9 @@ |
427 | 427 |
(def-random-reg-tns byte-reg al ah bl bh cl ch dl dh)
|
428 | 428 |
|
429 | 429 |
;; added by jrd
|
430 |
-(def-random-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
|
|
430 |
+(def-random-reg-tns single-reg
|
|
431 |
+ fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7
|
|
432 |
+ xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
|
|
431 | 433 |
|
432 | 434 |
;; Added by pw.
|
433 | 435 |
|
... | ... | @@ -526,7 +528,11 @@ |
526 | 528 |
(< -1 offset (length name-vec))
|
527 | 529 |
(svref name-vec offset))
|
528 | 530 |
(format nil "<Unknown Reg: off=~D, sc=~A>" offset sc-name))))
|
529 |
- (float-registers (format nil "FR~D" offset))
|
|
531 |
+ (float-registers
|
|
532 |
+ (format nil (if (< offset 8)
|
|
533 |
+ "FR~D"
|
|
534 |
+ "XMM~D")
|
|
535 |
+ (mod offset 8)))
|
|
530 | 536 |
(stack (format nil "S~D" offset))
|
531 | 537 |
(constant (format nil "Const~D" offset))
|
532 | 538 |
(immediate-constant "Immed")
|