dwarf_low/ and dwarf_high/ changes for DWARF inlined frames (PR2484)

Author: mshinwell

backend/debug/dwarf/dwarf_high/dwarf_attribute_helpers.ml

@@ -36,14 +36,21 @@ let create_low_pc address_label =
   AV.create spec
     (V.code_address_from_label ~comment:"low PC value" address_label)
 
-let create_high_pc_offset offset =
-  match Targetint.repr offset with
-  | Int32 offset ->
-    let spec = AS.create High_pc Data4 in
-    AV.create spec (V.int32 ~comment:"high PC value as offset" offset)
-  | Int64 offset ->
-    let spec = AS.create High_pc Data8 in
-    AV.create spec (V.int64 ~comment:"high PC value as offset" offset)
+let create_low_pc_with_offset address_label ~offset_in_bytes =
+  let spec = AS.create Low_pc Addr in
+  AV.create spec
+    (V.code_address_from_label_plus_offset ~comment:"low PC value" address_label
+       ~offset_in_bytes)
+
+let create_high_pc_offset ~low_pc ~low_pc_offset_in_bytes ~high_pc
+    ~high_pc_offset_in_bytes =
+  assert (Targetint.size = 64);
+  let spec = AS.create High_pc Data8 in
+  AV.create spec
+    (V.distance_between_labels_64_bit_with_offsets ~upper:high_pc
+       ~upper_offset:high_pc_offset_in_bytes ~lower:low_pc
+       ~lower_offset:low_pc_offset_in_bytes ~comment:"high PC value as offset"
+       ())
 
 let create_high_pc ~low_pc high_pc =
   match Dwarf_arch_sizes.size_addr with
@@ -131,6 +138,24 @@ let create_decl_column column =
   let column = Uint64.of_nonnegative_int_exn column in
   AV.create spec (V.uleb128 ~comment:"column number" column)
 
+let create_call_file file =
+  let spec = AS.create Call_file Udata in
+  let file = Uint64.of_nonnegative_int_exn file in
+  AV.create spec (V.uleb128 ~comment:"file number" file)
+
+let create_call_line line =
+  let spec = AS.create Call_line Udata in
+  let line = Uint64.of_nonnegative_int_exn line in
+  AV.create spec (V.uleb128 ~comment:"line number" line)
+
+let create_call_column column =
+  (* CR mshinwell: Check whether "call_file", "call_line" and "call_column" are
+     indeed supported pre DWARF 5. The gdb manual suggests that they've been
+     around since DWARF 2. *)
+  let spec = AS.create Call_column Udata in
+  let column = Uint64.of_nonnegative_int_exn column in
+  AV.create spec (V.uleb128 ~comment:"column number" column)
+
 let create_call_pc label =
   let spec = AS.create Call_pc Addr in
   needs_dwarf_five ();

backend/debug/dwarf/dwarf_high/dwarf_attribute_helpers.mli

@@ -22,10 +22,19 @@ val create_entry_pc : Asm_label.t -> Dwarf_attribute_values.Attribute_value.t
 
 val create_low_pc : Asm_label.t -> Dwarf_attribute_values.Attribute_value.t
 
+val create_low_pc_with_offset :
+  Asm_label.t ->
+  offset_in_bytes:Targetint.t ->
+  Dwarf_attribute_values.Attribute_value.t
+
 (** Creates a [DW_AT_high_pc] attribute value by taking the offset in bytes from
     the [DW_AT_low_pc] attribute value. *)
 val create_high_pc_offset :
-  Targetint.t -> Dwarf_attribute_values.Attribute_value.t
+  low_pc:Asm_label.t ->
+  low_pc_offset_in_bytes:Targetint.t ->
+  high_pc:Asm_label.t ->
+  high_pc_offset_in_bytes:Targetint.t ->
+  Dwarf_attribute_values.Attribute_value.t
 
 val create_high_pc :
   low_pc:Asm_symbol.t -> Asm_label.t -> Dwarf_attribute_values.Attribute_value.t
