@@ -767,10 +767,10 @@ let addr_array_set arr ofs newval dbg =
767
767
Cop (Cextcall (" caml_modify" , typ_void, [] , false ),
768
768
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
769
769
let int_array_set arr ofs newval dbg =
770
- Cop (Cstore (Word_int , Lambda. Assignment Lambda. alloc_heap ),
770
+ Cop (Cstore (Word_int , Assignment ),
771
771
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
772
772
let float_array_set arr ofs newval dbg =
773
- Cop (Cstore (Double , Lambda. Assignment Lambda. alloc_heap ),
773
+ Cop (Cstore (Double , Assignment ),
774
774
[array_indexing log2_size_float arr ofs dbg; newval], dbg)
775
775
776
776
let addr_array_set_local arr ofs newval dbg =
@@ -1004,14 +1004,14 @@ let bigarray_set unsafe elt_kind layout b args newval dbg =
1004
1004
bind " addr" (bigarray_indexing unsafe elt_kind layout b args dbg)
1005
1005
(fun addr ->
1006
1006
Csequence (
1007
- Cop (Cstore (kind, Assignment Lambda. alloc_heap ),
1007
+ Cop (Cstore (kind, Assignment ),
1008
1008
[addr; complex_re newv dbg], dbg),
1009
- Cop (Cstore (kind, Assignment Lambda. alloc_heap ),
1009
+ Cop (Cstore (kind, Assignment ),
1010
1010
[Cop (Cadda , [addr; Cconst_int (sz, dbg)], dbg);
1011
1011
complex_im newv dbg],
1012
1012
dbg))))
1013
1013
| _ ->
1014
- Cop (Cstore (bigarray_word_kind elt_kind, Assignment Lambda. alloc_heap ),
1014
+ Cop (Cstore (bigarray_word_kind elt_kind, Assignment ),
1015
1015
[bigarray_indexing unsafe elt_kind layout b args dbg; newval],
1016
1016
dbg))
1017
1017
@@ -1164,7 +1164,7 @@ let unaligned_load_16 ptr idx dbg =
1164
1164
let unaligned_set_16 ptr idx newval dbg =
1165
1165
if Arch. allow_unaligned_access
1166
1166
then
1167
- Cop (Cstore (Sixteen_unsigned , Assignment Lambda. alloc_heap ),
1167
+ Cop (Cstore (Sixteen_unsigned , Assignment ),
1168
1168
[add_int ptr idx dbg; newval], dbg)
1169
1169
else
1170
1170
let cconst_int i = Cconst_int (i, dbg) in
@@ -1175,8 +1175,8 @@ let unaligned_set_16 ptr idx newval dbg =
1175
1175
let v2 = Cop (Cand , [newval; cconst_int 0xFF ], dbg) in
1176
1176
let b1, b2 = if Arch. big_endian then v1, v2 else v2, v1 in
1177
1177
Csequence (
1178
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ), [add_int ptr idx dbg; b1], dbg),
1179
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1178
+ Cop (Cstore (Byte_unsigned , Assignment ), [add_int ptr idx dbg; b1], dbg),
1179
+ Cop (Cstore (Byte_unsigned , Assignment ),
1180
1180
[add_int (add_int ptr idx dbg) (cconst_int 1 ) dbg; b2], dbg))
1181
1181
1182
1182
let unaligned_load_32 ptr idx dbg =
@@ -1207,7 +1207,7 @@ let unaligned_load_32 ptr idx dbg =
1207
1207
let unaligned_set_32 ptr idx newval dbg =
1208
1208
if Arch. allow_unaligned_access
1209
1209
then
1210
- Cop (Cstore (Thirtytwo_unsigned , Assignment Lambda. alloc_heap ), [add_int ptr idx dbg; newval],
1210
+ Cop (Cstore (Thirtytwo_unsigned , Assignment ), [add_int ptr idx dbg; newval],
1211
1211
dbg)
1212
1212
else
1213
1213
let cconst_int i = Cconst_int (i, dbg) in
@@ -1227,16 +1227,16 @@ let unaligned_set_32 ptr idx newval dbg =
1227
1227
else v4, v3, v2, v1 in
1228
1228
Csequence (
1229
1229
Csequence (
1230
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1230
+ Cop (Cstore (Byte_unsigned , Assignment ),
1231
1231
[add_int ptr idx dbg; b1], dbg),
1232
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1232
+ Cop (Cstore (Byte_unsigned , Assignment ),
1233
1233
[add_int (add_int ptr idx dbg) (cconst_int 1 ) dbg; b2],
1234
1234
dbg)),
1235
1235
Csequence (
1236
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1236
+ Cop (Cstore (Byte_unsigned , Assignment ),
1237
1237
[add_int (add_int ptr idx dbg) (cconst_int 2 ) dbg; b3],
1238
1238
dbg),
1239
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1239
+ Cop (Cstore (Byte_unsigned , Assignment ),
1240
1240
[add_int (add_int ptr idx dbg) (cconst_int 3 ) dbg; b4],
1241
1241
dbg)))
1242
1242
@@ -1282,7 +1282,7 @@ let unaligned_load_64 ptr idx dbg =
1282
1282
let unaligned_set_64 ptr idx newval dbg =
1283
1283
assert (size_int = 8 );
1284
1284
if Arch. allow_unaligned_access
1285
- then Cop (Cstore (Word_int , Assignment Lambda. alloc_heap ), [add_int ptr idx dbg; newval], dbg)
1285
+ then Cop (Cstore (Word_int , Assignment ), [add_int ptr idx dbg; newval], dbg)
1286
1286
else
1287
1287
let cconst_int i = Cconst_int (i, dbg) in
1288
1288
let v1 =
@@ -1321,32 +1321,32 @@ let unaligned_set_64 ptr idx newval dbg =
1321
1321
Csequence (
1322
1322
Csequence (
1323
1323
Csequence (
1324
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1324
+ Cop (Cstore (Byte_unsigned , Assignment ),
1325
1325
[add_int ptr idx dbg; b1],
1326
1326
dbg),
1327
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1327
+ Cop (Cstore (Byte_unsigned , Assignment ),
1328
1328
[add_int (add_int ptr idx dbg) (cconst_int 1 ) dbg; b2],
1329
1329
dbg)),
1330
1330
Csequence (
1331
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1331
+ Cop (Cstore (Byte_unsigned , Assignment ),
1332
1332
[add_int (add_int ptr idx dbg) (cconst_int 2 ) dbg; b3],
1333
1333
dbg),
1334
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1334
+ Cop (Cstore (Byte_unsigned , Assignment ),
1335
1335
[add_int (add_int ptr idx dbg) (cconst_int 3 ) dbg; b4],
1336
1336
dbg))),
1337
1337
Csequence (
1338
1338
Csequence (
1339
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1339
+ Cop (Cstore (Byte_unsigned , Assignment ),
1340
1340
[add_int (add_int ptr idx dbg) (cconst_int 4 ) dbg; b5],
1341
1341
dbg),
1342
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1342
+ Cop (Cstore (Byte_unsigned , Assignment ),
1343
1343
[add_int (add_int ptr idx dbg) (cconst_int 5 ) dbg; b6],
1344
1344
dbg)),
1345
1345
Csequence (
1346
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1346
+ Cop (Cstore (Byte_unsigned , Assignment ),
1347
1347
[add_int (add_int ptr idx dbg) (cconst_int 6 ) dbg; b7],
1348
1348
dbg),
1349
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
1349
+ Cop (Cstore (Byte_unsigned , Assignment ),
1350
1350
[add_int (add_int ptr idx dbg) (cconst_int 7 ) dbg; b8],
1351
1351
dbg))))
1352
1352
@@ -1826,7 +1826,7 @@ let cache_public_method meths tag cache dbg =
1826
1826
VP. create tagged,
1827
1827
Cop (Caddi , [lsl_const (Cvar li) log2_size_addr dbg;
1828
1828
cconst_int(1 - 3 * size_addr)], dbg),
1829
- Csequence (Cop (Cstore (Word_int , Assignment Lambda. alloc_heap ), [cache; Cvar tagged], dbg),
1829
+ Csequence (Cop (Cstore (Word_int , Assignment ), [cache; Cvar tagged], dbg),
1830
1830
Cvar tagged)))))
1831
1831
1832
1832
let has_local_allocs e =
@@ -2266,7 +2266,7 @@ let negint arg dbg =
2266
2266
let offsetref n arg dbg =
2267
2267
return_unit dbg
2268
2268
(bind " ref" arg (fun arg ->
2269
- Cop (Cstore (Word_int , Assignment Lambda. alloc_heap ),
2269
+ Cop (Cstore (Word_int , Assignment ),
2270
2270
[arg;
2271
2271
add_const (Cop (Cload (Word_int , Mutable ), [arg], dbg))
2272
2272
(n lsl 1 ) dbg],
@@ -2318,7 +2318,10 @@ type binary_primitive = expression -> expression -> Debuginfo.t -> expression
2318
2318
2319
2319
(* Helper for compilation of initialization and assignment operations *)
2320
2320
2321
- type assignment_kind = Caml_modify | Caml_modify_local | Simple
2321
+ type assignment_kind =
2322
+ | Caml_modify
2323
+ | Caml_modify_local
2324
+ | Simple of initialization_or_assignment
2322
2325
2323
2326
let assignment_kind
2324
2327
(ptr : Lambda.immediate_or_pointer )
@@ -2330,8 +2333,8 @@ let assignment_kind
2330
2333
Caml_modify_local
2331
2334
| Heap_initialization , _ ->
2332
2335
Misc. fatal_error " Cmm_helpers: Lambda.Heap_initialization unsupported"
2333
- | (Assignment _), Immediate
2334
- | Root_initialization , (Immediate | Pointer ) -> Simple
2336
+ | (Assignment _ ), Immediate -> Simple Assignment
2337
+ | Root_initialization , (Immediate | Pointer ) -> Simple Initialization
2335
2338
2336
2339
let setfield n ptr init arg1 arg2 dbg =
2337
2340
match assignment_kind ptr init with
@@ -2345,10 +2348,15 @@ let setfield n ptr init arg1 arg2 dbg =
2345
2348
(Cop (Cextcall (" caml_modify_local" , typ_void, [] , false ),
2346
2349
[arg1; Cconst_int (n,dbg); arg2],
2347
2350
dbg))
2348
- | Simple ->
2351
+ | Simple init ->
2349
2352
return_unit dbg (set_field arg1 n arg2 init dbg)
2350
2353
2351
2354
let setfloatfield n init arg1 arg2 dbg =
2355
+ let init =
2356
+ match init with
2357
+ | Lambda. Assignment _ -> Assignment
2358
+ | Lambda. Heap_initialization | Lambda. Root_initialization -> Initialization
2359
+ in
2352
2360
return_unit dbg (
2353
2361
Cop (Cstore (Double , init),
2354
2362
[if n = 0 then arg1
@@ -2532,11 +2540,11 @@ let setfield_computed ptr init arg1 arg2 arg3 dbg =
2532
2540
return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
2533
2541
| Caml_modify_local ->
2534
2542
return_unit dbg (addr_array_set_local arg1 arg2 arg3 dbg)
2535
- | Simple ->
2543
+ | Simple _ ->
2536
2544
return_unit dbg (int_array_set arg1 arg2 arg3 dbg)
2537
2545
2538
2546
let bytesset_unsafe arg1 arg2 arg3 dbg =
2539
- return_unit dbg (Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
2547
+ return_unit dbg (Cop (Cstore (Byte_unsigned , Assignment ),
2540
2548
[add_int arg1 (untag_int arg2 dbg) dbg;
2541
2549
ignore_high_bit_int (untag_int arg3 dbg)], dbg))
2542
2550
@@ -2547,7 +2555,7 @@ let bytesset_safe arg1 arg2 arg3 dbg =
2547
2555
bind " str" arg1 (fun str ->
2548
2556
Csequence (
2549
2557
make_checkbound dbg [string_length str dbg; idx],
2550
- Cop (Cstore (Byte_unsigned , Assignment Lambda. alloc_heap ),
2558
+ Cop (Cstore (Byte_unsigned , Assignment ),
2551
2559
[add_int str idx dbg;
2552
2560
ignore_high_bit_int newval],
2553
2561
dbg))))))
@@ -2724,7 +2732,7 @@ let entry_point namelist =
2724
2732
let cconst_int i = Cconst_int (i, dbg () ) in
2725
2733
let cconst_symbol sym = Cconst_symbol (sym, dbg () ) in
2726
2734
let incr_global_inited () =
2727
- Cop (Cstore (Word_int , Assignment Lambda. alloc_heap ),
2735
+ Cop (Cstore (Word_int , Assignment ),
2728
2736
[cconst_symbol " caml_globals_inited" ;
2729
2737
Cop (Caddi , [Cop (Cload (Word_int , Mutable ),
2730
2738
[cconst_symbol " caml_globals_inited" ], dbg () );
0 commit comments