Skip to content

Commit 4c97d26

Browse files
EkdohibsEkdohibs
authored
flambda-backend: Unboxed numbers (#1165)
1 parent 1ad7252 commit 4c97d26

19 files changed

+143
-8
lines changed

‎asmcomp/cmm_helpers.ml

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2243,6 +2243,10 @@ let machtype_of_layout (layout : Lambda.layout) =
22432243
match layout with
22442244
| Ptop -> Misc.fatal_error "No machtype for layout [Ptop]"
22452245
| Pbottom -> Misc.fatal_error "No unique machtype for layout [Pbottom]"
2246+
| Punboxed_float -> typ_float
2247+
| Punboxed_int _ ->
2248+
(* Only 64-bit architectures, so this is always [typ_int] *)
2249+
typ_int
22462250
| Pvalue _ -> typ_val
22472251

22482252
let final_curry_function nlocal arity result =
@@ -3149,4 +3153,6 @@ let kind_of_layout (layout : Lambda.layout) =
31493153
| Ptop | Pbottom ->
31503154
(* This is incorrect but only used for unboxing *)
31513155
Vval Pgenval
3156+
| Punboxed_float -> Vfloat
3157+
| Punboxed_int _ -> Vint
31523158
| Pvalue kind -> Vval kind

‎asmcomp/cmmgen.ml

Lines changed: 25 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -606,6 +606,7 @@ let rec transl env e =
606606
| Pandbint _ | Porbint _ | Pxorbint _ | Plslbint _ | Plsrbint _
607607
| Pasrbint _ | Pbintcomp (_, _) | Pstring_load _ | Pbytes_load _
608608
| Pbytes_set _ | Pbigstring_load _ | Pbigstring_set _
609+
| Punbox_float | Pbox_float _ | Punbox_int _ | Pbox_int _
609610
| Pbbswap _), _)
610611
->
611612
fatal_error "Cmmgen.transl:prim"
@@ -750,6 +751,8 @@ and transl_catch (kind : Cmm.value_kind) env nfail ids body handler dbg =
750751
Misc.fatal_errorf
751752
"Variable %a with layout [Pbottom] can't be compiled"
752753
VP.print id
754+
| Punboxed_float | Punboxed_int _ ->
755+
u := No_unboxing
753756
| Pvalue kind ->
754757
let strict =
755758
match kind with
@@ -765,12 +768,12 @@ and transl_catch (kind : Cmm.value_kind) env nfail ids body handler dbg =
765768
let body = transl env_body body in
766769
let new_env, rewrite, ids =
767770
List.fold_right
768-
(fun (id, _kind, u) (env, rewrite, ids) ->
771+
(fun (id, layout, u) (env, rewrite, ids) ->
769772
match !u with
770773
| No_unboxing | Boxed (_, true) | No_result ->
771774
env,
772775
(fun x -> x) :: rewrite,
773-
(id, Cmm.typ_val) :: ids
776+
(id, machtype_of_layout layout) :: ids
774777
| Boxed (bn, false) ->
775778
let unboxed_id = V.create_local (VP.name id) in
776779
add_unboxed_id (VP.var id) unboxed_id bn env,
@@ -883,7 +886,15 @@ and transl_prim_1 env p arg dbg =
883886
offsetint n (transl env arg) dbg
884887
| Poffsetref n ->
885888
offsetref n (transl env arg) dbg
889+
| Punbox_int bi ->
890+
transl_unbox_int dbg env bi arg
891+
| Pbox_int (bi, m) ->
892+
box_int dbg bi m (transl env arg)
886893
(* Floating-point operations *)
894+
| Punbox_float ->
895+
transl_unbox_float dbg env arg
896+
| Pbox_float m ->
897+
box_float dbg m (transl env arg)
887898
| Pfloatofint m ->
888899
box_float dbg m (Cop(Cfloatofint, [untag_int(transl env arg) dbg], dbg))
889900
| Pintoffloat ->
@@ -1118,6 +1129,7 @@ and transl_prim_2 env p arg1 arg2 dbg =
11181129
| Pnegbint _ | Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _)
11191130
| Pbigarraydim _ | Pbytes_set _ | Pbigstring_set _ | Pbbswap _
11201131
| Pprobe_is_enabled _
1132+
| Punbox_float | Pbox_float _ | Punbox_int _ | Pbox_int _
11211133
->
11221134
fatal_errorf "Cmmgen.transl_prim_2: %a"
11231135
Printclambda_primitives.primitive p
@@ -1178,6 +1190,7 @@ and transl_prim_3 env p arg1 arg2 arg3 dbg =
11781190
| Pbigarrayref (_, _, _, _) | Pbigarrayset (_, _, _, _) | Pbigarraydim _
11791191
| Pstring_load _ | Pbytes_load _ | Pbigstring_load _ | Pbbswap _
11801192
| Pprobe_is_enabled _
1193+
| Punbox_float | Pbox_float _ | Punbox_int _ | Pbox_int _
11811194
->
11821195
fatal_errorf "Cmmgen.transl_prim_3: %a"
11831196
Printclambda_primitives.primitive p
@@ -1263,6 +1276,16 @@ and transl_let env str (layout : Lambda.layout) id exp transl_body =
12631276
there may be constant closures inside that need lifting out. *)
12641277
let _cbody : expression = transl_body env in
12651278
cexp
1279+
| Punboxed_float | Punboxed_int _ -> begin
1280+
let cexp = transl env exp in
1281+
let cbody = transl_body env in
1282+
match str with
1283+
| (Immutable | Immutable_unique) ->
1284+
Clet(id, cexp, cbody)
1285+
| Mutable ->
1286+
let typ = machtype_of_layout layout in
1287+
Clet_mut(id, typ, cexp, cbody)
1288+
end
12661289
| Pvalue kind ->
12671290
transl_let_value env str kind id exp transl_body
12681291

