Skip to content

Commit a527cab

Browse files
lpw25lpw25
committed
flambda-backend: Update backends for changes from ocaml-jst
1 parent ce88833 commit a527cab

File tree

8 files changed

+61
-52
lines changed

8 files changed

+61
-52
lines changed

‎asmcomp/afl_instrument.ml

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@
1414

1515
(* Insert instrumentation for afl-fuzz *)
1616

17-
open Lambda
1817
open Cmm
1918

2019
module V = Backend_var
@@ -46,12 +45,12 @@ let rec with_afl_logging b dbg =
4645
Clet(VP.create cur_pos, op Cxor [op (Cload (Word_int, Asttypes.Mutable))
4746
[afl_prev_loc dbg]; Cconst_int (cur_location, dbg)],
4847
Csequence(
49-
op (Cstore(Byte_unsigned, Assignment alloc_heap))
48+
op (Cstore(Byte_unsigned, Assignment))
5049
[op Cadda [Cvar afl_area; Cvar cur_pos];
5150
op Cadda [op (Cload (Byte_unsigned, Asttypes.Mutable))
5251
[op Cadda [Cvar afl_area; Cvar cur_pos]];
5352
Cconst_int (1, dbg)]],
54-
op (Cstore(Word_int, Assignment alloc_heap))
53+
op (Cstore(Word_int, Assignment))
5554
[afl_prev_loc dbg; Cconst_int (cur_location lsr 1, dbg)]))) in
5655
Csequence(instrumentation, instrument b)
5756

‎asmcomp/cmm.ml

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -126,6 +126,10 @@ let new_label() = incr label_counter; !label_counter
126126

127127
type rec_flag = Nonrecursive | Recursive
128128

129+
type initialization_or_assignment =
130+
| Initialization
131+
| Assignment
132+
129133
type phantom_defining_expr =
130134
| Cphantom_const_int of Targetint.t
131135
| Cphantom_const_symbol of string
@@ -152,7 +156,7 @@ and operation =
152156
| Cextcall of string * machtype * exttype list * bool
153157
| Cload of memory_chunk * Asttypes.mutable_flag
154158
| Calloc of Lambda.alloc_mode
155-
| Cstore of memory_chunk * Lambda.initialization_or_assignment
159+
| Cstore of memory_chunk * initialization_or_assignment
156160
| Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
157161
| Cand | Cor | Cxor | Clsl | Clsr | Casr
158162
| Ccmpi of integer_comparison

‎asmcomp/cmm.mli

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,10 @@ val cur_label: unit -> label
9898

9999
type rec_flag = Nonrecursive | Recursive
100100

