[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2013-12-a-1-ge2c9ece
Raymond Toy
rtoy at common-lisp.net
Fri Dec 13 01:25:51 UTC 2013
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via e2c9ecef46e95a79ad7655702088ec1c976267dd (commit)
from 2527de5ed52be53257a51876fe775630333cfc17 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit e2c9ecef46e95a79ad7655702088ec1c976267dd
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Dec 12 17:25:23 2013 -0800
Optimizations to many vops to allow a descriptor for the second arg.
* Allow the second arg to be a descriptor for the basic arithmetic
operations on single floats and double floats. Previously, the
boxed number would be loaded to a temporary reg for the
operation. This saves the load and the extra register.
* Allow a descriptor for the second arg in the comparison vops, the
float conversion vops and the float truncation vops.
* Allow descriptor for sqrt vop.
diff --git a/src/compiler/x86/float-sse2.lisp b/src/compiler/x86/float-sse2.lisp
index 27fddca..7ba25ab 100644
--- a/src/compiler/x86/float-sse2.lisp
+++ b/src/compiler/x86/float-sse2.lisp
@@ -756,32 +756,58 @@
(frob single-float-op single-reg single-float)
(frob double-float-op double-reg double-float))
-(macrolet ((generate (movinst opinst commutative)
+(macrolet ((generate (movinst opinst commutative rtype ea)
`(progn
(cond
((location= x r)
- (inst ,opinst x y))
+ ;; x and r are the same. We can just operate on x,
+ ;; and we're done.
+ (sc-case y
+ (,rtype
+ (inst ,opinst x y))
+ (descriptor-reg
+ (inst ,opinst x (,ea y)))))
((and ,commutative (location= y r))
+ ;; y = r and the operation is commutative, so just
+ ;; do the operation with r and x.
(inst ,opinst y x))
((not (location= r y))
+ ;; x, y, and r are three different regs. So just
+ ;; move r to x and do the operation on r.
(inst ,movinst r x)
- (inst ,opinst r y))
+ (sc-case y
+ (,rtype
+ (inst ,opinst r y))
+ (descriptor-reg
+ (inst ,opinst r (,ea y)))))
(t
+ ;; The hard case where the operation is not
+ ;; commutative, but y might be r. Don't want to
+ ;; destroy y in this case, so use a temp so we
+ ;; don't accidentally overwrite y.
(inst ,movinst tmp x)
- (inst ,opinst tmp y)
+ (sc-case y
+ (,rtype
+ (inst ,opinst tmp y))
+ (descriptor-reg
+ (inst ,opinst tmp (,ea y))))
(inst ,movinst r tmp)))))
(frob (op sinst sname scost dinst dname dcost commutative)
`(progn
(define-vop (,sname single-float-op)
- (:translate ,op)
+ (:args (x :scs (single-reg) :target r)
+ (y :scs (single-reg descriptor-reg)))
+ (:translate ,op)
(:temporary (:sc single-reg) tmp)
(:generator ,scost
- (generate movss ,sinst ,commutative)))
+ (generate movss ,sinst ,commutative single-reg ea-for-sf-desc)))
(define-vop (,dname double-float-op)
+ (:args (x :scs (double-reg) :target r)
+ (y :scs (double-reg descriptor-reg)))
(:translate ,op)
(:temporary (:sc single-reg) tmp)
(:generator ,dcost
- (generate movsd ,dinst ,commutative))))))
+ (generate movsd ,dinst ,commutative double-reg ea-for-df-desc))))))
(frob + addss +/single-float 2 addsd +/double-float 2 t)
(frob - subss -/single-float 2 subsd -/double-float 2 nil)
(frob * mulss */single-float 4 mulsd */double-float 5 t)
@@ -865,11 +891,11 @@
;;; and stack args
(define-vop (single-float-compare float-compare)
- (:args (x :scs (single-reg)) (y :scs (single-reg)))
+ (:args (x :scs (single-reg)) (y :scs (single-reg descriptor-reg)))
(:conditional)
(:arg-types single-float single-float))
(define-vop (double-float-compare float-compare)
- (:args (x :scs (double-reg)) (y :scs (double-reg)))
+ (:args (x :scs (double-reg)) (y :scs (double-reg descriptor-reg)))
(:conditional)
(:arg-types double-float double-float))
@@ -879,7 +905,11 @@
(:vop-var vop)
(:generator 3
(note-this-location vop :internal-error)
- (inst ucomiss x y)
+ (sc-case y
+ (single-reg
+ (inst ucomiss x y))
+ (descriptor-reg
+ (inst ucomiss x (ea-for-sf-desc y))))
;; if PF&CF, there was a NaN involved => not equal
;; otherwise, ZF => equal
(cond (not-p
@@ -897,7 +927,11 @@
(:vop-var vop)
(:generator 3
(note-this-location vop :internal-error)
- (inst ucomisd x y)
+ (sc-case y
+ (double-reg
+ (inst ucomisd x y))
+ (descriptor-reg
+ (inst ucomisd x (ea-for-df-desc y))))
(cond (not-p
(inst jmp :p target)
(inst jmp :ne target))
@@ -911,7 +945,11 @@
(:translate <)
(:info target not-p)
(:generator 3
- (inst comisd x y)
+ (sc-case y
+ (double-reg
+ (inst comisd x y))
+ (descriptor-reg
+ (inst comisd x (ea-for-df-desc y))))
(cond (not-p
(inst jmp :p target)
(inst jmp :nc target))
@@ -925,7 +963,11 @@
(:translate <)
(:info target not-p)
(:generator 3
- (inst comiss x y)
+ (sc-case y
+ (single-reg
+ (inst comiss x y))
+ (descriptor-reg
+ (inst comiss x (ea-for-sf-desc y))))
(cond (not-p
(inst jmp :p target)
(inst jmp :nc target))
@@ -939,7 +981,11 @@
(:translate >)
(:info target not-p)
(:generator 3
- (inst comisd x y)
+ (sc-case y
+ (double-reg
+ (inst comisd x y))
+ (descriptor-reg
+ (inst comisd x (ea-for-df-desc y))))
(cond (not-p
(inst jmp :p target)
(inst jmp :na target))
@@ -953,7 +999,11 @@
(:translate >)
(:info target not-p)
(:generator 3
- (inst comiss x y)
+ (sc-case y
+ (single-reg
+ (inst comiss x y))
+ (descriptor-reg
+ (inst comiss x (ea-for-sf-desc y))))
(cond (not-p
(inst jmp :p target)
(inst jmp :na target))
@@ -969,8 +1019,7 @@
(macrolet ((frob (name translate inst to-sc to-type)
`(define-vop (,name)
- (:args (x :scs (signed-stack signed-reg) :target temp))
- (:temporary (:sc signed-stack) temp)
+ (:args (x :scs (signed-stack signed-reg)))
(:results (y :scs (,to-sc)))
(:arg-types signed-num)
(:result-types ,to-type)
@@ -982,9 +1031,8 @@
(:generator 5
(sc-case x
(signed-reg
- (inst mov temp x)
(note-this-location vop :internal-error)
- (inst ,inst y temp))
+ (inst ,inst y x))
(signed-stack
(note-this-location vop :internal-error)
(inst ,inst y x)))))))
@@ -992,46 +1040,63 @@
(frob %double-float/signed %double-float cvtsi2sd double-reg double-float))
(macrolet ((frob (name translate inst from-sc from-type to-sc to-type)
- `(define-vop (,name)
- (:args (x :scs (,from-sc) :target y))
- (:results (y :scs (,to-sc)))
- (:arg-types ,from-type)
- (:result-types ,to-type)
- (:policy :fast-safe)
- (:note _N"inline float coercion")
- (:translate ,translate)
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 2
- (note-this-location vop :internal-error)
- (inst ,inst y x)))))
+ (let ((ea (if (eq from-sc 'single-reg)
+ 'ea-for-sf-desc
+ 'ea-for-df-desc)))
+ `(define-vop (,name)
+ (:args (x :scs (,from-sc descriptor-reg) :target y))
+ (:results (y :scs (,to-sc)))
+ (:arg-types ,from-type)
+ (:result-types ,to-type)
+ (:policy :fast-safe)
+ (:note _N"inline float coercion")
+ (:translate ,translate)
+ (:vop-var vop)
+ (:save-p :compute-only)
+ (:generator 2
+ (note-this-location vop :internal-error)
+ (sc-case x
+ (,from-sc
+ (inst ,inst y x))
+ (descriptor-reg
+ (inst ,inst y (,ea x)))))))))
(frob %single-float/double-float %single-float cvtsd2ss double-reg
- double-float single-reg single-float)
+ double-float single-reg single-float)
(frob %double-float/single-float %double-float cvtss2sd
- single-reg single-float double-reg double-float))
+ single-reg single-float double-reg double-float))
(macrolet ((frob (trans inst from-sc from-type round-p)
(declare (ignore round-p))
- `(define-vop (,(symbolicate trans "/" from-type))
- (:args (x :scs (,from-sc)))
- (:temporary (:sc any-reg) temp-reg)
- (:results (y :scs (signed-reg)))
- (:arg-types ,from-type)
- (:result-types signed-num)
- (:translate ,trans)
- (:policy :fast-safe)
- (:note _N"inline float truncate")
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 5
- (sc-case y
- (signed-stack
- (inst ,inst temp-reg x)
- (move y temp-reg))
- (signed-reg
- (inst ,inst y x)
- ))))))
+ (let ((ea (if (eq from-sc 'single-reg)
+ 'ea-for-sf-desc
+ 'ea-for-df-desc)))
+ `(define-vop (,(symbolicate trans "/" from-type))
+ (:args (x :scs (,from-sc descriptor-reg)))
+ (:temporary (:sc any-reg) temp-reg)
+ (:results (y :scs (signed-reg)))
+ (:arg-types ,from-type)
+ (:result-types signed-num)
+ (:translate ,trans)
+ (:policy :fast-safe)
+ (:note _N"inline float truncate")
+ (:vop-var vop)
+ (:save-p :compute-only)
+ (:generator 5
+ (sc-case y
+ (signed-stack
+ (sc-case x
+ (,from-sc
+ (inst ,inst temp-reg x))
+ (descriptor-reg
+ (inst ,inst temp-reg (,ea x))))
+ (move y temp-reg))
+ (signed-reg
+ (sc-case x
+ (,from-sc
+ (inst ,inst y x))
+ (descriptor-reg
+ (inst ,inst y (,ea x)))))))))))
(frob %unary-truncate cvttss2si single-reg single-float nil)
(frob %unary-truncate cvttsd2si double-reg double-float nil)
@@ -1039,7 +1104,7 @@
(frob %unary-round cvtsd2si double-reg double-float t))
(define-vop (fast-unary-ftruncate/single-float)
- (:args (x :scs (single-reg)))
+ (:args (x :scs (single-reg descriptor-reg)))
(:arg-types single-float)
(:results (r :scs (single-reg)))
(:result-types single-float)
@@ -1048,11 +1113,15 @@
(:temporary (:sc signed-reg) temp)
(:note _N"inline ftruncate")
(:generator 2
- (inst cvttss2si temp x)
+ (sc-case x
+ (single-reg
+ (inst cvttss2si temp x))
+ (descriptor-reg
+ (inst cvttss2si temp (ea-for-sf-desc x))))
(inst cvtsi2ss r temp)))
(define-vop (fast-unary-ftruncate/double-float)
- (:args (x :scs (double-reg) :target r))
+ (:args (x :scs (double-reg descriptor-reg) :target r))
(:arg-types double-float)
(:results (r :scs (double-reg)))
(:result-types double-float)
@@ -1061,7 +1130,11 @@
(:temporary (:sc signed-reg) temp)
(:note _N"inline ftruncate")
(:generator 2
- (inst cvttsd2si temp x)
+ (sc-case x
+ (double-reg
+ (inst cvttsd2si temp x))
+ (descriptor-reg
+ (inst cvttsd2si temp (ea-for-df-desc x))))
(inst cvtsi2sd r temp)))
(define-vop (make-single-float)
-----------------------------------------------------------------------
Summary of changes:
src/compiler/x86/float-sse2.lisp | 187 ++++++++++++++++++++++++++------------
1 file changed, 130 insertions(+), 57 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-commit
mailing list