Skip to content

Commit d879f23

Browse files
stedolanstedolan
committed
Merge remote-tracking branch 'jane/local-reviewed' into local-merge
2 parents 1c2479b + 94454f5 commit d879f23

204 files changed

Lines changed: 18749 additions & 8622 deletions

File tree

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎asmcomp/CSEgen.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -237,6 +237,7 @@ method class_of_operation op =
237237
| Ispecific _ -> Op_other
238238
| Iname_for_debugger _ -> Op_pure
239239
| Iprobe_is_enabled _ -> Op_other
240+
| Ibeginregion | Iendregion -> Op_other
240241

241242
(* Operations that are so cheap that it isn't worth factoring them. *)
242243

‎asmcomp/afl_instrument.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,8 @@ and instrument = function
8888
in
8989
Ccatch (isrec, cases, instrument body)
9090
| Cexit (ex, args) -> Cexit (ex, List.map instrument args)
91+
| Cregion e -> Cregion (instrument e)
92+
| Ctail e -> Ctail (instrument e)
9193

9294
(* these are base cases and have no logging *)
9395
| Cconst_int _ | Cconst_natint _ | Cconst_float _

‎asmcomp/amd64/emit.mlp‎

Lines changed: 39 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -299,6 +299,19 @@ let emit_call_gc gc =
299299
def_label gc.gc_frame;
300300
I.jmp (label gc.gc_return_lbl)
301301

302+
(* Record calls to local stack reallocation *)
303+
304+
type local_realloc_call =
305+
{ lr_lbl: label;
306+
lr_return_lbl: label; }
307+
308+
let local_realloc_sites = ref ([] : local_realloc_call list)
309+
310+
let emit_local_realloc lr =
311+
def_label lr.lr_lbl;
312+
emit_call "caml_call_local_realloc";
313+
I.jmp (label lr.lr_return_lbl)
314+
302315
(* Record calls to caml_ml_array_bound_error.
303316
In -g mode we maintain one call to
304317
caml_ml_array_bound_error per bound check site. Without -g, we can share
@@ -737,7 +750,7 @@ let emit_instr fallthrough i =
737750
| Double ->
738751
I.movsd (arg i 0) (addressing addr REAL8 i 1)
739752
end
740-
| Lop(Ialloc { bytes = n; dbginfo }) ->
753+
| Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) ->
741754
assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
742755
if !fastcode_flag then begin
743756
I.sub (int n) r15;
@@ -767,6 +780,21 @@ let emit_instr fallthrough i =
767780
def_label label;
768781
I.lea (mem64 NONE 8 R15) (res i 0)
769782
end
783+
| Lop(Ialloc { bytes = n; dbginfo=_; mode = Alloc_local }) ->
784+
let r = res i 0 in
785+
I.mov (domain_field Domainstate.Domain_local_sp) r;
786+
I.sub (int n) r;
787+
I.mov r (domain_field Domainstate.Domain_local_sp);
788+
I.cmp (domain_field Domainstate.Domain_local_limit) r;
789+
let lbl_call = new_label () in
790+
I.j L (label lbl_call);
791+
let lbl_after_alloc = new_label () in
792+
def_label lbl_after_alloc;
793+
I.add (domain_field Domainstate.Domain_local_top) r;
794+
I.add (int 8) r;
795+
local_realloc_sites :=
796+
{ lr_lbl = lbl_call;
797+
lr_return_lbl = lbl_after_alloc } :: !local_realloc_sites
770798
| Lop(Iintop(Icomp cmp)) ->
771799
I.cmp (arg i 1) (arg i 0);
772800
I.set (cond cmp) al;
@@ -844,6 +872,14 @@ let emit_instr fallthrough i =
844872
I.movsxd (arg32 i 0) (res i 0)
845873
| Lop(Ispecific(Izextend32)) ->
846874
I.mov (arg32 i 0) (res32 i 0)
875+
| Lop(Ibeginregion) ->
876+
I.mov (domain_field Domainstate.Domain_local_sp) (res i 0)
877+
| Lop(Iendregion) ->
878+
I.mov (arg i 0) r11;
879+
I.sub (domain_field Domainstate.Domain_local_sp) r11;
880+
I.add r11 (domain_field Domainstate.Domain_local_total);
881+
I.add (domain_field Domainstate.Domain_local_sp) r11;
882+
I.mov r11 (domain_field Domainstate.Domain_local_sp)
847883
| Lop (Iname_for_debugger _) -> ()
848884
| Lop (Iprobe _) ->
849885
let probe_label = new_label () in
@@ -1026,6 +1062,7 @@ let fundecl fundecl =
10261062
tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
10271063
stack_offset := 0;
10281064
call_gc_sites := [];
1065+
local_realloc_sites := [];
10291066
bound_error_sites := [];
10301067
bound_error_call := 0;
10311068
for i = 0 to Proc.num_register_classes - 1 do
@@ -1049,6 +1086,7 @@ let fundecl fundecl =
10491086
cfi_startproc ();
10501087
emit_all true fundecl.fun_body;
10511088
List.iter emit_call_gc !call_gc_sites;
1089+
List.iter emit_local_realloc !local_realloc_sites;
10521090
emit_call_bound_errors ();
10531091
if !frame_required then begin
10541092
let n = frame_size() - 8 - (if fp then 8 else 0) in

‎asmcomp/amd64/proc.ml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -312,6 +312,7 @@ let destroyed_at_oper = function
312312
-> [| rax |]
313313
| Iswitch(_, _) -> [| rax; rdx |]
314314
| Itrywith _ -> [| r11 |]
315+
| Iop(Iendregion) -> [| r11 |]
315316
| _ ->
316317
if fp then
317318
(* prevent any use of the frame pointer ! *)
@@ -358,6 +359,7 @@ let op_is_pure = function
358359
| Ispecific(Ilea _|Isextend32|Izextend32) -> true
359360
| Ispecific _ -> false
360361
| Iprobe _ | Iprobe_is_enabled _-> false
362+
| Ibeginregion | Iendregion -> false
361363
| _ -> true
362364

363365
(* Layout of the stack frame *)

‎asmcomp/arm/emit.mlp‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -636,7 +636,7 @@ let emit_instr i =
636636
| Double -> "fstd"
637637
| _ (* 32-bit quantities *) -> "str" in
638638
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
639-
| Lop(Ialloc { bytes = n; dbginfo }) ->
639+
| Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) ->
640640
let lbl_frame =
641641
record_frame_label i.live (Dbg_alloc dbginfo)
642642
in
@@ -670,6 +670,8 @@ let emit_instr i =
670670
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
671671
1 + ninstr
672672
end
673+
| Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) ->
674+
Misc.fatal_error "Local allocations not supported on this architecture"
673675
| Lop(Iintop(Icomp cmp)) ->
674676
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
675677
1 + emit_set_condition cmp i.res.(0)

