2 /* YACC parser for Fortran expressions, for GDB.
3 Copyright (C) 1986-2015 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 #define parse_type(ps) builtin_type (parse_gdbarch (ps))
58 #define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps))
60 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
61 as well as gratuitiously global symbol names, so we can have multiple
62 yacc generated parsers in gdb. Note that these are only the variables
63 produced by yacc. If other parser generators (bison, byacc, etc) produce
64 additional global names that conflict at link time, then those parser
65 generators need to be fixed instead of adding those names to this list. */
67 #define yymaxdepth f_maxdepth
68 #define yyparse f_parse_internal
70 #define yyerror f_error
73 #define yydebug f_debug
82 #define yyerrflag f_errflag
83 #define yynerrs f_nerrs
88 #define yystate f_state
94 #define yyreds f_reds /* With YYDEBUG defined */
95 #define yytoks f_toks /* With YYDEBUG defined */
96 #define yyname f_name /* With YYDEBUG defined */
97 #define yyrule f_rule /* With YYDEBUG defined */
100 #define yydefred f_yydefred
101 #define yydgoto f_yydgoto
102 #define yysindex f_yysindex
103 #define yyrindex f_yyrindex
104 #define yygindex f_yygindex
105 #define yytable f_yytable
106 #define yycheck f_yycheck
108 #define yysslim f_yysslim
109 #define yyssp f_yyssp
110 #define yystacksize f_yystacksize
112 #define yyvsp f_yyvsp
115 #define YYDEBUG 1 /* Default to yydebug support */
118 #define YYFPRINTF parser_fprintf
120 /* The state of the parser, used internally when we are parsing the
123 static struct parser_state *pstate = NULL;
127 static int yylex (void);
129 void yyerror (char *);
131 static void growbuf_by_size (int);
133 static int match_string_literal (void);
137 /* Although the yacc "value" of an expression is not used,
138 since the result is stored in the structure being created,
139 other node types do have values. */
153 struct symtoken ssym;
156 enum exp_opcode opcode;
157 struct internalvar *ivar;
164 /* YYSTYPE gets defined by %union */
165 static int parse_number (struct parser_state *, const char *, int,
169 %type <voidval> exp type_exp start variable
170 %type <tval> type typebase
171 %type <tvec> nonempty_typelist
172 /* %type <bval> block */
174 /* Fancy type parsing. */
175 %type <voidval> func_mod direct_abs_decl abs_decl
178 %token <typed_val> INT
181 /* Both NAME and TYPENAME tokens represent symbols in the input,
182 and both convey their data as strings.
183 But a TYPENAME is a string that happens to be defined as a typedef
184 or builtin type name (such as int or char)
185 and a NAME is any other symbol.
186 Contexts where this distinction is not important can use the
187 nonterminal "name", which matches either NAME or TYPENAME. */
189 %token <sval> STRING_LITERAL
190 %token <lval> BOOLEAN_LITERAL
192 %token <tsym> TYPENAME
194 %type <ssym> name_not_typename
196 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
197 but which would parse as a valid number in the current input radix.
198 E.g. "c" when input_radix==16. Depending on the parse, it will be
199 turned into a name or into a number. */
201 %token <ssym> NAME_OR_INT
206 /* Special type cases, put in to allow the parser to distinguish different
208 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
209 %token LOGICAL_S8_KEYWORD
210 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
211 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
212 %token BOOL_AND BOOL_OR BOOL_NOT
213 %token <lval> CHARACTER
215 %token <voidval> VARIABLE
217 %token <opcode> ASSIGN_MODIFY
221 %right '=' ASSIGN_MODIFY
230 %left LESSTHAN GREATERTHAN LEQ GEQ
248 { write_exp_elt_opcode (pstate, OP_TYPE);
249 write_exp_elt_type (pstate, $1);
250 write_exp_elt_opcode (pstate, OP_TYPE); }
257 /* Expressions, not including the comma operator. */
258 exp : '*' exp %prec UNARY
259 { write_exp_elt_opcode (pstate, UNOP_IND); }
262 exp : '&' exp %prec UNARY
263 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
266 exp : '-' exp %prec UNARY
267 { write_exp_elt_opcode (pstate, UNOP_NEG); }
270 exp : BOOL_NOT exp %prec UNARY
271 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
274 exp : '~' exp %prec UNARY
275 { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
278 exp : SIZEOF exp %prec UNARY
279 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
282 /* No more explicit array operators, we treat everything in F77 as
283 a function call. The disambiguation as to whether we are
284 doing a subscript operation or a function call is done
288 { start_arglist (); }
290 { write_exp_elt_opcode (pstate,
291 OP_F77_UNDETERMINED_ARGLIST);
292 write_exp_elt_longcst (pstate,
293 (LONGEST) end_arglist ());
294 write_exp_elt_opcode (pstate,
295 OP_F77_UNDETERMINED_ARGLIST); }
309 arglist : arglist ',' exp %prec ABOVE_COMMA
313 /* There are four sorts of subrange types in F90. */
315 subrange: exp ':' exp %prec ABOVE_COMMA
316 { write_exp_elt_opcode (pstate, OP_F90_RANGE);
317 write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
318 write_exp_elt_opcode (pstate, OP_F90_RANGE); }
321 subrange: exp ':' %prec ABOVE_COMMA
322 { write_exp_elt_opcode (pstate, OP_F90_RANGE);
323 write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
324 write_exp_elt_opcode (pstate, OP_F90_RANGE); }
327 subrange: ':' exp %prec ABOVE_COMMA
328 { write_exp_elt_opcode (pstate, OP_F90_RANGE);
329 write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
330 write_exp_elt_opcode (pstate, OP_F90_RANGE); }
333 subrange: ':' %prec ABOVE_COMMA
334 { write_exp_elt_opcode (pstate, OP_F90_RANGE);
335 write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
336 write_exp_elt_opcode (pstate, OP_F90_RANGE); }
339 complexnum: exp ',' exp
343 exp : '(' complexnum ')'
344 { write_exp_elt_opcode (pstate, OP_COMPLEX);
345 write_exp_elt_type (pstate,
346 parse_f_type (pstate)
347 ->builtin_complex_s16);
348 write_exp_elt_opcode (pstate, OP_COMPLEX); }
351 exp : '(' type ')' exp %prec UNARY
352 { write_exp_elt_opcode (pstate, UNOP_CAST);
353 write_exp_elt_type (pstate, $2);
354 write_exp_elt_opcode (pstate, UNOP_CAST); }
358 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
359 write_exp_string (pstate, $3);
360 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
363 /* Binary operators in order of decreasing precedence. */
366 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
369 exp : exp STARSTAR exp
370 { write_exp_elt_opcode (pstate, BINOP_EXP); }
374 { write_exp_elt_opcode (pstate, BINOP_MUL); }
378 { write_exp_elt_opcode (pstate, BINOP_DIV); }
382 { write_exp_elt_opcode (pstate, BINOP_ADD); }
386 { write_exp_elt_opcode (pstate, BINOP_SUB); }
390 { write_exp_elt_opcode (pstate, BINOP_LSH); }
394 { write_exp_elt_opcode (pstate, BINOP_RSH); }
398 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
401 exp : exp NOTEQUAL exp
402 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
406 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
410 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
413 exp : exp LESSTHAN exp
414 { write_exp_elt_opcode (pstate, BINOP_LESS); }
417 exp : exp GREATERTHAN exp
418 { write_exp_elt_opcode (pstate, BINOP_GTR); }
422 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
426 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
430 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
433 exp : exp BOOL_AND exp
434 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
438 exp : exp BOOL_OR exp
439 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
443 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
446 exp : exp ASSIGN_MODIFY exp
447 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
448 write_exp_elt_opcode (pstate, $2);
449 write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
453 { write_exp_elt_opcode (pstate, OP_LONG);
454 write_exp_elt_type (pstate, $1.type);
455 write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
456 write_exp_elt_opcode (pstate, OP_LONG); }
461 parse_number (pstate, $1.stoken.ptr,
462 $1.stoken.length, 0, &val);
463 write_exp_elt_opcode (pstate, OP_LONG);
464 write_exp_elt_type (pstate, val.typed_val.type);
465 write_exp_elt_longcst (pstate,
466 (LONGEST)val.typed_val.val);
467 write_exp_elt_opcode (pstate, OP_LONG); }
471 { write_exp_elt_opcode (pstate, OP_DOUBLE);
472 write_exp_elt_type (pstate,
473 parse_f_type (pstate)
475 write_exp_elt_dblcst (pstate, $1);
476 write_exp_elt_opcode (pstate, OP_DOUBLE); }
485 exp : SIZEOF '(' type ')' %prec UNARY
486 { write_exp_elt_opcode (pstate, OP_LONG);
487 write_exp_elt_type (pstate,
488 parse_f_type (pstate)
490 $3 = check_typedef ($3);
491 write_exp_elt_longcst (pstate,
492 (LONGEST) TYPE_LENGTH ($3));
493 write_exp_elt_opcode (pstate, OP_LONG); }
496 exp : BOOLEAN_LITERAL
497 { write_exp_elt_opcode (pstate, OP_BOOL);
498 write_exp_elt_longcst (pstate, (LONGEST) $1);
499 write_exp_elt_opcode (pstate, OP_BOOL);
505 write_exp_elt_opcode (pstate, OP_STRING);
506 write_exp_string (pstate, $1);
507 write_exp_elt_opcode (pstate, OP_STRING);
511 variable: name_not_typename
512 { struct symbol *sym = $1.sym;
516 if (symbol_read_needs_frame (sym))
518 if (innermost_block == 0
519 || contained_in (block_found,
521 innermost_block = block_found;
523 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
524 /* We want to use the selected frame, not
525 another more inner frame which happens to
526 be in the same block. */
527 write_exp_elt_block (pstate, NULL);
528 write_exp_elt_sym (pstate, sym);
529 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
534 struct bound_minimal_symbol msymbol;
535 char *arg = copy_name ($1.stoken);
538 lookup_bound_minimal_symbol (arg);
539 if (msymbol.minsym != NULL)
540 write_exp_msymbol (pstate, msymbol);
541 else if (!have_full_symbols () && !have_partial_symbols ())
542 error (_("No symbol table is loaded. Use the \"file\" command."));
544 error (_("No symbol \"%s\" in current context."),
545 copy_name ($1.stoken));
557 /* This is where the interesting stuff happens. */
560 struct type *follow_type = $1;
561 struct type *range_type;
570 follow_type = lookup_pointer_type (follow_type);
573 follow_type = lookup_reference_type (follow_type);
576 array_size = pop_type_int ();
577 if (array_size != -1)
580 create_static_range_type ((struct type *) NULL,
581 parse_f_type (pstate)
585 create_array_type ((struct type *) NULL,
586 follow_type, range_type);
589 follow_type = lookup_pointer_type (follow_type);
592 follow_type = lookup_function_type (follow_type);
600 { push_type (tp_pointer); $$ = 0; }
602 { push_type (tp_pointer); $$ = $2; }
604 { push_type (tp_reference); $$ = 0; }
606 { push_type (tp_reference); $$ = $2; }
610 direct_abs_decl: '(' abs_decl ')'
612 | direct_abs_decl func_mod
613 { push_type (tp_function); }
615 { push_type (tp_function); }
620 | '(' nonempty_typelist ')'
621 { free ($2); $$ = 0; }
624 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
628 { $$ = parse_f_type (pstate)->builtin_integer; }
630 { $$ = parse_f_type (pstate)->builtin_integer_s2; }
632 { $$ = parse_f_type (pstate)->builtin_character; }
634 { $$ = parse_f_type (pstate)->builtin_logical_s8; }
636 { $$ = parse_f_type (pstate)->builtin_logical; }
638 { $$ = parse_f_type (pstate)->builtin_logical_s2; }
640 { $$ = parse_f_type (pstate)->builtin_logical_s1; }
642 { $$ = parse_f_type (pstate)->builtin_real; }
644 { $$ = parse_f_type (pstate)->builtin_real_s8; }
646 { $$ = parse_f_type (pstate)->builtin_real_s16; }
648 { $$ = parse_f_type (pstate)->builtin_complex_s8; }
649 | COMPLEX_S16_KEYWORD
650 { $$ = parse_f_type (pstate)->builtin_complex_s16; }
651 | COMPLEX_S32_KEYWORD
652 { $$ = parse_f_type (pstate)->builtin_complex_s32; }
657 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
658 $<ivec>$[0] = 1; /* Number of types in vector */
661 | nonempty_typelist ',' type
662 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
663 $$ = (struct type **) realloc ((char *) $1, len);
664 $$[$<ivec>$[0]] = $3;
672 name_not_typename : NAME
673 /* These would be useful if name_not_typename was useful, but it is just
674 a fake for "variable", so these cause reduce/reduce conflicts because
675 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
676 =exp) or just an exp. If name_not_typename was ever used in an lvalue
677 context where only a name could occur, this might be useful.
684 /* Take care of parsing a number (anything that starts with a digit).
685 Set yylval and return the token type; update lexptr.
686 LEN is the number of characters in it. */
688 /*** Needs some error checking for the float case ***/
691 parse_number (struct parser_state *par_state,
692 const char *p, int len, int parsed_float, YYSTYPE *putithere)
697 int base = input_radix;
701 struct type *signed_type;
702 struct type *unsigned_type;
706 /* It's a float since it contains a point or an exponent. */
707 /* [dD] is not understood as an exponent by atof, change it to 'e'. */
711 for (tmp2 = tmp; *tmp2; ++tmp2)
712 if (*tmp2 == 'd' || *tmp2 == 'D')
714 putithere->dval = atof (tmp);
719 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
755 if (len == 0 && c == 'l')
757 else if (len == 0 && c == 'u')
762 if (c >= '0' && c <= '9')
764 else if (c >= 'a' && c <= 'f')
767 return ERROR; /* Char not a digit */
769 return ERROR; /* Invalid digit in this base */
773 /* Portably test for overflow (only works for nonzero values, so make
774 a second check for zero). */
775 if ((prevn >= n) && n != 0)
776 unsigned_p=1; /* Try something unsigned */
777 /* If range checking enabled, portably test for unsigned overflow. */
778 if (RANGE_CHECK && n != 0)
780 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
781 range_error (_("Overflow on numeric constant."));
786 /* If the number is too big to be an int, or it's got an l suffix
787 then it's a long. Work out if this has to be a long by
788 shifting right and seeing if anything remains, and the
789 target int size is different to the target long size.
791 In the expression below, we could have tested
792 (n >> gdbarch_int_bit (parse_gdbarch))
793 to see if it was zero,
794 but too many compilers warn about that, when ints and longs
795 are the same size. So we shift it twice, with fewer bits
796 each time, for the same result. */
798 if ((gdbarch_int_bit (parse_gdbarch (par_state))
799 != gdbarch_long_bit (parse_gdbarch (par_state))
801 >> (gdbarch_int_bit (parse_gdbarch (par_state))-2))) /* Avoid
805 high_bit = ((ULONGEST)1)
806 << (gdbarch_long_bit (parse_gdbarch (par_state))-1);
807 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
808 signed_type = parse_type (par_state)->builtin_long;
813 ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
814 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
815 signed_type = parse_type (par_state)->builtin_int;
818 putithere->typed_val.val = n;
820 /* If the high bit of the worked out type is set then this number
821 has to be unsigned. */
823 if (unsigned_p || (n & high_bit))
824 putithere->typed_val.type = unsigned_type;
826 putithere->typed_val.type = signed_type;
835 enum exp_opcode opcode;
838 static const struct token dot_ops[] =
840 { ".and.", BOOL_AND, BINOP_END },
841 { ".AND.", BOOL_AND, BINOP_END },
842 { ".or.", BOOL_OR, BINOP_END },
843 { ".OR.", BOOL_OR, BINOP_END },
844 { ".not.", BOOL_NOT, BINOP_END },
845 { ".NOT.", BOOL_NOT, BINOP_END },
846 { ".eq.", EQUAL, BINOP_END },
847 { ".EQ.", EQUAL, BINOP_END },
848 { ".eqv.", EQUAL, BINOP_END },
849 { ".NEQV.", NOTEQUAL, BINOP_END },
850 { ".neqv.", NOTEQUAL, BINOP_END },
851 { ".EQV.", EQUAL, BINOP_END },
852 { ".ne.", NOTEQUAL, BINOP_END },
853 { ".NE.", NOTEQUAL, BINOP_END },
854 { ".le.", LEQ, BINOP_END },
855 { ".LE.", LEQ, BINOP_END },
856 { ".ge.", GEQ, BINOP_END },
857 { ".GE.", GEQ, BINOP_END },
858 { ".gt.", GREATERTHAN, BINOP_END },
859 { ".GT.", GREATERTHAN, BINOP_END },
860 { ".lt.", LESSTHAN, BINOP_END },
861 { ".LT.", LESSTHAN, BINOP_END },
865 struct f77_boolean_val
871 static const struct f77_boolean_val boolean_values[] =
880 static const struct token f77_keywords[] =
882 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
883 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
884 { "character", CHARACTER, BINOP_END },
885 { "integer_2", INT_S2_KEYWORD, BINOP_END },
886 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
887 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
888 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END },
889 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
890 { "integer", INT_KEYWORD, BINOP_END },
891 { "logical", LOGICAL_KEYWORD, BINOP_END },
892 { "real_16", REAL_S16_KEYWORD, BINOP_END },
893 { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
894 { "sizeof", SIZEOF, BINOP_END },
895 { "real_8", REAL_S8_KEYWORD, BINOP_END },
896 { "real", REAL_KEYWORD, BINOP_END },
900 /* Implementation of a dynamically expandable buffer for processing input
901 characters acquired through lexptr and building a value to return in
902 yylval. Ripped off from ch-exp.y */
904 static char *tempbuf; /* Current buffer contents */
905 static int tempbufsize; /* Size of allocated buffer */
906 static int tempbufindex; /* Current index into buffer */
908 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
910 #define CHECKBUF(size) \
912 if (tempbufindex + (size) >= tempbufsize) \
914 growbuf_by_size (size); \
919 /* Grow the static temp buffer if necessary, including allocating the
920 first one on demand. */
923 growbuf_by_size (int count)
927 growby = max (count, GROWBY_MIN_SIZE);
928 tempbufsize += growby;
930 tempbuf = (char *) malloc (tempbufsize);
932 tempbuf = (char *) realloc (tempbuf, tempbufsize);
935 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
938 Recognize a string literal. A string literal is a nonzero sequence
939 of characters enclosed in matching single quotes, except that
940 a single character inside single quotes is a character literal, which
941 we reject as a string literal. To embed the terminator character inside
942 a string, it is simply doubled (I.E. 'this''is''one''string') */
945 match_string_literal (void)
947 const char *tokptr = lexptr;
949 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
952 if (*tokptr == *lexptr)
954 if (*(tokptr + 1) == *lexptr)
959 tempbuf[tempbufindex++] = *tokptr;
961 if (*tokptr == '\0' /* no terminator */
962 || tempbufindex == 0) /* no string */
966 tempbuf[tempbufindex] = '\0';
967 yylval.sval.ptr = tempbuf;
968 yylval.sval.length = tempbufindex;
970 return STRING_LITERAL;
974 /* Read one token, getting characters through lexptr. */
981 unsigned int i,token;
982 const char *tokstart;
986 prev_lexptr = lexptr;
990 /* First of all, let us make sure we are not dealing with the
991 special tokens .true. and .false. which evaluate to 1 and 0. */
995 for (i = 0; boolean_values[i].name != NULL; i++)
997 if (strncmp (tokstart, boolean_values[i].name,
998 strlen (boolean_values[i].name)) == 0)
1000 lexptr += strlen (boolean_values[i].name);
1001 yylval.lval = boolean_values[i].value;
1002 return BOOLEAN_LITERAL;
1007 /* See if it is a special .foo. operator. */
1009 for (i = 0; dot_ops[i].oper != NULL; i++)
1010 if (strncmp (tokstart, dot_ops[i].oper,
1011 strlen (dot_ops[i].oper)) == 0)
1013 lexptr += strlen (dot_ops[i].oper);
1014 yylval.opcode = dot_ops[i].opcode;
1015 return dot_ops[i].token;
1018 /* See if it is an exponentiation operator. */
1020 if (strncmp (tokstart, "**", 2) == 0)
1023 yylval.opcode = BINOP_EXP;
1027 switch (c = *tokstart)
1039 token = match_string_literal ();
1050 if (paren_depth == 0)
1057 if (comma_terminates && paren_depth == 0)
1063 /* Might be a floating point number. */
1064 if (lexptr[1] < '0' || lexptr[1] > '9')
1065 goto symbol; /* Nope, must be a symbol. */
1066 /* FALL THRU into number case. */
1079 /* It's a number. */
1080 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1081 const char *p = tokstart;
1082 int hex = input_radix > 10;
1084 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1089 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1090 || p[1]=='d' || p[1]=='D'))
1098 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1099 got_dot = got_e = 1;
1100 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1101 got_dot = got_d = 1;
1102 else if (!hex && !got_dot && *p == '.')
1104 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1105 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1106 && (*p == '-' || *p == '+'))
1107 /* This is the sign of the exponent, not the end of the
1110 /* We will take any letters or digits. parse_number will
1111 complain if past the radix, or if L or U are not final. */
1112 else if ((*p < '0' || *p > '9')
1113 && ((*p < 'a' || *p > 'z')
1114 && (*p < 'A' || *p > 'Z')))
1117 toktype = parse_number (pstate, tokstart, p - tokstart,
1118 got_dot|got_e|got_d,
1120 if (toktype == ERROR)
1122 char *err_copy = (char *) alloca (p - tokstart + 1);
1124 memcpy (err_copy, tokstart, p - tokstart);
1125 err_copy[p - tokstart] = 0;
1126 error (_("Invalid number \"%s\"."), err_copy);
1157 if (!(c == '_' || c == '$' || c ==':'
1158 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1159 /* We must have come across a bad character (e.g. ';'). */
1160 error (_("Invalid character '%c' in expression."), c);
1163 for (c = tokstart[namelen];
1164 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1165 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1166 c = tokstart[++namelen]);
1168 /* The token "if" terminates the expression and is NOT
1169 removed from the input stream. */
1171 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1176 /* Catch specific keywords. */
1178 for (i = 0; f77_keywords[i].oper != NULL; i++)
1179 if (strlen (f77_keywords[i].oper) == namelen
1180 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1182 /* lexptr += strlen(f77_keywords[i].operator); */
1183 yylval.opcode = f77_keywords[i].opcode;
1184 return f77_keywords[i].token;
1187 yylval.sval.ptr = tokstart;
1188 yylval.sval.length = namelen;
1190 if (*tokstart == '$')
1192 write_dollar_variable (pstate, yylval.sval);
1196 /* Use token-type TYPENAME for symbols that happen to be defined
1197 currently as names of types; NAME for other symbols.
1198 The caller is not constrained to care about the distinction. */
1200 char *tmp = copy_name (yylval.sval);
1202 struct field_of_this_result is_a_field_of_this;
1203 enum domain_enum_tag lookup_domains[] =
1212 for (i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1214 /* Initialize this in case we *don't* use it in this call; that
1215 way we can refer to it unconditionally below. */
1216 memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
1218 sym = lookup_symbol (tmp, expression_context_block,
1220 parse_language (pstate)->la_language
1221 == language_cplus ? &is_a_field_of_this : NULL);
1222 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1224 yylval.tsym.type = SYMBOL_TYPE (sym);
1233 = language_lookup_primitive_type (parse_language (pstate),
1234 parse_gdbarch (pstate), tmp);
1235 if (yylval.tsym.type != NULL)
1238 /* Input names that aren't symbols but ARE valid hex numbers,
1239 when the input radix permits them, can be names or numbers
1240 depending on the parse. Note we support radixes > 16 here. */
1242 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1243 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1245 YYSTYPE newlval; /* Its value is ignored. */
1246 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1249 yylval.ssym.sym = sym;
1250 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1255 /* Any other kind of symbol */
1256 yylval.ssym.sym = sym;
1257 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1263 f_parse (struct parser_state *par_state)
1266 struct cleanup *c = make_cleanup_clear_parser_state (&pstate);
1268 /* Setting up the parser state. */
1269 gdb_assert (par_state != NULL);
1272 result = yyparse ();
1281 lexptr = prev_lexptr;
1283 error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);