@@ -61,15 +61,23 @@ let rec static_float_array_updates symb env acc i = function
61
61
in
62
62
static_float_array_updates symb env acc (i + 1 ) r)
63
63
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 =
65
66
let aux x cont =
66
67
emit
67
68
(Symbol. linkage_name_as_string symbol, Cmmgen_state. Global )
68
69
(transl x) cont
69
70
in
70
71
let updates =
71
72
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
73
81
| Var (v , dbg ) ->
74
82
C. make_update env dbg kind ~symbol: (C. symbol ~dbg symbol) v ~index: 0
75
83
~prev_updates: updates
@@ -122,32 +130,36 @@ let static_const0 env r ~updates (bound_static : Bound_static.Pattern.t)
122
130
set_of_closures
123
131
in
124
132
env, r, updates
125
- | Block_like s , Boxed_float v ->
133
+ | Block_like symbol , Boxed_float v ->
126
134
let default = Numeric_types.Float_by_bit_pattern. zero in
127
135
let transl = Numeric_types.Float_by_bit_pattern. to_float in
136
+ let structured f = Clambda. Uconst_float f in
128
137
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
131
140
in
132
141
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
134
144
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
137
147
in
138
148
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
140
151
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
143
154
in
144
155
env, r, updates
145
- | Block_like s , Boxed_nativeint v ->
156
+ | Block_like symbol , Boxed_nativeint v ->
146
157
let default = Targetint_32_64. zero in
147
158
let transl = C. nativeint_of_targetint in
159
+ let structured i = Clambda. Uconst_nativeint i in
148
160
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
151
163
in
152
164
env, r, updates
153
165
| Block_like s, (Immutable_float_block fields | Immutable_float_array fields)
0 commit comments