1 /* YACC parser for Fortran expressions, for GDB.
2 Copyright 1986, 1989, 1990, 1991, 1993, 1994
3 Free Software Foundation, Inc.
4 Contributed by Motorola. Adapted from the C parser by Farooq Butt
5 (fmbutt@engage.sps.mot.com).
7 This file is part of GDB.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
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. */
47 #include "expression.h"
49 #include "parser-defs.h"
52 #include "bfd.h" /* Required by objfiles.h. */
53 #include "symfile.h" /* Required by objfiles.h. */
54 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
56 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
57 as well as gratuitiously global symbol names, so we can have multiple
58 yacc generated parsers in gdb. Note that these are only the variables
59 produced by yacc. If other parser generators (bison, byacc, etc) produce
60 additional global names that conflict at link time, then those parser
61 generators need to be fixed instead of adding those names to this list. */
63 #define yymaxdepth f_maxdepth
64 #define yyparse f_parse
66 #define yyerror f_error
69 #define yydebug f_debug
78 #define yyerrflag f_errflag
79 #define yynerrs f_nerrs
84 #define yystate f_state
90 #define yyreds f_reds /* With YYDEBUG defined */
91 #define yytoks f_toks /* With YYDEBUG defined */
94 #define yydefred f_yydefred
95 #define yydgoto f_yydgoto
96 #define yysindex f_yysindex
97 #define yyrindex f_yyrindex
98 #define yygindex f_yygindex
99 #define yytable f_yytable
100 #define yycheck f_yycheck
103 #define YYDEBUG 1 /* Default to no yydebug support */
106 int yyparse PARAMS ((void));
108 static int yylex PARAMS ((void));
110 void yyerror PARAMS ((char *));
114 /* Although the yacc "value" of an expression is not used,
115 since the result is stored in the structure being created,
116 other node types do have values. */
130 struct symtoken ssym;
133 enum exp_opcode opcode;
134 struct internalvar *ivar;
141 /* YYSTYPE gets defined by %union */
142 static int parse_number PARAMS ((char *, int, int, YYSTYPE *));
145 %type <voidval> exp type_exp start variable
146 %type <tval> type typebase
147 %type <tvec> nonempty_typelist
148 /* %type <bval> block */
150 /* Fancy type parsing. */
151 %type <voidval> func_mod direct_abs_decl abs_decl
154 %token <typed_val> INT
157 /* Both NAME and TYPENAME tokens represent symbols in the input,
158 and both convey their data as strings.
159 But a TYPENAME is a string that happens to be defined as a typedef
160 or builtin type name (such as int or char)
161 and a NAME is any other symbol.
162 Contexts where this distinction is not important can use the
163 nonterminal "name", which matches either NAME or TYPENAME. */
165 %token <sval> STRING_LITERAL
166 %token <lval> BOOLEAN_LITERAL
168 %token <tsym> TYPENAME
170 %type <ssym> name_not_typename
171 %type <tsym> typename
173 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
174 but which would parse as a valid number in the current input radix.
175 E.g. "c" when input_radix==16. Depending on the parse, it will be
176 turned into a name or into a number. */
178 %token <ssym> NAME_OR_INT
183 /* Special type cases, put in to allow the parser to distinguish different
185 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
186 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
187 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
188 %token BOOL_AND BOOL_OR BOOL_NOT
189 %token <lval> CHARACTER
191 %token <voidval> VARIABLE
193 %token <opcode> ASSIGN_MODIFY
197 %right '=' ASSIGN_MODIFY
206 %left LESSTHAN GREATERTHAN LEQ GEQ
222 { write_exp_elt_opcode(OP_TYPE);
223 write_exp_elt_type($1);
224 write_exp_elt_opcode(OP_TYPE); }
231 /* Expressions, not including the comma operator. */
232 exp : '*' exp %prec UNARY
233 { write_exp_elt_opcode (UNOP_IND); }
235 exp : '&' exp %prec UNARY
236 { write_exp_elt_opcode (UNOP_ADDR); }
238 exp : '-' exp %prec UNARY
239 { write_exp_elt_opcode (UNOP_NEG); }
242 exp : BOOL_NOT exp %prec UNARY
243 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
246 exp : '~' exp %prec UNARY
247 { write_exp_elt_opcode (UNOP_COMPLEMENT); }
250 exp : SIZEOF exp %prec UNARY
251 { write_exp_elt_opcode (UNOP_SIZEOF); }
254 /* No more explicit array operators, we treat everything in F77 as
255 a function call. The disambiguation as to whether we are
256 doing a subscript operation or a function call is done
260 { start_arglist (); }
262 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
263 write_exp_elt_longcst ((LONGEST) end_arglist ());
264 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
277 arglist : arglist ',' exp %prec ABOVE_COMMA
281 substring: exp ':' exp %prec ABOVE_COMMA
286 complexnum: exp ',' exp
290 exp : '(' complexnum ')'
291 { write_exp_elt_opcode(OP_COMPLEX); }
294 exp : '(' type ')' exp %prec UNARY
295 { write_exp_elt_opcode (UNOP_CAST);
296 write_exp_elt_type ($2);
297 write_exp_elt_opcode (UNOP_CAST); }
300 /* Binary operators in order of decreasing precedence. */
303 { write_exp_elt_opcode (BINOP_REPEAT); }
307 { write_exp_elt_opcode (BINOP_MUL); }
311 { write_exp_elt_opcode (BINOP_DIV); }
315 { write_exp_elt_opcode (BINOP_REM); }
319 { write_exp_elt_opcode (BINOP_ADD); }
323 { write_exp_elt_opcode (BINOP_SUB); }
327 { write_exp_elt_opcode (BINOP_LSH); }
331 { write_exp_elt_opcode (BINOP_RSH); }
335 { write_exp_elt_opcode (BINOP_EQUAL); }
338 exp : exp NOTEQUAL exp
339 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
343 { write_exp_elt_opcode (BINOP_LEQ); }
347 { write_exp_elt_opcode (BINOP_GEQ); }
350 exp : exp LESSTHAN exp
351 { write_exp_elt_opcode (BINOP_LESS); }
354 exp : exp GREATERTHAN exp
355 { write_exp_elt_opcode (BINOP_GTR); }
359 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
363 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
367 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
370 exp : exp BOOL_AND exp
371 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
375 exp : exp BOOL_OR exp
376 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
380 { write_exp_elt_opcode (BINOP_ASSIGN); }
383 exp : exp ASSIGN_MODIFY exp
384 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
385 write_exp_elt_opcode ($2);
386 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
390 { write_exp_elt_opcode (OP_LONG);
391 write_exp_elt_type ($1.type);
392 write_exp_elt_longcst ((LONGEST)($1.val));
393 write_exp_elt_opcode (OP_LONG); }
398 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
399 write_exp_elt_opcode (OP_LONG);
400 write_exp_elt_type (val.typed_val.type);
401 write_exp_elt_longcst ((LONGEST)val.typed_val.val);
402 write_exp_elt_opcode (OP_LONG); }
406 { write_exp_elt_opcode (OP_DOUBLE);
407 write_exp_elt_type (builtin_type_f_real_s8);
408 write_exp_elt_dblcst ($1);
409 write_exp_elt_opcode (OP_DOUBLE); }
418 exp : SIZEOF '(' type ')' %prec UNARY
419 { write_exp_elt_opcode (OP_LONG);
420 write_exp_elt_type (builtin_type_f_integer);
421 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
422 write_exp_elt_opcode (OP_LONG); }
425 exp : BOOLEAN_LITERAL
426 { write_exp_elt_opcode (OP_BOOL);
427 write_exp_elt_longcst ((LONGEST) $1);
428 write_exp_elt_opcode (OP_BOOL);
434 write_exp_elt_opcode (OP_STRING);
435 write_exp_string ($1);
436 write_exp_elt_opcode (OP_STRING);
440 variable: name_not_typename
441 { struct symbol *sym = $1.sym;
445 if (symbol_read_needs_frame (sym))
447 if (innermost_block == 0 ||
448 contained_in (block_found,
450 innermost_block = block_found;
452 write_exp_elt_opcode (OP_VAR_VALUE);
453 /* We want to use the selected frame, not
454 another more inner frame which happens to
455 be in the same block. */
456 write_exp_elt_block (NULL);
457 write_exp_elt_sym (sym);
458 write_exp_elt_opcode (OP_VAR_VALUE);
463 struct minimal_symbol *msymbol;
464 register char *arg = copy_name ($1.stoken);
467 lookup_minimal_symbol (arg, NULL, NULL);
470 write_exp_msymbol (msymbol,
471 lookup_function_type (builtin_type_int),
474 else if (!have_full_symbols () && !have_partial_symbols ())
475 error ("No symbol table is loaded. Use the \"file\" command.");
477 error ("No symbol \"%s\" in current context.",
478 copy_name ($1.stoken));
490 /* This is where the interesting stuff happens. */
493 struct type *follow_type = $1;
494 struct type *range_type;
503 follow_type = lookup_pointer_type (follow_type);
506 follow_type = lookup_reference_type (follow_type);
509 array_size = pop_type_int ();
510 if (array_size != -1)
513 create_range_type ((struct type *) NULL,
514 builtin_type_f_integer, 0,
517 create_array_type ((struct type *) NULL,
518 follow_type, range_type);
521 follow_type = lookup_pointer_type (follow_type);
524 follow_type = lookup_function_type (follow_type);
532 { push_type (tp_pointer); $$ = 0; }
534 { push_type (tp_pointer); $$ = $2; }
536 { push_type (tp_reference); $$ = 0; }
538 { push_type (tp_reference); $$ = $2; }
542 direct_abs_decl: '(' abs_decl ')'
544 | direct_abs_decl func_mod
545 { push_type (tp_function); }
547 { push_type (tp_function); }
552 | '(' nonempty_typelist ')'
553 { free ((PTR)$2); $$ = 0; }
556 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
560 { $$ = builtin_type_f_integer; }
562 { $$ = builtin_type_f_integer_s2; }
564 { $$ = builtin_type_f_character; }
566 { $$ = builtin_type_f_logical;}
568 { $$ = builtin_type_f_logical_s2;}
570 { $$ = builtin_type_f_logical_s1;}
572 { $$ = builtin_type_f_real;}
574 { $$ = builtin_type_f_real_s8;}
576 { $$ = builtin_type_f_real_s16;}
578 { $$ = builtin_type_f_complex_s8;}
579 | COMPLEX_S16_KEYWORD
580 { $$ = builtin_type_f_complex_s16;}
581 | COMPLEX_S32_KEYWORD
582 { $$ = builtin_type_f_complex_s32;}
590 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
591 $<ivec>$[0] = 1; /* Number of types in vector */
594 | nonempty_typelist ',' type
595 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
596 $$ = (struct type **) realloc ((char *) $1, len);
597 $$[$<ivec>$[0]] = $3;
609 name_not_typename : NAME
610 /* These would be useful if name_not_typename was useful, but it is just
611 a fake for "variable", so these cause reduce/reduce conflicts because
612 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
613 =exp) or just an exp. If name_not_typename was ever used in an lvalue
614 context where only a name could occur, this might be useful.
621 /* Take care of parsing a number (anything that starts with a digit).
622 Set yylval and return the token type; update lexptr.
623 LEN is the number of characters in it. */
625 /*** Needs some error checking for the float case ***/
628 parse_number (p, len, parsed_float, putithere)
634 register LONGEST n = 0;
635 register LONGEST prevn = 0;
638 register int base = input_radix;
641 unsigned LONGEST high_bit;
642 struct type *signed_type;
643 struct type *unsigned_type;
647 /* It's a float since it contains a point or an exponent. */
648 /* [dD] is not understood as an exponent by atof, change it to 'e'. */
652 for (tmp2 = tmp; *tmp2; ++tmp2)
653 if (*tmp2 == 'd' || *tmp2 == 'D')
655 putithere->dval = atof (tmp);
660 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
694 if (c >= 'A' && c <= 'Z')
696 if (c != 'l' && c != 'u')
698 if (c >= '0' && c <= '9')
702 if (base > 10 && c >= 'a' && c <= 'f')
703 n += i = c - 'a' + 10;
704 else if (len == 0 && c == 'l')
706 else if (len == 0 && c == 'u')
709 return ERROR; /* Char not a digit */
712 return ERROR; /* Invalid digit in this base */
714 /* Portably test for overflow (only works for nonzero values, so make
715 a second check for zero). */
716 if ((prevn >= n) && n != 0)
717 unsigned_p=1; /* Try something unsigned */
718 /* If range checking enabled, portably test for unsigned overflow. */
719 if (RANGE_CHECK && n != 0)
721 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
722 range_error("Overflow on numeric constant.");
727 /* If the number is too big to be an int, or it's got an l suffix
728 then it's a long. Work out if this has to be a long by
729 shifting right and and seeing if anything remains, and the
730 target int size is different to the target long size.
732 In the expression below, we could have tested
733 (n >> TARGET_INT_BIT)
734 to see if it was zero,
735 but too many compilers warn about that, when ints and longs
736 are the same size. So we shift it twice, with fewer bits
737 each time, for the same result. */
739 if ((TARGET_INT_BIT != TARGET_LONG_BIT
740 && ((n >> 2) >> (TARGET_INT_BIT-2))) /* Avoid shift warning */
743 high_bit = ((unsigned LONGEST)1) << (TARGET_LONG_BIT-1);
744 unsigned_type = builtin_type_unsigned_long;
745 signed_type = builtin_type_long;
749 high_bit = ((unsigned LONGEST)1) << (TARGET_INT_BIT-1);
750 unsigned_type = builtin_type_unsigned_int;
751 signed_type = builtin_type_int;
754 putithere->typed_val.val = n;
756 /* If the high bit of the worked out type is set then this number
757 has to be unsigned. */
759 if (unsigned_p || (n & high_bit))
760 putithere->typed_val.type = unsigned_type;
762 putithere->typed_val.type = signed_type;
771 enum exp_opcode opcode;
774 static const struct token dot_ops[] =
776 { ".and.", BOOL_AND, BINOP_END },
777 { ".AND.", BOOL_AND, BINOP_END },
778 { ".or.", BOOL_OR, BINOP_END },
779 { ".OR.", BOOL_OR, BINOP_END },
780 { ".not.", BOOL_NOT, BINOP_END },
781 { ".NOT.", BOOL_NOT, BINOP_END },
782 { ".eq.", EQUAL, BINOP_END },
783 { ".EQ.", EQUAL, BINOP_END },
784 { ".eqv.", EQUAL, BINOP_END },
785 { ".NEQV.", NOTEQUAL, BINOP_END },
786 { ".neqv.", NOTEQUAL, BINOP_END },
787 { ".EQV.", EQUAL, BINOP_END },
788 { ".ne.", NOTEQUAL, BINOP_END },
789 { ".NE.", NOTEQUAL, BINOP_END },
790 { ".le.", LEQ, BINOP_END },
791 { ".LE.", LEQ, BINOP_END },
792 { ".ge.", GEQ, BINOP_END },
793 { ".GE.", GEQ, BINOP_END },
794 { ".gt.", GREATERTHAN, BINOP_END },
795 { ".GT.", GREATERTHAN, BINOP_END },
796 { ".lt.", LESSTHAN, BINOP_END },
797 { ".LT.", LESSTHAN, BINOP_END },
801 struct f77_boolean_val
807 static const struct f77_boolean_val boolean_values[] =
816 static const struct token f77_keywords[] =
818 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
819 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
820 { "character", CHARACTER, BINOP_END },
821 { "integer_2", INT_S2_KEYWORD, BINOP_END },
822 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
823 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
824 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
825 { "integer", INT_KEYWORD, BINOP_END },
826 { "logical", LOGICAL_KEYWORD, BINOP_END },
827 { "real_16", REAL_S16_KEYWORD, BINOP_END },
828 { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
829 { "sizeof", SIZEOF, BINOP_END },
830 { "real_8", REAL_S8_KEYWORD, BINOP_END },
831 { "real", REAL_KEYWORD, BINOP_END },
835 /* Implementation of a dynamically expandable buffer for processing input
836 characters acquired through lexptr and building a value to return in
837 yylval. Ripped off from ch-exp.y */
839 static char *tempbuf; /* Current buffer contents */
840 static int tempbufsize; /* Size of allocated buffer */
841 static int tempbufindex; /* Current index into buffer */
843 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
845 #define CHECKBUF(size) \
847 if (tempbufindex + (size) >= tempbufsize) \
849 growbuf_by_size (size); \
854 /* Grow the static temp buffer if necessary, including allocating the first one
858 growbuf_by_size (count)
863 growby = max (count, GROWBY_MIN_SIZE);
864 tempbufsize += growby;
866 tempbuf = (char *) malloc (tempbufsize);
868 tempbuf = (char *) realloc (tempbuf, tempbufsize);
871 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
874 Recognize a string literal. A string literal is a nonzero sequence
875 of characters enclosed in matching single quotes, except that
876 a single character inside single quotes is a character literal, which
877 we reject as a string literal. To embed the terminator character inside
878 a string, it is simply doubled (I.E. 'this''is''one''string') */
881 match_string_literal ()
883 char *tokptr = lexptr;
885 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
888 if (*tokptr == *lexptr)
890 if (*(tokptr + 1) == *lexptr)
895 tempbuf[tempbufindex++] = *tokptr;
897 if (*tokptr == '\0' /* no terminator */
898 || tempbufindex == 0) /* no string */
902 tempbuf[tempbufindex] = '\0';
903 yylval.sval.ptr = tempbuf;
904 yylval.sval.length = tempbufindex;
906 return STRING_LITERAL;
910 /* Read one token, getting characters through lexptr. */
917 unsigned int i,token;
924 /* First of all, let us make sure we are not dealing with the
925 special tokens .true. and .false. which evaluate to 1 and 0. */
929 for (i = 0; boolean_values[i].name != NULL; i++)
931 if STREQN (tokstart, boolean_values[i].name,
932 strlen (boolean_values[i].name))
934 lexptr += strlen (boolean_values[i].name);
935 yylval.lval = boolean_values[i].value;
936 return BOOLEAN_LITERAL;
941 /* See if it is a special .foo. operator */
943 for (i = 0; dot_ops[i].operator != NULL; i++)
944 if (STREQN (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)))
946 lexptr += strlen (dot_ops[i].operator);
947 yylval.opcode = dot_ops[i].opcode;
948 return dot_ops[i].token;
951 switch (c = *tokstart)
963 token = match_string_literal ();
974 if (paren_depth == 0)
981 if (comma_terminates && paren_depth == 0)
987 /* Might be a floating point number. */
988 if (lexptr[1] < '0' || lexptr[1] > '9')
989 goto symbol; /* Nope, must be a symbol. */
990 /* FALL THRU into number case. */
1003 /* It's a number. */
1004 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1005 register char *p = tokstart;
1006 int hex = input_radix > 10;
1008 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1013 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1021 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1022 got_dot = got_e = 1;
1023 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1024 got_dot = got_d = 1;
1025 else if (!hex && !got_dot && *p == '.')
1027 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1028 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1029 && (*p == '-' || *p == '+'))
1030 /* This is the sign of the exponent, not the end of the
1033 /* We will take any letters or digits. parse_number will
1034 complain if past the radix, or if L or U are not final. */
1035 else if ((*p < '0' || *p > '9')
1036 && ((*p < 'a' || *p > 'z')
1037 && (*p < 'A' || *p > 'Z')))
1040 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
1042 if (toktype == ERROR)
1044 char *err_copy = (char *) alloca (p - tokstart + 1);
1046 memcpy (err_copy, tokstart, p - tokstart);
1047 err_copy[p - tokstart] = 0;
1048 error ("Invalid number \"%s\".", err_copy);
1079 if (!(c == '_' || c == '$'
1080 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1081 /* We must have come across a bad character (e.g. ';'). */
1082 error ("Invalid character '%c' in expression.", c);
1085 for (c = tokstart[namelen];
1086 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1087 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1088 c = tokstart[++namelen]);
1090 /* The token "if" terminates the expression and is NOT
1091 removed from the input stream. */
1093 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1098 /* Catch specific keywords. */
1100 for (i = 0; f77_keywords[i].operator != NULL; i++)
1101 if (STREQN(tokstart, f77_keywords[i].operator,
1102 strlen(f77_keywords[i].operator)))
1104 /* lexptr += strlen(f77_keywords[i].operator); */
1105 yylval.opcode = f77_keywords[i].opcode;
1106 return f77_keywords[i].token;
1109 yylval.sval.ptr = tokstart;
1110 yylval.sval.length = namelen;
1112 if (*tokstart == '$')
1114 write_dollar_variable (yylval.sval);
1118 /* Use token-type TYPENAME for symbols that happen to be defined
1119 currently as names of types; NAME for other symbols.
1120 The caller is not constrained to care about the distinction. */
1122 char *tmp = copy_name (yylval.sval);
1124 int is_a_field_of_this = 0;
1127 sym = lookup_symbol (tmp, expression_context_block,
1129 current_language->la_language == language_cplus
1130 ? &is_a_field_of_this : NULL,
1132 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1134 yylval.tsym.type = SYMBOL_TYPE (sym);
1137 if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
1140 /* Input names that aren't symbols but ARE valid hex numbers,
1141 when the input radix permits them, can be names or numbers
1142 depending on the parse. Note we support radixes > 16 here. */
1144 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1145 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1147 YYSTYPE newlval; /* Its value is ignored. */
1148 hextype = parse_number (tokstart, namelen, 0, &newlval);
1151 yylval.ssym.sym = sym;
1152 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1157 /* Any other kind of symbol */
1158 yylval.ssym.sym = sym;
1159 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1168 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);