Skip to content

Commit 442ea24

Browse files
TheNumbatTheNumbat
authored
flambda-backend: float32 backend operations (#2385)
1 parent 8442329 commit 442ea24

File tree

17 files changed

+410
-8
lines changed

17 files changed

+410
-8
lines changed

‎Makefile

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -648,6 +648,7 @@ runtime4_COMMON_C_SOURCES = \
648648
prng \
649649
signals \
650650
simd \
651+
float32 \
651652
skiplist \
652653
startup_aux \
653654
str \
@@ -721,6 +722,7 @@ runtime_COMMON_C_SOURCES = \
721722
shared_heap \
722723
signals \
723724
simd \
725+
float32 \
724726
skiplist \
725727
startup_aux \
726728
str \

‎runtime/caml/custom.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -79,6 +79,7 @@ extern const struct custom_operations caml_nativeint_ops;
7979
extern const struct custom_operations caml_int32_ops;
8080
extern const struct custom_operations caml_int64_ops;
8181
extern const struct custom_operations caml_ba_ops;
82+
extern const struct custom_operations caml_float32_ops;
8283
#endif /* CAML_INTERNALS */
8384

8485
#ifdef __cplusplus

‎runtime/caml/dune

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@
9292
(sync.h as caml/sync.h)
9393
(sys.h as caml/sys.h)
9494
(simd.h as caml/simd.h)
95+
(float32.h as caml/float32.h)
9596
(version.h as caml/version.h)
9697
(weak.h as caml/weak.h)
9798
(winsupport.h as caml/winsupport.h)

‎runtime/caml/float32.h

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
/**************************************************************************/
2+
/* */
3+
/* OCaml */
4+
/* */
5+
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6+
/* Max Slater, Jane Street */
7+
/* */
8+
/* Copyright 1996 Institut National de Recherche en Informatique et */
9+
/* en Automatique. */
10+
/* */
11+
/* All rights reserved. This file is distributed under the terms of */
12+
/* the GNU Lesser General Public License version 2.1, with the */
13+
/* special exception on linking described in the file LICENSE. */
14+
/* */
15+
/**************************************************************************/
16+
17+
#ifndef CAML_FLOAT32_H
18+
#define CAML_FLOAT32_H
19+
20+
#include "mlvalues.h"
21+
22+
#define Float32_val(v) (*((float *)Data_custom_val(v)))
23+
24+
CAMLextern value caml_copy_float32(float);
25+
26+
#endif /* CAML_FLOAT32_H */

‎runtime/custom.c

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,4 +180,5 @@ void caml_init_custom_operations(void)
180180
caml_register_custom_operations(&caml_nativeint_ops);
181181
caml_register_custom_operations(&caml_int64_ops);
182182
caml_register_custom_operations(&caml_ba_ops);
183+
caml_register_custom_operations(&caml_float32_ops);
183184
}

