/* YACC parser for Ada expressions, for GDB.
- Copyright (C) 1986-2021 Free Software Foundation, Inc.
+ Copyright (C) 1986-2022 Free Software Foundation, Inc.
This file is part of GDB.
static struct parser_state *pstate = NULL;
-/* If expression is in the context of TYPE'(...), then TYPE, else
- * NULL. */
-static struct type *type_qualifier;
-
int yyparse (void);
static int yylex (void);
static const struct block *block_lookup (const struct block *, const char *);
-static LONGEST convert_char_literal (struct type *, LONGEST);
-
static void write_ambiguous_var (struct parser_state *,
- const struct block *, char *, int);
+ const struct block *, const char *, int);
static struct type *type_int (struct parser_state *);
{
operation_up result = std::move (op);
ada_resolvable *res = dynamic_cast<ada_resolvable *> (result.get ());
- if (res != nullptr
- && res->resolve (pstate->expout.get (),
- deprocedure_p,
- pstate->parse_completion,
- pstate->block_tracker,
- context_type))
- result
- = make_operation<ada_funcall_operation> (std::move (result),
- std::vector<operation_up> ());
-
+ if (res != nullptr)
+ return res->replace (std::move (result),
+ pstate->expout.get (),
+ deprocedure_p,
+ pstate->parse_completion,
+ pstate->block_tracker,
+ context_type);
return result;
}
pstate->push (std::move (wrapped));
}
+/* Handle operator overloading. Either returns a function all
+ operation wrapping the arguments, or it returns null, leaving the
+ caller to construct the appropriate operation. If RHS is null, a
+ unary operator is assumed. */
+static operation_up
+maybe_overload (enum exp_opcode op, operation_up &lhs, operation_up &rhs)
+{
+ struct value *args[2];
+
+ int nargs = 1;
+ args[0] = lhs->evaluate (nullptr, pstate->expout.get (),
+ EVAL_AVOID_SIDE_EFFECTS);
+ if (rhs == nullptr)
+ args[1] = nullptr;
+ else
+ {
+ args[1] = rhs->evaluate (nullptr, pstate->expout.get (),
+ EVAL_AVOID_SIDE_EFFECTS);
+ ++nargs;
+ }
+
+ block_symbol fn = ada_find_operator_symbol (op, pstate->parse_completion,
+ nargs, args);
+ if (fn.symbol == nullptr)
+ return {};
+
+ if (symbol_read_needs_frame (fn.symbol))
+ pstate->block_tracker->update (fn.block, INNERMOST_BLOCK_FOR_SYMBOLS);
+ operation_up callee = make_operation<ada_var_value_operation> (fn);
+
+ std::vector<operation_up> argvec;
+ argvec.push_back (std::move (lhs));
+ if (rhs != nullptr)
+ argvec.push_back (std::move (rhs));
+ return make_operation<ada_funcall_operation> (std::move (callee),
+ std::move (argvec));
+}
+
+/* Like parser_state::wrap, but use ada_pop to pop the value, and
+ handle unary overloading. */
+template<typename T>
+void
+ada_wrap_overload (enum exp_opcode op)
+{
+ operation_up arg = ada_pop ();
+ operation_up empty;
+
+ operation_up call = maybe_overload (op, arg, empty);
+ if (call == nullptr)
+ call = make_operation<T> (std::move (arg));
+ pstate->push (std::move (call));
+}
+
/* A variant of parser_state::wrap2 that uses ada_pop to pop both
operands, and then pushes a new Ada-wrapped operation of the
template type T. */
template<typename T>
void
-ada_un_wrap2 ()
+ada_un_wrap2 (enum exp_opcode op)
{
operation_up rhs = ada_pop ();
operation_up lhs = ada_pop ();
- operation_up wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
- pstate->push_new<ada_wrapped_operation> (std::move (wrapped));
+
+ operation_up wrapped = maybe_overload (op, lhs, rhs);
+ if (wrapped == nullptr)
+ {
+ wrapped = make_operation<T> (std::move (lhs), std::move (rhs));
+ wrapped = make_operation<ada_wrapped_operation> (std::move (wrapped));
+ }
+ pstate->push (std::move (wrapped));
}
/* A variant of parser_state::wrap2 that uses ada_pop to pop both
used. */
template<typename T>
void
-ada_wrap2 ()
+ada_wrap2 (enum exp_opcode op)
{
operation_up rhs = ada_pop ();
operation_up lhs = ada_pop ();
- pstate->push_new<T> (std::move (lhs), std::move (rhs));
+ operation_up call = maybe_overload (op, lhs, rhs);
+ if (call == nullptr)
+ call = make_operation<T> (std::move (lhs), std::move (rhs));
+ pstate->push (std::move (call));
}
/* A variant of parser_state::wrap2 that uses ada_pop to pop both
{
operation_up rhs = ada_pop ();
operation_up lhs = ada_pop ();
- pstate->push_new<T> (op, std::move (lhs), std::move (rhs));
+ operation_up call = maybe_overload (op, lhs, rhs);
+ if (call == nullptr)
+ call = make_operation<T> (op, std::move (lhs), std::move (rhs));
+ pstate->push (std::move (call));
}
/* Pop three operands using ada_pop, then construct a new ternary
%type <bval> block
%type <lval> arglist tick_arglist
-%type <tval> save_qualifier
-
%token DOT_ALL
/* Special type cases, put in to allow the parser to distinguish different
/* Expressions, including the sequencing operator. */
exp1 : exp
| exp1 ';' exp
- { ada_wrap2<comma_operation> (); }
+ { ada_wrap2<comma_operation> (BINOP_COMMA); }
| primary ASSIGN exp /* Extension for convenience */
{
operation_up rhs = pstate->pop ();
}
;
-primary : var_or_type '\'' save_qualifier { type_qualifier = $1; }
- '(' exp ')'
+primary : var_or_type '\'' '(' exp ')'
{
if ($1 == NULL)
error (_("Type required for qualification"));
check_typedef ($1));
pstate->push_new<ada_qual_operation>
(std::move (arg), $1);
- type_qualifier = $3;
}
;
-save_qualifier : { $$ = type_qualifier; }
- ;
-
primary :
primary '(' simple_exp DOTDOT simple_exp ')'
{ ada_wrap3<ada_ternop_slice_operation> (); }
;
simple_exp : '-' simple_exp %prec UNARY
- { ada_wrap<ada_neg_operation> (); }
+ { ada_wrap_overload<ada_neg_operation> (UNOP_NEG); }
;
simple_exp : '+' simple_exp %prec UNARY
{
- /* No need to do anything. */
+ operation_up arg = ada_pop ();
+ operation_up empty;
+
+ /* If an overloaded operator was found, use
+ it. Otherwise, unary + has no effect and
+ the argument can be pushed instead. */
+ operation_up call = maybe_overload (UNOP_PLUS, arg,
+ empty);
+ if (call != nullptr)
+ arg = std::move (call);
+ pstate->push (std::move (arg));
}
;
simple_exp : NOT simple_exp %prec UNARY
- { ada_wrap<unary_logical_not_operation> (); }
+ {
+ ada_wrap_overload<unary_logical_not_operation>
+ (UNOP_LOGICAL_NOT);
+ }
;
simple_exp : ABS simple_exp %prec UNARY
- { ada_wrap<ada_abs_operation> (); }
+ { ada_wrap_overload<ada_abs_operation> (UNOP_ABS); }
;
arglist : { $$ = 0; }
/* Binary operators in order of decreasing precedence. */
simple_exp : simple_exp STARSTAR simple_exp
- { ada_wrap2<ada_binop_exp_operation> (); }
+ { ada_wrap2<ada_binop_exp_operation> (BINOP_EXP); }
;
simple_exp : simple_exp '*' simple_exp
- { ada_wrap2<ada_binop_mul_operation> (); }
+ { ada_wrap2<ada_binop_mul_operation> (BINOP_MUL); }
;
simple_exp : simple_exp '/' simple_exp
- { ada_wrap2<ada_binop_div_operation> (); }
+ { ada_wrap2<ada_binop_div_operation> (BINOP_DIV); }
;
simple_exp : simple_exp REM simple_exp /* May need to be fixed to give correct Ada REM */
- { ada_wrap2<ada_binop_rem_operation> (); }
+ { ada_wrap2<ada_binop_rem_operation> (BINOP_REM); }
;
simple_exp : simple_exp MOD simple_exp
- { ada_wrap2<ada_binop_mod_operation> (); }
+ { ada_wrap2<ada_binop_mod_operation> (BINOP_MOD); }
;
simple_exp : simple_exp '@' simple_exp /* GDB extension */
- { ada_wrap2<repeat_operation> (); }
+ { ada_wrap2<repeat_operation> (BINOP_REPEAT); }
;
simple_exp : simple_exp '+' simple_exp
;
simple_exp : simple_exp '&' simple_exp
- { ada_wrap2<concat_operation> (); }
+ { ada_wrap2<concat_operation> (BINOP_CONCAT); }
;
simple_exp : simple_exp '-' simple_exp
;
relation : simple_exp LEQ simple_exp
- { ada_un_wrap2<leq_operation> (); }
+ { ada_un_wrap2<leq_operation> (BINOP_LEQ); }
;
relation : simple_exp IN simple_exp DOTDOT simple_exp
;
relation : simple_exp GEQ simple_exp
- { ada_un_wrap2<geq_operation> (); }
+ { ada_un_wrap2<geq_operation> (BINOP_GEQ); }
;
relation : simple_exp '<' simple_exp
- { ada_un_wrap2<less_operation> (); }
+ { ada_un_wrap2<less_operation> (BINOP_LESS); }
;
relation : simple_exp '>' simple_exp
- { ada_un_wrap2<gtr_operation> (); }
+ { ada_un_wrap2<gtr_operation> (BINOP_GTR); }
;
exp : relation
and_exp :
relation _AND_ relation
- { ada_wrap2<ada_bitwise_and_operation> (); }
+ { ada_wrap2<ada_bitwise_and_operation>
+ (BINOP_BITWISE_AND); }
| and_exp _AND_ relation
- { ada_wrap2<ada_bitwise_and_operation> (); }
+ { ada_wrap2<ada_bitwise_and_operation>
+ (BINOP_BITWISE_AND); }
;
and_then_exp :
relation _AND_ THEN relation
- { ada_wrap2<logical_and_operation> (); }
+ { ada_wrap2<logical_and_operation>
+ (BINOP_LOGICAL_AND); }
| and_then_exp _AND_ THEN relation
- { ada_wrap2<logical_and_operation> (); }
+ { ada_wrap2<logical_and_operation>
+ (BINOP_LOGICAL_AND); }
;
or_exp :
relation OR relation
- { ada_wrap2<ada_bitwise_ior_operation> (); }
+ { ada_wrap2<ada_bitwise_ior_operation>
+ (BINOP_BITWISE_IOR); }
| or_exp OR relation
- { ada_wrap2<ada_bitwise_ior_operation> (); }
+ { ada_wrap2<ada_bitwise_ior_operation>
+ (BINOP_BITWISE_IOR); }
;
or_else_exp :
relation OR ELSE relation
- { ada_wrap2<logical_or_operation> (); }
+ { ada_wrap2<logical_or_operation> (BINOP_LOGICAL_OR); }
| or_else_exp OR ELSE relation
- { ada_wrap2<logical_or_operation> (); }
+ { ada_wrap2<logical_or_operation> (BINOP_LOGICAL_OR); }
;
xor_exp : relation XOR relation
- { ada_wrap2<ada_bitwise_xor_operation> (); }
+ { ada_wrap2<ada_bitwise_xor_operation>
+ (BINOP_BITWISE_XOR); }
| xor_exp XOR relation
- { ada_wrap2<ada_bitwise_xor_operation> (); }
+ { ada_wrap2<ada_bitwise_xor_operation>
+ (BINOP_BITWISE_XOR); }
;
/* Primaries can denote types (OP_TYPE). In cases such as
| primary TICK_TAG
{ ada_wrap<ada_atr_tag_operation> (); }
| opt_type_prefix TICK_MIN '(' exp ',' exp ')'
- { ada_wrap2<ada_binop_min_operation> (); }
+ { ada_wrap2<ada_binop_min_operation> (BINOP_MIN); }
| opt_type_prefix TICK_MAX '(' exp ',' exp ')'
- { ada_wrap2<ada_binop_max_operation> (); }
+ { ada_wrap2<ada_binop_max_operation> (BINOP_MAX); }
| opt_type_prefix TICK_POS '(' exp ')'
{ ada_wrap<ada_pos_operation> (); }
| type_prefix TICK_VAL '(' exp ')'
;
primary : CHARLIT
- { write_int (pstate,
- convert_char_literal (type_qualifier, $1.val),
- (type_qualifier == NULL)
- ? $1.type : type_qualifier);
- }
+ {
+ pstate->push_new<ada_char_operation> ($1.type, $1.val);
+ }
;
primary : FLOAT
;
primary : NULL_PTR
- { write_int (pstate, 0, type_int (pstate)); }
+ {
+ struct type *null_ptr_type
+ = lookup_pointer_type (parse_type (pstate)->builtin_int0);
+ write_int (pstate, 0, null_ptr_type);
+ }
;
primary : STRING
{ ada_addrof (); }
| primary '[' exp ']'
{
- ada_wrap2<subscript_operation> ();
+ ada_wrap2<subscript_operation> (BINOP_SUBSCRIPT);
ada_wrap<ada_wrapped_operation> ();
}
;
pstate = par_state;
lexer_init (yyin); /* (Re-)initialize lexer. */
- type_qualifier = NULL;
obstack_free (&temp_parse_space, NULL);
obstack_init (&temp_parse_space);
components.clear ();
non-NULL). */
static void
-write_var_from_sym (struct parser_state *par_state,
- const struct block *block,
- struct symbol *sym)
+write_var_from_sym (struct parser_state *par_state, block_symbol sym)
{
- if (symbol_read_needs_frame (sym))
- par_state->block_tracker->update (block, INNERMOST_BLOCK_FOR_SYMBOLS);
+ if (symbol_read_needs_frame (sym.symbol))
+ par_state->block_tracker->update (sym.block, INNERMOST_BLOCK_FOR_SYMBOLS);
- par_state->push_new<ada_var_value_operation> (sym, block);
+ par_state->push_new<ada_var_value_operation> (sym);
}
/* Write integer or boolean constant ARG of type TYPE. */
}
/* Emit expression corresponding to the renamed object named
- * designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
- * context of ORIG_LEFT_CONTEXT, to which is applied the operations
- * encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
- * cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
- * defaults to the currently selected block. ORIG_SYMBOL is the
- * symbol that originally encoded the renaming. It is needed only
- * because its prefix also qualifies any index variables used to index
- * or slice an array. It should not be necessary once we go to the
- * new encoding entirely (FIXME pnh 7/20/2007). */
+ designated by RENAMED_ENTITY[0 .. RENAMED_ENTITY_LEN-1] in the
+ context of ORIG_LEFT_CONTEXT, to which is applied the operations
+ encoded by RENAMING_EXPR. MAX_DEPTH is the maximum number of
+ cascaded renamings to allow. If ORIG_LEFT_CONTEXT is null, it
+ defaults to the currently selected block. ORIG_SYMBOL is the
+ symbol that originally encoded the renaming. It is needed only
+ because its prefix also qualifies any index variables used to index
+ or slice an array. It should not be necessary once we go to the
+ new encoding entirely (FIXME pnh 7/20/2007). */
static void
write_object_renaming (struct parser_state *par_state,
&inner_renaming_expr))
{
case ADA_NOT_RENAMING:
- write_var_from_sym (par_state, sym_info.block, sym_info.symbol);
+ write_var_from_sym (par_state, sym_info);
break;
case ADA_OBJECT_RENAMING:
write_object_renaming (par_state, sym_info.block,
else if (SYMBOL_CLASS (index_sym_info.symbol) == LOC_TYPEDEF)
/* Index is an old-style renaming symbol. */
index_sym_info.block = orig_left_context;
- write_var_from_sym (par_state, index_sym_info.block,
- index_sym_info.symbol);
+ write_var_from_sym (par_state, index_sym_info);
}
if (slice_state == SIMPLE_INDEX)
ada_funcall (1);
}
static int
-chop_selector (char *name, int end)
+chop_selector (const char *name, int end)
{
int i;
for (i = end - 1; i > 0; i -= 1)
'.'), chop this separator and return the result; else, return
NAME. */
-static char *
-chop_separator (char *name)
+static const char *
+chop_separator (const char *name)
{
if (*name == '.')
return name + 1;
<sep> is '__' or '.', write the indicated sequence of
STRUCTOP_STRUCT expression operators. */
static void
-write_selectors (struct parser_state *par_state, char *sels)
+write_selectors (struct parser_state *par_state, const char *sels)
{
while (*sels != '\0')
{
- char *p = chop_separator (sels);
+ const char *p = chop_separator (sels);
sels = p;
while (*sels != '\0' && *sels != '.'
&& (sels[0] != '_' || sels[1] != '_'))
*/
static void
write_ambiguous_var (struct parser_state *par_state,
- const struct block *block, char *name, int len)
+ const struct block *block, const char *name, int len)
{
struct symbol *sym = new (&temp_parse_space) symbol ();
sym->set_linkage_name (obstack_strndup (&temp_parse_space, name, len));
sym->set_language (language_ada, nullptr);
- par_state->push_new<ada_var_value_operation> (sym, block);
+ block_symbol bsym { sym, block };
+ par_state->push_new<ada_var_value_operation> (bsym);
}
/* A convenient wrapper around ada_get_field_index that takes
In case of failure, we return NULL. */
static struct type *
-get_symbol_field_type (struct symbol *sym, char *encoded_field_name)
+get_symbol_field_type (struct symbol *sym, const char *encoded_field_name)
{
- char *field_name = encoded_field_name;
- char *subfield_name;
+ const char *field_name = encoded_field_name;
+ const char *subfield_name;
struct type *type = SYMBOL_TYPE (sym);
int fieldno;
if (syms.size () == 1)
{
- write_var_from_sym (par_state, syms[0].block, syms[0].symbol);
+ write_var_from_sym (par_state, syms[0]);
write_selectors (par_state, encoded_name + tail_index);
return NULL;
}
if (syms.size () != 1 || SYMBOL_CLASS (syms[0].symbol) == LOC_TYPEDEF)
pstate->push_new<ada_string_operation> (copy_name (name));
else
- write_var_from_sym (par_state, syms[0].block, syms[0].symbol);
+ write_var_from_sym (par_state, syms[0]);
}
else
if (write_var_or_type (par_state, NULL, name) != NULL)
push_association<ada_name_association> (ada_pop ());
}
-/* Convert the character literal whose ASCII value would be VAL to the
- appropriate value of type TYPE, if there is a translation.
- Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
- the literal 'A' (VAL == 65), returns 0. */
-
-static LONGEST
-convert_char_literal (struct type *type, LONGEST val)
-{
- char name[7];
- int f;
-
- if (type == NULL)
- return val;
- type = check_typedef (type);
- if (type->code () != TYPE_CODE_ENUM)
- return val;
-
- if ((val >= 'a' && val <= 'z') || (val >= '0' && val <= '9'))
- xsnprintf (name, sizeof (name), "Q%c", (int) val);
- else
- xsnprintf (name, sizeof (name), "QU%02x", (int) val);
- size_t len = strlen (name);
- for (f = 0; f < type->num_fields (); f += 1)
- {
- /* Check the suffix because an enum constant in a package will
- have a name like "pkg__QUxx". This is safe enough because we
- already have the correct type, and because mangling means
- there can't be clashes. */
- const char *ename = TYPE_FIELD_NAME (type, f);
- size_t elen = strlen (ename);
-
- if (elen >= len && strcmp (name, ename + elen - len) == 0)
- return TYPE_FIELD_ENUMVAL (type, f);
- }
- return val;
-}
-
static struct type *
type_int (struct parser_state *par_state)
{