Skip to content

Commit f2942e4

Browse files
vouillonOlivierNicole
authored andcommitted
Distinguish float arrays
1 parent 38695ed commit f2942e4

File tree

6 files changed

+355
-258
lines changed

6 files changed

+355
-258
lines changed

compiler/lib/eval.ml

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -259,7 +259,17 @@ let eval_instr info ((x, loc) as i) =
259259
let c = Constant (Int c) in
260260
Flow.Info.update_def info x c;
261261
[ Let (x, c), loc ])
262-
| Let (_, Prim (Extern ("caml_array_unsafe_get" | "caml_array_unsafe_set"), _)) ->
262+
| Let
263+
( _
264+
, Prim
265+
( ( Extern
266+
( "caml_array_unsafe_get"
267+
| "caml_array_unsafe_set"
268+
| "caml_floatarray_unsafe_get"
269+
| "caml_floatarray_unsafe_set"
270+
| "caml_array_unsafe_set_addr" )
271+
| Array_get )
272+
, _ ) ) ->
263273
(* Fresh parameters can be introduced for these primitives
264274
in Specialize_js, which would make the call to [the_const_of]
265275
below fail. *)

compiler/lib/generate.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2041,7 +2041,10 @@ let init () =
20412041
; "caml_array_unsafe_get_float", "caml_array_unsafe_get"
20422042
; "caml_floatarray_unsafe_get", "caml_array_unsafe_get"
20432043
; "caml_array_unsafe_set_float", "caml_array_unsafe_set"
2044+
; "caml_array_unsafe_set_addr", "caml_array_unsafe_set"
20442045
; "caml_floatarray_unsafe_set", "caml_array_unsafe_set"
2046+
; "caml_check_bound_gen", "caml_check_bound"
2047+
; "caml_check_bound_float", "caml_check_bound"
20452048
; "caml_alloc_dummy_float", "caml_alloc_dummy"
20462049
; "caml_make_array", "%identity"
20472050
; "caml_ensure_stack_capacity", "%identity"

compiler/lib/global_flow.ml

