1 /* YACC parser for Fortran expressions, for GDB.
2 Copyright 1986, 1989, 1990, 1991, 1993, 1994, 1995, 1996, 2000, 2001
3 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
24 /* This was blantantly ripped off the C expression parser, please
25 be aware of that as you look at its basic structure -FMB */
27 /* Parse a F77 expression from text in a string,
28 and return the result as a struct expression pointer.
29 That structure contains arithmetic operations in reverse polish,
30 with constants represented by operations that are followed by special data.
31 See expression.h for the details of the format.
32 What is important here is that it can be built up sequentially
33 during the process of parsing; the lower levels of the tree always
34 come first in the result.
36 Note that malloc's and realloc's in this file are transformed to
37 xmalloc and xrealloc respectively by the same sed command in the
38 makefile that remaps any other malloc/realloc inserted by the parser
39 generator. Doing this with #defines and trying to control the interaction
40 with include files (<malloc.h> and <stdlib.h> for example) just became
41 too messy, particularly when such includes can be inserted at random
42 times by the parser generator. */
47 #include "gdb_string.h"
48 #include "expression.h"
50 #include "parser-defs.h"
53 #include "bfd.h" /* Required by objfiles.h. */
54 #include "symfile.h" /* Required by objfiles.h. */
55 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
58 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
59 as well as gratuitiously global symbol names, so we can have multiple
60 yacc generated parsers in gdb. Note that these are only the variables
61 produced by yacc. If other parser generators (bison, byacc, etc) produce
62 additional global names that conflict at link time, then those parser
63 generators need to be fixed instead of adding those names to this list. */
65 #define yymaxdepth f_maxdepth
66 #define yyparse f_parse
68 #define yyerror f_error
71 #define yydebug f_debug
80 #define yyerrflag f_errflag
81 #define yynerrs f_nerrs
86 #define yystate f_state
92 #define yyreds f_reds /* With YYDEBUG defined */
93 #define yytoks f_toks /* With YYDEBUG defined */
94 #define yyname f_name /* With YYDEBUG defined */
95 #define yyrule f_rule /* With YYDEBUG defined */
98 #define yydefred f_yydefred
99 #define yydgoto f_yydgoto
100 #define yysindex f_yysindex
101 #define yyrindex f_yyrindex
102 #define yygindex f_yygindex
103 #define yytable f_yytable
104 #define yycheck f_yycheck
107 #define YYDEBUG 1 /* Default to yydebug support */
110 #define YYFPRINTF parser_fprintf
114 static int yylex (void);
116 void yyerror (char *);
118 static void growbuf_by_size (int);
120 static int match_string_literal (void);
124 /* Although the yacc "value" of an expression is not used,
125 since the result is stored in the structure being created,
126 other node types do have values. */
140 struct symtoken ssym;
143 enum exp_opcode opcode;
144 struct internalvar *ivar;
151 /* YYSTYPE gets defined by %union */
152 static int parse_number (char *, int, int, YYSTYPE *);
155 %type <voidval> exp type_exp start variable
156 %type <tval> type typebase
157 %type <tvec> nonempty_typelist
158 /* %type <bval> block */
160 /* Fancy type parsing. */
161 %type <voidval> func_mod direct_abs_decl abs_decl
164 %token <typed_val> INT
167 /* Both NAME and TYPENAME tokens represent symbols in the input,
168 and both convey their data as strings.
169 But a TYPENAME is a string that happens to be defined as a typedef
170 or builtin type name (such as int or char)
171 and a NAME is any other symbol.
172 Contexts where this distinction is not important can use the
173 nonterminal "name", which matches either NAME or TYPENAME. */
175 %token <sval> STRING_LITERAL
176 %token <lval> BOOLEAN_LITERAL
178 %token <tsym> TYPENAME
180 %type <ssym> name_not_typename
181 %type <tsym> typename
183 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
184 but which would parse as a valid number in the current input radix.
185 E.g. "c" when input_radix==16. Depending on the parse, it will be
186 turned into a name or into a number. */
188 %token <ssym> NAME_OR_INT
193 /* Special type cases, put in to allow the parser to distinguish different
195 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
196 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
197 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
198 %token BOOL_AND BOOL_OR BOOL_NOT
199 %token <lval> CHARACTER
201 %token <voidval> VARIABLE
203 %token <opcode> ASSIGN_MODIFY
207 %right '=' ASSIGN_MODIFY
216 %left LESSTHAN GREATERTHAN LEQ GEQ
232 { write_exp_elt_opcode(OP_TYPE);
233 write_exp_elt_type($1);
234 write_exp_elt_opcode(OP_TYPE); }
241 /* Expressions, not including the comma operator. */
242 exp : '*' exp %prec UNARY
243 { write_exp_elt_opcode (UNOP_IND); }
246 exp : '&' exp %prec UNARY
247 { write_exp_elt_opcode (UNOP_ADDR); }
250 exp : '-' exp %prec UNARY
251 { write_exp_elt_opcode (UNOP_NEG); }
254 exp : BOOL_NOT exp %prec UNARY
255 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
258 exp : '~' exp %prec UNARY
259 { write_exp_elt_opcode (UNOP_COMPLEMENT); }
262 exp : SIZEOF exp %prec UNARY
263 { write_exp_elt_opcode (UNOP_SIZEOF); }
266 /* No more explicit array operators, we treat everything in F77 as
267 a function call. The disambiguation as to whether we are
268 doing a subscript operation or a function call is done
272 { start_arglist (); }
274 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
275 write_exp_elt_longcst ((LONGEST) end_arglist ());
276 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
290 arglist : arglist ',' exp %prec ABOVE_COMMA
294 substring: exp ':' exp %prec ABOVE_COMMA
299 complexnum: exp ',' exp
303 exp : '(' complexnum ')'
304 { write_exp_elt_opcode(OP_COMPLEX); }
307 exp : '(' type ')' exp %prec UNARY
308 { write_exp_elt_opcode (UNOP_CAST);
309 write_exp_elt_type ($2);
310 write_exp_elt_opcode (UNOP_CAST); }
313 /* Binary operators in order of decreasing precedence. */
316 { write_exp_elt_opcode (BINOP_REPEAT); }
320 { write_exp_elt_opcode (BINOP_MUL); }
324 { write_exp_elt_opcode (BINOP_DIV); }
328 { write_exp_elt_opcode (BINOP_REM); }
332 { write_exp_elt_opcode (BINOP_ADD); }
336 { write_exp_elt_opcode (BINOP_SUB); }
340 { write_exp_elt_opcode (BINOP_LSH); }
344 { write_exp_elt_opcode (BINOP_RSH); }
348 { write_exp_elt_opcode (BINOP_EQUAL); }
351 exp : exp NOTEQUAL exp
352 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
356 { write_exp_elt_opcode (BINOP_LEQ); }
360 { write_exp_elt_opcode (BINOP_GEQ); }
363 exp : exp LESSTHAN exp
364 { write_exp_elt_opcode (BINOP_LESS); }
367 exp : exp GREATERTHAN exp
368 { write_exp_elt_opcode (BINOP_GTR); }
372 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
376 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
380 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
383 exp : exp BOOL_AND exp
384 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
388 exp : exp BOOL_OR exp
389 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
393 { write_exp_elt_opcode (BINOP_ASSIGN); }
396 exp : exp ASSIGN_MODIFY exp
397 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
398 write_exp_elt_opcode ($2);
399 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
403 { write_exp_elt_opcode (OP_LONG);
404 write_exp_elt_type ($1.type);
405 write_exp_elt_longcst ((LONGEST)($1.val));
406 write_exp_elt_opcode (OP_LONG); }
411 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
412 write_exp_elt_opcode (OP_LONG);
413 write_exp_elt_type (val.typed_val.type);
414 write_exp_elt_longcst ((LONGEST)val.typed_val.val);
415 write_exp_elt_opcode (OP_LONG); }
419 { write_exp_elt_opcode (OP_DOUBLE);
420 write_exp_elt_type (builtin_type_f_real_s8);
421 write_exp_elt_dblcst ($1);
422 write_exp_elt_opcode (OP_DOUBLE); }
431 exp : SIZEOF '(' type ')' %prec UNARY
432 { write_exp_elt_opcode (OP_LONG);
433 write_exp_elt_type (builtin_type_f_integer);
435 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
436 write_exp_elt_opcode (OP_LONG); }
439 exp : BOOLEAN_LITERAL
440 { write_exp_elt_opcode (OP_BOOL);
441 write_exp_elt_longcst ((LONGEST) $1);
442 write_exp_elt_opcode (OP_BOOL);
448 write_exp_elt_opcode (OP_STRING);
449 write_exp_string ($1);
450 write_exp_elt_opcode (OP_STRING);
454 variable: name_not_typename
455 { struct symbol *sym = $1.sym;
459 if (symbol_read_needs_frame (sym))
461 if (innermost_block == 0 ||
462 contained_in (block_found,
464 innermost_block = block_found;
466 write_exp_elt_opcode (OP_VAR_VALUE);
467 /* We want to use the selected frame, not
468 another more inner frame which happens to
469 be in the same block. */
470 write_exp_elt_block (NULL);
471 write_exp_elt_sym (sym);
472 write_exp_elt_opcode (OP_VAR_VALUE);
477 struct minimal_symbol *msymbol;
478 register char *arg = copy_name ($1.stoken);
481 lookup_minimal_symbol (arg, NULL, NULL);
484 write_exp_msymbol (msymbol,
485 lookup_function_type (builtin_type_int),
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_reference_type (follow_type);
523 array_size = pop_type_int ();
524 if (array_size != -1)
527 create_range_type ((struct type *) NULL,
528 builtin_type_f_integer, 0,
531 create_array_type ((struct type *) NULL,
532 follow_type, range_type);
535 follow_type = lookup_pointer_type (follow_type);
538 follow_type = lookup_function_type (follow_type);
546 { push_type (tp_pointer); $$ = 0; }
548 { push_type (tp_pointer); $$ = $2; }
550 { push_type (tp_reference); $$ = 0; }
552 { push_type (tp_reference); $$ = $2; }
556 direct_abs_decl: '(' abs_decl ')'
558 | direct_abs_decl func_mod
559 { push_type (tp_function); }
561 { push_type (tp_function); }
566 | '(' nonempty_typelist ')'
567 { free ((PTR)$2); $$ = 0; }
570 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
574 { $$ = builtin_type_f_integer; }
576 { $$ = builtin_type_f_integer_s2; }
578 { $$ = builtin_type_f_character; }
580 { $$ = builtin_type_f_logical;}
582 { $$ = builtin_type_f_logical_s2;}
584 { $$ = builtin_type_f_logical_s1;}
586 { $$ = builtin_type_f_real;}
588 { $$ = builtin_type_f_real_s8;}
590 { $$ = builtin_type_f_real_s16;}
592 { $$ = builtin_type_f_complex_s8;}
593 | COMPLEX_S16_KEYWORD
594 { $$ = builtin_type_f_complex_s16;}
595 | COMPLEX_S32_KEYWORD
596 { $$ = builtin_type_f_complex_s32;}
604 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
605 $<ivec>$[0] = 1; /* Number of types in vector */
608 | nonempty_typelist ',' type
609 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
610 $$ = (struct type **) realloc ((char *) $1, len);
611 $$[$<ivec>$[0]] = $3;
623 name_not_typename : NAME
624 /* These would be useful if name_not_typename was useful, but it is just
625 a fake for "variable", so these cause reduce/reduce conflicts because
626 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
627 =exp) or just an exp. If name_not_typename was ever used in an lvalue
628 context where only a name could occur, this might be useful.
635 /* Take care of parsing a number (anything that starts with a digit).
636 Set yylval and return the token type; update lexptr.
637 LEN is the number of characters in it. */
639 /*** Needs some error checking for the float case ***/
642 parse_number (p, len, parsed_float, putithere)
648 register LONGEST n = 0;
649 register LONGEST prevn = 0;
651 register int base = input_radix;
655 struct type *signed_type;
656 struct type *unsigned_type;
660 /* It's a float since it contains a point or an exponent. */
661 /* [dD] is not understood as an exponent by atof, change it to 'e'. */
665 for (tmp2 = tmp; *tmp2; ++tmp2)
666 if (*tmp2 == 'd' || *tmp2 == 'D')
668 putithere->dval = atof (tmp);
673 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
709 if (len == 0 && c == 'l')
711 else if (len == 0 && c == 'u')
716 if (c >= '0' && c <= '9')
718 else if (c >= 'a' && c <= 'f')
721 return ERROR; /* Char not a digit */
723 return ERROR; /* Invalid digit in this base */
727 /* Portably test for overflow (only works for nonzero values, so make
728 a second check for zero). */
729 if ((prevn >= n) && n != 0)
730 unsigned_p=1; /* Try something unsigned */
731 /* If range checking enabled, portably test for unsigned overflow. */
732 if (RANGE_CHECK && n != 0)
734 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
735 range_error("Overflow on numeric constant.");
740 /* If the number is too big to be an int, or it's got an l suffix
741 then it's a long. Work out if this has to be a long by
742 shifting right and and seeing if anything remains, and the
743 target int size is different to the target long size.
745 In the expression below, we could have tested
746 (n >> TARGET_INT_BIT)
747 to see if it was zero,
748 but too many compilers warn about that, when ints and longs
749 are the same size. So we shift it twice, with fewer bits
750 each time, for the same result. */
752 if ((TARGET_INT_BIT != TARGET_LONG_BIT
753 && ((n >> 2) >> (TARGET_INT_BIT-2))) /* Avoid shift warning */
756 high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
757 unsigned_type = builtin_type_unsigned_long;
758 signed_type = builtin_type_long;
762 high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
763 unsigned_type = builtin_type_unsigned_int;
764 signed_type = builtin_type_int;
767 putithere->typed_val.val = n;
769 /* If the high bit of the worked out type is set then this number
770 has to be unsigned. */
772 if (unsigned_p || (n & high_bit))
773 putithere->typed_val.type = unsigned_type;
775 putithere->typed_val.type = signed_type;
784 enum exp_opcode opcode;
787 static const struct token dot_ops[] =
789 { ".and.", BOOL_AND, BINOP_END },
790 { ".AND.", BOOL_AND, BINOP_END },
791 { ".or.", BOOL_OR, BINOP_END },
792 { ".OR.", BOOL_OR, BINOP_END },
793 { ".not.", BOOL_NOT, BINOP_END },
794 { ".NOT.", BOOL_NOT, BINOP_END },
795 { ".eq.", EQUAL, BINOP_END },
796 { ".EQ.", EQUAL, BINOP_END },
797 { ".eqv.", EQUAL, BINOP_END },
798 { ".NEQV.", NOTEQUAL, BINOP_END },
799 { ".neqv.", NOTEQUAL, BINOP_END },
800 { ".EQV.", EQUAL, BINOP_END },
801 { ".ne.", NOTEQUAL, BINOP_END },
802 { ".NE.", NOTEQUAL, BINOP_END },
803 { ".le.", LEQ, BINOP_END },
804 { ".LE.", LEQ, BINOP_END },
805 { ".ge.", GEQ, BINOP_END },
806 { ".GE.", GEQ, BINOP_END },
807 { ".gt.", GREATERTHAN, BINOP_END },
808 { ".GT.", GREATERTHAN, BINOP_END },
809 { ".lt.", LESSTHAN, BINOP_END },
810 { ".LT.", LESSTHAN, BINOP_END },
814 struct f77_boolean_val
820 static const struct f77_boolean_val boolean_values[] =
829 static const struct token f77_keywords[] =
831 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
832 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
833 { "character", CHARACTER, BINOP_END },
834 { "integer_2", INT_S2_KEYWORD, BINOP_END },
835 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
836 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
837 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
838 { "integer", INT_KEYWORD, BINOP_END },
839 { "logical", LOGICAL_KEYWORD, BINOP_END },
840 { "real_16", REAL_S16_KEYWORD, BINOP_END },
841 { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
842 { "sizeof", SIZEOF, BINOP_END },
843 { "real_8", REAL_S8_KEYWORD, BINOP_END },
844 { "real", REAL_KEYWORD, BINOP_END },
848 /* Implementation of a dynamically expandable buffer for processing input
849 characters acquired through lexptr and building a value to return in
850 yylval. Ripped off from ch-exp.y */
852 static char *tempbuf; /* Current buffer contents */
853 static int tempbufsize; /* Size of allocated buffer */
854 static int tempbufindex; /* Current index into buffer */
856 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
858 #define CHECKBUF(size) \
860 if (tempbufindex + (size) >= tempbufsize) \
862 growbuf_by_size (size); \
867 /* Grow the static temp buffer if necessary, including allocating the first one
871 growbuf_by_size (count)
876 growby = max (count, GROWBY_MIN_SIZE);
877 tempbufsize += growby;
879 tempbuf = (char *) malloc (tempbufsize);
881 tempbuf = (char *) realloc (tempbuf, tempbufsize);
884 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
887 Recognize a string literal. A string literal is a nonzero sequence
888 of characters enclosed in matching single quotes, except that
889 a single character inside single quotes is a character literal, which
890 we reject as a string literal. To embed the terminator character inside
891 a string, it is simply doubled (I.E. 'this''is''one''string') */
894 match_string_literal ()
896 char *tokptr = lexptr;
898 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
901 if (*tokptr == *lexptr)
903 if (*(tokptr + 1) == *lexptr)
908 tempbuf[tempbufindex++] = *tokptr;
910 if (*tokptr == '\0' /* no terminator */
911 || tempbufindex == 0) /* no string */
915 tempbuf[tempbufindex] = '\0';
916 yylval.sval.ptr = tempbuf;
917 yylval.sval.length = tempbufindex;
919 return STRING_LITERAL;
923 /* Read one token, getting characters through lexptr. */
930 unsigned int i,token;
935 prev_lexptr = lexptr;
939 /* First of all, let us make sure we are not dealing with the
940 special tokens .true. and .false. which evaluate to 1 and 0. */
944 for (i = 0; boolean_values[i].name != NULL; i++)
946 if STREQN (tokstart, boolean_values[i].name,
947 strlen (boolean_values[i].name))
949 lexptr += strlen (boolean_values[i].name);
950 yylval.lval = boolean_values[i].value;
951 return BOOLEAN_LITERAL;
956 /* See if it is a special .foo. operator */
958 for (i = 0; dot_ops[i].operator != NULL; i++)
959 if (STREQN (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)))
961 lexptr += strlen (dot_ops[i].operator);
962 yylval.opcode = dot_ops[i].opcode;
963 return dot_ops[i].token;
966 switch (c = *tokstart)
978 token = match_string_literal ();
989 if (paren_depth == 0)
996 if (comma_terminates && paren_depth == 0)
1002 /* Might be a floating point number. */
1003 if (lexptr[1] < '0' || lexptr[1] > '9')
1004 goto symbol; /* Nope, must be a symbol. */
1005 /* FALL THRU into number case. */
1018 /* It's a number. */
1019 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1020 register char *p = tokstart;
1021 int hex = input_radix > 10;
1023 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1028 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1036 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1037 got_dot = got_e = 1;
1038 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1039 got_dot = got_d = 1;
1040 else if (!hex && !got_dot && *p == '.')
1042 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1043 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1044 && (*p == '-' || *p == '+'))
1045 /* This is the sign of the exponent, not the end of the
1048 /* We will take any letters or digits. parse_number will
1049 complain if past the radix, or if L or U are not final. */
1050 else if ((*p < '0' || *p > '9')
1051 && ((*p < 'a' || *p > 'z')
1052 && (*p < 'A' || *p > 'Z')))
1055 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
1057 if (toktype == ERROR)
1059 char *err_copy = (char *) alloca (p - tokstart + 1);
1061 memcpy (err_copy, tokstart, p - tokstart);
1062 err_copy[p - tokstart] = 0;
1063 error ("Invalid number \"%s\".", err_copy);
1094 if (!(c == '_' || c == '$'
1095 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1096 /* We must have come across a bad character (e.g. ';'). */
1097 error ("Invalid character '%c' in expression.", c);
1100 for (c = tokstart[namelen];
1101 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1102 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1103 c = tokstart[++namelen]);
1105 /* The token "if" terminates the expression and is NOT
1106 removed from the input stream. */
1108 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1113 /* Catch specific keywords. */
1115 for (i = 0; f77_keywords[i].operator != NULL; i++)
1116 if (STREQN(tokstart, f77_keywords[i].operator,
1117 strlen(f77_keywords[i].operator)))
1119 /* lexptr += strlen(f77_keywords[i].operator); */
1120 yylval.opcode = f77_keywords[i].opcode;
1121 return f77_keywords[i].token;
1124 yylval.sval.ptr = tokstart;
1125 yylval.sval.length = namelen;
1127 if (*tokstart == '$')
1129 write_dollar_variable (yylval.sval);
1133 /* Use token-type TYPENAME for symbols that happen to be defined
1134 currently as names of types; NAME for other symbols.
1135 The caller is not constrained to care about the distinction. */
1137 char *tmp = copy_name (yylval.sval);
1139 int is_a_field_of_this = 0;
1142 sym = lookup_symbol (tmp, expression_context_block,
1144 current_language->la_language == language_cplus
1145 ? &is_a_field_of_this : NULL,
1147 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1149 yylval.tsym.type = SYMBOL_TYPE (sym);
1152 if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
1155 /* Input names that aren't symbols but ARE valid hex numbers,
1156 when the input radix permits them, can be names or numbers
1157 depending on the parse. Note we support radixes > 16 here. */
1159 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1160 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1162 YYSTYPE newlval; /* Its value is ignored. */
1163 hextype = parse_number (tokstart, namelen, 0, &newlval);
1166 yylval.ssym.sym = sym;
1167 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1172 /* Any other kind of symbol */
1173 yylval.ssym.sym = sym;
1174 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1184 lexptr = prev_lexptr;
1186 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);