‎asmcomp/arm64/emit.mlp‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -511,6 +511,8 @@ module BR = Branch_relaxation.Make (struct
511511
| 16 | 24 | 32 -> 1
512512
| _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_bytes)
513513
end
514+
| Lop (Ibeginregion | Iendregion) ->
515+
Misc.fatal_error "Local allocations not supported on this architecture"
514516
| Lop (Iintop (Icomp _)) -> 2
515517
| Lop (Iintop_imm (Icomp _, _)) -> 2
516518
| Lop (Iintop (Icheckbound)) -> 2
@@ -771,10 +773,12 @@ let emit_instr i =
771773
| Word_int | Word_val | Double ->
772774
` str {emit_reg src}, {emit_addressing addr base}\n`
773775
end
774-
| Lop(Ialloc { bytes = n; dbginfo }) ->
776+
| Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) ->
775777
assembly_code_for_allocation i ~n ~far:false ~dbginfo
776778
| Lop(Ispecific (Ifar_alloc { bytes = n; dbginfo })) ->
777779
assembly_code_for_allocation i ~n ~far:true ~dbginfo
780+
| Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) ->
781+
Misc.fatal_error "Local allocations not supported on this architecture"
778782
| Lop(Iintop_imm(Iadd, n)) ->
779783
emit_addimm i.res.(0) i.arg.(0) n
780784
| Lop(Iintop_imm(Isub, n)) ->

‎asmcomp/cmm.ml‎

Lines changed: 82 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -148,10 +148,10 @@ type memory_chunk =
148148
| Double
149149

