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

Commits:

3 changed files:

Changes:

  • src/compiler/amd64/float-sse2.lisp
    ... ... @@ -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)
    

  • src/compiler/amd64/insts.lisp
    ... ... @@ -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))
    

  • src/compiler/amd64/vm.lisp
    ... ... @@ -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")