Merge branch 'trunk' into ocamlrun-help

Changes

@@ -17,8 +17,17 @@ Working version
 - #10101: Add -help/--help option to ocamlrun.
   (David Allsopp, review by Xavier Leroy)
 
+- #10102: Ignore PROFINFO_WIDTH if WITH_PROFINFO is not defined (technically
+  a breaking change if the configuration system was being abused before).
+  (David Allsopp, review by Xavier Leroy)
+
 ### Code generation and optimizations:
 
+- #9876: do not cache the young_limit GC variable in a processor register.
+  This affects the ARM64, PowerPC and RISC-V ports, making signal handling
+  and minor GC triggers more reliable, at the cost of a small slowdown.
+  (Xavier Leroy, review by Nicolás Ojeda Bär)
+
 - #9937: improvements in ARM64 code generation (constants, sign extensions)
   (Xavier Leroy, review by Stephen Dolan)
 

README.adoc

@@ -1,12 +1,12 @@
 |=====
 | Branch `trunk` | Branch `4.12` | Branch `4.11` | Branch `4.10`
 
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=trunk["TravisCI Build Status (trunk branch)",
-     link="https://travis-ci.org/ocaml/ocaml"]
+| image:https://github.com/ocaml/ocaml/workflows/main/badge.svg?branch=trunk["Github CI Build Status (trunk branch)",
+     link="https://github.com/ocaml/ocaml/actions?query=workflow%3Amain"]
   image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=trunk&svg=true["AppVeyor Build Status (trunk branch)",
      link="https://ci.appveyor.com/project/avsm/ocaml"]
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.12["TravisCI Build Status (4.12 branch)",
-     link="https://travis-ci.org/ocaml/ocaml"]
+| image:https://github.com/ocaml/ocaml/workflows/main/badge.svg?branch=4.12["Github CI Build Status (4.12 branch)",
+     link="https://github.com/ocaml/ocaml/actions?query=workflow%3Amain"]
   image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.12&svg=true["AppVeyor Build Status (4.12 branch)",
      link="https://ci.appveyor.com/project/avsm/ocaml"]
 | image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.11["TravisCI Build Status (4.11 branch)",
@@ -49,7 +49,7 @@ compiler currently runs on the following platforms:
 | ARM 64 bits    | Linux, macOS                    |  FreeBSD
 | ARM 32 bits    | Linux                           |  FreeBSD, NetBSD, OpenBSD
 | Power 64 bits  | Linux                           |
-| Power 32 bits  |                                 |  Linux
+| Power 32 bits  | Linux                           |
 | RISC-V 64 bits | Linux                           |
 | IBM Z (s390x)  | Linux                           |
 |====
@@ -61,7 +61,7 @@ the compiler may work under other operating systems with little work.
 == Copyright
 
 All files marked "Copyright INRIA" in this distribution are
-Copyright (C) 1996-2020 Institut National de Recherche en Informatique et
+Copyright (C) 1996-2021 Institut National de Recherche en Informatique et
 en Automatique (INRIA) and distributed under the conditions stated in
 file LICENSE.
 

asmcomp/arm64/emit.mlp

@@ -33,12 +33,11 @@ let fastcode_flag = ref true
 
 (* Names for special regs *)
 
-let reg_domain_state_ptr = phys_reg 22
-let reg_trap_ptr = phys_reg 23
-let reg_alloc_ptr = phys_reg 24
-let reg_alloc_limit = phys_reg 25
-let reg_tmp1 = phys_reg 26
-let reg_x8 = phys_reg 8
+let reg_domain_state_ptr = phys_reg 25 (* x28 *)
+let reg_trap_ptr = phys_reg 23 (* x26 *)
+let reg_alloc_ptr = phys_reg 24 (* x27 *)
+let reg_tmp1 = phys_reg 26 (* x16 *)
+let reg_x8 = phys_reg 8 (* x8 *)
 
 (* Output a label *)
 
@@ -496,10 +495,8 @@ module BR = Branch_relaxation.Make (struct
     | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) ->
       let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in
       based + begin match size with Single -> 2 | _ -> 1 end
-    | Lop (Ialloc {bytes = num_bytes}) when !fastcode_flag ->
-      if num_bytes <= 0xFFF then 4 else 5
-    | Lop (Ispecific (Ifar_alloc {bytes = num_bytes})) when !fastcode_flag ->
-      if num_bytes <= 0xFFF then 5 else 6
+    | Lop (Ialloc _) when !fastcode_flag -> 5
+    | Lop (Ispecific (Ifar_alloc _)) when !fastcode_flag -> 6
     | Lop (Ialloc { bytes = num_bytes; _ })
     | Lop (Ispecific (Ifar_alloc { bytes = num_bytes; _ })) ->
       begin match num_bytes with
@@ -586,8 +583,10 @@ let assembly_code_for_allocation i ~n ~far ~dbginfo =
        so it is reasonable to assume n < 0x1_000.  This makes
        the generated code simpler. *)
     assert (16 <= n && n < 0x1_000 && n land 0x7 = 0);