150150
and operation =
151-
Capply of machtype
151+
Capply of machtype * Lambda.apply_position
152152
| Cextcall of string * machtype * exttype list * bool
153153
| Cload of memory_chunk * Asttypes.mutable_flag
154-
| Calloc
154+
| Calloc of Lambda.alloc_mode
155155
| Cstore of memory_chunk * Lambda.initialization_or_assignment
156156
| Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
157157
| Cand | Cor | Cxor | Clsl | Clsr | Casr
@@ -195,6 +195,8 @@ type expression =
195195
| Cexit of int * expression list
196196
| Ctrywith of expression * Backend_var.With_provenance.t * expression
197197
* Debuginfo.t
198+
| Cregion of expression
199+
| Ctail of expression
198200

199201
type codegen_option =
200202
| Reduce_code_size
@@ -254,6 +256,12 @@ let iter_shallow_tail f = function
254256
f e1;
255257
f e2;
256258
true
259+
| Cregion e ->
260+
f e;
261+
true
262+
| Ctail e ->
263+
f e;
264+
true
257265
| Cexit _ | Cop (Craise _, _, _) ->
258266
true
259267
| Cconst_int _
@@ -266,30 +274,34 @@ let iter_shallow_tail f = function
266274
| Cop _ ->
267275
false
268276