‎bytecomp/bytegen.ml

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -121,6 +121,7 @@ let preserve_tailcall_for_prim = function
121121
| Pdivint _ | Pmodint _ | Pandint | Porint | Pxorint | Plslint | Plsrint
122122
| Pasrint | Pintcomp _ | Poffsetint _ | Poffsetref _ | Pintoffloat
123123
| Pfloatofint _ | Pnegfloat _ | Pabsfloat _ | Paddfloat _ | Psubfloat _ | Pmulfloat _
124+
| Punbox_float | Pbox_float _ | Punbox_int _ | Pbox_int _
124125
| Pdivfloat _ | Pfloatcomp _ | Pstringlength | Pstringrefu | Pstringrefs
125126
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
126127
| Pbyteslength | Pbytesrefu | Pbytessetu | Pbytesrefs | Pbytessets
@@ -530,6 +531,7 @@ let comp_primitive p args =
530531
| Pmakeblock _
531532
| Pmakefloatblock _
532533
| Pprobe_is_enabled _
534+
| Punbox_float | Pbox_float _ | Punbox_int _ | Pbox_int _
533535
->
534536
fatal_error "Bytegen.comp_primitive"
535537

@@ -705,6 +707,10 @@ let rec comp_expr env exp sz cont =
705707
end
706708
| Lprim((Popaque _ | Pobj_magic _), [arg], _) ->
707709
comp_expr env arg sz cont
710+
| Lprim((Pbox_float _ | Punbox_float), [arg], _) ->
711+
comp_expr env arg sz cont
712+
| Lprim((Pbox_int _ | Punbox_int _), [arg], _) ->
713+
comp_expr env arg sz cont
708714
| Lprim(Pignore, [arg], _) ->
709715
comp_expr env arg sz (add_const_unit cont)
710716
| Lprim(Pnot, [arg], _) ->

‎lambda/lambda.ml

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -239,6 +239,10 @@ type primitive =
239239
(* Primitives for [Obj] *)
240240
| Pobj_dup
241241
| Pobj_magic of layout
242+
| Punbox_float
243+
| Pbox_float of alloc_mode
244+
| Punbox_int of boxed_integer
245+
| Pbox_int of boxed_integer * alloc_mode
242246

243247
and integer_comparison =
244248
Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -257,6 +261,8 @@ and value_kind =
257261
and layout =
258262
| Ptop
259263
| Pvalue of value_kind
264+
| Punboxed_float
265+
| Punboxed_int of boxed_integer
260266
| Pbottom
261267

