/* 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).
#include "block.h"
#include <ctype.h>
#include <algorithm>
+#include "type-stack.h"
#define parse_type(ps) builtin_type (ps->gdbarch ())
#define parse_f_type(ps) builtin_f_type (ps->gdbarch ())
/* Depth of parentheses. */
static int paren_depth;
+/* The current type stack. */
+static struct type_stack *type_stack;
+
int yyparse (void);
static int yylex (void);
%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
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); }
;
{ 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. */
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);
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 ());
}
}
;
struct type *range_type;
while (!done)
- switch (pop_type ())
+ switch (type_stack->pop ())
{
case tp_end:
done = 1;
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 =
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);
}
;
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
;
| '*' 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: '(' ')'
{ $$ = 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
ival = static_cast <int> (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
{ "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;
}
}
pstate = par_state;
paren_depth = 0;
+ struct type_stack stack;
+ scoped_restore restore_type_stack = make_scoped_restore (&type_stack,
+ &stack);
+
return yyparse ();
}
projects / deliverable / binutils-gdb.git / blobdiff