Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

1 changed file:

Changes:

  • src/compiler/x86/arith.lisp
    ... ... @@ -196,143 +196,13 @@
    196 196
    197 197
    198 198
    199 
    -;(define-binop + 4 add)
    199 
    +(define-binop + 4 add)
    200 200 
     (define-binop - 4 sub)
    201 201 
     (define-binop logand 2 and)
    202 202 
     (define-binop logior 2 or)
    203 203 
     (define-binop logxor 2 xor)
    204 204
    205 205
    206 
    -;;; Special handling of add on the x86; can use lea to avoid a
    207 
    -;;; register load, otherwise it uses add.
    208 
    -(define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op)
    209 
    -  (:translate +)
    210 
    -  (:args (x :scs (any-reg) :target r
    211 
    -	    :load-if (not (and (sc-is x control-stack)
    212 
    -			       (sc-is y any-reg)
    213 
    -			       (sc-is r control-stack)
    214 
    -			       (location= x r))))
    215 
    -	 (y :scs (any-reg control-stack)))
    216 
    -  (:arg-types tagged-num tagged-num)
    217 
    -  (:results (r :scs (any-reg) :from (:argument 0)
    218 
    -	       :load-if (not (and (sc-is x control-stack)
    219 
    -				  (sc-is y any-reg)
    220 
    -				  (sc-is r control-stack)
    221 
    -				  (location= x r)))))
    222 
    -  (:result-types tagged-num)
    223 
    -  (:note _N"inline fixnum arithmetic")
    224 
    -  (:generator 2
    225 
    -    (cond ((and (sc-is x any-reg) (sc-is y any-reg) (sc-is r any-reg)
    226 
    -		(not (location= x r)))
    227 
    -	   (inst lea r (make-ea :dword :base x :index y :scale 1)))
    228 
    -	  (t
    229 
    -	   (move r x)
    230 
    -	   (inst add r y)))))
    231 
    -
    232 
    -(define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op)
    233 
    -  (:translate +)
    234 
    -  (:args (x :target r :scs (any-reg control-stack)))
    235 
    -  (:info y)
    236 
    -  (:arg-types tagged-num (:constant (signed-byte 30)))
    237 
    -  (:results (r :scs (any-reg)
    238 
    -	       :load-if (not (location= x r))))
    239 
    -  (:result-types tagged-num)
    240 
    -  (:note _N"inline fixnum arithmetic")
    241 
    -  (:generator 1
    242 
    -    (cond ((and (sc-is x any-reg) (sc-is r any-reg) (not (location= x r)))
    243 
    -	   (inst lea r (make-ea :dword :base x :disp (fixnumize y))))
    244 
    -	  (t
    245 
    -	   (move r x)
    246 
    -	   (inst add r (fixnumize y))))))
    247 
    -
    248 
    -(define-vop (fast-+/signed=>signed fast-safe-arith-op)
    249 
    -  (:translate +)
    250 
    -  (:args (x :scs (signed-reg) :target r
    251 
    -	    :load-if (not (and (sc-is x signed-stack)
    252 
    -			       (sc-is y signed-reg)
    253 
    -			       (sc-is r signed-stack)
    254 
    -			       (location= x r))))
    255 
    -	 (y :scs (signed-reg signed-stack)))
    256 
    -  (:arg-types signed-num signed-num)
    257 
    -  (:results (r :scs (signed-reg) :from (:argument 0)
    258 
    -	       :load-if (not (and (sc-is x signed-stack)
    259 
    -				  (sc-is y signed-reg)
    260 
    -				  (location= x r)))))
    261 
    -  (:result-types signed-num)
    262 
    -  (:note _N"inline (signed-byte 32) arithmetic")
    263 
    -  (:generator 5
    264 
    -    (cond ((and (sc-is x signed-reg) (sc-is y signed-reg) (sc-is r signed-reg)
    265 
    -		(not (location= x r)))
    266 
    -	   (inst lea r (make-ea :dword :base x :index y :scale 1)))
    267 
    -	  (t
    268 
    -	   (move r x)
    269 
    -	   (inst add r y)))))
    270 
    -
    271 
    -(define-vop (fast-+-c/signed=>signed fast-safe-arith-op)
    272 
    -  (:translate +)
    273 
    -  (:args (x :target r :scs (signed-reg signed-stack)))
    274 
    -  (:info y)
    275 
    -  (:arg-types signed-num (:constant (signed-byte 32)))
    276 
    -  (:results (r :scs (signed-reg)
    277 
    -	       :load-if (not (location= x r))))
    278 
    -  (:result-types signed-num)
    279 
    -  (:note _N"inline (signed-byte 32) arithmetic")
    280 
    -  (:generator 4
    281 
    -    (cond ((and (sc-is x signed-reg) (sc-is r signed-reg)
    282 
    -		(not (location= x r)))
    283 
    -	   (inst lea r (make-ea :dword :base x :disp y)))
    284 
    -	  (t
    285 
    -	   (move r x)
    286 
    -	   (if (= y 1)
    287 
    -	       (inst inc r)
    288 
    -	     (inst add r y))))))
    289 
    -
    290 
    -(define-vop (fast-+/unsigned=>unsigned fast-safe-arith-op)
    291 
    -  (:translate +)
    292 
    -  (:args (x :scs (unsigned-reg) :target r
    293 
    -	    :load-if (not (and (sc-is x unsigned-stack)
    294 
    -			       (sc-is y unsigned-reg)
    295 
    -			       (sc-is r unsigned-stack)
    296 
    -			       (location= x r))))
    297 
    -	 (y :scs (unsigned-reg unsigned-stack)))
    298 
    -  (:arg-types unsigned-num unsigned-num)
    299 
    -  (:results (r :scs (unsigned-reg) :from (:argument 0)
    300 
    -	       :load-if (not (and (sc-is x unsigned-stack)
    301 
    -				  (sc-is y unsigned-reg)
    302 
    -				  (sc-is r unsigned-stack)
    303 
    -				  (location= x r)))))
    304 
    -  (:result-types unsigned-num)
    305 
    -  (:note _N"inline (unsigned-byte 32) arithmetic")
    306 
    -  (:generator 5
    307 
    -    (cond ((and (sc-is x unsigned-reg) (sc-is y unsigned-reg)
    308 
    -		(sc-is r unsigned-reg) (not (location= x r)))
    309 
    -	   (inst lea r (make-ea :dword :base x :index y :scale 1)))
    310 
    -	  (t
    311 
    -	   (move r x)
    312 
    -	   (inst add r y)))))
    313 
    -
    314 
    -(define-vop (fast-+-c/unsigned=>unsigned fast-safe-arith-op)
    315 
    -  (:translate +)
    316 
    -  (:args (x :target r :scs (unsigned-reg unsigned-stack)))
    317 
    -  (:info y)
    318 
    -  (:arg-types unsigned-num (:constant (unsigned-byte 32)))
    319 
    -  (:results (r :scs (unsigned-reg)
    320 
    -	       :load-if (not (location= x r))))
    321 
    -  (:result-types unsigned-num)
    322 
    -  (:note _N"inline (unsigned-byte 32) arithmetic")
    323 
    -  (:generator 4
    324 
    -    (cond ((and (sc-is x unsigned-reg)
    325 
    -		(sc-is r unsigned-reg)
    326 
    -		(not (location= x r))
    327 
    -		(valid-displacement-p y))
    328 
    -	   (inst lea r (make-ea :dword :base x :disp y)))
    329 
    -	  (t
    330 
    -	   (move r x)
    331 
    -	   (if (= y 1)
    332 
    -	       (inst inc r)
    333 
    -	       (inst add r y))))))
    334 
    -
    335 
    -
    336 206 
     ;;;; Special logand cases: (logand signed unsigned) => unsigned
    337 207
    338 208 
     (define-vop (fast-logand/signed-unsigned=>unsigned
    ... ... @@ -641,25 +511,18 @@
    641 511 
       (:result-types tagged-num)
    642 512 
       (:note _N"inline ASH")
    643 513 
       (:generator 2
    644 
    -    (cond ((and (= amount 1) (not (location= number result)))
    645 
    -	   (inst lea result (make-ea :dword :index number :scale 2)))
    646 
    -	  ((and (= amount 2) (not (location= number result)))
    647 
    -	   (inst lea result (make-ea :dword :index number :scale 4)))
    648 
    -	  ((and (= amount 3) (not (location= number result)))
    649 
    -	   (inst lea result (make-ea :dword :index number :scale 8)))
    514 
    +    (move result number)
    515 
    +    (cond ((plusp amount)
    516 
    +	   ;; We don't have to worry about overflow because of the
    517 
    +	   ;; result type restriction.
    518 
    +	   (inst shl result amount))
    650 519 
     	  (t
    651 
    -	   (move result number)
    652 
    -	   (cond ((plusp amount)
    653 
    -		  ;; We don't have to worry about overflow because of the
    654 
    -		  ;; result type restriction.
    655 
    -		  (inst shl result amount))
    656 
    -		 (t
    657 
    -		  ;; If the amount is greater than 31, only shift by 31.  We
    658 
    -		  ;; have to do this because the shift instructions only look
    659 
    -		  ;; at the low five bits of the result.
    660 
    -		  (inst sar result (min 31 (- amount)))
    661 
    -		  ;; Fixnum correction.
    662 
    -		  (inst and result #xfffffffc)))))))
    520 
    +	   ;; If the amount is greater than 31, only shift by 31.  We
    521 
    +	   ;; have to do this because the shift instructions only look
    522 
    +	   ;; at the low five bits of the result.
    523 
    +	   (inst sar result (min 31 (- amount)))
    524 
    +	   ;; Fixnum correction.
    525 
    +	   (inst and result #xfffffffc)))))
    663 526
    664 527 
     (define-vop (fast-ash-left/fixnum=>fixnum)
    665 528 
       (:translate ash)
    ... ... @@ -699,22 +562,15 @@
    699 562 
       (:result-types unsigned-num)
    700 563 
       (:note _N"inline ASH")
    701 564 
       (:generator 3
    702 
    -    (cond ((and (= amount 1) (not (location= number result)))
    703 
    -	   (inst lea result (make-ea :dword :index number :scale 2)))
    704 
    -	  ((and (= amount 2) (not (location= number result)))
    705 
    -	   (inst lea result (make-ea :dword :index number :scale 4)))
    706 
    -	  ((and (= amount 3) (not (location= number result)))
    707 
    -	   (inst lea result (make-ea :dword :index number :scale 8)))
    565 
    +    (move result number)
    566 
    +    (cond ((plusp amount)
    567 
    +	   ;; We don't have to worry about overflow because of the
    568 
    +	   ;; result type restriction.
    569 
    +	   (inst shl result amount))
    570 
    +	  ((< amount -31)
    571 
    +	   (inst mov result 0))
    708 572 
     	  (t
    709 
    -	   (move result number)
    710 
    -	   (cond ((plusp amount)
    711 
    -		  ;; We don't have to worry about overflow because of the
    712 
    -		  ;; result type restriction.
    713 
    -		  (inst shl result amount))
    714 
    -		 ((< amount -31)
    715 
    -		  (inst mov result 0))
    716 
    -		 (t
    717 
    -		  (inst shr result (- amount))))))))
    573 
    +	   (inst shr result (- amount))))))
    718 574
    719 575 
     (define-vop (fast-ash-c/signed=>signed)
    720 576 
       (:translate ash)
    ... ... @@ -732,23 +588,16 @@
    732 588 
       (:result-types signed-num)
    733 589 
       (:note _N"inline ASH")
    734 590 
       (:generator 3
    735 
    -    (cond ((and (= amount 1) (not (location= number result)))
    736 
    -	   (inst lea result (make-ea :dword :index number :scale 2)))
    737 
    -	  ((and (= amount 2) (not (location= number result)))
    738 
    -	   (inst lea result (make-ea :dword :index number :scale 4)))
    739 
    -	  ((and (= amount 3) (not (location= number result)))
    740 
    -	   (inst lea result (make-ea :dword :index number :scale 8)))
    591 
    +    (move result number)
    592 
    +    (cond ((plusp amount)
    593 
    +	   ;; We don't have to worry about overflow because of the
    594 
    +	   ;; result type restriction.
    595 
    +	   (inst shl result amount))
    741 596 
     	  (t
    742 
    -	   (move result number)
    743 
    -	   (cond ((plusp amount)
    744 
    -		  ;; We don't have to worry about overflow because of the
    745 
    -		  ;; result type restriction.
    746 
    -		  (inst shl result amount))
    747 
    -		 (t
    748 
    -		  ;; If the amount is greater than 31, only shift by 31.  We
    749 
    -		  ;; have to do this because the shift instructions only look
    750 
    -		  ;; at the low five bits of the result.
    751 
    -		  (inst sar result (min 31 (- amount)))))))))
    597 
    +	   ;; If the amount is greater than 31, only shift by 31.  We
    598 
    +	   ;; have to do this because the shift instructions only look
    599 
    +	   ;; at the low five bits of the result.
    600 
    +	   (inst sar result (min 31 (- amount)))))))
    752 601
    753 602 
     (define-vop (fast-ash-c/fixnum=>signed)
    754 603 
       (:translate ash)
    ... ... @@ -767,23 +616,16 @@
    767 616 
       (:note "inline ASH")
    768 617 
       (:generator 1
    769 618 
         (let ((shift (- amount vm:fixnum-tag-bits)))
    770 
    -      (cond ((and (= shift 1) (not (location= number result)))
    771 
    -	     (inst lea result (make-ea :dword :index number :scale 2)))
    772 
    -	    ((and (= shift 2) (not (location= number result)))
    773 
    -	     (inst lea result (make-ea :dword :index number :scale 4)))
    774 
    -	    ((and (= shift 3) (not (location= number result)))
    775 
    -	     (inst lea result (make-ea :dword :index number :scale 8)))
    619 
    +      (move result number)
    620 
    +      (cond ((plusp shift)
    621 
    +	     ;; We don't have to worry about overflow because of the
    622 
    +	     ;; result type restriction.
    623 
    +	     (inst shl result shift))
    776 624 
     	    (t
    777 
    -	     (move result number)
    778 
    -	     (cond ((plusp shift)
    779 
    -		    ;; We don't have to worry about overflow because of the
    780 
    -		    ;; result type restriction.
    781 
    -		    (inst shl result shift))
    782 
    -		   (t
    783 
    -		    ;; If the shift is greater than 31, only shift by 31.  We
    784 
    -		    ;; have to do this because the shift instructions only look
    785 
    -		    ;; at the low five bits of the result.
    786 
    -		    (inst sar result (min 31 (- shift))))))))))
    625 
    +	     ;; If the shift is greater than 31, only shift by 31.  We
    626 
    +	     ;; have to do this because the shift instructions only look
    627 
    +	     ;; at the low five bits of the result.
    628 
    +	     (inst sar result (min 31 (- shift))))))))
    787 629
    788 630 
     (define-vop (fast-ash-left/unsigned=>unsigned)
    789 631 
       (:translate ash)
    ... ... @@ -1907,4 +1749,4 @@
    1907 1749 
     				  vm:other-pointer-type))
    1908 1750 
     	  s1)))
    1909 1751 
     )
    1910 
    -
    \ No newline at end of file
    1752 
    +

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help