262268
and block_shape =
@@ -330,8 +336,12 @@ let compatible_layout x y =
330336
| Pbottom, _
331337
| _, Pbottom -> true
332338
| Pvalue _, Pvalue _ -> true
339+
| Punboxed_float, Punboxed_float -> true
340+
| Punboxed_int bi1, Punboxed_int bi2 ->
341+
equal_boxed_integer bi1 bi2
333342
| Ptop, Ptop -> true
334343
| Ptop, _ | _, Ptop -> false
344+
| (Pvalue _ | Punboxed_float | Punboxed_int _), _ -> false
335345

336346
let must_be_value layout =
337347
match layout with
@@ -1372,6 +1382,8 @@ let primitive_may_allocate : primitive -> alloc_mode option = function
13721382
| Pprobe_is_enabled _ -> None
13731383
| Pobj_dup -> Some alloc_heap
13741384
| Pobj_magic _ -> None
1385+
| Punbox_float | Punbox_int _ -> None
1386+
| Pbox_float m | Pbox_int (_, m) -> Some m
13751387

13761388
let constant_layout = function
13771389
| Const_int _ | Const_char _ -> Pvalue Pintval
@@ -1400,7 +1412,9 @@ let primitive_result_layout (p : primitive) =
14001412
| Pduparray _ | Pbigarraydim _ | Pobj_dup -> layout_block
14011413
| Pfield _ | Pfield_computed _ -> layout_field
14021414
| Pfloatfield _ | Pfloatofint _ | Pnegfloat _ | Pabsfloat _
1403-
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _ -> layout_float
1415+
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _
1416+
| Pbox_float _ -> layout_float
1417+
| Punbox_float -> Punboxed_float
14041418
| Pccall _p ->
14051419
(* CR ncourant: use native_repr *)
14061420
layout_any_value
@@ -1430,8 +1444,9 @@ let primitive_result_layout (p : primitive) =
14301444
| Pmulbint (bi, _) | Pdivbint {size = bi} | Pmodbint {size = bi}
14311445
| Pandbint (bi, _) | Porbint (bi, _) | Pxorbint (bi, _)
14321446
| Plslbint (bi, _) | Plsrbint (bi, _) | Pasrbint (bi, _)
1433-
| Pbbswap (bi, _) ->
1447+
| Pbbswap (bi, _) | Pbox_int (bi, _) ->
14341448
layout_boxedint bi
1449+
| Punbox_int bi -> Punboxed_int bi
14351450
| Pstring_load_32 _ | Pbytes_load_32 _ | Pbigstring_load_32 _ ->
14361451
layout_boxedint Pint32
14371452
| Pstring_load_64 _ | Pbytes_load_64 _ | Pbigstring_load_64 _ ->

‎lambda/lambda.mli

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -190,6 +190,10 @@ type primitive =
190190
(* Primitives for [Obj] *)
191191
| Pobj_dup
192192
| Pobj_magic of layout
193+
| Punbox_float
194+
| Pbox_float of alloc_mode
195+
| Punbox_int of boxed_integer
196+
| Pbox_int of boxed_integer * alloc_mode
193197

194198
and integer_comparison =
195199
Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -214,6 +218,8 @@ and value_kind =
214218
and layout =
215219
| Ptop
216220
| Pvalue of value_kind
221+
| Punboxed_float
222+
| Punboxed_int of boxed_integer
217223
| Pbottom
218224

219225
and block_shape =

‎lambda/printlambda.ml

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -100,6 +100,8 @@ let layout ppf layout =
100100
| Pvalue k -> value_kind ppf k
101101
| Ptop -> fprintf ppf "[top]"
102102
| Pbottom -> fprintf ppf "[bottom]"
103+
| Punboxed_float -> fprintf ppf "[unboxed_float]"
104+
| Punboxed_int bi -> fprintf ppf "[unboxed_%s]" (boxed_integer_name bi)
103105

104106
let return_kind ppf (mode, kind) =
105107
let smode = alloc_mode mode in
@@ -113,6 +115,8 @@ let return_kind ppf (mode, kind) =
113115
| Pvalue (Pboxedintval bi) -> fprintf ppf ": %s%s@ " smode (boxed_integer_name bi)
114116
| Pvalue (Pvariant { consts; non_consts; }) ->
115117
variant_kind value_kind' ppf ~consts ~non_consts
118+
| Punboxed_float -> fprintf ppf ": unboxed_float@ "
119+
| Punboxed_int bi -> fprintf ppf ": unboxed_%s@ " (boxed_integer_name bi)
116120
| Ptop -> fprintf ppf ": top@ "
117121
| Pbottom -> fprintf ppf ": bottom@ "
118122

