Emit DWARF info for local variables and function parameters (ocaml-fl…

…ambda#1659)

backend/amd64/emit.mlp

@@ -478,12 +478,6 @@ let emit_jump_tables () =
   List.iter emit_jump_table !jump_tables;
   jump_tables := []
 
-(* Record function info for dwarf and emit label if needed. *)
-let emit_dwarf_for_fundecl fun_name fun_dbg =
-  match Emitaux.Dwarf_helpers.record_dwarf_for_fundecl ~fun_name fun_dbg with
-  | None -> ()
-  | Some label -> def_label label
-
 let build_asm_directives () : (module Asm_targets.Asm_directives_intf.S) = (
     module Asm_targets.Asm_directives.Make(struct
 
@@ -1472,6 +1466,11 @@ let emit_function_type_and_size fun_name =
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
+  let fun_end_label, fundecl =
+    match Emitaux.Dwarf_helpers.record_dwarf_for_fundecl fundecl with
+    | None -> None, fundecl
+    | Some { fun_end_label; fundecl } -> Some fun_end_label, fundecl
+  in
   function_name := fundecl.fun_name;
   fastcode_flag := fundecl.fun_fast;
   tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
@@ -1516,7 +1515,7 @@ let fundecl fundecl =
       cfi_adjust_cfa_offset (-n);
     end;
   end;
-  emit_dwarf_for_fundecl fundecl.fun_name fundecl.fun_dbg;
+  Option.iter def_label fun_end_label;
   cfi_endproc ();
   emit_function_type_and_size fundecl.fun_name
 
@@ -2043,7 +2042,7 @@ let end_assembly () =
   end;
 
   let asm =
-    if !Emitaux.create_asm_file then
+    if !X86_proc.create_asm_file then
       Some
         (
          (if X86_proc.masm then X86_masm.generate_asm

backend/arm64/emit.mlp

@@ -1131,6 +1131,11 @@ let rec emit_all i =
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
+  let fun_end_label, fundecl =
+    match Emitaux.Dwarf_helpers.record_dwarf_for_fundecl fundecl with
+    | None -> None, fundecl
+    | Some { fun_end_label; fundecl } -> Some fun_end_label, fundecl
+  in
   function_name := fundecl.fun_name;
   fastcode_flag := fundecl.fun_fast;
   tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
@@ -1163,10 +1168,9 @@ let fundecl fundecl =
   List.iter emit_call_bound_error !bound_error_sites;
   assert (List.length !call_gc_sites = num_call_gc);
   assert (List.length !bound_error_sites = num_check_bound);
-  (match Emitaux.Dwarf_helpers.record_dwarf_for_fundecl
-           ~fun_name:fundecl.fun_name fundecl.fun_dbg with
+  (match fun_end_label with
    | None -> ()
-   | Some label -> `{emit_label label}:\n`);
+   | Some fun_end_label -> `{emit_label fun_end_label}:\n`);
   cfi_endproc();
   emit_symbol_type emit_symbol fundecl.fun_name "function";
   emit_symbol_size fundecl.fun_name;

backend/asmgen.ml

@@ -407,7 +407,7 @@ let compile_unit ~output_prefix ~asm_filename ~keep_asm ~obj_filename ~may_reduc
   reset ();
   let create_asm = should_emit () &&
                    (keep_asm || not !Emitaux.binary_backend_available) in
-  Emitaux.create_asm_file := create_asm;
+  X86_proc.create_asm_file := create_asm;
   Misc.try_finally
     ~exceptionally:(fun () -> remove_file obj_filename)
     (fun () ->

backend/debug/available_ranges_vars.ml

@@ -0,0 +1,193 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2014--2023 Jane Street Group LLC                           *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+module L = Linear
+module V = Backend_var
+
+module Key = struct
+  type t = Reg_with_debug_info.t
+
+  type key = t
+
+  module Raw_set = Reg_with_debug_info.Set
+
+  module Set = struct
+    include Reg_availability_set
+
+    let print ppf t = print ~print_reg:Printmach.reg ppf t
+  end
+
+  module Map = Map.Make (struct
+    type t = Reg_with_debug_info.t
+
+    let compare = Reg_with_debug_info.compare
+  end)
+
+  let print ppf t = Reg_with_debug_info.print ~print_reg:Printmach.reg ppf t
+
+  let all_parents _ = []
+end
+
+module Vars = struct
+  module RD = Reg_with_debug_info
+
+  (* By the time this pass runs, register stamps are irrelevant; indeed, there
+     may be multiple registers with different stamps assigned to the same
+     location. As such, we quotient register sets by the equivalence relation
+     that identifies two registers iff they have the same name and location. *)
+  (* CR mshinwell: as part of rethinking the Reg_availability_set stuff, we
+     should think about the above comment. Should we be using
+     RD.Set_distinguishing_names_and_locations? *)
+  module Key = Key
+  module Index = V
+
+  module Subrange_state : sig
+    include Compute_ranges_intf.S_subrange_state
+
+    val stack_offset : t -> int
+  end = struct
+    type t = { stack_offset : int }
+
+    let create () = { stack_offset = Proc.initial_stack_offset }
+
+    let advance_over_instruction t (insn : L.instruction) =
+      let stack_offset =
+        match insn.desc with
+        | Lop (Istackoffset delta) -> t.stack_offset + delta
+        | Lpushtrap _ -> t.stack_offset + Proc.trap_frame_size_in_bytes
+        | Lpoptrap -> t.stack_offset - Proc.trap_frame_size_in_bytes
+        | Lend | Lprologue | Lop _ | Lreloadretaddr | Lreturn | Llabel _
+        | Lbranch _ | Lcondbranch _ | Lcondbranch3 _ | Lswitch _ | Lentertrap
+        | Lraise _ | Ladjust_stack_offset _ ->
+          t.stack_offset
+      in
+      { stack_offset }
+
+    let stack_offset t = t.stack_offset
+  end
+
+  module Subrange_info : sig
+    include
+      Compute_ranges_intf.S_subrange_info
+        with type key := Key.t
+        with type subrange_state := Subrange_state.t
+
+    val reg : t -> Reg.t
+
+    val offset : t -> Stack_reg_offset.t option
+  end = struct
+    type t =
+      { reg : Reg.t;
+        offset : Stack_reg_offset.t option
+      }
+
+    let print ppf { reg; offset } =
+      Format.fprintf ppf "@[<hov 1>((reg %a)@ (offset %a))@]" Printmach.reg reg
+        (Misc.Stdlib.Option.print Stack_reg_offset.print)
+        offset
+
+    let create reg subrange_state ~fun_contains_calls ~fun_num_stack_slots =
+      let reg = RD.reg reg in
+      let stack_offset = Subrange_state.stack_offset subrange_state in
+      let offset =
+        match reg.loc with
+        | Stack loc ->
+          let frame_size =
+            Proc.frame_size ~stack_offset ~fun_contains_calls
+              ~fun_num_stack_slots
+          in
+          let slot_offset =
+            Proc.slot_offset loc
+              ~stack_class:(Proc.stack_slot_class reg.typ)
+              ~stack_offset ~fun_contains_calls ~fun_num_stack_slots
+          in
+          let offset : Stack_reg_offset.t =
+            match slot_offset with
+            | Bytes_relative_to_stack_pointer i ->
+              Bytes_relative_to_cfa (frame_size - i)
+            | Bytes_relative_to_domainstate_pointer i ->
+              Bytes_relative_to_domainstate_pointer i
+          in
+          Some offset
+        | Reg _ | Unknown -> None
+      in
+      { reg; offset }
+
+    let reg t = t.reg
+
+    (* Available subranges are allowed to cross points at which the stack
+       pointer changes, since we reference the stack slots as an offset from the
+       CFA, not from the stack pointer. *)
+
+    let offset t = t.offset
+  end
+
+  module Range_info : sig
+    include
+      Compute_ranges_intf.S_range_info
+        with type key := Key.t
+        with type index := Index.t
+
+    val provenance : t -> V.Provenance.t option
+
+    val is_parameter : t -> Is_parameter.t
+  end = struct
+    type t =
+      { provenance : V.Provenance.t option;
+        is_parameter : Is_parameter.t
+      }
+
+    let print ppf { provenance; is_parameter } =
+      Format.fprintf ppf "@[<hov 1>((provenance %a)@ (is_parameter %a))@]"
+        (Misc.Stdlib.Option.print V.Provenance.print)
+        provenance Is_parameter.print is_parameter
+
+    let create _fundecl reg ~start_insn:_ =
+      match RD.debug_info reg with
+      | None -> None
+      | Some debug_info ->
+        let var = RD.Debug_info.holds_value_of debug_info in
+        let provenance = RD.Debug_info.provenance debug_info in
+        let is_parameter = RD.Debug_info.is_parameter debug_info in
+        let t = { provenance; is_parameter } in
+        Some (var, t)
+
+    let provenance t = t.provenance
+
+    let is_parameter t = t.is_parameter
+  end
+
+  (* CR mshinwell: update comment to explain what "subset inclusion" means
+     here *)
+  (* Important note: [Reg_availability_set.canonicalise] does not preserve
+     subset inclusion. This means in particular that a canonicalised
+     [available_across] set may not be a subset of the corresponding
+     canonicalised [available_before]. [Compute_ranges] can cope with this. *)
+
+  let availability_set_to_key_set (avail : Reg_availability_set.t) =
+    Reg_availability_set.canonicalise avail
+
+  let available_before (insn : L.instruction) =
+    Option.map availability_set_to_key_set insn.available_before
+
+  let available_across (insn : L.instruction) =
+    match insn.available_across with
+    | None -> available_before insn
+    | Some across -> Some (availability_set_to_key_set across)
+end
+
+module Subrange_state = Vars.Subrange_state
+module Subrange_info = Vars.Subrange_info
+module Range_info = Vars.Range_info
+include Compute_ranges.Make (Vars)

backend/debug/available_ranges_vars.mli

@@ -0,0 +1,79 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                  Mark Shinwell, Jane Street Europe                     *)
+(*                                                                        *)
+(*   Copyright 2014--2023 Jane Street Group LLC                           *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Given a variable [x] and a function, an "available subrange" is in the
+    normal case a contiguous subset of that function's code paired with a
+    register [r], such that at all times during the block's execution the value
+    of [x] is available in [r]. ([r] may end up being a hard register or a
+    location on the stack.)
+
+    Available subranges associated with non-phantom variables are computed by
+    this pass based on the information from the dataflow analysis in
+    [Regs]. (The linearized code is updated so that it contains the
+    necessary labels for delimiting such ranges.)
+
+    An "available range" is then a set of available subranges that do not
+    overlap in code space, again for a single variable and function.
+*)
+
+module Key : Compute_ranges_intf.S_key with type t = Reg_with_debug_info.t
+
+module Subrange_state : sig
+  type t
+
+  val create : unit -> t
+
+  val advance_over_instruction : t -> Linear.instruction -> t
+end
+
+module Subrange_info : sig
+  type t
+
+  val create :
+    Reg_with_debug_info.t ->
+    Subrange_state.t ->
+    fun_contains_calls:bool ->
+    fun_num_stack_slots:int array ->
+    t
+
+  val reg : t -> Reg.t
+
+  val offset : t -> Stack_reg_offset.t option
+
+  val print : Format.formatter -> t -> unit
+end
+
+module Range_info : sig
+  type t
+
+  val create :
+    Linear.fundecl ->
+    Reg_with_debug_info.t ->
+    start_insn:Linear.instruction ->
+    (Backend_var.t * t) option
+
+  val provenance : t -> Backend_var.Provenance.t option
+
+  val is_parameter : t -> Is_parameter.t
+
+  val print : Format.formatter -> t -> unit
+end
+
+include
+  Compute_ranges_intf.S
+    with module Index := Backend_var
+    with module Key := Key
+    with module Subrange_state := Subrange_state
+    with module Subrange_info := Subrange_info
+    with module Range_info := Range_info

backend/debug/dwarf/dwarf_high/dwarf_attribute_helpers.ml

@@ -351,10 +351,13 @@ let create_ocaml_prefix_name name =
   let spec = AS.create (Ocaml_specific Prefix_name) Strp in
   AV.create spec (V.indirect_string ~comment:"prefix name" name)
 
+let linker_dir_sep = '\001'
+
+let mangle_linker_dirs dirs =
+  String.concat (Printf.sprintf "%c" linker_dir_sep) dirs
+
 let create_ocaml_linker_dirs dirs =
-  let dirs =
-    Dwarf_name_laundry.mangle_linker_dirs (Misc.Stdlib.String.Set.elements dirs)
-  in
+  let dirs = mangle_linker_dirs (Misc.Stdlib.String.Set.elements dirs) in
   let spec = AS.create (Ocaml_specific Linker_dirs) Strp in
   AV.create spec (V.indirect_string ~comment:"linker dirs" dirs)