@@ -63,6 +72,12 @@ val create_decl_line : int -> Dwarf_attribute_values.Attribute_value.t
 
 val create_decl_column : int -> Dwarf_attribute_values.Attribute_value.t
 
+val create_call_file : int -> Dwarf_attribute_values.Attribute_value.t
+
+val create_call_line : int -> Dwarf_attribute_values.Attribute_value.t
+
+val create_call_column : int -> Dwarf_attribute_values.Attribute_value.t
+
 val create_call_pc : Asm_label.t -> Dwarf_attribute_values.Attribute_value.t
 
 val create_call_return_pc :

backend/debug/dwarf/dwarf_high/proto_die.ml

@@ -39,6 +39,8 @@ type t =
     location_list_in_debug_loc_table : Dwarf_4_location_list.t option
   }
 
+let equal t1 t2 = t1 == t2
+
 let attribute_values_map attribute_values =
   List.fold_left
     (fun map attribute_value ->
@@ -100,6 +102,10 @@ let add_or_replace_attribute_value t attribute_value =
   in
   t.attribute_values <- attribute_values
 
+let replace_all_attribute_values t attribute_values =
+  let attribute_values = attribute_values_map attribute_values in
+  { t with attribute_values }
+
 let set_name t name = t.name <- Some name
 
 type fold_arg =

backend/debug/dwarf/dwarf_high/proto_die.mli

@@ -59,6 +59,9 @@ val create_ignore :
 val add_or_replace_attribute_value :
   t -> Dwarf_attribute_values.Attribute_value.t -> unit
 
+val replace_all_attribute_values :
+  t -> Dwarf_attribute_values.Attribute_value.t list -> t
+
 (* CR-someday mshinwell: add a [name] argument to the creation functions *)
 val set_name : t -> Asm_symbol.t -> unit
 
@@ -102,3 +105,5 @@ val depth_first_fold : t -> init:'a -> f:('a -> fold_arg -> 'a) -> 'a
     suppresses a complaint from objdump "Location lists in .debug_loc start at
     ...". *)
 val location_list_in_debug_loc_table : t -> Dwarf_4_location_list.t option
+
+val equal : t -> t -> bool

backend/debug/dwarf/dwarf_low/dwarf_attribute_values.ml

@@ -60,6 +60,12 @@ module Value = struct
   let distance_between_labels_64_bit ?comment ~upper ~lower () =
     Dwarf_value (V.distance_between_labels_64_bit ?comment ~upper ~lower ())
 
+  let distance_between_labels_64_bit_with_offsets ?comment ~upper ~upper_offset
+      ~lower ~lower_offset () =
+    Dwarf_value
+      (V.distance_between_labels_64_bit_with_offsets ?comment ~upper
+         ~upper_offset ~lower ~lower_offset ())
+
   let distance_between_label_and_symbol_32_bit ?comment ~upper ~lower () =
     assert (Dwarf_arch_sizes.size_addr = 4);
     Dwarf_value
@@ -75,6 +81,10 @@ module Value = struct
   let code_address_from_label ?comment lbl =
     Dwarf_value (V.code_address_from_label ?comment lbl)
 
+  let code_address_from_label_plus_offset ?comment lbl ~offset_in_bytes =
+    Dwarf_value
+      (V.code_address_from_label_plus_offset ?comment lbl ~offset_in_bytes)
+
   let code_address_from_symbol ?comment sym =
     Dwarf_value (V.code_address_from_symbol ?comment sym)
 

backend/debug/dwarf/dwarf_low/dwarf_attribute_values.mli

@@ -70,6 +70,15 @@ module Value : sig
     unit ->
     Dwarf_attributes.Form.data8 t
 
+  val distance_between_labels_64_bit_with_offsets :
+    ?comment:string ->
+    upper:Asm_label.t ->
+    upper_offset:Targetint.t ->
+    lower:Asm_label.t ->
+    lower_offset:Targetint.t ->
+    unit ->
+    Dwarf_attributes.Form.data8 t
+
   val distance_between_label_and_symbol_32_bit :
     ?comment:string ->
     upper:Asm_label.t ->
@@ -87,6 +96,12 @@ module Value : sig
   val code_address_from_label :
     ?comment:string -> Asm_label.t -> Dwarf_attributes.Form.addr t
 
+  val code_address_from_label_plus_offset :
+    ?comment:string ->
+    Asm_label.t ->
+    offset_in_bytes:Targetint.t ->
+    Dwarf_attributes.Form.addr t
+
   val code_address_from_symbol :
     ?comment:string -> Asm_symbol.t -> Dwarf_attributes.Form.addr t
 

backend/debug/dwarf/dwarf_low/dwarf_value.ml

@@ -44,6 +44,10 @@ type value =
   | Indirect_string of string
   | Absolute_address of Targetint.t
   | Code_address_from_label of Asm_label.t
+  | Code_address_from_label_plus_offset of
+      { label : Asm_label.t;
+        offset_in_bytes : Targetint.t
+      }
   | Code_address_from_symbol of Asm_symbol.t
   | Code_address_from_label_symbol_diff of
       { upper : Asm_label.t;
@@ -80,6 +84,12 @@ type value =
       { upper : Asm_label.t;
         lower : Asm_label.t
       }
+  | Distance_between_labels_64_bit_with_offsets of
+      { upper : Asm_label.t;
+        upper_offset : Targetint.t;
+        lower : Asm_label.t;
+        lower_offset : Targetint.t
+      }
 
 type t =
   { value : value;
@@ -105,6 +115,10 @@ let print ppf { value; comment = _ } =
   | Absolute_address addr ->
     Format.fprintf ppf "0x%Lx" (Targetint.to_int64 addr)
   | Code_address_from_label lbl -> Asm_label.print ppf lbl
+  | Code_address_from_label_plus_offset
+      { label : Asm_label.t; offset_in_bytes : Targetint.t } ->
+    Format.fprintf ppf "%a + %a" Asm_label.print label Targetint.print
+      offset_in_bytes
   | Code_address_from_symbol sym -> Asm_symbol.print ppf sym
   | Code_address_from_label_symbol_diff { upper; lower; offset_upper } ->
     Format.fprintf ppf "(%a + %a) - %a" Asm_label.print upper Targetint.print
@@ -143,6 +157,11 @@ let print ppf { value; comment = _ } =
   | Distance_between_labels_64_bit { upper; lower } ->
     Format.fprintf ppf "%a - %a (64)" Asm_label.print upper Asm_label.print
       lower
+  | Distance_between_labels_64_bit_with_offsets
+      { upper; upper_offset; lower; lower_offset } ->
+    Format.fprintf ppf "(%a + %a) - (%a + %a) (64)" Asm_label.print upper
+      Targetint.print upper_offset Asm_label.print lower Targetint.print
+      lower_offset
 
 let flag_true ?comment () = { value = Flag_true; comment }
 
@@ -177,6 +196,11 @@ let absolute_address ?comment addr = { value = Absolute_address addr; comment }
 let code_address_from_label ?comment lbl =
   { value = Code_address_from_label lbl; comment }
 
+let code_address_from_label_plus_offset ?comment label ~offset_in_bytes =
+  { value = Code_address_from_label_plus_offset { label; offset_in_bytes };
+    comment
+  }
+
 let code_address_from_symbol ?comment sym =
   { value = Code_address_from_symbol sym; comment }
 
@@ -233,6 +257,14 @@ let distance_between_labels_32_bit ?comment ~upper ~lower () =
 let distance_between_labels_64_bit ?comment ~upper ~lower () =
   { value = Distance_between_labels_64_bit { upper; lower }; comment }
 
+let distance_between_labels_64_bit_with_offsets ?comment ~upper ~upper_offset
+    ~lower ~lower_offset () =
+  { value =
+      Distance_between_labels_64_bit_with_offsets
+        { upper; upper_offset; lower; lower_offset };
+    comment
+  }
+
 let append_to_comment { value; comment } to_append =
   let comment =
     match comment with
@@ -271,7 +303,8 @@ let size { value; comment = _ } =
   | Int64 _ | Uint64 _ -> Dwarf_int.eight ()
   | Uleb128 i -> uleb128_size i
   | Sleb128 i -> sleb128_size i
-  | Absolute_address _ | Code_address_from_label _ | Code_address_from_symbol _
+  | Absolute_address _ | Code_address_from_label _
+  | Code_address_from_label_plus_offset _ | Code_address_from_symbol _
   | Code_address_from_label_symbol_diff _ | Code_address_from_symbol_diff _
   | Code_address_from_symbol_plus_bytes _ -> (
     match Targetint.size with
@@ -289,7 +322,9 @@ let size { value; comment = _ } =
     Dwarf_int.size (Dwarf_int.zero ())
   | Distance_between_labels_16_bit _ -> Dwarf_int.two ()
   | Distance_between_labels_32_bit _ -> Dwarf_int.four ()
-  | Distance_between_labels_64_bit _ -> Dwarf_int.eight ()
+  | Distance_between_labels_64_bit _
+  | Distance_between_labels_64_bit_with_offsets _ ->
+    Dwarf_int.eight ()
 
 let emit ~asm_directives { value; comment } =
   let module A = (val asm_directives : Asm_directives.S) in
@@ -331,6 +366,8 @@ let emit ~asm_directives { value; comment } =
       A.comment abbrev
   | Absolute_address addr -> A.targetint ?comment addr
   | Code_address_from_label lbl -> A.label ?comment lbl
+  | Code_address_from_label_plus_offset { label; offset_in_bytes } ->
+    A.label_plus_offset ?comment label ~offset_in_bytes
   | Code_address_from_symbol sym -> A.symbol ?comment sym
   | Code_address_from_label_symbol_diff { upper; lower; offset_upper } ->
     A.between_symbol_in_current_unit_and_label_offset ?comment ~upper ~lower
@@ -377,3 +414,7 @@ let emit ~asm_directives { value; comment } =
     A.between_labels_32_bit ?comment ~upper ~lower ()
   | Distance_between_labels_64_bit { upper; lower } ->
     A.between_labels_64_bit ?comment ~upper ~lower ()
+  | Distance_between_labels_64_bit_with_offsets
+      { upper; upper_offset; lower; lower_offset } ->
+    A.between_labels_64_bit_with_offsets ?comment ~upper ~upper_offset ~lower
+      ~lower_offset ()

backend/debug/dwarf/dwarf_low/dwarf_value.mli

@@ -53,6 +53,9 @@ val absolute_address : ?comment:string -> Targetint.t -> t
 
 val code_address_from_label : ?comment:string -> Asm_label.t -> t
 
+val code_address_from_label_plus_offset :
+  ?comment:string -> Asm_label.t -> offset_in_bytes:Targetint.t -> t
+
 val code_address_from_symbol : ?comment:string -> Asm_symbol.t -> t
 
 (* CR mshinwell: This doesn't form a code address. *)
@@ -105,6 +108,15 @@ val distance_between_labels_32_bit :
 val distance_between_labels_64_bit :
   ?comment:string -> upper:Asm_label.t -> lower:Asm_label.t -> unit -> t
 
+val distance_between_labels_64_bit_with_offsets :
+  ?comment:string ->
+  upper:Asm_label.t ->
+  upper_offset:Targetint.t ->
+  lower:Asm_label.t ->
+  lower_offset:Targetint.t ->
+  unit ->
+  t
+
 val append_to_comment : t -> string -> t
 
 val print : Format.formatter -> t -> unit