@@ -447,6 +451,11 @@ let primitive ppf = function
447451
| Pprobe_is_enabled {name} -> fprintf ppf "probe_is_enabled[%s]" name
448452
| Pobj_dup -> fprintf ppf "obj_dup"
449453
| Pobj_magic _ -> fprintf ppf "obj_magic"
454+
| Punbox_float -> fprintf ppf "unbox_float"
455+
| Pbox_float m -> fprintf ppf "box_float%s" (alloc_kind m)
456+
| Punbox_int bi -> fprintf ppf "unbox_%s" (boxed_integer_name bi)
457+
| Pbox_int (bi, m) ->
458+
fprintf ppf "box_%s%s" (boxed_integer_name bi) (alloc_kind m)
450459

451460
let name_of_primitive = function
452461
| Pbytes_of_string -> "Pbytes_of_string"
@@ -555,6 +564,10 @@ let name_of_primitive = function
555564
| Pprobe_is_enabled _ -> "Pprobe_is_enabled"
556565
| Pobj_dup -> "Pobj_dup"
557566
| Pobj_magic _ -> "Pobj_magic"
567+
| Punbox_float -> "Punbox_float"
568+
| Pbox_float _ -> "Pbox_float"
569+
| Punbox_int _ -> "Punbox_int"
570+
| Pbox_int _ -> "Pbox_int"
558571

559572
let check_attribute ppf check =
560573
let check_property = function

‎lambda/tmc.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -880,6 +880,8 @@ let rec choice ctx t =
880880
| Pisint _ | Pisout
881881
| Pignore
882882
| Pcompare_ints | Pcompare_floats | Pcompare_bints _
883+
| Punbox_float | Pbox_float _
884+
| Punbox_int _ | Pbox_int _
883885

884886
(* we don't handle array indices as destinations yet *)
885887
| (Pmakearray _ | Pduparray _)

‎lambda/translprim.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -857,6 +857,7 @@ let lambda_primitive_needs_event_after = function
857857
collect the call stack. *)
858858
| Pduprecord _ | Pccall _ | Pfloatofint _ | Pnegfloat _ | Pabsfloat _
859859
| Paddfloat _ | Psubfloat _ | Pmulfloat _ | Pdivfloat _ | Pstringrefs | Pbytesrefs
860+
| Pbox_float _ | Pbox_int _
860861
| Pbytessets | Pmakearray (Pgenarray, _, _) | Pduparray _
861862
| Parrayrefu (Pgenarray | Pfloatarray) | Parraysetu (Pgenarray | Pfloatarray)
862863
| Parrayrefs _ | Parraysets _ | Pbintofint _ | Pcvtbint _ | Pnegbint _
@@ -883,7 +884,7 @@ let lambda_primitive_needs_event_after = function
883884
| Parraylength _ | Parrayrefu _ | Parraysetu _ | Pisint _ | Pisout
884885
| Pprobe_is_enabled _
885886
| Pintofbint _ | Pctconst _ | Pbswap16 | Pint_as_pointer | Popaque _
886-
| Pobj_magic _ -> false
887+
| Pobj_magic _ | Punbox_float | Punbox_int _ -> false
887888

888889
(* Determine if a primitive should be surrounded by an "after" debug event *)
889890
let primitive_needs_event_after = function

‎middle_end/clambda_primitives.ml

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -122,6 +122,10 @@ type primitive =
122122
| Popaque
123123
(* Probes *)
124124
| Pprobe_is_enabled of { name : string }
125+
| Punbox_float
126+
| Pbox_float of alloc_mode
127+
| Punbox_int of boxed_integer
128+
| Pbox_int of boxed_integer * alloc_mode
125129

126130
and integer_comparison = Lambda.integer_comparison =
127131
Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -144,6 +148,8 @@ and value_kind = Lambda.value_kind =
144148
and layout = Lambda.layout =
145149
| Ptop
146150
| Pvalue of value_kind
151+
| Punboxed_float
152+
| Punboxed_int of boxed_integer
147153
| Pbottom
148154

