/* 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).
%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 <lval> CHARACTER
%token <voidval> DOLLAR_VARIABLE
%token <opcode> ASSIGN_MODIFY
-%token <opcode> UNOP_INTRINSIC
+%token <opcode> UNOP_INTRINSIC BINOP_INTRINSIC
%left ','
%left ABOVE_COMMA
;
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
{ write_exp_elt_opcode (pstate, $1); }
;
+exp : BINOP_INTRINSIC '(' exp ',' exp ')'
+ { write_exp_elt_opcode (pstate, $1); }
+ ;
+
arglist :
;
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 ());
}
}
;
{ $$ = 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
{ "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
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,
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, pstate->expression_context_block,
- lookup_domains[i],
- pstate->language ()->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);
yylval.tsym.type
= language_lookup_primitive_type (pstate->language (),
- pstate->gdbarch (), tmp);
+ pstate->gdbarch (), tmp.c_str ());
if (yylval.tsym.type != NULL)
return TYPENAME;
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;
}
}