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 */
58 #define parse_type(ps) builtin_type (parse_gdbarch (ps))
59 #define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps))
61 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
63 #define GDB_YY_REMAP_PREFIX f_
66 /* The state of the parser, used internally when we are parsing the
69 static struct parser_state *pstate = NULL;
73 static int yylex (void);
75 static void yyerror (const char *);
77 static void growbuf_by_size (int);
79 static int match_string_literal (void);
81 static void push_kind_type (LONGEST val, struct type *type);
83 static struct type *convert_to_kind_type (struct type *basetype, int kind);
87 /* Although the yacc "value" of an expression is not used,
88 since the result is stored in the structure being created,
89 other node types do have values. */
106 struct symtoken ssym;
109 enum exp_opcode opcode;
110 struct internalvar *ivar;
117 /* YYSTYPE gets defined by %union */
118 static int parse_number (struct parser_state *, const char *, int,
122 %type <voidval> exp type_exp start variable
123 %type <tval> type typebase
124 %type <tvec> nonempty_typelist
125 /* %type <bval> block */
127 /* Fancy type parsing. */
128 %type <voidval> func_mod direct_abs_decl abs_decl
131 %token <typed_val> INT
132 %token <typed_val_float> FLOAT
134 /* Both NAME and TYPENAME tokens represent symbols in the input,
135 and both convey their data as strings.
136 But a TYPENAME is a string that happens to be defined as a typedef
137 or builtin type name (such as int or char)
138 and a NAME is any other symbol.
139 Contexts where this distinction is not important can use the
140 nonterminal "name", which matches either NAME or TYPENAME. */
142 %token <sval> STRING_LITERAL
143 %token <lval> BOOLEAN_LITERAL
145 %token <tsym> TYPENAME
147 %type <ssym> name_not_typename
149 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
150 but which would parse as a valid number in the current input radix.
151 E.g. "c" when input_radix==16. Depending on the parse, it will be
152 turned into a name or into a number. */
154 %token <ssym> NAME_OR_INT
159 /* Special type cases, put in to allow the parser to distinguish different
161 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
162 %token LOGICAL_S8_KEYWORD
163 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
164 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
165 %token BOOL_AND BOOL_OR BOOL_NOT
166 %token <lval> CHARACTER
168 %token <voidval> DOLLAR_VARIABLE
170 %token <opcode> ASSIGN_MODIFY
174 %right '=' ASSIGN_MODIFY
183 %left LESSTHAN GREATERTHAN LEQ GEQ
201 { write_exp_elt_opcode (pstate, OP_TYPE);
202 write_exp_elt_type (pstate, $1);
203 write_exp_elt_opcode (pstate, OP_TYPE); }
210 /* Expressions, not including the comma operator. */
211 exp : '*' exp %prec UNARY
212 { write_exp_elt_opcode (pstate, UNOP_IND); }
215 exp : '&' exp %prec UNARY
216 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
219 exp : '-' exp %prec UNARY
220 { write_exp_elt_opcode (pstate, UNOP_NEG); }
223 exp : BOOL_NOT exp %prec UNARY
224 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
227 exp : '~' exp %prec UNARY
228 { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
231 exp : SIZEOF exp %prec UNARY
232 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
235 exp : KIND '(' exp ')' %prec UNARY
236 { write_exp_elt_opcode (pstate, UNOP_KIND); }
239 /* No more explicit array operators, we treat everything in F77 as
240 a function call. The disambiguation as to whether we are
241 doing a subscript operation or a function call is done
245 { start_arglist (); }
247 { write_exp_elt_opcode (pstate,
248 OP_F77_UNDETERMINED_ARGLIST);
249 write_exp_elt_longcst (pstate,
250 (LONGEST) end_arglist ());
251 write_exp_elt_opcode (pstate,
252 OP_F77_UNDETERMINED_ARGLIST); }
266 arglist : arglist ',' exp %prec ABOVE_COMMA
270 /* There are four sorts of subrange types in F90. */
272 subrange: exp ':' exp %prec ABOVE_COMMA
273 { write_exp_elt_opcode (pstate, OP_RANGE);
274 write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
275 write_exp_elt_opcode (pstate, OP_RANGE); }
278 subrange: exp ':' %prec ABOVE_COMMA
279 { write_exp_elt_opcode (pstate, OP_RANGE);
280 write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
281 write_exp_elt_opcode (pstate, OP_RANGE); }
284 subrange: ':' exp %prec ABOVE_COMMA
285 { write_exp_elt_opcode (pstate, OP_RANGE);
286 write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
287 write_exp_elt_opcode (pstate, OP_RANGE); }
290 subrange: ':' %prec ABOVE_COMMA
291 { write_exp_elt_opcode (pstate, OP_RANGE);
292 write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
293 write_exp_elt_opcode (pstate, OP_RANGE); }
296 complexnum: exp ',' exp
300 exp : '(' complexnum ')'
301 { write_exp_elt_opcode (pstate, OP_COMPLEX);
302 write_exp_elt_type (pstate,
303 parse_f_type (pstate)
304 ->builtin_complex_s16);
305 write_exp_elt_opcode (pstate, OP_COMPLEX); }
308 exp : '(' type ')' exp %prec UNARY
309 { write_exp_elt_opcode (pstate, UNOP_CAST);
310 write_exp_elt_type (pstate, $2);
311 write_exp_elt_opcode (pstate, UNOP_CAST); }
315 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
316 write_exp_string (pstate, $3);
317 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
320 /* Binary operators in order of decreasing precedence. */
323 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
326 exp : exp STARSTAR exp
327 { write_exp_elt_opcode (pstate, BINOP_EXP); }
331 { write_exp_elt_opcode (pstate, BINOP_MUL); }
335 { write_exp_elt_opcode (pstate, BINOP_DIV); }
339 { write_exp_elt_opcode (pstate, BINOP_ADD); }
343 { write_exp_elt_opcode (pstate, BINOP_SUB); }
347 { write_exp_elt_opcode (pstate, BINOP_LSH); }
351 { write_exp_elt_opcode (pstate, BINOP_RSH); }
355 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
358 exp : exp NOTEQUAL exp
359 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
363 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
367 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
370 exp : exp LESSTHAN exp
371 { write_exp_elt_opcode (pstate, BINOP_LESS); }
374 exp : exp GREATERTHAN exp
375 { write_exp_elt_opcode (pstate, BINOP_GTR); }
379 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
383 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
387 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
390 exp : exp BOOL_AND exp
391 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
395 exp : exp BOOL_OR exp
396 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
400 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
403 exp : exp ASSIGN_MODIFY exp
404 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
405 write_exp_elt_opcode (pstate, $2);
406 write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
410 { write_exp_elt_opcode (pstate, OP_LONG);
411 write_exp_elt_type (pstate, $1.type);
412 write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
413 write_exp_elt_opcode (pstate, OP_LONG); }
418 parse_number (pstate, $1.stoken.ptr,
419 $1.stoken.length, 0, &val);
420 write_exp_elt_opcode (pstate, OP_LONG);
421 write_exp_elt_type (pstate, val.typed_val.type);
422 write_exp_elt_longcst (pstate,
423 (LONGEST)val.typed_val.val);
424 write_exp_elt_opcode (pstate, OP_LONG); }
428 { write_exp_elt_opcode (pstate, OP_FLOAT);
429 write_exp_elt_type (pstate, $1.type);
430 write_exp_elt_floatcst (pstate, $1.val);
431 write_exp_elt_opcode (pstate, OP_FLOAT); }
437 exp : DOLLAR_VARIABLE
440 exp : SIZEOF '(' type ')' %prec UNARY
441 { write_exp_elt_opcode (pstate, OP_LONG);
442 write_exp_elt_type (pstate,
443 parse_f_type (pstate)
445 $3 = check_typedef ($3);
446 write_exp_elt_longcst (pstate,
447 (LONGEST) TYPE_LENGTH ($3));
448 write_exp_elt_opcode (pstate, OP_LONG); }
451 exp : BOOLEAN_LITERAL
452 { write_exp_elt_opcode (pstate, OP_BOOL);
453 write_exp_elt_longcst (pstate, (LONGEST) $1);
454 write_exp_elt_opcode (pstate, OP_BOOL);
460 write_exp_elt_opcode (pstate, OP_STRING);
461 write_exp_string (pstate, $1);
462 write_exp_elt_opcode (pstate, OP_STRING);
466 variable: name_not_typename
467 { struct block_symbol sym = $1.sym;
471 if (symbol_read_needs_frame (sym.symbol))
472 innermost_block.update (sym);
473 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
474 write_exp_elt_block (pstate, sym.block);
475 write_exp_elt_sym (pstate, sym.symbol);
476 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
481 struct bound_minimal_symbol msymbol;
482 char *arg = copy_name ($1.stoken);
485 lookup_bound_minimal_symbol (arg);
486 if (msymbol.minsym != NULL)
487 write_exp_msymbol (pstate, msymbol);
488 else if (!have_full_symbols () && !have_partial_symbols ())
489 error (_("No symbol table is loaded. Use the \"file\" command."));
491 error (_("No symbol \"%s\" in current context."),
492 copy_name ($1.stoken));
504 /* This is where the interesting stuff happens. */
507 struct type *follow_type = $1;
508 struct type *range_type;
517 follow_type = lookup_pointer_type (follow_type);
520 follow_type = lookup_lvalue_reference_type (follow_type);
523 array_size = pop_type_int ();
524 if (array_size != -1)
527 create_static_range_type ((struct type *) NULL,
528 parse_f_type (pstate)
532 create_array_type ((struct type *) NULL,
533 follow_type, range_type);
536 follow_type = lookup_pointer_type (follow_type);
539 follow_type = lookup_function_type (follow_type);
543 int kind_val = pop_type_int ();
545 = convert_to_kind_type (follow_type, kind_val);
554 { push_type (tp_pointer); $$ = 0; }
556 { push_type (tp_pointer); $$ = $2; }
558 { push_type (tp_reference); $$ = 0; }
560 { push_type (tp_reference); $$ = $2; }
564 direct_abs_decl: '(' abs_decl ')'
566 | '(' KIND '=' INT ')'
567 { push_kind_type ($4.val, $4.type); }
568 | direct_abs_decl func_mod
569 { push_type (tp_function); }
571 { push_type (tp_function); }
576 | '(' nonempty_typelist ')'
577 { free ($2); $$ = 0; }
580 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
584 { $$ = parse_f_type (pstate)->builtin_integer; }
586 { $$ = parse_f_type (pstate)->builtin_integer_s2; }
588 { $$ = parse_f_type (pstate)->builtin_character; }
590 { $$ = parse_f_type (pstate)->builtin_logical_s8; }
592 { $$ = parse_f_type (pstate)->builtin_logical; }
594 { $$ = parse_f_type (pstate)->builtin_logical_s2; }
596 { $$ = parse_f_type (pstate)->builtin_logical_s1; }
598 { $$ = parse_f_type (pstate)->builtin_real; }
600 { $$ = parse_f_type (pstate)->builtin_real_s8; }
602 { $$ = parse_f_type (pstate)->builtin_real_s16; }
604 { $$ = parse_f_type (pstate)->builtin_complex_s8; }
605 | COMPLEX_S16_KEYWORD
606 { $$ = parse_f_type (pstate)->builtin_complex_s16; }
607 | COMPLEX_S32_KEYWORD
608 { $$ = parse_f_type (pstate)->builtin_complex_s32; }
613 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
614 $<ivec>$[0] = 1; /* Number of types in vector */
617 | nonempty_typelist ',' type
618 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
619 $$ = (struct type **) realloc ((char *) $1, len);
620 $$[$<ivec>$[0]] = $3;
628 name_not_typename : NAME
629 /* These would be useful if name_not_typename was useful, but it is just
630 a fake for "variable", so these cause reduce/reduce conflicts because
631 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
632 =exp) or just an exp. If name_not_typename was ever used in an lvalue
633 context where only a name could occur, this might be useful.
640 /* Take care of parsing a number (anything that starts with a digit).
641 Set yylval and return the token type; update lexptr.
642 LEN is the number of characters in it. */
644 /*** Needs some error checking for the float case ***/
647 parse_number (struct parser_state *par_state,
648 const char *p, int len, int parsed_float, YYSTYPE *putithere)
653 int base = input_radix;
657 struct type *signed_type;
658 struct type *unsigned_type;
662 /* It's a float since it contains a point or an exponent. */
663 /* [dD] is not understood as an exponent by parse_float,
668 for (tmp2 = tmp; *tmp2; ++tmp2)
669 if (*tmp2 == 'd' || *tmp2 == 'D')
672 /* FIXME: Should this use different types? */
673 putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
674 bool parsed = parse_float (tmp, len,
675 putithere->typed_val_float.type,
676 putithere->typed_val_float.val);
678 return parsed? FLOAT : ERROR;
681 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
717 if (len == 0 && c == 'l')
719 else if (len == 0 && c == 'u')
724 if (c >= '0' && c <= '9')
726 else if (c >= 'a' && c <= 'f')
729 return ERROR; /* Char not a digit */
731 return ERROR; /* Invalid digit in this base */
735 /* Portably test for overflow (only works for nonzero values, so make
736 a second check for zero). */
737 if ((prevn >= n) && n != 0)
738 unsigned_p=1; /* Try something unsigned */
739 /* If range checking enabled, portably test for unsigned overflow. */
740 if (RANGE_CHECK && n != 0)
742 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
743 range_error (_("Overflow on numeric constant."));
748 /* If the number is too big to be an int, or it's got an l suffix
749 then it's a long. Work out if this has to be a long by
750 shifting right and seeing if anything remains, and the
751 target int size is different to the target long size.
753 In the expression below, we could have tested
754 (n >> gdbarch_int_bit (parse_gdbarch))
755 to see if it was zero,
756 but too many compilers warn about that, when ints and longs
757 are the same size. So we shift it twice, with fewer bits
758 each time, for the same result. */
760 if ((gdbarch_int_bit (parse_gdbarch (par_state))
761 != gdbarch_long_bit (parse_gdbarch (par_state))
763 >> (gdbarch_int_bit (parse_gdbarch (par_state))-2))) /* Avoid
767 high_bit = ((ULONGEST)1)
768 << (gdbarch_long_bit (parse_gdbarch (par_state))-1);
769 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
770 signed_type = parse_type (par_state)->builtin_long;
775 ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
776 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
777 signed_type = parse_type (par_state)->builtin_int;
780 putithere->typed_val.val = n;
782 /* If the high bit of the worked out type is set then this number
783 has to be unsigned. */
785 if (unsigned_p || (n & high_bit))
786 putithere->typed_val.type = unsigned_type;
788 putithere->typed_val.type = signed_type;
793 /* Called to setup the type stack when we encounter a '(kind=N)' type
794 modifier, performs some bounds checking on 'N' and then pushes this to
795 the type stack followed by the 'tp_kind' marker. */
797 push_kind_type (LONGEST val, struct type *type)
801 if (TYPE_UNSIGNED (type))
803 ULONGEST uval = static_cast <ULONGEST> (val);
805 error (_("kind value out of range"));
806 ival = static_cast <int> (uval);
810 if (val > INT_MAX || val < 0)
811 error (_("kind value out of range"));
812 ival = static_cast <int> (val);
815 push_type_int (ival);
819 /* Called when a type has a '(kind=N)' modifier after it, for example
820 'character(kind=1)'. The BASETYPE is the type described by 'character'
821 in our example, and KIND is the integer '1'. This function returns a
822 new type that represents the basetype of a specific kind. */
824 convert_to_kind_type (struct type *basetype, int kind)
826 if (basetype == parse_f_type (pstate)->builtin_character)
828 /* Character of kind 1 is a special case, this is the same as the
829 base character type. */
831 return parse_f_type (pstate)->builtin_character;
834 error (_("unsupported kind %d for type %s"),
835 kind, TYPE_SAFE_NAME (basetype));
837 /* Should never get here. */
843 /* The string to match against. */
846 /* The lexer token to return. */
849 /* The expression opcode to embed within the token. */
850 enum exp_opcode opcode;
852 /* When this is true the string in OPER is matched exactly including
853 case, when this is false OPER is matched case insensitively. */
857 static const struct token dot_ops[] =
859 { ".and.", BOOL_AND, BINOP_END, false },
860 { ".or.", BOOL_OR, BINOP_END, false },
861 { ".not.", BOOL_NOT, BINOP_END, false },
862 { ".eq.", EQUAL, BINOP_END, false },
863 { ".eqv.", EQUAL, BINOP_END, false },
864 { ".neqv.", NOTEQUAL, BINOP_END, false },
865 { ".ne.", NOTEQUAL, BINOP_END, false },
866 { ".le.", LEQ, BINOP_END, false },
867 { ".ge.", GEQ, BINOP_END, false },
868 { ".gt.", GREATERTHAN, BINOP_END, false },
869 { ".lt.", LESSTHAN, BINOP_END, false },
872 /* Holds the Fortran representation of a boolean, and the integer value we
873 substitute in when one of the matching strings is parsed. */
874 struct f77_boolean_val
876 /* The string representing a Fortran boolean. */
879 /* The integer value to replace it with. */
883 /* The set of Fortran booleans. These are matched case insensitively. */
884 static const struct f77_boolean_val boolean_values[] =
890 static const struct token f77_keywords[] =
892 /* Historically these have always been lowercase only in GDB. */
893 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
894 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
895 { "character", CHARACTER, BINOP_END, true },
896 { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
897 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
898 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
899 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
900 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
901 { "integer", INT_KEYWORD, BINOP_END, true },
902 { "logical", LOGICAL_KEYWORD, BINOP_END, true },
903 { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
904 { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
905 { "sizeof", SIZEOF, BINOP_END, true },
906 { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
907 { "real", REAL_KEYWORD, BINOP_END, true },
908 /* The following correspond to actual functions in Fortran and are case
910 { "kind", KIND, BINOP_END, false }
913 /* Implementation of a dynamically expandable buffer for processing input
914 characters acquired through lexptr and building a value to return in
915 yylval. Ripped off from ch-exp.y */
917 static char *tempbuf; /* Current buffer contents */
918 static int tempbufsize; /* Size of allocated buffer */
919 static int tempbufindex; /* Current index into buffer */
921 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
923 #define CHECKBUF(size) \
925 if (tempbufindex + (size) >= tempbufsize) \
927 growbuf_by_size (size); \
932 /* Grow the static temp buffer if necessary, including allocating the
933 first one on demand. */
936 growbuf_by_size (int count)
940 growby = std::max (count, GROWBY_MIN_SIZE);
941 tempbufsize += growby;
943 tempbuf = (char *) malloc (tempbufsize);
945 tempbuf = (char *) realloc (tempbuf, tempbufsize);
948 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
951 Recognize a string literal. A string literal is a nonzero sequence
952 of characters enclosed in matching single quotes, except that
953 a single character inside single quotes is a character literal, which
954 we reject as a string literal. To embed the terminator character inside
955 a string, it is simply doubled (I.E. 'this''is''one''string') */
958 match_string_literal (void)
960 const char *tokptr = lexptr;
962 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
965 if (*tokptr == *lexptr)
967 if (*(tokptr + 1) == *lexptr)
972 tempbuf[tempbufindex++] = *tokptr;
974 if (*tokptr == '\0' /* no terminator */
975 || tempbufindex == 0) /* no string */
979 tempbuf[tempbufindex] = '\0';
980 yylval.sval.ptr = tempbuf;
981 yylval.sval.length = tempbufindex;
983 return STRING_LITERAL;
987 /* Read one token, getting characters through lexptr. */
995 const char *tokstart;
999 prev_lexptr = lexptr;
1003 /* First of all, let us make sure we are not dealing with the
1004 special tokens .true. and .false. which evaluate to 1 and 0. */
1008 for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
1010 if (strncasecmp (tokstart, boolean_values[i].name,
1011 strlen (boolean_values[i].name)) == 0)
1013 lexptr += strlen (boolean_values[i].name);
1014 yylval.lval = boolean_values[i].value;
1015 return BOOLEAN_LITERAL;
1020 /* See if it is a special .foo. operator. */
1021 for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
1022 if (strncasecmp (tokstart, dot_ops[i].oper,
1023 strlen (dot_ops[i].oper)) == 0)
1025 gdb_assert (!dot_ops[i].case_sensitive);
1026 lexptr += strlen (dot_ops[i].oper);
1027 yylval.opcode = dot_ops[i].opcode;
1028 return dot_ops[i].token;
1031 /* See if it is an exponentiation operator. */
1033 if (strncmp (tokstart, "**", 2) == 0)
1036 yylval.opcode = BINOP_EXP;
1040 switch (c = *tokstart)
1052 token = match_string_literal ();
1063 if (paren_depth == 0)
1070 if (comma_terminates && paren_depth == 0)
1076 /* Might be a floating point number. */
1077 if (lexptr[1] < '0' || lexptr[1] > '9')
1078 goto symbol; /* Nope, must be a symbol. */
1092 /* It's a number. */
1093 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1094 const char *p = tokstart;
1095 int hex = input_radix > 10;
1097 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1102 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1103 || p[1]=='d' || p[1]=='D'))
1111 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1112 got_dot = got_e = 1;
1113 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1114 got_dot = got_d = 1;
1115 else if (!hex && !got_dot && *p == '.')
1117 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1118 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1119 && (*p == '-' || *p == '+'))
1120 /* This is the sign of the exponent, not the end of the
1123 /* We will take any letters or digits. parse_number will
1124 complain if past the radix, or if L or U are not final. */
1125 else if ((*p < '0' || *p > '9')
1126 && ((*p < 'a' || *p > 'z')
1127 && (*p < 'A' || *p > 'Z')))
1130 toktype = parse_number (pstate, tokstart, p - tokstart,
1131 got_dot|got_e|got_d,
1133 if (toktype == ERROR)
1135 char *err_copy = (char *) alloca (p - tokstart + 1);
1137 memcpy (err_copy, tokstart, p - tokstart);
1138 err_copy[p - tokstart] = 0;
1139 error (_("Invalid number \"%s\"."), err_copy);
1170 if (!(c == '_' || c == '$' || c ==':'
1171 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1172 /* We must have come across a bad character (e.g. ';'). */
1173 error (_("Invalid character '%c' in expression."), c);
1176 for (c = tokstart[namelen];
1177 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1178 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1179 c = tokstart[++namelen]);
1181 /* The token "if" terminates the expression and is NOT
1182 removed from the input stream. */
1184 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1189 /* Catch specific keywords. */
1191 for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
1192 if (strlen (f77_keywords[i].oper) == namelen
1193 && ((!f77_keywords[i].case_sensitive
1194 && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1195 || (f77_keywords[i].case_sensitive
1196 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
1198 yylval.opcode = f77_keywords[i].opcode;
1199 return f77_keywords[i].token;
1202 yylval.sval.ptr = tokstart;
1203 yylval.sval.length = namelen;
1205 if (*tokstart == '$')
1207 write_dollar_variable (pstate, yylval.sval);
1208 return DOLLAR_VARIABLE;
1211 /* Use token-type TYPENAME for symbols that happen to be defined
1212 currently as names of types; NAME for other symbols.
1213 The caller is not constrained to care about the distinction. */
1215 char *tmp = copy_name (yylval.sval);
1216 struct block_symbol result;
1217 struct field_of_this_result is_a_field_of_this;
1218 enum domain_enum_tag lookup_domains[] =
1226 for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1228 /* Initialize this in case we *don't* use it in this call; that
1229 way we can refer to it unconditionally below. */
1230 memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
1232 result = lookup_symbol (tmp, expression_context_block,
1234 parse_language (pstate)->la_language
1236 ? &is_a_field_of_this : NULL);
1237 if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
1239 yylval.tsym.type = SYMBOL_TYPE (result.symbol);
1248 = language_lookup_primitive_type (parse_language (pstate),
1249 parse_gdbarch (pstate), tmp);
1250 if (yylval.tsym.type != NULL)
1253 /* Input names that aren't symbols but ARE valid hex numbers,
1254 when the input radix permits them, can be names or numbers
1255 depending on the parse. Note we support radixes > 16 here. */
1257 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1258 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1260 YYSTYPE newlval; /* Its value is ignored. */
1261 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1264 yylval.ssym.sym = result;
1265 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1270 /* Any other kind of symbol */
1271 yylval.ssym.sym = result;
1272 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1278 f_parse (struct parser_state *par_state)
1280 /* Setting up the parser state. */
1281 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1282 scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1284 gdb_assert (par_state != NULL);
1291 yyerror (const char *msg)
1294 lexptr = prev_lexptr;
1296 error (_("A %s in expression, near `%s'."), msg, lexptr);