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 Sun, 2009-10-04 at 16:17 +0200, Jan Kratochvil wrote:
> On Wed, 30 Sep 2009 17:59:34 +0200, Joost van der Sluis wrote:
> > Attached it the new patch.
> 
> Please write GNU style ChangeLog entry for it.  I am sorry I did not write the
> entries myself in the log (as a partial excuse it was not reviewed by anyone
> that time).

I've done my best, see below. 

> > I tested it and I have no regressions anymore.
> 
> Getting a lot of regressions included below.
> * Some fortran failures only happen with `ulimit -v 500000'.
> * Are the new Pascal testcase FAILures expected?  If a more recent fpc is
>   required the testcase should XFAIL, not FAIL.
> You need to have installed at least gcc-gfortran + gcc-gnat with
> 	ln -s /usr/bin/gfortran src-toplevel-dir/g77
> > @@ -197,6 +198,13 @@ struct value
> >    /* If value is a variable, is it initialized or not.  */
> >    int initialized;
> >  
> > +  CORE_ADDR data_address;
> > +
> > +  char calc_length;
> > +  long length;
> > +  char checked_dynamics;
> > +  long lower_bound;
> > +  long upper_bound;
> 
> 
> Still I do not like duplicating the information already present in `struct
> main_type'.  I find right you have changed passing some `struct type *' to
> `struct value *' instead but that new `struct value' just could use
> copy_type_recursive on that linked `struct type'.

I've reworked the patch and removed these duplicates. It does not try to
do some things fully dynamic anymore. I think this patch is more
suitable to be included in FSF GDB. I think you'll like it.

I've added some tests to the pascal-tests so they XFail when an older
version of fpc is installed, and the tests aren't runned at all when gpc
is used as pascal-compiler.

I've tested for regressions, this time with ada and fortran enabled and
didn't have any regressions.

Here's the changelog:

2009-10-28 Joost van der Sluis <joost@cnoc.nl>

* tekhex.c (move_section_contents): fixed usage of offset parameter

* 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

* gdbtypes.c, gdbtypes.h (check_typedef, check_typedef_target) Added 
check_typedef_target which resolves the target type without doing a full
check_typedef

* p-valprint.c (pascal_val_print) Do not Handle arrays of integers as strings

* p-valprint.c (pascal_val_print) When printing array-elements use the original
passed type, and not one which is handled by check_typedef

* arrays.exp New tests for arrays in fpc
* pascal.exp Added variables fpcversion_major, fpcversion_minor and
fpcversion_release with the version of the used compiler

* valprint.c, valprint.h (get_array_bounds) Changed first parameter from struct
type into struct value
* valprint.c (val_print_array_elements) Calculate the amount of elements in 
an array always by substracting the upper and lower bound
* valprint.c (val_print_array_elements) For each element in the array, create a
new struct value and print it using common_val_print, so that all elements are
properly evaluated

* value.c, value.h (struct value) Added data_address to struct value. Added the
functions data_address and set_data_address 
* value.c, value.h (set_value_address) Use object_address_get_data to set 
data_addr
* value.c, value.h (value_lower_bound, value_upper_bound, get_bound) Added
these functions to get the lower and upper bound of an value struct containing
an array

2009 Jan Kratochvil <jan.kratochvil@redhat.com>>
* ada-valprint.c (print_optional_low_bound): no idea


diff --git a/bfd/tekhex.c b/bfd/tekhex.c
index 052795d..d8425cb 100644
--- 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;
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.
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..2296582 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/valops.c b/gdb/valops.c
index 0ffccaf..c24dabd 100644
--- a/gdb/valops.c
+++ b/gdb/valops.c
@@ -719,8 +719,8 @@ value_fetch_lazy (struct value *val)
 
       if (object_address_get_data (value_type (val), &addr))
 	{
-	  struct type *type = value_enclosing_type (val);
-	  int length = TYPE_LENGTH (check_typedef (type));
+          struct type *type = value_enclosing_type (val);
+          int length = TYPE_LENGTH (check_typedef (type));
 
 	  if (length)
 	    {
diff --git a/gdb/valprint.c b/gdb/valprint.c
index e5b12f2..f71065e 100644
--- a/gdb/valprint.c
+++ b/gdb/valprint.c
@@ -1033,9 +1033,9 @@ print_char_chars (struct ui_file *stream, struct type *type,
    default values instead.  */
 
 int
-get_array_bounds (struct type *type, long *low_bound, long *high_bound)
+get_array_bounds (struct value *val, long *low_bound, long *high_bound)
 {
-  struct type *index = TYPE_INDEX_TYPE (type);
+  struct type *index = TYPE_INDEX_TYPE (value_type (val));
   long low = 0;
   long high = 0;
                                   
@@ -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 (val);
+      high = value_upper_bound (val);
     }
   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,32 +1119,32 @@ 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 (val, &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.  */
-  if (len > 0 && !get_array_bounds (type, &low_bound_index, NULL))
+  if (len > 0 && !get_array_bounds (val, &low_bound_index, NULL))
     {
       warning (_("unable to get low bound of array, using zero as default"));
       low_bound_index = 0;
@@ -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 (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), 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/valprint.h b/gdb/valprint.h
index c0be116..9f8e76a 100644
--- a/gdb/valprint.h
+++ b/gdb/valprint.h
@@ -109,7 +109,7 @@ extern void get_raw_print_options (struct value_print_options *opts);
 extern void get_formatted_print_options (struct value_print_options *opts,
 					 char format);
 
-extern int get_array_bounds (struct type *type, long *low_bound,
+extern int get_array_bounds (struct value *val, long *low_bound,
 			     long *high_bound);
 
 extern void maybe_print_array_index (struct type *index_type, LONGEST index,
diff --git a/gdb/value.c b/gdb/value.c
index b79d84d..3475b6e 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 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;
@@ -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.  */
@@ -554,9 +556,23 @@ 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);
+  value->data_address = data_addr;
+}
+
+CORE_ADDR
+data_address (struct value *value)
+{
+  return value->data_address;
+}
+void
+set_data_address (struct value *value, CORE_ADDR addr)
+{
+  value->data_address = addr;
 }
 
 struct internalvar **
@@ -577,6 +593,53 @@ deprecated_value_regnum_hack (struct value *value)
   return &value->regnum;
 }
 
+long
+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;
+}
+
+long
+value_lower_bound (struct value *value)
+{
+  return get_bound (value_type (value), 0);
+}
+
+long 
+value_upper_bound (struct value *value)
+{
+  return get_bound (value_type (value), 1);
+}
+
 int
 deprecated_value_modifiable (struct value *value)
 {
diff --git a/gdb/value.h b/gdb/value.h
index aa4b3db..5011c09 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 data_address (struct value *);
+extern void set_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 long value_lower_bound (struct value *);
+extern long value_upper_bound (struct value *);
+
 /* 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]