2 /* YACC parser for Fortran expressions, for GDB.
3 Copyright (C) 1986-2019 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 3 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, see <http://www.gnu.org/licenses/>. */
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. */
46 #include "expression.h"
48 #include "parser-defs.h"
51 #include "bfd.h" /* Required by objfiles.h. */
52 #include "symfile.h" /* Required by objfiles.h. */
53 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
58 #define parse_type(ps) builtin_type (parse_gdbarch (ps))
59 #define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps))
61 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
63 #define GDB_YY_REMAP_PREFIX f_
66 /* The state of the parser, used internally when we are parsing the
69 static struct parser_state *pstate = NULL;
73 static int yylex (void);
75 static void yyerror (const char *);
77 static void growbuf_by_size (int);
79 static int match_string_literal (void);
81 static void push_kind_type (LONGEST val, struct type *type);
83 static struct type *convert_to_kind_type (struct type *basetype, int kind);
87 /* Although the yacc "value" of an expression is not used,
88 since the result is stored in the structure being created,
89 other node types do have values. */
106 struct symtoken ssym;
109 enum exp_opcode opcode;
110 struct internalvar *ivar;
117 /* YYSTYPE gets defined by %union */
118 static int parse_number (struct parser_state *, const char *, int,
122 %type <voidval> exp type_exp start variable
123 %type <tval> type typebase
124 %type <tvec> nonempty_typelist
125 /* %type <bval> block */
127 /* Fancy type parsing. */
128 %type <voidval> func_mod direct_abs_decl abs_decl
131 %token <typed_val> INT
132 %token <typed_val_float> FLOAT
134 /* Both NAME and TYPENAME tokens represent symbols in the input,
135 and both convey their data as strings.
136 But a TYPENAME is a string that happens to be defined as a typedef
137 or builtin type name (such as int or char)
138 and a NAME is any other symbol.
139 Contexts where this distinction is not important can use the
140 nonterminal "name", which matches either NAME or TYPENAME. */
142 %token <sval> STRING_LITERAL
143 %token <lval> BOOLEAN_LITERAL
145 %token <tsym> TYPENAME
147 %type <ssym> name_not_typename
149 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
150 but which would parse as a valid number in the current input radix.
151 E.g. "c" when input_radix==16. Depending on the parse, it will be
152 turned into a name or into a number. */
154 %token <ssym> NAME_OR_INT
159 /* Special type cases, put in to allow the parser to distinguish different
161 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
162 %token LOGICAL_S8_KEYWORD
163 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
164 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
165 %token BOOL_AND BOOL_OR BOOL_NOT
166 %token <lval> CHARACTER
168 %token <voidval> DOLLAR_VARIABLE
170 %token <opcode> ASSIGN_MODIFY
171 %token <opcode> UNOP_INTRINSIC
175 %right '=' ASSIGN_MODIFY
184 %left LESSTHAN GREATERTHAN LEQ GEQ
202 { write_exp_elt_opcode (pstate, OP_TYPE);
203 write_exp_elt_type (pstate, $1);
204 write_exp_elt_opcode (pstate, OP_TYPE); }
211 /* Expressions, not including the comma operator. */
212 exp : '*' exp %prec UNARY
213 { write_exp_elt_opcode (pstate, UNOP_IND); }
216 exp : '&' exp %prec UNARY
217 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
220 exp : '-' exp %prec UNARY
221 { write_exp_elt_opcode (pstate, UNOP_NEG); }
224 exp : BOOL_NOT exp %prec UNARY
225 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
228 exp : '~' exp %prec UNARY
229 { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
232 exp : SIZEOF exp %prec UNARY
233 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
236 exp : KIND '(' exp ')' %prec UNARY
237 { write_exp_elt_opcode (pstate, UNOP_KIND); }
240 /* No more explicit array operators, we treat everything in F77 as
241 a function call. The disambiguation as to whether we are
242 doing a subscript operation or a function call is done
246 { start_arglist (); }
248 { write_exp_elt_opcode (pstate,
249 OP_F77_UNDETERMINED_ARGLIST);
250 write_exp_elt_longcst (pstate,
251 (LONGEST) end_arglist ());
252 write_exp_elt_opcode (pstate,
253 OP_F77_UNDETERMINED_ARGLIST); }
256 exp : UNOP_INTRINSIC '(' exp ')'
257 { write_exp_elt_opcode (pstate, $1); }
271 arglist : arglist ',' exp %prec ABOVE_COMMA
275 /* There are four sorts of subrange types in F90. */
277 subrange: exp ':' exp %prec ABOVE_COMMA
278 { write_exp_elt_opcode (pstate, OP_RANGE);
279 write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
280 write_exp_elt_opcode (pstate, OP_RANGE); }
283 subrange: exp ':' %prec ABOVE_COMMA
284 { write_exp_elt_opcode (pstate, OP_RANGE);
285 write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
286 write_exp_elt_opcode (pstate, OP_RANGE); }
289 subrange: ':' exp %prec ABOVE_COMMA
290 { write_exp_elt_opcode (pstate, OP_RANGE);
291 write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
292 write_exp_elt_opcode (pstate, OP_RANGE); }
295 subrange: ':' %prec ABOVE_COMMA
296 { write_exp_elt_opcode (pstate, OP_RANGE);
297 write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
298 write_exp_elt_opcode (pstate, OP_RANGE); }
301 complexnum: exp ',' exp
305 exp : '(' complexnum ')'
306 { write_exp_elt_opcode (pstate, OP_COMPLEX);
307 write_exp_elt_type (pstate,
308 parse_f_type (pstate)
309 ->builtin_complex_s16);
310 write_exp_elt_opcode (pstate, OP_COMPLEX); }
313 exp : '(' type ')' exp %prec UNARY
314 { write_exp_elt_opcode (pstate, UNOP_CAST);
315 write_exp_elt_type (pstate, $2);
316 write_exp_elt_opcode (pstate, UNOP_CAST); }
320 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
321 write_exp_string (pstate, $3);
322 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
325 /* Binary operators in order of decreasing precedence. */
328 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
331 exp : exp STARSTAR exp
332 { write_exp_elt_opcode (pstate, BINOP_EXP); }
336 { write_exp_elt_opcode (pstate, BINOP_MUL); }
340 { write_exp_elt_opcode (pstate, BINOP_DIV); }
344 { write_exp_elt_opcode (pstate, BINOP_ADD); }
348 { write_exp_elt_opcode (pstate, BINOP_SUB); }
352 { write_exp_elt_opcode (pstate, BINOP_LSH); }
356 { write_exp_elt_opcode (pstate, BINOP_RSH); }
360 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
363 exp : exp NOTEQUAL exp
364 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
368 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
372 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
375 exp : exp LESSTHAN exp
376 { write_exp_elt_opcode (pstate, BINOP_LESS); }
379 exp : exp GREATERTHAN exp
380 { write_exp_elt_opcode (pstate, BINOP_GTR); }
384 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
388 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
392 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
395 exp : exp BOOL_AND exp
396 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
400 exp : exp BOOL_OR exp
401 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
405 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
408 exp : exp ASSIGN_MODIFY exp
409 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
410 write_exp_elt_opcode (pstate, $2);
411 write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
415 { write_exp_elt_opcode (pstate, OP_LONG);
416 write_exp_elt_type (pstate, $1.type);
417 write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
418 write_exp_elt_opcode (pstate, OP_LONG); }
423 parse_number (pstate, $1.stoken.ptr,
424 $1.stoken.length, 0, &val);
425 write_exp_elt_opcode (pstate, OP_LONG);
426 write_exp_elt_type (pstate, val.typed_val.type);
427 write_exp_elt_longcst (pstate,
428 (LONGEST)val.typed_val.val);
429 write_exp_elt_opcode (pstate, OP_LONG); }
433 { write_exp_elt_opcode (pstate, OP_FLOAT);
434 write_exp_elt_type (pstate, $1.type);
435 write_exp_elt_floatcst (pstate, $1.val);
436 write_exp_elt_opcode (pstate, OP_FLOAT); }
442 exp : DOLLAR_VARIABLE
445 exp : SIZEOF '(' type ')' %prec UNARY
446 { write_exp_elt_opcode (pstate, OP_LONG);
447 write_exp_elt_type (pstate,
448 parse_f_type (pstate)
450 $3 = check_typedef ($3);
451 write_exp_elt_longcst (pstate,
452 (LONGEST) TYPE_LENGTH ($3));
453 write_exp_elt_opcode (pstate, OP_LONG); }
456 exp : BOOLEAN_LITERAL
457 { write_exp_elt_opcode (pstate, OP_BOOL);
458 write_exp_elt_longcst (pstate, (LONGEST) $1);
459 write_exp_elt_opcode (pstate, OP_BOOL);
465 write_exp_elt_opcode (pstate, OP_STRING);
466 write_exp_string (pstate, $1);
467 write_exp_elt_opcode (pstate, OP_STRING);
471 variable: name_not_typename
472 { struct block_symbol sym = $1.sym;
476 if (symbol_read_needs_frame (sym.symbol))
477 innermost_block.update (sym);
478 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
479 write_exp_elt_block (pstate, sym.block);
480 write_exp_elt_sym (pstate, sym.symbol);
481 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
486 struct bound_minimal_symbol msymbol;
487 char *arg = copy_name ($1.stoken);
490 lookup_bound_minimal_symbol (arg);
491 if (msymbol.minsym != NULL)
492 write_exp_msymbol (pstate, msymbol);
493 else if (!have_full_symbols () && !have_partial_symbols ())
494 error (_("No symbol table is loaded. Use the \"file\" command."));
496 error (_("No symbol \"%s\" in current context."),
497 copy_name ($1.stoken));
509 /* This is where the interesting stuff happens. */
512 struct type *follow_type = $1;
513 struct type *range_type;
522 follow_type = lookup_pointer_type (follow_type);
525 follow_type = lookup_lvalue_reference_type (follow_type);
528 array_size = pop_type_int ();
529 if (array_size != -1)
532 create_static_range_type ((struct type *) NULL,
533 parse_f_type (pstate)
537 create_array_type ((struct type *) NULL,
538 follow_type, range_type);
541 follow_type = lookup_pointer_type (follow_type);
544 follow_type = lookup_function_type (follow_type);
548 int kind_val = pop_type_int ();
550 = convert_to_kind_type (follow_type, kind_val);
559 { push_type (tp_pointer); $$ = 0; }
561 { push_type (tp_pointer); $$ = $2; }
563 { push_type (tp_reference); $$ = 0; }
565 { push_type (tp_reference); $$ = $2; }
569 direct_abs_decl: '(' abs_decl ')'
571 | '(' KIND '=' INT ')'
572 { push_kind_type ($4.val, $4.type); }
574 { push_kind_type ($2.val, $2.type); }
575 | direct_abs_decl func_mod
576 { push_type (tp_function); }
578 { push_type (tp_function); }
583 | '(' nonempty_typelist ')'
584 { free ($2); $$ = 0; }
587 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
591 { $$ = parse_f_type (pstate)->builtin_integer; }
593 { $$ = parse_f_type (pstate)->builtin_integer_s2; }
595 { $$ = parse_f_type (pstate)->builtin_character; }
597 { $$ = parse_f_type (pstate)->builtin_logical_s8; }
599 { $$ = parse_f_type (pstate)->builtin_logical; }
601 { $$ = parse_f_type (pstate)->builtin_logical_s2; }
603 { $$ = parse_f_type (pstate)->builtin_logical_s1; }
605 { $$ = parse_f_type (pstate)->builtin_real; }
607 { $$ = parse_f_type (pstate)->builtin_real_s8; }
609 { $$ = parse_f_type (pstate)->builtin_real_s16; }
611 { $$ = parse_f_type (pstate)->builtin_complex_s8; }
612 | COMPLEX_S16_KEYWORD
613 { $$ = parse_f_type (pstate)->builtin_complex_s16; }
614 | COMPLEX_S32_KEYWORD
615 { $$ = parse_f_type (pstate)->builtin_complex_s32; }
620 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
621 $<ivec>$[0] = 1; /* Number of types in vector */
624 | nonempty_typelist ',' type
625 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
626 $$ = (struct type **) realloc ((char *) $1, len);
627 $$[$<ivec>$[0]] = $3;
635 name_not_typename : NAME
636 /* These would be useful if name_not_typename was useful, but it is just
637 a fake for "variable", so these cause reduce/reduce conflicts because
638 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
639 =exp) or just an exp. If name_not_typename was ever used in an lvalue
640 context where only a name could occur, this might be useful.
647 /* Take care of parsing a number (anything that starts with a digit).
648 Set yylval and return the token type; update lexptr.
649 LEN is the number of characters in it. */
651 /*** Needs some error checking for the float case ***/
654 parse_number (struct parser_state *par_state,
655 const char *p, int len, int parsed_float, YYSTYPE *putithere)
660 int base = input_radix;
664 struct type *signed_type;
665 struct type *unsigned_type;
669 /* It's a float since it contains a point or an exponent. */
670 /* [dD] is not understood as an exponent by parse_float,
675 for (tmp2 = tmp; *tmp2; ++tmp2)
676 if (*tmp2 == 'd' || *tmp2 == 'D')
679 /* FIXME: Should this use different types? */
680 putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
681 bool parsed = parse_float (tmp, len,
682 putithere->typed_val_float.type,
683 putithere->typed_val_float.val);
685 return parsed? FLOAT : ERROR;
688 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
724 if (len == 0 && c == 'l')
726 else if (len == 0 && c == 'u')
731 if (c >= '0' && c <= '9')
733 else if (c >= 'a' && c <= 'f')
736 return ERROR; /* Char not a digit */
738 return ERROR; /* Invalid digit in this base */
742 /* Portably test for overflow (only works for nonzero values, so make
743 a second check for zero). */
744 if ((prevn >= n) && n != 0)
745 unsigned_p=1; /* Try something unsigned */
746 /* If range checking enabled, portably test for unsigned overflow. */
747 if (RANGE_CHECK && n != 0)
749 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
750 range_error (_("Overflow on numeric constant."));
755 /* If the number is too big to be an int, or it's got an l suffix
756 then it's a long. Work out if this has to be a long by
757 shifting right and seeing if anything remains, and the
758 target int size is different to the target long size.
760 In the expression below, we could have tested
761 (n >> gdbarch_int_bit (parse_gdbarch))
762 to see if it was zero,
763 but too many compilers warn about that, when ints and longs
764 are the same size. So we shift it twice, with fewer bits
765 each time, for the same result. */
767 if ((gdbarch_int_bit (parse_gdbarch (par_state))
768 != gdbarch_long_bit (parse_gdbarch (par_state))
770 >> (gdbarch_int_bit (parse_gdbarch (par_state))-2))) /* Avoid
774 high_bit = ((ULONGEST)1)
775 << (gdbarch_long_bit (parse_gdbarch (par_state))-1);
776 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
777 signed_type = parse_type (par_state)->builtin_long;
782 ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1);
783 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
784 signed_type = parse_type (par_state)->builtin_int;
787 putithere->typed_val.val = n;
789 /* If the high bit of the worked out type is set then this number
790 has to be unsigned. */
792 if (unsigned_p || (n & high_bit))
793 putithere->typed_val.type = unsigned_type;
795 putithere->typed_val.type = signed_type;
800 /* Called to setup the type stack when we encounter a '(kind=N)' type
801 modifier, performs some bounds checking on 'N' and then pushes this to
802 the type stack followed by the 'tp_kind' marker. */
804 push_kind_type (LONGEST val, struct type *type)
808 if (TYPE_UNSIGNED (type))
810 ULONGEST uval = static_cast <ULONGEST> (val);
812 error (_("kind value out of range"));
813 ival = static_cast <int> (uval);
817 if (val > INT_MAX || val < 0)
818 error (_("kind value out of range"));
819 ival = static_cast <int> (val);
822 push_type_int (ival);
826 /* Called when a type has a '(kind=N)' modifier after it, for example
827 'character(kind=1)'. The BASETYPE is the type described by 'character'
828 in our example, and KIND is the integer '1'. This function returns a
829 new type that represents the basetype of a specific kind. */
831 convert_to_kind_type (struct type *basetype, int kind)
833 if (basetype == parse_f_type (pstate)->builtin_character)
835 /* Character of kind 1 is a special case, this is the same as the
836 base character type. */
838 return parse_f_type (pstate)->builtin_character;
840 else if (basetype == parse_f_type (pstate)->builtin_complex_s8)
843 return parse_f_type (pstate)->builtin_complex_s8;
845 return parse_f_type (pstate)->builtin_complex_s16;
847 return parse_f_type (pstate)->builtin_complex_s32;
849 else if (basetype == parse_f_type (pstate)->builtin_real)
852 return parse_f_type (pstate)->builtin_real;
854 return parse_f_type (pstate)->builtin_real_s8;
856 return parse_f_type (pstate)->builtin_real_s16;
858 else if (basetype == parse_f_type (pstate)->builtin_logical)
861 return parse_f_type (pstate)->builtin_logical_s1;
863 return parse_f_type (pstate)->builtin_logical_s2;
865 return parse_f_type (pstate)->builtin_logical;
867 return parse_f_type (pstate)->builtin_logical_s8;
869 else if (basetype == parse_f_type (pstate)->builtin_integer)
872 return parse_f_type (pstate)->builtin_integer_s2;
874 return parse_f_type (pstate)->builtin_integer;
876 return parse_f_type (pstate)->builtin_integer_s8;
879 error (_("unsupported kind %d for type %s"),
880 kind, TYPE_SAFE_NAME (basetype));
882 /* Should never get here. */
888 /* The string to match against. */
891 /* The lexer token to return. */
894 /* The expression opcode to embed within the token. */
895 enum exp_opcode opcode;
897 /* When this is true the string in OPER is matched exactly including
898 case, when this is false OPER is matched case insensitively. */
902 static const struct token dot_ops[] =
904 { ".and.", BOOL_AND, BINOP_END, false },
905 { ".or.", BOOL_OR, BINOP_END, false },
906 { ".not.", BOOL_NOT, BINOP_END, false },
907 { ".eq.", EQUAL, BINOP_END, false },
908 { ".eqv.", EQUAL, BINOP_END, false },
909 { ".neqv.", NOTEQUAL, BINOP_END, false },
910 { ".ne.", NOTEQUAL, BINOP_END, false },
911 { ".le.", LEQ, BINOP_END, false },
912 { ".ge.", GEQ, BINOP_END, false },
913 { ".gt.", GREATERTHAN, BINOP_END, false },
914 { ".lt.", LESSTHAN, BINOP_END, false },
917 /* Holds the Fortran representation of a boolean, and the integer value we
918 substitute in when one of the matching strings is parsed. */
919 struct f77_boolean_val
921 /* The string representing a Fortran boolean. */
924 /* The integer value to replace it with. */
928 /* The set of Fortran booleans. These are matched case insensitively. */
929 static const struct f77_boolean_val boolean_values[] =
935 static const struct token f77_keywords[] =
937 /* Historically these have always been lowercase only in GDB. */
938 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
939 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
940 { "character", CHARACTER, BINOP_END, true },
941 { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
942 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
943 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
944 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
945 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
946 { "integer", INT_KEYWORD, BINOP_END, true },
947 { "logical", LOGICAL_KEYWORD, BINOP_END, true },
948 { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
949 { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
950 { "sizeof", SIZEOF, BINOP_END, true },
951 { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
952 { "real", REAL_KEYWORD, BINOP_END, true },
953 /* The following correspond to actual functions in Fortran and are case
955 { "kind", KIND, BINOP_END, false },
956 { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
959 /* Implementation of a dynamically expandable buffer for processing input
960 characters acquired through lexptr and building a value to return in
961 yylval. Ripped off from ch-exp.y */
963 static char *tempbuf; /* Current buffer contents */
964 static int tempbufsize; /* Size of allocated buffer */
965 static int tempbufindex; /* Current index into buffer */
967 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
969 #define CHECKBUF(size) \
971 if (tempbufindex + (size) >= tempbufsize) \
973 growbuf_by_size (size); \
978 /* Grow the static temp buffer if necessary, including allocating the
979 first one on demand. */
982 growbuf_by_size (int count)
986 growby = std::max (count, GROWBY_MIN_SIZE);
987 tempbufsize += growby;
989 tempbuf = (char *) malloc (tempbufsize);
991 tempbuf = (char *) realloc (tempbuf, tempbufsize);
994 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
997 Recognize a string literal. A string literal is a nonzero sequence
998 of characters enclosed in matching single quotes, except that
999 a single character inside single quotes is a character literal, which
1000 we reject as a string literal. To embed the terminator character inside
1001 a string, it is simply doubled (I.E. 'this''is''one''string') */
1004 match_string_literal (void)
1006 const char *tokptr = lexptr;
1008 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1011 if (*tokptr == *lexptr)
1013 if (*(tokptr + 1) == *lexptr)
1018 tempbuf[tempbufindex++] = *tokptr;
1020 if (*tokptr == '\0' /* no terminator */
1021 || tempbufindex == 0) /* no string */
1025 tempbuf[tempbufindex] = '\0';
1026 yylval.sval.ptr = tempbuf;
1027 yylval.sval.length = tempbufindex;
1029 return STRING_LITERAL;
1033 /* Read one token, getting characters through lexptr. */
1041 const char *tokstart;
1045 prev_lexptr = lexptr;
1049 /* First of all, let us make sure we are not dealing with the
1050 special tokens .true. and .false. which evaluate to 1 and 0. */
1054 for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
1056 if (strncasecmp (tokstart, boolean_values[i].name,
1057 strlen (boolean_values[i].name)) == 0)
1059 lexptr += strlen (boolean_values[i].name);
1060 yylval.lval = boolean_values[i].value;
1061 return BOOLEAN_LITERAL;
1066 /* See if it is a special .foo. operator. */
1067 for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
1068 if (strncasecmp (tokstart, dot_ops[i].oper,
1069 strlen (dot_ops[i].oper)) == 0)
1071 gdb_assert (!dot_ops[i].case_sensitive);
1072 lexptr += strlen (dot_ops[i].oper);
1073 yylval.opcode = dot_ops[i].opcode;
1074 return dot_ops[i].token;
1077 /* See if it is an exponentiation operator. */
1079 if (strncmp (tokstart, "**", 2) == 0)
1082 yylval.opcode = BINOP_EXP;
1086 switch (c = *tokstart)
1098 token = match_string_literal ();
1109 if (paren_depth == 0)
1116 if (comma_terminates && paren_depth == 0)
1122 /* Might be a floating point number. */
1123 if (lexptr[1] < '0' || lexptr[1] > '9')
1124 goto symbol; /* Nope, must be a symbol. */
1138 /* It's a number. */
1139 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1140 const char *p = tokstart;
1141 int hex = input_radix > 10;
1143 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1148 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1149 || p[1]=='d' || p[1]=='D'))
1157 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1158 got_dot = got_e = 1;
1159 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1160 got_dot = got_d = 1;
1161 else if (!hex && !got_dot && *p == '.')
1163 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1164 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1165 && (*p == '-' || *p == '+'))
1166 /* This is the sign of the exponent, not the end of the
1169 /* We will take any letters or digits. parse_number will
1170 complain if past the radix, or if L or U are not final. */
1171 else if ((*p < '0' || *p > '9')
1172 && ((*p < 'a' || *p > 'z')
1173 && (*p < 'A' || *p > 'Z')))
1176 toktype = parse_number (pstate, tokstart, p - tokstart,
1177 got_dot|got_e|got_d,
1179 if (toktype == ERROR)
1181 char *err_copy = (char *) alloca (p - tokstart + 1);
1183 memcpy (err_copy, tokstart, p - tokstart);
1184 err_copy[p - tokstart] = 0;
1185 error (_("Invalid number \"%s\"."), err_copy);
1216 if (!(c == '_' || c == '$' || c ==':'
1217 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1218 /* We must have come across a bad character (e.g. ';'). */
1219 error (_("Invalid character '%c' in expression."), c);
1222 for (c = tokstart[namelen];
1223 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1224 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1225 c = tokstart[++namelen]);
1227 /* The token "if" terminates the expression and is NOT
1228 removed from the input stream. */
1230 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1235 /* Catch specific keywords. */
1237 for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
1238 if (strlen (f77_keywords[i].oper) == namelen
1239 && ((!f77_keywords[i].case_sensitive
1240 && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1241 || (f77_keywords[i].case_sensitive
1242 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
1244 yylval.opcode = f77_keywords[i].opcode;
1245 return f77_keywords[i].token;
1248 yylval.sval.ptr = tokstart;
1249 yylval.sval.length = namelen;
1251 if (*tokstart == '$')
1253 write_dollar_variable (pstate, yylval.sval);
1254 return DOLLAR_VARIABLE;
1257 /* Use token-type TYPENAME for symbols that happen to be defined
1258 currently as names of types; NAME for other symbols.
1259 The caller is not constrained to care about the distinction. */
1261 char *tmp = copy_name (yylval.sval);
1262 struct block_symbol result;
1263 struct field_of_this_result is_a_field_of_this;
1264 enum domain_enum_tag lookup_domains[] =
1272 for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1274 /* Initialize this in case we *don't* use it in this call; that
1275 way we can refer to it unconditionally below. */
1276 memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
1278 result = lookup_symbol (tmp, expression_context_block,
1280 parse_language (pstate)->la_language
1282 ? &is_a_field_of_this : NULL);
1283 if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
1285 yylval.tsym.type = SYMBOL_TYPE (result.symbol);
1294 = language_lookup_primitive_type (parse_language (pstate),
1295 parse_gdbarch (pstate), tmp);
1296 if (yylval.tsym.type != NULL)
1299 /* Input names that aren't symbols but ARE valid hex numbers,
1300 when the input radix permits them, can be names or numbers
1301 depending on the parse. Note we support radixes > 16 here. */
1303 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1304 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1306 YYSTYPE newlval; /* Its value is ignored. */
1307 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1310 yylval.ssym.sym = result;
1311 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1316 /* Any other kind of symbol */
1317 yylval.ssym.sym = result;
1318 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1324 f_parse (struct parser_state *par_state)
1326 /* Setting up the parser state. */
1327 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1328 scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1330 gdb_assert (par_state != NULL);
1337 yyerror (const char *msg)
1340 lexptr = prev_lexptr;
1342 error (_("A %s in expression, near `%s'."), msg, lexptr);