1 /* Copyright (C) 2020-2021 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.  */
fortran_array_offset_calculator(struct type * type)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.  */
index_offset(LONGEST index)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.  */
continue_walkingfortran_array_walker_base_impl114   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 INNER_P is true for the inner most dimension (the dimension
119      containing the actual elements of the array), and false for more outer
120      dimensions.  For a concrete example of how this function is called
121      see the comment on process_element below.  */
start_dimensionfortran_array_walker_base_impl122   void start_dimension (bool inner_p)
123   { /* Nothing.  */ }
124 
125   /* Called when GDB finishes iterating over a dimension of the array.  The
126      argument INNER_P is true for the inner most dimension (the dimension
127      containing the actual elements of the array), and false for more outer
128      dimensions.  LAST_P is true for the last call at a particular
129      dimension.  For a concrete example of how this function is called
130      see the comment on process_element below.  */
finish_dimensionfortran_array_walker_base_impl131   void finish_dimension (bool inner_p, bool last_p)
132   { /* Nothing.  */ }
133 
134   /* Called when processing the inner most dimension of the array, for
135      every element in the array.  ELT_TYPE is the type of the element being
136      extracted, and ELT_OFF is the offset of the element from the start of
137      array being walked, and LAST_P is true only when this is the last
138      element that will be processed in this dimension.
139 
140      Given this two dimensional array ((1, 2) (3, 4)), the calls to
141      start_dimension, process_element, and finish_dimension look like this:
142 
143      start_dimension (false);
144        start_dimension (true);
145          process_element (TYPE, OFFSET, false);
146          process_element (TYPE, OFFSET, true);
147        finish_dimension (true, false);
148        start_dimension (true);
149          process_element (TYPE, OFFSET, false);
150          process_element (TYPE, OFFSET, true);
151        finish_dimension (true, true);
152      finish_dimension (false, true);  */
process_elementfortran_array_walker_base_impl153   void process_element (struct type *elt_type, LONGEST elt_off, bool last_p)
154   { /* Nothing.  */ }
155 };
156 
157 /* A class to wrap up the process of iterating over a multi-dimensional
158    Fortran array.  IMPL is used to specialise what happens as we walk over
159    the array.  See class FORTRAN_ARRAY_WALKER_BASE_IMPL (above) for the
160    methods than can be used to customise the array walk.  */
161 template<typename Impl>
162 class fortran_array_walker
163 {
164   /* Ensure that Impl is derived from the required base class.  This just
165      ensures that all of the required API methods are available and have a
166      sensible default implementation.  */
167   gdb_static_assert ((std::is_base_of<fortran_array_walker_base_impl,Impl>::value));
168 
169 public:
170   /* Create a new array walker.  TYPE is the type of the array being walked
171      over, and ADDRESS is the base address for the object of TYPE in
172      memory.  All other arguments are forwarded to the constructor of the
173      template parameter class IMPL.  */
174   template <typename ...Args>
fortran_array_walker(struct type * type,CORE_ADDR address,Args...args)175   fortran_array_walker (struct type *type, CORE_ADDR address,
176 			Args... args)
177     : m_type (type),
178       m_address (address),
179       m_impl (type, address, args...)
180   {
181     m_ndimensions =  calc_f77_array_dims (m_type);
182   }
183 
184   /* Walk the array.  */
185   void
walk()186   walk ()
187   {
188     walk_1 (1, m_type, 0, false);
189   }
190 
191 private:
192   /* The core of the array walking algorithm.  NSS is the current
193      dimension number being processed, TYPE is the type of this dimension,
194      and OFFSET is the offset (in bytes) for the start of this dimension.  */
195   void
walk_1(int nss,struct type * type,int offset,bool last_p)196   walk_1 (int nss, struct type *type, int offset, bool last_p)
197   {
198     /* Extract the range, and get lower and upper bounds.  */
199     struct type *range_type = check_typedef (type)->index_type ();
200     LONGEST lowerbound, upperbound;
201     if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
202       error ("failed to get range bounds");
203 
204     /* CALC is used to calculate the offsets for each element in this
205        dimension.  */
206     fortran_array_offset_calculator calc (type);
207 
208     m_impl.start_dimension (nss == m_ndimensions);
209 
210     if (nss != m_ndimensions)
211       {
212 	/* For dimensions other than the inner most, walk each element and
213 	   recurse while peeling off one more dimension of the array.  */
214 	for (LONGEST i = lowerbound;
215 	     m_impl.continue_walking (i < upperbound + 1);
216 	     i++)
217 	  {
218 	    /* Use the index and the stride to work out a new offset.  */
219 	    LONGEST new_offset = offset + calc.index_offset (i);
220 
221 	    /* Now print the lower dimension.  */
222 	    struct type *subarray_type
223 	      = TYPE_TARGET_TYPE (check_typedef (type));
224 	    walk_1 (nss + 1, subarray_type, new_offset, (i == upperbound));
225 	  }
226       }
227     else
228       {
229 	/* For the inner most dimension of the array, process each element
230 	   within this dimension.  */
231 	for (LONGEST i = lowerbound;
232 	     m_impl.continue_walking (i < upperbound + 1);
233 	     i++)
234 	  {
235 	    LONGEST elt_off = offset + calc.index_offset (i);
236 
237 	    struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (type));
238 	    if (is_dynamic_type (elt_type))
239 	      {
240 		CORE_ADDR e_address = m_address + elt_off;
241 		elt_type = resolve_dynamic_type (elt_type, {}, e_address);
242 	      }
243 
244 	    m_impl.process_element (elt_type, elt_off, (i == upperbound));
245 	  }
246       }
247 
248     m_impl.finish_dimension (nss == m_ndimensions, last_p || nss == 1);
249   }
250 
251   /* The array type being processed.  */
252   struct type *m_type;
253 
254   /* The address in target memory for the object of M_TYPE being
255      processed.  This is required in order to resolve dynamic types.  */
256   CORE_ADDR m_address;
257 
258   /* An instance of the template specialisation class.  */
259   Impl m_impl;
260 
261   /* The total number of dimensions in M_TYPE.  */
262   int m_ndimensions;
263 };
264 
265 #endif /* F_ARRAY_WALKER_H */
266