X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Ff-exp.y;h=0fa18dd1860664ad140c8dbd2883665975a7f6ac;hb=refs%2Fheads%2Fconcurrent-displaced-stepping-2020-04-01;hp=88c685a0af35bd27e5664e8a5d1d175c8d16b426;hpb=0841c79a3dc1cfa382164a6bb2c1ee41af3ab0a9;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/f-exp.y b/gdb/f-exp.y index 88c685a0af..0fa18dd186 100644 --- a/gdb/f-exp.y +++ b/gdb/f-exp.y @@ -1,6 +1,6 @@ /* YACC parser for Fortran expressions, for GDB. - Copyright (C) 1986-2019 Free Software Foundation, Inc. + Copyright (C) 1986-2020 Free Software Foundation, Inc. Contributed by Motorola. Adapted from the C parser by Farooq Butt (fmbutt@engage.sps.mot.com). @@ -54,9 +54,10 @@ #include "block.h" #include #include +#include "type-stack.h" -#define parse_type(ps) builtin_type (parse_gdbarch (ps)) -#define parse_f_type(ps) builtin_f_type (parse_gdbarch (ps)) +#define parse_type(ps) builtin_type (ps->gdbarch ()) +#define parse_f_type(ps) builtin_f_type (ps->gdbarch ()) /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc). */ @@ -68,6 +69,12 @@ static struct parser_state *pstate = NULL; +/* Depth of parentheses. */ +static int paren_depth; + +/* The current type stack. */ +static struct type_stack *type_stack; + int yyparse (void); static int yylex (void); @@ -105,7 +112,6 @@ static struct type *convert_to_kind_type (struct type *basetype, int kind); struct ttype tsym; struct symtoken ssym; int voidval; - struct block *bval; enum exp_opcode opcode; struct internalvar *ivar; @@ -161,14 +167,16 @@ static int parse_number (struct parser_state *, const char *, int, %token INT_KEYWORD INT_S2_KEYWORD LOGICAL_S1_KEYWORD LOGICAL_S2_KEYWORD %token LOGICAL_S8_KEYWORD %token LOGICAL_KEYWORD REAL_KEYWORD REAL_S8_KEYWORD REAL_S16_KEYWORD +%token COMPLEX_KEYWORD %token COMPLEX_S8_KEYWORD COMPLEX_S16_KEYWORD COMPLEX_S32_KEYWORD %token BOOL_AND BOOL_OR BOOL_NOT +%token SINGLE DOUBLE PRECISION %token CHARACTER %token DOLLAR_VARIABLE %token ASSIGN_MODIFY -%token UNOP_INTRINSIC +%token UNOP_INTRINSIC BINOP_INTRINSIC %left ',' %left ABOVE_COMMA @@ -234,7 +242,7 @@ exp : SIZEOF exp %prec UNARY ; exp : KIND '(' exp ')' %prec UNARY - { write_exp_elt_opcode (pstate, UNOP_KIND); } + { write_exp_elt_opcode (pstate, UNOP_FORTRAN_KIND); } ; /* No more explicit array operators, we treat everything in F77 as @@ -243,12 +251,12 @@ exp : KIND '(' exp ')' %prec UNARY later in eval.c. */ exp : exp '(' - { start_arglist (); } + { pstate->start_arglist (); } arglist ')' { write_exp_elt_opcode (pstate, OP_F77_UNDETERMINED_ARGLIST); write_exp_elt_longcst (pstate, - (LONGEST) end_arglist ()); + pstate->end_arglist ()); write_exp_elt_opcode (pstate, OP_F77_UNDETERMINED_ARGLIST); } ; @@ -257,19 +265,23 @@ exp : UNOP_INTRINSIC '(' exp ')' { write_exp_elt_opcode (pstate, $1); } ; +exp : BINOP_INTRINSIC '(' exp ',' exp ')' + { write_exp_elt_opcode (pstate, $1); } + ; + arglist : ; arglist : exp - { arglist_len = 1; } + { pstate->arglist_len = 1; } ; arglist : subrange - { arglist_len = 1; } + { pstate->arglist_len = 1; } ; arglist : arglist ',' exp %prec ABOVE_COMMA - { arglist_len++; } + { pstate->arglist_len++; } ; /* There are four sorts of subrange types in F90. */ @@ -474,7 +486,7 @@ variable: name_not_typename if (sym.symbol) { if (symbol_read_needs_frame (sym.symbol)) - innermost_block.update (sym); + pstate->block_tracker->update (sym); write_exp_elt_opcode (pstate, OP_VAR_VALUE); write_exp_elt_block (pstate, sym.block); write_exp_elt_sym (pstate, sym.symbol); @@ -484,17 +496,17 @@ variable: name_not_typename else { struct bound_minimal_symbol msymbol; - char *arg = copy_name ($1.stoken); + std::string arg = copy_name ($1.stoken); msymbol = - lookup_bound_minimal_symbol (arg); + lookup_bound_minimal_symbol (arg.c_str ()); if (msymbol.minsym != NULL) write_exp_msymbol (pstate, msymbol); else if (!have_full_symbols () && !have_partial_symbols ()) error (_("No symbol table is loaded. Use the \"file\" command.")); else error (_("No symbol \"%s\" in current context."), - copy_name ($1.stoken)); + arg.c_str ()); } } ; @@ -513,7 +525,7 @@ ptype : typebase struct type *range_type; while (!done) - switch (pop_type ()) + switch (type_stack->pop ()) { case tp_end: done = 1; @@ -525,7 +537,7 @@ ptype : typebase follow_type = lookup_lvalue_reference_type (follow_type); break; case tp_array: - array_size = pop_type_int (); + array_size = type_stack->pop_int (); if (array_size != -1) { range_type = @@ -545,7 +557,7 @@ ptype : typebase break; case tp_kind: { - int kind_val = pop_type_int (); + int kind_val = type_stack->pop_int (); follow_type = convert_to_kind_type (follow_type, kind_val); } @@ -556,13 +568,13 @@ ptype : typebase ; abs_decl: '*' - { push_type (tp_pointer); $$ = 0; } + { type_stack->push (tp_pointer); $$ = 0; } | '*' abs_decl - { push_type (tp_pointer); $$ = $2; } + { type_stack->push (tp_pointer); $$ = $2; } | '&' - { push_type (tp_reference); $$ = 0; } + { type_stack->push (tp_reference); $$ = 0; } | '&' abs_decl - { push_type (tp_reference); $$ = $2; } + { type_stack->push (tp_reference); $$ = $2; } | direct_abs_decl ; @@ -570,10 +582,12 @@ direct_abs_decl: '(' abs_decl ')' { $$ = $2; } | '(' KIND '=' INT ')' { push_kind_type ($4.val, $4.type); } + | '*' INT + { push_kind_type ($2.val, $2.type); } | direct_abs_decl func_mod - { push_type (tp_function); } + { type_stack->push (tp_function); } | func_mod - { push_type (tp_function); } + { type_stack->push (tp_function); } ; func_mod: '(' ')' @@ -605,12 +619,22 @@ typebase /* Implements (approximately): (type-qualifier)* type-specifier */ { $$ = parse_f_type (pstate)->builtin_real_s8; } | REAL_S16_KEYWORD { $$ = parse_f_type (pstate)->builtin_real_s16; } + | COMPLEX_KEYWORD + { $$ = parse_f_type (pstate)->builtin_complex_s8; } | COMPLEX_S8_KEYWORD { $$ = parse_f_type (pstate)->builtin_complex_s8; } | COMPLEX_S16_KEYWORD { $$ = parse_f_type (pstate)->builtin_complex_s16; } | COMPLEX_S32_KEYWORD { $$ = parse_f_type (pstate)->builtin_complex_s32; } + | SINGLE PRECISION + { $$ = parse_f_type (pstate)->builtin_real;} + | DOUBLE PRECISION + { $$ = parse_f_type (pstate)->builtin_real_s8;} + | SINGLE COMPLEX_KEYWORD + { $$ = parse_f_type (pstate)->builtin_complex_s8;} + | DOUBLE COMPLEX_KEYWORD + { $$ = parse_f_type (pstate)->builtin_complex_s16;} ; nonempty_typelist @@ -762,22 +786,22 @@ parse_number (struct parser_state *par_state, are the same size. So we shift it twice, with fewer bits each time, for the same result. */ - if ((gdbarch_int_bit (parse_gdbarch (par_state)) - != gdbarch_long_bit (parse_gdbarch (par_state)) + if ((gdbarch_int_bit (par_state->gdbarch ()) + != gdbarch_long_bit (par_state->gdbarch ()) && ((n >> 2) - >> (gdbarch_int_bit (parse_gdbarch (par_state))-2))) /* Avoid + >> (gdbarch_int_bit (par_state->gdbarch ())-2))) /* Avoid shift warning */ || long_p) { high_bit = ((ULONGEST)1) - << (gdbarch_long_bit (parse_gdbarch (par_state))-1); + << (gdbarch_long_bit (par_state->gdbarch ())-1); unsigned_type = parse_type (par_state)->builtin_unsigned_long; signed_type = parse_type (par_state)->builtin_long; } else { high_bit = - ((ULONGEST)1) << (gdbarch_int_bit (parse_gdbarch (par_state)) - 1); + ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1); unsigned_type = parse_type (par_state)->builtin_unsigned_int; signed_type = parse_type (par_state)->builtin_int; } @@ -817,8 +841,8 @@ push_kind_type (LONGEST val, struct type *type) ival = static_cast (val); } - push_type_int (ival); - push_type (tp_kind); + type_stack->push (ival); + type_stack->push (tp_kind); } /* Called when a type has a '(kind=N)' modifier after it, for example @@ -944,14 +968,22 @@ static const struct token f77_keywords[] = { "integer", INT_KEYWORD, BINOP_END, true }, { "logical", LOGICAL_KEYWORD, BINOP_END, true }, { "real_16", REAL_S16_KEYWORD, BINOP_END, true }, - { "complex", COMPLEX_S8_KEYWORD, BINOP_END, true }, + { "complex", COMPLEX_KEYWORD, BINOP_END, true }, { "sizeof", SIZEOF, BINOP_END, true }, { "real_8", REAL_S8_KEYWORD, BINOP_END, true }, { "real", REAL_KEYWORD, BINOP_END, true }, + { "single", SINGLE, BINOP_END, true }, + { "double", DOUBLE, BINOP_END, true }, + { "precision", PRECISION, BINOP_END, true }, /* The following correspond to actual functions in Fortran and are case insensitive. */ { "kind", KIND, BINOP_END, false }, - { "abs", UNOP_INTRINSIC, UNOP_ABS, false } + { "abs", UNOP_INTRINSIC, UNOP_ABS, false }, + { "mod", BINOP_INTRINSIC, BINOP_MOD, false }, + { "floor", UNOP_INTRINSIC, UNOP_FORTRAN_FLOOR, false }, + { "ceiling", UNOP_INTRINSIC, UNOP_FORTRAN_CEILING, false }, + { "modulo", BINOP_INTRINSIC, BINOP_FORTRAN_MODULO, false }, + { "cmplx", BINOP_INTRINSIC, BINOP_FORTRAN_CMPLX, false }, }; /* Implementation of a dynamically expandable buffer for processing input @@ -1001,14 +1033,14 @@ growbuf_by_size (int count) static int match_string_literal (void) { - const char *tokptr = lexptr; + const char *tokptr = pstate->lexptr; for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++) { CHECKBUF (1); - if (*tokptr == *lexptr) + if (*tokptr == *pstate->lexptr) { - if (*(tokptr + 1) == *lexptr) + if (*(tokptr + 1) == *pstate->lexptr) tokptr++; else break; @@ -1023,7 +1055,7 @@ match_string_literal (void) tempbuf[tempbufindex] = '\0'; yylval.sval.ptr = tempbuf; yylval.sval.length = tempbufindex; - lexptr = ++tokptr; + pstate->lexptr = ++tokptr; return STRING_LITERAL; } } @@ -1040,21 +1072,21 @@ yylex (void) retry: - prev_lexptr = lexptr; + pstate->prev_lexptr = pstate->lexptr; - tokstart = lexptr; + tokstart = pstate->lexptr; /* First of all, let us make sure we are not dealing with the special tokens .true. and .false. which evaluate to 1 and 0. */ - if (*lexptr == '.') + if (*pstate->lexptr == '.') { for (int i = 0; i < ARRAY_SIZE (boolean_values); i++) { if (strncasecmp (tokstart, boolean_values[i].name, strlen (boolean_values[i].name)) == 0) { - lexptr += strlen (boolean_values[i].name); + pstate->lexptr += strlen (boolean_values[i].name); yylval.lval = boolean_values[i].value; return BOOLEAN_LITERAL; } @@ -1067,7 +1099,7 @@ yylex (void) strlen (dot_ops[i].oper)) == 0) { gdb_assert (!dot_ops[i].case_sensitive); - lexptr += strlen (dot_ops[i].oper); + pstate->lexptr += strlen (dot_ops[i].oper); yylval.opcode = dot_ops[i].opcode; return dot_ops[i].token; } @@ -1076,7 +1108,7 @@ yylex (void) if (strncmp (tokstart, "**", 2) == 0) { - lexptr += 2; + pstate->lexptr += 2; yylval.opcode = BINOP_EXP; return STARSTAR; } @@ -1089,7 +1121,7 @@ yylex (void) case ' ': case '\t': case '\n': - lexptr++; + pstate->lexptr++; goto retry; case '\'': @@ -1100,25 +1132,25 @@ yylex (void) case '(': paren_depth++; - lexptr++; + pstate->lexptr++; return c; case ')': if (paren_depth == 0) return 0; paren_depth--; - lexptr++; + pstate->lexptr++; return c; case ',': - if (comma_terminates && paren_depth == 0) + if (pstate->comma_terminates && paren_depth == 0) return 0; - lexptr++; + pstate->lexptr++; return c; case '.': /* Might be a floating point number. */ - if (lexptr[1] < '0' || lexptr[1] > '9') + if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9') goto symbol; /* Nope, must be a symbol. */ /* FALL THRU. */ @@ -1182,7 +1214,7 @@ yylex (void) err_copy[p - tokstart] = 0; error (_("Invalid number \"%s\"."), err_copy); } - lexptr = p; + pstate->lexptr = p; return toktype; } @@ -1207,7 +1239,7 @@ yylex (void) case '{': case '}': symbol: - lexptr++; + pstate->lexptr++; return c; } @@ -1228,7 +1260,7 @@ yylex (void) if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f') return 0; - lexptr += namelen; + pstate->lexptr += namelen; /* Catch specific keywords. */ @@ -1256,9 +1288,8 @@ yylex (void) currently as names of types; NAME for other symbols. The caller is not constrained to care about the distinction. */ { - char *tmp = copy_name (yylval.sval); + std::string tmp = copy_name (yylval.sval); struct block_symbol result; - struct field_of_this_result is_a_field_of_this; enum domain_enum_tag lookup_domains[] = { STRUCT_DOMAIN, @@ -1269,15 +1300,8 @@ yylex (void) for (int i = 0; i < ARRAY_SIZE (lookup_domains); ++i) { - /* Initialize this in case we *don't* use it in this call; that - way we can refer to it unconditionally below. */ - memset (&is_a_field_of_this, 0, sizeof (is_a_field_of_this)); - - result = lookup_symbol (tmp, expression_context_block, - lookup_domains[i], - parse_language (pstate)->la_language - == language_cplus - ? &is_a_field_of_this : NULL); + result = lookup_symbol (tmp.c_str (), pstate->expression_context_block, + lookup_domains[i], NULL); if (result.symbol && SYMBOL_CLASS (result.symbol) == LOC_TYPEDEF) { yylval.tsym.type = SYMBOL_TYPE (result.symbol); @@ -1289,8 +1313,8 @@ yylex (void) } yylval.tsym.type - = language_lookup_primitive_type (parse_language (pstate), - parse_gdbarch (pstate), tmp); + = language_lookup_primitive_type (pstate->language (), + pstate->gdbarch (), tmp.c_str ()); if (yylval.tsym.type != NULL) return TYPENAME; @@ -1306,14 +1330,14 @@ yylex (void) if (hextype == INT) { yylval.ssym.sym = result; - yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL; + yylval.ssym.is_a_field_of_this = false; return NAME_OR_INT; } } /* Any other kind of symbol */ yylval.ssym.sym = result; - yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL; + yylval.ssym.is_a_field_of_this = false; return NAME; } } @@ -1327,6 +1351,11 @@ f_parse (struct parser_state *par_state) parser_debug); gdb_assert (par_state != NULL); pstate = par_state; + paren_depth = 0; + + struct type_stack stack; + scoped_restore restore_type_stack = make_scoped_restore (&type_stack, + &stack); return yyparse (); } @@ -1334,8 +1363,8 @@ f_parse (struct parser_state *par_state) static void yyerror (const char *msg) { - if (prev_lexptr) - lexptr = prev_lexptr; + if (pstate->prev_lexptr) + pstate->lexptr = pstate->prev_lexptr; - error (_("A %s in expression, near `%s'."), msg, lexptr); + error (_("A %s in expression, near `%s'."), msg, pstate->lexptr); }