Do not cache young_limit in a processor register (upstream PR 9876) (#315)

On target architectures with 32 or more registers,
a register was used to cache the value of the young_limit field
of the domain state.  This reduced the size and execution time
of the code for inlined allocations.

However, this usage is problematic with respect to polling for signals
and to inter-domain communication in Multicore OCaml, because it is
often not possible to change the value of the register when we change
young_limit.  So, the change to young_limit doesn't take effect
immediately, only when the register is reloaded from young_limit.

  - Removes the caching of young_limit in a register from the
    ARM64, PowerPC and RISC-V ports.

  - Recycle the former "young limit" register, giving one more allocatable register

    Now that we have a unused callee-save register on ARM64, PowerPC, and RISC-V,
    make it available for register allocation.

  - Assorted cleanups in runtime/*.S and in asmcomp/*/proc.ml

  - ARM64: wrong register pressure limits for Iextcall
    There are only 7 callee-save integer registers (x19 to x25), not 10.

Co-authored-by: Xavier Leroy <[email protected]>

Author: stedolan

backend/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 *)
 
@@ -504,10 +503,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
@@ -597,8 +594,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

backend/arm64/proc.ml

@@ -34,11 +34,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
@@ -49,10 +48,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";
@@ -68,7 +68,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 |]
@@ -270,16 +270,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). *)

backend/power/emit.mlp

@@ -508,8 +508,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(Icompf _) -> 5
@@ -550,6 +550,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 =
@@ -782,22 +802,10 @@ let emit_instr i =
           | Single -> "stfs"
           | Double -> "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) ->
@@ -1009,8 +1017,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);

backend/power/proc.ml

@@ -35,10 +35,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
@@ -47,9 +46,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";
@@ -64,7 +63,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 |]
 
@@ -76,7 +75,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 =
@@ -315,11 +314,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). *)

backend/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 *)
 
@@ -392,13 +391,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 :=

backend/riscv/proc.ml

@@ -37,12 +37,12 @@ let word_addressed = false
     a0-a7        0-7       arguments/results
     s2-s9        8-15      arguments/results (preserved by C)
     t2-t6        16-20     temporary
-    t0           21        temporary
-    t1           22        temporary (used by code generator)
-    s0           23        domain pointer (preserved by C)
+    s0           21        general purpose (preserved by C)
+    t0           22        temporary
+    t1           23        temporary (used by code generator)
     s1           24        trap pointer (preserved by C)
     s10          25        allocation pointer (preserved by C)
-    s11          26        allocation limit (preserved by C)
+    s11          26        domain pointer (preserved by C)
 
   Floating-point register map
   ---------------------------
@@ -66,11 +66,12 @@ let word_addressed = false
 *)
 
 let int_reg_name =
-  [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7";
-     "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9";
-     "t2"; "t3"; "t4"; "t5"; "t6";
-     "t0"; "t1";
-     "s0"; "s1"; "s10"; "s11" |]
+  [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7";  (* 0 - 7 *)
+     "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9";  (* 8 - 15 *)
+     "t2"; "t3"; "t4"; "t5"; "t6";                    (* 16 - 20 *)
+     "s0";                                            (* 21 *)
+     "t0"; "t1";                                      (* 22 - 23 *)
+     "s1"; "s10"; "s11" |]                            (* 24 - 26 *)
 
 let float_reg_name =
   [| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7";
@@ -86,7 +87,7 @@ let register_class r =
   | Val | Int | Addr -> 0
   | Float -> 1
 
-let num_available_registers = [| 22; 32 |]
+let num_available_registers = [| 23; 32 |]
 
 let first_available_register = [| 0; 100 |]
 
@@ -235,21 +236,21 @@ let regs_are_volatile _ = false
 let destroyed_at_c_call =
   (* s0-s11 and fs0-fs11 are callee-save *)
   Array.of_list(List.map phys_reg
-    [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; 21;
+    [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; 22;
      100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116;
      117; 128; 129; 130; 131])
 
 let destroyed_at_alloc =
-  (* t0-t3 are used for PLT stubs *)
-  if !Clflags.dlcode then Array.map phys_reg [|16; 17; 18; 19; 20; 21|]
+  (* t0-t6 are used for PLT stubs *)
+  if !Clflags.dlcode then Array.map phys_reg [|16; 17; 18; 19; 20; 22|]
   else [| |]
 
 let destroyed_at_oper = function
   | Iop(Icall_ind | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
   | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
   | Iop(Ialloc _) -> destroyed_at_alloc
   | Iop(Istore(Single, _, _)) -> [| phys_reg 100 |]
-  | Iswitch _ -> [| phys_reg 21 |]
+  | Iswitch _ -> [| phys_reg 22 |]  (* t0 *)
   | _ -> [||]
 
 let destroyed_at_raise = all_phys_regs
@@ -259,12 +260,12 @@ let destroyed_at_reloadretaddr = [| |]
 (* Maximal register pressure *)
 
 let safe_register_pressure = function
-  | Iextcall _ -> 15
-  | _ -> 22
+  | Iextcall _ -> 9
+  | _ -> 23
 
 let max_register_pressure = function
-  | Iextcall _ -> [| 15; 18 |]
-  | _ -> [| 22; 30 |]
+  | Iextcall _ -> [| 9; 12 |]
+  | _ -> [| 23; 30 |]
 
 (* Pure operations (without any side effect besides updating their result
    registers). *)
@@ -293,8 +294,9 @@ let int_dwarf_reg_numbers =
   [| 10; 11; 12; 13; 14; 15; 16; 17;
      18; 19; 20; 21; 22; 23; 24; 25;
      7; 28; 29; 30; 31;
+     8;
      5; 6;
-     8; 9; 26; 27;
+     9; 26; 27;
   |]
 
 let float_dwarf_reg_numbers =