101+
type initialization_or_assignment =
102+
| Initialization
103+
| Assignment
104+
101105
type phantom_defining_expr =
102106
(* CR-soon mshinwell: Convert this to [Targetint.OCaml.t] (or whatever the
103107
representation of "target-width OCaml integers of type [int]"
@@ -146,7 +150,7 @@ and operation =
146150
An empty list means "all arguments are machine words [XInt]". *)
147151
| Cload of memory_chunk * Asttypes.mutable_flag
148152
| Calloc of Lambda.alloc_mode
149-
| Cstore of memory_chunk * Lambda.initialization_or_assignment
153+
| Cstore of memory_chunk * initialization_or_assignment
150154
| Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
151155
| Cand | Cor | Cxor | Clsl | Clsr | Casr
152156
| Ccmpi of integer_comparison

‎asmcomp/cmm_helpers.ml

Lines changed: 40 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -767,10 +767,10 @@ let addr_array_set arr ofs newval dbg =
767767
Cop(Cextcall("caml_modify", typ_void, [], false),
768768
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
769769
let int_array_set arr ofs newval dbg =
770-
Cop(Cstore (Word_int, Lambda.Assignment Lambda.alloc_heap),
770+
Cop(Cstore (Word_int, Assignment),
771771
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
772772
let float_array_set arr ofs newval dbg =
773-
Cop(Cstore (Double, Lambda.Assignment Lambda.alloc_heap),
773+
Cop(Cstore (Double, Assignment),
774774
[array_indexing log2_size_float arr ofs dbg; newval], dbg)
775775

776776
let addr_array_set_local arr ofs newval dbg =
@@ -1004,14 +1004,14 @@ let bigarray_set unsafe elt_kind layout b args newval dbg =
10041004
bind "addr" (bigarray_indexing unsafe elt_kind layout b args dbg)
10051005
(fun addr ->
10061006
Csequence(
1007-
Cop(Cstore (kind, Assignment Lambda.alloc_heap),
1007+
Cop(Cstore (kind, Assignment),
10081008
[addr; complex_re newv dbg], dbg),
1009-
Cop(Cstore (kind, Assignment Lambda.alloc_heap),
1009+
Cop(Cstore (kind, Assignment),
10101010
[Cop(Cadda, [addr; Cconst_int (sz, dbg)], dbg);
10111011
complex_im newv dbg],
10121012
dbg))))
10131013
| _ ->
1014-
Cop(Cstore (bigarray_word_kind elt_kind, Assignment Lambda.alloc_heap),
1014+
Cop(Cstore (bigarray_word_kind elt_kind, Assignment),
10151015
[bigarray_indexing unsafe elt_kind layout b args dbg; newval],
10161016
dbg))
10171017

@@ -1164,7 +1164,7 @@ let unaligned_load_16 ptr idx dbg =
11641164
let unaligned_set_16 ptr idx newval dbg =
11651165
if Arch.allow_unaligned_access
11661166
then
1167-
Cop(Cstore (Sixteen_unsigned, Assignment Lambda.alloc_heap),
1167+
Cop(Cstore (Sixteen_unsigned, Assignment),
11681168
[add_int ptr idx dbg; newval], dbg)
11691169
else
11701170
let cconst_int i = Cconst_int (i, dbg) in
@@ -1175,8 +1175,8 @@ let unaligned_set_16 ptr idx newval dbg =
11751175
let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
11761176
let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
11771177
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),
11801180
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg))
11811181

11821182
let unaligned_load_32 ptr idx dbg =
@@ -1207,7 +1207,7 @@ let unaligned_load_32 ptr idx dbg =
12071207
let unaligned_set_32 ptr idx newval dbg =
12081208
if Arch.allow_unaligned_access
12091209
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],
12111211
dbg)
12121212
else
12131213
let cconst_int i = Cconst_int (i, dbg) in
@@ -1227,16 +1227,16 @@ let unaligned_set_32 ptr idx newval dbg =
12271227
else v4, v3, v2, v1 in
12281228
Csequence(
12291229
Csequence(
1230-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1230+
Cop(Cstore (Byte_unsigned, Assignment),
12311231
[add_int ptr idx dbg; b1], dbg),
1232-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1232+
Cop(Cstore (Byte_unsigned, Assignment),
12331233
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
12341234
dbg)),
12351235
Csequence(
1236-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1236+
Cop(Cstore (Byte_unsigned, Assignment),
12371237
[add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
12381238
dbg),
1239-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1239+
Cop(Cstore (Byte_unsigned, Assignment),
12401240
[add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
12411241
dbg)))
12421242

@@ -1282,7 +1282,7 @@ let unaligned_load_64 ptr idx dbg =
12821282
let unaligned_set_64 ptr idx newval dbg =
12831283
assert(size_int = 8);
12841284
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)
12861286
else
12871287
let cconst_int i = Cconst_int (i, dbg) in
12881288
let v1 =
@@ -1321,32 +1321,32 @@ let unaligned_set_64 ptr idx newval dbg =
13211321
Csequence(
13221322
Csequence(
13231323
Csequence(
1324-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1324+
Cop(Cstore (Byte_unsigned, Assignment),
13251325
[add_int ptr idx dbg; b1],
13261326
dbg),
1327-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1327+
Cop(Cstore (Byte_unsigned, Assignment),
13281328
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
13291329
dbg)),
13301330
Csequence(
1331-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1331+
Cop(Cstore (Byte_unsigned, Assignment),
13321332
[add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
13331333
dbg),
1334-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1334+
Cop(Cstore (Byte_unsigned, Assignment),
13351335
[add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
13361336
dbg))),
13371337
Csequence(
13381338
Csequence(
1339-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1339+
Cop(Cstore (Byte_unsigned, Assignment),
13401340
[add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5],
13411341
dbg),
1342-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1342+
Cop(Cstore (Byte_unsigned, Assignment),
13431343
[add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6],
13441344
dbg)),
13451345
Csequence(
1346-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1346+
Cop(Cstore (Byte_unsigned, Assignment),
13471347
[add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7],
13481348
dbg),
1349-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
1349+
Cop(Cstore (Byte_unsigned, Assignment),
13501350
[add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
13511351
dbg))))
13521352

@@ -1826,7 +1826,7 @@ let cache_public_method meths tag cache dbg =
18261826
VP.create tagged,
18271827
Cop(Caddi, [lsl_const (Cvar li) log2_size_addr dbg;
18281828
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),
18301830
Cvar tagged)))))
18311831

18321832
let has_local_allocs e =
@@ -2266,7 +2266,7 @@ let negint arg dbg =
22662266
let offsetref n arg dbg =
22672267
return_unit dbg
22682268
(bind "ref" arg (fun arg ->
2269-
Cop(Cstore (Word_int, Assignment Lambda.alloc_heap),
2269+
Cop(Cstore (Word_int, Assignment),
22702270
[arg;
22712271
add_const (Cop(Cload (Word_int, Mutable), [arg], dbg))
22722272
(n lsl 1) dbg],
@@ -2318,7 +2318,10 @@ type binary_primitive = expression -> expression -> Debuginfo.t -> expression
23182318

23192319
(* Helper for compilation of initialization and assignment operations *)
23202320

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
23222325

23232326
let assignment_kind
23242327
(ptr: Lambda.immediate_or_pointer)
@@ -2330,8 +2333,8 @@ let assignment_kind
23302333
Caml_modify_local
23312334
| Heap_initialization, _ ->
23322335
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
23352338

23362339
let setfield n ptr init arg1 arg2 dbg =
23372340
match assignment_kind ptr init with
@@ -2345,10 +2348,15 @@ let setfield n ptr init arg1 arg2 dbg =
23452348
(Cop(Cextcall("caml_modify_local", typ_void, [], false),
23462349
[arg1; Cconst_int (n,dbg); arg2],
23472350
dbg))
2348-
| Simple ->
2351+
| Simple init ->
23492352
return_unit dbg (set_field arg1 n arg2 init dbg)
23502353

23512354
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
23522360
return_unit dbg (
23532361
Cop(Cstore (Double, init),
23542362
[if n = 0 then arg1
@@ -2532,11 +2540,11 @@ let setfield_computed ptr init arg1 arg2 arg3 dbg =
25322540
return_unit dbg (addr_array_set arg1 arg2 arg3 dbg)
25332541
| Caml_modify_local ->
25342542
return_unit dbg (addr_array_set_local arg1 arg2 arg3 dbg)
2535-
| Simple ->
2543+
| Simple _ ->
25362544
return_unit dbg (int_array_set arg1 arg2 arg3 dbg)
25372545

25382546
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),
25402548
[add_int arg1 (untag_int arg2 dbg) dbg;
25412549
ignore_high_bit_int (untag_int arg3 dbg)], dbg))
25422550

@@ -2547,7 +2555,7 @@ let bytesset_safe arg1 arg2 arg3 dbg =
25472555
bind "str" arg1 (fun str ->
25482556
Csequence(
25492557
make_checkbound dbg [string_length str dbg; idx],
2550-
Cop(Cstore (Byte_unsigned, Assignment Lambda.alloc_heap),
2558+
Cop(Cstore (Byte_unsigned, Assignment),
25512559
[add_int str idx dbg;
25522560
ignore_high_bit_int newval],
25532561
dbg))))))
@@ -2724,7 +2732,7 @@ let entry_point namelist =
27242732
let cconst_int i = Cconst_int (i, dbg ()) in
27252733
let cconst_symbol sym = Cconst_symbol (sym, dbg ()) in
27262734
let incr_global_inited () =
2727-
Cop(Cstore (Word_int, Assignment Lambda.alloc_heap),
2735+
Cop(Cstore (Word_int, Assignment),
27282736
[cconst_symbol "caml_globals_inited";
27292737
Cop(Caddi, [Cop(Cload (Word_int, Mutable),
27302738
[cconst_symbol "caml_globals_inited"], dbg ());

‎asmcomp/cmm_helpers.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -190,7 +190,7 @@ val get_field_gen :
190190
(** [set_field ptr n newval init dbg] returns an expression for setting the
191191
[n]th field of the block pointed to by [ptr] to [newval] *)
192192
val set_field :
193-
expression -> int -> expression -> Lambda.initialization_or_assignment ->
193+
expression -> int -> expression -> initialization_or_assignment ->
194194
Debuginfo.t -> expression
195195

196196
(** Load a block's header *)

‎asmcomp/printcmm.ml

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -124,10 +124,8 @@ let operation d = function
124124
| Cstore (c, init) ->
125125
let init =
126126
match init with
127-
| Lambda.Heap_initialization -> "(heap-init)"
128-
| Lambda.Root_initialization -> "(root-init)"
129-
| Lambda.Assignment Alloc_heap -> ""
130-
| Lambda.Assignment Alloc_local -> "(local)"
127+
| Initialization -> "(heap-init)"
128+
| Assignment -> ""
131129
in
132130
Printf.sprintf "store %s%s" (chunk c) init
133131
| Caddi -> "+"

‎asmcomp/selectgen.ml

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -485,9 +485,8 @@ method select_operation op args _dbg =
485485
let (addr, eloc) = self#select_addressing chunk arg1 in
486486
let is_assign =
487487
match init with
488-
| Lambda.Root_initialization -> false
489-
| Lambda.Heap_initialization -> false
490-
| Lambda.Assignment _ -> true
488+
| Initialization -> false
489+
| Assignment -> true
491490
in
492491
if chunk = Word_int || chunk = Word_val then begin
493492
let (op, newarg2) = self#select_store is_assign addr arg2 in

‎testsuite/tools/parsecmm.mly

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -270,16 +270,13 @@ expr:
270270
Cop(Cload (Double, Mutable), [access_array $3 $4 Arch.size_float],
271271
Debuginfo.none) }
272272
| LPAREN ADDRASET expr expr expr RPAREN
273-
{ let open Lambda in
274-
Cop(Cstore (Word_val, Assignment Lambda.alloc_heap),
273+
{ Cop(Cstore (Word_val, Assignment),
275274
[access_array $3 $4 Arch.size_addr; $5], Debuginfo.none) }
276275
| LPAREN INTASET expr expr expr RPAREN
277-
{ let open Lambda in
278-
Cop(Cstore (Word_int, Assignment Lambda.alloc_heap),
276+
{ Cop(Cstore (Word_int, Assignment),
279277
[access_array $3 $4 Arch.size_int; $5], Debuginfo.none) }
280278
| LPAREN FLOATASET expr expr expr RPAREN
281-
{ let open Lambda in
282-
Cop(Cstore (Double, Assignment Lambda.alloc_heap),
279+
{ Cop(Cstore (Double, Assignment),
283280
[access_array $3 $4 Arch.size_float; $5], Debuginfo.none) }
284281
;
285282
exprlist:
@@ -330,7 +327,7 @@ unaryop:
330327
| ABSF { Cabsf }
331328
;
332329
binaryop:
333-
STORE chunk { Cstore ($2, Lambda.Assignment Lambda.alloc_heap) }
330+
STORE chunk { Cstore ($2, Assignment) }
334331
| ADDI { Caddi }
335332
| SUBI { Csubi }
336333
| STAR { Cmuli }

0 commit comments

Comments
 (0)