2 /* YACC parser for Fortran expressions, for GDB.
3 Copyright (C) 1986-2022 Free Software Foundation, Inc.
5 Contributed by Motorola. Adapted from the C parser by Farooq Butt
6 (fmbutt@engage.sps.mot.com).
8 This file is part of GDB.
10 This program is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 3 of the License, or
13 (at your option) any later version.
15 This program is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with this program. If not, see <http://www.gnu.org/licenses/>. */
23 /* This was blantantly ripped off the C expression parser, please
24 be aware of that as you look at its basic structure -FMB */
26 /* Parse a F77 expression from text in a string,
27 and return the result as a struct expression pointer.
28 That structure contains arithmetic operations in reverse polish,
29 with constants represented by operations that are followed by special data.
30 See expression.h for the details of the format.
31 What is important here is that it can be built up sequentially
32 during the process of parsing; the lower levels of the tree always
33 come first in the result.
35 Note that malloc's and realloc's in this file are transformed to
36 xmalloc and xrealloc respectively by the same sed command in the
37 makefile that remaps any other malloc/realloc inserted by the parser
38 generator. Doing this with #defines and trying to control the interaction
39 with include files (<malloc.h> and <stdlib.h> for example) just became
40 too messy, particularly when such includes can be inserted at random
41 times by the parser generator. */
46 #include "expression.h"
48 #include "parser-defs.h"
51 #include "bfd.h" /* Required by objfiles.h. */
52 #include "symfile.h" /* Required by objfiles.h. */
53 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
57 #include "type-stack.h"
60 #define parse_type(ps) builtin_type (ps->gdbarch ())
61 #define parse_f_type(ps) builtin_f_type (ps->gdbarch ())
63 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
65 #define GDB_YY_REMAP_PREFIX f_
68 /* The state of the parser, used internally when we are parsing the
71 static struct parser_state *pstate = NULL;
73 /* Depth of parentheses. */
74 static int paren_depth;
76 /* The current type stack. */
77 static struct type_stack *type_stack;
81 static int yylex (void);
83 static void yyerror (const char *);
85 static void growbuf_by_size (int);
87 static int match_string_literal (void);
89 static void push_kind_type (LONGEST val, struct type *type);
91 static struct type *convert_to_kind_type (struct type *basetype, int kind);
96 /* Although the yacc "value" of an expression is not used,
97 since the result is stored in the structure being created,
98 other node types do have values. */
115 struct symtoken ssym;
117 enum exp_opcode opcode;
118 struct internalvar *ivar;
125 /* YYSTYPE gets defined by %union */
126 static int parse_number (struct parser_state *, const char *, int,
130 %type <voidval> exp type_exp start variable
131 %type <tval> type typebase
132 %type <tvec> nonempty_typelist
133 /* %type <bval> block */
135 /* Fancy type parsing. */
136 %type <voidval> func_mod direct_abs_decl abs_decl
139 %token <typed_val> INT
140 %token <typed_val_float> FLOAT
142 /* Both NAME and TYPENAME tokens represent symbols in the input,
143 and both convey their data as strings.
144 But a TYPENAME is a string that happens to be defined as a typedef
145 or builtin type name (such as int or char)
146 and a NAME is any other symbol.
147 Contexts where this distinction is not important can use the
148 nonterminal "name", which matches either NAME or TYPENAME. */
150 %token <sval> STRING_LITERAL
151 %token <lval> BOOLEAN_LITERAL
153 %token <tsym> TYPENAME
154 %token <voidval> COMPLETE
156 %type <ssym> name_not_typename
158 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
159 but which would parse as a valid number in the current input radix.
160 E.g. "c" when input_radix==16. Depending on the parse, it will be
161 turned into a name or into a number. */
163 %token <ssym> NAME_OR_INT
168 /* Special type cases, put in to allow the parser to distinguish different
170 %token INT_S1_KEYWORD INT_S2_KEYWORD INT_KEYWORD INT_S4_KEYWORD INT_S8_KEYWORD
171 %token LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD LOGICAL_KEYWORD LOGICAL_S4_KEYWORD
172 %token LOGICAL_S8_KEYWORD
173 %token REAL_KEYWORD REAL_S4_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
174 %token COMPLEX_KEYWORD COMPLEX_S4_KEYWORD COMPLEX_S8_KEYWORD
175 %token COMPLEX_S16_KEYWORD
176 %token BOOL_AND BOOL_OR BOOL_NOT
177 %token SINGLE DOUBLE PRECISION
178 %token <lval> CHARACTER
180 %token <sval> DOLLAR_VARIABLE
182 %token <opcode> ASSIGN_MODIFY
183 %token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC
184 %token <opcode> UNOP_OR_BINOP_INTRINSIC
188 %right '=' ASSIGN_MODIFY
197 %left LESSTHAN GREATERTHAN LEQ GEQ
215 { pstate->push_new<type_operation> ($1); }
222 /* Expressions, not including the comma operator. */
223 exp : '*' exp %prec UNARY
224 { pstate->wrap<unop_ind_operation> (); }
227 exp : '&' exp %prec UNARY
228 { pstate->wrap<unop_addr_operation> (); }
231 exp : '-' exp %prec UNARY
232 { pstate->wrap<unary_neg_operation> (); }
235 exp : BOOL_NOT exp %prec UNARY
236 { pstate->wrap<unary_logical_not_operation> (); }
239 exp : '~' exp %prec UNARY
240 { pstate->wrap<unary_complement_operation> (); }
243 exp : SIZEOF exp %prec UNARY
244 { pstate->wrap<unop_sizeof_operation> (); }
247 exp : KIND '(' exp ')' %prec UNARY
248 { pstate->wrap<fortran_kind_operation> (); }
251 exp : UNOP_OR_BINOP_INTRINSIC '('
252 { pstate->start_arglist (); }
255 int n = pstate->end_arglist ();
256 gdb_assert (n == 1 || n == 2);
257 if ($1 == FORTRAN_ASSOCIATED)
260 pstate->wrap<fortran_associated_1arg> ();
262 pstate->wrap2<fortran_associated_2arg> ();
264 else if ($1 == FORTRAN_ARRAY_SIZE)
267 pstate->wrap<fortran_array_size_1arg> ();
269 pstate->wrap2<fortran_array_size_2arg> ();
273 std::vector<operation_up> args
274 = pstate->pop_vector (n);
275 gdb_assert ($1 == FORTRAN_LBOUND
276 || $1 == FORTRAN_UBOUND);
280 (new fortran_bound_1arg ($1,
281 std::move (args[0])));
284 (new fortran_bound_2arg ($1,
286 std::move (args[1])));
287 pstate->push (std::move (op));
294 { pstate->arglist_len = 1; }
296 { pstate->arglist_len = 2; }
299 /* No more explicit array operators, we treat everything in F77 as
300 a function call. The disambiguation as to whether we are
301 doing a subscript operation or a function call is done
305 { pstate->start_arglist (); }
308 std::vector<operation_up> args
309 = pstate->pop_vector (pstate->end_arglist ());
310 pstate->push_new<fortran_undetermined>
311 (pstate->pop (), std::move (args));
315 exp : UNOP_INTRINSIC '(' exp ')'
320 pstate->wrap<fortran_abs_operation> ();
322 case UNOP_FORTRAN_FLOOR:
323 pstate->wrap<fortran_floor_operation> ();
325 case UNOP_FORTRAN_CEILING:
326 pstate->wrap<fortran_ceil_operation> ();
328 case UNOP_FORTRAN_ALLOCATED:
329 pstate->wrap<fortran_allocated_operation> ();
331 case UNOP_FORTRAN_RANK:
332 pstate->wrap<fortran_rank_operation> ();
334 case UNOP_FORTRAN_SHAPE:
335 pstate->wrap<fortran_array_shape_operation> ();
337 case UNOP_FORTRAN_LOC:
338 pstate->wrap<fortran_loc_operation> ();
341 gdb_assert_not_reached ("unhandled intrinsic");
346 exp : BINOP_INTRINSIC '(' exp ',' exp ')'
351 pstate->wrap2<fortran_mod_operation> ();
353 case BINOP_FORTRAN_MODULO:
354 pstate->wrap2<fortran_modulo_operation> ();
356 case BINOP_FORTRAN_CMPLX:
357 pstate->wrap2<fortran_cmplx_operation> ();
360 gdb_assert_not_reached ("unhandled intrinsic");
369 { pstate->arglist_len = 1; }
373 { pstate->arglist_len = 1; }
376 arglist : arglist ',' exp %prec ABOVE_COMMA
377 { pstate->arglist_len++; }
380 arglist : arglist ',' subrange %prec ABOVE_COMMA
381 { pstate->arglist_len++; }
384 /* There are four sorts of subrange types in F90. */
386 subrange: exp ':' exp %prec ABOVE_COMMA
388 operation_up high = pstate->pop ();
389 operation_up low = pstate->pop ();
390 pstate->push_new<fortran_range_operation>
391 (RANGE_STANDARD, std::move (low),
392 std::move (high), operation_up ());
396 subrange: exp ':' %prec ABOVE_COMMA
398 operation_up low = pstate->pop ();
399 pstate->push_new<fortran_range_operation>
400 (RANGE_HIGH_BOUND_DEFAULT, std::move (low),
401 operation_up (), operation_up ());
405 subrange: ':' exp %prec ABOVE_COMMA
407 operation_up high = pstate->pop ();
408 pstate->push_new<fortran_range_operation>
409 (RANGE_LOW_BOUND_DEFAULT, operation_up (),
410 std::move (high), operation_up ());
414 subrange: ':' %prec ABOVE_COMMA
416 pstate->push_new<fortran_range_operation>
417 (RANGE_LOW_BOUND_DEFAULT
418 | RANGE_HIGH_BOUND_DEFAULT,
419 operation_up (), operation_up (),
424 /* And each of the four subrange types can also have a stride. */
425 subrange: exp ':' exp ':' exp %prec ABOVE_COMMA
427 operation_up stride = pstate->pop ();
428 operation_up high = pstate->pop ();
429 operation_up low = pstate->pop ();
430 pstate->push_new<fortran_range_operation>
431 (RANGE_STANDARD | RANGE_HAS_STRIDE,
432 std::move (low), std::move (high),
437 subrange: exp ':' ':' exp %prec ABOVE_COMMA
439 operation_up stride = pstate->pop ();
440 operation_up low = pstate->pop ();
441 pstate->push_new<fortran_range_operation>
442 (RANGE_HIGH_BOUND_DEFAULT
444 std::move (low), operation_up (),
449 subrange: ':' exp ':' exp %prec ABOVE_COMMA
451 operation_up stride = pstate->pop ();
452 operation_up high = pstate->pop ();
453 pstate->push_new<fortran_range_operation>
454 (RANGE_LOW_BOUND_DEFAULT
456 operation_up (), std::move (high),
461 subrange: ':' ':' exp %prec ABOVE_COMMA
463 operation_up stride = pstate->pop ();
464 pstate->push_new<fortran_range_operation>
465 (RANGE_LOW_BOUND_DEFAULT
466 | RANGE_HIGH_BOUND_DEFAULT
468 operation_up (), operation_up (),
473 complexnum: exp ',' exp
477 exp : '(' complexnum ')'
479 operation_up rhs = pstate->pop ();
480 operation_up lhs = pstate->pop ();
481 pstate->push_new<complex_operation>
482 (std::move (lhs), std::move (rhs),
483 parse_f_type (pstate)->builtin_complex_s16);
487 exp : '(' type ')' exp %prec UNARY
489 pstate->push_new<unop_cast_operation>
490 (pstate->pop (), $2);
496 pstate->push_new<fortran_structop_operation>
497 (pstate->pop (), copy_name ($3));
501 exp : exp '%' name COMPLETE
503 structop_base_operation *op
504 = new fortran_structop_operation (pstate->pop (),
506 pstate->mark_struct_expression (op);
507 pstate->push (operation_up (op));
511 exp : exp '%' COMPLETE
513 structop_base_operation *op
514 = new fortran_structop_operation (pstate->pop (),
516 pstate->mark_struct_expression (op);
517 pstate->push (operation_up (op));
521 /* Binary operators in order of decreasing precedence. */
524 { pstate->wrap2<repeat_operation> (); }
527 exp : exp STARSTAR exp
528 { pstate->wrap2<exp_operation> (); }
532 { pstate->wrap2<mul_operation> (); }
536 { pstate->wrap2<div_operation> (); }
540 { pstate->wrap2<add_operation> (); }
544 { pstate->wrap2<sub_operation> (); }
548 { pstate->wrap2<lsh_operation> (); }
552 { pstate->wrap2<rsh_operation> (); }
556 { pstate->wrap2<equal_operation> (); }
559 exp : exp NOTEQUAL exp
560 { pstate->wrap2<notequal_operation> (); }
564 { pstate->wrap2<leq_operation> (); }
568 { pstate->wrap2<geq_operation> (); }
571 exp : exp LESSTHAN exp
572 { pstate->wrap2<less_operation> (); }
575 exp : exp GREATERTHAN exp
576 { pstate->wrap2<gtr_operation> (); }
580 { pstate->wrap2<bitwise_and_operation> (); }
584 { pstate->wrap2<bitwise_xor_operation> (); }
588 { pstate->wrap2<bitwise_ior_operation> (); }
591 exp : exp BOOL_AND exp
592 { pstate->wrap2<logical_and_operation> (); }
596 exp : exp BOOL_OR exp
597 { pstate->wrap2<logical_or_operation> (); }
601 { pstate->wrap2<assign_operation> (); }
604 exp : exp ASSIGN_MODIFY exp
606 operation_up rhs = pstate->pop ();
607 operation_up lhs = pstate->pop ();
608 pstate->push_new<assign_modify_operation>
609 ($2, std::move (lhs), std::move (rhs));
615 pstate->push_new<long_const_operation>
622 parse_number (pstate, $1.stoken.ptr,
623 $1.stoken.length, 0, &val);
624 pstate->push_new<long_const_operation>
633 std::copy (std::begin ($1.val), std::end ($1.val),
635 pstate->push_new<float_const_operation> ($1.type, data);
642 exp : DOLLAR_VARIABLE
643 { pstate->push_dollar ($1); }
646 exp : SIZEOF '(' type ')' %prec UNARY
648 $3 = check_typedef ($3);
649 pstate->push_new<long_const_operation>
650 (parse_f_type (pstate)->builtin_integer,
655 exp : BOOLEAN_LITERAL
656 { pstate->push_new<bool_operation> ($1); }
661 pstate->push_new<string_operation>
666 variable: name_not_typename
667 { struct block_symbol sym = $1.sym;
668 std::string name = copy_name ($1.stoken);
669 pstate->push_symbol (name.c_str (), sym);
680 /* This is where the interesting stuff happens. */
683 struct type *follow_type = $1;
684 struct type *range_type;
687 switch (type_stack->pop ())
693 follow_type = lookup_pointer_type (follow_type);
696 follow_type = lookup_lvalue_reference_type (follow_type);
699 array_size = type_stack->pop_int ();
700 if (array_size != -1)
703 create_static_range_type ((struct type *) NULL,
704 parse_f_type (pstate)
708 create_array_type ((struct type *) NULL,
709 follow_type, range_type);
712 follow_type = lookup_pointer_type (follow_type);
715 follow_type = lookup_function_type (follow_type);
719 int kind_val = type_stack->pop_int ();
721 = convert_to_kind_type (follow_type, kind_val);
730 { type_stack->push (tp_pointer); $$ = 0; }
732 { type_stack->push (tp_pointer); $$ = $2; }
734 { type_stack->push (tp_reference); $$ = 0; }
736 { type_stack->push (tp_reference); $$ = $2; }
740 direct_abs_decl: '(' abs_decl ')'
742 | '(' KIND '=' INT ')'
743 { push_kind_type ($4.val, $4.type); }
745 { push_kind_type ($2.val, $2.type); }
746 | direct_abs_decl func_mod
747 { type_stack->push (tp_function); }
749 { type_stack->push (tp_function); }
754 | '(' nonempty_typelist ')'
755 { free ($2); $$ = 0; }
758 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
762 { $$ = parse_f_type (pstate)->builtin_integer_s1; }
764 { $$ = parse_f_type (pstate)->builtin_integer_s2; }
766 { $$ = parse_f_type (pstate)->builtin_integer; }
768 { $$ = parse_f_type (pstate)->builtin_integer; }
770 { $$ = parse_f_type (pstate)->builtin_integer_s8; }
772 { $$ = parse_f_type (pstate)->builtin_character; }
774 { $$ = parse_f_type (pstate)->builtin_logical_s1; }
776 { $$ = parse_f_type (pstate)->builtin_logical_s2; }
778 { $$ = parse_f_type (pstate)->builtin_logical; }
780 { $$ = parse_f_type (pstate)->builtin_logical; }
782 { $$ = parse_f_type (pstate)->builtin_logical_s8; }
784 { $$ = parse_f_type (pstate)->builtin_real; }
786 { $$ = parse_f_type (pstate)->builtin_real; }
788 { $$ = parse_f_type (pstate)->builtin_real_s8; }
790 { $$ = parse_f_type (pstate)->builtin_real_s16; }
792 { $$ = parse_f_type (pstate)->builtin_complex; }
794 { $$ = parse_f_type (pstate)->builtin_complex; }
796 { $$ = parse_f_type (pstate)->builtin_complex_s8; }
797 | COMPLEX_S16_KEYWORD
798 { $$ = parse_f_type (pstate)->builtin_complex_s16; }
800 { $$ = parse_f_type (pstate)->builtin_real;}
802 { $$ = parse_f_type (pstate)->builtin_real_s8;}
803 | SINGLE COMPLEX_KEYWORD
804 { $$ = parse_f_type (pstate)->builtin_complex;}
805 | DOUBLE COMPLEX_KEYWORD
806 { $$ = parse_f_type (pstate)->builtin_complex_s8;}
811 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
812 $<ivec>$[0] = 1; /* Number of types in vector */
815 | nonempty_typelist ',' type
816 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
817 $$ = (struct type **) realloc ((char *) $1, len);
818 $$[$<ivec>$[0]] = $3;
829 name_not_typename : NAME
830 /* These would be useful if name_not_typename was useful, but it is just
831 a fake for "variable", so these cause reduce/reduce conflicts because
832 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
833 =exp) or just an exp. If name_not_typename was ever used in an lvalue
834 context where only a name could occur, this might be useful.
841 /* Take care of parsing a number (anything that starts with a digit).
842 Set yylval and return the token type; update lexptr.
843 LEN is the number of characters in it. */
845 /*** Needs some error checking for the float case ***/
848 parse_number (struct parser_state *par_state,
849 const char *p, int len, int parsed_float, YYSTYPE *putithere)
854 int base = input_radix;
858 struct type *signed_type;
859 struct type *unsigned_type;
863 /* It's a float since it contains a point or an exponent. */
864 /* [dD] is not understood as an exponent by parse_float,
869 for (tmp2 = tmp; *tmp2; ++tmp2)
870 if (*tmp2 == 'd' || *tmp2 == 'D')
873 /* FIXME: Should this use different types? */
874 putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
875 bool parsed = parse_float (tmp, len,
876 putithere->typed_val_float.type,
877 putithere->typed_val_float.val);
879 return parsed? FLOAT : ERROR;
882 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
883 if (p[0] == '0' && len > 1)
918 if (len == 0 && c == 'l')
920 else if (len == 0 && c == 'u')
925 if (c >= '0' && c <= '9')
927 else if (c >= 'a' && c <= 'f')
930 return ERROR; /* Char not a digit */
932 return ERROR; /* Invalid digit in this base */
936 /* Portably test for overflow (only works for nonzero values, so make
937 a second check for zero). */
938 if ((prevn >= n) && n != 0)
939 unsigned_p=1; /* Try something unsigned */
940 /* If range checking enabled, portably test for unsigned overflow. */
941 if (RANGE_CHECK && n != 0)
943 if ((unsigned_p && prevn >= n))
944 range_error (_("Overflow on numeric constant."));
949 /* If the number is too big to be an int, or it's got an l suffix
950 then it's a long. Work out if this has to be a long by
951 shifting right and seeing if anything remains, and the
952 target int size is different to the target long size.
954 In the expression below, we could have tested
955 (n >> gdbarch_int_bit (parse_gdbarch))
956 to see if it was zero,
957 but too many compilers warn about that, when ints and longs
958 are the same size. So we shift it twice, with fewer bits
959 each time, for the same result. */
961 if ((gdbarch_int_bit (par_state->gdbarch ())
962 != gdbarch_long_bit (par_state->gdbarch ())
964 >> (gdbarch_int_bit (par_state->gdbarch ())-2))) /* Avoid
968 high_bit = ((ULONGEST)1)
969 << (gdbarch_long_bit (par_state->gdbarch ())-1);
970 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
971 signed_type = parse_type (par_state)->builtin_long;
976 ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
977 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
978 signed_type = parse_type (par_state)->builtin_int;
981 putithere->typed_val.val = n;
983 /* If the high bit of the worked out type is set then this number
984 has to be unsigned. */
986 if (unsigned_p || (n & high_bit))
987 putithere->typed_val.type = unsigned_type;
989 putithere->typed_val.type = signed_type;
994 /* Called to setup the type stack when we encounter a '(kind=N)' type
995 modifier, performs some bounds checking on 'N' and then pushes this to
996 the type stack followed by the 'tp_kind' marker. */
998 push_kind_type (LONGEST val, struct type *type)
1002 if (type->is_unsigned ())
1004 ULONGEST uval = static_cast <ULONGEST> (val);
1006 error (_("kind value out of range"));
1007 ival = static_cast <int> (uval);
1011 if (val > INT_MAX || val < 0)
1012 error (_("kind value out of range"));
1013 ival = static_cast <int> (val);
1016 type_stack->push (ival);
1017 type_stack->push (tp_kind);
1020 /* Called when a type has a '(kind=N)' modifier after it, for example
1021 'character(kind=1)'. The BASETYPE is the type described by 'character'
1022 in our example, and KIND is the integer '1'. This function returns a
1023 new type that represents the basetype of a specific kind. */
1024 static struct type *
1025 convert_to_kind_type (struct type *basetype, int kind)
1027 if (basetype == parse_f_type (pstate)->builtin_character)
1029 /* Character of kind 1 is a special case, this is the same as the
1030 base character type. */
1032 return parse_f_type (pstate)->builtin_character;
1034 else if (basetype == parse_f_type (pstate)->builtin_complex)
1037 return parse_f_type (pstate)->builtin_complex;
1039 return parse_f_type (pstate)->builtin_complex_s8;
1040 else if (kind == 16)
1041 return parse_f_type (pstate)->builtin_complex_s16;
1043 else if (basetype == parse_f_type (pstate)->builtin_real)
1046 return parse_f_type (pstate)->builtin_real;
1048 return parse_f_type (pstate)->builtin_real_s8;
1049 else if (kind == 16)
1050 return parse_f_type (pstate)->builtin_real_s16;
1052 else if (basetype == parse_f_type (pstate)->builtin_logical)
1055 return parse_f_type (pstate)->builtin_logical_s1;
1057 return parse_f_type (pstate)->builtin_logical_s2;
1059 return parse_f_type (pstate)->builtin_logical;
1061 return parse_f_type (pstate)->builtin_logical_s8;
1063 else if (basetype == parse_f_type (pstate)->builtin_integer)
1066 return parse_f_type (pstate)->builtin_integer_s1;
1068 return parse_f_type (pstate)->builtin_integer_s2;
1070 return parse_f_type (pstate)->builtin_integer;
1072 return parse_f_type (pstate)->builtin_integer_s8;
1075 error (_("unsupported kind %d for type %s"),
1076 kind, TYPE_SAFE_NAME (basetype));
1078 /* Should never get here. */
1084 /* The string to match against. */
1087 /* The lexer token to return. */
1090 /* The expression opcode to embed within the token. */
1091 enum exp_opcode opcode;
1093 /* When this is true the string in OPER is matched exactly including
1094 case, when this is false OPER is matched case insensitively. */
1095 bool case_sensitive;
1098 /* List of Fortran operators. */
1100 static const struct token fortran_operators[] =
1102 { ".and.", BOOL_AND, OP_NULL, false },
1103 { ".or.", BOOL_OR, OP_NULL, false },
1104 { ".not.", BOOL_NOT, OP_NULL, false },
1105 { ".eq.", EQUAL, OP_NULL, false },
1106 { ".eqv.", EQUAL, OP_NULL, false },
1107 { ".neqv.", NOTEQUAL, OP_NULL, false },
1108 { ".xor.", NOTEQUAL, OP_NULL, false },
1109 { "==", EQUAL, OP_NULL, false },
1110 { ".ne.", NOTEQUAL, OP_NULL, false },
1111 { "/=", NOTEQUAL, OP_NULL, false },
1112 { ".le.", LEQ, OP_NULL, false },
1113 { "<=", LEQ, OP_NULL, false },
1114 { ".ge.", GEQ, OP_NULL, false },
1115 { ">=", GEQ, OP_NULL, false },
1116 { ".gt.", GREATERTHAN, OP_NULL, false },
1117 { ">", GREATERTHAN, OP_NULL, false },
1118 { ".lt.", LESSTHAN, OP_NULL, false },
1119 { "<", LESSTHAN, OP_NULL, false },
1120 { "**", STARSTAR, BINOP_EXP, false },
1123 /* Holds the Fortran representation of a boolean, and the integer value we
1124 substitute in when one of the matching strings is parsed. */
1125 struct f77_boolean_val
1127 /* The string representing a Fortran boolean. */
1130 /* The integer value to replace it with. */
1134 /* The set of Fortran booleans. These are matched case insensitively. */
1135 static const struct f77_boolean_val boolean_values[] =
1141 static const struct token f77_keywords[] =
1143 /* Historically these have always been lowercase only in GDB. */
1144 { "character", CHARACTER, OP_NULL, true },
1145 { "complex", COMPLEX_KEYWORD, OP_NULL, true },
1146 { "complex_4", COMPLEX_S4_KEYWORD, OP_NULL, true },
1147 { "complex_8", COMPLEX_S8_KEYWORD, OP_NULL, true },
1148 { "complex_16", COMPLEX_S16_KEYWORD, OP_NULL, true },
1149 { "integer_1", INT_S1_KEYWORD, OP_NULL, true },
1150 { "integer_2", INT_S2_KEYWORD, OP_NULL, true },
1151 { "integer_4", INT_S4_KEYWORD, OP_NULL, true },
1152 { "integer", INT_KEYWORD, OP_NULL, true },
1153 { "integer_8", INT_S8_KEYWORD, OP_NULL, true },
1154 { "logical_1", LOGICAL_S1_KEYWORD, OP_NULL, true },
1155 { "logical_2", LOGICAL_S2_KEYWORD, OP_NULL, true },
1156 { "logical", LOGICAL_KEYWORD, OP_NULL, true },
1157 { "logical_4", LOGICAL_S4_KEYWORD, OP_NULL, true },
1158 { "logical_8", LOGICAL_S8_KEYWORD, OP_NULL, true },
1159 { "real", REAL_KEYWORD, OP_NULL, true },
1160 { "real_4", REAL_S4_KEYWORD, OP_NULL, true },
1161 { "real_8", REAL_S8_KEYWORD, OP_NULL, true },
1162 { "real_16", REAL_S16_KEYWORD, OP_NULL, true },
1163 { "sizeof", SIZEOF, OP_NULL, true },
1164 { "single", SINGLE, OP_NULL, true },
1165 { "double", DOUBLE, OP_NULL, true },
1166 { "precision", PRECISION, OP_NULL, true },
1167 /* The following correspond to actual functions in Fortran and are case
1169 { "kind", KIND, OP_NULL, false },
1170 { "abs", UNOP_INTRINSIC, UNOP_ABS, false },
1171 { "mod", BINOP_INTRINSIC, BINOP_MOD, false },
1172 { "floor", UNOP_INTRINSIC, UNOP_FORTRAN_FLOOR, false },
1173 { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false },
1174 { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false },
1175 { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false },
1176 { "lbound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_LBOUND, false },
1177 { "ubound", UNOP_OR_BINOP_INTRINSIC, FORTRAN_UBOUND, false },
1178 { "allocated", UNOP_INTRINSIC, UNOP_FORTRAN_ALLOCATED, false },
1179 { "associated", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ASSOCIATED, false },
1180 { "rank", UNOP_INTRINSIC, UNOP_FORTRAN_RANK, false },
1181 { "size", UNOP_OR_BINOP_INTRINSIC, FORTRAN_ARRAY_SIZE, false },
1182 { "shape", UNOP_INTRINSIC, UNOP_FORTRAN_SHAPE, false },
1183 { "loc", UNOP_INTRINSIC, UNOP_FORTRAN_LOC, false },
1186 /* Implementation of a dynamically expandable buffer for processing input
1187 characters acquired through lexptr and building a value to return in
1188 yylval. Ripped off from ch-exp.y */
1190 static char *tempbuf; /* Current buffer contents */
1191 static int tempbufsize; /* Size of allocated buffer */
1192 static int tempbufindex; /* Current index into buffer */
1194 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
1196 #define CHECKBUF(size) \
1198 if (tempbufindex + (size) >= tempbufsize) \
1200 growbuf_by_size (size); \
1205 /* Grow the static temp buffer if necessary, including allocating the
1206 first one on demand. */
1209 growbuf_by_size (int count)
1213 growby = std::max (count, GROWBY_MIN_SIZE);
1214 tempbufsize += growby;
1215 if (tempbuf == NULL)
1216 tempbuf = (char *) malloc (tempbufsize);
1218 tempbuf = (char *) realloc (tempbuf, tempbufsize);
1221 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
1224 Recognize a string literal. A string literal is a nonzero sequence
1225 of characters enclosed in matching single quotes, except that
1226 a single character inside single quotes is a character literal, which
1227 we reject as a string literal. To embed the terminator character inside
1228 a string, it is simply doubled (I.E. 'this''is''one''string') */
1231 match_string_literal (void)
1233 const char *tokptr = pstate->lexptr;
1235 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1238 if (*tokptr == *pstate->lexptr)
1240 if (*(tokptr + 1) == *pstate->lexptr)
1245 tempbuf[tempbufindex++] = *tokptr;
1247 if (*tokptr == '\0' /* no terminator */
1248 || tempbufindex == 0) /* no string */
1252 tempbuf[tempbufindex] = '\0';
1253 yylval.sval.ptr = tempbuf;
1254 yylval.sval.length = tempbufindex;
1255 pstate->lexptr = ++tokptr;
1256 return STRING_LITERAL;
1260 /* This is set if a NAME token appeared at the very end of the input
1261 string, with no whitespace separating the name from the EOF. This
1262 is used only when parsing to do field name completion. */
1263 static bool saw_name_at_eof;
1265 /* This is set if the previously-returned token was a structure
1267 static bool last_was_structop;
1269 /* Read one token, getting characters through lexptr. */
1277 const char *tokstart;
1278 bool saw_structop = last_was_structop;
1280 last_was_structop = false;
1284 pstate->prev_lexptr = pstate->lexptr;
1286 tokstart = pstate->lexptr;
1288 /* First of all, let us make sure we are not dealing with the
1289 special tokens .true. and .false. which evaluate to 1 and 0. */
1291 if (*pstate->lexptr == '.')
1293 for (const auto &candidate : boolean_values)
1295 if (strncasecmp (tokstart, candidate.name,
1296 strlen (candidate.name)) == 0)
1298 pstate->lexptr += strlen (candidate.name);
1299 yylval.lval = candidate.value;
1300 return BOOLEAN_LITERAL;
1305 /* See if it is a Fortran operator. */
1306 for (const auto &candidate : fortran_operators)
1307 if (strncasecmp (tokstart, candidate.oper,
1308 strlen (candidate.oper)) == 0)
1310 gdb_assert (!candidate.case_sensitive);
1311 pstate->lexptr += strlen (candidate.oper);
1312 yylval.opcode = candidate.opcode;
1313 return candidate.token;
1316 switch (c = *tokstart)
1319 if (saw_name_at_eof)
1321 saw_name_at_eof = false;
1324 else if (pstate->parse_completion && saw_structop)
1335 token = match_string_literal ();
1346 if (paren_depth == 0)
1353 if (pstate->comma_terminates && paren_depth == 0)
1359 /* Might be a floating point number. */
1360 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1361 goto symbol; /* Nope, must be a symbol. */
1375 /* It's a number. */
1376 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1377 const char *p = tokstart;
1378 int hex = input_radix > 10;
1380 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1385 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1386 || p[1]=='d' || p[1]=='D'))
1394 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1395 got_dot = got_e = 1;
1396 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1397 got_dot = got_d = 1;
1398 else if (!hex && !got_dot && *p == '.')
1400 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1401 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1402 && (*p == '-' || *p == '+'))
1403 /* This is the sign of the exponent, not the end of the
1406 /* We will take any letters or digits. parse_number will
1407 complain if past the radix, or if L or U are not final. */
1408 else if ((*p < '0' || *p > '9')
1409 && ((*p < 'a' || *p > 'z')
1410 && (*p < 'A' || *p > 'Z')))
1413 toktype = parse_number (pstate, tokstart, p - tokstart,
1414 got_dot|got_e|got_d,
1416 if (toktype == ERROR)
1418 char *err_copy = (char *) alloca (p - tokstart + 1);
1420 memcpy (err_copy, tokstart, p - tokstart);
1421 err_copy[p - tokstart] = 0;
1422 error (_("Invalid number \"%s\"."), err_copy);
1429 last_was_structop = true;
1455 if (!(c == '_' || c == '$' || c ==':'
1456 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1457 /* We must have come across a bad character (e.g. ';'). */
1458 error (_("Invalid character '%c' in expression."), c);
1461 for (c = tokstart[namelen];
1462 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1463 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1464 c = tokstart[++namelen]);
1466 /* The token "if" terminates the expression and is NOT
1467 removed from the input stream. */
1469 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1472 pstate->lexptr += namelen;
1474 /* Catch specific keywords. */
1476 for (const auto &keyword : f77_keywords)
1477 if (strlen (keyword.oper) == namelen
1478 && ((!keyword.case_sensitive
1479 && strncasecmp (tokstart, keyword.oper, namelen) == 0)
1480 || (keyword.case_sensitive
1481 && strncmp (tokstart, keyword.oper, namelen) == 0)))
1483 yylval.opcode = keyword.opcode;
1484 return keyword.token;
1487 yylval.sval.ptr = tokstart;
1488 yylval.sval.length = namelen;
1490 if (*tokstart == '$')
1491 return DOLLAR_VARIABLE;
1493 /* Use token-type TYPENAME for symbols that happen to be defined
1494 currently as names of types; NAME for other symbols.
1495 The caller is not constrained to care about the distinction. */
1497 std::string tmp = copy_name (yylval.sval);
1498 struct block_symbol result;
1499 const enum domain_enum_tag lookup_domains[] =
1507 for (const auto &domain : lookup_domains)
1509 result = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1511 if (result.symbol && result.symbol->aclass () == LOC_TYPEDEF)
1513 yylval.tsym.type = result.symbol->type ();
1522 = language_lookup_primitive_type (pstate->language (),
1523 pstate->gdbarch (), tmp.c_str ());
1524 if (yylval.tsym.type != NULL)
1527 /* Input names that aren't symbols but ARE valid hex numbers,
1528 when the input radix permits them, can be names or numbers
1529 depending on the parse. Note we support radixes > 16 here. */
1531 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1532 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1534 YYSTYPE newlval; /* Its value is ignored. */
1535 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1538 yylval.ssym.sym = result;
1539 yylval.ssym.is_a_field_of_this = false;
1544 if (pstate->parse_completion && *pstate->lexptr == '\0')
1545 saw_name_at_eof = true;
1547 /* Any other kind of symbol */
1548 yylval.ssym.sym = result;
1549 yylval.ssym.is_a_field_of_this = false;
1555 f_language::parser (struct parser_state *par_state) const
1557 /* Setting up the parser state. */
1558 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1559 scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1561 gdb_assert (par_state != NULL);
1563 last_was_structop = false;
1564 saw_name_at_eof = false;
1567 struct type_stack stack;
1568 scoped_restore restore_type_stack = make_scoped_restore (&type_stack,
1571 int result = yyparse ();
1573 pstate->set_operation (pstate->pop ());
1578 yyerror (const char *msg)
1580 if (pstate->prev_lexptr)
1581 pstate->lexptr = pstate->prev_lexptr;
1583 error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);