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, 2009
4 Free Software Foundation, Inc.
6 Contributed by Motorola. Adapted from the C parser by Farooq Butt
7 (fmbutt@engage.sps.mot.com).
9 This file is part of GDB.
11 This program is free software; you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation; either version 2 of the License, or
14 (at your option) any later version.
16 This program is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with this program; if not, write to the Free Software
23 Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 Boston, MA 02110-1301, USA. */
26 /* This was blantantly ripped off the C expression parser, please
27 be aware of that as you look at its basic structure -FMB */
29 /* Parse a F77 expression from text in a string,
30 and return the result as a struct expression pointer.
31 That structure contains arithmetic operations in reverse polish,
32 with constants represented by operations that are followed by special data.
33 See expression.h for the details of the format.
34 What is important here is that it can be built up sequentially
35 during the process of parsing; the lower levels of the tree always
36 come first in the result.
38 Note that malloc's and realloc's in this file are transformed to
39 xmalloc and xrealloc respectively by the same sed command in the
40 makefile that remaps any other malloc/realloc inserted by the parser
41 generator. Doing this with #defines and trying to control the interaction
42 with include files (<malloc.h> and <stdlib.h> for example) just became
43 too messy, particularly when such includes can be inserted at random
44 times by the parser generator. */
49 #include "gdb_string.h"
50 #include "expression.h"
52 #include "parser-defs.h"
55 #include "bfd.h" /* Required by objfiles.h. */
56 #include "symfile.h" /* Required by objfiles.h. */
57 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
61 #define parse_type builtin_type (parse_gdbarch)
62 #define parse_f_type builtin_f_type (parse_gdbarch)
64 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
65 as well as gratuitiously global symbol names, so we can have multiple
66 yacc generated parsers in gdb. Note that these are only the variables
67 produced by yacc. If other parser generators (bison, byacc, etc) produce
68 additional global names that conflict at link time, then those parser
69 generators need to be fixed instead of adding those names to this list. */
71 #define yymaxdepth f_maxdepth
72 #define yyparse f_parse
74 #define yyerror f_error
77 #define yydebug f_debug
86 #define yyerrflag f_errflag
87 #define yynerrs f_nerrs
92 #define yystate f_state
98 #define yyreds f_reds /* With YYDEBUG defined */
99 #define yytoks f_toks /* With YYDEBUG defined */
100 #define yyname f_name /* With YYDEBUG defined */
101 #define yyrule f_rule /* With YYDEBUG defined */
102 #define yylhs f_yylhs
103 #define yylen f_yylen
104 #define yydefred f_yydefred
105 #define yydgoto f_yydgoto
106 #define yysindex f_yysindex
107 #define yyrindex f_yyrindex
108 #define yygindex f_yygindex
109 #define yytable f_yytable
110 #define yycheck f_yycheck
113 #define YYDEBUG 1 /* Default to yydebug support */
116 #define YYFPRINTF parser_fprintf
120 static int yylex (void);
122 void yyerror (char *);
124 static void growbuf_by_size (int);
126 static int match_string_literal (void);
130 /* Although the yacc "value" of an expression is not used,
131 since the result is stored in the structure being created,
132 other node types do have values. */
146 struct symtoken ssym;
149 enum exp_opcode opcode;
150 struct internalvar *ivar;
157 /* YYSTYPE gets defined by %union */
158 static int parse_number (char *, int, int, YYSTYPE *);
161 %type <voidval> exp type_exp start variable
162 %type <tval> type typebase
163 %type <tvec> nonempty_typelist
164 /* %type <bval> block */
166 /* Fancy type parsing. */
167 %type <voidval> func_mod direct_abs_decl abs_decl
170 %token <typed_val> INT
173 /* Both NAME and TYPENAME tokens represent symbols in the input,
174 and both convey their data as strings.
175 But a TYPENAME is a string that happens to be defined as a typedef
176 or builtin type name (such as int or char)
177 and a NAME is any other symbol.
178 Contexts where this distinction is not important can use the
179 nonterminal "name", which matches either NAME or TYPENAME. */
181 %token <sval> STRING_LITERAL
182 %token <lval> BOOLEAN_LITERAL
184 %token <tsym> TYPENAME
186 %type <ssym> name_not_typename
188 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
189 but which would parse as a valid number in the current input radix.
190 E.g. "c" when input_radix==16. Depending on the parse, it will be
191 turned into a name or into a number. */
193 %token <ssym> NAME_OR_INT
198 /* Special type cases, put in to allow the parser to distinguish different
200 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
201 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
202 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
203 %token BOOL_AND BOOL_OR BOOL_NOT
204 %token <lval> CHARACTER
206 %token <voidval> VARIABLE
208 %token <opcode> ASSIGN_MODIFY
212 %right '=' ASSIGN_MODIFY
221 %left LESSTHAN GREATERTHAN LEQ GEQ
239 { write_exp_elt_opcode(OP_TYPE);
240 write_exp_elt_type($1);
241 write_exp_elt_opcode(OP_TYPE); }
248 /* Expressions, not including the comma operator. */
249 exp : '*' exp %prec UNARY
250 { write_exp_elt_opcode (UNOP_IND); }
253 exp : '&' exp %prec UNARY
254 { write_exp_elt_opcode (UNOP_ADDR); }
257 exp : '-' exp %prec UNARY
258 { write_exp_elt_opcode (UNOP_NEG); }
261 exp : BOOL_NOT exp %prec UNARY
262 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
265 exp : '~' exp %prec UNARY
266 { write_exp_elt_opcode (UNOP_COMPLEMENT); }
269 exp : SIZEOF exp %prec UNARY
270 { write_exp_elt_opcode (UNOP_SIZEOF); }
273 /* No more explicit array operators, we treat everything in F77 as
274 a function call. The disambiguation as to whether we are
275 doing a subscript operation or a function call is done
279 { start_arglist (); }
281 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
282 write_exp_elt_longcst ((LONGEST) end_arglist ());
283 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
297 arglist : arglist ',' exp %prec ABOVE_COMMA
301 /* There are four sorts of subrange types in F90. */
303 subrange: exp ':' exp %prec ABOVE_COMMA
304 { write_exp_elt_opcode (OP_F90_RANGE);
305 write_exp_elt_longcst (NONE_BOUND_DEFAULT);
306 write_exp_elt_opcode (OP_F90_RANGE); }
309 subrange: exp ':' %prec ABOVE_COMMA
310 { write_exp_elt_opcode (OP_F90_RANGE);
311 write_exp_elt_longcst (HIGH_BOUND_DEFAULT);
312 write_exp_elt_opcode (OP_F90_RANGE); }
315 subrange: ':' exp %prec ABOVE_COMMA
316 { write_exp_elt_opcode (OP_F90_RANGE);
317 write_exp_elt_longcst (LOW_BOUND_DEFAULT);
318 write_exp_elt_opcode (OP_F90_RANGE); }
321 subrange: ':' %prec ABOVE_COMMA
322 { write_exp_elt_opcode (OP_F90_RANGE);
323 write_exp_elt_longcst (BOTH_BOUND_DEFAULT);
324 write_exp_elt_opcode (OP_F90_RANGE); }
327 complexnum: exp ',' exp
331 exp : '(' complexnum ')'
332 { write_exp_elt_opcode(OP_COMPLEX);
333 write_exp_elt_type (parse_f_type->builtin_complex_s16);
334 write_exp_elt_opcode(OP_COMPLEX); }
337 exp : '(' type ')' exp %prec UNARY
338 { write_exp_elt_opcode (UNOP_CAST);
339 write_exp_elt_type ($2);
340 write_exp_elt_opcode (UNOP_CAST); }
344 { write_exp_elt_opcode (STRUCTOP_STRUCT);
345 write_exp_string ($3);
346 write_exp_elt_opcode (STRUCTOP_STRUCT); }
349 /* Binary operators in order of decreasing precedence. */
352 { write_exp_elt_opcode (BINOP_REPEAT); }
355 exp : exp STARSTAR exp
356 { write_exp_elt_opcode (BINOP_EXP); }
360 { write_exp_elt_opcode (BINOP_MUL); }
364 { write_exp_elt_opcode (BINOP_DIV); }
368 { write_exp_elt_opcode (BINOP_ADD); }
372 { write_exp_elt_opcode (BINOP_SUB); }
376 { write_exp_elt_opcode (BINOP_LSH); }
380 { write_exp_elt_opcode (BINOP_RSH); }
384 { write_exp_elt_opcode (BINOP_EQUAL); }
387 exp : exp NOTEQUAL exp
388 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
392 { write_exp_elt_opcode (BINOP_LEQ); }
396 { write_exp_elt_opcode (BINOP_GEQ); }
399 exp : exp LESSTHAN exp
400 { write_exp_elt_opcode (BINOP_LESS); }
403 exp : exp GREATERTHAN exp
404 { write_exp_elt_opcode (BINOP_GTR); }
408 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
412 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
416 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
419 exp : exp BOOL_AND exp
420 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
424 exp : exp BOOL_OR exp
425 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
429 { write_exp_elt_opcode (BINOP_ASSIGN); }
432 exp : exp ASSIGN_MODIFY exp
433 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
434 write_exp_elt_opcode ($2);
435 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
439 { write_exp_elt_opcode (OP_LONG);
440 write_exp_elt_type ($1.type);
441 write_exp_elt_longcst ((LONGEST)($1.val));
442 write_exp_elt_opcode (OP_LONG); }
447 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
448 write_exp_elt_opcode (OP_LONG);
449 write_exp_elt_type (val.typed_val.type);
450 write_exp_elt_longcst ((LONGEST)val.typed_val.val);
451 write_exp_elt_opcode (OP_LONG); }
455 { write_exp_elt_opcode (OP_DOUBLE);
456 write_exp_elt_type (parse_f_type->builtin_real_s8);
457 write_exp_elt_dblcst ($1);
458 write_exp_elt_opcode (OP_DOUBLE); }
467 exp : SIZEOF '(' type ')' %prec UNARY
468 { write_exp_elt_opcode (OP_LONG);
469 write_exp_elt_type (parse_f_type->builtin_integer);
471 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
472 write_exp_elt_opcode (OP_LONG); }
475 exp : BOOLEAN_LITERAL
476 { write_exp_elt_opcode (OP_BOOL);
477 write_exp_elt_longcst ((LONGEST) $1);
478 write_exp_elt_opcode (OP_BOOL);
484 write_exp_elt_opcode (OP_STRING);
485 write_exp_string ($1);
486 write_exp_elt_opcode (OP_STRING);
490 variable: name_not_typename
491 { struct symbol *sym = $1.sym;
495 if (symbol_read_needs_frame (sym))
497 if (innermost_block == 0 ||
498 contained_in (block_found,
500 innermost_block = block_found;
502 write_exp_elt_opcode (OP_VAR_VALUE);
503 /* We want to use the selected frame, not
504 another more inner frame which happens to
505 be in the same block. */
506 write_exp_elt_block (NULL);
507 write_exp_elt_sym (sym);
508 write_exp_elt_opcode (OP_VAR_VALUE);
513 struct minimal_symbol *msymbol;
514 char *arg = copy_name ($1.stoken);
517 lookup_minimal_symbol (arg, NULL, NULL);
519 write_exp_msymbol (msymbol);
520 else if (!have_full_symbols () && !have_partial_symbols ())
521 error ("No symbol table is loaded. Use the \"file\" command.");
523 error ("No symbol \"%s\" in current context.",
524 copy_name ($1.stoken));
536 /* This is where the interesting stuff happens. */
539 struct type *follow_type = $1;
540 struct type *range_type;
549 follow_type = lookup_pointer_type (follow_type);
552 follow_type = lookup_reference_type (follow_type);
555 array_size = pop_type_int ();
556 if (array_size != -1)
559 create_range_type ((struct type *) NULL,
560 parse_f_type->builtin_integer,
563 create_array_type ((struct type *) NULL,
564 follow_type, range_type);
567 follow_type = lookup_pointer_type (follow_type);
570 follow_type = lookup_function_type (follow_type);
578 { push_type (tp_pointer); $$ = 0; }
580 { push_type (tp_pointer); $$ = $2; }
582 { push_type (tp_reference); $$ = 0; }
584 { push_type (tp_reference); $$ = $2; }
588 direct_abs_decl: '(' abs_decl ')'
590 | direct_abs_decl func_mod
591 { push_type (tp_function); }
593 { push_type (tp_function); }
598 | '(' nonempty_typelist ')'
599 { free ($2); $$ = 0; }
602 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
606 { $$ = parse_f_type->builtin_integer; }
608 { $$ = parse_f_type->builtin_integer_s2; }
610 { $$ = parse_f_type->builtin_character; }
612 { $$ = parse_f_type->builtin_logical; }
614 { $$ = parse_f_type->builtin_logical_s2; }
616 { $$ = parse_f_type->builtin_logical_s1; }
618 { $$ = parse_f_type->builtin_real; }
620 { $$ = parse_f_type->builtin_real_s8; }
622 { $$ = parse_f_type->builtin_real_s16; }
624 { $$ = parse_f_type->builtin_complex_s8; }
625 | COMPLEX_S16_KEYWORD
626 { $$ = parse_f_type->builtin_complex_s16; }
627 | COMPLEX_S32_KEYWORD
628 { $$ = parse_f_type->builtin_complex_s32; }
633 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
634 $<ivec>$[0] = 1; /* Number of types in vector */
637 | nonempty_typelist ',' type
638 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
639 $$ = (struct type **) realloc ((char *) $1, len);
640 $$[$<ivec>$[0]] = $3;
648 name_not_typename : NAME
649 /* These would be useful if name_not_typename was useful, but it is just
650 a fake for "variable", so these cause reduce/reduce conflicts because
651 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
652 =exp) or just an exp. If name_not_typename was ever used in an lvalue
653 context where only a name could occur, this might be useful.
660 /* Take care of parsing a number (anything that starts with a digit).
661 Set yylval and return the token type; update lexptr.
662 LEN is the number of characters in it. */
664 /*** Needs some error checking for the float case ***/
667 parse_number (p, len, parsed_float, putithere)
676 int base = input_radix;
680 struct type *signed_type;
681 struct type *unsigned_type;
685 /* It's a float since it contains a point or an exponent. */
686 /* [dD] is not understood as an exponent by atof, change it to 'e'. */
690 for (tmp2 = tmp; *tmp2; ++tmp2)
691 if (*tmp2 == 'd' || *tmp2 == 'D')
693 putithere->dval = atof (tmp);
698 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
734 if (len == 0 && c == 'l')
736 else if (len == 0 && c == 'u')
741 if (c >= '0' && c <= '9')
743 else if (c >= 'a' && c <= 'f')
746 return ERROR; /* Char not a digit */
748 return ERROR; /* Invalid digit in this base */
752 /* Portably test for overflow (only works for nonzero values, so make
753 a second check for zero). */
754 if ((prevn >= n) && n != 0)
755 unsigned_p=1; /* Try something unsigned */
756 /* If range checking enabled, portably test for unsigned overflow. */
757 if (RANGE_CHECK && n != 0)
759 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
760 range_error("Overflow on numeric constant.");
765 /* If the number is too big to be an int, or it's got an l suffix
766 then it's a long. Work out if this has to be a long by
767 shifting right and and seeing if anything remains, and the
768 target int size is different to the target long size.
770 In the expression below, we could have tested
771 (n >> gdbarch_int_bit (parse_gdbarch))
772 to see if it was zero,
773 but too many compilers warn about that, when ints and longs
774 are the same size. So we shift it twice, with fewer bits
775 each time, for the same result. */
777 if ((gdbarch_int_bit (parse_gdbarch) != gdbarch_long_bit (parse_gdbarch)
779 >> (gdbarch_int_bit (parse_gdbarch)-2))) /* Avoid shift warning */
782 high_bit = ((ULONGEST)1) << (gdbarch_long_bit (parse_gdbarch)-1);
783 unsigned_type = parse_type->builtin_unsigned_long;
784 signed_type = parse_type->builtin_long;
788 high_bit = ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch)-1);
789 unsigned_type = parse_type->builtin_unsigned_int;
790 signed_type = parse_type->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;
810 enum exp_opcode opcode;
813 static const struct token dot_ops[] =
815 { ".and.", BOOL_AND, BINOP_END },
816 { ".AND.", BOOL_AND, BINOP_END },
817 { ".or.", BOOL_OR, BINOP_END },
818 { ".OR.", BOOL_OR, BINOP_END },
819 { ".not.", BOOL_NOT, BINOP_END },
820 { ".NOT.", BOOL_NOT, BINOP_END },
821 { ".eq.", EQUAL, BINOP_END },
822 { ".EQ.", EQUAL, BINOP_END },
823 { ".eqv.", EQUAL, BINOP_END },
824 { ".NEQV.", NOTEQUAL, BINOP_END },
825 { ".neqv.", NOTEQUAL, BINOP_END },
826 { ".EQV.", EQUAL, BINOP_END },
827 { ".ne.", NOTEQUAL, BINOP_END },
828 { ".NE.", NOTEQUAL, BINOP_END },
829 { ".le.", LEQ, BINOP_END },
830 { ".LE.", LEQ, BINOP_END },
831 { ".ge.", GEQ, BINOP_END },
832 { ".GE.", GEQ, BINOP_END },
833 { ".gt.", GREATERTHAN, BINOP_END },
834 { ".GT.", GREATERTHAN, BINOP_END },
835 { ".lt.", LESSTHAN, BINOP_END },
836 { ".LT.", LESSTHAN, BINOP_END },
840 struct f77_boolean_val
846 static const struct f77_boolean_val boolean_values[] =
855 static const struct token f77_keywords[] =
857 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
858 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
859 { "character", CHARACTER, BINOP_END },
860 { "integer_2", INT_S2_KEYWORD, BINOP_END },
861 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
862 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
863 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
864 { "integer", INT_KEYWORD, BINOP_END },
865 { "logical", LOGICAL_KEYWORD, BINOP_END },
866 { "real_16", REAL_S16_KEYWORD, BINOP_END },
867 { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
868 { "sizeof", SIZEOF, BINOP_END },
869 { "real_8", REAL_S8_KEYWORD, BINOP_END },
870 { "real", REAL_KEYWORD, BINOP_END },
874 /* Implementation of a dynamically expandable buffer for processing input
875 characters acquired through lexptr and building a value to return in
876 yylval. Ripped off from ch-exp.y */
878 static char *tempbuf; /* Current buffer contents */
879 static int tempbufsize; /* Size of allocated buffer */
880 static int tempbufindex; /* Current index into buffer */
882 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
884 #define CHECKBUF(size) \
886 if (tempbufindex + (size) >= tempbufsize) \
888 growbuf_by_size (size); \
893 /* Grow the static temp buffer if necessary, including allocating the first one
897 growbuf_by_size (count)
902 growby = max (count, GROWBY_MIN_SIZE);
903 tempbufsize += growby;
905 tempbuf = (char *) malloc (tempbufsize);
907 tempbuf = (char *) realloc (tempbuf, tempbufsize);
910 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
913 Recognize a string literal. A string literal is a nonzero sequence
914 of characters enclosed in matching single quotes, except that
915 a single character inside single quotes is a character literal, which
916 we reject as a string literal. To embed the terminator character inside
917 a string, it is simply doubled (I.E. 'this''is''one''string') */
920 match_string_literal ()
922 char *tokptr = lexptr;
924 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
927 if (*tokptr == *lexptr)
929 if (*(tokptr + 1) == *lexptr)
934 tempbuf[tempbufindex++] = *tokptr;
936 if (*tokptr == '\0' /* no terminator */
937 || tempbufindex == 0) /* no string */
941 tempbuf[tempbufindex] = '\0';
942 yylval.sval.ptr = tempbuf;
943 yylval.sval.length = tempbufindex;
945 return STRING_LITERAL;
949 /* Read one token, getting characters through lexptr. */
956 unsigned int i,token;
961 prev_lexptr = lexptr;
965 /* First of all, let us make sure we are not dealing with the
966 special tokens .true. and .false. which evaluate to 1 and 0. */
970 for (i = 0; boolean_values[i].name != NULL; i++)
972 if (strncmp (tokstart, boolean_values[i].name,
973 strlen (boolean_values[i].name)) == 0)
975 lexptr += strlen (boolean_values[i].name);
976 yylval.lval = boolean_values[i].value;
977 return BOOLEAN_LITERAL;
982 /* See if it is a special .foo. operator. */
984 for (i = 0; dot_ops[i].operator != NULL; i++)
985 if (strncmp (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)) == 0)
987 lexptr += strlen (dot_ops[i].operator);
988 yylval.opcode = dot_ops[i].opcode;
989 return dot_ops[i].token;
992 /* See if it is an exponentiation operator. */
994 if (strncmp (tokstart, "**", 2) == 0)
997 yylval.opcode = BINOP_EXP;
1001 switch (c = *tokstart)
1013 token = match_string_literal ();
1024 if (paren_depth == 0)
1031 if (comma_terminates && paren_depth == 0)
1037 /* Might be a floating point number. */
1038 if (lexptr[1] < '0' || lexptr[1] > '9')
1039 goto symbol; /* Nope, must be a symbol. */
1040 /* FALL THRU into number case. */
1053 /* It's a number. */
1054 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1056 int hex = input_radix > 10;
1058 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1063 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1071 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1072 got_dot = got_e = 1;
1073 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1074 got_dot = got_d = 1;
1075 else if (!hex && !got_dot && *p == '.')
1077 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1078 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1079 && (*p == '-' || *p == '+'))
1080 /* This is the sign of the exponent, not the end of the
1083 /* We will take any letters or digits. parse_number will
1084 complain if past the radix, or if L or U are not final. */
1085 else if ((*p < '0' || *p > '9')
1086 && ((*p < 'a' || *p > 'z')
1087 && (*p < 'A' || *p > 'Z')))
1090 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
1092 if (toktype == ERROR)
1094 char *err_copy = (char *) alloca (p - tokstart + 1);
1096 memcpy (err_copy, tokstart, p - tokstart);
1097 err_copy[p - tokstart] = 0;
1098 error ("Invalid number \"%s\".", err_copy);
1129 if (!(c == '_' || c == '$'
1130 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1131 /* We must have come across a bad character (e.g. ';'). */
1132 error ("Invalid character '%c' in expression.", c);
1135 for (c = tokstart[namelen];
1136 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1137 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1138 c = tokstart[++namelen]);
1140 /* The token "if" terminates the expression and is NOT
1141 removed from the input stream. */
1143 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1148 /* Catch specific keywords. */
1150 for (i = 0; f77_keywords[i].operator != NULL; i++)
1151 if (strncmp (tokstart, f77_keywords[i].operator,
1152 strlen(f77_keywords[i].operator)) == 0)
1154 /* lexptr += strlen(f77_keywords[i].operator); */
1155 yylval.opcode = f77_keywords[i].opcode;
1156 return f77_keywords[i].token;
1159 yylval.sval.ptr = tokstart;
1160 yylval.sval.length = namelen;
1162 if (*tokstart == '$')
1164 write_dollar_variable (yylval.sval);
1168 /* Use token-type TYPENAME for symbols that happen to be defined
1169 currently as names of types; NAME for other symbols.
1170 The caller is not constrained to care about the distinction. */
1172 char *tmp = copy_name (yylval.sval);
1174 int is_a_field_of_this = 0;
1177 sym = lookup_symbol (tmp, expression_context_block,
1179 parse_language->la_language == language_cplus
1180 ? &is_a_field_of_this : NULL);
1181 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1183 yylval.tsym.type = SYMBOL_TYPE (sym);
1187 = language_lookup_primitive_type_by_name (parse_language,
1188 parse_gdbarch, tmp);
1189 if (yylval.tsym.type != NULL)
1192 /* Input names that aren't symbols but ARE valid hex numbers,
1193 when the input radix permits them, can be names or numbers
1194 depending on the parse. Note we support radixes > 16 here. */
1196 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1197 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1199 YYSTYPE newlval; /* Its value is ignored. */
1200 hextype = parse_number (tokstart, namelen, 0, &newlval);
1203 yylval.ssym.sym = sym;
1204 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1209 /* Any other kind of symbol */
1210 yylval.ssym.sym = sym;
1211 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1221 lexptr = prev_lexptr;
1223 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);