This is the mail archive of the archer@sourceware.org mailing list for the Archer project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: Patch for pascal-dynamic arrays


On Fri, 2009-10-30 at 10:47 +0100, Jan Kratochvil wrote:
> On Wed, 28 Oct 2009 18:34:46 +0100, Joost van der Sluis wrote:

> > * tekhex.c (move_section_contents): fixed usage of offset parameter
> 
> > --- a/bfd/tekhex.c
> > +++ b/bfd/tekhex.c
> > @@ -583,8 +583,7 @@ move_section_contents (bfd *abfd,
> >    bfd_vma prev_number = 1;	/* Nothing can have this as a high bit.  */
> >    struct data_struct *d = NULL;
> >  
> > -  BFD_ASSERT (offset == 0);
> > -  for (addr = section->vma; count != 0; count--, addr++)
> > +  for (addr = section->vma + offset; count != 0; count--, addr++)
> >      {
> >        /* Get high bits of address.  */
> >        bfd_vma chunk_number = addr & ~(bfd_vma) CHUNK_MASK;
> 
> (a) You use tekhex binary format for some builds wrt Pascal?
> (b) OFFSET is already asserted as 0, this change must be a nop.

This code caused some regressions, unrelated to pascal. There are some
tests that write large arrays to disk and then reads them again.

Point is that this function has a parameter 'offset', but I think that
someone saw that it was never implemented, and thus added the assert to
check that it was always 0. But with my patch, this was not the case, so
I implemented the offset for other values then 0.

I still think that this is a valid fix, but I saw that I can omit this
change without a regression anymore. So that's no problem.

> > 2009 Jan Kratochvil <jan.kratochvil@redhat.com>>
> > * ada-valprint.c (print_optional_low_bound): no idea
> 
> > diff --git a/gdb/ada-valprint.c b/gdb/ada-valprint.c
> > index 565172c..af5def1 100644
> > --- a/gdb/ada-valprint.c
> > +++ b/gdb/ada-valprint.c
> > @@ -90,7 +90,8 @@ print_optional_low_bound (struct ui_file *stream, struct type *type,
> >    if (options->print_array_indexes)
> >      return 0;
> >  
> > -  if (!get_array_bounds (type, &low_bound, &high_bound))
> > +gdb_assert (0);        /* type vs. val */
> > +  if (!get_array_bounds (NULL, &low_bound, &high_bound))
> >      return 0;
> >  
> >    /* If this is an empty array, then don't print the lower bound.
> 
> This patch I wrote to be able to build GDB first the first variant of the
> patch as you built it without -Wall -Werror and thus the code was invalid.
> 
> As you changed the get_array_bounds prototype to require now `struct value *'
> and not `struct type *' as befoer the ADA code was no longer compatible.
> 
> I did not find simple enough to fix it, there is no `struct value *' available
> at that specific point of ADA code.  Either (a) one should pass
> `struct value *' there somehow or (b) one should still provide
> get_array_bounds variant accepting just `struct type *' for such cases.
> Whether (b) is a feasible way or whether one should go the (a) way I found to
> be more decided by the author of the patch - you.

Attached is a completely other way. This change from 'struct type' to
'struct value' was not strictly needed anymore. So I removed it. 

> One needs to care of all the targets and supported languages in the GNU
> projects as even the generic code benefits from the code contributed by the
> people around such specific targets/languages as ADA.

Or Pascal. I do understand this very well.. ;)

> > * cp-valprint.c (cp_print_value_fields): when the address is 0, do not pass
> > the 0 value increased with some offset to val_print, but pass 0 instead
> 
> > --- a/gdb/cp-valprint.c
> > +++ b/gdb/cp-valprint.c
> > -		  val_print (TYPE_FIELD_TYPE (type, i),
> > -			     valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
> > -			     address + TYPE_FIELD_BITPOS (type, i) / 8,
> > -			     stream, recurse + 1, &opts,
> > -			     current_language);
> > +                  if (address != 0)
> > +		    val_print (TYPE_FIELD_TYPE (type, i),
> > +		               valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
> > +			       address + TYPE_FIELD_BITPOS (type, i) / 8,
> > +			       stream, recurse + 1, &opts,
> > +			       current_language);
> > +                  else
> > +		    val_print (TYPE_FIELD_TYPE (type, i),
> > +		               valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
> > +			       0,
> > +			       stream, recurse + 1, &opts,
> > +			       current_language);
> 
> ADDRESS zero is a valid address of a variable on some targets, it must not be
> treated as a specific "undefined" case.  GDB for example uses for this purpose
> value ~0 (INVALID_ENTRY_POINT) which is also not right but less probable to be
> hit in real world cases.

> (Still this part is OK for archer-jankratochvil-vla but not for FSF GDB.)

Do you have a suggestion how to fix this? I did this to fix one single
regression:

FAIL: gdb.base/call-rt-st.exp: print print_one_large_struct(*list1)

The problem is that cp_print_value_fields is called with an invalid
address value of 0. And not ~0. That's not really my fault... Maybe I
can fix this one call from the test, but I thought that is was better to
fix this for the more general case.

> > @@ -240,7 +243,6 @@ static struct value_history_chunk *value_history_chain;
> >  
> >  static int value_history_count;	/* Abs number of last entry stored */
> >  
> > -
> >  /* List of all value objects currently allocated
> >     (except for those released by calls to release_value)
> >     This is so they can be freed after each command.  */
> 
> Please drop such excessive patch changes.

A remaining of the few ours I tried to use Eclipse. And I don't know how
to get rid of it using git. But I can delete it from the patch. ;)

Joost
diff --git a/gdb/cp-valprint.c b/gdb/cp-valprint.c
index 49d71a4..8e5e08c 100644
--- a/gdb/cp-valprint.c
+++ b/gdb/cp-valprint.c
@@ -293,11 +293,18 @@ cp_print_value_fields (struct type *type, struct type *real_type,
 		{
 		  struct value_print_options opts = *options;
 		  opts.deref_ref = 0;
-		  val_print (TYPE_FIELD_TYPE (type, i),
-			     valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
-			     address + TYPE_FIELD_BITPOS (type, i) / 8,
-			     stream, recurse + 1, &opts,
-			     current_language);
+                  if (address != 0)
+		    val_print (TYPE_FIELD_TYPE (type, i),
+		               valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
+			       address + TYPE_FIELD_BITPOS (type, i) / 8,
+			       stream, recurse + 1, &opts,
+			       current_language);
+                  else
+		    val_print (TYPE_FIELD_TYPE (type, i),
+		               valaddr, offset + TYPE_FIELD_BITPOS (type, i) / 8,
+			       0,
+			       stream, recurse + 1, &opts,
+			       current_language);
 		}
 	    }
 	  annotate_field_end ();
diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 0623204..f5d71c7 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -1490,11 +1490,8 @@ finalize_type (struct type *type)
    updated.  FIXME: Remove this dependency (only ada_to_fixed_type?).  */
 
 struct type *
-check_typedef (struct type *type)
+check_typedef_target (struct type *type)
 {
-  struct type *orig_type = type;
-  int is_const, is_volatile;
-
   gdb_assert (type);
 
   while (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
@@ -1527,6 +1524,17 @@ check_typedef (struct type *type)
 	}
       type = TYPE_TARGET_TYPE (type);
     }
+  return (type);
+
+}
+
+struct type *
+check_typedef (struct type *type)
+{
+  struct type *orig_type = type;
+  int is_const, is_volatile;
+
+  type = check_typedef_target (type);
 
   is_const = TYPE_CONST (type);
   is_volatile = TYPE_VOLATILE (type);
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index f0a5405..f571161 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -1339,6 +1339,8 @@ extern struct type *lookup_unsigned_typename (const struct language_defn *,
 extern struct type *lookup_signed_typename (const struct language_defn *,
 					    struct gdbarch *,char *);
 
+extern struct type *check_typedef_target (struct type *);
+
 extern struct type *check_typedef (struct type *);
 
 #define CHECK_TYPEDEF(TYPE)			\
diff --git a/gdb/p-valprint.c b/gdb/p-valprint.c
index 50c993f..b682829 100644
--- a/gdb/p-valprint.c
+++ b/gdb/p-valprint.c
@@ -61,12 +61,15 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
   unsigned int i = 0;	/* Number of characters printed */
   unsigned len;
   struct type *elttype;
+  struct type *orgtype;
   unsigned eltlen;
   int length_pos, length_size, string_pos;
   struct type *char_type;
   LONGEST val;
   CORE_ADDR addr;
 
+  orgtype = type;
+
   CHECK_TYPEDEF (type);
   switch (TYPE_CODE (type))
     {
@@ -82,9 +85,8 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 	    }
 	  /* For an array of chars, print with string syntax.  */
 	  if ((eltlen == 1 || eltlen == 2 || eltlen == 4)
-	      && ((TYPE_CODE (elttype) == TYPE_CODE_INT)
-	       || ((current_language->la_language == language_pascal)
-		   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
+	      && ((current_language->la_language == language_pascal)
+		   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR))
 	      && (options->format == 0 || options->format == 's'))
 	    {
 	      /* If requested, look for the first null char and only print
@@ -122,7 +124,7 @@ pascal_val_print (struct type *type, const gdb_byte *valaddr,
 		{
 		  i = 0;
 		}
-	      val_print_array_elements (type, valaddr + embedded_offset, address, stream,
+	      val_print_array_elements (orgtype, valaddr+embedded_offset, address, stream,
 					recurse, options, i);
 	      fprintf_filtered (stream, "}");
 	    }
diff --git a/gdb/testsuite/gdb.pascal/arrays.exp b/gdb/testsuite/gdb.pascal/arrays.exp
new file mode 100644
index 0000000..ccc6e1e
--- /dev/null
+++ b/gdb/testsuite/gdb.pascal/arrays.exp
@@ -0,0 +1,104 @@
+# Copyright 2008, 2009 Free Software Foundation, Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+if $tracelevel then {
+    strace $tracelevel
+}
+
+load_lib "pascal.exp"
+
+set testfile "arrays"
+set srcfile ${testfile}.pas
+set binfile ${objdir}/${subdir}/${testfile}$EXEEXT
+
+# These tests only work with fpc, using the -gw3 compile-option
+pascal_init
+if { $pascal_compiler_is_fpc != 1 } {
+  return -1
+}
+
+# Detect if the fpc version is below 2.3.0
+set fpc_generates_dwarf_for_dynamic_arrays 1
+if { ($fpcversion_major < 2) || ( ($fpcversion_major == 2) && ($fpcversion_minor < 3))}  {
+  set fpc_generates_dwarf_for_dynamic_arrays 0
+}
+
+
+if {[gdb_compile_pascal "-gw3 ${srcdir}/${subdir}/${srcfile}" "${binfile}" executable [list debug ]] != "" } {
+  return -1
+}
+
+gdb_exit
+gdb_start
+gdb_reinitialize_dir $srcdir/$subdir
+gdb_load ${binfile}
+set bp_location1 [gdb_get_line_number "set breakpoint 1 here"]
+set bp_location2 [gdb_get_line_number "set breakpoint 2 here"]
+
+
+if { [gdb_breakpoint ${srcfile}:${bp_location1}] } {
+    pass "setting breakpoint 1"
+}
+if { [gdb_breakpoint ${srcfile}:${bp_location2}] } {
+    pass "setting breakpoint 2"
+}
+
+# Verify that "start" lands inside the right procedure.
+if { [gdb_start_cmd] < 0 } {
+    untested start
+    return -1
+}
+
+gdb_test "" ".* at .*${srcfile}.*" "start"
+
+gdb_test "cont" "Breakpoint .*:${bp_location1}.*" "Going to first breakpoint"
+
+gdb_test "print StatArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer type"
+gdb_test "print StatArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61\\}" "Print static array of integer"
+
+gdb_test "cont" "Breakpoint .*:${bp_location2}.*" "Going to second breakpoint"
+
+gdb_test "print StatArrChar" ".* = 'abcdefghijkl'" "Print static array of char"
+gdb_test "print Stat2dArrInt" ".* = \\{\\{0, 1, 2, 3, 4\\}, \\{1, 2, 3, 4, 5\\}, \\{2, 3, 4, 5, 6\\}, \\{3, 4, 5, 6, 7\\}, \\{4, 5, 6, 7, 8\\}, \\{5, 6, 7, 8, 9\\}, \\{6, 7, 8, 9, 10\\}, \\{7, 8, 9, 10, 11\\}, \\{8, 9, 10, 11, 12\\}, \\{9, 10, 11, 12, 13\\}, \\{10, 11, 12, 13, 14\\}, \\{11, 12, 13, 14, 15\\}\\}" "Print static 2-dimensional array of integer"
+
+if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
+  setup_xfail "*-*-*"
+}
+gdb_test "print DynArrInt" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer type"
+if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
+  setup_xfail "*-*-*"
+}
+gdb_test "print DynArrInt_" ".* = \\{50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62\\}" "Print dynamic array of integer"
+
+if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
+  setup_xfail "*-*-*"
+}
+gdb_test "print s" ".* = 'test'#0'string'" "Print string containing null-char"
+
+if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
+  setup_xfail "*-*-*"
+}
+gdb_test "print DynArrStr" ".* = \\{'dstr0', 'dstr1', 'dstr2', 'dstr3', 'dstr4', 'dstr5', 'dstr6', 'dstr7', 'dstr8', 'dstr9', 'dstr10', 'dstr11', 'dstr12'\\}" "Print dynamic array of string"
+
+if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
+  setup_xfail "*-*-*"
+}
+gdb_test "print StatArrStr" ".* = \\{'str0', 'str1', 'str2', 'str3', 'str4', 'str5', 'str6', 'str7', 'str8', 'str9', 'str10', 'str11', 'str12'\\}" "Print static array of string"
+
+if { $fpc_generates_dwarf_for_dynamic_arrays == 0} {
+  setup_xfail "*-*-*"
+}
+gdb_test "print DynArrChar" ".* = 'abcdefghijklm'" "Print dynamic array of char"
+
diff --git a/gdb/testsuite/gdb.pascal/arrays.pas b/gdb/testsuite/gdb.pascal/arrays.pas
new file mode 100644
index 0000000..295602d
--- /dev/null
+++ b/gdb/testsuite/gdb.pascal/arrays.pas
@@ -0,0 +1,82 @@
+{
+ Copyright 2008, 2009 Free Software Foundation, Inc.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+}
+
+program arrays;
+
+{$mode objfpc}{$h+}
+
+uses sysutils;
+
+type TStatArrInt= array[0..11] of integer;
+     TDynArrInt= array of integer;
+     TStatArrStr= array[0..12] of string;
+     TDynArrStr= array of string;
+     TDynArrChar = array of char;
+     TStatArrChar = array [0..11] of char;
+
+     TStat2dArrInt = array[0..11,0..4] of integer;
+
+var StatArrInt: TStatArrInt;
+    StatArrInt_: Array[0..11] of integer;
+    DynArrInt:  TDynArrInt;
+    DynArrInt_: Array of integer;
+    StatArrStr: TStatArrStr;
+    DynArrStr: TDynArrStr;
+    StatArrChar: TStatArrChar;
+    DynArrChar: TDynArrChar;
+
+    Stat2dArrInt: TStat2dArrInt;
+
+    s: string;
+	
+    i,j : integer;
+
+begin
+  for i := 0 to 11 do
+    begin
+    StatArrInt[i]:= i+50;
+    StatArrInt_[i]:= i+50;
+    StatArrChar[i]:= chr(ord('a')+i);
+    for j := 0 to 4 do
+      Stat2dArrInt[i,j]:=i+j;
+    end;
+  writeln(StatArrInt_[0]);
+  writeln(StatArrInt[0]); { set breakpoint 1 here }
+  writeln(StatArrChar[0]);
+  writeln(Stat2dArrInt[0,0]);
+
+  setlength(DynArrInt,13);
+  setlength(DynArrInt_,13);
+  setlength(DynArrStr,13);
+  setlength(DynArrChar,13);
+  for i := 0 to 12 do
+    begin
+    DynArrInt[i]:= i+50;
+    DynArrInt_[i]:= i+50;
+    DynArrChar[i]:= chr(ord('a')+i);
+    StatArrStr[i]:='str'+inttostr(i);
+    DynArrStr[i]:='dstr'+inttostr(i);
+    end;
+  writeln(DynArrInt_[1]);
+  writeln(DynArrInt[1]); 
+  writeln(DynArrStr[1]); 
+  writeln(StatArrStr[1]);
+  writeln(DynArrChar[1]);
+
+  s := 'test'#0'string';
+  writeln(s); { set breakpoint 2 here }
+end.
diff --git a/gdb/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp
index 146eaec..7115f58 100644
--- a/gdb/testsuite/lib/pascal.exp
+++ b/gdb/testsuite/lib/pascal.exp
@@ -37,6 +37,9 @@ proc pascal_init {} {
     global pascal_compiler_is_fpc
     global gpc_compiler
     global fpc_compiler
+    global fpcversion_major
+    global fpcversion_minor
+    global fpcversion_release
     global env
  
     if { $pascal_init_done == 1 } {
@@ -64,6 +67,20 @@ proc pascal_init {} {
 	    set pascal_compiler_is_fpc 1
 	    verbose -log "Free Pascal compiler found"
 	}
+
+	# Detect the fpc-version
+	if { $pascal_compiler_is_fpc == 1 } {
+	    set fpcversion_major 1
+	    set fpcversion_minor 0
+	    set fpcversion_release 0
+	    set fpcversion [ remote_exec host $fpc_compiler "-iV" ] 
+	    if [regexp {.*([0-9]+)\.([0-9]+)\.([0-9]+).?} $fpcversion] {
+              regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\1} fpcversion_major
+              regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\2} fpcversion_minor
+              regsub {.*([0-9]+)\.([0-9]+)\.([0-9]+).?\n?.?} $fpcversion {\3} fpcversion_release
+	    }
+            verbose -log "Freepascal version: $fpcversion_major.$fpcversion_minor.$fpcversion_release"
+	}
     }
     set pascal_init_done 1
 }   
diff --git a/gdb/valprint.c b/gdb/valprint.c
index e5b12f2..51be803 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1044,8 +1044,8 @@ get_array_bounds (struct type *type, long *low_bound, long *high_bound)
 
   if (TYPE_CODE (index) == TYPE_CODE_RANGE)
     {
-      low = TYPE_LOW_BOUND (index);
-      high = TYPE_HIGH_BOUND (index);
+      low = value_lower_bound (type);
+      high = value_upper_bound (type);
     }
   else if (TYPE_CODE (index) == TYPE_CODE_ENUM)
     {
@@ -1109,7 +1109,9 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
   unsigned int things_printed = 0;
   unsigned len;
   struct type *elttype, *index_type;
+  struct value *val;
   unsigned eltlen;
+  unsigned stride;
   /* Position of the array element we are examining to see
      whether it is repeated.  */
   unsigned int rep1;
@@ -1117,28 +1119,28 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
   unsigned int reps;
   long low_bound_index = 0;
 
+  type = check_typedef_target (type);
+  stride = TYPE_ARRAY_BYTE_STRIDE_VALUE (check_typedef (type));
+  /* Construct a new 'struct value' to obtain dynamic information on the type,
+     like the array bounds */
+  val = value_at_lazy (type, address);
   elttype = TYPE_TARGET_TYPE (type);
   eltlen = TYPE_LENGTH (check_typedef (elttype));
   index_type = TYPE_INDEX_TYPE (type);
 
-  /* Compute the number of elements in the array.  On most arrays,
-     the size of its elements is not zero, and so the number of elements
-     is simply the size of the array divided by the size of the elements.
-     But for arrays of elements whose size is zero, we need to look at
-     the bounds.  */
-  if (eltlen != 0)
-    len = TYPE_LENGTH (type) / eltlen;
-  else
-    {
-      long low, hi;
-      if (get_array_bounds (type, &low, &hi))
-        len = hi - low + 1;
-      else
-        {
-          warning (_("unable to get bounds of array, assuming null array"));
-          len = 0;
-        }
-    }
+  /* Always use the bounds to calculate the amount of
+     elements in the array.  */
+  {
+    long low, hi;
+
+    if (get_array_bounds (type, &low, &hi))
+      len = hi - low + 1;
+    else
+      {
+       warning (_("unable to get bounds of array, assuming null array"));
+       len = 0;
+      }
+  }
 
   /* Get the array low bound.  This only makes sense if the array
      has one or more element in it.  */
@@ -1177,10 +1179,29 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
 	  ++rep1;
 	}
 
+      /* Set object_address to the address of the element and create a
+         new, clean value to pass to common_val_print, so that all dyanic
+         properties are handled correctly. */
+      {
+       struct value *element_value;
+
+       /* When no data_address is given, use the value already stored in the 
+          inferior at valaddr. Else force a new fetch of the variable into
+          the inferior */
+
+       if (value_data_address (val) == 0)
+           element_value = value_from_contents_and_address (TYPE_TARGET_TYPE (type),
+                                                            valaddr + i * stride,
+                                                            0);
+       else
+           element_value = value_at_lazy (TYPE_TARGET_TYPE (type), value_data_address (val) + i * stride);
+
+       common_val_print (element_value, stream, recurse + 1, options,
+                         current_language);
+      }
+
       if (reps > options->repeat_count_threshold)
 	{
-	  val_print (elttype, valaddr + i * eltlen, 0, address + i * eltlen,
-		     stream, recurse + 1, options, current_language);
 	  annotate_elt_rep (reps);
 	  fprintf_filtered (stream, " <repeats %u times>", reps);
 	  annotate_elt_rep_end ();
@@ -1190,8 +1211,6 @@ val_print_array_elements (struct type *type, const gdb_byte *valaddr,
 	}
       else
 	{
-	  val_print (elttype, valaddr + i * eltlen, 0, address + i * eltlen,
-		     stream, recurse + 1, options, current_language);
 	  annotate_elt ();
 	  things_printed++;
 	}
diff --git a/gdb/value.c b/gdb/value.c
index b79d84d..8c06d08 100644
--- a/gdb/value.c
+++ b/gdb/value.c
@@ -40,6 +40,7 @@
 #include "valprint.h"
 #include "cli/cli-decode.h"
 #include "observer.h"
+#include "dwarf2loc.h"
 
 #include "python/python.h"
 
@@ -197,6 +198,8 @@ struct value
   /* If value is a variable, is it initialized or not.  */
   int initialized;
 
+  CORE_ADDR value_data_address;
+
   /* If value is from the stack.  If this is set, read_stack will be
      used instead of read_memory to enable extra caching.  */
   int stack;
@@ -554,9 +556,24 @@ value_raw_address (struct value *value)
 void
 set_value_address (struct value *value, CORE_ADDR addr)
 {
+  CORE_ADDR data_addr = addr;
   gdb_assert (value->lval != lval_internalvar
 	      && value->lval != lval_internalvar_component);
   value->location.address = addr;
+  object_address_get_data (value_type (value), &data_addr);
+  set_value_data_address (value, data_addr);
+}
+
+CORE_ADDR
+value_data_address (struct value *value)
+{
+  return value->value_data_address;
+}
+
+void
+set_value_data_address (struct value *value, CORE_ADDR addr)
+{
+  value->value_data_address = addr;
 }
 
 struct internalvar **
@@ -578,6 +595,53 @@ deprecated_value_regnum_hack (struct value *value)
 }
 
 int
+get_bound (struct type *type, int i)
+{
+  struct type *index = TYPE_INDEX_TYPE (type);
+  if ((!(index == NULL)) && (TYPE_CODE (index) == TYPE_CODE_RANGE))
+    {
+      int nfields;
+      nfields = TYPE_NFIELDS (index);
+
+      if (nfields>(i-1))
+        {
+          switch (TYPE_FIELD_LOC_KIND (index, i))
+            {
+              case FIELD_LOC_KIND_BITPOS:
+                return TYPE_FIELD_BITPOS (index, i);
+              case FIELD_LOC_KIND_DWARF_BLOCK:
+                if (TYPE_NOT_ALLOCATED (index)
+                  || TYPE_NOT_ASSOCIATED (index))
+                  return 0;
+                else
+                  {
+                    return dwarf_locexpr_baton_eval (TYPE_FIELD_DWARF_BLOCK (index, i));
+                  }
+                break;
+              default:
+                internal_error (__FILE__, __LINE__,
+                                _("Unexpected type field location kind: %d"),
+                                  TYPE_FIELD_LOC_KIND (index, i));
+            }
+        }
+    }
+  /* NOTREACHED */
+  return -1;
+}
+
+int
+value_lower_bound (struct type *type)
+{
+  return get_bound (type, 0);
+}
+
+int
+value_upper_bound (struct type *type)
+{
+  return get_bound (type, 1);
+}
+
+int
 deprecated_value_modifiable (struct value *value)
 {
   return value->modifiable;
diff --git a/gdb/value.h b/gdb/value.h
index aa4b3db..f73e873 100644
--- a/gdb/value.h
+++ b/gdb/value.h
@@ -289,6 +289,10 @@ extern CORE_ADDR value_raw_address (struct value *);
 /* Set the address of a value.  */
 extern void set_value_address (struct value *, CORE_ADDR);
 
+extern CORE_ADDR value_data_address (struct value *);
+extern void set_value_data_address (struct value *, CORE_ADDR);
+
+
 /* Pointer to internal variable.  */
 extern struct internalvar **deprecated_value_internalvar_hack (struct value *);
 #define VALUE_INTERNALVAR(val) (*deprecated_value_internalvar_hack (val))
@@ -302,6 +306,10 @@ extern struct frame_id *deprecated_value_frame_id_hack (struct value *);
 extern short *deprecated_value_regnum_hack (struct value *);
 #define VALUE_REGNUM(val) (*deprecated_value_regnum_hack (val))
 
+/* Array bounds */
+extern int value_lower_bound (struct type *);
+extern int value_upper_bound (struct type *);
+
 /* Convert a REF to the object referenced.  */
 
 extern struct value *coerce_ref (struct value *value);

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]