‎runtime/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,7 @@
2020
alloc.c array.c compare.c extern.c floats.c gc_ctrl.c hash.c intern.c interp.c ints.c io.c
2121
lexing.c md5.c meta.c memprof.c obj.c parsing.c signals.c str.c sys.c callback.c weak.c
2222
finalise.c domain.c platform.c fiber.c memory.c startup_aux.c runtime_events.c sync.c
23-
dynlink.c backtrace_byt.c backtrace.c afl.c
23+
dynlink.c backtrace_byt.c backtrace.c afl.c float32.c
2424
bigarray.c prng.c win32.c
2525
)
2626
(action (with-stdout-to %{targets}

‎runtime/float32.c

Lines changed: 172 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,172 @@
1+
/**************************************************************************/
2+
/* */
3+
/* OCaml */
4+
/* */
5+
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6+
/* Max Slater, Jane Street */
7+
/* */
8+
/* Copyright 1996 Institut National de Recherche en Informatique et */
9+
/* en Automatique. */
10+
/* */
11+
/* All rights reserved. This file is distributed under the terms of */
12+
/* the GNU Lesser General Public License version 2.1, with the */
13+
/* special exception on linking described in the file LICENSE. */
14+
/* */
15+
/**************************************************************************/
16+
17+
#include <math.h>
18+
#include <float.h>
19+
20+
#include "caml/alloc.h"
21+
#include "caml/custom.h"
22+
#include "caml/float32.h"
23+
#include "caml/memory.h"
24+
#include "caml/intext.h"
25+
#include "caml/mlvalues.h"
26+
27+
#define CAML_INTERNALS
28+
29+
CAML_STATIC_ASSERT(sizeof(float) == sizeof(int32_t));
30+
31+
intnat caml_float32_compare_unboxed(float f, float g)
32+
{
33+
/* If one or both of f and g is NaN, order according to the convention
34+
NaN = NaN and NaN < x for all other floats x. */
35+
/* This branchless implementation is from GPR#164.
36+
Note that [f == f] if and only if f is not NaN.
37+
We expand each subresult of the expression to
38+
avoid sign-extension on 64bit. GPR#2250. */
39+
intnat res =
40+
(intnat)(f > g) - (intnat)(f < g) + (intnat)(f == f) - (intnat)(g == g);
41+
return res;
42+
}
43+
44+
static int float32_cmp(value v1, value v2)
45+
{
46+
return caml_float32_compare_unboxed(Float32_val(v1), Float32_val(v2));
47+
}
48+
49+
static intnat float32_hash(value v)
50+
{
51+
union {
52+
float f;
53+
uint32_t i;
54+
} u;
55+
uint32_t n;
56+
u.f = Float32_val(v); n = u.i;
57+
/* Normalize NaNs */
58+
if ((n & 0x7F800000) == 0x7F800000 && (n & 0x007FFFFF) != 0) {
59+
n = 0x7F800001;
60+
}
61+
/* Normalize -0 into +0 */
62+
else if (n == 0x80000000) {
63+
n = 0;
64+
}
65+
return n;
66+
}
67+
68+
static uintnat float32_deserialize(void *dst)
69+
{
70+
*((float *)dst) = caml_deserialize_float_4();
71+
return 4;
72+
}
73+
74+
static void float32_serialize(value v, uintnat *bsize_32,
75+
uintnat *bsize_64)
76+
{
77+
caml_serialize_float_4(Float32_val(v));
78+
*bsize_32 = *bsize_64 = 4;
79+
}
80+
81+
static const struct custom_fixed_length float32_length = {4, 4};
82+
83+
CAMLexport struct custom_operations caml_float32_ops = {
84+
"_f32",
85+
custom_finalize_default,
86+
float32_cmp,
87+
float32_hash,
88+
float32_serialize,
89+
float32_deserialize,
90+
custom_compare_ext_default,
91+
&float32_length
92+
};
93+
94+
CAMLexport value caml_copy_float32(float f)
95+
{
96+
value res = caml_alloc_custom(&caml_float32_ops, 4, 0, 1);
97+
Float32_val(res) = f;
98+
return res;
99+
}
100+
101+
CAMLprim value caml_float32_of_float(value d)
102+
{
103+
return caml_copy_float32((float)Double_val(d));
104+
}
105+
106+
CAMLprim value caml_float_of_float32(value f)
107+
{
108+
return caml_copy_double((double)Float32_val(f));
109+
}
110+
111+
CAMLprim value caml_int_of_float32(value f)
112+
{
113+
return Val_long((intnat)Float32_val(f));
114+
}
115+
116+
CAMLprim value caml_float32_of_int(value n)
117+
{
118+
return caml_copy_float32((float)Long_val(n));
119+
}
120+
121+
CAMLprim value caml_neg_float32(value f)
122+
{
123+
return caml_copy_float32(-Float32_val(f));
124+
}
125+
126+
CAMLprim value caml_abs_float32(value f)
127+
{
128+
return caml_copy_float32(fabsf(Float32_val(f)));
129+
}
130+
131+
CAMLprim value caml_add_float32(value f, value g)
132+
{
133+
return caml_copy_float32(Float32_val(f) + Float32_val(g));
134+
}
135+
136+
CAMLprim value caml_sub_float32(value f, value g)
137+
{
138+
return caml_copy_float32(Float32_val(f) - Float32_val(g));
139+
}
140+
141+
CAMLprim value caml_mul_float32(value f, value g)
142+
{
143+
return caml_copy_float32(Float32_val(f) * Float32_val(g));
144+
}
145+
146+
CAMLprim value caml_div_float32(value f, value g)
147+
{
148+
return caml_copy_float32(Float32_val(f) / Float32_val(g));
149+
}
150+
151+
CAMLprim value caml_sqrt_float32(value f)
152+
{
153+
return caml_copy_float32(sqrtf(Float32_val(f)));
154+
}
155+
156+
CAMLprim value caml_float32_compare(value vf, value vg)
157+
{
158+
return Val_int(caml_float32_compare_unboxed(Float32_val(vf), Float32_val(vg)));
159+
}
160+
161+
#define DEFINE_NAN_CMP(op) \
162+
(value f, value g) \
163+
{ \
164+
return Val_bool(Float32_val(f) op Float32_val(g)); \
165+
}
166+
167+
CAMLprim value caml_eq_float32 DEFINE_NAN_CMP(==)
168+
CAMLprim value caml_neq_float32 DEFINE_NAN_CMP(!=)
169+
CAMLprim value caml_le_float32 DEFINE_NAN_CMP(<=)
170+
CAMLprim value caml_lt_float32 DEFINE_NAN_CMP(<)
171+
CAMLprim value caml_ge_float32 DEFINE_NAN_CMP(>=)
172+
CAMLprim value caml_gt_float32 DEFINE_NAN_CMP(>)

‎runtime/floats.c

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -419,8 +419,6 @@ CAMLprim value caml_float_of_string(value vs)
419419
return Val_unit; /* not reached */
420420
}
421421

422-
// CR mslater: (float32) runtime
423-
424422
CAMLprim value caml_int_of_float(value f)
425423
{
426424
return Val_long((intnat) Double_val(f));

‎runtime/gen_primitives.sh

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ export LC_ALL=C
2626
lexing md5 meta memprof obj parsing signals str sys callback weak \
2727
finalise domain platform fiber memory startup_aux runtime_events sync \
2828
dynlink backtrace_byt backtrace afl \
29-
bigarray prng
29+
bigarray prng float32
3030
do
3131
sed -n -e 's/^CAMLprim value \([a-z0-9_][a-z0-9_]*\).*/\1/p' \
3232
"runtime/$prim.c"

‎runtime4/Makefile

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ BYTECODE_C_SOURCES := $(addsuffix .c, \
2525
signals_byt printexc backtrace_byt backtrace compare ints eventlog prng \
2626
floats simd str array io extern intern hash sys meta parsing gc_ctrl md5 obj \
2727
lexing callback debugger weak compact finalise custom dynlink \
28-
afl $(UNIX_OR_WIN32) bigarray main memprof domain \
28+
afl $(UNIX_OR_WIN32) bigarray main memprof domain float32 \
2929
skiplist codefrag)
3030

3131
NATIVE_C_SOURCES := $(addsuffix .c, \
@@ -34,7 +34,7 @@ NATIVE_C_SOURCES := $(addsuffix .c, \
3434
floats simd str array io extern intern hash sys parsing gc_ctrl eventlog prng md5 obj \
3535
lexing $(UNIX_OR_WIN32) printexc callback weak compact finalise custom \
3636
globroots backtrace_nat backtrace dynlink_nat debugger meta \
37-
dynlink clambda_checks afl bigarray \
37+
dynlink clambda_checks afl bigarray float32 \
3838
memprof domain skiplist codefrag)
3939

4040
# Header files generated by configure

‎runtime4/caml/custom.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@ extern struct custom_operations caml_nativeint_ops;
8181
extern struct custom_operations caml_int32_ops;
8282
extern struct custom_operations caml_int64_ops;
8383
extern struct custom_operations caml_ba_ops;
84+
extern struct custom_operations caml_float32_ops;
8485
#endif /* CAML_INTERNALS */
8586

8687
#ifdef __cplusplus

‎runtime4/caml/dune

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,6 +92,7 @@
9292
(s.h as caml/s.h)
9393
(signals.h as caml/signals.h)
9494
(simd.h as caml/simd.h)
95+
(float32.h as caml/float32.h)
9596
(skiplist.h as caml/skiplist.h)
9697
(signals_machdep.h as caml/signals_machdep.h)
9798
(stack.h as caml/stack.h)

‎runtime4/caml/float32.h

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
/**************************************************************************/
2+
/* */
3+
/* OCaml */
4+
/* */
5+
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
6+
/* Max Slater, Jane Street */
7+
/* */
8+
/* Copyright 1996 Institut National de Recherche en Informatique et */
9+
/* en Automatique. */
10+
/* */
11+
/* All rights reserved. This file is distributed under the terms of */
12+
/* the GNU Lesser General Public License version 2.1, with the */
13+
/* special exception on linking described in the file LICENSE. */
14+
/* */
15+
/**************************************************************************/
16+
17+
#ifndef CAML_FLOAT32_H
18+
#define CAML_FLOAT32_H
19+
20+
#include "mlvalues.h"
21+
22+
#define Float32_val(v) (*((float *)Data_custom_val(v)))
23+
24+
CAMLextern value caml_copy_float32(float);
25+
26+
#endif /* CAML_FLOAT32_H */

‎runtime4/custom.c

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -164,4 +164,5 @@ void caml_init_custom_operations(void)
164164
caml_register_custom_operations(&caml_nativeint_ops);
165165
caml_register_custom_operations(&caml_int64_ops);
166166
caml_register_custom_operations(&caml_ba_ops);
167+
caml_register_custom_operations(&caml_float32_ops);
167168
}

‎runtime4/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@
2323
callback.c weak.c
2424
finalise.c stacks.c dynlink.c backtrace_byt.c backtrace.c
2525
afl.c
26-
bigarray.c prng.c eventlog.c misc.c domain.c)
26+
bigarray.c prng.c eventlog.c misc.c domain.c float32.c)
2727
(action (with-stdout-to %{targets} (run %{dep:gen_primitives.sh}))))
2828

2929
(rule

0 commit comments

Comments
 (0)