Skip to content
Snippets Groups Projects
Commit b689cd59 authored by Raymond Toy's avatar Raymond Toy
Browse files

Allow stack-tn's to be accessed in the float arith vops.

The vops can directly access stack tn's now instead of having to load
it into a register first.
parent c9a3b19c
No related branches found
No related tags found
No related merge requests found
...@@ -756,58 +756,69 @@ ...@@ -756,58 +756,69 @@
(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 rtype ea) (macrolet ((generate (movinst opinst commutative rtype ea ea-stack)
`(progn (let ((stack-sc (if (eq rtype 'single-reg)
(cond 'single-stack
((location= x r) 'double-stack)))
;; x and r are the same. We can just operate on x, `(progn
;; and we're done. (cond
(sc-case y ((location= x r)
(,rtype ;; x and r are the same. We can just operate on x,
(inst ,opinst x y)) ;; and we're done.
(descriptor-reg (sc-case y
(inst ,opinst x (,ea y))))) (,rtype
((and ,commutative (location= y r)) (inst ,opinst x y))
;; y = r and the operation is commutative, so just (descriptor-reg
;; do the operation with r and x. (inst ,opinst x (,ea y)))
(inst ,opinst y x)) (,stack-sc
((not (location= r y)) (inst ,opinst x (,ea-stack y)))))
;; x, y, and r are three different regs. So just ((and ,commutative (location= y r))
;; move r to x and do the operation on r. ;; y = r and the operation is commutative, so just
(inst ,movinst r x) ;; do the operation with r and x.
(sc-case y (inst ,opinst y x))
(,rtype ((not (location= r y))
(inst ,opinst r y)) ;; x, y, and r are three different regs. So just
(descriptor-reg ;; move r to x and do the operation on r.
(inst ,opinst r (,ea y))))) (inst ,movinst r x)
(t (sc-case y
;; The hard case where the operation is not (,rtype
;; commutative, but y might be r. Don't want to (inst ,opinst r y))
;; destroy y in this case, so use a temp so we (descriptor-reg
;; don't accidentally overwrite y. (inst ,opinst r (,ea y)))
(inst ,movinst tmp x) (,stack-sc
(sc-case y (inst, opinst r (,ea-stack y)))))
(,rtype (t
(inst ,opinst tmp y)) ;; The hard case where the operation is not
(descriptor-reg ;; commutative, but y might be r. Don't want to
(inst ,opinst tmp (,ea y)))) ;; destroy y in this case, so use a temp so we
(inst ,movinst r tmp))))) ;; don't accidentally overwrite y.
(inst ,movinst tmp x)
(sc-case y
(,rtype
(inst ,opinst tmp y))
(descriptor-reg
(inst ,opinst tmp (,ea y)))
(,stack-sc
(inst, opinst tmp (,ea-stack y))))
(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)
(:args (x :scs (single-reg) :target r) (:args (x :scs (single-reg) :target r)
(y :scs (single-reg descriptor-reg))) (y :scs (single-reg descriptor-reg)
:load-if (not (sc-is y single-stack))))
(:translate ,op) (:translate ,op)
(:temporary (:sc single-reg) tmp) (:temporary (:sc single-reg) tmp)
(:generator ,scost (:generator ,scost
(generate movss ,sinst ,commutative single-reg ea-for-sf-desc))) (generate movss ,sinst ,commutative single-reg ea-for-sf-desc ea-for-sf-stack)))
(define-vop (,dname double-float-op) (define-vop (,dname double-float-op)
(:args (x :scs (double-reg) :target r) (:args (x :scs (double-reg) :target r)
(y :scs (double-reg descriptor-reg))) (y :scs (double-reg descriptor-reg)
:load-if (not (sc-is y double-stack))))
(:translate ,op) (:translate ,op)
(:temporary (:sc single-reg) tmp) (:temporary (:sc double-reg) tmp)
(:generator ,dcost (:generator ,dcost
(generate movsd ,dinst ,commutative double-reg ea-for-df-desc)))))) (generate movsd ,dinst ,commutative double-reg ea-for-df-desc ea-for-df-stack))))))
(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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment