Merge flambda-backend changes

Author: lpw25

.depend

@@ -2093,15 +2093,18 @@ asmcomp/CSEgen.cmo : \
     asmcomp/proc.cmi \
     asmcomp/mach.cmi \
     asmcomp/cmm.cmi \
+    parsing/asttypes.cmi \
     asmcomp/CSEgen.cmi
 asmcomp/CSEgen.cmx : \
     asmcomp/reg.cmx \
     asmcomp/proc.cmx \
     asmcomp/mach.cmx \
     asmcomp/cmm.cmx \
+    parsing/asttypes.cmi \
     asmcomp/CSEgen.cmi
 asmcomp/CSEgen.cmi : \
-    asmcomp/mach.cmi
+    asmcomp/mach.cmi \
+    parsing/asttypes.cmi
 asmcomp/afl_instrument.cmo : \
     lambda/lambda.cmi \
     asmcomp/cmm.cmi \
@@ -2146,6 +2149,7 @@ asmcomp/asmgen.cmo : \
     asmcomp/linscan.cmi \
     asmcomp/linearize.cmi \
     file_formats/linear_format.cmi \
+    asmcomp/linear.cmi \
     lambda/lambda.cmi \
     asmcomp/interval.cmi \
     asmcomp/interf.cmi \
@@ -2188,6 +2192,7 @@ asmcomp/asmgen.cmx : \
     asmcomp/linscan.cmx \
     asmcomp/linearize.cmx \
     file_formats/linear_format.cmx \
+    asmcomp/linear.cmx \
     lambda/lambda.cmx \
     asmcomp/interval.cmx \
     asmcomp/interf.cmx \
@@ -2211,6 +2216,7 @@ asmcomp/asmgen.cmx : \
     asmcomp/asmgen.cmi
 asmcomp/asmgen.cmi : \
     lambda/lambda.cmi \
+    asmcomp/emitaux.cmi \
     asmcomp/cmm.cmi \
     middle_end/clambda.cmi \
     middle_end/backend_intf.cmi
@@ -2719,6 +2725,7 @@ asmcomp/mach.cmo : \
     lambda/debuginfo.cmi \
     asmcomp/cmm.cmi \
     middle_end/backend_var.cmi \
+    parsing/asttypes.cmi \
     asmcomp/arch.cmo \
     asmcomp/mach.cmi
 asmcomp/mach.cmx : \
@@ -2729,6 +2736,7 @@ asmcomp/mach.cmx : \
     lambda/debuginfo.cmx \
     asmcomp/cmm.cmx \
     middle_end/backend_var.cmx \
+    parsing/asttypes.cmi \
     asmcomp/arch.cmx \
     asmcomp/mach.cmi
 asmcomp/mach.cmi : \
@@ -2738,6 +2746,7 @@ asmcomp/mach.cmi : \
     lambda/debuginfo.cmi \
     asmcomp/cmm.cmi \
     middle_end/backend_var.cmi \
+    parsing/asttypes.cmi \
     asmcomp/arch.cmo
 asmcomp/printcmm.cmo : \
     utils/targetint.cmi \

Makefile.config.in

@@ -225,6 +225,7 @@ WITH_OCAMLDOC=@ocamldoc@
 WITH_OCAMLTEST=@ocamltest@
 ASM_CFI_SUPPORTED=@asm_cfi_supported@
 WITH_FRAME_POINTERS=@frame_pointers@
+WITH_CPP_MANGLING=@cpp_mangling@
 WITH_PROFINFO=@profinfo@
 PROFINFO_WIDTH=@profinfo_width@
 WITH_FPIC=@fpic@

asmcomp/CSEgen.ml

@@ -25,7 +25,7 @@ type valnum = int
 type op_class =
   | Op_pure           (* pure arithmetic, produce one or several result *)
   | Op_checkbound     (* checkbound-style: no result, can raise an exn *)
-  | Op_load           (* memory load *)
+  | Op_load of Asttypes.mutable_flag (* memory load *)
   | Op_store of bool  (* memory store, false = init, true = assign *)
   | Op_other   (* anything else that does not allocate nor store in memory *)
 
@@ -40,29 +40,30 @@ module Equations = struct
     Map.Make(struct type t = rhs let compare = Stdlib.compare end)
 
   type 'a t =
