Skip to content

Commit c52d40b

Browse files
authored
float32 flambda2 operations (#2384)
1 parent c32252e commit c52d40b

16 files changed

+437
-169
lines changed

backend/cmm_helpers.ml

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -499,6 +499,8 @@ let mk_compare_floats_untagged dbg a1 a2 =
499499
runtime/floats.c *)
500500
add_int (sub_int op1 op2 dbg) (sub_int op3 op4 dbg) dbg))
501501

502+
let mk_compare_float32s_untagged _dbg _a1 _a2 = assert false
503+
502504
let mk_compare_floats dbg a1 a2 =
503505
bind "float_cmp" a2 (fun a2 ->
504506
bind "float_cmp" a1 (fun a1 ->
@@ -3702,6 +3704,30 @@ let float_gt = binary (Ccmpf CFgt)
37023704

37033705
let float_ge = binary (Ccmpf CFge)
37043706

3707+
let float32_abs ~dbg:_ _ = assert false
3708+
3709+
let float32_neg ~dbg:_ _ = assert false
3710+
3711+
let float32_add ~dbg:_ _ _ = assert false
3712+
3713+
let float32_sub ~dbg:_ _ _ = assert false
3714+
3715+
let float32_mul ~dbg:_ _ _ = assert false
3716+
3717+
let float32_div ~dbg:_ _ _ = assert false
3718+
3719+
let float32_eq ~dbg:_ _ _ = assert false
3720+
3721+
let float32_neq ~dbg:_ _ _ = assert false
3722+
3723+
let float32_lt ~dbg:_ _ _ = assert false
3724+
3725+
let float32_le ~dbg:_ _ _ = assert false
3726+
3727+
let float32_gt ~dbg:_ _ _ = assert false
3728+
3729+
let float32_ge ~dbg:_ _ _ = assert false
3730+
37053731
let beginregion ~dbg = Cop (Cbeginregion, [], dbg)
37063732

37073733
let endregion ~dbg region = Cop (Cendregion, [region], dbg)

backend/cmm_helpers.mli

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -127,6 +127,9 @@ val mk_compare_ints_untagged :
127127
val mk_compare_floats_untagged :
128128
Debuginfo.t -> expression -> expression -> expression
129129

130+
val mk_compare_float32s_untagged :
131+
Debuginfo.t -> expression -> expression -> expression
132+
130133
(** Convert a tagged integer into a raw integer with boolean meaning *)
131134
val test_bool : Debuginfo.t -> expression -> expression
132135

@@ -723,6 +726,8 @@ val uge : dbg:Debuginfo.t -> expression -> expression -> expression
723726
(** Asbolute value on floats. *)
724727
val float_abs : dbg:Debuginfo.t -> expression -> expression
725728

729+
val float32_abs : dbg:Debuginfo.t -> expression -> expression
730+
726731
(** Arithmetic negation on floats. *)
727732
val float_neg : dbg:Debuginfo.t -> expression -> expression
728733

@@ -732,11 +737,23 @@ val float_sub : dbg:Debuginfo.t -> expression -> expression -> expression
732737

733738
val float_mul : dbg:Debuginfo.t -> expression -> expression -> expression
734739

740+
val float32_neg : dbg:Debuginfo.t -> expression -> expression
741+
742+
val float32_add : dbg:Debuginfo.t -> expression -> expression -> expression
743+
744+
val float32_sub : dbg:Debuginfo.t -> expression -> expression -> expression
745+
746+
val float32_mul : dbg:Debuginfo.t -> expression -> expression -> expression
747+
735748
(** Float arithmetic operations. *)
736749
val float_div : dbg:Debuginfo.t -> expression -> expression -> expression
737750

738751
val float_eq : dbg:Debuginfo.t -> expression -> expression -> expression
739752

753+
val float32_div : dbg:Debuginfo.t -> expression -> expression -> expression
754+
755+
val float32_eq : dbg:Debuginfo.t -> expression -> expression -> expression
756+
740757
(** Float arithmetic (dis)equality of cmm expressions. Returns an untagged
741758
integer (either 0 or 1) to represent the result of the comparison. *)
742759
val float_neq : dbg:Debuginfo.t -> expression -> expression -> expression
@@ -747,10 +764,20 @@ val float_le : dbg:Debuginfo.t -> expression -> expression -> expression
747764

748765
val float_gt : dbg:Debuginfo.t -> expression -> expression -> expression
749766

767+
val float32_neq : dbg:Debuginfo.t -> expression -> expression -> expression
768+
769+
val float32_lt : dbg:Debuginfo.t -> expression -> expression -> expression
770+
771+
val float32_le : dbg:Debuginfo.t -> expression -> expression -> expression
772+
773+
val float32_gt : dbg:Debuginfo.t -> expression -> expression -> expression
774+
750775
(** Float arithmetic comparisons on cmm expressions. Returns an untagged integer
751776
(either 0 or 1) to represent the result of the comparison. *)
752777
val float_ge : dbg:Debuginfo.t -> expression -> expression -> expression
753778

779+
val float32_ge : dbg:Debuginfo.t -> expression -> expression -> expression
780+
754781
val beginregion : dbg:Debuginfo.t -> expression
755782

756783
val endregion : dbg:Debuginfo.t -> expression -> expression

middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

Lines changed: 78 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -1120,35 +1120,39 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
11201120
let dst = K.Standard_int_or_float.Naked_float in
11211121
[box_float mode (Unary (Num_conv { src; dst }, arg)) ~current_region]
11221122
| Pnegfloat (Pfloat64, mode), [[arg]] ->
1123-
[box_float mode (Unary (Float_arith Neg, unbox_float arg)) ~current_region]
1123+
[ box_float mode
1124+
(Unary (Float_arith (Float64, Neg), unbox_float arg))
1125+
~current_region ]
11241126
| Pabsfloat (Pfloat64, mode), [[arg]] ->
1125-
[box_float mode (Unary (Float_arith Abs, unbox_float arg)) ~current_region]
1127+
[ box_float mode
1128+
(Unary (Float_arith (Float64, Abs), unbox_float arg))
1129+
~current_region ]
11261130
| Paddfloat (Pfloat64, mode), [[arg1]; [arg2]] ->
11271131
[ box_float mode
1128-
(Binary (Float_arith Add, unbox_float arg1, unbox_float arg2))
1132+
(Binary (Float_arith (Float64, Add), unbox_float arg1, unbox_float arg2))
11291133
~current_region ]
11301134
| Psubfloat (Pfloat64, mode), [[arg1]; [arg2]] ->
11311135
[ box_float mode
1132-
(Binary (Float_arith Sub, unbox_float arg1, unbox_float arg2))
1136+
(Binary (Float_arith (Float64, Sub), unbox_float arg1, unbox_float arg2))
11331137
~current_region ]
11341138
| Pmulfloat (Pfloat64, mode), [[arg1]; [arg2]] ->
11351139
[ box_float mode
1136-
(Binary (Float_arith Mul, unbox_float arg1, unbox_float arg2))
1140+
(Binary (Float_arith (Float64, Mul), unbox_float arg1, unbox_float arg2))
11371141
~current_region ]
11381142
| Pdivfloat (Pfloat64, mode), [[arg1]; [arg2]] ->
11391143
[ box_float mode
1140-
(Binary (Float_arith Div, unbox_float arg1, unbox_float arg2))
1144+
(Binary (Float_arith (Float64, Div), unbox_float arg1, unbox_float arg2))
11411145
~current_region ]
11421146
| Pfloatcomp (Pfloat64, comp), [[arg1]; [arg2]] ->
11431147
[ tag_int
11441148
(Binary
1145-
( Float_comp (Yielding_bool (convert_float_comparison comp)),
1149+
( Float_comp (Float64, Yielding_bool (convert_float_comparison comp)),
11461150
unbox_float arg1,
11471151
unbox_float arg2 )) ]
11481152
| Punboxed_float_comp (Pfloat64, comp), [[arg1]; [arg2]] ->
11491153
[ tag_int
11501154
(Binary
1151-
( Float_comp (Yielding_bool (convert_float_comparison comp)),
1155+
( Float_comp (Float64, Yielding_bool (convert_float_comparison comp)),
11521156
arg1,
11531157
arg2 )) ]
11541158
| Punbox_float Pfloat64, [[arg]] -> [Unary (Unbox_number Naked_float, arg)]
@@ -1166,19 +1170,53 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
11661170
let src = K.Standard_int_or_float.Tagged_immediate in
11671171
let dst = K.Standard_int_or_float.Naked_float32 in
11681172
[box_float32 mode (Unary (Num_conv { src; dst }, arg)) ~current_region]
1169-
| Pnegfloat (Pfloat32, _), _
1170-
| Pabsfloat (Pfloat32, _), _
1171-
| Paddfloat (Pfloat32, _), _
1172-
| Psubfloat (Pfloat32, _), _
1173-
| Pmulfloat (Pfloat32, _), _
1174-
| Pdivfloat (Pfloat32, _), _
1175-
| Pfloatcomp (Pfloat32, _), _
1176-
| Punbox_float Pfloat32, _
1177-
| Pbox_float (Pfloat32, _), _
1178-
| Pcompare_floats Pfloat32, _
1179-
| Punboxed_float_comp (Pfloat32, _), _ ->
1180-
(* CR mslater: (float32) runtime *)
1181-
assert false
1173+
| Pnegfloat (Pfloat32, mode), [[arg]] ->
1174+
[ box_float32 mode
1175+
(Unary (Float_arith (Float32, Neg), unbox_float32 arg))
1176+
~current_region ]
1177+
| Pabsfloat (Pfloat32, mode), [[arg]] ->
1178+
[ box_float32 mode
1179+
(Unary (Float_arith (Float32, Abs), unbox_float32 arg))
1180+
~current_region ]
1181+
| Paddfloat (Pfloat32, mode), [[arg1]; [arg2]] ->
1182+
[ box_float32 mode
1183+
(Binary
1184+
(Float_arith (Float32, Add), unbox_float32 arg1, unbox_float32 arg2))
1185+
~current_region ]
1186+
| Psubfloat (Pfloat32, mode), [[arg1]; [arg2]] ->
1187+
[ box_float32 mode
1188+
(Binary
1189+
(Float_arith (Float32, Sub), unbox_float32 arg1, unbox_float32 arg2))
1190+
~current_region ]
1191+
| Pmulfloat (Pfloat32, mode), [[arg1]; [arg2]] ->
1192+
[ box_float32 mode
1193+
(Binary
1194+
(Float_arith (Float32, Mul), unbox_float32 arg1, unbox_float32 arg2))
1195+
~current_region ]
1196+
| Pdivfloat (Pfloat32, mode), [[arg1]; [arg2]] ->
1197+
[ box_float32 mode
1198+
(Binary
1199+
(Float_arith (Float32, Div), unbox_float32 arg1, unbox_float32 arg2))
1200+
~current_region ]
1201+
| Pfloatcomp (Pfloat32, comp), [[arg1]; [arg2]] ->
1202+
[ tag_int
1203+
(Binary
1204+
( Float_comp (Float32, Yielding_bool (convert_float_comparison comp)),
1205+
unbox_float32 arg1,
1206+
unbox_float32 arg2 )) ]
1207+
| Punboxed_float_comp (Pfloat32, comp), [[arg1]; [arg2]] ->
1208+
[ tag_int
1209+
(Binary
1210+
( Float_comp (Float32, Yielding_bool (convert_float_comparison comp)),
1211+
arg1,
1212+
arg2 )) ]
1213+
| Punbox_float Pfloat32, [[arg]] -> [Unary (Unbox_number Naked_float32, arg)]
1214+
| Pbox_float (Pfloat32, mode), [[arg]] ->
1215+
[ Unary
1216+
( Box_number
1217+
( Naked_float32,
1218+
Alloc_mode.For_allocations.from_lambda mode ~current_region ),
1219+
arg ) ]
11821220
| Punbox_int bi, [[arg]] ->
11831221
let kind = boxable_number_of_boxed_integer bi in
11841222
[Unary (Unbox_number kind, arg)]
@@ -1818,9 +1856,15 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
18181856
| Pcompare_floats Pfloat64, [[f1]; [f2]] ->
18191857
[ tag_int
18201858
(Binary
1821-
( Float_comp (Yielding_int_like_compare_functions ()),
1859+
( Float_comp (Float64, Yielding_int_like_compare_functions ()),
18221860
Prim (Unary (Unbox_number Naked_float, f1)),
18231861
Prim (Unary (Unbox_number Naked_float, f2)) )) ]
1862+
| Pcompare_floats Pfloat32, [[f1]; [f2]] ->
1863+
[ tag_int
1864+
(Binary
1865+
( Float_comp (Float32, Yielding_int_like_compare_functions ()),
1866+
Prim (Unary (Unbox_number Naked_float32, f1)),
1867+
Prim (Unary (Unbox_number Naked_float32, f2)) )) ]
18241868
| Pcompare_bints int_kind, [[i1]; [i2]] ->
18251869
let unboxing_kind = boxable_number_of_boxed_integer int_kind in
18261870
[ tag_int
@@ -1860,18 +1904,17 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
18601904
%a (%a)"
18611905
Printlambda.primitive prim H.print_list_of_simple_or_prim
18621906
(List.flatten args)
1863-
| ( ( Pfield _ | Pnegint | Pnot | Poffsetint _
1864-
| Pintoffloat (Pfloat64 | Pfloat32)
1865-
| Pfloatofint ((Pfloat64 | Pfloat32), _)
1907+
| ( ( Pfield _ | Pnegint | Pnot | Poffsetint _ | Pintoffloat _
1908+
| Pfloatofint (_, _)
18661909
| Pfloatoffloat32 _ | Pfloat32offloat _
1867-
| Pnegfloat (Pfloat64, _)
1868-
| Pabsfloat (Pfloat64, _)
1910+
| Pnegfloat (_, _)
1911+
| Pabsfloat (_, _)
18691912
| Pstringlength | Pbyteslength | Pbintofint _ | Pintofbint _ | Pnegbint _
18701913
| Popaque _ | Pduprecord _ | Parraylength _ | Pduparray _ | Pfloatfield _
18711914
| Pcvtbint _ | Poffsetref _ | Pbswap16 | Pbbswap _ | Pisint _
18721915
| Pint_as_pointer _ | Pbigarraydim _ | Pobj_dup | Pobj_magic _
1873-
| Punbox_float Pfloat64
1874-
| Pbox_float (Pfloat64, _)
1916+
| Punbox_float _
1917+
| Pbox_float (_, _)
18751918
| Punbox_int _ | Pbox_int _ | Punboxed_product_field _ | Pget_header _
18761919
| Pufloatfield _ | Patomic_load _ | Pmixedfield _ ),
18771920
([] | _ :: _ :: _ | [([] | _ :: _ :: _)]) ) ->
@@ -1881,12 +1924,12 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
18811924
Printlambda.primitive prim H.print_list_of_lists_of_simple_or_prim args
18821925
| ( ( Paddint | Psubint | Pmulint | Pandint | Porint | Pxorint | Plslint
18831926
| Plsrint | Pasrint | Pdivint _ | Pmodint _ | Psetfield _ | Pintcomp _
1884-
| Paddfloat (Pfloat64, _)
1885-
| Psubfloat (Pfloat64, _)
1886-
| Pmulfloat (Pfloat64, _)
1887-
| Pdivfloat (Pfloat64, _)
1888-
| Pfloatcomp (Pfloat64, _)
1889-
| Punboxed_float_comp (Pfloat64, _)
1927+
| Paddfloat (_, _)
1928+
| Psubfloat (_, _)
1929+
| Pmulfloat (_, _)
1930+
| Pdivfloat (_, _)
1931+
| Pfloatcomp (_, _)
1932+
| Punboxed_float_comp (_, _)
18901933
| Pstringrefu | Pbytesrefu | Pstringrefs | Pbytesrefs | Pstring_load_16 _
18911934
| Pstring_load_32 _ | Pstring_load_64 _ | Pstring_load_128 _
18921935
| Pbytes_load_16 _ | Pbytes_load_32 _ | Pbytes_load_64 _

middle_end/flambda2/parser/fexpr.ml

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -350,12 +350,14 @@ type bytes_like_value = Flambda_primitive.bytes_like_value =
350350
| Bytes
351351
| Bigstring
352352

353+
type float_bitwidth = Flambda_primitive.float_bitwidth
354+
353355
type infix_binop =
354356
| Int_arith of binary_int_arith_op (* on tagged immediates *)
355357
| Int_shift of int_shift_op (* on tagged immediates *)
356358
| Int_comp of signed_or_unsigned comparison_behaviour (* on tagged imms *)
357-
| Float_arith of binary_float_arith_op
358-
| Float_comp of unit comparison_behaviour
359+
| Float_arith of float_bitwidth * binary_float_arith_op
360+
| Float_comp of float_bitwidth * unit comparison_behaviour
359361

360362
type binop =
361363
| Array_load of array_kind * array_accessor_width * mutability

middle_end/flambda2/parser/fexpr_to_flambda.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -411,8 +411,8 @@ let infix_binop (binop : Fexpr.infix_binop) : Flambda_primitive.binary_primitive
411411
| Int_arith o -> Int_arith (Tagged_immediate, o)
412412
| Int_comp c -> Int_comp (Tagged_immediate, c)
413413
| Int_shift s -> Int_shift (Tagged_immediate, s)
414-
| Float_arith o -> Float_arith o
415-
| Float_comp c -> Float_comp c
414+
| Float_arith (w, o) -> Float_arith (w, o)
415+
| Float_comp (w, c) -> Float_comp (w, c)
416416

417417
let block_access_kind (ak : Fexpr.block_access_kind) :
418418
Flambda_primitive.Block_access_kind.t =

middle_end/flambda2/parser/flambda_parser.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4784,7 +4784,7 @@ module Tables = struct
47844784
# 4785 "flambda_parser_in.ml"
47854785
) =
47864786
# 431 "flambda_parser.mly"
4787-
( Float_arith o )
4787+
( Float_arith (Float64, o) )
47884788
# 4789 "flambda_parser_in.ml"
47894789
in
47904790
{
@@ -4817,7 +4817,7 @@ module Tables = struct
48174817
# 4818 "flambda_parser_in.ml"
48184818
) =
48194819
# 432 "flambda_parser.mly"
4820-
( Float_comp c )
4820+
( Float_comp (Float64, c) )
48214821
# 4822 "flambda_parser_in.ml"
48224822
in
48234823
{

middle_end/flambda2/parser/flambda_parser.mly

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -428,8 +428,8 @@ infix_binop:
428428
| o = binary_int_arith_op { Int_arith o }
429429
| c = int_comp { Int_comp (c Signed) }
430430
| s = int_shift { Int_shift s }
431-
| o = binary_float_arith_op { Float_arith o }
432-
| c = float_comp { Float_comp c }
431+
| o = binary_float_arith_op { Float_arith (Float64, o) }
432+
| c = float_comp { Float_comp (Float64, c) }
433433
;
434434

435435
prefix_binop:

middle_end/flambda2/parser/flambda_to_fexpr.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -592,8 +592,8 @@ let binop (op : Flambda_primitive.binary_primitive) : Fexpr.binop =
592592
| Int_comp (i, c) -> Int_comp (i, c)
593593
| Int_shift (Tagged_immediate, s) -> Infix (Int_shift s)
594594
| Int_shift (i, s) -> Int_shift (i, s)
595-
| Float_arith o -> Infix (Float_arith o)
596-
| Float_comp c -> Infix (Float_comp c)
595+
| Float_arith (w, o) -> Infix (Float_arith (w, o))
596+
| Float_comp (w, c) -> Infix (Float_comp (w, c))
597597
| String_or_bigstring_load (slv, saw) -> String_or_bigstring_load (slv, saw)
598598
| Bigarray_get_alignment align -> Bigarray_get_alignment align
599599
| Bigarray_load _ | Atomic_exchange | Atomic_fetch_and_add ->

0 commit comments

Comments
 (0)