[Git][cmucl/cmucl][master] Simplify bignum-shld and bignum-shrd vops.

[Raymond Toy]

Raymond Toy pushed to branch master at cmucl / cmucl


Commits:
351351df by Raymond Toy at 2016-01-17T23:53:43Z
Simplify bignum-shld and bignum-shrd vops.

One temp variable for bignum-shld can be removed and the only temp
variable for bignum-shld-c can be removed.  Base this on the
digit-ashr vops.  This makes the vops simpler and faster.

- - - - -


1 changed file:

- src/compiler/x86/arith.lisp


Changes:

=====================================
src/compiler/x86/arith.lisp
=====================================
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -1583,80 +1583,48 @@
 (define-vop (bignum-shld)
   (:policy :fast-safe)
   (:translate bignum::%shld)
-  (:args (x :scs (unsigned-reg) :target r)
-	 (shift-in :scs (unsigned-reg))
+  (:args (x :scs (unsigned-reg unsigned-stack) :target r)
+	 (shift-in :scs (unsigned-reg) :to :result)
 	 (amount :scs (unsigned-reg) :target cl))
   (:arg-types unsigned-num unsigned-num unsigned-num)
-  (:results (r :scs (unsigned-reg)))
+  (:results (r :scs (unsigned-reg)
+	       :load-if (not (and (sc-is r unsigned-stack)
+				  (location= x r)))))
   (:result-types unsigned-num)
-  (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
   (:temporary (:sc unsigned-reg :offset ecx-offset
-		   :from (:argument 2) :to (:result 0)) cl)
-  (:generator 4
+		   :from (:argument 2)) cl)
+  (:generator 3
     (move cl amount)
-    (cond ((location= x r)
-	   (inst shld x shift-in :cl))
-	  (t
-	   (move temp x)
-	   (inst shld temp shift-in :cl)
-	   (move r temp)))))
+    (move r x)
+    (inst shld r shift-in :cl)))
   
 (define-vop (bignum-shld-c)
   (:policy :fast-safe)
   (:translate bignum::%shld)
-  (:args (x :scs (unsigned-reg) :target r)
-	 (shift-in :scs (unsigned-reg)))
+  (:args (x :scs (unsigned-reg unsigned-stack) :target r)
+	 (shift-in :scs (unsigned-reg) :to :save))
   (:info shift)
   (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5)))
-  (:results (r :scs (unsigned-reg)))
+  (:results (r :scs (unsigned-reg)
+	       :load-if (not (and (sc-is r unsigned-stack)
+				  (location= x r)))))
   (:result-types unsigned-num)
-  (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
-  (:generator 3
-    (cond ((location= x r)
-	   (inst shld x shift-in shift))
-	  (t
-	   (move temp x)
-	   (inst shld temp shift-in shift)
-	   (move r temp)))))
+  (:generator 2
+    (move r x)
+    (inst shld r shift-in shift)))
 
-(define-vop (bignum-shrd)
-  (:policy :fast-safe)
+(define-vop (bignum-shrd bignum-shld)
   (:translate bignum::%shrd)
-  (:args (x :scs (unsigned-reg) :target r)
-	 (shift-in :scs (unsigned-reg))
-	 (amount :scs (unsigned-reg) :target cl))
-  (:arg-types unsigned-num unsigned-num unsigned-num)
-  (:results (r :scs (unsigned-reg)))
-  (:result-types unsigned-num)
-  (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
-  (:temporary (:sc unsigned-reg :offset ecx-offset
-		   :from (:argument 2) :to (:result 0)) cl)
-  (:generator 4
+  (:generator 3
     (move cl amount)
-    (cond ((location= x r)
-	   (inst shrd x shift-in :cl))
-	  (t
-	   (move temp x)
-	   (inst shrd temp shift-in :cl)
-	   (move r temp)))))
+    (move r x)
+    (inst shrd r shift-in :cl)))
 
-(define-vop (bignum-shrd-c)
-  (:policy :fast-safe)
+(define-vop (bignum-shrd-c bignum-shld-c)
   (:translate bignum::%shrd)
-  (:args (x :scs (unsigned-reg))
-	 (shift-in :scs (unsigned-reg)))
-  (:info shift)
-  (:arg-types unsigned-num unsigned-num (:constant (unsigned-byte 5)))
-  (:results (r :scs (unsigned-reg)))
-  (:result-types unsigned-num)
-  (:temporary (:sc unsigned-reg :from (:argument 0) :to (:result 0)) temp)
-  (:generator 3
-    (cond ((location= x r)
-	   (inst shrd x shift-in shift))
-	  (t
-	   (move temp x)
-	   (inst shrd temp shift-in shift)
-	   (move r temp)))))
+  (:generator 2
+    (move r x)
+    (inst shrd r shift-in shift)))
 
 
 




View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/351351dfc04be5578dc76650c82f501ae704db28
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20160118/345bb237/attachment.html>