149155
and block_shape = Lambda.block_shape
@@ -171,4 +177,8 @@ and raise_kind = Lambda.raise_kind =
171177

172178
let equal (x: primitive) (y: primitive) = x = y
173179

174-
let result_layout _p = Lambda.layout_any_value
180+
let result_layout (p : primitive) =
181+
match p with
182+
| Punbox_float -> Lambda.Punboxed_float
183+
| Punbox_int bi -> Lambda.Punboxed_int bi
184+
| _ -> Lambda.layout_any_value

‎middle_end/clambda_primitives.mli

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -125,6 +125,10 @@ type primitive =
125125
| Popaque
126126
(* Probes *)
127127
| Pprobe_is_enabled of { name : string }
128+
| Punbox_float
129+
| Pbox_float of alloc_mode
130+
| Punbox_int of boxed_integer
131+
| Pbox_int of boxed_integer * alloc_mode
128132

129133
and integer_comparison = Lambda.integer_comparison =
130134
Ceq | Cne | Clt | Cgt | Cle | Cge
@@ -147,6 +151,8 @@ and value_kind = Lambda.value_kind =
147151
and layout = Lambda.layout =
148152
| Ptop
149153
| Pvalue of value_kind
154+
| Punboxed_float
155+
| Punboxed_int of boxed_integer
150156
| Pbottom
151157

152158
and block_shape = Lambda.block_shape

‎middle_end/closure/closure.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,8 @@ let is_gc_ignorable kind =
6161
match kind with
6262
| Ptop -> Misc.fatal_error "[Ptop] can't be stored in a closure."
6363
| Pbottom -> Misc.fatal_error "[Pbottom] should not be stored in a closure."
64+
| Punboxed_float -> true
65+
| Punboxed_int _ -> true
6466
| Pvalue Pintval -> true
6567
| Pvalue (Pgenval | Pfloatval | Pboxedintval _ | Pvariant _ | Parrayval _) -> false
6668

‎middle_end/convert_primitives.ml

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -154,6 +154,10 @@ let convert (prim : Lambda.primitive) : Clambda_primitives.primitive =
154154
~native_name:"caml_obj_dup"
155155
~native_repr_args:[P.Prim_global, P.Same_as_ocaml_repr]
156156
~native_repr_res:(P.Prim_global, P.Same_as_ocaml_repr))
157+
| Punbox_float -> Punbox_float
158+
| Pbox_float m -> Pbox_float m
159+
| Punbox_int bi -> Punbox_int bi
160+
| Pbox_int (bi, m) -> Pbox_int (bi, m)
157161
| Pobj_magic _
158162
| Pbytes_to_string
159163
| Pbytes_of_string

‎middle_end/flambda/closure_offsets.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -77,6 +77,8 @@ let add_closure_offsets
7777
Misc.fatal_error
7878
"[Pbottom] should have been eliminated as dead code \
7979
and not stored in a closure."
80+
| Punboxed_float -> true
81+
| Punboxed_int _ -> true
8082
| Pvalue Pintval -> true
8183
| Pvalue _ -> false)
8284
free_vars

‎middle_end/flambda/flambda_to_clambda.ml

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -701,6 +701,8 @@ and to_clambda_set_of_closures t env
701701
Misc.fatal_error
702702
"[Pbottom] should have been eliminated as dead code \
703703
and not stored in a closure."
704+
| Punboxed_float -> true
705+
| Punboxed_int _ -> true
704706
| Pvalue Pintval -> true
705707
| Pvalue _ -> false)
706708
free_vars
@@ -750,7 +752,11 @@ and to_clambda_closed_set_of_closures t env symbol
750752
in
751753
let body =
752754
let body, body_layout = to_clambda t env_body function_decl.body in
753-
assert(Lambda.compatible_layout body_layout function_decl.return_layout);
755+
if not (Lambda.compatible_layout body_layout function_decl.return_layout) then
756+
Misc.fatal_errorf "Incompatible layouts:@.body: %[email protected]: %a@.%a@."
757+
Printlambda.layout body_layout
758+
Printlambda.layout function_decl.return_layout
759+
Printclambda.clambda body;
754760
Un_anf.apply ~ppf_dump:t.ppf_dump ~what:symbol body
755761
in
756762
let label =

0 commit comments

Comments
 (0)