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 (ps->gdbarch ())
59 #define parse_f_type(ps) builtin_f_type (ps->gdbarch ())
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;
71 /* Depth of parentheses. */
72 static int paren_depth;
76 static int yylex (void);
78 static void yyerror (const char *);
80 static void growbuf_by_size (int);
82 static int match_string_literal (void);
84 static void push_kind_type (LONGEST val, struct type *type);
86 static struct type *convert_to_kind_type (struct type *basetype, int kind);
90 /* Although the yacc "value" of an expression is not used,
91 since the result is stored in the structure being created,
92 other node types do have values. */
109 struct symtoken ssym;
111 enum exp_opcode opcode;
112 struct internalvar *ivar;
119 /* YYSTYPE gets defined by %union */
120 static int parse_number (struct parser_state *, const char *, int,
124 %type <voidval> exp type_exp start variable
125 %type <tval> type typebase
126 %type <tvec> nonempty_typelist
127 /* %type <bval> block */
129 /* Fancy type parsing. */
130 %type <voidval> func_mod direct_abs_decl abs_decl
133 %token <typed_val> INT
134 %token <typed_val_float> FLOAT
136 /* Both NAME and TYPENAME tokens represent symbols in the input,
137 and both convey their data as strings.
138 But a TYPENAME is a string that happens to be defined as a typedef
139 or builtin type name (such as int or char)
140 and a NAME is any other symbol.
141 Contexts where this distinction is not important can use the
142 nonterminal "name", which matches either NAME or TYPENAME. */
144 %token <sval> STRING_LITERAL
145 %token <lval> BOOLEAN_LITERAL
147 %token <tsym> TYPENAME
149 %type <ssym> name_not_typename
151 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
152 but which would parse as a valid number in the current input radix.
153 E.g. "c" when input_radix==16. Depending on the parse, it will be
154 turned into a name or into a number. */
156 %token <ssym> NAME_OR_INT
161 /* Special type cases, put in to allow the parser to distinguish different
163 %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD
164 %token LOGICAL_S8_KEYWORD
165 %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD
166 %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD
167 %token BOOL_AND BOOL_OR BOOL_NOT
168 %token <lval> CHARACTER
170 %token <voidval> DOLLAR_VARIABLE
172 %token <opcode> ASSIGN_MODIFY
173 %token <opcode> UNOP_INTRINSIC
177 %right '=' ASSIGN_MODIFY
186 %left LESSTHAN GREATERTHAN LEQ GEQ
204 { write_exp_elt_opcode (pstate, OP_TYPE);
205 write_exp_elt_type (pstate, $1);
206 write_exp_elt_opcode (pstate, OP_TYPE); }
213 /* Expressions, not including the comma operator. */
214 exp : '*' exp %prec UNARY
215 { write_exp_elt_opcode (pstate, UNOP_IND); }
218 exp : '&' exp %prec UNARY
219 { write_exp_elt_opcode (pstate, UNOP_ADDR); }
222 exp : '-' exp %prec UNARY
223 { write_exp_elt_opcode (pstate, UNOP_NEG); }
226 exp : BOOL_NOT exp %prec UNARY
227 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
230 exp : '~' exp %prec UNARY
231 { write_exp_elt_opcode (pstate, UNOP_COMPLEMENT); }
234 exp : SIZEOF exp %prec UNARY
235 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
238 exp : KIND '(' exp ')' %prec UNARY
239 { write_exp_elt_opcode (pstate, UNOP_KIND); }
242 /* No more explicit array operators, we treat everything in F77 as
243 a function call. The disambiguation as to whether we are
244 doing a subscript operation or a function call is done
248 { start_arglist (); }
250 { write_exp_elt_opcode (pstate,
251 OP_F77_UNDETERMINED_ARGLIST);
252 write_exp_elt_longcst (pstate,
253 (LONGEST) end_arglist ());
254 write_exp_elt_opcode (pstate,
255 OP_F77_UNDETERMINED_ARGLIST); }
258 exp : UNOP_INTRINSIC '(' exp ')'
259 { write_exp_elt_opcode (pstate, $1); }
273 arglist : arglist ',' exp %prec ABOVE_COMMA
277 /* There are four sorts of subrange types in F90. */
279 subrange: exp ':' exp %prec ABOVE_COMMA
280 { write_exp_elt_opcode (pstate, OP_RANGE);
281 write_exp_elt_longcst (pstate, NONE_BOUND_DEFAULT);
282 write_exp_elt_opcode (pstate, OP_RANGE); }
285 subrange: exp ':' %prec ABOVE_COMMA
286 { write_exp_elt_opcode (pstate, OP_RANGE);
287 write_exp_elt_longcst (pstate, HIGH_BOUND_DEFAULT);
288 write_exp_elt_opcode (pstate, OP_RANGE); }
291 subrange: ':' exp %prec ABOVE_COMMA
292 { write_exp_elt_opcode (pstate, OP_RANGE);
293 write_exp_elt_longcst (pstate, LOW_BOUND_DEFAULT);
294 write_exp_elt_opcode (pstate, OP_RANGE); }
297 subrange: ':' %prec ABOVE_COMMA
298 { write_exp_elt_opcode (pstate, OP_RANGE);
299 write_exp_elt_longcst (pstate, BOTH_BOUND_DEFAULT);
300 write_exp_elt_opcode (pstate, OP_RANGE); }
303 complexnum: exp ',' exp
307 exp : '(' complexnum ')'
308 { write_exp_elt_opcode (pstate, OP_COMPLEX);
309 write_exp_elt_type (pstate,
310 parse_f_type (pstate)
311 ->builtin_complex_s16);
312 write_exp_elt_opcode (pstate, OP_COMPLEX); }
315 exp : '(' type ')' exp %prec UNARY
316 { write_exp_elt_opcode (pstate, UNOP_CAST);
317 write_exp_elt_type (pstate, $2);
318 write_exp_elt_opcode (pstate, UNOP_CAST); }
322 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
323 write_exp_string (pstate, $3);
324 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
327 /* Binary operators in order of decreasing precedence. */
330 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
333 exp : exp STARSTAR exp
334 { write_exp_elt_opcode (pstate, BINOP_EXP); }
338 { write_exp_elt_opcode (pstate, BINOP_MUL); }
342 { write_exp_elt_opcode (pstate, BINOP_DIV); }
346 { write_exp_elt_opcode (pstate, BINOP_ADD); }
350 { write_exp_elt_opcode (pstate, BINOP_SUB); }
354 { write_exp_elt_opcode (pstate, BINOP_LSH); }
358 { write_exp_elt_opcode (pstate, BINOP_RSH); }
362 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
365 exp : exp NOTEQUAL exp
366 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
370 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
374 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
377 exp : exp LESSTHAN exp
378 { write_exp_elt_opcode (pstate, BINOP_LESS); }
381 exp : exp GREATERTHAN exp
382 { write_exp_elt_opcode (pstate, BINOP_GTR); }
386 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
390 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
394 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
397 exp : exp BOOL_AND exp
398 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
402 exp : exp BOOL_OR exp
403 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
407 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
410 exp : exp ASSIGN_MODIFY exp
411 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
412 write_exp_elt_opcode (pstate, $2);
413 write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY); }
417 { write_exp_elt_opcode (pstate, OP_LONG);
418 write_exp_elt_type (pstate, $1.type);
419 write_exp_elt_longcst (pstate, (LONGEST) ($1.val));
420 write_exp_elt_opcode (pstate, OP_LONG); }
425 parse_number (pstate, $1.stoken.ptr,
426 $1.stoken.length, 0, &val);
427 write_exp_elt_opcode (pstate, OP_LONG);
428 write_exp_elt_type (pstate, val.typed_val.type);
429 write_exp_elt_longcst (pstate,
430 (LONGEST)val.typed_val.val);
431 write_exp_elt_opcode (pstate, OP_LONG); }
435 { write_exp_elt_opcode (pstate, OP_FLOAT);
436 write_exp_elt_type (pstate, $1.type);
437 write_exp_elt_floatcst (pstate, $1.val);
438 write_exp_elt_opcode (pstate, OP_FLOAT); }
444 exp : DOLLAR_VARIABLE
447 exp : SIZEOF '(' type ')' %prec UNARY
448 { write_exp_elt_opcode (pstate, OP_LONG);
449 write_exp_elt_type (pstate,
450 parse_f_type (pstate)
452 $3 = check_typedef ($3);
453 write_exp_elt_longcst (pstate,
454 (LONGEST) TYPE_LENGTH ($3));
455 write_exp_elt_opcode (pstate, OP_LONG); }
458 exp : BOOLEAN_LITERAL
459 { write_exp_elt_opcode (pstate, OP_BOOL);
460 write_exp_elt_longcst (pstate, (LONGEST) $1);
461 write_exp_elt_opcode (pstate, OP_BOOL);
467 write_exp_elt_opcode (pstate, OP_STRING);
468 write_exp_string (pstate, $1);
469 write_exp_elt_opcode (pstate, OP_STRING);
473 variable: name_not_typename
474 { struct block_symbol sym = $1.sym;
478 if (symbol_read_needs_frame (sym.symbol))
479 innermost_block.update (sym);
480 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
481 write_exp_elt_block (pstate, sym.block);
482 write_exp_elt_sym (pstate, sym.symbol);
483 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
488 struct bound_minimal_symbol msymbol;
489 char *arg = copy_name ($1.stoken);
492 lookup_bound_minimal_symbol (arg);
493 if (msymbol.minsym != NULL)
494 write_exp_msymbol (pstate, msymbol);
495 else if (!have_full_symbols () && !have_partial_symbols ())
496 error (_("No symbol table is loaded. Use the \"file\" command."));
498 error (_("No symbol \"%s\" in current context."),
499 copy_name ($1.stoken));
511 /* This is where the interesting stuff happens. */
514 struct type *follow_type = $1;
515 struct type *range_type;
524 follow_type = lookup_pointer_type (follow_type);
527 follow_type = lookup_lvalue_reference_type (follow_type);
530 array_size = pop_type_int ();
531 if (array_size != -1)
534 create_static_range_type ((struct type *) NULL,
535 parse_f_type (pstate)
539 create_array_type ((struct type *) NULL,
540 follow_type, range_type);
543 follow_type = lookup_pointer_type (follow_type);
546 follow_type = lookup_function_type (follow_type);
550 int kind_val = pop_type_int ();
552 = convert_to_kind_type (follow_type, kind_val);
561 { push_type (tp_pointer); $$ = 0; }
563 { push_type (tp_pointer); $$ = $2; }
565 { push_type (tp_reference); $$ = 0; }
567 { push_type (tp_reference); $$ = $2; }
571 direct_abs_decl: '(' abs_decl ')'
573 | '(' KIND '=' INT ')'
574 { push_kind_type ($4.val, $4.type); }
576 { push_kind_type ($2.val, $2.type); }
577 | direct_abs_decl func_mod
578 { push_type (tp_function); }
580 { push_type (tp_function); }
585 | '(' nonempty_typelist ')'
586 { free ($2); $$ = 0; }
589 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
593 { $$ = parse_f_type (pstate)->builtin_integer; }
595 { $$ = parse_f_type (pstate)->builtin_integer_s2; }
597 { $$ = parse_f_type (pstate)->builtin_character; }
599 { $$ = parse_f_type (pstate)->builtin_logical_s8; }
601 { $$ = parse_f_type (pstate)->builtin_logical; }
603 { $$ = parse_f_type (pstate)->builtin_logical_s2; }
605 { $$ = parse_f_type (pstate)->builtin_logical_s1; }
607 { $$ = parse_f_type (pstate)->builtin_real; }
609 { $$ = parse_f_type (pstate)->builtin_real_s8; }
611 { $$ = parse_f_type (pstate)->builtin_real_s16; }
613 { $$ = parse_f_type (pstate)->builtin_complex_s8; }
614 | COMPLEX_S16_KEYWORD
615 { $$ = parse_f_type (pstate)->builtin_complex_s16; }
616 | COMPLEX_S32_KEYWORD
617 { $$ = parse_f_type (pstate)->builtin_complex_s32; }
622 { $$ = (struct type **) malloc (sizeof (struct type *) * 2);
623 $<ivec>$[0] = 1; /* Number of types in vector */
626 | nonempty_typelist ',' type
627 { int len = sizeof (struct type *) * (++($<ivec>1[0]) + 1);
628 $$ = (struct type **) realloc ((char *) $1, len);
629 $$[$<ivec>$[0]] = $3;
637 name_not_typename : NAME
638 /* These would be useful if name_not_typename was useful, but it is just
639 a fake for "variable", so these cause reduce/reduce conflicts because
640 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
641 =exp) or just an exp. If name_not_typename was ever used in an lvalue
642 context where only a name could occur, this might be useful.
649 /* Take care of parsing a number (anything that starts with a digit).
650 Set yylval and return the token type; update lexptr.
651 LEN is the number of characters in it. */
653 /*** Needs some error checking for the float case ***/
656 parse_number (struct parser_state *par_state,
657 const char *p, int len, int parsed_float, YYSTYPE *putithere)
662 int base = input_radix;
666 struct type *signed_type;
667 struct type *unsigned_type;
671 /* It's a float since it contains a point or an exponent. */
672 /* [dD] is not understood as an exponent by parse_float,
677 for (tmp2 = tmp; *tmp2; ++tmp2)
678 if (*tmp2 == 'd' || *tmp2 == 'D')
681 /* FIXME: Should this use different types? */
682 putithere->typed_val_float.type = parse_f_type (pstate)->builtin_real_s8;
683 bool parsed = parse_float (tmp, len,
684 putithere->typed_val_float.type,
685 putithere->typed_val_float.val);
687 return parsed? FLOAT : ERROR;
690 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
726 if (len == 0 && c == 'l')
728 else if (len == 0 && c == 'u')
733 if (c >= '0' && c <= '9')
735 else if (c >= 'a' && c <= 'f')
738 return ERROR; /* Char not a digit */
740 return ERROR; /* Invalid digit in this base */
744 /* Portably test for overflow (only works for nonzero values, so make
745 a second check for zero). */
746 if ((prevn >= n) && n != 0)
747 unsigned_p=1; /* Try something unsigned */
748 /* If range checking enabled, portably test for unsigned overflow. */
749 if (RANGE_CHECK && n != 0)
751 if ((unsigned_p && (unsigned)prevn >= (unsigned)n))
752 range_error (_("Overflow on numeric constant."));
757 /* If the number is too big to be an int, or it's got an l suffix
758 then it's a long. Work out if this has to be a long by
759 shifting right and seeing if anything remains, and the
760 target int size is different to the target long size.
762 In the expression below, we could have tested
763 (n >> gdbarch_int_bit (parse_gdbarch))
764 to see if it was zero,
765 but too many compilers warn about that, when ints and longs
766 are the same size. So we shift it twice, with fewer bits
767 each time, for the same result. */
769 if ((gdbarch_int_bit (par_state->gdbarch ())
770 != gdbarch_long_bit (par_state->gdbarch ())
772 >> (gdbarch_int_bit (par_state->gdbarch ())-2))) /* Avoid
776 high_bit = ((ULONGEST)1)
777 << (gdbarch_long_bit (par_state->gdbarch ())-1);
778 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
779 signed_type = parse_type (par_state)->builtin_long;
784 ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
785 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
786 signed_type = parse_type (par_state)->builtin_int;
789 putithere->typed_val.val = n;
791 /* If the high bit of the worked out type is set then this number
792 has to be unsigned. */
794 if (unsigned_p || (n & high_bit))
795 putithere->typed_val.type = unsigned_type;
797 putithere->typed_val.type = signed_type;
802 /* Called to setup the type stack when we encounter a '(kind=N)' type
803 modifier, performs some bounds checking on 'N' and then pushes this to
804 the type stack followed by the 'tp_kind' marker. */
806 push_kind_type (LONGEST val, struct type *type)
810 if (TYPE_UNSIGNED (type))
812 ULONGEST uval = static_cast <ULONGEST> (val);
814 error (_("kind value out of range"));
815 ival = static_cast <int> (uval);
819 if (val > INT_MAX || val < 0)
820 error (_("kind value out of range"));
821 ival = static_cast <int> (val);
824 push_type_int (ival);
828 /* Called when a type has a '(kind=N)' modifier after it, for example
829 'character(kind=1)'. The BASETYPE is the type described by 'character'
830 in our example, and KIND is the integer '1'. This function returns a
831 new type that represents the basetype of a specific kind. */
833 convert_to_kind_type (struct type *basetype, int kind)
835 if (basetype == parse_f_type (pstate)->builtin_character)
837 /* Character of kind 1 is a special case, this is the same as the
838 base character type. */
840 return parse_f_type (pstate)->builtin_character;
842 else if (basetype == parse_f_type (pstate)->builtin_complex_s8)
845 return parse_f_type (pstate)->builtin_complex_s8;
847 return parse_f_type (pstate)->builtin_complex_s16;
849 return parse_f_type (pstate)->builtin_complex_s32;
851 else if (basetype == parse_f_type (pstate)->builtin_real)
854 return parse_f_type (pstate)->builtin_real;
856 return parse_f_type (pstate)->builtin_real_s8;
858 return parse_f_type (pstate)->builtin_real_s16;
860 else if (basetype == parse_f_type (pstate)->builtin_logical)
863 return parse_f_type (pstate)->builtin_logical_s1;
865 return parse_f_type (pstate)->builtin_logical_s2;
867 return parse_f_type (pstate)->builtin_logical;
869 return parse_f_type (pstate)->builtin_logical_s8;
871 else if (basetype == parse_f_type (pstate)->builtin_integer)
874 return parse_f_type (pstate)->builtin_integer_s2;
876 return parse_f_type (pstate)->builtin_integer;
878 return parse_f_type (pstate)->builtin_integer_s8;
881 error (_("unsupported kind %d for type %s"),
882 kind, TYPE_SAFE_NAME (basetype));
884 /* Should never get here. */
890 /* The string to match against. */
893 /* The lexer token to return. */
896 /* The expression opcode to embed within the token. */
897 enum exp_opcode opcode;
899 /* When this is true the string in OPER is matched exactly including
900 case, when this is false OPER is matched case insensitively. */
904 static const struct token dot_ops[] =
906 { ".and.", BOOL_AND, BINOP_END, false },
907 { ".or.", BOOL_OR, BINOP_END, false },
908 { ".not.", BOOL_NOT, BINOP_END, false },
909 { ".eq.", EQUAL, BINOP_END, false },
910 { ".eqv.", EQUAL, BINOP_END, false },
911 { ".neqv.", NOTEQUAL, BINOP_END, false },
912 { ".ne.", NOTEQUAL, BINOP_END, false },
913 { ".le.", LEQ, BINOP_END, false },
914 { ".ge.", GEQ, BINOP_END, false },
915 { ".gt.", GREATERTHAN, BINOP_END, false },
916 { ".lt.", LESSTHAN, BINOP_END, false },
919 /* Holds the Fortran representation of a boolean, and the integer value we
920 substitute in when one of the matching strings is parsed. */
921 struct f77_boolean_val
923 /* The string representing a Fortran boolean. */
926 /* The integer value to replace it with. */
930 /* The set of Fortran booleans. These are matched case insensitively. */
931 static const struct f77_boolean_val boolean_values[] =
937 static const struct token f77_keywords[] =
939 /* Historically these have always been lowercase only in GDB. */
940 { "complex_16", COMPLEX_S16_KEYWORD, BINOP_END, true },
941 { "complex_32", COMPLEX_S32_KEYWORD, BINOP_END, true },
942 { "character", CHARACTER, BINOP_END, true },
943 { "integer_2", INT_S2_KEYWORD, BINOP_END, true },
944 { "logical_1", LOGICAL_S1_KEYWORD, BINOP_END, true },
945 { "logical_2", LOGICAL_S2_KEYWORD, BINOP_END, true },
946 { "logical_8", LOGICAL_S8_KEYWORD, BINOP_END, true },
947 { "complex_8", COMPLEX_S8_KEYWORD, BINOP_END, true },
948 { "integer", INT_KEYWORD, BINOP_END, true },
949 { "logical", LOGICAL_KEYWORD, BINOP_END, true },
950 { "real_16", REAL_S16_KEYWORD, BINOP_END, true },
951 { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true },
952 { "sizeof", SIZEOF, BINOP_END, true },
953 { "real_8", REAL_S8_KEYWORD, BINOP_END, true },
954 { "real", REAL_KEYWORD, BINOP_END, true },
955 /* The following correspond to actual functions in Fortran and are case
957 { "kind", KIND, BINOP_END, false },
958 { "abs", UNOP_INTRINSIC, UNOP_ABS, false }
961 /* Implementation of a dynamically expandable buffer for processing input
962 characters acquired through lexptr and building a value to return in
963 yylval. Ripped off from ch-exp.y */
965 static char *tempbuf; /* Current buffer contents */
966 static int tempbufsize; /* Size of allocated buffer */
967 static int tempbufindex; /* Current index into buffer */
969 #define GROWBY_MIN_SIZE 64 /* Minimum amount to grow buffer by */
971 #define CHECKBUF(size) \
973 if (tempbufindex + (size) >= tempbufsize) \
975 growbuf_by_size (size); \
980 /* Grow the static temp buffer if necessary, including allocating the
981 first one on demand. */
984 growbuf_by_size (int count)
988 growby = std::max (count, GROWBY_MIN_SIZE);
989 tempbufsize += growby;
991 tempbuf = (char *) malloc (tempbufsize);
993 tempbuf = (char *) realloc (tempbuf, tempbufsize);
996 /* Blatantly ripped off from ch-exp.y. This routine recognizes F77
999 Recognize a string literal. A string literal is a nonzero sequence
1000 of characters enclosed in matching single quotes, except that
1001 a single character inside single quotes is a character literal, which
1002 we reject as a string literal. To embed the terminator character inside
1003 a string, it is simply doubled (I.E. 'this''is''one''string') */
1006 match_string_literal (void)
1008 const char *tokptr = lexptr;
1010 for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
1013 if (*tokptr == *lexptr)
1015 if (*(tokptr + 1) == *lexptr)
1020 tempbuf[tempbufindex++] = *tokptr;
1022 if (*tokptr == '\0' /* no terminator */
1023 || tempbufindex == 0) /* no string */
1027 tempbuf[tempbufindex] = '\0';
1028 yylval.sval.ptr = tempbuf;
1029 yylval.sval.length = tempbufindex;
1031 return STRING_LITERAL;
1035 /* Read one token, getting characters through lexptr. */
1043 const char *tokstart;
1047 prev_lexptr = lexptr;
1051 /* First of all, let us make sure we are not dealing with the
1052 special tokens .true. and .false. which evaluate to 1 and 0. */
1056 for (int i = 0; i < ARRAY_SIZE (boolean_values); i++)
1058 if (strncasecmp (tokstart, boolean_values[i].name,
1059 strlen (boolean_values[i].name)) == 0)
1061 lexptr += strlen (boolean_values[i].name);
1062 yylval.lval = boolean_values[i].value;
1063 return BOOLEAN_LITERAL;
1068 /* See if it is a special .foo. operator. */
1069 for (int i = 0; i < ARRAY_SIZE (dot_ops); i++)
1070 if (strncasecmp (tokstart, dot_ops[i].oper,
1071 strlen (dot_ops[i].oper)) == 0)
1073 gdb_assert (!dot_ops[i].case_sensitive);
1074 lexptr += strlen (dot_ops[i].oper);
1075 yylval.opcode = dot_ops[i].opcode;
1076 return dot_ops[i].token;
1079 /* See if it is an exponentiation operator. */
1081 if (strncmp (tokstart, "**", 2) == 0)
1084 yylval.opcode = BINOP_EXP;
1088 switch (c = *tokstart)
1100 token = match_string_literal ();
1111 if (paren_depth == 0)
1118 if (pstate->comma_terminates && paren_depth == 0)
1124 /* Might be a floating point number. */
1125 if (lexptr[1] < '0' || lexptr[1] > '9')
1126 goto symbol; /* Nope, must be a symbol. */
1140 /* It's a number. */
1141 int got_dot = 0, got_e = 0, got_d = 0, toktype;
1142 const char *p = tokstart;
1143 int hex = input_radix > 10;
1145 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1150 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1151 || p[1]=='d' || p[1]=='D'))
1159 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1160 got_dot = got_e = 1;
1161 else if (!hex && !got_d && (*p == 'd' || *p == 'D'))
1162 got_dot = got_d = 1;
1163 else if (!hex && !got_dot && *p == '.')
1165 else if (((got_e && (p[-1] == 'e' || p[-1] == 'E'))
1166 || (got_d && (p[-1] == 'd' || p[-1] == 'D')))
1167 && (*p == '-' || *p == '+'))
1168 /* This is the sign of the exponent, not the end of the
1171 /* We will take any letters or digits. parse_number will
1172 complain if past the radix, or if L or U are not final. */
1173 else if ((*p < '0' || *p > '9')
1174 && ((*p < 'a' || *p > 'z')
1175 && (*p < 'A' || *p > 'Z')))
1178 toktype = parse_number (pstate, tokstart, p - tokstart,
1179 got_dot|got_e|got_d,
1181 if (toktype == ERROR)
1183 char *err_copy = (char *) alloca (p - tokstart + 1);
1185 memcpy (err_copy, tokstart, p - tokstart);
1186 err_copy[p - tokstart] = 0;
1187 error (_("Invalid number \"%s\"."), err_copy);
1218 if (!(c == '_' || c == '$' || c ==':'
1219 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1220 /* We must have come across a bad character (e.g. ';'). */
1221 error (_("Invalid character '%c' in expression."), c);
1224 for (c = tokstart[namelen];
1225 (c == '_' || c == '$' || c == ':' || (c >= '0' && c <= '9')
1226 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1227 c = tokstart[++namelen]);
1229 /* The token "if" terminates the expression and is NOT
1230 removed from the input stream. */
1232 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1237 /* Catch specific keywords. */
1239 for (int i = 0; i < ARRAY_SIZE (f77_keywords); i++)
1240 if (strlen (f77_keywords[i].oper) == namelen
1241 && ((!f77_keywords[i].case_sensitive
1242 && strncasecmp (tokstart, f77_keywords[i].oper, namelen) == 0)
1243 || (f77_keywords[i].case_sensitive
1244 && strncmp (tokstart, f77_keywords[i].oper, namelen) == 0)))
1246 yylval.opcode = f77_keywords[i].opcode;
1247 return f77_keywords[i].token;
1250 yylval.sval.ptr = tokstart;
1251 yylval.sval.length = namelen;
1253 if (*tokstart == '$')
1255 write_dollar_variable (pstate, yylval.sval);
1256 return DOLLAR_VARIABLE;
1259 /* Use token-type TYPENAME for symbols that happen to be defined
1260 currently as names of types; NAME for other symbols.
1261 The caller is not constrained to care about the distinction. */
1263 char *tmp = copy_name (yylval.sval);
1264 struct block_symbol result;
1265 struct field_of_this_result is_a_field_of_this;
1266 enum domain_enum_tag lookup_domains[] =
1274 for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i)
1276 /* Initialize this in case we *don't* use it in this call; that
1277 way we can refer to it unconditionally below. */
1278 memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this));
1280 result = lookup_symbol (tmp, pstate->expression_context_block,
1282 pstate->language ()->la_language
1284 ? &is_a_field_of_this : NULL);
1285 if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF)
1287 yylval.tsym.type = SYMBOL_TYPE (result.symbol);
1296 = language_lookup_primitive_type (pstate->language (),
1297 pstate->gdbarch (), tmp);
1298 if (yylval.tsym.type != NULL)
1301 /* Input names that aren't symbols but ARE valid hex numbers,
1302 when the input radix permits them, can be names or numbers
1303 depending on the parse. Note we support radixes > 16 here. */
1305 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1306 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1308 YYSTYPE newlval; /* Its value is ignored. */
1309 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1312 yylval.ssym.sym = result;
1313 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1318 /* Any other kind of symbol */
1319 yylval.ssym.sym = result;
1320 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1326 f_parse (struct parser_state *par_state)
1328 /* Setting up the parser state. */
1329 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1330 scoped_restore restore_yydebug = make_scoped_restore (&yydebug,
1332 gdb_assert (par_state != NULL);
1340 yyerror (const char *msg)
1343 lexptr = prev_lexptr;
1345 error (_("A %s in expression, near `%s'."), msg, lexptr);