-    { load_equations : 'a Rhs_map.t;
+    { mutable_load_equations : 'a Rhs_map.t;
       other_equations : 'a Rhs_map.t }
 
   let empty =
-    { load_equations = Rhs_map.empty;
+    { mutable_load_equations = Rhs_map.empty;
       other_equations = Rhs_map.empty }
 
   let add op_class op v m =
     match op_class with
-    | Op_load ->
-      { m with load_equations = Rhs_map.add op v m.load_equations }
+    | Op_load Mutable ->
+      { m with mutable_load_equations =
+                 Rhs_map.add op v m.mutable_load_equations }
     | _ ->
       { m with other_equations = Rhs_map.add op v m.other_equations }
 
   let find op_class op m =
     match op_class with
-    | Op_load ->
-      Rhs_map.find op m.load_equations
+    | Op_load Mutable ->
+      Rhs_map.find op m.mutable_load_equations
     | _ ->
       Rhs_map.find op m.other_equations
 
-  let remove_loads m =
-    { load_equations = Rhs_map.empty;
+  let remove_mutable_loads m =
+    { mutable_load_equations = Rhs_map.empty;
       other_equations = m.other_equations }
 end
 
@@ -190,8 +191,8 @@ let set_unknown_regs n rs =
 
 (* Keep only the equations satisfying the given predicate. *)
 
-let remove_load_numbering n =
-  { n with num_eqs = Equations.remove_loads n.num_eqs }
+let remove_mutable_load_numbering n =
+  { n with num_eqs = Equations.remove_mutable_loads n.num_eqs }
 
 (* Forget everything we know about registers of type [Addr]. *)
 
@@ -225,7 +226,7 @@ method class_of_operation op =
   | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
   | Iextcall _ | Iprobe _ | Iopaque -> assert false       (* treated specially *)
   | Istackoffset _ -> Op_other
-  | Iload(_,_) -> Op_load
+  | Iload(_,_,mut) -> Op_load mut
   | Istore(_,_,asg) -> Op_store asg
   | Ialloc _ -> assert false                   (* treated specially *)
   | Iintop(Icheckbound) -> Op_checkbound
@@ -246,11 +247,11 @@ method is_cheap_operation op =
   | Iconst_int _ -> true
   | _ -> false
 
-(* Forget all equations involving memory loads.  Performed after a
-   non-initializing store *)
+(* Forget all equations involving mutable memory loads.
+   Performed after a non-initializing store *)
 
 method private kill_loads n =
-  remove_load_numbering n
+  remove_mutable_load_numbering n
 
 (* Perform CSE on the given instruction [i] and its successors.
    [n] is the value numbering current at the beginning of [i]. *)
@@ -292,13 +293,13 @@ method private cse n i =
          Moreover, allocation can trigger the asynchronous execution
          of arbitrary Caml code (finalizer, signal handler, context
          switch), which can contain non-initializing stores.
-         Hence, all equations over loads must be removed. *)
+         Hence, all equations over mutable loads must be removed. *)
        let n1 = kill_addr_regs (self#kill_loads n) in
        let n2 = set_unknown_regs n1 i.res in
        {i with next = self#cse n2 i.next}
   | Iop op ->
       begin match self#class_of_operation op with
-      | (Op_pure | Op_checkbound | Op_load) as op_class ->
+      | (Op_pure | Op_checkbound | Op_load _) as op_class ->
           let (n1, varg) = valnum_regs n i.arg in
           let n2 = set_unknown_regs n1 (Proc.destroyed_at_oper i.desc) in
           begin match find_equation op_class n1 (op, varg) with
@@ -336,7 +337,7 @@ method private cse n i =
          {i with next = self#cse n2 i.next}
       | Op_store true ->
           (* A non-initializing store can invalidate
-             anything we know about prior loads. *)
+             anything we know about prior mutable loads. *)
          let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
          let n2 = set_unknown_regs n1 i.res in
          let n3 = self#kill_loads n2 in

asmcomp/CSEgen.mli

@@ -19,7 +19,7 @@
 type op_class =
   | Op_pure     (* pure, produce one result *)
   | Op_checkbound     (* checkbound-style: no result, can raise an exn *)
-  | Op_load           (* memory load *)
+  | Op_load of Asttypes.mutable_flag  (* memory load *)
   | Op_store of bool  (* memory store, false = init, true = assign *)
   | Op_other   (* anything else that does not allocate nor store in memory *)
 

asmcomp/amd64/CSE.ml

@@ -30,7 +30,7 @@ method! class_of_operation op =
     | Ilea _ | Isextend32 | Izextend32 -> Op_pure
     | Istore_int(_, _, is_asg) -> Op_store is_asg
     | Ioffset_loc(_, _) -> Op_store true
-    | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load
+    | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load Mutable
     | Ibswap _ | Isqrtf -> super#class_of_operation op
     end
   | _ -> super#class_of_operation op

asmcomp/amd64/arch.ml

@@ -134,7 +134,20 @@ let print_specific_operation printreg op ppf arg =
   | Izextend32 ->
       fprintf ppf "zextend32 %a" printreg arg.(0)
 
+(* Are we using the Windows 64-bit ABI? *)
+
 let win64 =
   match Config.system with
   | "win64" | "mingw64" | "cygwin" -> true
   | _                   -> false
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ilea _ | Ibswap _ | Isqrtf | Isextend32 | Izextend32 -> true
+  | Ifloatarithmem _ | Ifloatsqrtf _ -> true
+  | _ -> false
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false

asmcomp/amd64/emit.mlp

@@ -717,7 +717,7 @@ let emit_instr fallthrough i =
       end
   | Lop(Istackoffset n) ->
       emit_stack_offset n
-  | Lop(Iload(chunk, addr)) ->
+  | Lop(Iload(chunk, addr, _mut)) ->
       let dest = res i 0 in
       begin match chunk with
       | Word_int | Word_val ->

asmcomp/amd64/proc.ml

@@ -360,19 +360,6 @@ let max_register_pressure = function
     if fp then [| 12; 15 |] else [| 13; 15 |]
   | _ -> if fp then [| 12; 16 |] else [| 13; 16 |]
 
-(* Pure operations (without any side effect besides updating their result
-   registers). *)
-
-let op_is_pure = function
-  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | 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 *)
 
 let frame_required fd =

asmcomp/arm/arch.ml

@@ -262,3 +262,15 @@ let is_immediate n =
     s := !s + 2
   done;
   !s <= m
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+  | Ishiftcheckbound _ -> false
+  | _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+  | Ishiftcheckbound _ -> true
+  | _ -> false

asmcomp/arm/emit.mlp

@@ -580,10 +580,10 @@ let emit_instr i =
         let ninstr = emit_stack_adjustment (-n) in
         stack_offset := !stack_offset + n;
         ninstr
-    | Lop(Iload(Single, addr)) when !fpu >= VFPv2 ->
+    | Lop(Iload(Single, addr, _mut)) when !fpu >= VFPv2 ->
         `	flds	s14, {emit_addressing addr i.arg 0}\n`;
         `	fcvtds	{emit_reg i.res.(0)}, s14\n`; 2
-    | Lop(Iload(Double, addr)) when !fpu = Soft ->
+    | Lop(Iload(Double, addr, _mut)) when !fpu = Soft ->
         (* Use LDM or LDRD if possible *)
         begin match i.res.(0), i.res.(1), addr with
           {loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
@@ -602,7 +602,7 @@ let emit_instr i =
               `	ldr	{emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
             end; 2
         end
-    | Lop(Iload(size, addr)) ->
+    | Lop(Iload(size, addr, _mut)) ->
         let r = i.res.(0) in
         let instr =
           match size with

asmcomp/arm/proc.ml

@@ -311,7 +311,8 @@ let destroyed_at_oper = function
   | Iop(Iintop (Icomp _) | Iintop_imm(Icomp _, _))
     when !arch >= ARMv8 && !thumb ->
       [| phys_reg 3 |]  (* r3 destroyed *)
-  | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
+  | Iop(Iintoffloat | Ifloatofint
+  | Iload(Single, _, _) | Istore(Single, _, _)) ->
       [| phys_reg 107 |]            (* d7 (s14-s15) destroyed *)
   | _ -> [||]
 
@@ -335,20 +336,10 @@ let max_register_pressure = function
   | Ialloc _ -> if abi = EABI then [| 7; 0; 0 |] else [| 7; 8; 8 |]
   | Iconst_symbol _ when !Clflags.pic_code -> [| 7; 16; 32 |]
   | Iintoffloat | Ifloatofint
-  | Iload(Single, _) | Istore(Single, _, _) -> [| 9; 15; 31 |]
+  | Iload(Single, _, _) | Istore(Single, _, _) -> [| 9; 15; 31 |]
   | Iintop Imulh when !arch < ARMv6 -> [| 8; 16; 32 |]
   | _ -> [| 9; 16; 32 |]
 
-(* Pure operations (without any side effect besides updating their result
-   registers). *)
-
-let op_is_pure = function
-  | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
-  | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
-  | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque
-  | Ispecific(Ishiftcheckbound _) -> false
-  | _ -> true
-
 (* Layout of the stack *)
 
 let frame_required fd =

asmcomp/arm/scheduling.ml

@@ -29,7 +29,7 @@ method oper_latency = function
   (* Loads have a latency of two cycles in general *)
     Iconst_symbol _
   | Iconst_float _
-  | Iload(_, _)
+  | Iload(_, _, _)
   | Ireload
   | Ifloatofint       (* mcr/mrc count as memory access *)
   | Iintoffloat -> 2