1 /* Definitions for Fortran expressions
2 
3    Copyright (C) 2020-2024 Free Software Foundation, Inc.
4 
5    This file is part of GDB.
6 
7    This program is free software; you can redistribute it and/or modify
8    it under the terms of the GNU General Public License as published by
9    the Free Software Foundation; either version 3 of the License, or
10    (at your option) any later version.
11 
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15    GNU General Public License for more details.
16 
17    You should have received a copy of the GNU General Public License
18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
19 
20 #ifndef FORTRAN_EXP_H
21 #define FORTRAN_EXP_H
22 
23 #include "expop.h"
24 
25 extern struct value *eval_op_f_abs (struct type *expect_type,
26                                             struct expression *exp,
27                                             enum noside noside,
28                                             enum exp_opcode opcode,
29                                             struct value *arg1);
30 extern struct value *eval_op_f_mod (struct type *expect_type,
31                                             struct expression *exp,
32                                             enum noside noside,
33                                             enum exp_opcode opcode,
34                                             struct value *arg1, struct value *arg2);
35 
36 /* Implement expression evaluation for Fortran's CEILING intrinsic function
37    called with one argument.  For EXPECT_TYPE, EXP, and NOSIDE see
38    expression::evaluate (in expression.h).  OPCODE will always be
39    FORTRAN_CEILING and ARG1 is the argument passed to CEILING.  */
40 
41 extern struct value *eval_op_f_ceil (struct type *expect_type,
42                                              struct expression *exp,
43                                              enum noside noside,
44                                              enum exp_opcode opcode,
45                                              struct value *arg1);
46 
47 /* Implement expression evaluation for Fortran's CEILING intrinsic function
48    called with two arguments.  For EXPECT_TYPE, EXP, and NOSIDE see
49    expression::evaluate (in expression.h).  OPCODE will always be
50    FORTRAN_CEILING, ARG1 is the first argument passed to CEILING, and KIND_ARG
51    is the type corresponding to the KIND parameter passed to CEILING.  */
52 
53 extern value *eval_op_f_ceil (type *expect_type, expression *exp,
54                                     noside noside, exp_opcode opcode, value *arg1,
55                                     type *kind_arg);
56 
57 /* Implement expression evaluation for Fortran's FLOOR intrinsic function
58    called with one argument.  For EXPECT_TYPE, EXP, and NOSIDE see
59    expression::evaluate (in expression.h).  OPCODE will always be FORTRAN_FLOOR
60    and ARG1 is the argument passed to FLOOR.  */
61 
62 extern struct value *eval_op_f_floor (struct type *expect_type,
63                                               struct expression *exp,
64                                               enum noside noside,
65                                               enum exp_opcode opcode,
66                                               struct value *arg1);
67 
68 /* Implement expression evaluation for Fortran's FLOOR intrinsic function
69    called with two arguments.  For EXPECT_TYPE, EXP, and NOSIDE see
70    expression::evaluate (in expression.h).  OPCODE will always be
71    FORTRAN_FLOOR, ARG1 is the first argument passed to FLOOR, and KIND_ARG is
72    the type corresponding to the KIND parameter passed to FLOOR.  */
73 
74 extern value *eval_op_f_floor (type *expect_type, expression *exp,
75                                      noside noside, exp_opcode opcode, value *arg1,
76                                      type *kind_arg);
77 
78 extern struct value *eval_op_f_modulo (struct type *expect_type,
79                                                struct expression *exp,
80                                                enum noside noside,
81                                                enum exp_opcode opcode,
82                                                struct value *arg1, struct value *arg2);
83 
84 /* Implement expression evaluation for Fortran's CMPLX intrinsic function
85    called with one argument.  For EXPECT_TYPE, EXP, and NOSIDE see
86    expression::evaluate (in expression.h). OPCODE will always be
87    FORTRAN_CMPLX and ARG1 is the argument passed to CMPLX if.  */
88 
89 extern value *eval_op_f_cmplx (type *expect_type, expression *exp,
90                                      noside noside, exp_opcode opcode, value *arg1);
91 
92 /* Implement expression evaluation for Fortran's CMPLX intrinsic function
93    called with two arguments.  For EXPECT_TYPE, EXP, and NOSIDE see
94    expression::evaluate (in expression.h).  OPCODE will always be
95    FORTRAN_CMPLX, ARG1 and ARG2 are the arguments passed to CMPLX.  */
96 
97 extern struct value *eval_op_f_cmplx (struct type *expect_type,
98                                               struct expression *exp,
99                                               enum noside noside,
100                                               enum exp_opcode opcode,
101                                               struct value *arg1, struct value *arg2);
102 
103 /* Implement expression evaluation for Fortran's CMPLX intrinsic function
104    called with three arguments.  For EXPECT_TYPE, EXP, and NOSIDE see
105    expression::evaluate (in expression.h).  OPCODE will always be
106    FORTRAN_CMPLX, ARG1 and ARG2 are real and imaginary part passed to CMPLX,
107    and KIND_ARG is the type corresponding to the KIND parameter passed to
108    CMPLX.  */
109 
110 extern value *eval_op_f_cmplx (type *expect_type, expression *exp,
111                                      noside noside, exp_opcode opcode, value *arg1,
112                                      value *arg2, type *kind_arg);
113 
114 extern struct value *eval_op_f_kind (struct type *expect_type,
115                                              struct expression *exp,
116                                              enum noside noside,
117                                              enum exp_opcode opcode,
118                                              struct value *arg1);
119 extern struct value *eval_op_f_associated (struct type *expect_type,
120                                                      struct expression *exp,
121                                                      enum noside noside,
122                                                      enum exp_opcode opcode,
123                                                      struct value *arg1);
124 extern struct value *eval_op_f_associated (struct type *expect_type,
125                                                      struct expression *exp,
126                                                      enum noside noside,
127                                                      enum exp_opcode opcode,
128                                                      struct value *arg1,
129                                                      struct value *arg2);
130 extern struct value * eval_op_f_allocated (struct type *expect_type,
131                                                      struct expression *exp,
132                                                      enum noside noside,
133                                                      enum exp_opcode op,
134                                                      struct value *arg1);
135 extern struct value * eval_op_f_loc (struct type *expect_type,
136                                              struct expression *exp,
137                                              enum noside noside,
138                                              enum exp_opcode op,
139                                              struct value *arg1);
140 
141 /* Implement the evaluation of UNOP_FORTRAN_RANK.  EXPECTED_TYPE, EXP, and
142    NOSIDE are as for expression::evaluate (see expression.h).  OP will
143    always be UNOP_FORTRAN_RANK, and ARG1 is the argument being passed to
144    the expression.   */
145 
146 extern struct value *eval_op_f_rank (struct type *expect_type,
147                                              struct expression *exp,
148                                              enum noside noside,
149                                              enum exp_opcode op,
150                                              struct value *arg1);
151 
152 /* Implement expression evaluation for Fortran's SIZE keyword. For
153    EXPECT_TYPE, EXP, and NOSIDE see expression::evaluate (in
154    expression.h).  OPCODE will always for FORTRAN_ARRAY_SIZE.  ARG1 is the
155    value passed to SIZE if it is only passed a single argument.  For the
156    two argument form see the overload of this function below.  */
157 
158 extern struct value *eval_op_f_array_size (struct type *expect_type,
159                                                      struct expression *exp,
160                                                      enum noside noside,
161                                                      enum exp_opcode opcode,
162                                                      struct value *arg1);
163 
164 /* An overload of EVAL_OP_F_ARRAY_SIZE above, this version takes two
165    arguments, representing the two values passed to Fortran's SIZE
166    keyword.  */
167 
168 extern struct value *eval_op_f_array_size (struct type *expect_type,
169                                                      struct expression *exp,
170                                                      enum noside noside,
171                                                      enum exp_opcode opcode,
172                                                      struct value *arg1,
173                                                      struct value *arg2);
174 
175 /* Implement expression evaluation for Fortran's SIZE intrinsic function called
176    with three arguments.  For EXPECT_TYPE, EXP, and NOSIDE see
177    expression::evaluate (in expression.h).  OPCODE will always be
178    FORTRAN_ARRAY_SIZE, ARG1 and ARG2 the first two values passed to SIZE, and
179    KIND_ARG is the type corresponding to the KIND parameter passed to SIZE.  */
180 
181 extern value *eval_op_f_array_size (type *expect_type, expression *exp,
182                                             noside noside, exp_opcode opcode,
183                                             value *arg1, value *arg2, type *kind_arg);
184 
185 /* Implement the evaluation of Fortran's SHAPE keyword.  EXPECTED_TYPE,
186    EXP, and NOSIDE are as for expression::evaluate (see expression.h).  OP
187    will always be UNOP_FORTRAN_SHAPE, and ARG1 is the argument being passed
188    to the expression.  */
189 
190 extern struct value *eval_op_f_array_shape (struct type *expect_type,
191                                                       struct expression *exp,
192                                                       enum noside noside,
193                                                       enum exp_opcode op,
194                                                       struct value *arg1);
195 
196 namespace expr
197 {
198 
199 /* Function prototype for Fortran intrinsic functions taking one argument and
200    one kind argument.  */
201 typedef value *binary_kind_ftype (type *expect_type, expression *exp,
202                                           noside noside, exp_opcode op, value *arg1,
203                                           type *kind_arg);
204 
205 /* Two-argument operation with the second argument being a kind argument.  */
206 template<exp_opcode OP, binary_kind_ftype FUNC>
207 class fortran_kind_2arg
208   : public tuple_holding_operation<operation_up, type*>
209 {
210 public:
211 
212   using tuple_holding_operation::tuple_holding_operation;
213 
evaluate(type * expect_type,expression * exp,noside noside)214   value *evaluate (type *expect_type, expression *exp, noside noside) override
215   {
216     value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
217     type *kind_arg = std::get<1> (m_storage);
218     return FUNC (expect_type, exp, noside, OP, arg1, kind_arg);
219   }
220 
opcode()221   exp_opcode opcode () const override
222   { return OP; }
223 };
224 
225 /* Function prototype for Fortran intrinsic functions taking two arguments and
226    one kind argument.  */
227 typedef value *ternary_kind_ftype (type *expect_type, expression *exp,
228                                            noside noside, exp_opcode op, value *arg1,
229                                            value *arg2, type *kind_arg);
230 
231 /* Three-argument operation with the third argument being a kind argument.  */
232 template<exp_opcode OP, ternary_kind_ftype FUNC>
233 class fortran_kind_3arg
234   : public tuple_holding_operation<operation_up, operation_up, type *>
235 {
236 public:
237 
238   using tuple_holding_operation::tuple_holding_operation;
239 
evaluate(type * expect_type,expression * exp,noside noside)240   value *evaluate (type *expect_type, expression *exp, noside noside) override
241   {
242     value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
243     value *arg2 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
244     type *kind_arg = std::get<2> (m_storage);
245     return FUNC (expect_type, exp, noside, OP, arg1, arg2, kind_arg);
246   }
247 
opcode()248   exp_opcode opcode () const override
249   { return OP; }
250 };
251 
252 using fortran_abs_operation = unop_operation<UNOP_ABS, eval_op_f_abs>;
253 using fortran_ceil_operation_1arg = unop_operation<FORTRAN_CEILING,
254                                                                eval_op_f_ceil>;
255 using fortran_ceil_operation_2arg = fortran_kind_2arg<FORTRAN_CEILING,
256                                                                   eval_op_f_ceil>;
257 using fortran_floor_operation_1arg = unop_operation<FORTRAN_FLOOR,
258                                                                 eval_op_f_floor>;
259 using fortran_floor_operation_2arg = fortran_kind_2arg<FORTRAN_FLOOR,
260                                                                    eval_op_f_floor>;
261 using fortran_kind_operation = unop_operation<UNOP_FORTRAN_KIND,
262                                                         eval_op_f_kind>;
263 using fortran_allocated_operation = unop_operation<UNOP_FORTRAN_ALLOCATED,
264                                                                eval_op_f_allocated>;
265 using fortran_loc_operation = unop_operation<UNOP_FORTRAN_LOC,
266                                                                eval_op_f_loc>;
267 
268 using fortran_mod_operation = binop_operation<BINOP_MOD, eval_op_f_mod>;
269 using fortran_modulo_operation = binop_operation<BINOP_FORTRAN_MODULO,
270                                                              eval_op_f_modulo>;
271 using fortran_associated_1arg = unop_operation<FORTRAN_ASSOCIATED,
272                                                          eval_op_f_associated>;
273 using fortran_associated_2arg = binop_operation<FORTRAN_ASSOCIATED,
274                                                             eval_op_f_associated>;
275 using fortran_rank_operation = unop_operation<UNOP_FORTRAN_RANK,
276                                                         eval_op_f_rank>;
277 using fortran_array_size_1arg = unop_operation<FORTRAN_ARRAY_SIZE,
278                                                          eval_op_f_array_size>;
279 using fortran_array_size_2arg = binop_operation<FORTRAN_ARRAY_SIZE,
280                                                             eval_op_f_array_size>;
281 using fortran_array_size_3arg = fortran_kind_3arg<FORTRAN_ARRAY_SIZE,
282                                                               eval_op_f_array_size>;
283 using fortran_array_shape_operation = unop_operation<UNOP_FORTRAN_SHAPE,
284                                                                  eval_op_f_array_shape>;
285 using fortran_cmplx_operation_1arg = unop_operation<FORTRAN_CMPLX,
286                                                                 eval_op_f_cmplx>;
287 using fortran_cmplx_operation_2arg = binop_operation<FORTRAN_CMPLX,
288                                                                  eval_op_f_cmplx>;
289 using fortran_cmplx_operation_3arg = fortran_kind_3arg<FORTRAN_CMPLX,
290                                                                  eval_op_f_cmplx>;
291 
292 /* OP_RANGE for Fortran.  */
293 class fortran_range_operation
294   : public tuple_holding_operation<enum range_flag, operation_up, operation_up,
295                                            operation_up>
296 {
297 public:
298 
299   using tuple_holding_operation::tuple_holding_operation;
300 
301   value *evaluate (struct type *expect_type,
302                        struct expression *exp,
303                        enum noside noside) override
304   {
305     error (_("ranges not allowed in this context"));
306   }
307 
308   range_flag get_flags () const
309   {
310     return std::get<0> (m_storage);
311   }
312 
313   value *evaluate0 (struct expression *exp, enum noside noside) const
314   {
315     return std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
316   }
317 
318   value *evaluate1 (struct expression *exp, enum noside noside) const
319   {
320     return std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
321   }
322 
323   value *evaluate2 (struct expression *exp, enum noside noside) const
324   {
325     return std::get<3> (m_storage)->evaluate (nullptr, exp, noside);
326   }
327 
328   enum exp_opcode opcode () const override
329   { return OP_RANGE; }
330 };
331 
332 /* In F77, functions, substring ops and array subscript operations
333    cannot be disambiguated at parse time.  This operation handles
334    both, deciding which do to at evaluation time.  */
335 class fortran_undetermined
336   : public tuple_holding_operation<operation_up, std::vector<operation_up>>
337 {
338 public:
339 
340   using tuple_holding_operation::tuple_holding_operation;
341 
342   value *evaluate (struct type *expect_type,
343                        struct expression *exp,
344                        enum noside noside) override;
345 
opcode()346   enum exp_opcode opcode () const override
347   { return OP_F77_UNDETERMINED_ARGLIST; }
348 
349 private:
350 
351   value *value_subarray (value *array, struct expression *exp,
352                                enum noside noside);
353 };
354 
355 /* Single-argument form of Fortran ubound/lbound intrinsics.  */
356 class fortran_bound_1arg
357   : public tuple_holding_operation<exp_opcode, operation_up>
358 {
359 public:
360 
361   using tuple_holding_operation::tuple_holding_operation;
362 
363   value *evaluate (struct type *expect_type,
364                        struct expression *exp,
365                        enum noside noside) override;
366 
opcode()367   enum exp_opcode opcode () const override
368   { return std::get<0> (m_storage); }
369 };
370 
371 /* Two-argument form of Fortran ubound/lbound intrinsics.  */
372 class fortran_bound_2arg
373   : public tuple_holding_operation<exp_opcode, operation_up, operation_up>
374 {
375 public:
376 
377   using tuple_holding_operation::tuple_holding_operation;
378 
379   value *evaluate (struct type *expect_type,
380                        struct expression *exp,
381                        enum noside noside) override;
382 
opcode()383   enum exp_opcode opcode () const override
384   { return std::get<0> (m_storage); }
385 };
386 
387 /* Three-argument form of Fortran ubound/lbound intrinsics.  */
388 class fortran_bound_3arg
389   : public tuple_holding_operation<exp_opcode, operation_up, operation_up,
390                                            type *>
391 {
392 public:
393 
394   using tuple_holding_operation::tuple_holding_operation;
395 
396   value *evaluate (type *expect_type, expression *exp, noside noside) override;
397 
opcode()398   exp_opcode opcode () const override
399   { return std::get<0> (m_storage); }
400 };
401 
402 /* Implement STRUCTOP_STRUCT for Fortran.  */
403 class fortran_structop_operation
404   : public structop_base_operation
405 {
406 public:
407 
408   using structop_base_operation::structop_base_operation;
409 
410   value *evaluate (struct type *expect_type,
411                        struct expression *exp,
412                        enum noside noside) override;
413 
opcode()414   enum exp_opcode opcode () const override
415   { return STRUCTOP_STRUCT; }
416 };
417 
418 } /* namespace expr */
419 
420 #endif /* FORTRAN_EXP_H */
421