1 /* YACC parser for Fortran expressions, for GDB.
2 Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001,
3 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 2 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, write to the Free Software
22 Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 Boston, MA 02110-1301, USA. */
25 /* This was blantantly ripped off the C expression parser, please
26 be aware of that as you look at its basic structure -FMB */
28 /* Parse a F77 expression from text in a string,
29 and return the result as a struct expression pointer.
30 That structure contains arithmetic operations in reverse polish,
31 with constants represented by operations that are followed by special data.
32 See expression.h for the details of the format.
33 What is important here is that it can be built up sequentially
34 during the process of parsing; the lower levels of the tree always
35 come first in the result.
37 Note that malloc's and realloc's in this file are transformed to
38 xmalloc and xrealloc respectively by the same sed command in the
39 makefile that remaps any other malloc/realloc inserted by the parser
40 generator. Doing this with #defines and trying to control the interaction
41 with include files (<malloc.h> and <stdlib.h> for example) just became
42 too messy, particularly when such includes can be inserted at random
43 times by the parser generator. */
48 #include "gdb_string.h"
49 #include "expression.h"
51 #include "parser-defs.h"
54 #include "bfd.h" /* Required by objfiles.h. */
55 #include "symfile.h" /* Required by objfiles.h. */
56 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
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
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
109 #define YYDEBUG 1 /* Default to yydebug support */
112 #define YYFPRINTF parser_fprintf
116 static int yylex (void);
118 void yyerror (char *);
120 static void growbuf_by_size (int);
122 static int match_string_literal (void);
126 /* Although the yacc "value" of an expression is not used,
127 since the result is stored in the structure being created,
128 other node types do have values. */
142 struct symtoken ssym;
145 enum exp_opcode opcode;
146 struct internalvar *ivar;
153 /* YYSTYPE gets defined by %union */
154 static int parse_number (char *, int, int, YYSTYPE *);
157 %type <voidval> exp type_exp start variable
158 %type <tval> type typebase
159 %type <tvec> nonempty_typelist
160 /* %type <bval> block */
162 /* Fancy type parsing. */
163 %type <voidval> func_mod direct_abs_decl abs_decl
166 %token <typed_val> INT
169 /* Both NAME and TYPENAME tokens represent symbols in the input,
170 and both convey their data as strings.
171 But a TYPENAME is a string that happens to be defined as a typedef
172 or builtin type name (such as int or char)
173 and a NAME is any other symbol.
174 Contexts where this distinction is not important can use the
175 nonterminal "name", which matches either NAME or TYPENAME. */
177 %token <sval> STRING_LITERAL
178 %token <lval> BOOLEAN_LITERAL
180 %token <tsym> TYPENAME
182 %type <ssym> name_not_typename
184 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
185 but which would parse as a valid number in the current input radix.
186 E.g. "c" when input_radix==16. Depending on the parse, it will be
187 turned into a name or into a number. */
189 %token <ssym> NAME_OR_INT
194 /* Special type cases, put in to allow the parser to distinguish different
196 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
197 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
198 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
199 %token BOOL_AND BOOL_OR BOOL_NOT
200 %token <lval> CHARACTER
202 %token <voidval> VARIABLE
204 %token <opcode> ASSIGN_MODIFY
208 %right '=' ASSIGN_MODIFY
217 %left LESSTHAN GREATERTHAN LEQ GEQ
235 { write_exp_elt_opcode(OP_TYPE);
236 write_exp_elt_type($1);
237 write_exp_elt_opcode(OP_TYPE); }
244 /* Expressions, not including the comma operator. */
245 exp : '*' exp %prec UNARY
246 { write_exp_elt_opcode (UNOP_IND); }
249 exp : '&' exp %prec UNARY
250 { write_exp_elt_opcode (UNOP_ADDR); }
253 exp : '-' exp %prec UNARY
254 { write_exp_elt_opcode (UNOP_NEG); }
257 exp : BOOL_NOT exp %prec UNARY
258 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
261 exp : '~' exp %prec UNARY
262 { write_exp_elt_opcode (UNOP_COMPLEMENT); }
265 exp : SIZEOF exp %prec UNARY
266 { write_exp_elt_opcode (UNOP_SIZEOF); }
269 /* No more explicit array operators, we treat everything in F77 as
270 a function call. The disambiguation as to whether we are
271 doing a subscript operation or a function call is done
275 { start_arglist (); }
277 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
278 write_exp_elt_longcst ((LONGEST) end_arglist ());
279 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
293 arglist : arglist ',' exp %prec ABOVE_COMMA
297 /* There are four sorts of subrange types in F90. */
299 subrange: exp ':' exp %prec ABOVE_COMMA
300 { write_exp_elt_opcode (OP_F90_RANGE);
301 write_exp_elt_longcst (NONE_BOUND_DEFAULT);
302 write_exp_elt_opcode (OP_F90_RANGE); }
305 subrange: exp ':' %prec ABOVE_COMMA
306 { write_exp_elt_opcode (OP_F90_RANGE);
307 write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
308 write_exp_elt_opcode (OP_F90_RANGE); }
311 subrange: ':' exp %prec ABOVE_COMMA
312 { write_exp_elt_opcode (OP_F90_RANGE);
313 write_exp_elt_longcst (LOW_BOUND_DEFAULT);
314 write_exp_elt_opcode (OP_F90_RANGE); }
317 subrange: ':' %prec ABOVE_COMMA
318 { write_exp_elt_opcode (OP_F90_RANGE);
319 write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
320 write_exp_elt_opcode (OP_F90_RANGE); }
323 complexnum: exp ',' exp
327 exp : '(' complexnum ')'
328 { write_exp_elt_opcode(OP_COMPLEX); }
331 exp : '(' type ')' exp %prec UNARY
332 { write_exp_elt_opcode (UNOP_CAST);
333 write_exp_elt_type ($2);
334 write_exp_elt_opcode (UNOP_CAST); }
338 { write_exp_elt_opcode (STRUCTOP_STRUCT);
339 write_exp_string ($3);
340 write_exp_elt_opcode (STRUCTOP_STRUCT); }
343 /* Binary operators in order of decreasing precedence. */
346 { write_exp_elt_opcode (BINOP_REPEAT); }
349 exp : exp STARSTAR exp
350 { write_exp_elt_opcode (BINOP_EXP); }
354 { write_exp_elt_opcode (BINOP_MUL); }
358 { write_exp_elt_opcode (BINOP_DIV); }
362 { write_exp_elt_opcode (BINOP_ADD); }
366 { write_exp_elt_opcode (BINOP_SUB); }
370 { write_exp_elt_opcode (BINOP_LSH); }
374 { write_exp_elt_opcode (BINOP_RSH); }
378 { write_exp_elt_opcode (BINOP_EQUAL); }
381 exp : exp NOTEQUAL exp
382 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
386 { write_exp_elt_opcode (BINOP_LEQ); }
390 { write_exp_elt_opcode (BINOP_GEQ); }
393 exp : exp LESSTHAN exp
394 { write_exp_elt_opcode (BINOP_LESS); }
397 exp : exp GREATERTHAN exp
398 { write_exp_elt_opcode (BINOP_GTR); }
402 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
406 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
410 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
413 exp : exp BOOL_AND exp
414 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
418 exp : exp BOOL_OR exp
419 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
423 { write_exp_elt_opcode (BINOP_ASSIGN); }
426 exp : exp ASSIGN_MODIFY exp
427 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
428 write_exp_elt_opcode ($2);
429 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
433 { write_exp_elt_opcode (OP_LONG);
434 write_exp_elt_type ($1.type);
435 write_exp_elt_longcst ((LONGEST)($1.val));
436 write_exp_elt_opcode (OP_LONG); }
441 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
442 write_exp_elt_opcode (OP_LONG);
443 write_exp_elt_type (val.typed_val.type);
444 write_exp_elt_longcst ((LONGEST)val.typed_val.val);
445 write_exp_elt_opcode (OP_LONG); }
449 { write_exp_elt_opcode (OP_DOUBLE);
450 write_exp_elt_type (builtin_type_f_real_s8);
451 write_exp_elt_dblcst ($1);
452 write_exp_elt_opcode (OP_DOUBLE); }
461 exp : SIZEOF '(' type ')' %prec UNARY
462 { write_exp_elt_opcode (OP_LONG);
463 write_exp_elt_type (builtin_type_f_integer);
465 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
466 write_exp_elt_opcode (OP_LONG); }
469 exp : BOOLEAN_LITERAL
470 { write_exp_elt_opcode (OP_BOOL);
471 write_exp_elt_longcst ((LONGEST) $1);
472 write_exp_elt_opcode (OP_BOOL);
478 write_exp_elt_opcode (OP_STRING);
479 write_exp_string ($1);
480 write_exp_elt_opcode (OP_STRING);
484 variable: name_not_typename
485 { struct symbol *sym = $1.sym;
489 if (symbol_read_needs_frame (sym))
491 if (innermost_block == 0 ||
492 contained_in (block_found,
494 innermost_block = block_found;
496 write_exp_elt_opcode (OP_VAR_VALUE);
497 /* We want to use the selected frame, not
498 another more inner frame which happens to
499 be in the same block. */
500 write_exp_elt_block (NULL);
501 write_exp_elt_sym (sym);
502 write_exp_elt_opcode (OP_VAR_VALUE);
507 struct minimal_symbol *msymbol;
508 char *arg = copy_name ($1.stoken);
511 lookup_minimal_symbol (arg, NULL, NULL);
513 write_exp_msymbol (msymbol);
514 else if (!have_full_symbols () && !have_partial_symbols ())
515 error ("No symbol table is loaded. Use the \"file\" command.");
517 error ("No symbol \"%s\" in current context.",
518 copy_name ($1.stoken));
530 /* This is where the interesting stuff happens. */
533 struct type *follow_type = $1;
534 struct type *range_type;
543 follow_type = lookup_pointer_type (follow_type);
546 follow_type = lookup_reference_type (follow_type);
549 array_size = pop_type_int ();
550 if (array_size != -1)
553 create_range_type ((struct type *) NULL,
554 builtin_type_f_integer, 0,
557 create_array_type ((struct type *) NULL,
558 follow_type, range_type);
561 follow_type = lookup_pointer_type (follow_type);
564 follow_type = lookup_function_type (follow_type);
572 { push_type (tp_pointer); $$ = 0; }
574 { push_type (tp_pointer); $$ = $2; }
576 { push_type (tp_reference); $$ = 0; }
578 { push_type (tp_reference); $$ = $2; }
582 direct_abs_decl: '(' abs_decl ')'
584 | direct_abs_decl func_mod
585 { push_type (tp_function); }
587 { push_type (tp_function); }
592 | '(' nonempty_typelist ')'
593 { free ($2); $$ = 0; }
596 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
600 { $$ = builtin_type_f_integer; }
602 { $$ = builtin_type_f_integer_s2; }
604 { $$ = builtin_type_f_character; }
606 { $$ = builtin_type_f_logical;}
608 { $$ = builtin_type_f_logical_s2;}
610 { $$ = builtin_type_f_logical_s1;}
612 { $$ = builtin_type_f_real;}
614 { $$ = builtin_type_f_real_s8;}
616 { $$ = builtin_type_f_real_s16;}
618 { $$ = builtin_type_f_complex_s8;}
619 | COMPLEX_S16_KEYWORD
620 { $$ = builtin_type_f_complex_s16;}
621 | COMPLEX_S32_KEYWORD
622 { $$ = builtin_type_f_complex_s32;}
627 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
628 $<ivec>$[0] = 1; /* Number of types in vector */
631 | nonempty_typelist ',' type
632 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
633 $$ = (struct type **) realloc ((char *) $1, len);
634 $$[$<ivec>$[0]] = $3;
642 name_not_typename : NAME
643 /* These would be useful if name_not_typename was useful, but it is just
644 a fake for "variable", so these cause reduce/reduce conflicts because
645 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
646 =exp) or just an exp. If name_not_typename was ever used in an lvalue
647 context where only a name could occur, this might be useful.
654 /* Take care of parsing a number (anything that starts with a digit).
655 Set yylval and return the token type; update lexptr.
656 LEN is the number of characters in it. */
658 /*** Needs some error checking for the float case ***/
661 parse_number (p, len, parsed_float, putithere)
670 int base = input_radix;
674 struct type *signed_type;
675 struct type *unsigned_type;
679 /* It's a float since it contains a point or an exponent. */
680 /* [dD] is not understood as an exponent by atof, change it to 'e'. */
684 for (tmp2 = tmp; *tmp2; ++tmp2)
685 if (*tmp2 == 'd' || *tmp2 == 'D')
687 putithere->dval = atof (tmp);
692 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
728 if (len == 0 && c == 'l')
730 else if (len == 0 && c == 'u')
735 if (c >= '0' && c <= '9')
737 else if (c >= 'a' && c <= 'f')
740 return ERROR; /* Char not a digit */
742 return ERROR; /* Invalid digit in this base */
746 /* Portably test for overflow (only works for nonzero values, so make
747 a second check for zero). */
748 if ((prevn >= n) && n != 0)
749 unsigned_p=1; /* Try something unsigned */
750 /* If range checking enabled, portably test for unsigned overflow. */
751 if (RANGE_CHECK && n != 0)
753 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
754 range_error("Overflow on numeric constant.");
759 /* If the number is too big to be an int, or it's got an l suffix
760 then it's a long. Work out if this has to be a long by
761 shifting right and and seeing if anything remains, and the
762 target int size is different to the target long size.
764 In the expression below, we could have tested
765 (n >> gdbarch_int_bit (current_gdbarch))
766 to see if it was zero,
767 but too many compilers warn about that, when ints and longs
768 are the same size. So we shift it twice, with fewer bits
769 each time, for the same result. */
771 if ((gdbarch_int_bit (current_gdbarch) != gdbarch_long_bit (current_gdbarch)
773 >> (gdbarch_int_bit (current_gdbarch)-2))) /* Avoid shift warning */
776 high_bit = ((ULONGEST)1) << (gdbarch_long_bit (current_gdbarch)-1);
777 unsigned_type = builtin_type_unsigned_long;
778 signed_type = builtin_type_long;
782 high_bit = ((ULONGEST)1) << (gdbarch_int_bit (current_gdbarch)-1);
783 unsigned_type = builtin_type_unsigned_int;
784 signed_type = builtin_type_int;
787 putithere->typed_val.val = n;
789 /* If the high bit of the worked out type is set then this number
790 has to be unsigned. */
792 if (unsigned_p || (n & high_bit))
793 putithere->typed_val.type = unsigned_type;
795 putithere->typed_val.type = signed_type;
804 enum exp_opcode opcode;
807 static const struct token dot_ops[] =
809 { ".and.", BOOL_AND, BINOP_END },
810 { ".AND.", BOOL_AND, BINOP_END },
811 { ".or.", BOOL_OR, BINOP_END },
812 { ".OR.", BOOL_OR, BINOP_END },
813 { ".not.", BOOL_NOT, BINOP_END },
814 { ".NOT.", BOOL_NOT, BINOP_END },
815 { ".eq.", EQUAL, BINOP_END },
816 { ".EQ.", EQUAL, BINOP_END },
817 { ".eqv.", EQUAL, BINOP_END },
818 { ".NEQV.", NOTEQUAL, BINOP_END },
819 { ".neqv.", NOTEQUAL, BINOP_END },
820 { ".EQV.", EQUAL, BINOP_END },
821 { ".ne.", NOTEQUAL, BINOP_END },
822 { ".NE.", NOTEQUAL, BINOP_END },
823 { ".le.", LEQ, BINOP_END },
824 { ".LE.", LEQ, BINOP_END },
825 { ".ge.", GEQ, BINOP_END },
826 { ".GE.", GEQ, BINOP_END },
827 { ".gt.", GREATERTHAN, BINOP_END },
828 { ".GT.", GREATERTHAN, BINOP_END },
829 { ".lt.", LESSTHAN, BINOP_END },
830 { ".LT.", LESSTHAN, BINOP_END },
834 struct f77_boolean_val
840 static const struct f77_boolean_val boolean_values[] =
849 static const struct token f77_keywords[] =
851 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
852 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
853 { "character", CHARACTER, BINOP_END },
854 { "integer_2", INT_S2_KEYWORD, BINOP_END },
855 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
856 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
857 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
858 { "integer", INT_KEYWORD, BINOP_END },
859 { "logical", LOGICAL_KEYWORD, BINOP_END },
860 { "real_16", REAL_S16_KEYWORD, BINOP_END },
861 { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
862 { "sizeof", SIZEOF, BINOP_END },
863 { "real_8", REAL_S8_KEYWORD, BINOP_END },
864 { "real", REAL_KEYWORD, BINOP_END },
868 /* Implementation of a dynamically expandable buffer for processing input
869 characters acquired through lexptr and building a value to return in
870 yylval. Ripped off from ch-exp.y */
872 static char *tempbuf; /* Current buffer contents */
873 static int tempbufsize; /* Size of allocated buffer */
874 static int tempbufindex; /* Current index into buffer */
876 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
878 #define CHECKBUF(size) \
880 if (tempbufindex + (size) >= tempbufsize) \
882 growbuf_by_size (size); \
887 /* Grow the static temp buffer if necessary, including allocating the first one
891 growbuf_by_size (count)
896 growby = max (count, GROWBY_MIN_SIZE);
897 tempbufsize += growby;
899 tempbuf = (char *) malloc (tempbufsize);
901 tempbuf = (char *) realloc (tempbuf, tempbufsize);
904 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
907 Recognize a string literal. A string literal is a nonzero sequence
908 of characters enclosed in matching single quotes, except that
909 a single character inside single quotes is a character literal, which
910 we reject as a string literal. To embed the terminator character inside
911 a string, it is simply doubled (I.E. 'this''is''one''string') */
914 match_string_literal ()
916 char *tokptr = lexptr;
918 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
921 if (*tokptr == *lexptr)
923 if (*(tokptr + 1) == *lexptr)
928 tempbuf[tempbufindex++] = *tokptr;
930 if (*tokptr == '\0' /* no terminator */
931 || tempbufindex == 0) /* no string */
935 tempbuf[tempbufindex] = '\0';
936 yylval.sval.ptr = tempbuf;
937 yylval.sval.length = tempbufindex;
939 return STRING_LITERAL;
943 /* Read one token, getting characters through lexptr. */
950 unsigned int i,token;
955 prev_lexptr = lexptr;
959 /* First of all, let us make sure we are not dealing with the
960 special tokens .true. and .false. which evaluate to 1 and 0. */
964 for (i = 0; boolean_values[i].name != NULL; i++)
966 if (strncmp (tokstart, boolean_values[i].name,
967 strlen (boolean_values[i].name)) == 0)
969 lexptr += strlen (boolean_values[i].name);
970 yylval.lval = boolean_values[i].value;
971 return BOOLEAN_LITERAL;
976 /* See if it is a special .foo. operator. */
978 for (i = 0; dot_ops[i].operator != NULL; i++)
979 if (strncmp (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)) == 0)
981 lexptr += strlen (dot_ops[i].operator);
982 yylval.opcode = dot_ops[i].opcode;
983 return dot_ops[i].token;
986 /* See if it is an exponentiation operator. */
988 if (strncmp (tokstart, "**", 2) == 0)
991 yylval.opcode = BINOP_EXP;
995 switch (c = *tokstart)
1007 token = match_string_literal ();
1018 if (paren_depth == 0)
1025 if (comma_terminates && paren_depth == 0)
1031 /* Might be a floating point number. */
1032 if (lexptr[1] < '0' || lexptr[1] > '9')
1033 goto symbol; /* Nope, must be a symbol. */
1034 /* FALL THRU into number case. */
1047 /* It's a number. */
1048 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1050 int hex = input_radix > 10;
1052 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1057 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1065 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1066 got_dot = got_e = 1;
1067 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1068 got_dot = got_d = 1;
1069 else if (!hex && !got_dot && *p == '.')
1071 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1072 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1073 && (*p == '-' || *p == '+'))
1074 /* This is the sign of the exponent, not the end of the
1077 /* We will take any letters or digits. parse_number will
1078 complain if past the radix, or if L or U are not final. */
1079 else if ((*p < '0' || *p > '9')
1080 && ((*p < 'a' || *p > 'z')
1081 && (*p < 'A' || *p > 'Z')))
1084 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
1086 if (toktype == ERROR)
1088 char *err_copy = (char *) alloca (p - tokstart + 1);
1090 memcpy (err_copy, tokstart, p - tokstart);
1091 err_copy[p - tokstart] = 0;
1092 error ("Invalid number \"%s\".", err_copy);
1123 if (!(c == '_' || c == '$'
1124 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1125 /* We must have come across a bad character (e.g. ';'). */
1126 error ("Invalid character '%c' in expression.", c);
1129 for (c = tokstart[namelen];
1130 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1131 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1132 c = tokstart[++namelen]);
1134 /* The token "if" terminates the expression and is NOT
1135 removed from the input stream. */
1137 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1142 /* Catch specific keywords. */
1144 for (i = 0; f77_keywords[i].operator != NULL; i++)
1145 if (strncmp (tokstart, f77_keywords[i].operator,
1146 strlen(f77_keywords[i].operator)) == 0)
1148 /* lexptr += strlen(f77_keywords[i].operator); */
1149 yylval.opcode = f77_keywords[i].opcode;
1150 return f77_keywords[i].token;
1153 yylval.sval.ptr = tokstart;
1154 yylval.sval.length = namelen;
1156 if (*tokstart == '$')
1158 write_dollar_variable (yylval.sval);
1162 /* Use token-type TYPENAME for symbols that happen to be defined
1163 currently as names of types; NAME for other symbols.
1164 The caller is not constrained to care about the distinction. */
1166 char *tmp = copy_name (yylval.sval);
1168 int is_a_field_of_this = 0;
1171 sym = lookup_symbol (tmp, expression_context_block,
1173 current_language->la_language == language_cplus
1174 ? &is_a_field_of_this : NULL);
1175 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1177 yylval.tsym.type = SYMBOL_TYPE (sym);
1181 = language_lookup_primitive_type_by_name (current_language,
1182 current_gdbarch, tmp);
1183 if (yylval.tsym.type != NULL)
1186 /* Input names that aren't symbols but ARE valid hex numbers,
1187 when the input radix permits them, can be names or numbers
1188 depending on the parse. Note we support radixes > 16 here. */
1190 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1191 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1193 YYSTYPE newlval; /* Its value is ignored. */
1194 hextype = parse_number (tokstart, namelen, 0, &newlval);
1197 yylval.ssym.sym = sym;
1198 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1203 /* Any other kind of symbol */
1204 yylval.ssym.sym = sym;
1205 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1215 lexptr = prev_lexptr;
1217 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);