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