| ... |
... |
@@ -944,8 +944,21 @@ |
|
944
|
944
|
(frob single ucomiss)
|
|
945
|
945
|
(frob double ucomisd))
|
|
946
|
946
|
|
|
|
947
|
+#+nil
|
|
947
|
948
|
(macrolet
|
|
948
|
|
- ((frob (op size inst)
|
|
|
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)
|
|
949
|
962
|
(let ((ea (ecase size
|
|
950
|
963
|
(single
|
|
951
|
964
|
'ea-for-sf-desc)
|
| ... |
... |
@@ -958,11 +971,7 @@ |
|
958
|
971
|
(:translate ,op)
|
|
959
|
972
|
(:info target not-p)
|
|
960
|
973
|
(:generator 3
|
|
961
|
|
- (sc-case y
|
|
962
|
|
- (,sc-type
|
|
963
|
|
- (inst ,inst x y))
|
|
964
|
|
- (descriptor-reg
|
|
965
|
|
- (inst ,inst x (,ea y))))
|
|
|
974
|
+ (gen-code ,swap-args-p ,sc-type ,inst ,ea)
|
|
966
|
975
|
;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In
|
|
967
|
976
|
;; the normal case (not-p false), we want to jump to the
|
|
968
|
977
|
;; target when x > y. This happens when CF = 0. Hence,
|
| ... |
... |
@@ -974,11 +983,24 @@ |
|
974
|
983
|
;; these bits too, so we jump to the target for NaN or x
|
|
975
|
984
|
;; <= y, as desired.
|
|
976
|
985
|
(inst jmp (if (not not-p) :a :be) target))))))
|
|
977
|
|
- (frob > single comiss)
|
|
978
|
|
- (frob > double comisd))
|
|
|
986
|
+ (frob > single comiss nil)
|
|
|
987
|
+ (frob > double comisd nil))
|
|
979
|
988
|
|
|
|
989
|
+#+nil
|
|
980
|
990
|
(macrolet
|
|
981
|
|
- ((frob (op size inst)
|
|
|
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)
|
|
982
|
1004
|
(let ((ea (ecase size
|
|
983
|
1005
|
(single
|
|
984
|
1006
|
'ea-for-sf-desc)
|
| ... |
... |
@@ -998,12 +1020,69 @@ |
|
998
|
1020
|
;; args to reduce the number of jump instructions
|
|
999
|
1021
|
;; needed. Then the logic for the branches is the same
|
|
1000
|
1022
|
;; as for the case y > x above.
|
|
1001
|
|
- (sc-case x
|
|
1002
|
|
- (,sc-type
|
|
1003
|
|
- (inst ,inst y x))
|
|
1004
|
|
- (descriptor-reg
|
|
1005
|
|
- (inst ,inst y (,ea x))))
|
|
|
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
|
+(macrolet
|
|
|
1029
|
+ ((gen-code (op sc-type inst ea)
|
|
|
1030
|
+ ;; When the operation is >, the second arg (y) can be a
|
|
|
1031
|
+ ;; register or a descriptor. When the operation is <, the args
|
|
|
1032
|
+ ;; are swapped and we want to allow x to be a register or
|
|
|
1033
|
+ ;; descriptor.
|
|
|
1034
|
+ (if (eq op '<)
|
|
|
1035
|
+ `(sc-case x
|
|
|
1036
|
+ (,sc-type
|
|
|
1037
|
+ (inst ,inst y x))
|
|
|
1038
|
+ (descriptor-reg
|
|
|
1039
|
+ (inst ,inst y (,ea x))))
|
|
|
1040
|
+ `(sc-case y
|
|
|
1041
|
+ (,sc-type
|
|
|
1042
|
+ (inst ,inst x y))
|
|
|
1043
|
+ (descriptor-reg
|
|
|
1044
|
+ (inst ,inst x (,ea y))))))
|
|
|
1045
|
+ (frob (op size inst)
|
|
|
1046
|
+ (let ((ea (ecase size
|
|
|
1047
|
+ (single
|
|
|
1048
|
+ 'ea-for-sf-desc)
|
|
|
1049
|
+ (double
|
|
|
1050
|
+ 'ea-for-df-desc)))
|
|
|
1051
|
+ (name (symbolicate op "/" size "-FLOAT"))
|
|
|
1052
|
+ (sc-type (symbolicate size "-REG"))
|
|
|
1053
|
+ (inherit (symbolicate size "-FLOAT-COMPARE")))
|
|
|
1054
|
+ `(define-vop (,name ,inherit)
|
|
|
1055
|
+ ;; When the operation is <, we want to rewrite x < y to y
|
|
|
1056
|
+ ;; > x. In that case, we want to allow x to be in a
|
|
|
1057
|
+ ;; descriptor. For >, y is allowed to be a descriptor.
|
|
|
1058
|
+ ,@(when (eq op '<)
|
|
|
1059
|
+ `((:args (x :scs (,sc-type descriptor-reg))
|
|
|
1060
|
+ (y :scs (,sc-type)))))
|
|
|
1061
|
+ (:translate ,op)
|
|
|
1062
|
+ (:info target not-p)
|
|
|
1063
|
+ (:generator 3
|
|
|
1064
|
+ ;; Note: x < y is the same as y > x. We reverse the
|
|
|
1065
|
+ ;; args to reduce the number of jump instructions
|
|
|
1066
|
+ ;; needed.
|
|
|
1067
|
+ (gen-code ,op ,sc-type ,inst ,ea)
|
|
|
1068
|
+ ;; Consider the case of x > y.
|
|
|
1069
|
+ ;;
|
|
|
1070
|
+ ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In
|
|
|
1071
|
+ ;; the normal case (not-p false), we want to jump to the
|
|
|
1072
|
+ ;; target when x > y. This happens when CF = 0. Hence,
|
|
|
1073
|
+ ;; we won't jump to the target when there's a NaN, as
|
|
|
1074
|
+ ;; desired.
|
|
|
1075
|
+ ;;
|
|
|
1076
|
+ ;; For the not-p case, we want to jump to target when x
|
|
|
1077
|
+ ;; <= y. This means CF = 1 or ZF = 1. But NaN sets
|
|
|
1078
|
+ ;; these bits too, so we jump to the target for NaN or x
|
|
|
1079
|
+ ;; <= y, as desired.
|
|
|
1080
|
+ ;;
|
|
|
1081
|
+ ;; For the case of x < y, we can use the equivalent y >
|
|
|
1082
|
+ ;; x. Thus if we swap the args, the same logic applies.
|
|
1006
|
1083
|
(inst jmp (if (not not-p) :a :be) target))))))
|
|
|
1084
|
+ (frob > single comiss)
|
|
|
1085
|
+ (frob > double comisd)
|
|
1007
|
1086
|
(frob < single comiss)
|
|
1008
|
1087
|
(frob < double comisd))
|
|
1009
|
1088
|
|