| ... |
... |
@@ -944,87 +944,6 @@ |
|
944
|
944
|
(frob single ucomiss)
|
|
945
|
945
|
(frob double ucomisd))
|
|
946
|
946
|
|
|
947
|
|
-#+nil
|
|
948
|
|
-(macrolet
|
|
949
|
|
- ((gen-code (swap-args-p sc-type inst ea)
|
|
950
|
|
- (if swap-args-p
|
|
951
|
|
- `(sc-case x
|
|
952
|
|
- (,sc-type
|
|
953
|
|
- (inst ,inst y x))
|
|
954
|
|
- (descriptor-reg
|
|
955
|
|
- (inst ,inst y (,ea x))))
|
|
956
|
|
- `(sc-case y
|
|
957
|
|
- (,sc-type
|
|
958
|
|
- (inst ,inst x y))
|
|
959
|
|
- (descriptor-reg
|
|
960
|
|
- (inst ,inst x (,ea y))))))
|
|
961
|
|
- (frob (op size inst swap-args-p)
|
|
962
|
|
- (let ((ea (ecase size
|
|
963
|
|
- (single
|
|
964
|
|
- 'ea-for-sf-desc)
|
|
965
|
|
- (double
|
|
966
|
|
- 'ea-for-df-desc)))
|
|
967
|
|
- (name (symbolicate op "/" size "-FLOAT"))
|
|
968
|
|
- (sc-type (symbolicate size "-REG"))
|
|
969
|
|
- (inherit (symbolicate size "-FLOAT-COMPARE")))
|
|
970
|
|
- `(define-vop (,name ,inherit)
|
|
971
|
|
- (:translate ,op)
|
|
972
|
|
- (:info target not-p)
|
|
973
|
|
- (:generator 3
|
|
974
|
|
- (gen-code ,swap-args-p ,sc-type ,inst ,ea)
|
|
975
|
|
- ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In
|
|
976
|
|
- ;; the normal case (not-p false), we want to jump to the
|
|
977
|
|
- ;; target when x > y. This happens when CF = 0. Hence,
|
|
978
|
|
- ;; we won't jump to the target when there's a NaN, as
|
|
979
|
|
- ;; desired.
|
|
980
|
|
- ;;
|
|
981
|
|
- ;; For the not-p case, we want to jump to target when x
|
|
982
|
|
- ;; <= y. This means CF = 1 or ZF = 1. But NaN sets
|
|
983
|
|
- ;; these bits too, so we jump to the target for NaN or x
|
|
984
|
|
- ;; <= y, as desired.
|
|
985
|
|
- (inst jmp (if (not not-p) :a :be) target))))))
|
|
986
|
|
- (frob > single comiss nil)
|
|
987
|
|
- (frob > double comisd nil))
|
|
988
|
|
-
|
|
989
|
|
-#+nil
|
|
990
|
|
-(macrolet
|
|
991
|
|
- ((gen-code (swap-args-p sc-type inst ea)
|
|
992
|
|
- (if swap-args-p
|
|
993
|
|
- `(sc-case x
|
|
994
|
|
- (,sc-type
|
|
995
|
|
- (inst ,inst y x))
|
|
996
|
|
- (descriptor-reg
|
|
997
|
|
- (inst ,inst y (,ea x))))
|
|
998
|
|
- `(sc-case y
|
|
999
|
|
- (,sc-type
|
|
1000
|
|
- (inst ,inst x y))
|
|
1001
|
|
- (descriptor-reg
|
|
1002
|
|
- (inst ,inst x (,ea y))))))
|
|
1003
|
|
- (frob (op size inst swap-args-p)
|
|
1004
|
|
- (let ((ea (ecase size
|
|
1005
|
|
- (single
|
|
1006
|
|
- 'ea-for-sf-desc)
|
|
1007
|
|
- (double
|
|
1008
|
|
- 'ea-for-df-desc)))
|
|
1009
|
|
- (name (symbolicate op "/" size "-FLOAT"))
|
|
1010
|
|
- (sc-type (symbolicate size "-REG"))
|
|
1011
|
|
- (inherit (symbolicate size "-FLOAT-COMPARE")))
|
|
1012
|
|
- `(define-vop (,name ,inherit)
|
|
1013
|
|
- (:args (x :scs (,sc-type descriptor-reg))
|
|
1014
|
|
- (y :scs (,sc-type)))
|
|
1015
|
|
- (:translate ,op)
|
|
1016
|
|
- (:info target not-p)
|
|
1017
|
|
- (:temporary (:sc ,sc-type) load-x)
|
|
1018
|
|
- (:generator 3
|
|
1019
|
|
- ;; Note: x < y is the same as y > x. We reverse the
|
|
1020
|
|
- ;; args to reduce the number of jump instructions
|
|
1021
|
|
- ;; needed. Then the logic for the branches is the same
|
|
1022
|
|
- ;; as for the case y > x above.
|
|
1023
|
|
- (gen-code ,swap-args-p ,sc-type ,inst ,ea)
|
|
1024
|
|
- (inst jmp (if (not not-p) :a :be) target))))))
|
|
1025
|
|
- (frob < single comiss t)
|
|
1026
|
|
- (frob < double comisd t))
|
|
1027
|
|
-
|
|
1028
|
947
|
(macrolet
|
|
1029
|
948
|
((gen-code (op sc-type inst ea)
|
|
1030
|
949
|
;; When the operation is >, the second arg (y) can be a
|