1 /* YACC parser for Fortran expressions, for GDB.
2 Copyright 1986, 1989, 1990, 1991, 1993, 1994, 2001 Free Software
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 */
57 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
58 as well as gratuitiously global symbol names, so we can have multiple
59 yacc generated parsers in gdb. Note that these are only the variables
60 produced by yacc. If other parser generators (bison, byacc, etc) produce
61 additional global names that conflict at link time, then those parser
62 generators need to be fixed instead of adding those names to this list. */
64 #define yymaxdepth f_maxdepth
65 #define yyparse f_parse
67 #define yyerror f_error
70 #define yydebug f_debug
79 #define yyerrflag f_errflag
80 #define yynerrs f_nerrs
85 #define yystate f_state
91 #define yyreds f_reds /* With YYDEBUG defined */
92 #define yytoks f_toks /* With YYDEBUG defined */
95 #define yydefred f_yydefred
96 #define yydgoto f_yydgoto
97 #define yysindex f_yysindex
98 #define yyrindex f_yyrindex
99 #define yygindex f_yygindex
100 #define yytable f_yytable
101 #define yycheck f_yycheck
104 #define YYDEBUG 1 /* Default to no yydebug support */
109 static int yylex (void);
111 void yyerror (char *);
113 static void growbuf_by_size (int);
115 static int match_string_literal (void);
119 /* Although the yacc "value" of an expression is not used,
120 since the result is stored in the structure being created,
121 other node types do have values. */
135 struct symtoken ssym;
138 enum exp_opcode opcode;
139 struct internalvar *ivar;
146 /* YYSTYPE gets defined by %union */
147 static int parse_number (char *, int, int, YYSTYPE *);
150 %type <voidval> exp type_exp start variable
151 %type <tval> type typebase
152 %type <tvec> nonempty_typelist
153 /* %type <bval> block */
155 /* Fancy type parsing. */
156 %type <voidval> func_mod direct_abs_decl abs_decl
159 %token <typed_val> INT
162 /* Both NAME and TYPENAME tokens represent symbols in the input,
163 and both convey their data as strings.
164 But a TYPENAME is a string that happens to be defined as a typedef
165 or builtin type name (such as int or char)
166 and a NAME is any other symbol.
167 Contexts where this distinction is not important can use the
168 nonterminal "name", which matches either NAME or TYPENAME. */
170 %token <sval> STRING_LITERAL
171 %token <lval> BOOLEAN_LITERAL
173 %token <tsym> TYPENAME
175 %type <ssym> name_not_typename
176 %type <tsym> typename
178 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
179 but which would parse as a valid number in the current input radix.
180 E.g. "c" when input_radix==16. Depending on the parse, it will be
181 turned into a name or into a number. */
183 %token <ssym> NAME_OR_INT
188 /* Special type cases, put in to allow the parser to distinguish different
190 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
191 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
192 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
193 %token BOOL_AND BOOL_OR BOOL_NOT
194 %token <lval> CHARACTER
196 %token <voidval> VARIABLE
198 %token <opcode> ASSIGN_MODIFY
202 %right '=' ASSIGN_MODIFY
211 %left LESSTHAN GREATERTHAN LEQ GEQ
227 { write_exp_elt_opcode(OP_TYPE);
228 write_exp_elt_type($1);
229 write_exp_elt_opcode(OP_TYPE); }
236 /* Expressions, not including the comma operator. */
237 exp : '*' exp %prec UNARY
238 { write_exp_elt_opcode (UNOP_IND); }
240 exp : '&' exp %prec UNARY
241 { write_exp_elt_opcode (UNOP_ADDR); }
243 exp : '-' exp %prec UNARY
244 { write_exp_elt_opcode (UNOP_NEG); }
247 exp : BOOL_NOT exp %prec UNARY
248 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
251 exp : '~' exp %prec UNARY
252 { write_exp_elt_opcode (UNOP_COMPLEMENT); }
255 exp : SIZEOF exp %prec UNARY
256 { write_exp_elt_opcode (UNOP_SIZEOF); }
259 /* No more explicit array operators, we treat everything in F77 as
260 a function call. The disambiguation as to whether we are
261 doing a subscript operation or a function call is done
265 { start_arglist (); }
267 { write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST);
268 write_exp_elt_longcst ((LONGEST) end_arglist ());
269 write_exp_elt_opcode (OP_F77_UNDETERMINED_ARGLIST); }
282 arglist : arglist ',' exp %prec ABOVE_COMMA
286 substring: exp ':' exp %prec ABOVE_COMMA
291 complexnum: exp ',' exp
295 exp : '(' complexnum ')'
296 { write_exp_elt_opcode(OP_COMPLEX); }
299 exp : '(' type ')' exp %prec UNARY
300 { write_exp_elt_opcode (UNOP_CAST);
301 write_exp_elt_type ($2);
302 write_exp_elt_opcode (UNOP_CAST); }
305 /* Binary operators in order of decreasing precedence. */
308 { write_exp_elt_opcode (BINOP_REPEAT); }
312 { write_exp_elt_opcode (BINOP_MUL); }
316 { write_exp_elt_opcode (BINOP_DIV); }
320 { write_exp_elt_opcode (BINOP_REM); }
324 { write_exp_elt_opcode (BINOP_ADD); }
328 { write_exp_elt_opcode (BINOP_SUB); }
332 { write_exp_elt_opcode (BINOP_LSH); }
336 { write_exp_elt_opcode (BINOP_RSH); }
340 { write_exp_elt_opcode (BINOP_EQUAL); }
343 exp : exp NOTEQUAL exp
344 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
348 { write_exp_elt_opcode (BINOP_LEQ); }
352 { write_exp_elt_opcode (BINOP_GEQ); }
355 exp : exp LESSTHAN exp
356 { write_exp_elt_opcode (BINOP_LESS); }
359 exp : exp GREATERTHAN exp
360 { write_exp_elt_opcode (BINOP_GTR); }
364 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
368 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
372 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
375 exp : exp BOOL_AND exp
376 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
380 exp : exp BOOL_OR exp
381 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
385 { write_exp_elt_opcode (BINOP_ASSIGN); }
388 exp : exp ASSIGN_MODIFY exp
389 { write_exp_elt_opcode (BINOP_ASSIGN_MODIFY);
390 write_exp_elt_opcode ($2);
391 write_exp_elt_opcode (BINOP_ASSIGN_MODIFY); }
395 { write_exp_elt_opcode (OP_LONG);
396 write_exp_elt_type ($1.type);
397 write_exp_elt_longcst ((LONGEST)($1.val));
398 write_exp_elt_opcode (OP_LONG); }
403 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
404 write_exp_elt_opcode (OP_LONG);
405 write_exp_elt_type (val.typed_val.type);
406 write_exp_elt_longcst ((LONGEST)val.typed_val.val);
407 write_exp_elt_opcode (OP_LONG); }
411 { write_exp_elt_opcode (OP_DOUBLE);
412 write_exp_elt_type (builtin_type_f_real_s8);
413 write_exp_elt_dblcst ($1);
414 write_exp_elt_opcode (OP_DOUBLE); }
423 exp : SIZEOF '(' type ')' %prec UNARY
424 { write_exp_elt_opcode (OP_LONG);
425 write_exp_elt_type (builtin_type_f_integer);
427 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
428 write_exp_elt_opcode (OP_LONG); }
431 exp : BOOLEAN_LITERAL
432 { write_exp_elt_opcode (OP_BOOL);
433 write_exp_elt_longcst ((LONGEST) $1);
434 write_exp_elt_opcode (OP_BOOL);
440 write_exp_elt_opcode (OP_STRING);
441 write_exp_string ($1);
442 write_exp_elt_opcode (OP_STRING);
446 variable: name_not_typename
447 { struct symbol *sym = $1.sym;
451 if (symbol_read_needs_frame (sym))
453 if (innermost_block == 0 ||
454 contained_in (block_found,
456 innermost_block = block_found;
458 write_exp_elt_opcode (OP_VAR_VALUE);
459 /* We want to use the selected frame, not
460 another more inner frame which happens to
461 be in the same block. */
462 write_exp_elt_block (NULL);
463 write_exp_elt_sym (sym);
464 write_exp_elt_opcode (OP_VAR_VALUE);
469 struct minimal_symbol *msymbol;
470 register char *arg = copy_name ($1.stoken);
473 lookup_minimal_symbol (arg, NULL, NULL);
476 write_exp_msymbol (msymbol,
477 lookup_function_type (builtin_type_int),
480 else if (!have_full_symbols () && !have_partial_symbols ())
481 error ("No symbol table is loaded. Use the \"file\" command.");
483 error ("No symbol \"%s\" in current context.",
484 copy_name ($1.stoken));
496 /* This is where the interesting stuff happens. */
499 struct type *follow_type = $1;
500 struct type *range_type;
509 follow_type = lookup_pointer_type (follow_type);
512 follow_type = lookup_reference_type (follow_type);
515 array_size = pop_type_int ();
516 if (array_size != -1)
519 create_range_type ((struct type *) NULL,
520 builtin_type_f_integer, 0,
523 create_array_type ((struct type *) NULL,
524 follow_type, range_type);
527 follow_type = lookup_pointer_type (follow_type);
530 follow_type = lookup_function_type (follow_type);
538 { push_type (tp_pointer); $$ = 0; }
540 { push_type (tp_pointer); $$ = $2; }
542 { push_type (tp_reference); $$ = 0; }
544 { push_type (tp_reference); $$ = $2; }
548 direct_abs_decl: '(' abs_decl ')'
550 | direct_abs_decl func_mod
551 { push_type (tp_function); }
553 { push_type (tp_function); }
558 | '(' nonempty_typelist ')'
559 { free ((PTR)$2); $$ = 0; }
562 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
566 { $$ = builtin_type_f_integer; }
568 { $$ = builtin_type_f_integer_s2; }
570 { $$ = builtin_type_f_character; }
572 { $$ = builtin_type_f_logical;}
574 { $$ = builtin_type_f_logical_s2;}
576 { $$ = builtin_type_f_logical_s1;}
578 { $$ = builtin_type_f_real;}
580 { $$ = builtin_type_f_real_s8;}
582 { $$ = builtin_type_f_real_s16;}
584 { $$ = builtin_type_f_complex_s8;}
585 | COMPLEX_S16_KEYWORD
586 { $$ = builtin_type_f_complex_s16;}
587 | COMPLEX_S32_KEYWORD
588 { $$ = builtin_type_f_complex_s32;}
596 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
597 $<ivec>$[0] = 1; /* Number of types in vector */
600 | nonempty_typelist ',' type
601 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
602 $$ = (struct type **) realloc ((char *) $1, len);
603 $$[$<ivec>$[0]] = $3;
615 name_not_typename : NAME
616 /* These would be useful if name_not_typename was useful, but it is just
617 a fake for "variable", so these cause reduce/reduce conflicts because
618 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
619 =exp) or just an exp. If name_not_typename was ever used in an lvalue
620 context where only a name could occur, this might be useful.
627 /* Take care of parsing a number (anything that starts with a digit).
628 Set yylval and return the token type; update lexptr.
629 LEN is the number of characters in it. */
631 /*** Needs some error checking for the float case ***/
634 parse_number (p, len, parsed_float, putithere)
640 register LONGEST n = 0;
641 register LONGEST prevn = 0;
644 register int base = input_radix;
648 struct type *signed_type;
649 struct type *unsigned_type;
653 /* It's a float since it contains a point or an exponent. */
654 /* [dD] is not understood as an exponent by atof, change it to 'e'. */
658 for (tmp2 = tmp; *tmp2; ++tmp2)
659 if (*tmp2 == 'd' || *tmp2 == 'D')
661 putithere->dval = atof (tmp);
666 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
700 if (c >= 'A' && c <= 'Z')
702 if (c != 'l' && c != 'u')
704 if (c >= '0' && c <= '9')
708 if (base > 10 && c >= 'a' && c <= 'f')
709 n += i = c - 'a' + 10;
710 else if (len == 0 && c == 'l')
712 else if (len == 0 && c == 'u')
715 return ERROR; /* Char not a digit */
718 return ERROR; /* Invalid digit in this base */
720 /* Portably test for overflow (only works for nonzero values, so make
721 a second check for zero). */
722 if ((prevn >= n) && n != 0)
723 unsigned_p=1; /* Try something unsigned */
724 /* If range checking enabled, portably test for unsigned overflow. */
725 if (RANGE_CHECK && n != 0)
727 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
728 range_error("Overflow on numeric constant.");
733 /* If the number is too big to be an int, or it's got an l suffix
734 then it's a long. Work out if this has to be a long by
735 shifting right and and seeing if anything remains, and the
736 target int size is different to the target long size.
738 In the expression below, we could have tested
739 (n >> TARGET_INT_BIT)
740 to see if it was zero,
741 but too many compilers warn about that, when ints and longs
742 are the same size. So we shift it twice, with fewer bits
743 each time, for the same result. */
745 if ((TARGET_INT_BIT != TARGET_LONG_BIT
746 && ((n >> 2) >> (TARGET_INT_BIT-2))) /* Avoid shift warning */
749 high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
750 unsigned_type = builtin_type_unsigned_long;
751 signed_type = builtin_type_long;
755 high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
756 unsigned_type = builtin_type_unsigned_int;
757 signed_type = builtin_type_int;
760 putithere->typed_val.val = n;
762 /* If the high bit of the worked out type is set then this number
763 has to be unsigned. */
765 if (unsigned_p || (n & high_bit))
766 putithere->typed_val.type = unsigned_type;
768 putithere->typed_val.type = signed_type;
777 enum exp_opcode opcode;
780 static const struct token dot_ops[] =
782 { ".and.", BOOL_AND, BINOP_END },
783 { ".AND.", BOOL_AND, BINOP_END },
784 { ".or.", BOOL_OR, BINOP_END },
785 { ".OR.", BOOL_OR, BINOP_END },
786 { ".not.", BOOL_NOT, BINOP_END },
787 { ".NOT.", BOOL_NOT, BINOP_END },
788 { ".eq.", EQUAL, BINOP_END },
789 { ".EQ.", EQUAL, BINOP_END },
790 { ".eqv.", EQUAL, BINOP_END },
791 { ".NEQV.", NOTEQUAL, BINOP_END },
792 { ".neqv.", NOTEQUAL, BINOP_END },
793 { ".EQV.", EQUAL, BINOP_END },
794 { ".ne.", NOTEQUAL, BINOP_END },
795 { ".NE.", NOTEQUAL, BINOP_END },
796 { ".le.", LEQ, BINOP_END },
797 { ".LE.", LEQ, BINOP_END },
798 { ".ge.", GEQ, BINOP_END },
799 { ".GE.", GEQ, BINOP_END },
800 { ".gt.", GREATERTHAN, BINOP_END },
801 { ".GT.", GREATERTHAN, BINOP_END },
802 { ".lt.", LESSTHAN, BINOP_END },
803 { ".LT.", LESSTHAN, BINOP_END },
807 struct f77_boolean_val
813 static const struct f77_boolean_val boolean_values[] =
822 static const struct token f77_keywords[] =
824 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END },
825 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END },
826 { "character", CHARACTER, BINOP_END },
827 { "integer_2", INT_S2_KEYWORD, BINOP_END },
828 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END },
829 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END },
830 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END },
831 { "integer", INT_KEYWORD, BINOP_END },
832 { "logical", LOGICAL_KEYWORD, BINOP_END },
833 { "real_16", REAL_S16_KEYWORD, BINOP_END },
834 { "complex", COMPLEX_S8_KEYWORD, BINOP_END },
835 { "sizeof", SIZEOF, BINOP_END },
836 { "real_8", REAL_S8_KEYWORD, BINOP_END },
837 { "real", REAL_KEYWORD, BINOP_END },
841 /* Implementation of a dynamically expandable buffer for processing input
842 characters acquired through lexptr and building a value to return in
843 yylval. Ripped off from ch-exp.y */
845 static char *tempbuf; /* Current buffer contents */
846 static int tempbufsize; /* Size of allocated buffer */
847 static int tempbufindex; /* Current index into buffer */
849 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
851 #define CHECKBUF(size) \
853 if (tempbufindex + (size) >= tempbufsize) \
855 growbuf_by_size (size); \
860 /* Grow the static temp buffer if necessary, including allocating the first one
864 growbuf_by_size (count)
869 growby = max (count, GROWBY_MIN_SIZE);
870 tempbufsize += growby;
872 tempbuf = (char *) malloc (tempbufsize);
874 tempbuf = (char *) realloc (tempbuf, tempbufsize);
877 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
880 Recognize a string literal. A string literal is a nonzero sequence
881 of characters enclosed in matching single quotes, except that
882 a single character inside single quotes is a character literal, which
883 we reject as a string literal. To embed the terminator character inside
884 a string, it is simply doubled (I.E. 'this''is''one''string') */
887 match_string_literal ()
889 char *tokptr = lexptr;
891 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
894 if (*tokptr == *lexptr)
896 if (*(tokptr + 1) == *lexptr)
901 tempbuf[tempbufindex++] = *tokptr;
903 if (*tokptr == '\0' /* no terminator */
904 || tempbufindex == 0) /* no string */
908 tempbuf[tempbufindex] = '\0';
909 yylval.sval.ptr = tempbuf;
910 yylval.sval.length = tempbufindex;
912 return STRING_LITERAL;
916 /* Read one token, getting characters through lexptr. */
923 unsigned int i,token;
930 /* First of all, let us make sure we are not dealing with the
931 special tokens .true. and .false. which evaluate to 1 and 0. */
935 for (i = 0; boolean_values[i].name != NULL; i++)
937 if STREQN (tokstart, boolean_values[i].name,
938 strlen (boolean_values[i].name))
940 lexptr += strlen (boolean_values[i].name);
941 yylval.lval = boolean_values[i].value;
942 return BOOLEAN_LITERAL;
947 /* See if it is a special .foo. operator */
949 for (i = 0; dot_ops[i].operator != NULL; i++)
950 if (STREQN (tokstart, dot_ops[i].operator, strlen (dot_ops[i].operator)))
952 lexptr += strlen (dot_ops[i].operator);
953 yylval.opcode = dot_ops[i].opcode;
954 return dot_ops[i].token;
957 switch (c = *tokstart)
969 token = match_string_literal ();
980 if (paren_depth == 0)
987 if (comma_terminates && paren_depth == 0)
993 /* Might be a floating point number. */
994 if (lexptr[1] < '0' || lexptr[1] > '9')
995 goto symbol; /* Nope, must be a symbol. */
996 /* FALL THRU into number case. */
1009 /* It's a number. */
1010 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1011 register char *p = tokstart;
1012 int hex = input_radix > 10;
1014 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1019 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1027 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1028 got_dot = got_e = 1;
1029 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1030 got_dot = got_d = 1;
1031 else if (!hex && !got_dot && *p == '.')
1033 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1034 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1035 && (*p == '-' || *p == '+'))
1036 /* This is the sign of the exponent, not the end of the
1039 /* We will take any letters or digits. parse_number will
1040 complain if past the radix, or if L or U are not final. */
1041 else if ((*p < '0' || *p > '9')
1042 && ((*p < 'a' || *p > 'z')
1043 && (*p < 'A' || *p > 'Z')))
1046 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e|got_d,
1048 if (toktype == ERROR)
1050 char *err_copy = (char *) alloca (p - tokstart + 1);
1052 memcpy (err_copy, tokstart, p - tokstart);
1053 err_copy[p - tokstart] = 0;
1054 error ("Invalid number \"%s\".", err_copy);
1085 if (!(c == '_' || c == '$'
1086 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1087 /* We must have come across a bad character (e.g. ';'). */
1088 error ("Invalid character '%c' in expression.", c);
1091 for (c = tokstart[namelen];
1092 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1093 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1094 c = tokstart[++namelen]);
1096 /* The token "if" terminates the expression and is NOT
1097 removed from the input stream. */
1099 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1104 /* Catch specific keywords. */
1106 for (i = 0; f77_keywords[i].operator != NULL; i++)
1107 if (STREQN(tokstart, f77_keywords[i].operator,
1108 strlen(f77_keywords[i].operator)))
1110 /* lexptr += strlen(f77_keywords[i].operator); */
1111 yylval.opcode = f77_keywords[i].opcode;
1112 return f77_keywords[i].token;
1115 yylval.sval.ptr = tokstart;
1116 yylval.sval.length = namelen;
1118 if (*tokstart == '$')
1120 write_dollar_variable (yylval.sval);
1124 /* Use token-type TYPENAME for symbols that happen to be defined
1125 currently as names of types; NAME for other symbols.
1126 The caller is not constrained to care about the distinction. */
1128 char *tmp = copy_name (yylval.sval);
1130 int is_a_field_of_this = 0;
1133 sym = lookup_symbol (tmp, expression_context_block,
1135 current_language->la_language == language_cplus
1136 ? &is_a_field_of_this : NULL,
1138 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1140 yylval.tsym.type = SYMBOL_TYPE (sym);
1143 if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
1146 /* Input names that aren't symbols but ARE valid hex numbers,
1147 when the input radix permits them, can be names or numbers
1148 depending on the parse. Note we support radixes > 16 here. */
1150 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1151 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1153 YYSTYPE newlval; /* Its value is ignored. */
1154 hextype = parse_number (tokstart, namelen, 0, &newlval);
1157 yylval.ssym.sym = sym;
1158 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1163 /* Any other kind of symbol */
1164 yylval.ssym.sym = sym;
1165 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1174 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);