Squashed 'ocaml/' changes from 23a7f736be..1924269795

1924269795 Several fixes for partial application and currying
4fee6ae2e8 Pprintast support for new local syntax
8df43e93e5 Quieten Makefile when runtime dep files are not present
88ec84e29e Typecheck x |> f y as (f y x), not ((f y) x)
87a10e3348 Remove autogeneration of @ocaml.curry
c656dc9bb1 Merge flambda-backend changes
11b5424a69 Avoid printing double spaces in function argument lists
7751faa4f9 Restore locations to Typedtree.{pat,let}_bound_idents_full
e450b6c0e9 add build_ocaml_compiler.sexp
0403bb3eed Revert PR 9895 to continue installing VERSION
b3447dbe5d Ensure new local attributes are namespaced properly
7f213fc8b3 Allow empty functions again
8f22ad82ad Bugfix: ensure local domain state is initialised
80f54dd625 Bugfix for Selectgen with regions
e8133a189a Fix external-external signature inclusion
9840051375 Bootstrap
d879f23efd Merge remote-tracking branch 'jane/local-reviewed' into local-merge
94454f5f1c Use Local_store for the local allocations ref
54a164cf35 Create fewer regions, according to typechecking (ocaml-flambda#59)
1c2479bdb3 Merge flambda-backend changes
ce34678606 Fix printing of modes in return types
91f228128b Hook mode variable solving into Btype.snapshot/backtrack
54e4b09d64 Move Alloc_mode and Value_mode to Btype
ff4611e779 Merge flambda-backend changes
ce62e451d5 Ensure allocations are initialised, even dead ones
6b6ec5a744 Fix the alloc.ml test on 32-bit builds
81e9879ac5 Merge flambda-backend changes
40a7f89c96 Update repo URL for ocaml-jst, and rename script.
0454ee73d4 Add some new locally-allocating primitives (ocaml-flambda#57)
8acdda123d Reset the local stack pointer in exception handlers (ocaml-flambda#56)
8dafa98b49 Improve typing for (||) and (&&) (ocaml-flambda#55)
8c64754035 Fix make_check_all_arches (ocaml-flambda#54)
b50cd457aa Allow arguments to primitives to be local even in tail position (ocaml-flambda#53)
cad125dbe3 Fix modes from or-patterns (ocaml-flambda#50)
4efdb7273c Fix tailcalls tests with inlining (ocaml-flambda#52)
4a795cb4af Flambda support (ocaml-flambda#49)
74722cbf35 Add [@ocaml.principal] and [@ocaml.noprincipal] attributes, and use in oo.mli
6d7d3b87b5 Ensure that functions are evaluated after their arguments (flambda-backend ocaml-flambda#353)
89bda6b8ad Keep Sys.opaque_identity in Cmm and Mach (port upstream PR 9412)
a39126a17f Fix tailcalls within regions (ocaml-flambda#48)
4ac4cfd4b8 Fix stdlib manpages build
3a95f5edaf Merge flambda-backend changes
efe80c9b8b Add jane/pull-flambda-patches script
fca94c47c6 Register allocations for Omitted parameter closures (ocaml-flambda#47)
103b139794 Remove various FIXMEs (ocaml-flambda#46)
62ba2c1d50 Bootstrap
a0062ad6c4 Allow local allocations for various primitives (ocaml-flambda#43)
7a2165e64c Allow primitives to be poly-moded (ocaml-flambda#43)
2af3f55db6 Fix a flaky test by refactoring TypePairs (ocaml/ocaml#10638)
58dd8078aa Bootstrap
ee3be10c8f Fix modes in build_apply for partial applications
fe736568e5 Tweak for evaluation order of labelled partial applications (#10653)
052757089e Fix caml_modify on local allocations (ocaml-flambda#40)
e657e995f6 Relax modes for `as` patterns (ocaml-flambda#42)
f815bf2b4f Add special mode handling for tuples in matches and let bindings (ocaml-flambda#38)
39f1211a5f Only take the upper bounds of modes associated with allocations (ocaml-flambda#37)
aec6fde3e4 Interpret arrow types in "local positions" differently
c4f3319d19 Bootstrap
ff6fdade6e Add some missing regions
40d586de9e Bootstrap
66d8110784 Switch to a system with 3 modes for values
f2c5a85bce Bugfix for Comballoc with local allocations. (ocaml-flambda#41)
83bcd09ef1 Fix bug with root scanning during compaction (ocaml-flambda#39)
1b5ec83383 Track modes in Lambda.lfunction and onwards (ocaml-flambda#33)
f1e2e97549 Port ocaml/ocaml#10728
56703cd290 Port ocaml/ocaml#10081
eb66785575 Support local allocations in i386 and fix amd64 bug (ocaml-flambda#31)
c936b1902e Disallow local recursive non-functions (ocaml-flambda#30)
c7a193a0f3 GC support for local allocations (ocaml-flambda#29)
8dd72709c9 Nonlocal fields (ocaml-flambda#28)
e19a2f0571 Bootstrap
694b9ac5be Add syntax to the parser for local allocations (ocaml-flambda#26)
f183008978 Lower initial stack size
918226ff46 Allow local closure allocations (ocaml-flambda#27)
2552e7d257 Introduce mode variables (ocaml-flambda#25)
bc41c99b24 Minor fixes for local allocations (ocaml-flambda#24)
a2a4e608e3 Runtime and compiler support for more local allocations (ocaml-flambda#23)
d03055416b Typechecking for local allocations (ocaml-flambda#21)
9ee2332f66 Bugfix missing from ocaml-flambda#20
02c4cef20e Retain block-structured local regions until Mach.
86dbe1c7da amd64: Move stack realloc calls out-of-line
324d218997 More typing modes and locking of environments
a4080b80f9 Initial version of local allocation (unsafe)

git-subtree-dir: ocaml
git-subtree-split: 1924269795db2450be5c084f7799340e0e003e19

Makefile

@@ -352,6 +352,9 @@ install:
 	$(MKDIR) "$(INSTALL_LIBDIR)"
 	$(MKDIR) "$(INSTALL_STUBLIBDIR)"
 	$(MKDIR) "$(INSTALL_COMPLIBDIR)"
+	$(INSTALL_DATA) \
+	  VERSION \
+	  "$(INSTALL_LIBDIR)"
 	$(MAKE) -C runtime install
 	$(INSTALL_PROG) ocaml$(EXE) "$(INSTALL_BINDIR)"
 ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"

asmcomp/CSEgen.ml

@@ -223,7 +223,7 @@ method class_of_operation op =
   | Imove | Ispill | Ireload -> assert false   (* treated specially *)
   | Iconst_int _ | Iconst_float _ | Iconst_symbol _ -> Op_pure
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Iprobe _ -> assert false                 (* treated specially *)
+  | Iextcall _ | Iprobe _ | Iopaque -> assert false       (* treated specially *)
   | Istackoffset _ -> Op_other
   | Iload(_,_) -> Op_load
   | Istore(_,_,asg) -> Op_store asg
@@ -237,6 +237,7 @@ method class_of_operation op =
   | Ispecific _ -> Op_other
   | Iname_for_debugger _ -> Op_pure
   | Iprobe_is_enabled _ -> Op_other
+  | Ibeginregion | Iendregion -> Op_other
 
 (* Operations that are so cheap that it isn't worth factoring them. *)
 
@@ -278,6 +279,9 @@ method private cse n i =
          arguments is always a memory load.  For simplicity, we
          just forget everything. *)
       {i with next = self#cse empty_numbering i.next}
+  | Iop Iopaque ->
+      (* Assume arbitrary side effects from Iopaque *)
+      {i with next = self#cse empty_numbering i.next}
   | Iop (Ialloc _) ->
       (* For allocations, we must avoid extending the live range of a
          pseudoregister across the allocation if this pseudoreg

asmcomp/afl_instrument.ml

@@ -88,6 +88,8 @@ and instrument = function
      in
      Ccatch (isrec, cases, instrument body)
   | Cexit (ex, args) -> Cexit (ex, List.map instrument args)
+  | Cregion e -> Cregion (instrument e)
+  | Ctail e -> Ctail (instrument e)
 
   (* these are base cases and have no logging *)
   | Cconst_int _ | Cconst_natint _ | Cconst_float _

asmcomp/amd64/emit.mlp

@@ -299,6 +299,19 @@ let emit_call_gc gc =
   def_label gc.gc_frame;
   I.jmp (label gc.gc_return_lbl)
 
+(* Record calls to local stack reallocation *)
+
+type local_realloc_call =
+  { lr_lbl: label;
+    lr_return_lbl: label; }
+
+let local_realloc_sites = ref ([] : local_realloc_call list)
+
+let emit_local_realloc lr =
+  def_label lr.lr_lbl;
+  emit_call "caml_call_local_realloc";
+  I.jmp (label lr.lr_return_lbl)
+
 (* Record calls to caml_ml_array_bound_error.
    In -g mode we maintain one call to
    caml_ml_array_bound_error per bound check site.  Without -g, we can share
@@ -737,7 +750,7 @@ let emit_instr fallthrough i =
       | Double ->
           I.movsd (arg i 0) (addressing addr REAL8 i 1)
       end
-  | Lop(Ialloc { bytes = n; dbginfo }) ->
+  | Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) ->
       assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
       if !fastcode_flag then begin
         I.sub (int n) r15;
@@ -767,6 +780,21 @@ let emit_instr fallthrough i =
         def_label label;
         I.lea (mem64 NONE 8 R15) (res i 0)
       end
+  | Lop(Ialloc { bytes = n; dbginfo=_; mode = Alloc_local }) ->
+      let r = res i 0 in
+      I.mov (domain_field Domainstate.Domain_local_sp) r;
+      I.sub (int n) r;
+      I.mov r (domain_field Domainstate.Domain_local_sp);
+      I.cmp (domain_field Domainstate.Domain_local_limit) r;
+      let lbl_call = new_label () in
+      I.j L (label lbl_call);
+      let lbl_after_alloc = new_label () in
+      def_label lbl_after_alloc;
+      I.add (domain_field Domainstate.Domain_local_top) r;
+      I.add (int 8) r;
+      local_realloc_sites :=
+        { lr_lbl = lbl_call;
+          lr_return_lbl = lbl_after_alloc } :: !local_realloc_sites
   | Lop(Iintop(Icomp cmp)) ->
       I.cmp (arg i 1) (arg i 0);
       I.set (cond cmp) al;
@@ -813,6 +841,8 @@ let emit_instr fallthrough i =
       I.cvtsi2sd  (arg i 0)  (res i 0)
   | Lop(Iintoffloat) ->
       I.cvttsd2si (arg i 0) (res i 0)
+  | Lop(Iopaque) ->
+      assert (i.arg.(0).loc = i.res.(0).loc)
   | Lop(Ispecific(Ilea addr)) ->
       I.lea (addressing addr NONE i 0) (res i 0)
   | Lop(Ispecific(Istore_int(n, addr, _))) ->
@@ -842,6 +872,14 @@ let emit_instr fallthrough i =
       I.movsxd (arg32 i 0) (res i 0)
   | Lop(Ispecific(Izextend32)) ->
       I.mov (arg32 i 0) (res32 i 0)
+  | Lop(Ibeginregion) ->
+      I.mov (domain_field Domainstate.Domain_local_sp) (res i 0)
+  | Lop(Iendregion) ->
+      I.mov (arg i 0) r11;
+      I.sub (domain_field Domainstate.Domain_local_sp) r11;
+      I.add r11 (domain_field Domainstate.Domain_local_total);
+      I.add (domain_field Domainstate.Domain_local_sp) r11;
+      I.mov r11 (domain_field Domainstate.Domain_local_sp)
   | Lop (Iname_for_debugger _) -> ()
   | Lop (Iprobe _) ->
     let probe_label = new_label () in
@@ -1024,6 +1062,7 @@ let fundecl fundecl =
   tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
   stack_offset := 0;
   call_gc_sites := [];
+  local_realloc_sites := [];
   bound_error_sites := [];
   bound_error_call := 0;
   for i = 0 to Proc.num_register_classes - 1 do
@@ -1047,6 +1086,7 @@ let fundecl fundecl =
   cfi_startproc ();
   emit_all true fundecl.fun_body;
   List.iter emit_call_gc !call_gc_sites;
+  List.iter emit_local_realloc !local_realloc_sites;
   emit_call_bound_errors ();
   if !frame_required then begin
     let n = frame_size() - 8 - (if fp then 8 else 0) in

asmcomp/amd64/proc.ml

@@ -312,6 +312,7 @@ let destroyed_at_oper = function
         -> [| rax |]
   | Iswitch(_, _) -> [| rax; rdx |]
   | Itrywith _ -> [| r11 |]
+  | Iop(Iendregion) -> [| r11 |]
   | _ ->
     if fp then
 (* prevent any use of the frame pointer ! *)
@@ -354,10 +355,11 @@ let max_register_pressure = function
 let op_is_pure = function
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
   | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque -> false
   | Ispecific(Ilea _|Isextend32|Izextend32) -> true
   | Ispecific _ -> false
   | Iprobe _ | Iprobe_is_enabled _-> false
+  | Ibeginregion | Iendregion -> false
   | _ -> true
 
 (* Layout of the stack frame *)

asmcomp/arm/emit.mlp

@@ -636,7 +636,7 @@ let emit_instr i =
           | Double -> "fstd"
           | _ (* 32-bit quantities *) -> "str" in
         `	{emit_string instr}	{emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
-    | Lop(Ialloc { bytes = n; dbginfo }) ->
+    | Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) ->
         let lbl_frame =
           record_frame_label i.live (Dbg_alloc dbginfo)
         in
@@ -670,6 +670,8 @@ let emit_instr i =
           `{emit_label lbl_frame}:	add	{emit_reg i.res.(0)}, alloc_ptr, #4\n`;
           1 + ninstr
         end
+    | Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) ->
+       Misc.fatal_error "Local allocations not supported on this architecture"
     | Lop(Iintop(Icomp cmp)) ->
         `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
         1 + emit_set_condition cmp i.res.(0)
@@ -719,6 +721,8 @@ let emit_instr i =
     | Lop(Iintoffloat) ->
         `	ftosizd	s14, {emit_reg i.arg.(0)}\n`;
         `	fmrs	{emit_reg i.res.(0)}, s14\n`; 2
+    | Lop(Iopaque) ->
+        assert (i.arg.(0).loc = i.res.(0).loc); 0
     | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
         let instr = (match op with
                        Iaddf              -> "faddd"

asmcomp/arm/proc.ml

@@ -335,7 +335,7 @@ let max_register_pressure = function
 let op_is_pure = function
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
   | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque
   | Ispecific(Ishiftcheckbound _) -> false
   | _ -> true
 

asmcomp/arm64/emit.mlp

@@ -511,6 +511,8 @@ module BR = Branch_relaxation.Make (struct
       | 16 | 24 | 32 -> 1
       | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_bytes)
       end
+    | Lop (Ibeginregion | Iendregion) ->
+       Misc.fatal_error "Local allocations not supported on this architecture"
     | Lop (Iintop (Icomp _)) -> 2
     | Lop (Iintop_imm (Icomp _, _)) -> 2
     | Lop (Iintop (Icheckbound)) -> 2
@@ -525,6 +527,7 @@ module BR = Branch_relaxation.Make (struct
     | Lop (Iintop_imm _) -> 1
     | Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1
     | Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1
+    | Lop (Iopaque) -> 0
     | Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1
     | Lop (Ispecific (Ishiftarith _)) -> 1
     | Lop (Ispecific (Imuladd | Imulsub)) -> 1
@@ -770,10 +773,12 @@ let emit_instr i =
         | Word_int | Word_val | Double ->
             `	str	{emit_reg src}, {emit_addressing addr base}\n`
         end
-    | Lop(Ialloc { bytes = n; dbginfo }) ->
+    | Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) ->
         assembly_code_for_allocation i ~n ~far:false ~dbginfo
     | Lop(Ispecific (Ifar_alloc { bytes = n; dbginfo })) ->
         assembly_code_for_allocation i ~n ~far:true ~dbginfo
+    | Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) ->
+       Misc.fatal_error "Local allocations not supported on this architecture"
     | Lop(Iintop_imm(Iadd, n)) ->
         emit_addimm i.res.(0) i.arg.(0) n
     | Lop(Iintop_imm(Isub, n)) ->
@@ -855,6 +860,8 @@ let emit_instr i =
                      | Inegmulsubf -> "fnmsub"
                      | _ -> assert false) in
         `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}, {emit_reg i.arg.(0)}\n`
+    | Lop(Iopaque) ->
+        assert (i.arg.(0).loc = i.res.(0).loc)
     | Lop(Ispecific(Ishiftarith(op, shift))) ->
         let instr = (match op with
                        Ishiftadd    -> "add"

asmcomp/arm64/proc.ml

@@ -286,7 +286,7 @@ let max_register_pressure = function
 let op_is_pure = function
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
   | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
+  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque
   | Ispecific(Ishiftcheckbound _) -> false
   | _ -> true