Skip to content

Commit f393310

Browse files
authored
Register boxed numbers as structured constants in cmmgen_state during to_cmm (#808)
1 parent bbb6b1a commit f393310

File tree

2 files changed

+28
-14
lines changed

2 files changed

+28
-14
lines changed

middle_end/flambda2/to_cmm/to_cmm.ml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,8 @@ let flush_cmm_helpers_state () =
4646
"There shouldn't be any closures in Cmmgen_state during Flambda 2 to \
4747
Cmm translation"
4848
in
49+
(* reset the structured constants, just in case *)
50+
Cmmgen_state.set_structured_constants [];
4951
match Cmmgen_state.get_and_clear_data_items () with
5052
| [] ->
5153
let cst_map = Cmmgen_state.get_and_clear_constants () in

middle_end/flambda2/to_cmm/to_cmm_static.ml

Lines changed: 26 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -61,15 +61,23 @@ let rec static_float_array_updates symb env acc i = function
6161
in
6262
static_float_array_updates symb env acc (i + 1) r)
6363

64-
let static_boxed_number kind env symbol default emit transl v r updates =
64+
let static_boxed_number ~kind ~env ~symbol ~default ~emit ~transl ~structured v
65+
r updates =
6566
let aux x cont =
6667
emit
6768
(Symbol.linkage_name_as_string symbol, Cmmgen_state.Global)
6869
(transl x) cont
6970
in
7071
let updates =
7172
match (v : _ Or_variable.t) with
72-
| Const _ -> env, None
73+
| Const c ->
74+
(* Add the const to the cmmgen_state structured constants table so that
75+
functions in cmm_helpers can short-circuit Unboxing of boxed constant
76+
symbols, particularly in Classic mode. *)
77+
let symbol_name = Symbol.linkage_name_as_string symbol in
78+
let structured_constant = structured (transl c) in
79+
Cmmgen_state.add_structured_constant symbol_name structured_constant;
80+
env, None
7381
| Var (v, dbg) ->
7482
C.make_update env dbg kind ~symbol:(C.symbol ~dbg symbol) v ~index:0
7583
~prev_updates:updates
@@ -122,32 +130,36 @@ let static_const0 env r ~updates (bound_static : Bound_static.Pattern.t)
122130
set_of_closures
123131
in
124132
env, r, updates
125-
| Block_like s, Boxed_float v ->
133+
| Block_like symbol, Boxed_float v ->
126134
let default = Numeric_types.Float_by_bit_pattern.zero in
127135
let transl = Numeric_types.Float_by_bit_pattern.to_float in
136+
let structured f = Clambda.Uconst_float f in
128137
let r, (env, updates) =
129-
static_boxed_number Double env s default C.emit_float_constant transl v r
130-
updates
138+
static_boxed_number ~kind:Double ~env ~symbol ~default
139+
~emit:C.emit_float_constant ~transl ~structured v r updates
131140
in
132141
env, r, updates
133-
| Block_like s, Boxed_int32 v ->
142+
| Block_like symbol, Boxed_int32 v ->
143+
let structured i = Clambda.Uconst_int32 i in
134144
let r, (env, updates) =
135-
static_boxed_number Word_int env s 0l C.emit_int32_constant Fun.id v r
136-
updates
145+
static_boxed_number ~kind:Word_int ~env ~symbol ~default:0l
146+
~emit:C.emit_int32_constant ~transl:Fun.id ~structured v r updates
137147
in
138148
env, r, updates
139-
| Block_like s, Boxed_int64 v ->
149+
| Block_like symbol, Boxed_int64 v ->
150+
let structured i = Clambda.Uconst_int64 i in
140151
let r, (env, updates) =
141-
static_boxed_number Word_int env s 0L C.emit_int64_constant Fun.id v r
142-
updates
152+
static_boxed_number ~kind:Word_int ~env ~symbol ~default:0L
153+
~emit:C.emit_int64_constant ~transl:Fun.id ~structured v r updates
143154
in
144155
env, r, updates
145-
| Block_like s, Boxed_nativeint v ->
156+
| Block_like symbol, Boxed_nativeint v ->
146157
let default = Targetint_32_64.zero in
147158
let transl = C.nativeint_of_targetint in
159+
let structured i = Clambda.Uconst_nativeint i in
148160
let r, (env, updates) =
149-
static_boxed_number Word_int env s default C.emit_nativeint_constant
150-
transl v r updates
161+
static_boxed_number ~kind:Word_int ~env ~symbol ~default
162+
~emit:C.emit_nativeint_constant ~transl ~structured v r updates
151163
in
152164
env, r, updates
153165
| Block_like s, (Immutable_float_block fields | Immutable_float_array fields)

0 commit comments

Comments
 (0)