gdb/f-array-walker.h

   1 /* Copyright (C) 2020-2022 Free Software Foundation, Inc.
   2
   3    This file is part of GDB.
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 3 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  17
  18 /* Support classes to wrap up the process of iterating over a
  19    multi-dimensional Fortran array.  */
  20
  21 #ifndef F_ARRAY_WALKER_H
  22 #define F_ARRAY_WALKER_H
  23
  24 #include "defs.h"
  25 #include "gdbtypes.h"
  26 #include "f-lang.h"
  27
  28 /* Class for calculating the byte offset for elements within a single
  29    dimension of a Fortran array.  */
  30 class fortran_array_offset_calculator
  31 {
  32 public:
  33   /* Create a new offset calculator for TYPE, which is either an array or a
  34      string.  */
  35   explicit fortran_array_offset_calculator (struct type *type)
  36   {
  37     /* Validate the type.  */
  38     type = check_typedef (type);
  39     if (type->code () != TYPE_CODE_ARRAY
  40         && (type->code () != TYPE_CODE_STRING))
  41       error (_("can only compute offsets for arrays and strings"));
  42
  43     /* Get the range, and extract the bounds.  */
  44     struct type *range_type = type->index_type ();
  45     if (!get_discrete_bounds (range_type, &m_lowerbound, &m_upperbound))
  46       error ("unable to read array bounds");
  47
  48     /* Figure out the stride for this array.  */
  49     struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
  50     m_stride = type->index_type ()->bounds ()->bit_stride ();
  51     if (m_stride == 0)
  52       m_stride = type_length_units (elt_type);
  53     else
  54       {
  55         int unit_size
  56           = gdbarch_addressable_memory_unit_size (elt_type->arch ());
  57         m_stride /= (unit_size * 8);
  58       }
  59   };
  60
  61   /* Get the byte offset for element INDEX within the type we are working
  62      on.  There is no bounds checking done on INDEX.  If the stride is
  63      negative then we still assume that the base address (for the array
  64      object) points to the element with the lowest memory address, we then
  65      calculate an offset assuming that index 0 will be the element at the
  66      highest address, index 1 the next highest, and so on.  This is not
  67      quite how Fortran works in reality; in reality the base address of
  68      the object would point at the element with the highest address, and
  69      we would index backwards from there in the "normal" way, however,
  70      GDB's current value contents model doesn't support having the base
  71      address be near to the end of the value contents, so we currently
  72      adjust the base address of Fortran arrays with negative strides so
  73      their base address points at the lowest memory address.  This code
  74      here is part of working around this weirdness.  */
  75   LONGEST index_offset (LONGEST index)
  76   {
  77     LONGEST offset;
  78     if (m_stride < 0)
  79       offset = std::abs (m_stride) * (m_upperbound - index);
  80     else
  81       offset = std::abs (m_stride) * (index - m_lowerbound);
  82     return offset;
  83   }
  84
  85 private:
  86
  87   /* The stride for the type we are working with.  */
  88   LONGEST m_stride;
  89
  90   /* The upper bound for the type we are working with.  */
  91   LONGEST m_upperbound;
  92
  93   /* The lower bound for the type we are working with.  */
  94   LONGEST m_lowerbound;
  95 };
  96
  97 /* A base class used by fortran_array_walker.  There's no virtual methods
  98    here, sub-classes should just override the functions they want in order
  99    to specialise the behaviour to their needs.  The functionality
 100    provided in these default implementations will visit every array
 101    element, but do nothing for each element.  */
 102
 103 struct fortran_array_walker_base_impl
 104 {
 105   /* Called when iterating between the lower and upper bounds of each
 106      dimension of the array.  Return true if GDB should continue iterating,
 107      otherwise, return false.
 108
 109      SHOULD_CONTINUE indicates if GDB is going to stop anyway, and should
 110      be taken into consideration when deciding what to return.  If
 111      SHOULD_CONTINUE is false then this function must also return false,
 112      the function is still called though in case extra work needs to be
 113      done as part of the stopping process.  */
 114   bool continue_walking (bool should_continue)
 115   { return should_continue; }
 116
 117   /* Called when GDB starts iterating over a dimension of the array.  The
 118      argument NELTS holds the number of the elements in the dimension and
 119      INNER_P is true for the inner most dimension (the dimension containing
 120      the actual elements of the array), and false for more outer dimensions.
 121      For a concrete example of how this function is called see the comment
 122      on process_element below.  */
 123   void start_dimension (LONGEST nelts, bool inner_p)
 124   { /* Nothing.  */ }
 125
 126   /* Called when GDB finishes iterating over a dimension of the array.  The
 127      argument INNER_P is true for the inner most dimension (the dimension
 128      containing the actual elements of the array), and false for more outer
 129      dimensions.  LAST_P is true for the last call at a particular
 130      dimension.  For a concrete example of how this function is called
 131      see the comment on process_element below.  */
 132   void finish_dimension (bool inner_p, bool last_p)
 133   { /* Nothing.  */ }
 134
 135   /* Called when processing dimensions of the array other than the
 136      innermost one.  WALK_1 is the walker to normally call, ELT_TYPE is
 137      the type of the element being extracted, and ELT_OFF is the offset
 138      of the element from the start of array being walked, and LAST_P is
 139      true only when this is the last element that will be processed in
 140      this dimension.  */
 141   void process_dimension (gdb::function_view<void (struct type *,
 142                                                    int, bool)> walk_1,
 143                           struct type *elt_type, LONGEST elt_off, bool last_p)
 144   {
 145     walk_1 (elt_type, elt_off, last_p);
 146   }
 147
 148   /* Called when processing the inner most dimension of the array, for
 149      every element in the array.  ELT_TYPE is the type of the element being
 150      extracted, and ELT_OFF is the offset of the element from the start of
 151      array being walked, and LAST_P is true only when this is the last
 152      element that will be processed in this dimension.
 153
 154      Given this two dimensional array ((1, 2) (3, 4) (5, 6)), the calls to
 155      start_dimension, process_element, and finish_dimension look like this:
 156
 157      start_dimension (3, false);
 158        start_dimension (2, true);
 159          process_element (TYPE, OFFSET, false);
 160          process_element (TYPE, OFFSET, true);
 161        finish_dimension (true, false);
 162        start_dimension (2, true);
 163          process_element (TYPE, OFFSET, false);
 164          process_element (TYPE, OFFSET, true);
 165        finish_dimension (true, true);
 166        start_dimension (2, true);
 167          process_element (TYPE, OFFSET, false);
 168          process_element (TYPE, OFFSET, true);
 169        finish_dimension (true, true);
 170      finish_dimension (false, true);  */
 171   void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
 172   { /* Nothing.  */ }
 173 };
 174
 175 /* A class to wrap up the process of iterating over a multi-dimensional
 176    Fortran array.  IMPL is used to specialise what happens as we walk over
 177    the array.  See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
 178    methods than can be used to customise the array walk.  */
 179 template<typename Impl>
 180 class fortran_array_walker
 181 {
 182   /* Ensure that Impl is derived from the required base class.  This just
 183      ensures that all of the required API methods are available and have a
 184      sensible default implementation.  */
 185   gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
 186
 187 public:
 188   /* Create a new array walker.  TYPE is the type of the array being walked
 189      over, and ADDRESS is the base address for the object of TYPE in
 190      memory.  All other arguments are forwarded to the constructor of the
 191      template parameter class IMPL.  */
 192   template <typename ...Args>
 193   fortran_array_walker (struct type *type, CORE_ADDR address,
 194                         Args... args)
 195     : m_type (type),
 196       m_address (address),
 197       m_impl (type, address, args...),
 198       m_ndimensions (calc_f77_array_dims (m_type)),
 199       m_nss (0)
 200   { /* Nothing.  */ }
 201
 202   /* Walk the array.  */
 203   void
 204   walk ()
 205   {
 206     walk_1 (m_type, 0, false);
 207   }
 208
 209 private:
 210   /* The core of the array walking algorithm.  TYPE is the type of
 211      the current dimension being processed and OFFSET is the offset
 212      (in bytes) for the start of this dimension.  */
 213   void
 214   walk_1 (struct type *type, int offset, bool last_p)
 215   {
 216     /* Extract the range, and get lower and upper bounds.  */
 217     struct type *range_type = check_typedef (type)->index_type ();
 218     LONGEST lowerbound, upperbound;
 219     if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
 220       error ("failed to get range bounds");
 221
 222     /* CALC is used to calculate the offsets for each element in this
 223        dimension.  */
 224     fortran_array_offset_calculator calc (type);
 225
 226     m_nss++;
 227     m_impl.start_dimension (upperbound - lowerbound + 1,
 228                             m_nss == m_ndimensions);
 229
 230     if (m_nss != m_ndimensions)
 231       {
 232         struct type *subarray_type = TYPE_TARGET_TYPE (check_typedef (type));
 233
 234         /* For dimensions other than the inner most, walk each element and
 235            recurse while peeling off one more dimension of the array.  */
 236         for (LONGEST i = lowerbound;
 237              m_impl.continue_walking (i < upperbound + 1);
 238              i++)
 239           {
 240             /* Use the index and the stride to work out a new offset.  */
 241             LONGEST new_offset = offset + calc.index_offset (i);
 242
 243             /* Now print the lower dimension.  */
 244             m_impl.process_dimension
 245               ([this] (struct type *w_type, int w_offset, bool w_last_p) -> void
 246                 {
 247                   this->walk_1 (w_type, w_offset, w_last_p);
 248                 },
 249                subarray_type, new_offset, i == upperbound);
 250           }
 251       }
 252     else
 253       {
 254         struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
 255
 256         /* For the inner most dimension of the array, process each element
 257            within this dimension.  */
 258         for (LONGEST i = lowerbound;
 259              m_impl.continue_walking (i < upperbound + 1);
 260              i++)
 261           {
 262             LONGEST elt_off = offset + calc.index_offset (i);
 263
 264             if (is_dynamic_type (elt_type))
 265               {
 266                 CORE_ADDR e_address = m_address + elt_off;
 267                 elt_type = resolve_dynamic_type (elt_type, {}, e_address);
 268               }
 269
 270             m_impl.process_element (elt_type, elt_off, (i == upperbound));
 271           }
 272       }
 273
 274     m_impl.finish_dimension (m_nss == m_ndimensions, last_p || m_nss == 1);
 275     m_nss--;
 276   }
 277
 278   /* The array type being processed.  */
 279   struct type *m_type;
 280
 281   /* The address in target memory for the object of M_TYPE being
 282      processed.  This is required in order to resolve dynamic types.  */
 283   CORE_ADDR m_address;
 284
 285   /* An instance of the template specialisation class.  */
 286   Impl m_impl;
 287
 288   /* The total number of dimensions in M_TYPE.  */
 289   int m_ndimensions;
 290
 291   /* The current dimension number being processed.  */
 292   int m_nss;
 293 };
 294
 295 #endif /* F_ARRAY_WALKER_H */