269-
let rec map_tail f = function
277+
let map_shallow_tail f = function
270278
| Clet(id, exp, body) ->
271-
Clet(id, exp, map_tail f body)
279+
Clet(id, exp, f body)
272280
| Clet_mut(id, kind, exp, body) ->
273-
Clet_mut(id, kind, exp, map_tail f body)
281+
Clet_mut(id, kind, exp, f body)
274282
| Cphantom_let(id, exp, body) ->
275-
Cphantom_let (id, exp, map_tail f body)
283+
Cphantom_let (id, exp, f body)
276284
| Cifthenelse(cond, ifso_dbg, ifso, ifnot_dbg, ifnot, dbg) ->
277285
Cifthenelse
278286
(
279287
cond,
280-
ifso_dbg, map_tail f ifso,
281-
ifnot_dbg, map_tail f ifnot,
288+
ifso_dbg, f ifso,
289+
ifnot_dbg, f ifnot,
282290
dbg
283291
)
284292
| Csequence(e1, e2) ->
285-
Csequence(e1, map_tail f e2)
293+
Csequence(e1, f e2)
286294
| Cswitch(e, tbl, el, dbg') ->
287-
Cswitch(e, tbl, Array.map (fun (e, dbg) -> map_tail f e, dbg) el, dbg')
295+
Cswitch(e, tbl, Array.map (fun (e, dbg) -> f e, dbg) el, dbg')
288296
| Ccatch(rec_flag, handlers, body) ->
289-
let map_h (n, ids, handler, dbg) = (n, ids, map_tail f handler, dbg) in
290-
Ccatch(rec_flag, List.map map_h handlers, map_tail f body)
297+
let map_h (n, ids, handler, dbg) = (n, ids, f handler, dbg) in
298+
Ccatch(rec_flag, List.map map_h handlers, f body)
291299
| Ctrywith(e1, id, e2, dbg) ->
292-
Ctrywith(map_tail f e1, id, map_tail f e2, dbg)
300+
Ctrywith(f e1, id, f e2, dbg)
301+
| Cregion e ->
302+
Cregion(f e)
303+
| Ctail e ->
304+
Ctail(f e)
293305
| Cexit _ | Cop (Craise _, _, _) as cmm ->
294306
cmm
295307
| Cconst_int _
@@ -299,8 +311,59 @@ let rec map_tail f = function
299311
| Cvar _
300312
| Cassign _
301313
| Ctuple _
302-
| Cop _ as c ->
303-
f c
314+
| Cop _ as cmm -> cmm
315+
316+
let map_tail f =
317+
let rec loop = function
318+
| Cconst_int _
319+
| Cconst_natint _
320+
| Cconst_float _
321+
| Cconst_symbol _
322+
| Cvar _
323+
| Cassign _
324+
| Ctuple _
325+
| Cop _ as c ->
326+
f c
327+
| cmm -> map_shallow_tail loop cmm
328+
in
329+
loop
330+
331+
let iter_shallow f = function
332+
| Clet (_id, e1, e2) ->
333+
f e1; f e2
334+
| Clet_mut (_id, _kind, e1, e2) ->
335+
f e1; f e2
336+
| Cphantom_let (_id, _de, e) ->
337+
f e
338+
| Cassign (_id, e) ->
339+
f e
340+
| Ctuple el ->
341+
List.iter f el
342+
| Cop (_op, el, _dbg) ->
343+
List.iter f el
344+
| Csequence (e1, e2) ->
345+
f e1; f e2
346+
| Cifthenelse(cond, _ifso_dbg, ifso, _ifnot_dbg, ifnot, _dbg) ->
347+
f cond; f ifso; f ifnot
348+
| Cswitch (_e, _ia, ea, _dbg) ->
349+
Array.iter (fun (e, _) -> f e) ea
350+
| Ccatch (_rf, hl, body) ->
351+
let iter_h (_n, _ids, handler, _dbg) = f handler in
352+
List.iter iter_h hl; f body
353+
| Cexit (_n, el) ->
354+
List.iter f el
355+
| Ctrywith (e1, _id, e2, _dbg) ->
356+
f e1; f e2
357+
| Cregion e ->
358+
f e
359+
| Ctail e ->
360+
f e
361+
| Cconst_int _
362+
| Cconst_natint _
363+
| Cconst_float _
364+
| Cconst_symbol _
365+
| Cvar _ ->
366+
()
304367

305368
let map_shallow f = function
306369
| Clet (id, e1, e2) ->
@@ -328,6 +391,10 @@ let map_shallow f = function
328391
Cexit (n, List.map f el)
329392
| Ctrywith (e1, id, e2, dbg) ->
330393
Ctrywith (f e1, id, f e2, dbg)
394+
| Cregion e ->
395+
Cregion (f e)
396+
| Ctail e ->
397+
Ctail (f e)
331398
| Cconst_int _
332399
| Cconst_natint _
333400
| Cconst_float _

‎asmcomp/cmm.mli‎

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -139,13 +139,13 @@ type memory_chunk =
139139
see PR#10433 *)
140140

141141
and operation =
142-
Capply of machtype
142+
Capply of machtype * Lambda.apply_position
143143
| Cextcall of string * machtype * exttype list * bool
144144
(** The [machtype] is the machine type of the result.
145145
The [exttype list] describes the unboxing types of the arguments.
146146
An empty list means "all arguments are machine words [XInt]". *)
147147
| Cload of memory_chunk * Asttypes.mutable_flag
148-
| Calloc
148+
| Calloc of Lambda.alloc_mode
149149
| Cstore of memory_chunk * Lambda.initialization_or_assignment
150150
| Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi
151151
| Cand | Cor | Cxor | Clsl | Clsr | Casr
@@ -196,6 +196,8 @@ and expression =
196196
| Cexit of int * expression list
197197
| Ctrywith of expression * Backend_var.With_provenance.t * expression
198198
* Debuginfo.t
199+
| Cregion of expression
200+
| Ctail of expression
199201

200202
type codegen_option =
201203
| Reduce_code_size
@@ -243,11 +245,18 @@ val iter_shallow_tail: (expression -> unit) -> expression -> bool
243245
considered to be in tail position (because their result become
244246
the final result for the expression). *)
245247

248+
val map_shallow_tail: (expression -> expression) -> expression -> expression
249+
(** Apply the transformation to those immediate sub-expressions of an
250+
expression that are in tail position, using the same definition of "tail"
251+
as [iter_shallow_tail] *)
252+
246253
val map_tail: (expression -> expression) -> expression -> expression
247254
(** Apply the transformation to an expression, trying to push it
248-
to all inner sub-expressions that can produce the final result.
249-
Same disclaimer as for [iter_shallow_tail] about the notion
250-
of "tail" sub-expression. *)
255+
to all inner sub-expressions that can produce the final result,
256+
by recursively applying map_shallow_tail *)
257+
258+
val iter_shallow: (expression -> unit) -> expression -> unit
259+
(** Apply the transformation to each immediate sub-expression. *)
251260

252261
val map_shallow: (expression -> expression) -> expression -> expression
253262
(** Apply the transformation to each immediate sub-expression. *)

0 commit comments

Comments
 (0)