Propagate the change to the corresponding Linear type.

Author: xclerc

backend/amd64/emit.mlp

@@ -566,7 +566,7 @@ let emit_named_text_section func_name =
 (* Name of current function *)
 let function_name = ref ""
 (* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
+let tailrec_entry_point = ref None
 
 (* Emit tracing probes *)
 
@@ -722,7 +722,9 @@ let emit_instr fallthrough i =
   | Lop(Itailcall_imm { func; label_after; }) ->
       begin
         if func = !function_name then
-          I.jmp (label !tailrec_entry_point)
+          match !tailrec_entry_point with
+          | None -> Misc.fatal_error "jump to missing tailrec entry point"
+          | Some tailrec_entry_point -> I.jmp (label tailrec_entry_point)
         else begin
           output_epilogue begin fun () ->
             add_used_symbol func;

backend/asmgen.ml

@@ -138,7 +138,9 @@ let compile_fundecl ~ppf_dump fd_cmm =
       if !use_ocamlcfg then begin
         let cfg = Ocamlcfg.Cfg_with_layout.of_linear fd ~preserve_orig_labels:true in
         let fun_body = Ocamlcfg.Cfg_with_layout.to_linear cfg in
-        { fd with Linear.fun_body; }
+        let fun_tailrec_entry_point_label =
+          Ocamlcfg.Cfg.fun_tailrec_entry_point_label (Ocamlcfg.Cfg_with_layout.cfg cfg) in
+        { fd with Linear.fun_body; fun_tailrec_entry_point_label }
       end else
         fd)
   ++ Profile.record ~accumulate:true "scheduling" Scheduling.fundecl

backend/cfg/cfg.ml

@@ -55,7 +55,7 @@ let create ~fun_name ~fun_tailrec_entry_point_label ~fun_dbg =
     fun_dbg;
     entry_label = 1;
     blocks = Label.Tbl.create 31;
-    fun_tailrec_entry_point_label = Some fun_tailrec_entry_point_label
+    fun_tailrec_entry_point_label
   }
 
 let mem_block t label = Label.Tbl.mem t.blocks label

backend/cfg/cfg.mli

@@ -85,7 +85,7 @@ type t = private
             Otherwise, the [Prologue] falls through to this label. *)
   }
 
-val create : fun_name:string -> fun_tailrec_entry_point_label:Label.t ->
+val create : fun_name:string -> fun_tailrec_entry_point_label:Label.t option ->
   fun_dbg:Debuginfo.t -> t
 
 val fun_name : t -> string

backend/cfg/cfg_to_linear.ml

@@ -384,7 +384,7 @@ let print_assembly (blocks : Cfg.basic_block list) =
   (* create a fake cfg just for printing these blocks *)
   let layout = List.map (fun (b : Cfg.basic_block) -> b.start) blocks in
   let fun_name = "_fun_start_" in
-  let fun_tailrec_entry_point_label = 0 in
+  let fun_tailrec_entry_point_label = Some 0 in
   let cfg = Cfg.create ~fun_name ~fun_tailrec_entry_point_label
               ~fun_dbg:Debuginfo.none in
   List.iter

backend/linear.ml

@@ -54,7 +54,7 @@ type fundecl =
     fun_fast: bool;
     fun_dbg : Debuginfo.t;
     fun_spacetime_shape : Mach.spacetime_shape option;
-    fun_tailrec_entry_point_label : label;
+    fun_tailrec_entry_point_label : label option;
     fun_contains_calls: bool;
     fun_num_stack_slots: int array;
     fun_frame_required: bool;

backend/linear.mli

@@ -55,7 +55,7 @@ type fundecl =
     fun_fast: bool;
     fun_dbg : Debuginfo.t;
     fun_spacetime_shape : Mach.spacetime_shape option;
-    fun_tailrec_entry_point_label : label;
+    fun_tailrec_entry_point_label : label option;
     fun_contains_calls: bool;
     fun_num_stack_slots: int array;
     fun_frame_required: bool;

backend/linearize.ml

@@ -334,7 +334,7 @@ let fundecl f =
     fun_fast = not (List.mem Cmm.Reduce_code_size f.Mach.fun_codegen_options);
     fun_dbg  = f.Mach.fun_dbg;
     fun_spacetime_shape = f.Mach.fun_spacetime_shape;
-    fun_tailrec_entry_point_label;
+    fun_tailrec_entry_point_label = Some fun_tailrec_entry_point_label;
     fun_contains_calls = contains_calls;
     fun_num_stack_slots = f.Mach.fun_num_stack_slots;
     fun_frame_required = Proc.frame_required f;