Home | History | Annotate | Line # | Download | only in gdb
      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 GDB_F_EXP_H
     21 #define GDB_F_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 
    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 
    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 
    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 
    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 
    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 
    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 
    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 
    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 
    414   enum exp_opcode opcode () const override
    415   { return STRUCTOP_STRUCT; }
    416 };
    417 
    418 } /* namespace expr */
    419 
    420 #endif /* GDB_F_EXP_H */
    421