From d6722c797fc6830d805bc94741427e406f4e16ab Mon Sep 17 00:00:00 2001
From: Bernhard Schommer <bernhardschommer@gmail.com>
Date: Thu, 22 Sep 2016 17:05:15 +0200
Subject: Added sizetyp for subarray bounds. Fix 19894

---
 debug/DwarfPrinter.ml |  4 ++--
 debug/DwarfTypes.mli  |  2 +-
 debug/Dwarfgen.ml     | 58 +++++++++++++++++++++++++++++++++++----------------
 3 files changed, 43 insertions(+), 21 deletions(-)

(limited to 'debug')

diff --git a/debug/DwarfPrinter.ml b/debug/DwarfPrinter.ml
index 9313b6c5..df67a352 100644
--- a/debug/DwarfPrinter.ml
+++ b/debug/DwarfPrinter.ml
@@ -184,7 +184,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
           add_attr_some e.subprogram_type add_type;
       | DW_TAG_subrange_type e ->
           prologue 0x21 "DW_TAG_subrange_type";
-          add_attr_some e.subrange_type add_type;
+          add_type buf;
           (match e.subrange_upper_bound with
           | None -> ()
           | Some (BoundConst _) -> add_abbr_entry (0x2f,"DW_AT_upper_bound",DW_FORM_udata) buf
@@ -491,7 +491,7 @@ module DwarfPrinter(Target: DWARF_TARGET):
       print_opt_value oc "DW_AT_type" sp.subprogram_type print_ref
 
     let print_subrange oc sr =
-      print_opt_value oc "DW_AT_type" sr.subrange_type print_ref;
+      print_ref oc "DW_AT_type" sr.subrange_type;
       print_opt_value oc  "DW_AT_upper_bound" sr.subrange_upper_bound print_bound_value
 
     let print_subroutine oc st =
diff --git a/debug/DwarfTypes.mli b/debug/DwarfTypes.mli
index f6074cf3..de4082a5 100644
--- a/debug/DwarfTypes.mli
+++ b/debug/DwarfTypes.mli
@@ -188,7 +188,7 @@ type dw_tag_subprogram =
 
 type dw_tag_subrange_type =
     {
-     subrange_type:        reference   option;
+     subrange_type:        reference;
      subrange_upper_bound: bound_value option;
    }
 
diff --git a/debug/Dwarfgen.ml b/debug/Dwarfgen.ml
index f1a8ce3e..76e2d638 100644
--- a/debug/Dwarfgen.ml
+++ b/debug/Dwarfgen.ml
@@ -88,18 +88,21 @@ module Dwarfgenaux (Target: TARGET) =
 
     let name_opt n = if n <> "" then Some (string_entry n) else None
 
+    let subrange_type : int option ref = ref None
+
+    let encoding_of_ikind = function
+      | IBool -> DW_ATE_boolean
+      | IChar ->
+          if !Machine.config.Machine.char_signed then
+            DW_ATE_signed_char
+          else
+            DW_ATE_unsigned_char
+      | IInt | ILong | ILongLong | IShort | ISChar -> DW_ATE_signed
+      | _ -> DW_ATE_unsigned
+
     (* Functions to translate the basetypes. *)
     let int_type_to_entry id i =
-      let encoding =
-        (match i.int_kind with
-        | IBool -> DW_ATE_boolean
-        | IChar ->
-            if !Machine.config.Machine.char_signed then
-              DW_ATE_signed_char
-            else
-              DW_ATE_unsigned_char
-        | IInt | ILong | ILongLong | IShort | ISChar -> DW_ATE_signed
-        | _ -> DW_ATE_unsigned)in
+      let encoding = encoding_of_ikind i.int_kind in
       let int = {
         base_type_byte_size = sizeof_ikind i.int_kind;
         base_type_encoding = Some encoding;
@@ -153,10 +156,18 @@ module Dwarfgenaux (Target: TARGET) =
         let r = match a with
         | None -> None
         | Some i ->
-            let bound = Int64.to_int (Int64.sub i Int64.one) in
-            Some (BoundConst bound) in
+            if i <> 0L then
+              let bound = Int64.to_int (Int64.sub i Int64.one) in
+              Some (BoundConst bound)
+            else
+              None in
+        let st = match !subrange_type with
+        | None -> let id = next_id () in
+          subrange_type := Some id;
+          id
+        | Some id  -> id in
         let s = {
-          subrange_type = None;
+          subrange_type = st;
           subrange_upper_bound = r;
         } in
         new_entry (next_id ()) (DW_TAG_subrange_type s)) arr.arr_size in
@@ -310,11 +321,22 @@ module Dwarfgenaux (Target: TARGET) =
         else
           d in
       let typs = aux needed in
-      List.rev (fold_types (fun id t acc ->
-        if IntSet.mem id typs then
-          (infotype_to_entry id t)::acc
-        else
-          acc) [])
+      let res =
+        List.rev (fold_types (fun id t acc ->
+          if IntSet.mem id typs then
+            (infotype_to_entry id t)::acc
+          else
+            acc) []) in
+      match !subrange_type with
+      | None -> res
+      | Some id ->
+          let encoding = encoding_of_ikind (Cutil.size_t_ikind ()) in
+          let tag = {
+            base_type_byte_size = !Machine.config.Machine.sizeof_size_t;
+            base_type_encoding = Some encoding;
+            base_type_name = string_entry "sizetype";
+          } in
+          (new_entry id (DW_TAG_base_type tag))::res
 
     let global_variable_to_entry acc id v =
       let loc = match v.gvar_atom with
-- 
cgit