+    let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+    `	ldr	{emit_reg reg_tmp1}, [{emit_reg reg_domain_state_ptr}, #{emit_int offset}]\n`;
     `	sub	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
-    `	cmp	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
+    `	cmp	{emit_reg reg_alloc_ptr}, {emit_reg reg_tmp1}\n`;
     if not far then begin
       `	b.lo	{emit_label lbl_call_gc}\n`
     end else begin

asmcomp/arm64/proc.ml

@@ -33,11 +33,10 @@ let word_addressed = false
     x0 - x15              general purpose (caller-save)
     x16, x17              temporaries (used by call veeners)
     x18                   platform register (reserved)
-    x19 - x24             general purpose (callee-save)
-    x25                   domain state pointer
+    x19 - x25             general purpose (callee-save)
     x26                   trap pointer
     x27                   alloc pointer
-    x28                   alloc limit
+    x28                   domain state pointer
     x29                   frame pointer
     x30                   return address
     sp / xzr              stack pointer / zero register
@@ -48,10 +47,11 @@ let word_addressed = false
 *)
 
 let int_reg_name =
-  [| "x0";  "x1";  "x2";  "x3";  "x4";  "x5";  "x6";  "x7";
-     "x8";  "x9";  "x10"; "x11"; "x12"; "x13"; "x14"; "x15";
-     "x19"; "x20"; "x21"; "x22"; "x23"; "x24";
-     "x25"; "x26"; "x27"; "x28"; "x16"; "x17" |]
+  [| "x0";  "x1";  "x2";  "x3";  "x4";  "x5";  "x6";  "x7";  (* 0 - 7 *)
+     "x8";  "x9";  "x10"; "x11"; "x12"; "x13"; "x14"; "x15"; (* 8 - 15 *)
+     "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; "x25";        (* 16 - 22 *)
+     "x26"; "x27"; "x28";                                    (* 23 - 25 *)
+     "x16"; "x17" |]                                         (* 26 - 27 *)
 
 let float_reg_name =
   [| "d0";  "d1";  "d2";  "d3";  "d4";  "d5";  "d6";  "d7";
@@ -67,7 +67,7 @@ let register_class r =
   | Float -> 1
 
 let num_available_registers =
-  [| 22; 32 |] (* first 22 int regs allocatable; all float regs allocatable *)
+  [| 23; 32 |] (* first 23 int regs allocatable; all float regs allocatable *)
 
 let first_available_register =
   [| 0; 100 |]
@@ -269,16 +269,16 @@ let destroyed_at_reloadretaddr = [| |]
 (* Maximal register pressure *)
 
 let safe_register_pressure = function
-  | Iextcall _ -> 8
-  | Ialloc _ -> 24
-  | _ -> 25
+  | Iextcall _ -> 7
+  | Ialloc _ -> 22
+  | _ -> 23
 
 let max_register_pressure = function
-  | Iextcall _ -> [| 10; 8 |]
-  | Ialloc _ -> [| 24; 32 |]
+  | Iextcall _ -> [| 7; 8 |]  (* 7 integer callee-saves, 8 FP callee-saves *)
+  | Ialloc _ -> [| 22; 32 |]
   | Iintoffloat | Ifloatofint
-  | Iload(Single, _) | Istore(Single, _, _) -> [| 25; 31 |]
-  | _ -> [| 25; 32 |]
+  | Iload(Single, _) | Istore(Single, _, _) -> [| 23; 31 |]
+  | _ -> [| 23; 32 |]
 
 (* Pure operations (without any side effect besides updating their result
    registers). *)

asmcomp/power/emit.mlp

@@ -486,8 +486,8 @@ module BR = Branch_relaxation.Make (struct
       then load_store_size addr + 1
       else load_store_size addr
     | Lop(Istore(_chunk, addr, _)) -> load_store_size addr
-    | Lop(Ialloc _) -> 4
-    | Lop(Ispecific(Ialloc_far _)) -> 5
+    | Lop(Ialloc _) -> 5
+    | Lop(Ispecific(Ialloc_far _)) -> 6
     | Lop(Iintop Imod) -> 3
     | Lop(Iintop(Icomp _)) -> 4
     | Lop(Iintop _) -> 1
@@ -524,6 +524,26 @@ module BR = Branch_relaxation.Make (struct
   let relax_intop_imm_checkbound ~bound:_ = assert false
 end)
 
+(* Assembly code for inlined allocation *)
+
+let emit_alloc i bytes dbginfo far =
+  if !call_gc_label = 0 then call_gc_label := new_label ();
+  let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+  `	{emit_string lg}	0, {emit_int offset}(30)\n`;
+  `	addi    31, 31, {emit_int(-bytes)}\n`;
+  `	{emit_string cmplg}	31, 0\n`;
+  if not far then begin
+    `	bltl	{emit_label !call_gc_label}\n`;
+    record_frame i.live (Dbg_alloc dbginfo);
+    `	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+  end else begin
+    let lbl = new_label() in
+    `	bge	{emit_label lbl}\n`;
+    `	bl	{emit_label !call_gc_label}\n`;
+    record_frame i.live (Dbg_alloc dbginfo);
+    `{emit_label lbl}:	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+  end
+
 (* Output the assembly code for an instruction *)
 
 let emit_instr i =
@@ -754,22 +774,10 @@ let emit_instr i =
           | Single -> "stfs"
           | Double | Double_u -> "stfd" in
         emit_load_store storeinstr addr i.arg 1 i.arg.(0)
-    | Lop(Ialloc { bytes = n; dbginfo }) ->
-        if !call_gc_label = 0 then call_gc_label := new_label ();
-        `	addi    31, 31, {emit_int(-n)}\n`;
-        `	{emit_string cmplg}	31, 30\n`;
-        `	bltl	{emit_label !call_gc_label}\n`;
-        record_frame i.live (Dbg_alloc dbginfo);
-        `	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
-    | Lop(Ispecific(Ialloc_far { bytes = n; dbginfo })) ->
-        if !call_gc_label = 0 then call_gc_label := new_label ();
-        let lbl = new_label() in
-        `	addi    31, 31, {emit_int(-n)}\n`;
-        `	{emit_string cmplg}	31, 30\n`;
-        `	bge	{emit_label lbl}\n`;
-        `	bl	{emit_label !call_gc_label}\n`;
-        record_frame i.live (Dbg_alloc dbginfo);
-        `{emit_label lbl}:	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+    | Lop(Ialloc { bytes; dbginfo }) ->
+        emit_alloc i bytes dbginfo false
+    | Lop(Ispecific(Ialloc_far { bytes; dbginfo })) ->
+        emit_alloc i bytes dbginfo true
     | Lop(Iintop Isub) ->               (* subfc has swapped arguments *)
         `	subfc	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
     | Lop(Iintop Imod) ->
@@ -985,8 +993,8 @@ let emit_instr i =
               Domainstate.(idx_of_field Domain_backtrace_pos)
             in
             begin match abi with
-            | ELF32 -> `	stw	0, {emit_int (backtrace_pos * 8)}(28)\n`
-            | _ -> `	std	0, {emit_int (backtrace_pos * 8)}(28)\n`
+            | ELF32 -> `	stw	0, {emit_int (backtrace_pos * 8)}(30)\n`
+            | _ -> `	std	0, {emit_int (backtrace_pos * 8)}(30)\n`
             end;
             emit_call "caml_raise_exn";
             record_frame Reg.Set.empty (Dbg_raise i.dbg);

asmcomp/power/proc.ml

@@ -34,10 +34,9 @@ let word_addressed = false
     3 - 10              function arguments and results
     11 - 12             temporaries
     13                  pointer to small data area
-    14 - 27             general purpose, preserved by C
-    28                  domain state pointer
+    14 - 28             general purpose, preserved by C
     29                  trap pointer
-    30                  allocation limit
+    30                  domain state pointer
     31                  allocation pointer
   Floating-point register map:
     0                   temporary
@@ -46,9 +45,9 @@ let word_addressed = false
 *)
 
 let int_reg_name =
-  [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";
-     "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21";
-     "22"; "23"; "24"; "25"; "26"; "27" |]
+  [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";           (* 0 - 7 *)
+     "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21";    (* 8 - 15 *)
+     "22"; "23"; "24"; "25"; "26"; "27"; "28" |]        (* 16 - 22 *)
 
 let float_reg_name =
   [| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8";
@@ -63,7 +62,7 @@ let register_class r =
   | Val | Int | Addr -> 0
   | Float -> 1
 
-let num_available_registers = [| 22; 31 |]
+let num_available_registers = [| 23; 31 |]
 
 let first_available_register = [| 0; 100 |]
 
@@ -75,7 +74,7 @@ let rotate_registers = true
 (* Representation of hard registers by pseudo-registers *)
 
 let hard_int_reg =
-  let v = Array.make 22 Reg.dummy in
+  let v = Array.make 23 Reg.dummy in
   for i = 0 to 21 do v.(i) <- Reg.at_location Int (Reg i) done; v
 
 let hard_float_reg =
@@ -314,11 +313,11 @@ let destroyed_at_reloadretaddr = [| phys_reg 11 |]
 
 let safe_register_pressure = function
     Iextcall _ -> 14
-  | _ -> 22
+  | _ -> 23
 
 let max_register_pressure = function
     Iextcall _ -> [| 14; 18 |]
-  | _ -> [| 22; 30 |]
+  | _ -> [| 23; 30 |]
 
 (* Pure operations (without any side effect besides updating their result
    registers). *)

asmcomp/riscv/emit.mlp

@@ -82,12 +82,11 @@ let rodata_space =
 
 (* Names for special regs *)
 
-let reg_tmp = phys_reg 22
+let reg_tmp = phys_reg 23
 let reg_t2 = phys_reg 16
-let reg_domain_state_ptr = phys_reg 23
+let reg_domain_state_ptr = phys_reg 26
 let reg_trap = phys_reg 24
 let reg_alloc_ptr = phys_reg 25
-let reg_alloc_lim = phys_reg 26
 
 (* Output a pseudo-register *)
 
@@ -374,13 +373,15 @@ let emit_instr i =
       let lbl_after_alloc = new_label () in
       let lbl_call_gc = new_label () in
       let n = -bytes in
+      let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
       if is_immediate n then
         `	addi	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_int n}\n`
       else begin
         `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
         `	add	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}\n`
       end;
-      `	bltu	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`;
+      `	ld	{emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
+      `	bltu	{emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`;
       `{emit_label lbl_after_alloc}:\n`;
       `	addi	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
       call_gc_sites :=