### 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.```
parent 2527de5e
 ... @@ -756,32 +756,58 @@ ... @@ -756,32 +756,58 @@ (frob single-float-op single-reg single-float) (frob single-float-op single-reg single-float) (frob double-float-op double-reg double-float)) (frob double-float-op double-reg double-float)) (macrolet ((generate (movinst opinst commutative) (macrolet ((generate (movinst opinst commutative rtype ea) `(progn `(progn (cond (cond ((location= x r) ((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)) ((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)) (inst ,opinst y x)) ((not (location= r y)) ((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 ,movinst r x) (inst ,opinst r y)) (sc-case y (,rtype (inst ,opinst r y)) (descriptor-reg (inst ,opinst r (,ea y))))) (t (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 ,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))))) (inst ,movinst r tmp))))) (frob (op sinst sname scost dinst dname dcost commutative) (frob (op sinst sname scost dinst dname dcost commutative) `(progn `(progn (define-vop (,sname single-float-op) (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) (:temporary (:sc single-reg) tmp) (:generator ,scost (:generator ,scost (generate movss ,sinst ,commutative))) (generate movss ,sinst ,commutative single-reg ea-for-sf-desc))) (define-vop (,dname double-float-op) (define-vop (,dname double-float-op) (:args (x :scs (double-reg) :target r) (y :scs (double-reg descriptor-reg))) (:translate ,op) (:translate ,op) (:temporary (:sc single-reg) tmp) (:temporary (:sc single-reg) tmp) (:generator ,dcost (: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 + addss +/single-float 2 addsd +/double-float 2 t) (frob - subss -/single-float 2 subsd -/double-float 2 nil) (frob - subss -/single-float 2 subsd -/double-float 2 nil) (frob * mulss */single-float 4 mulsd */double-float 5 t) (frob * mulss */single-float 4 mulsd */double-float 5 t) ... @@ -865,11 +891,11 @@ ... @@ -865,11 +891,11 @@ ;;; and stack args ;;; and stack args (define-vop (single-float-compare float-compare) (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) (:conditional) (:arg-types single-float single-float)) (:arg-types single-float single-float)) (define-vop (double-float-compare float-compare) (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) (:conditional) (:arg-types double-float double-float)) (:arg-types double-float double-float)) ... @@ -879,7 +905,11 @@ ... @@ -879,7 +905,11 @@ (:vop-var vop) (:vop-var vop) (:generator 3 (:generator 3 (note-this-location vop :internal-error) (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 ;; if PF&CF, there was a NaN involved => not equal ;; otherwise, ZF => equal ;; otherwise, ZF => equal (cond (not-p (cond (not-p ... @@ -897,7 +927,11 @@ ... @@ -897,7 +927,11 @@ (:vop-var vop) (:vop-var vop) (:generator 3 (:generator 3 (note-this-location vop :internal-error) (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 (cond (not-p (inst jmp :p target) (inst jmp :p target) (inst jmp :ne target)) (inst jmp :ne target)) ... @@ -911,7 +945,11 @@ ... @@ -911,7 +945,11 @@ (:translate <) (:translate <) (:info target not-p) (:info target not-p) (:generator 3 (: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 (cond (not-p (inst jmp :p target) (inst jmp :p target) (inst jmp :nc target)) (inst jmp :nc target)) ... @@ -925,7 +963,11 @@ ... @@ -925,7 +963,11 @@ (:translate <) (:translate <) (:info target not-p) (:info target not-p) (:generator 3 (: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 (cond (not-p (inst jmp :p target) (inst jmp :p target) (inst jmp :nc target)) (inst jmp :nc target)) ... @@ -939,7 +981,11 @@ ... @@ -939,7 +981,11 @@ (:translate >) (:translate >) (:info target not-p) (:info target not-p) (:generator 3 (: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 (cond (not-p (inst jmp :p target) (inst jmp :p target) (inst jmp :na target)) (inst jmp :na target)) ... @@ -953,7 +999,11 @@ ... @@ -953,7 +999,11 @@ (:translate >) (:translate >) (:info target not-p) (:info target not-p) (:generator 3 (: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 (cond (not-p (inst jmp :p target) (inst jmp :p target) (inst jmp :na target)) (inst jmp :na target)) ... @@ -969,8 +1019,7 @@ ... @@ -969,8 +1019,7 @@ (macrolet ((frob (name translate inst to-sc to-type) (macrolet ((frob (name translate inst to-sc to-type) `(define-vop (,name) `(define-vop (,name) (:args (x :scs (signed-stack signed-reg) :target temp)) (:args (x :scs (signed-stack signed-reg))) (:temporary (:sc signed-stack) temp) (:results (y :scs (,to-sc))) (:results (y :scs (,to-sc))) (:arg-types signed-num) (:arg-types signed-num) (:result-types ,to-type) (:result-types ,to-type) ... @@ -982,9 +1031,8 @@ ... @@ -982,9 +1031,8 @@ (:generator 5 (:generator 5 (sc-case x (sc-case x (signed-reg (signed-reg (inst mov temp x) (note-this-location vop :internal-error) (note-this-location vop :internal-error) (inst ,inst y temp)) (inst ,inst y x)) (signed-stack (signed-stack (note-this-location vop :internal-error) (note-this-location vop :internal-error) (inst ,inst y x))))))) (inst ,inst y x))))))) ... @@ -992,46 +1040,63 @@ ... @@ -992,46 +1040,63 @@ (frob %double-float/signed %double-float cvtsi2sd double-reg double-float)) (frob %double-float/signed %double-float cvtsi2sd double-reg double-float)) (macrolet ((frob (name translate inst from-sc from-type to-sc to-type) (macrolet ((frob (name translate inst from-sc from-type to-sc to-type) `(define-vop (,name) (let ((ea (if (eq from-sc 'single-reg) (:args (x :scs (,from-sc) :target y)) 'ea-for-sf-desc (:results (y :scs (,to-sc))) 'ea-for-df-desc))) (:arg-types ,from-type) `(define-vop (,name) (:result-types ,to-type) (:args (x :scs (,from-sc descriptor-reg) :target y)) (:policy :fast-safe) (:results (y :scs (,to-sc))) (:note _N"inline float coercion") (:arg-types ,from-type) (:translate ,translate) (:result-types ,to-type) (:vop-var vop) (:policy :fast-safe) (:save-p :compute-only) (:note _N"inline float coercion") (:generator 2 (:translate ,translate) (note-this-location vop :internal-error) (:vop-var vop) (inst ,inst y x))))) (: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 (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 (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) (macrolet ((frob (trans inst from-sc from-type round-p) (declare (ignore round-p)) (declare (ignore round-p)) `(define-vop (,(symbolicate trans "/" from-type)) (let ((ea (if (eq from-sc 'single-reg) (:args (x :scs (,from-sc))) 'ea-for-sf-desc (:temporary (:sc any-reg) temp-reg) 'ea-for-df-desc))) (:results (y :scs (signed-reg))) `(define-vop (,(symbolicate trans "/" from-type)) (:arg-types ,from-type) (:args (x :scs (,from-sc descriptor-reg))) (:result-types signed-num) (:temporary (:sc any-reg) temp-reg) (:translate ,trans) (:results (y :scs (signed-reg))) (:policy :fast-safe) (:arg-types ,from-type) (:note _N"inline float truncate") (:result-types signed-num) (:vop-var vop) (:translate ,trans) (:save-p :compute-only) (:policy :fast-safe) (:generator 5 (:note _N"inline float truncate") (sc-case y (:vop-var vop) (signed-stack (:save-p :compute-only) (inst ,inst temp-reg x) (:generator 5 (move y temp-reg)) (sc-case y (signed-reg (signed-stack (inst ,inst y x) (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 cvttss2si single-reg single-float nil) (frob %unary-truncate cvttsd2si double-reg double-float nil) (frob %unary-truncate cvttsd2si double-reg double-float nil) ... @@ -1039,7 +1104,7 @@ ... @@ -1039,7 +1104,7 @@ (frob %unary-round cvtsd2si double-reg double-float t)) (frob %unary-round cvtsd2si double-reg double-float t)) (define-vop (fast-unary-ftruncate/single-float) (define-vop (fast-unary-ftruncate/single-float) (:args (x :scs (single-reg))) (:args (x :scs (single-reg descriptor-reg))) (:arg-types single-float) (:arg-types single-float) (:results (r :scs (single-reg))) (:results (r :scs (single-reg))) (:result-types single-float) (:result-types single-float) ... @@ -1048,11 +1113,15 @@ ... @@ -1048,11 +1113,15 @@ (:temporary (:sc signed-reg) temp) (:temporary (:sc signed-reg) temp) (:note _N"inline ftruncate") (:note _N"inline ftruncate") (:generator 2 (: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))) (inst cvtsi2ss r temp))) (define-vop (fast-unary-ftruncate/double-float) (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) (:arg-types double-float) (:results (r :scs (double-reg))) (:results (r :scs (double-reg))) (:result-types double-float) (:result-types double-float) ... @@ -1061,7 +1130,11 @@ ... @@ -1061,7 +1130,11 @@ (:temporary (:sc signed-reg) temp) (:temporary (:sc signed-reg) temp) (:note _N"inline ftruncate") (:note _N"inline ftruncate") (:generator 2 (: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))) (inst cvtsi2sd r temp))) (define-vop (make-single-float) (define-vop (make-single-float) ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!