2 /* YACC parser for Fortran expressions, for GDB.
3 Copyright (C) 1986-2019 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"
59 #define parse_type(ps) builtin_type (ps->gdbarch ())
60 #define parse_f_type(ps) builtin_f_type (ps->gdbarch ())
62 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
64 #define GDB_YY_REMAP_PREFIX f_
67 /* The state of the parser, used internally when we are parsing the
70 static struct parser_state *pstate = NULL;
72 /* Depth of parentheses. */
73 static int paren_depth;
75 /* The current type stack. */
76 static struct type_stack *type_stack;
80 static int yylex (void);
82 static void yyerror (const char *);
84 static void growbuf_by_size (int);
86 static int match_string_literal (void);
88 static void push_kind_type (LONGEST val, struct type *type);
90 static struct type *convert_to_kind_type (struct type *basetype, int kind);
94 /* Although the yacc "value" of an expression is not used,
95 since the result is stored in the structure being created,
96 other node types do have values. */
113 struct symtoken ssym;
115 enum exp_opcode opcode;
116 struct internalvar *ivar;
123 /* YYSTYPE gets defined by %union */
124 static int parse_number (struct parser_state *, const char *, int,
128 %type <voidval> exp type_exp start variable
129 %type <tval> type typebase
130 %type <tvec> nonempty_typelist
131 /* %type <bval> block */
133 /* Fancy type parsing. */
134 %type <voidval> func_mod direct_abs_decl abs_decl
137 %token <typed_val> INT
138 %token <typed_val_float> FLOAT
140 /* Both NAME and TYPENAME tokens represent symbols in the input,
141 and both convey their data as strings.
142 But a TYPENAME is a string that happens to be defined as a typedef
143 or builtin type name (such as int or char)
144 and a NAME is any other symbol.
145 Contexts where this distinction is not important can use the
146 nonterminal "name", which matches either NAME or TYPENAME. */
148 %token <sval> STRING_LITERAL
149 %token <lval> BOOLEAN_LITERAL
151 %token <tsym> TYPENAME
153 %type <ssym> name_not_typename
155 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
156 but which would parse as a valid number in the current input radix.
157 E.g. "c" when input_radix==16. Depending on the parse, it will be
158 turned into a name or into a number. */
160 %token <ssym> NAME_OR_INT
165 /* Special type cases, put in to allow the parser to distinguish different
167 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
168 %token LOGICAL_S8_KEYWORD
169 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
170 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
171 %token BOOL_AND BOOL_OR BOOL_NOT
172 %token <lval> CHARACTER
174 %token <voidval> DOLLAR_VARIABLE
176 %token <opcode> ASSIGN_MODIFY
177 %token <opcode> UNOP_INTRINSIC
181 %right '=' ASSIGN_MODIFY
190 %left LESSTHAN GREATERTHAN LEQ GEQ
208 { write_exp_elt_opcode (pstate, OP_TYPE);
209 write_exp_elt_type (pstate, $1);
210 write_exp_elt_opcode (pstate, OP_TYPE); }
217 /* Expressions, not including the comma operator. */
218 exp : '*' exp %prec UNARY
219 { write_exp_elt_opcode (pstate, UNOP_IND); }
222 exp : '&' exp %prec UNARY
223 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
226 exp : '-' exp %prec UNARY
227 { write_exp_elt_opcode (pstate, UNOP_NEG); }
230 exp : BOOL_NOT exp %prec UNARY
231 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
234 exp : '~' exp %prec UNARY
235 { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
238 exp : SIZEOF exp %prec UNARY
239 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
242 exp : KIND '(' exp ')' %prec UNARY
243 { write_exp_elt_opcode (pstate, UNOP_KIND); }
246 /* No more explicit array operators, we treat everything in F77 as
247 a function call. The disambiguation as to whether we are
248 doing a subscript operation or a function call is done
252 { pstate->start_arglist (); }
254 { write_exp_elt_opcode (pstate,
255 OP_F77_UNDETERMINED_ARGLIST);
256 write_exp_elt_longcst (pstate,
257 pstate->end_arglist ());
258 write_exp_elt_opcode (pstate,
259 OP_F77_UNDETERMINED_ARGLIST); }
262 exp : UNOP_INTRINSIC '(' exp ')'
263 { write_exp_elt_opcode (pstate, $1); }
270 { pstate->arglist_len = 1; }
274 { pstate->arglist_len = 1; }
277 arglist : arglist ',' exp %prec ABOVE_COMMA
278 { pstate->arglist_len++; }
281 /* There are four sorts of subrange types in F90. */
283 subrange: exp ':' exp %prec ABOVE_COMMA
284 { write_exp_elt_opcode (pstate, OP_RANGE);
285 write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
286 write_exp_elt_opcode (pstate, OP_RANGE); }
289 subrange: exp ':' %prec ABOVE_COMMA
290 { write_exp_elt_opcode (pstate, OP_RANGE);
291 write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
292 write_exp_elt_opcode (pstate, OP_RANGE); }
295 subrange: ':' exp %prec ABOVE_COMMA
296 { write_exp_elt_opcode (pstate, OP_RANGE);
297 write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
298 write_exp_elt_opcode (pstate, OP_RANGE); }
301 subrange: ':' %prec ABOVE_COMMA
302 { write_exp_elt_opcode (pstate, OP_RANGE);
303 write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
304 write_exp_elt_opcode (pstate, OP_RANGE); }
307 complexnum: exp ',' exp
311 exp : '(' complexnum ')'
312 { write_exp_elt_opcode (pstate, OP_COMPLEX);
313 write_exp_elt_type (pstate,
314 parse_f_type (pstate)
315 ->builtin_complex_s16);
316 write_exp_elt_opcode (pstate, OP_COMPLEX); }
319 exp : '(' type ')' exp %prec UNARY
320 { write_exp_elt_opcode (pstate, UNOP_CAST);
321 write_exp_elt_type (pstate, $2);
322 write_exp_elt_opcode (pstate, UNOP_CAST); }
326 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
327 write_exp_string (pstate, $3);
328 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
331 /* Binary operators in order of decreasing precedence. */
334 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
337 exp : exp STARSTAR exp
338 { write_exp_elt_opcode (pstate, BINOP_EXP); }
342 { write_exp_elt_opcode (pstate, BINOP_MUL); }
346 { write_exp_elt_opcode (pstate, BINOP_DIV); }
350 { write_exp_elt_opcode (pstate, BINOP_ADD); }
354 { write_exp_elt_opcode (pstate, BINOP_SUB); }
358 { write_exp_elt_opcode (pstate, BINOP_LSH); }
362 { write_exp_elt_opcode (pstate, BINOP_RSH); }
366 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
369 exp : exp NOTEQUAL exp
370 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
374 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
378 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
381 exp : exp LESSTHAN exp
382 { write_exp_elt_opcode (pstate, BINOP_LESS); }
385 exp : exp GREATERTHAN exp
386 { write_exp_elt_opcode (pstate, BINOP_GTR); }
390 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
394 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
398 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
401 exp : exp BOOL_AND exp
402 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
406 exp : exp BOOL_OR exp
407 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
411 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
414 exp : exp ASSIGN_MODIFY exp
415 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
416 write_exp_elt_opcode (pstate, $2);
417 write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
421 { write_exp_elt_opcode (pstate, OP_LONG);
422 write_exp_elt_type (pstate, $1.type);
423 write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
424 write_exp_elt_opcode (pstate, OP_LONG); }
429 parse_number (pstate, $1.stoken.ptr,
430 $1.stoken.length, 0, &val);
431 write_exp_elt_opcode (pstate, OP_LONG);
432 write_exp_elt_type (pstate, val.typed_val.type);
433 write_exp_elt_longcst (pstate,
434 (LONGEST)val.typed_val.val);
435 write_exp_elt_opcode (pstate, OP_LONG); }
439 { write_exp_elt_opcode (pstate, OP_FLOAT);
440 write_exp_elt_type (pstate, $1.type);
441 write_exp_elt_floatcst (pstate, $1.val);
442 write_exp_elt_opcode (pstate, OP_FLOAT); }
448 exp : DOLLAR_VARIABLE
451 exp : SIZEOF '(' type ')' %prec UNARY
452 { write_exp_elt_opcode (pstate, OP_LONG);
453 write_exp_elt_type (pstate,
454 parse_f_type (pstate)
456 $3 = check_typedef ($3);
457 write_exp_elt_longcst (pstate,
458 (LONGEST) TYPE_LENGTH ($3));
459 write_exp_elt_opcode (pstate, OP_LONG); }
462 exp : BOOLEAN_LITERAL
463 { write_exp_elt_opcode (pstate, OP_BOOL);
464 write_exp_elt_longcst (pstate, (LONGEST) $1);
465 write_exp_elt_opcode (pstate, OP_BOOL);
471 write_exp_elt_opcode (pstate, OP_STRING);
472 write_exp_string (pstate, $1);
473 write_exp_elt_opcode (pstate, OP_STRING);
477 variable: name_not_typename
478 { struct block_symbol sym = $1.sym;
482 if (symbol_read_needs_frame (sym.symbol))
483 pstate->block_tracker->update (sym);
484 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
485 write_exp_elt_block (pstate, sym.block);
486 write_exp_elt_sym (pstate, sym.symbol);
487 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
492 struct bound_minimal_symbol msymbol;
493 std::string arg = copy_name ($1.stoken);
496 lookup_bound_minimal_symbol (arg.c_str ());
497 if (msymbol.minsym != NULL)
498 write_exp_msymbol (pstate, msymbol);
499 else if (!have_full_symbols () && !have_partial_symbols ())
500 error (_("No symbol table is loaded. Use the \"file\" command."));
502 error (_("No symbol \"%s\" in current context."),
515 /* This is where the interesting stuff happens. */
518 struct type *follow_type = $1;
519 struct type *range_type;
522 switch (type_stack->pop ())
528 follow_type = lookup_pointer_type (follow_type);
531 follow_type = lookup_lvalue_reference_type (follow_type);
534 array_size = type_stack->pop_int ();
535 if (array_size != -1)
538 create_static_range_type ((struct type *) NULL,
539 parse_f_type (pstate)
543 create_array_type ((struct type *) NULL,
544 follow_type, range_type);
547 follow_type = lookup_pointer_type (follow_type);
550 follow_type = lookup_function_type (follow_type);
554 int kind_val = type_stack->pop_int ();
556 = convert_to_kind_type (follow_type, kind_val);
565 { type_stack->push (tp_pointer); $$ = 0; }
567 { type_stack->push (tp_pointer); $$ = $2; }
569 { type_stack->push (tp_reference); $$ = 0; }
571 { type_stack->push (tp_reference); $$ = $2; }
575 direct_abs_decl: '(' abs_decl ')'
577 | '(' KIND '=' INT ')'
578 { push_kind_type ($4.val, $4.type); }
580 { push_kind_type ($2.val, $2.type); }
581 | direct_abs_decl func_mod
582 { type_stack->push (tp_function); }
584 { type_stack->push (tp_function); }
589 | '(' nonempty_typelist ')'
590 { free ($2); $$ = 0; }
593 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
597 { $$ = parse_f_type (pstate)->builtin_integer; }
599 { $$ = parse_f_type (pstate)->builtin_integer_s2; }
601 { $$ = parse_f_type (pstate)->builtin_character; }
603 { $$ = parse_f_type (pstate)->builtin_logical_s8; }
605 { $$ = parse_f_type (pstate)->builtin_logical; }
607 { $$ = parse_f_type (pstate)->builtin_logical_s2; }
609 { $$ = parse_f_type (pstate)->builtin_logical_s1; }
611 { $$ = parse_f_type (pstate)->builtin_real; }
613 { $$ = parse_f_type (pstate)->builtin_real_s8; }
615 { $$ = parse_f_type (pstate)->builtin_real_s16; }
617 { $$ = parse_f_type (pstate)->builtin_complex_s8; }
618 | COMPLEX_S16_KEYWORD
619 { $$ = parse_f_type (pstate)->builtin_complex_s16; }
620 | COMPLEX_S32_KEYWORD
621 { $$ = parse_f_type (pstate)->builtin_complex_s32; }
626 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
627 $<ivec>$[0] = 1; /* Number of types in vector */
630 | nonempty_typelist ',' type
631 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
632 $$ = (struct type **) realloc ((char *) $1, len);
633 $$[$<ivec>$[0]] = $3;
641 name_not_typename : NAME
642 /* These would be useful if name_not_typename was useful, but it is just
643 a fake for "variable", so these cause reduce/reduce conflicts because
644 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
645 =exp) or just an exp. If name_not_typename was ever used in an lvalue
646 context where only a name could occur, this might be useful.
653 /* Take care of parsing a number (anything that starts with a digit).
654 Set yylval and return the token type; update lexptr.
655 LEN is the number of characters in it. */
657 /*** Needs some error checking for the float case ***/
660 parse_number (struct parser_state *par_state,
661 const char *p, int len, int parsed_float, YYSTYPE *putithere)
666 int base = input_radix;
670 struct type *signed_type;
671 struct type *unsigned_type;
675 /* It's a float since it contains a point or an exponent. */
676 /* [dD] is not understood as an exponent by parse_float,
681 for (tmp2 = tmp; *tmp2; ++tmp2)
682 if (*tmp2 == 'd' || *tmp2 == 'D')
685 /* FIXME: Should this use different types? */
686 putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
687 bool parsed = parse_float (tmp, len,
688 putithere->typed_val_float.type,
689 putithere->typed_val_float.val);
691 return parsed? FLOAT : ERROR;
694 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
730 if (len == 0 && c == 'l')
732 else if (len == 0 && c == 'u')
737 if (c >= '0' && c <= '9')
739 else if (c >= 'a' && c <= 'f')
742 return ERROR; /* Char not a digit */
744 return ERROR; /* Invalid digit in this base */
748 /* Portably test for overflow (only works for nonzero values, so make
749 a second check for zero). */
750 if ((prevn >= n) && n != 0)
751 unsigned_p=1; /* Try something unsigned */
752 /* If range checking enabled, portably test for unsigned overflow. */
753 if (RANGE_CHECK && n != 0)
755 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
756 range_error (_("Overflow on numeric constant."));
761 /* If the number is too big to be an int, or it's got an l suffix
762 then it's a long. Work out if this has to be a long by
763 shifting right and seeing if anything remains, and the
764 target int size is different to the target long size.
766 In the expression below, we could have tested
767 (n >> gdbarch_int_bit (parse_gdbarch))
768 to see if it was zero,
769 but too many compilers warn about that, when ints and longs
770 are the same size. So we shift it twice, with fewer bits
771 each time, for the same result. */
773 if ((gdbarch_int_bit (par_state->gdbarch ())
774 != gdbarch_long_bit (par_state->gdbarch ())
776 >> (gdbarch_int_bit (par_state->gdbarch ())-2))) /* Avoid
780 high_bit = ((ULONGEST)1)
781 << (gdbarch_long_bit (par_state->gdbarch ())-1);
782 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
783 signed_type = parse_type (par_state)->builtin_long;
788 ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
789 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
790 signed_type = parse_type (par_state)->builtin_int;
793 putithere->typed_val.val = n;
795 /* If the high bit of the worked out type is set then this number
796 has to be unsigned. */
798 if (unsigned_p || (n & high_bit))
799 putithere->typed_val.type = unsigned_type;
801 putithere->typed_val.type = signed_type;
806 /* Called to setup the type stack when we encounter a '(kind=N)' type
807 modifier, performs some bounds checking on 'N' and then pushes this to
808 the type stack followed by the 'tp_kind' marker. */
810 push_kind_type (LONGEST val, struct type *type)
814 if (TYPE_UNSIGNED (type))
816 ULONGEST uval = static_cast <ULONGEST> (val);
818 error (_("kind value out of range"));
819 ival = static_cast <int> (uval);
823 if (val > INT_MAX || val < 0)
824 error (_("kind value out of range"));
825 ival = static_cast <int> (val);
828 type_stack->push (ival);
829 type_stack->push (tp_kind);
832 /* Called when a type has a '(kind=N)' modifier after it, for example
833 'character(kind=1)'. The BASETYPE is the type described by 'character'
834 in our example, and KIND is the integer '1'. This function returns a
835 new type that represents the basetype of a specific kind. */
837 convert_to_kind_type (struct type *basetype, int kind)
839 if (basetype == parse_f_type (pstate)->builtin_character)
841 /* Character of kind 1 is a special case, this is the same as the
842 base character type. */
844 return parse_f_type (pstate)->builtin_character;
846 else if (basetype == parse_f_type (pstate)->builtin_complex_s8)
849 return parse_f_type (pstate)->builtin_complex_s8;
851 return parse_f_type (pstate)->builtin_complex_s16;
853 return parse_f_type (pstate)->builtin_complex_s32;
855 else if (basetype == parse_f_type (pstate)->builtin_real)
858 return parse_f_type (pstate)->builtin_real;
860 return parse_f_type (pstate)->builtin_real_s8;
862 return parse_f_type (pstate)->builtin_real_s16;
864 else if (basetype == parse_f_type (pstate)->builtin_logical)
867 return parse_f_type (pstate)->builtin_logical_s1;
869 return parse_f_type (pstate)->builtin_logical_s2;
871 return parse_f_type (pstate)->builtin_logical;
873 return parse_f_type (pstate)->builtin_logical_s8;
875 else if (basetype == parse_f_type (pstate)->builtin_integer)
878 return parse_f_type (pstate)->builtin_integer_s2;
880 return parse_f_type (pstate)->builtin_integer;
882 return parse_f_type (pstate)->builtin_integer_s8;
885 error (_("unsupported kind %d for type %s"),
886 kind, TYPE_SAFE_NAME (basetype));
888 /* Should never get here. */
894 /* The string to match against. */
897 /* The lexer token to return. */
900 /* The expression opcode to embed within the token. */
901 enum exp_opcode opcode;
903 /* When this is true the string in OPER is matched exactly including
904 case, when this is false OPER is matched case insensitively. */
908 static const struct token dot_ops[] =
910 { ".and.", BOOL_AND, BINOP_END, false },
911 { ".or.", BOOL_OR, BINOP_END, false },
912 { ".not.", BOOL_NOT, BINOP_END, false },
913 { ".eq.", EQUAL, BINOP_END, false },
914 { ".eqv.", EQUAL, BINOP_END, false },
915 { ".neqv.", NOTEQUAL, BINOP_END, false },
916 { ".ne.", NOTEQUAL, BINOP_END, false },
917 { ".le.", LEQ, BINOP_END, false },
918 { ".ge.", GEQ, BINOP_END, false },
919 { ".gt.", GREATERTHAN, BINOP_END, false },
920 { ".lt.", LESSTHAN, BINOP_END, false },
923 /* Holds the Fortran representation of a boolean, and the integer value we
924 substitute in when one of the matching strings is parsed. */
925 struct f77_boolean_val
927 /* The string representing a Fortran boolean. */
930 /* The integer value to replace it with. */
934 /* The set of Fortran booleans. These are matched case insensitively. */
935 static const struct f77_boolean_val boolean_values[] =
941 static const struct token f77_keywords[] =
943 /* Historically these have always been lowercase only in GDB. */
944 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
945 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
946 { "character", CHARACTER, BINOP_END, true },
947 { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
948 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
949 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
950 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
951 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
952 { "integer", INT_KEYWORD, BINOP_END, true },
953 { "logical", LOGICAL_KEYWORD, BINOP_END, true },
954 { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
955 { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
956 { "sizeof", SIZEOF, BINOP_END, true },
957 { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
958 { "real", REAL_KEYWORD, BINOP_END, true },
959 /* The following correspond to actual functions in Fortran and are case
961 { "kind", KIND, BINOP_END, false },
962 { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
965 /* Implementation of a dynamically expandable buffer for processing input
966 characters acquired through lexptr and building a value to return in
967 yylval. Ripped off from ch-exp.y */
969 static char *tempbuf; /* Current buffer contents */
970 static int tempbufsize; /* Size of allocated buffer */
971 static int tempbufindex; /* Current index into buffer */
973 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
975 #define CHECKBUF(size) \
977 if (tempbufindex + (size) >= tempbufsize) \
979 growbuf_by_size (size); \
984 /* Grow the static temp buffer if necessary, including allocating the
985 first one on demand. */
988 growbuf_by_size (int count)
992 growby = std::max (count, GROWBY_MIN_SIZE);
993 tempbufsize += growby;
995 tempbuf = (char *) malloc (tempbufsize);
997 tempbuf = (char *) realloc (tempbuf, tempbufsize);
1000 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
1003 Recognize a string literal. A string literal is a nonzero sequence
1004 of characters enclosed in matching single quotes, except that
1005 a single character inside single quotes is a character literal, which
1006 we reject as a string literal. To embed the terminator character inside
1007 a string, it is simply doubled (I.E. 'this''is''one''string') */
1010 match_string_literal (void)
1012 const char *tokptr = pstate->lexptr;
1014 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1017 if (*tokptr == *pstate->lexptr)
1019 if (*(tokptr + 1) == *pstate->lexptr)
1024 tempbuf[tempbufindex++] = *tokptr;
1026 if (*tokptr == '\0' /* no terminator */
1027 || tempbufindex == 0) /* no string */
1031 tempbuf[tempbufindex] = '\0';
1032 yylval.sval.ptr = tempbuf;
1033 yylval.sval.length = tempbufindex;
1034 pstate->lexptr = ++tokptr;
1035 return STRING_LITERAL;
1039 /* Read one token, getting characters through lexptr. */
1047 const char *tokstart;
1051 pstate->prev_lexptr = pstate->lexptr;
1053 tokstart = pstate->lexptr;
1055 /* First of all, let us make sure we are not dealing with the
1056 special tokens .true. and .false. which evaluate to 1 and 0. */
1058 if (*pstate->lexptr == '.')
1060 for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
1062 if (strncasecmp (tokstart, boolean_values[i].name,
1063 strlen (boolean_values[i].name)) == 0)
1065 pstate->lexptr += strlen (boolean_values[i].name);
1066 yylval.lval = boolean_values[i].value;
1067 return BOOLEAN_LITERAL;
1072 /* See if it is a special .foo. operator. */
1073 for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
1074 if (strncasecmp (tokstart, dot_ops[i].oper,
1075 strlen (dot_ops[i].oper)) == 0)
1077 gdb_assert (!dot_ops[i].case_sensitive);
1078 pstate->lexptr += strlen (dot_ops[i].oper);
1079 yylval.opcode = dot_ops[i].opcode;
1080 return dot_ops[i].token;
1083 /* See if it is an exponentiation operator. */
1085 if (strncmp (tokstart, "**", 2) == 0)
1087 pstate->lexptr += 2;
1088 yylval.opcode = BINOP_EXP;
1092 switch (c = *tokstart)
1104 token = match_string_literal ();
1115 if (paren_depth == 0)
1122 if (pstate->comma_terminates && paren_depth == 0)
1128 /* Might be a floating point number. */
1129 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1130 goto symbol; /* Nope, must be a symbol. */
1144 /* It's a number. */
1145 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1146 const char *p = tokstart;
1147 int hex = input_radix > 10;
1149 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1154 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1155 || p[1]=='d' || p[1]=='D'))
1163 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1164 got_dot = got_e = 1;
1165 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1166 got_dot = got_d = 1;
1167 else if (!hex && !got_dot && *p == '.')
1169 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1170 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1171 && (*p == '-' || *p == '+'))
1172 /* This is the sign of the exponent, not the end of the
1175 /* We will take any letters or digits. parse_number will
1176 complain if past the radix, or if L or U are not final. */
1177 else if ((*p < '0' || *p > '9')
1178 && ((*p < 'a' || *p > 'z')
1179 && (*p < 'A' || *p > 'Z')))
1182 toktype = parse_number (pstate, tokstart, p - tokstart,
1183 got_dot|got_e|got_d,
1185 if (toktype == ERROR)
1187 char *err_copy = (char *) alloca (p - tokstart + 1);
1189 memcpy (err_copy, tokstart, p - tokstart);
1190 err_copy[p - tokstart] = 0;
1191 error (_("Invalid number \"%s\"."), err_copy);
1222 if (!(c == '_' || c == '$' || c ==':'
1223 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1224 /* We must have come across a bad character (e.g. ';'). */
1225 error (_("Invalid character '%c' in expression."), c);
1228 for (c = tokstart[namelen];
1229 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1230 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1231 c = tokstart[++namelen]);
1233 /* The token "if" terminates the expression and is NOT
1234 removed from the input stream. */
1236 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1239 pstate->lexptr += namelen;
1241 /* Catch specific keywords. */
1243 for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
1244 if (strlen (f77_keywords[i].oper) == namelen
1245 && ((!f77_keywords[i].case_sensitive
1246 && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1247 || (f77_keywords[i].case_sensitive
1248 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
1250 yylval.opcode = f77_keywords[i].opcode;
1251 return f77_keywords[i].token;
1254 yylval.sval.ptr = tokstart;
1255 yylval.sval.length = namelen;
1257 if (*tokstart == '$')
1259 write_dollar_variable (pstate, yylval.sval);
1260 return DOLLAR_VARIABLE;
1263 /* Use token-type TYPENAME for symbols that happen to be defined
1264 currently as names of types; NAME for other symbols.
1265 The caller is not constrained to care about the distinction. */
1267 std::string tmp = copy_name (yylval.sval);
1268 struct block_symbol result;
1269 struct field_of_this_result is_a_field_of_this;
1270 enum domain_enum_tag lookup_domains[] =
1278 for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1280 /* Initialize this in case we *don't* use it in this call; that
1281 way we can refer to it unconditionally below. */
1282 memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
1284 result = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1286 pstate->language ()->la_language
1288 ? &is_a_field_of_this : NULL);
1289 if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
1291 yylval.tsym.type = SYMBOL_TYPE (result.symbol);
1300 = language_lookup_primitive_type (pstate->language (),
1301 pstate->gdbarch (), tmp.c_str ());
1302 if (yylval.tsym.type != NULL)
1305 /* Input names that aren't symbols but ARE valid hex numbers,
1306 when the input radix permits them, can be names or numbers
1307 depending on the parse. Note we support radixes > 16 here. */
1309 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1310 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1312 YYSTYPE newlval; /* Its value is ignored. */
1313 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1316 yylval.ssym.sym = result;
1317 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1322 /* Any other kind of symbol */
1323 yylval.ssym.sym = result;
1324 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1330 f_parse (struct parser_state *par_state)
1332 /* Setting up the parser state. */
1333 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1334 scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1336 gdb_assert (par_state != NULL);
1340 struct type_stack stack;
1341 scoped_restore restore_type_stack = make_scoped_restore (&type_stack,
1348 yyerror (const char *msg)
1350 if (pstate->prev_lexptr)
1351 pstate->lexptr = pstate->prev_lexptr;
1353 error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);