Lines changed: 15 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -153,7 +153,15 @@ let expr_deps blocks st x e =
153153
| Constant _ | Prim ((Vectlength | Not | IsInt | Eq | Neq | Lt | Le | Ult), _) | Block _
154154
-> ()
155155
| Special _ -> ()
156-
| Prim ((Extern ("caml_check_bound" | "caml_array_unsafe_get") | Array_get), l) ->
156+
| Prim
157+
( ( Extern
158+
( "caml_check_bound"
159+
| "caml_check_bound_float"
160+
| "caml_check_bound_gen"
161+
| "caml_array_unsafe_get"
162+
| "caml_floatarray_unsafe_get" )
163+
| Array_get )
164+
, l ) ->
157165
(* The analysis knowns about these primitives, and will compute
158166
an approximation of the value they return based on an
159167
approximation of their arguments *)
@@ -424,8 +432,12 @@ let propagate st ~update approx x =
424432
| Phi _ | Expr _ -> assert false)
425433
known
426434
| Top -> Top)
427-
| Prim (Extern "caml_check_bound", [ Pv y; _ ]) -> Var.Tbl.get approx y
428-
| Prim ((Array_get | Extern "caml_array_unsafe_get"), [ Pv y; _ ]) -> (
435+
| Prim
436+
( Extern ("caml_check_bound" | "caml_check_bound_float" | "caml_check_bound_gen")
437+
, [ Pv y; _ ] ) -> Var.Tbl.get approx y
438+
| Prim
439+
( (Array_get | Extern ("caml_array_unsafe_get" | "caml_floatarray_unsafe_get"))
440+
, [ Pv y; _ ] ) -> (
429441
if st.fast
430442
then Domain.others
431443
else

compiler/lib/parse_bytecode.ml

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1554,7 +1554,17 @@ and compile infos pc state instrs =
15541554
let x, state = State.fresh_var state loc in
15551555

15561556
if debug_parser () then Format.printf "%a = %a[%d]@." Var.print x Var.print y n;
1557-
compile infos (pc + 2) state ((Let (x, Field (y, n)), loc) :: instrs)
1557+
compile
1558+
infos
1559+
(pc + 2)
1560+
state
1561+
(( Let
1562+
( x
1563+
, Prim
1564+
( Extern "caml_floatarray_unsafe_get"
1565+
, [ Pv y; Pc (Int (Int32.of_int n)) ] ) )
1566+
, loc )
1567+
:: instrs)
15581568
| SETFIELD0 ->
15591569
let y, _ = State.accu state in
15601570
let z, _ = State.peek 0 state in
@@ -1628,7 +1638,13 @@ and compile infos pc state instrs =
16281638
infos
16291639
(pc + 2)
16301640
(State.pop 1 state)
1631-
((Let (x, const 0l), loc) :: (Set_field (y, n, z), loc) :: instrs)
1641+
(( Let
1642+
( x
1643+
, Prim
1644+
( Extern "caml_floatarray_unsafe_set"
1645+
, [ Pv y; Pc (Int (Int32.of_int n)); Pv z ] ) )
1646+
, loc )
1647+
:: instrs)
16321648
| VECTLENGTH ->
16331649
let y, _ = State.accu state in
16341650
let x, state = State.fresh_var state loc in

compiler/lib/specialize_js.ml

Lines changed: 61 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -195,48 +195,90 @@ let specialize_instrs info l =
195195
the array access. The bound checking function returns the array,
196196
which allows to produce more compact code. *)
197197
match i with
198-
| Let (x, Prim (Extern "caml_array_get", [ y; z ]))
199-
| Let (x, Prim (Extern "caml_array_get_float", [ y; z ]))
200-
| Let (x, Prim (Extern "caml_array_get_addr", [ y; z ])) ->
198+
| Let
199+
( x
200+
, Prim
201+
( Extern
202+
(( "caml_array_get"
203+
| "caml_array_get_float"
204+
| "caml_floatarray_get"
205+
| "caml_array_get_addr" ) as prim)
206+
, [ y; z ] ) ) ->
201207
let idx =
202208
match the_int info z with
203209
| Some idx -> `Cst idx
204210
| None -> `Var z
205211
in
212+
let instr y =
213+
let prim =
214+
match prim with
215+
| "caml_array_get" -> Extern "caml_array_unsafe_get"
216+
| "caml_array_get_float" | "caml_floatarray_get" ->
217+
Extern "caml_floatarray_unsafe_get"
218+
| "caml_array_get_addr" -> Array_get
219+
| _ -> assert false
220+
in
221+
Let (x, Prim (prim, [ y; z ])), loc
222+
in
206223
if List.mem (y, idx) ~set:checks
207224
then
208-
let acc =
209-
(Let (x, Prim (Extern "caml_array_unsafe_get", [ y; z ])), loc) :: acc
210-
in
225+
let acc = instr y :: acc in
211226
aux info checks r acc
212227
else
228+
let check =
229+
match prim with
230+
| "caml_array_get" -> "caml_check_bound_gen"
231+
| "caml_array_get_float" | "caml_floatarray_get" ->
232+
"caml_check_bound_float"
233+
| "caml_array_get_addr" -> "caml_check_bound"
234+
| _ -> assert false
235+
in
213236
let y' = Code.Var.fresh () in
214237
let acc =
215-
(Let (x, Prim (Extern "caml_array_unsafe_get", [ Pv y'; z ])), loc)
216-
:: (Let (y', Prim (Extern "caml_check_bound", [ y; z ])), noloc)
217-
:: acc
238+
instr (Pv y') :: (Let (y', Prim (Extern check, [ y; z ])), noloc) :: acc
218239
in
219240
aux info ((y, idx) :: checks) r acc
220-
| Let (x, Prim (Extern "caml_array_set", [ y; z; t ]))
221-
| Let (x, Prim (Extern "caml_array_set_float", [ y; z; t ]))
222-
| Let (x, Prim (Extern "caml_array_set_addr", [ y; z; t ])) ->
241+
| Let
242+
( x
243+
, Prim
244+
( Extern
245+
(( "caml_array_set"
246+
| "caml_array_set_float"
247+
| "caml_floatarray_set"
248+
| "caml_array_set_addr" ) as prim)
249+
, [ y; z; t ] ) ) ->
223250
let idx =
224251
match the_int info z with
225252
| Some idx -> `Cst idx
226253
| None -> `Var z
227254
in
255+
let instr y =
256+
let prim =
257+
match prim with
258+
| "caml_array_set" -> "caml_array_unsafe_set"
259+
| "caml_array_set_float" | "caml_floatarray_set" ->
260+
"caml_floatarray_unsafe_set"
261+
| "caml_array_set_addr" -> "caml_array_unsafe_set_addr"
262+
| _ -> assert false
263+
in
264+
Let (x, Prim (Extern prim, [ y; z; t ])), loc
265+
in
228266
if List.mem (y, idx) ~set:checks
229267
then
230-
let acc =
231-
(Let (x, Prim (Extern "caml_array_unsafe_set", [ y; z; t ])), loc) :: acc
232-
in
268+
let acc = instr y :: acc in
233269
aux info checks r acc
234270
else
271+
let check =
272+
match prim with
273+
| "caml_array_set" -> "caml_check_bound_gen"
274+
| "caml_array_set_float" | "caml_floatarray_set" ->
275+
"caml_check_bound_float"
276+
| "caml_array_set_addr" -> "caml_check_bound"
277+
| _ -> assert false
278+
in
235279
let y' = Code.Var.fresh () in
236280
let acc =
237-
(Let (x, Prim (Extern "caml_array_unsafe_set", [ Pv y'; z; t ])), loc)
238-
:: (Let (y', Prim (Extern "caml_check_bound", [ y; z ])), noloc)
239-
:: acc
281+
instr (Pv y') :: (Let (y', Prim (Extern check, [ y; z ])), noloc) :: acc
240282
in
241283
aux info ((y, idx) :: checks) r acc
242284
| _ ->
@@ -270,6 +312,7 @@ let f_once p =
270312
( "caml_array_set"
271313
| "caml_array_unsafe_set"
272314
| "caml_array_set_float"
315+
| "caml_floatarray_set"
273316
| "caml_array_set_addr"
274317
| "caml_array_unsafe_set_float"
275318
| "caml_floatarray_unsafe_set" )

0 commit comments

Comments
 (0)