/* Ada language support routines for GDB, the GNU debugger.
- Copyright (C) 1992-2021 Free Software Foundation, Inc.
+ Copyright (C) 1992-2022 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include <ctype.h>
-#include "gdb_regex.h"
+#include "gdbsupport/gdb_regex.h"
#include "frame.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "breakpoint.h"
#include "gdbcore.h"
#include "hashtab.h"
-#include "gdb_obstack.h"
+#include "gdbsupport/gdb_obstack.h"
#include "ada-lang.h"
#include "completer.h"
#include "ui-out.h"
#include "typeprint.h"
#include "namespace.h"
#include "cli/cli-style.h"
+#include "cli/cli-decode.h"
#include "value.h"
#include "mi/mi-common.h"
static int desc_arity (struct type *);
-static int ada_type_match (struct type *, struct type *, int);
-
static int ada_args_match (struct symbol *, struct value **, int);
static struct value *make_array_descriptor (struct type *, struct value *);
struct symbol *,
const struct block *);
-static struct value *resolve_subexp (expression_up *, int *, int,
- struct type *, int,
- innermost_block_tracker *);
-
-static void replace_operator_with_call (expression_up *, int, int, int,
- struct symbol *, const struct block *);
-
static int possible_user_operator_p (enum exp_opcode, struct value **);
static const char *ada_decoded_op_name (enum exp_opcode);
static struct type *ada_lookup_struct_elt_type (struct type *, const char *,
int, int);
-static struct value *evaluate_subexp_type (struct expression *, int *);
-
static struct type *ada_find_parallel_type_with_name (struct type *,
const char *);
static LONGEST pos_atr (struct value *);
-static struct value *value_pos_atr (struct type *, struct value *);
-
static struct value *val_atr (struct type *, LONGEST);
static struct symbol *standard_lookup (const char *, const struct block *,
static int ada_resolve_function (std::vector<struct block_symbol> &,
struct value **, int, const char *,
- struct type *, int);
+ struct type *, bool);
static int ada_is_direct_array_type (struct type *);
static struct value *ada_index_struct_field (int, struct value *, int,
struct type *);
-static struct value *assign_aggregate (struct value *, struct value *,
- struct expression *,
- int *, enum noside);
-
-static void aggregate_assign_from_choices (struct value *, struct value *,
- struct expression *,
- int *, std::vector<LONGEST> &,
- LONGEST, LONGEST);
-
-static void aggregate_assign_positional (struct value *, struct value *,
- struct expression *,
- int *, std::vector<LONGEST> &,
- LONGEST, LONGEST);
-
-
-static void aggregate_assign_others (struct value *, struct value *,
- struct expression *,
- int *, std::vector<LONGEST> &,
- LONGEST, LONGEST);
-
-
static void add_component_interval (LONGEST, LONGEST, std::vector<LONGEST> &);
-static struct value *ada_evaluate_subexp (struct type *, struct expression *,
- int *, enum noside);
-
-static void ada_forward_operator_length (struct expression *, int, int *,
- int *);
-
static struct type *ada_find_any_type (const char *name);
static symbol_name_matcher_ftype *ada_get_symbol_name_matcher
struct cache_entry *root[HASH_SIZE] {};
};
-/* Maximum-sized dynamic type. */
-static unsigned int varsize_limit;
-
static const char ada_completer_word_break_characters[] =
#ifdef VMS
" \t\n!@#%^&*()+=|~`}{[]\";:?/,-";
struct type *struct_type = check_typedef ((struct type *) type);
for (fieldno = 0; fieldno < struct_type->num_fields (); fieldno++)
- if (field_name_match (TYPE_FIELD_NAME (struct_type, fieldno), field_name))
+ if (field_name_match (struct_type->field (fieldno).name (), field_name))
return fieldno;
if (!maybe_missing)
{
struct value *result;
- /* Make sure that the object size is not unreasonable before
- trying to allocate some memory for it. */
- ada_ensure_varsize_limit (type);
-
if (value_optimized_out (val))
result = allocate_optimized_out_value (type);
else if (value_lazy (val)
va_end (args);
}
-/* Issue an error if the size of an object of type T is unreasonable,
- i.e. if it would be a bad idea to allocate a value of this type in
- GDB. */
-
-void
-ada_ensure_varsize_limit (const struct type *type)
-{
- if (TYPE_LENGTH (type) > varsize_limit)
- error (_("object size is larger than varsize-limit"));
-}
-
/* Maximum value of a SIZE-byte signed integer type. */
static LONGEST
max_of_size (int size)
}
}
case TYPE_CODE_ENUM:
- return TYPE_FIELD_ENUMVAL (type, type->num_fields () - 1);
+ return type->field (type->num_fields () - 1).loc_enumval ();
case TYPE_CODE_BOOL:
return 1;
case TYPE_CODE_CHAR:
}
}
case TYPE_CODE_ENUM:
- return TYPE_FIELD_ENUMVAL (type, 0);
+ return type->field (0).loc_enumval ();
case TYPE_CODE_BOOL:
return 0;
case TYPE_CODE_CHAR:
{NULL, NULL}
};
+/* If STR is a decoded version of a compiler-provided suffix (like the
+ "[cold]" in "symbol[cold]"), return true. Otherwise, return
+ false. */
+
+static bool
+is_compiler_suffix (const char *str)
+{
+ gdb_assert (*str == '[');
+ ++str;
+ while (*str != '\0' && isalpha (*str))
+ ++str;
+ /* We accept a missing "]" in order to support completion. */
+ return *str == '\0' || (str[0] == ']' && str[1] == '\0');
+}
+
/* The "encoded" form of DECODED, according to GNAT conventions. If
THROW_ERRORS, throw an error if invalid operator name is found.
Otherwise, return the empty string in that case. */
{
if (*p == '.')
encoding_buffer.append ("__");
+ else if (*p == '[' && is_compiler_suffix (p))
+ {
+ encoding_buffer = encoding_buffer + "." + (p + 1);
+ if (encoding_buffer.back () == ']')
+ encoding_buffer.pop_back ();
+ break;
+ }
else if (*p == '"')
{
const struct ada_opname_map *mapping;
*len = *len - 1;
}
-/* If ENCODED follows the GNAT entity encoding conventions, then return
- the decoded form of ENCODED. Otherwise, return "<%s>" where "%s" is
- replaced by ENCODED. */
+/* If ENCODED ends with a compiler-provided suffix (like ".cold"),
+ then update *LEN to remove the suffix and return the offset of the
+ character just past the ".". Otherwise, return -1. */
+
+static int
+remove_compiler_suffix (const char *encoded, int *len)
+{
+ int offset = *len - 1;
+ while (offset > 0 && isalpha (encoded[offset]))
+ --offset;
+ if (offset > 0 && encoded[offset] == '.')
+ {
+ *len = offset;
+ return offset + 1;
+ }
+ return -1;
+}
+
+/* See ada-lang.h. */
std::string
-ada_decode (const char *encoded)
+ada_decode (const char *encoded, bool wrap)
{
int i, j;
int len0;
const char *p;
int at_start_name;
std::string decoded;
+ int suffix = -1;
/* With function descriptors on PPC64, the value of a symbol named
".FN", if it exists, is the entry point of the function "FN". */
len0 = strlen (encoded);
+ suffix = remove_compiler_suffix (encoded, &len0);
+
ada_remove_trailing_digits (encoded, &len0);
ada_remove_po_subprogram_suffix (encoded, &len0);
if (isupper (decoded[i]) || decoded[i] == ' ')
goto Suppress;
+ /* If the compiler added a suffix, append it now. */
+ if (suffix >= 0)
+ decoded = decoded + "[" + &encoded[suffix] + "]";
+
return decoded;
Suppress:
+ if (!wrap)
+ return {};
+
if (encoded[0] == '<')
decoded = encoded;
else
decoded = '<' + std::string(encoded) + '>';
return decoded;
-
}
/* Table for keeping permanent unique copies of decoded names. Once
return *resultp;
}
-static char *
-ada_la_decode (const char *encoded, int options)
-{
- return xstrdup (ada_decode (encoded).c_str ());
-}
-
\f
/* Arrays */
is not equal to the field name. */
if (index_desc_type->field (0).type ()->name () != NULL
&& strcmp (index_desc_type->field (0).type ()->name (),
- TYPE_FIELD_NAME (index_desc_type, 0)) == 0)
+ index_desc_type->field (0).name ()) == 0)
return;
/* Fixup each field of INDEX_DESC_TYPE. */
for (i = 0; i < index_desc_type->num_fields (); i++)
{
- const char *name = TYPE_FIELD_NAME (index_desc_type, i);
+ const char *name = index_desc_type->field (i).name ();
struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
if (raw_type)
else if (is_thick_pntr (type))
{
- struct value *p_bounds = value_struct_elt (&arr, NULL, "P_BOUNDS", NULL,
+ struct value *p_bounds = value_struct_elt (&arr, {}, "P_BOUNDS", NULL,
_("Bad GNAT array descriptor"));
struct type *p_bounds_type = value_type (p_bounds);
static int
fat_pntr_bounds_bitpos (struct type *type)
{
- return TYPE_FIELD_BITPOS (desc_base_type (type), 1);
+ return desc_base_type (type)->field (1).loc_bitpos ();
}
/* If TYPE is the type of an array-descriptor (fat pointer), the bit
if (is_thin_pntr (type))
return thin_data_pntr (arr);
else if (is_thick_pntr (type))
- return value_struct_elt (&arr, NULL, "P_ARRAY", NULL,
+ return value_struct_elt (&arr, {}, "P_ARRAY", NULL,
_("Bad GNAT array descriptor"));
else
return NULL;
static int
fat_pntr_data_bitpos (struct type *type)
{
- return TYPE_FIELD_BITPOS (desc_base_type (type), 0);
+ return desc_base_type (type)->field (0).loc_bitpos ();
}
/* If TYPE is the type of an array-descriptor (fat pointer), the bit
char bound_name[20];
xsnprintf (bound_name, sizeof (bound_name), "%cB%d",
which ? 'U' : 'L', i - 1);
- return value_struct_elt (&bounds, NULL, bound_name, NULL,
+ return value_struct_elt (&bounds, {}, bound_name, NULL,
_("Bad GNAT array descriptor bounds"));
}
static int
desc_bound_bitpos (struct type *type, int i, int which)
{
- return TYPE_FIELD_BITPOS (desc_base_type (type), 2 * i + which - 2);
+ return desc_base_type (type)->field (2 * i + which - 2).loc_bitpos ();
}
/* If BOUNDS is an array-bounds structure type, return the bit field size
if (arrVal == NULL)
error (_("Bounds unavailable for null array pointer."));
- ada_ensure_varsize_limit (TYPE_TARGET_TYPE (value_type (arrVal)));
return value_ind (arrVal);
}
else if (ada_is_constrained_packed_array_type (value_type (arr)))
/* The structure's first field is a pointer to an array, so this
fetches the array type. */
type = TYPE_TARGET_TYPE (type->field (0).type ());
+ if (type->code () == TYPE_CODE_TYPEDEF)
+ type = ada_typedef_target_type (type);
/* Now we can see if the array elements are packed. */
return TYPE_FIELD_BITSIZE (type, 0) > 0;
}
bounds may be variable and were not passed to that function. So,
we further resolve the array bounds here and then update the
sizes. */
- const gdb_byte *valaddr = value_contents_for_printing (arr);
+ const gdb_byte *valaddr = value_contents_for_printing (arr).data ();
CORE_ADDR address = value_address (arr);
gdb::array_view<const gdb_byte> view
= gdb::make_array_view (valaddr, TYPE_LENGTH (type));
&& ada_is_modular_type (value_type (arr)))
{
/* This is a (right-justified) modular type representing a packed
- array with no wrapper. In order to interpret the value through
- the (left-justified) packed array type we just built, we must
- first left-justify it. */
+ array with no wrapper. In order to interpret the value through
+ the (left-justified) packed array type we just built, we must
+ first left-justify it. */
int bit_size, bit_pos;
ULONGEST mod;
if (obj == NULL)
src = valaddr + offset;
else
- src = value_contents (obj) + offset;
+ src = value_contents (obj).data () + offset;
if (is_dynamic_type (type))
{
else
{
v = allocate_value (type);
- src = value_contents (obj) + offset;
+ src = value_contents (obj).data () + offset;
}
if (obj != NULL)
}
else
set_value_bitsize (v, bit_size);
- unpacked = value_contents_writeable (v);
+ unpacked = value_contents_writeable (v).data ();
if (bit_size == 0)
{
if (is_big_endian && is_scalar_type (value_type (fromval)))
from_offset = from_size - bits;
copy_bitwise (buffer, value_bitpos (toval),
- value_contents (fromval), from_offset,
+ value_contents (fromval).data (), from_offset,
bits, is_big_endian);
write_memory_with_notification (to_addr, buffer, len);
val = value_copy (toval);
- memcpy (value_contents_raw (val), value_contents (fromval),
+ memcpy (value_contents_raw (val).data (),
+ value_contents (fromval).data (),
TYPE_LENGTH (type));
deprecated_set_value_type (val, type);
= TYPE_LENGTH (value_type (component)) * TARGET_CHAR_BIT - bits;
else
src_offset = 0;
- copy_bitwise (value_contents_writeable (container) + offset_in_container,
+ copy_bitwise ((value_contents_writeable (container).data ()
+ + offset_in_container),
value_bitpos (container) + bit_offset_in_container,
- value_contents (val), src_offset, bits, 1);
+ value_contents (val).data (), src_offset, bits, 1);
}
else
- copy_bitwise (value_contents_writeable (container) + offset_in_container,
+ copy_bitwise ((value_contents_writeable (container).data ()
+ + offset_in_container),
value_bitpos (container) + bit_offset_in_container,
- value_contents (val), 0, bits, 0);
+ value_contents (val).data (), 0, bits, 0);
}
/* Determine if TYPE is an access to an unconstrained array. */
return NULL;
}
-/* The type of nth index in arrays of given type (n numbering from 1).
- Does not examine memory. Throws an error if N is invalid or TYPE
- is not an array type. NAME is the name of the Ada attribute being
- evaluated ('range, 'first, 'last, or 'length); it is used in building
- the error message. */
+/* See ada-lang.h. */
-static struct type *
+struct type *
ada_index_type (struct type *type, int n, const char *name)
{
struct type *result_type;
int i;
for (i = 1; i < n; i += 1)
- type = TYPE_TARGET_TYPE (type);
- result_type = TYPE_TARGET_TYPE (type->index_type ());
+ {
+ type = ada_check_typedef (type);
+ type = TYPE_TARGET_TYPE (type);
+ }
+ result_type = TYPE_TARGET_TYPE (ada_check_typedef (type)->index_type ());
/* FIXME: The stabs type r(0,0);bound;bound in an array type
has a target type of TYPE_CODE_UNDEF. We compensate here, but
perhaps stabsread.c would make more sense. */
/* See ada-lang.h. */
block_symbol
-ada_find_operator_symbol (enum exp_opcode op, int parse_completion,
+ada_find_operator_symbol (enum exp_opcode op, bool parse_completion,
int nargs, value *argvec[])
{
if (possible_user_operator_p (op, argvec))
block_symbol
ada_resolve_funcall (struct symbol *sym, const struct block *block,
struct type *context_type,
- int parse_completion,
+ bool parse_completion,
int nargs, value *argvec[],
innermost_block_tracker *tracker)
{
return candidates[i];
}
+/* Resolve a mention of a name where the context type is an
+ enumeration type. */
+
+static int
+ada_resolve_enum (std::vector<struct block_symbol> &syms,
+ const char *name, struct type *context_type,
+ bool parse_completion)
+{
+ gdb_assert (context_type->code () == TYPE_CODE_ENUM);
+ context_type = ada_check_typedef (context_type);
+
+ for (int i = 0; i < syms.size (); ++i)
+ {
+ /* We already know the name matches, so we're just looking for
+ an element of the correct enum type. */
+ if (ada_check_typedef (SYMBOL_TYPE (syms[i].symbol)) == context_type)
+ return i;
+ }
+
+ error (_("No name '%s' in enumeration type '%s'"), name,
+ ada_type_name (context_type));
+}
+
/* See ada-lang.h. */
block_symbol
ada_resolve_variable (struct symbol *sym, const struct block *block,
struct type *context_type,
- int parse_completion,
+ bool parse_completion,
int deprocedure_p,
innermost_block_tracker *tracker)
{
candidates.end ());
}
+ /* Filter out artificial symbols. */
+ candidates.erase
+ (std::remove_if
+ (candidates.begin (),
+ candidates.end (),
+ [] (block_symbol &bsym)
+ {
+ return bsym.symbol->artificial;
+ }),
+ candidates.end ());
+
int i;
if (candidates.empty ())
error (_("No definition found for %s"), sym->print_name ());
else if (candidates.size () == 1)
i = 0;
+ else if (context_type != nullptr
+ && context_type->code () == TYPE_CODE_ENUM)
+ i = ada_resolve_enum (candidates, sym->linkage_name (), context_type,
+ parse_completion);
else if (deprocedure_p && !is_nonfunction (candidates))
{
i = ada_resolve_function
return candidates[i];
}
-/* Resolve the operator of the subexpression beginning at
- position *POS of *EXPP. "Resolving" consists of replacing
- the symbols that have undefined namespaces in OP_VAR_VALUE nodes
- with their resolutions, replacing built-in operators with
- function calls to user-defined operators, where appropriate, and,
- when DEPROCEDURE_P is non-zero, converting function-valued variables
- into parameterless calls. May expand *EXPP. The CONTEXT_TYPE functions
- are as in ada_resolve, above. */
-
-static struct value *
-resolve_subexp (expression_up *expp, int *pos, int deprocedure_p,
- struct type *context_type, int parse_completion,
- innermost_block_tracker *tracker)
-{
- int pc = *pos;
- int i;
- struct expression *exp; /* Convenience: == *expp. */
- enum exp_opcode op = (*expp)->elts[pc].opcode;
- struct value **argvec; /* Vector of operand types (alloca'ed). */
- int nargs; /* Number of operands. */
- int oplen;
- /* If we're resolving an expression like ARRAY(ARG...), then we set
- this to the type of the array, so we can use the index types as
- the expected types for resolution. */
- struct type *array_type = nullptr;
- /* The arity of ARRAY_TYPE. */
- int array_arity = 0;
-
- argvec = NULL;
- nargs = 0;
- exp = expp->get ();
-
- /* Pass one: resolve operands, saving their types and updating *pos,
- if needed. */
- switch (op)
- {
- case OP_FUNCALL:
- if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- *pos += 7;
- else
- {
- *pos += 3;
- struct value *lhs = resolve_subexp (expp, pos, 0, NULL,
- parse_completion, tracker);
- struct type *lhstype = ada_check_typedef (value_type (lhs));
- array_arity = ada_array_arity (lhstype);
- if (array_arity > 0)
- array_type = lhstype;
- }
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- break;
-
- case UNOP_ADDR:
- *pos += 1;
- resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- break;
-
- case UNOP_QUAL:
- *pos += 3;
- resolve_subexp (expp, pos, 1, check_typedef (exp->elts[pc + 1].type),
- parse_completion, tracker);
- break;
-
- case OP_ATR_MODULUS:
- case OP_ATR_SIZE:
- case OP_ATR_TAG:
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- case OP_ATR_POS:
- case OP_ATR_VAL:
- case OP_ATR_MIN:
- case OP_ATR_MAX:
- case TERNOP_IN_RANGE:
- case BINOP_IN_BOUNDS:
- case UNOP_IN_RANGE:
- case OP_AGGREGATE:
- case OP_OTHERS:
- case OP_CHOICES:
- case OP_POSITIONAL:
- case OP_DISCRETE_RANGE:
- case OP_NAME:
- ada_forward_operator_length (exp, pc, &oplen, &nargs);
- *pos += oplen;
- break;
-
- case BINOP_ASSIGN:
- {
- struct value *arg1;
-
- *pos += 1;
- arg1 = resolve_subexp (expp, pos, 0, NULL, parse_completion, tracker);
- if (arg1 == NULL)
- resolve_subexp (expp, pos, 1, NULL, parse_completion, tracker);
- else
- resolve_subexp (expp, pos, 1, value_type (arg1), parse_completion,
- tracker);
- break;
- }
-
- case UNOP_CAST:
- *pos += 3;
- nargs = 1;
- break;
-
- case BINOP_ADD:
- case BINOP_SUB:
- case BINOP_MUL:
- case BINOP_DIV:
- case BINOP_REM:
- case BINOP_MOD:
- case BINOP_EXP:
- case BINOP_CONCAT:
- case BINOP_LOGICAL_AND:
- case BINOP_LOGICAL_OR:
- case BINOP_BITWISE_AND:
- case BINOP_BITWISE_IOR:
- case BINOP_BITWISE_XOR:
-
- case BINOP_EQUAL:
- case BINOP_NOTEQUAL:
- case BINOP_LESS:
- case BINOP_GTR:
- case BINOP_LEQ:
- case BINOP_GEQ:
-
- case BINOP_REPEAT:
- case BINOP_SUBSCRIPT:
- case BINOP_COMMA:
- *pos += 1;
- nargs = 2;
- break;
-
- case UNOP_NEG:
- case UNOP_PLUS:
- case UNOP_LOGICAL_NOT:
- case UNOP_ABS:
- case UNOP_IND:
- *pos += 1;
- nargs = 1;
- break;
-
- case OP_LONG:
- case OP_FLOAT:
- case OP_VAR_VALUE:
- case OP_VAR_MSYM_VALUE:
- *pos += 4;
- break;
-
- case OP_TYPE:
- case OP_BOOL:
- case OP_LAST:
- case OP_INTERNALVAR:
- *pos += 3;
- break;
-
- case UNOP_MEMVAL:
- *pos += 3;
- nargs = 1;
- break;
-
- case OP_REGISTER:
- *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
- break;
-
- case STRUCTOP_STRUCT:
- *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
- nargs = 1;
- break;
-
- case TERNOP_SLICE:
- *pos += 1;
- nargs = 3;
- break;
-
- case OP_STRING:
- break;
-
- default:
- error (_("Unexpected operator during name resolution"));
- }
-
- argvec = XALLOCAVEC (struct value *, nargs + 1);
- for (i = 0; i < nargs; i += 1)
- {
- struct type *subtype = nullptr;
- if (i < array_arity)
- subtype = ada_index_type (array_type, i + 1, "array type");
- argvec[i] = resolve_subexp (expp, pos, 1, subtype, parse_completion,
- tracker);
- }
- argvec[i] = NULL;
- exp = expp->get ();
-
- /* Pass two: perform any resolution on principal operator. */
- switch (op)
- {
- default:
- break;
-
- case OP_VAR_VALUE:
- if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
- {
- block_symbol resolved
- = ada_resolve_variable (exp->elts[pc + 2].symbol,
- exp->elts[pc + 1].block,
- context_type, parse_completion,
- deprocedure_p, tracker);
- exp->elts[pc + 1].block = resolved.block;
- exp->elts[pc + 2].symbol = resolved.symbol;
- }
-
- if (deprocedure_p
- && (SYMBOL_TYPE (exp->elts[pc + 2].symbol)->code ()
- == TYPE_CODE_FUNC))
- {
- replace_operator_with_call (expp, pc, 0, 4,
- exp->elts[pc + 2].symbol,
- exp->elts[pc + 1].block);
- exp = expp->get ();
- }
- break;
-
- case OP_FUNCALL:
- {
- if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- {
- block_symbol resolved
- = ada_resolve_funcall (exp->elts[pc + 5].symbol,
- exp->elts[pc + 4].block,
- context_type, parse_completion,
- nargs, argvec,
- tracker);
- exp->elts[pc + 4].block = resolved.block;
- exp->elts[pc + 5].symbol = resolved.symbol;
- }
- }
- break;
- case BINOP_ADD:
- case BINOP_SUB:
- case BINOP_MUL:
- case BINOP_DIV:
- case BINOP_REM:
- case BINOP_MOD:
- case BINOP_CONCAT:
- case BINOP_BITWISE_AND:
- case BINOP_BITWISE_IOR:
- case BINOP_BITWISE_XOR:
- case BINOP_EQUAL:
- case BINOP_NOTEQUAL:
- case BINOP_LESS:
- case BINOP_GTR:
- case BINOP_LEQ:
- case BINOP_GEQ:
- case BINOP_EXP:
- case UNOP_NEG:
- case UNOP_PLUS:
- case UNOP_LOGICAL_NOT:
- case UNOP_ABS:
- {
- block_symbol found = ada_find_operator_symbol (op, parse_completion,
- nargs, argvec);
- if (found.symbol == nullptr)
- break;
-
- replace_operator_with_call (expp, pc, nargs, 1,
- found.symbol, found.block);
- exp = expp->get ();
- }
- break;
-
- case OP_TYPE:
- case OP_REGISTER:
- return NULL;
- }
-
- *pos = pc;
- if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
- return evaluate_var_msym_value (EVAL_AVOID_SIDE_EFFECTS,
- exp->elts[pc + 1].objfile,
- exp->elts[pc + 2].msymbol);
- else
- return evaluate_subexp_type (exp, pos);
-}
-
-/* Return non-zero if formal type FTYPE matches actual type ATYPE. If
- MAY_DEREF is non-zero, the formal may be a pointer and the actual
- a non-pointer. */
+/* Return non-zero if formal type FTYPE matches actual type ATYPE. */
/* The term "match" here is rather loose. The match is heuristic and
liberal. */
static int
-ada_type_match (struct type *ftype, struct type *atype, int may_deref)
+ada_type_match (struct type *ftype, struct type *atype)
{
ftype = ada_check_typedef (ftype);
atype = ada_check_typedef (atype);
default:
return ftype->code () == atype->code ();
case TYPE_CODE_PTR:
- if (atype->code () == TYPE_CODE_PTR)
- return ada_type_match (TYPE_TARGET_TYPE (ftype),
- TYPE_TARGET_TYPE (atype), 0);
- else
- return (may_deref
- && ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0));
+ if (atype->code () != TYPE_CODE_PTR)
+ return 0;
+ atype = TYPE_TARGET_TYPE (atype);
+ /* This can only happen if the actual argument is 'null'. */
+ if (atype->code () == TYPE_CODE_INT && TYPE_LENGTH (atype) == 0)
+ return 1;
+ return ada_type_match (TYPE_TARGET_TYPE (ftype), atype);
case TYPE_CODE_INT:
case TYPE_CODE_ENUM:
case TYPE_CODE_RANGE:
struct type *ftype = ada_check_typedef (func_type->field (i).type ());
struct type *atype = ada_check_typedef (value_type (actuals[i]));
- if (!ada_type_match (ftype, atype, 1))
+ if (!ada_type_match (ftype, atype))
return 0;
}
}
ada_resolve_function (std::vector<struct block_symbol> &syms,
struct value **args, int nargs,
const char *name, struct type *context_type,
- int parse_completion)
+ bool parse_completion)
{
int fallback;
int k;
return 0;
}
-/* Replace the operator of length OPLEN at position PC in *EXPP with a call
- on the function identified by SYM and BLOCK, and taking NARGS
- arguments. Update *EXPP as needed to hold more space. */
-
-static void
-replace_operator_with_call (expression_up *expp, int pc, int nargs,
- int oplen, struct symbol *sym,
- const struct block *block)
-{
- /* We want to add 6 more elements (3 for funcall, 4 for function
- symbol, -OPLEN for operator being replaced) to the
- expression. */
- struct expression *exp = expp->get ();
- int save_nelts = exp->nelts;
- int extra_elts = 7 - oplen;
- exp->nelts += extra_elts;
-
- if (extra_elts > 0)
- exp->resize (exp->nelts);
- memmove (exp->elts + pc + 7, exp->elts + pc + oplen,
- EXP_ELEM_TO_BYTES (save_nelts - pc - oplen));
- if (extra_elts < 0)
- exp->resize (exp->nelts);
-
- exp->elts[pc].opcode = exp->elts[pc + 2].opcode = OP_FUNCALL;
- exp->elts[pc + 1].longconst = (LONGEST) nargs;
-
- exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE;
- exp->elts[pc + 4].block = block;
- exp->elts[pc + 5].symbol = sym;
-}
-
/* Type-class predicates */
/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type),
{
case TYPE_CODE_INT:
case TYPE_CODE_FLT:
+ case TYPE_CODE_FIXED_POINT:
return 1;
case TYPE_CODE_RANGE:
return (type == TYPE_TARGET_TYPE (type)
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
case TYPE_CODE_FLT:
+ case TYPE_CODE_FIXED_POINT:
return 1;
default:
return 0;
VALUE_LVAL (val) = lval_memory;
set_value_address (val, addr);
- write_memory (addr, value_contents (val), len);
+ write_memory (addr, value_contents (val).data (), len);
}
return val;
If not found then let's look in the fixed type. */
if (!find_struct_field (name, t1, 0,
- &field_type, &byte_offset, &bit_offset,
- &bit_size, NULL))
+ nullptr, nullptr, nullptr,
+ nullptr, nullptr))
check_tag = 1;
else
check_tag = 0;
actual_type = ada_check_typedef (value_type (actual));
val = allocate_value (actual_type);
- memcpy ((char *) value_contents_raw (val),
- (char *) value_contents (actual),
- TYPE_LENGTH (actual_type));
+ copy (value_contents (actual), value_contents_raw (val));
actual = ensure_lval (val);
}
result = value_addr (actual);
for (i = ada_array_arity (ada_check_typedef (value_type (arr)));
i > 0; i -= 1)
{
- modify_field (value_type (bounds), value_contents_writeable (bounds),
+ modify_field (value_type (bounds),
+ value_contents_writeable (bounds).data (),
ada_array_bound (arr, i, 0),
desc_bound_bitpos (bounds_type, i, 0),
desc_bound_bitsize (bounds_type, i, 0));
- modify_field (value_type (bounds), value_contents_writeable (bounds),
+ modify_field (value_type (bounds),
+ value_contents_writeable (bounds).data (),
ada_array_bound (arr, i, 1),
desc_bound_bitpos (bounds_type, i, 1),
desc_bound_bitsize (bounds_type, i, 1));
bounds = ensure_lval (bounds);
modify_field (value_type (descriptor),
- value_contents_writeable (descriptor),
+ value_contents_writeable (descriptor).data (),
value_pointer (ensure_lval (arr),
desc_type->field (0).type ()),
fat_pntr_data_bitpos (desc_type),
fat_pntr_data_bitsize (desc_type));
modify_field (value_type (descriptor),
- value_contents_writeable (descriptor),
+ value_contents_writeable (descriptor).data (),
value_pointer (bounds,
desc_type->field (1).type ()),
fat_pntr_bounds_bitpos (desc_type),
return result;
}
-/* For all subprograms that statically enclose the subprogram of the
- selected frame, add symbols matching identifier NAME in DOMAIN
- and their blocks to the list of data in RESULT, as for
- ada_add_block_symbols (q.v.). If WILD_MATCH_P, treat as NAME
- with a wildcard prefix. */
-
-static void
-add_symbols_from_enclosing_procs (std::vector<struct block_symbol> &result,
- const lookup_name_info &lookup_name,
- domain_enum domain)
-{
-}
-
/* True if TYPE is definitely an artificial type supplied to a symbol
for which no debugging information was given in the symbol file. */
/* All enums in the type should have an identical underlying value. */
for (i = 0; i < type1->num_fields (); i++)
- if (TYPE_FIELD_ENUMVAL (type1, i) != TYPE_FIELD_ENUMVAL (type2, i))
+ if (type1->field (i).loc_enumval () != type2->field (i).loc_enumval ())
return 0;
/* All enumerals should also have the same name (modulo any numerical
suffix). */
for (i = 0; i < type1->num_fields (); i++)
{
- const char *name_1 = TYPE_FIELD_NAME (type1, i);
- const char *name_2 = TYPE_FIELD_NAME (type2, i);
+ const char *name_1 = type1->field (i).name ();
+ const char *name_2 = type2->field (i).name ();
int len_1 = strlen (name_1);
int len_2 = strlen (name_2);
- ada_remove_trailing_digits (TYPE_FIELD_NAME (type1, i), &len_1);
- ada_remove_trailing_digits (TYPE_FIELD_NAME (type2, i), &len_2);
+ ada_remove_trailing_digits (type1->field (i).name (), &len_1);
+ ada_remove_trailing_digits (type2->field (i).name (), &len_2);
if (len_1 != len_2
- || strncmp (TYPE_FIELD_NAME (type1, i),
- TYPE_FIELD_NAME (type2, i),
+ || strncmp (type1->field (i).name (),
+ type2->field (i).name (),
len_1) != 0)
return 0;
}
}
/* Add to RESULT all symbols from BLOCK (and its super-blocks)
- whose name and domain match NAME and DOMAIN respectively.
- If no match was found, then extend the search to "enclosing"
- routines (in other words, if we're inside a nested function,
- search the symbols defined inside the enclosing functions).
- If WILD_MATCH_P is nonzero, perform the naming matching in
- "wild" mode (see function "wild_match" for more info).
+ whose name and domain match LOOKUP_NAME and DOMAIN respectively.
- Note: This function assumes that RESULT has 0 (zero) element in it. */
+ Note: This function assumes that RESULT is empty. */
static void
ada_add_local_symbols (std::vector<struct block_symbol> &result,
const lookup_name_info &lookup_name,
const struct block *block, domain_enum domain)
{
- int block_depth = 0;
-
while (block != NULL)
{
- block_depth += 1;
ada_add_block_symbols (result, block, lookup_name, domain, NULL);
- /* If we found a non-function match, assume that's the one. */
- if (is_nonfunction (result))
+ /* If we found a non-function match, assume that's the one. We
+ only check this when finding a function boundary, so that we
+ can accumulate all results from intervening blocks first. */
+ if (BLOCK_FUNCTION (block) != nullptr && is_nonfunction (result))
return;
block = BLOCK_SUPERBLOCK (block);
}
-
- /* If no luck so far, try to find NAME as a local symbol in some lexically
- enclosing subprogram. */
- if (result.empty () && block_depth > 2)
- add_symbols_from_enclosing_procs (result, lookup_name, domain);
}
-/* An object of this type is used as the user_data argument when
+/* An object of this type is used as the callback argument when
calling the map_matching_symbols method. */
struct match_data
}
DISABLE_COPY_AND_ASSIGN (match_data);
+ bool operator() (struct block_symbol *bsym);
+
struct objfile *objfile = nullptr;
std::vector<struct block_symbol> *resultp;
struct symbol *arg_sym = nullptr;
bool found_sym = false;
};
-/* A callback for add_nonlocal_symbols that adds symbol, found in BSYM,
- to a list of symbols. DATA is a pointer to a struct match_data *
- containing the vector that collects the symbol list, the file that SYM
- must come from, a flag indicating whether a non-argument symbol has
- been found in the current block, and the last argument symbol
- passed in SYM within the current block (if any). When SYM is null,
- marking the end of a block, the argument symbol is added if no
- other has been found. */
+/* A callback for add_nonlocal_symbols that adds symbol, found in
+ BSYM, to a list of symbols. */
-static bool
-aux_add_nonlocal_symbols (struct block_symbol *bsym,
- struct match_data *data)
+bool
+match_data::operator() (struct block_symbol *bsym)
{
const struct block *block = bsym->block;
struct symbol *sym = bsym->symbol;
if (sym == NULL)
{
- if (!data->found_sym && data->arg_sym != NULL)
- add_defn_to_vec (*data->resultp,
- fixup_symbol_section (data->arg_sym, data->objfile),
+ if (!found_sym && arg_sym != NULL)
+ add_defn_to_vec (*resultp,
+ fixup_symbol_section (arg_sym, objfile),
block);
- data->found_sym = false;
- data->arg_sym = NULL;
+ found_sym = false;
+ arg_sym = NULL;
}
else
{
if (SYMBOL_CLASS (sym) == LOC_UNRESOLVED)
return true;
else if (SYMBOL_IS_ARGUMENT (sym))
- data->arg_sym = sym;
+ arg_sym = sym;
else
{
- data->found_sym = true;
- add_defn_to_vec (*data->resultp,
- fixup_symbol_section (sym, data->objfile),
+ found_sym = true;
+ add_defn_to_vec (*resultp,
+ fixup_symbol_section (sym, objfile),
block);
}
}
return lookup_name.ada ().lookup_name ().c_str ();
}
+/* A helper for add_nonlocal_symbols. Call expand_matching_symbols
+ for OBJFILE, then walk the objfile's symtabs and update the
+ results. */
+
+static void
+map_matching_symbols (struct objfile *objfile,
+ const lookup_name_info &lookup_name,
+ bool is_wild_match,
+ domain_enum domain,
+ int global,
+ match_data &data)
+{
+ data.objfile = objfile;
+ objfile->expand_matching_symbols (lookup_name, domain, global,
+ is_wild_match ? nullptr : compare_names);
+
+ const int block_kind = global ? GLOBAL_BLOCK : STATIC_BLOCK;
+ for (compunit_symtab *symtab : objfile->compunits ())
+ {
+ const struct block *block
+ = BLOCKVECTOR_BLOCK (symtab->blockvector (), block_kind);
+ if (!iterate_over_symbols_terminated (block, lookup_name,
+ domain, data))
+ break;
+ }
+}
+
/* Add to RESULT all non-local symbols whose name and domain match
LOOKUP_NAME and DOMAIN respectively. The search is performed on
GLOBAL_BLOCK symbols if GLOBAL is non-zero, or on STATIC_BLOCK
bool is_wild_match = lookup_name.ada ().wild_match_p ();
- auto callback = [&] (struct block_symbol *bsym)
- {
- return aux_add_nonlocal_symbols (bsym, &data);
- };
-
for (objfile *objfile : current_program_space->objfiles ())
{
- data.objfile = objfile;
-
- if (objfile->sf != nullptr)
- objfile->sf->qf->map_matching_symbols (objfile, lookup_name,
- domain, global, callback,
- (is_wild_match
- ? NULL : compare_names));
+ map_matching_symbols (objfile, lookup_name, is_wild_match, domain,
+ global, data);
for (compunit_symtab *cu : objfile->compunits ())
{
const struct block *global_block
- = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (cu), GLOBAL_BLOCK);
+ = BLOCKVECTOR_BLOCK (cu->blockvector (), GLOBAL_BLOCK);
if (ada_add_block_renamings (result, global_block, lookup_name,
domain))
lookup_name_info name1 (bracket_name, symbol_name_match_type::FULL);
for (objfile *objfile : current_program_space->objfiles ())
- {
- data.objfile = objfile;
- if (objfile->sf != nullptr)
- objfile->sf->qf->map_matching_symbols (objfile, name1,
- domain, global, callback,
- compare_names);
- }
- }
+ map_matching_symbols (objfile, name1, false, domain, global, data);
+ }
}
/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if
/* Check the name of that field. */
{
- const char *name = TYPE_FIELD_NAME (type, field_num);
+ const char *name = type->field (field_num).name ();
/* Anonymous field names should not be printed.
brobecker/2007-02-20: I don't think this can actually happen
int tag_byte_offset;
struct type *tag_type;
- if (find_struct_field ("_tag", type, 0, &tag_type, &tag_byte_offset,
+ gdb::array_view<const gdb_byte> contents;
+ if (valaddr != nullptr)
+ contents = gdb::make_array_view (valaddr, TYPE_LENGTH (type));
+ struct type *resolved_type = resolve_dynamic_type (type, contents, address);
+ if (find_struct_field ("_tag", resolved_type, 0, &tag_type, &tag_byte_offset,
NULL, NULL, NULL))
{
const gdb_byte *valaddr1 = ((valaddr == NULL)
int
ada_is_parent_field (struct type *type, int field_num)
{
- const char *name = TYPE_FIELD_NAME (ada_check_typedef (type), field_num);
+ const char *name = ada_check_typedef (type)->field (field_num).name ();
return (name != NULL
&& (startswith (name, "PARENT")
int
ada_is_wrapper_field (struct type *type, int field_num)
{
- const char *name = TYPE_FIELD_NAME (type, field_num);
+ const char *name = type->field (field_num).name ();
if (name != NULL && strcmp (name, "RETVAL") == 0)
{
static int
ada_is_others_clause (struct type *type, int field_num)
{
- const char *name = TYPE_FIELD_NAME (type, field_num);
+ const char *name = type->field (field_num).name ();
return (name != NULL && name[0] == 'O');
}
static int
ada_in_variant (LONGEST val, struct type *type, int field_num)
{
- const char *name = TYPE_FIELD_NAME (type, field_num);
+ const char *name = type->field (field_num).name ();
int p;
p = 0;
packed; in this case we must take the bit-field path. */
if (TYPE_FIELD_BITSIZE (arg_type, fieldno) != 0 || value_bitpos (arg1) != 0)
{
- int bit_pos = TYPE_FIELD_BITPOS (arg_type, fieldno);
+ int bit_pos = arg_type->field (fieldno).loc_bitpos ();
int bit_size = TYPE_FIELD_BITSIZE (arg_type, fieldno);
- return ada_value_primitive_packed_val (arg1, value_contents (arg1),
+ return ada_value_primitive_packed_val (arg1,
+ value_contents (arg1).data (),
offset + bit_pos / 8,
bit_pos % 8, bit_size, type);
}
for (i = 0; i < type->num_fields (); i += 1)
{
- int bit_pos = TYPE_FIELD_BITPOS (type, i);
- int fld_offset = offset + bit_pos / 8;
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ /* These can't be computed using TYPE_FIELD_BITPOS for a dynamic
+ type. However, we only need the values to be correct when
+ the caller asks for them. */
+ int bit_pos = 0, fld_offset = 0;
+ if (byte_offset_p != nullptr || bit_offset_p != nullptr)
+ {
+ bit_pos = type->field (i).loc_bitpos ();
+ fld_offset = offset + bit_pos / 8;
+ }
+
+ const char *t_field_name = type->field (i).name ();
if (t_field_name == NULL)
continue;
{
if (find_struct_field (name, field_type->field (j).type (),
fld_offset
- + TYPE_FIELD_BITPOS (field_type, j) / 8,
+ + field_type->field (j).loc_bitpos () / 8,
field_type_p, byte_offset_p,
bit_offset_p, bit_size_p, index_p))
return 1;
if (parent_offset != -1)
{
- int bit_pos = TYPE_FIELD_BITPOS (type, parent_offset);
- int fld_offset = offset + bit_pos / 8;
+ /* As above, only compute the offset when truly needed. */
+ int fld_offset = offset;
+ if (byte_offset_p != nullptr || bit_offset_p != nullptr)
+ {
+ int bit_pos = type->field (parent_offset).loc_bitpos ();
+ fld_offset += bit_pos / 8;
+ }
if (find_struct_field (name, type->field (parent_offset).type (),
fld_offset, field_type_p, byte_offset_p,
type = ada_check_typedef (type);
for (i = 0; i < type->num_fields (); i += 1)
{
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = type->field (i).name ();
if (t_field_name == NULL)
continue;
{
struct value *v = /* Do not let indent join lines here. */
ada_search_struct_field (name, arg,
- offset + TYPE_FIELD_BITPOS (type, i) / 8,
+ offset + type->field (i).loc_bitpos () / 8,
type->field (i).type ());
if (v != NULL)
/* PNH: Do we ever get here? See find_struct_field. */
int j;
struct type *field_type = ada_check_typedef (type->field (i).type ());
- int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
+ int var_offset = offset + type->field (i).loc_bitpos () / 8;
for (j = 0; j < field_type->num_fields (); j += 1)
{
struct value *v = ada_search_struct_field /* Force line
break. */
(name, arg,
- var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
+ var_offset + field_type->field (j).loc_bitpos () / 8,
field_type->field (j).type ());
if (v != NULL)
if (parent_offset != -1)
{
struct value *v = ada_search_struct_field (
- name, arg, offset + TYPE_FIELD_BITPOS (type, parent_offset) / 8,
+ name, arg, offset + type->field (parent_offset).loc_bitpos () / 8,
type->field (parent_offset).type ());
if (v != NULL)
for (i = 0; i < type->num_fields (); i += 1)
{
- if (TYPE_FIELD_NAME (type, i) == NULL)
+ if (type->field (i).name () == NULL)
continue;
else if (ada_is_wrapper_field (type, i))
{
struct value *v = /* Do not let indent join lines here. */
ada_index_struct_field_1 (index_p, arg,
- offset + TYPE_FIELD_BITPOS (type, i) / 8,
+ offset + type->field (i).loc_bitpos () / 8,
type->field (i).type ());
if (v != NULL)
type_print (type, "", &tmp_stream, -1);
- return std::move (tmp_stream.string ());
+ return tmp_stream.release ();
}
/* Given a type TYPE, look up the type of the component of type named NAME.
for (i = 0; i < type->num_fields (); i += 1)
{
- const char *t_field_name = TYPE_FIELD_NAME (type, i);
+ const char *t_field_name = type->field (i).name ();
struct type *t;
if (t_field_name == NULL)
NOT wrapped in a struct, since the compiler sometimes
generates these for unchecked variant types. Revisit
if the compiler changes this practice. */
- const char *v_field_name = TYPE_FIELD_NAME (field_type, j);
+ const char *v_field_name = field_type->field (j).name ();
if (v_field_name != NULL
&& field_name_match (v_field_name, name))
static unsigned int
field_alignment (struct type *type, int f)
{
- const char *name = TYPE_FIELD_NAME (type, f);
+ const char *name = type->field (f).name ();
int len;
int align_offset;
static int
is_dynamic_field (struct type *templ_type, int field_num)
{
- const char *name = TYPE_FIELD_NAME (templ_type, field_num);
+ const char *name = templ_type->field (field_num).name ();
return name != NULL
&& templ_type->field (field_num).type ()->code () == TYPE_CODE_PTR
for (f = 0; f < nfields; f += 1)
{
off = align_up (off, field_alignment (type, f))
- + TYPE_FIELD_BITPOS (type, f);
- SET_FIELD_BITPOS (rtype->field (f), off);
+ + type->field (f).loc_bitpos ();
+ rtype->field (f).set_loc_bitpos (off);
TYPE_FIELD_BITSIZE (rtype, f) = 0;
if (ada_is_variant_part (type, f))
if (dval0 == NULL)
{
- /* rtype's length is computed based on the run-time
- value of discriminants. If the discriminants are not
- initialized, the type size may be completely bogus and
- GDB may fail to allocate a value for it. So check the
- size first before creating the value. */
- ada_ensure_varsize_limit (rtype);
/* Using plain value_from_contents_and_address here
causes problems because we will end up trying to
resolve a type that is currently being
that follow this one. */
if (ada_is_aligner_type (field_type))
{
- long field_offset = TYPE_FIELD_BITPOS (field_type, f);
+ long field_offset = type->field (f).loc_bitpos ();
field_valaddr = cond_offset_host (field_valaddr, field_offset);
field_address = cond_offset_target (field_address, field_offset);
field_type = ada_get_base_type (field_type);
field_type = ada_to_fixed_type (field_type, field_valaddr,
field_address, dval, 0);
- /* If the field size is already larger than the maximum
- object size, then the record itself will necessarily
- be larger than the maximum object size. We need to make
- this check now, because the size might be so ridiculously
- large (due to an uninitialized variable in the inferior)
- that it would cause an overflow when adding it to the
- record size. */
- ada_ensure_varsize_limit (field_type);
rtype->field (f).set_type (field_type);
- TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
+ rtype->field (f).set_name (type->field (f).name ());
/* The multiplication can potentially overflow. But because
the field length has been size-checked just above, and
assuming that the maximum size is a reasonable value,
to distinguish between the two options. Stripping it
would prevent us from printing this field appropriately. */
rtype->field (f).set_type (type->field (f).type ());
- TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
+ rtype->field (f).set_name (type->field (f).name ());
if (TYPE_FIELD_BITSIZE (type, f) > 0)
fld_bit_len =
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
{
struct type *branch_type;
- off = TYPE_FIELD_BITPOS (rtype, variant_field);
+ off = rtype->field (variant_field).loc_bitpos ();
if (dval0 == NULL)
{
else
{
rtype->field (variant_field).set_type (branch_type);
- TYPE_FIELD_NAME (rtype, variant_field) = "S";
+ rtype->field (variant_field).set_name ("S");
fld_bit_len =
TYPE_LENGTH (rtype->field (variant_field).type ()) *
TARGET_CHAR_BIT;
}
value_free_to_mark (mark);
- if (TYPE_LENGTH (rtype) > varsize_limit)
- error (_("record type with dynamic size is larger than varsize-limit"));
return rtype;
}
TYPE_LENGTH (type) = 0;
}
type->field (f).set_type (new_type);
- TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
+ type->field (f).set_name (type0->field (f).name ());
}
}
branch_type = to_fixed_variant_branch_type
(type->field (variant_field).type (),
cond_offset_host (valaddr,
- TYPE_FIELD_BITPOS (type, variant_field)
+ type->field (variant_field).loc_bitpos ()
/ TARGET_CHAR_BIT),
cond_offset_target (address,
- TYPE_FIELD_BITPOS (type, variant_field)
+ type->field (variant_field).loc_bitpos ()
/ TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
{
else
{
rtype->field (variant_field).set_type (branch_type);
- TYPE_FIELD_NAME (rtype, variant_field) = "S";
+ rtype->field (variant_field).set_name ("S");
TYPE_FIELD_BITSIZE (rtype, variant_field) = 0;
TYPE_LENGTH (rtype) += TYPE_LENGTH (branch_type);
}
result, range_type);
elt_type0 = TYPE_TARGET_TYPE (elt_type0);
}
- if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit)
- error (_("array type with dynamic size is larger than varsize-limit"));
}
/* We want to preserve the type name. This can be useful when
/* Our value does not live in memory; it could be a convenience
variable, for instance. Create a not_lval value using val0's
contents. */
- return value_from_contents (type, value_contents (val0));
+ return value_from_contents (type, value_contents (val0).data ());
}
return value_from_contents_and_address (type, 0, address);
return *result;
}
-static struct value *
-value_pos_atr (struct type *type, struct value *arg)
+struct value *
+ada_pos_atr (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside, enum exp_opcode op,
+ struct value *arg)
{
+ struct type *type = builtin_type (exp->gdbarch)->builtin_int;
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (type, not_lval);
return value_from_longest (type, pos_atr (arg));
}
{
if (val < 0 || val >= type->num_fields ())
error (_("argument to 'VAL out of range"));
- val = TYPE_FIELD_ENUMVAL (type, val);
+ val = type->field (val).loc_enumval ();
}
return value_from_longest (type, val);
}
-static struct value *
+struct value *
ada_val_atr (enum noside noside, struct type *type, struct value *arg)
{
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return (type->code () == TYPE_CODE_STRUCT
&& type->num_fields () == 1
- && strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
+ && strcmp (type->field (0).name (), "F") == 0);
}
/* If there is an ___XVS-convention type parallel to SUBTYPE, return
/* This is an older encoding form where the base type needs to be
looked up by name. We prefer the newer encoding because it is
more efficient. */
- raw_real_type = ada_find_any_type (TYPE_FIELD_NAME (real_type_namer, 0));
+ raw_real_type = ada_find_any_type (real_type_namer->field (0).name ());
if (raw_real_type == NULL)
return raw_type;
else
ada_aligned_value_addr (struct type *type, const gdb_byte *valaddr)
{
if (ada_is_aligner_type (type))
- return ada_aligned_value_addr (type->field (0).type (),
- valaddr +
- TYPE_FIELD_BITPOS (type,
- 0) / TARGET_CHAR_BIT);
+ return ada_aligned_value_addr
+ (type->field (0).type (),
+ valaddr + type->field (0).loc_bitpos () / TARGET_CHAR_BIT);
else
return valaddr;
}
}
}
-/* Evaluate the subexpression of EXP starting at *POS as for
- evaluate_type, updating *POS to point just past the evaluated
- expression. */
-
-static struct value *
-evaluate_subexp_type (struct expression *exp, int *pos)
-{
- return evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
-}
-
/* If VAL is wrapped in an aligner or subtype wrapper, return the
value it wraps. */
{
struct type *elt_type = TYPE_TARGET_TYPE (type);
LONGEST lo, hi;
- struct value *res;
LONGEST i;
/* Verify that both val and type are arrays of scalars, and
if (!get_array_bounds (type, &lo, &hi))
error (_("unable to determine array bounds"));
- res = allocate_value (type);
+ value *res = allocate_value (type);
+ gdb::array_view<gdb_byte> res_contents = value_contents_writeable (res);
/* Promote each array element. */
for (i = 0; i < hi - lo + 1; i++)
{
struct value *elt = value_cast (elt_type, value_subscript (val, lo + i));
+ int elt_len = TYPE_LENGTH (elt_type);
- memcpy (value_contents_writeable (res) + (i * TYPE_LENGTH (elt_type)),
- value_contents_all (elt), TYPE_LENGTH (elt_type));
+ copy (value_contents_all (elt), res_contents.slice (elt_len * i, elt_len));
}
return res;
v2 = value_as_long (arg2);
if (v2 == 0)
- error (_("second operand of %s must not be zero."), op_string (op));
+ {
+ const char *name;
+ if (op == BINOP_MOD)
+ name = "mod";
+ else if (op == BINOP_DIV)
+ name = "/";
+ else
+ {
+ gdb_assert (op == BINOP_REM);
+ name = "rem";
+ }
+
+ error (_("second operand of %s must not be zero."), name);
+ }
if (type1->is_unsigned () || op == BINOP_MOD)
return value_binop (arg1, arg2, op);
}
val = allocate_value (type1);
- store_unsigned_integer (value_contents_raw (val),
+ store_unsigned_integer (value_contents_raw (val).data (),
TYPE_LENGTH (value_type (val)),
type_byte_order (type1), v);
return val;
representations use all bits (no padding or undefined bits)
and do not have user-defined equality. */
return (TYPE_LENGTH (arg1_type) == TYPE_LENGTH (arg2_type)
- && memcmp (value_contents (arg1), value_contents (arg2),
+ && memcmp (value_contents (arg1).data (),
+ value_contents (arg2).data (),
TYPE_LENGTH (arg1_type)) == 0);
}
return value_equal (arg1, arg2);
}
-/* Assign the result of evaluating EXP starting at *POS to the INDEXth
- component of LHS (a simple array or a record), updating *POS past
- the expression, assuming that LHS is contained in CONTAINER. Does
- not modify the inferior's memory, nor does it modify LHS (unless
- LHS == CONTAINER). */
-
-static void
-assign_component (struct value *container, struct value *lhs, LONGEST index,
- struct expression *exp, int *pos)
+namespace expr
{
- struct value *mark = value_mark ();
+
+bool
+check_objfile (const std::unique_ptr<ada_component> &comp,
+ struct objfile *objfile)
+{
+ return comp->uses_objfile (objfile);
+}
+
+/* Assign the result of evaluating ARG starting at *POS to the INDEXth
+ component of LHS (a simple array or a record). Does not modify the
+ inferior's memory, nor does it modify LHS (unless LHS ==
+ CONTAINER). */
+
+static void
+assign_component (struct value *container, struct value *lhs, LONGEST index,
+ struct expression *exp, operation_up &arg)
+{
+ scoped_value_mark mark;
+
struct value *elt;
struct type *lhs_type = check_typedef (value_type (lhs));
elt = ada_to_fixed_value (elt);
}
- if (exp->elts[*pos].opcode == OP_AGGREGATE)
- assign_aggregate (container, elt, exp, pos, EVAL_NORMAL);
+ ada_aggregate_operation *ag_op
+ = dynamic_cast<ada_aggregate_operation *> (arg.get ());
+ if (ag_op != nullptr)
+ ag_op->assign_aggregate (container, elt, exp);
else
- value_assign_to_component (container, elt,
- ada_evaluate_subexp (NULL, exp, pos,
- EVAL_NORMAL));
+ value_assign_to_component (container, elt,
+ arg->evaluate (nullptr, exp,
+ EVAL_NORMAL));
+}
- value_free_to_mark (mark);
+bool
+ada_aggregate_component::uses_objfile (struct objfile *objfile)
+{
+ for (const auto &item : m_components)
+ if (item->uses_objfile (objfile))
+ return true;
+ return false;
}
-/* Assuming that LHS represents an lvalue having a record or array
- type, and EXP->ELTS[*POS] is an OP_AGGREGATE, evaluate an assignment
- of that aggregate's value to LHS, advancing *POS past the
- aggregate. NOSIDE is as for evaluate_subexp. CONTAINER is an
- lvalue containing LHS (possibly LHS itself). Does not modify
- the inferior's memory, nor does it modify the contents of
- LHS (unless == CONTAINER). Returns the modified CONTAINER. */
+void
+ada_aggregate_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sAggregate\n"), depth, "");
+ for (const auto &item : m_components)
+ item->dump (stream, depth + 1);
+}
-static struct value *
-assign_aggregate (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, enum noside noside)
+void
+ada_aggregate_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ for (auto &item : m_components)
+ item->assign (container, lhs, exp, indices, low, high);
+}
+
+/* See ada-exp.h. */
+
+value *
+ada_aggregate_operation::assign_aggregate (struct value *container,
+ struct value *lhs,
+ struct expression *exp)
{
struct type *lhs_type;
- int n = exp->elts[*pos+1].longconst;
LONGEST low_index, high_index;
- int i;
-
- *pos += 3;
- if (noside != EVAL_NORMAL)
- {
- for (i = 0; i < n; i += 1)
- ada_evaluate_subexp (NULL, exp, pos, noside);
- return container;
- }
container = ada_coerce_ref (container);
if (ada_is_direct_array_type (value_type (container)))
indices[0] = indices[1] = low_index - 1;
indices[2] = indices[3] = high_index + 1;
- for (i = 0; i < n; i += 1)
- {
- switch (exp->elts[*pos].opcode)
- {
- case OP_CHOICES:
- aggregate_assign_from_choices (container, lhs, exp, pos, indices,
- low_index, high_index);
- break;
- case OP_POSITIONAL:
- aggregate_assign_positional (container, lhs, exp, pos, indices,
- low_index, high_index);
- break;
- case OP_OTHERS:
- if (i != n-1)
- error (_("Misplaced 'others' clause"));
- aggregate_assign_others (container, lhs, exp, pos, indices,
- low_index, high_index);
- break;
- default:
- error (_("Internal error: bad aggregate clause"));
- }
- }
+ std::get<0> (m_storage)->assign (container, lhs, exp, indices,
+ low_index, high_index);
return container;
}
-
+
+bool
+ada_positional_component::uses_objfile (struct objfile *objfile)
+{
+ return m_op->uses_objfile (objfile);
+}
+
+void
+ada_positional_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sPositional, index = %d\n"),
+ depth, "", m_index);
+ m_op->dump (stream, depth + 1);
+}
+
/* Assign into the component of LHS indexed by the OP_POSITIONAL
- construct at *POS, updating *POS past the construct, given that
- the positions are relative to lower bound LOW, where HIGH is the
- upper bound. Record the position in INDICES. CONTAINER is as for
- assign_aggregate. */
-static void
-aggregate_assign_positional (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
+ construct, given that the positions are relative to lower bound
+ LOW, where HIGH is the upper bound. Record the position in
+ INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_positional_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
- LONGEST ind = longest_to_int (exp->elts[*pos + 1].longconst) + low;
-
+ LONGEST ind = m_index + low;
+
if (ind - 1 == high)
warning (_("Extra components in aggregate ignored."));
if (ind <= high)
{
add_component_interval (ind, ind, indices);
- *pos += 3;
- assign_component (container, lhs, ind, exp, pos);
+ assign_component (container, lhs, ind, exp, m_op);
}
- else
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
}
-/* Assign into the components of LHS indexed by the OP_CHOICES
- construct at *POS, updating *POS past the construct, given that
- the allowable indices are LOW..HIGH. Record the indices assigned
- to in INDICES. CONTAINER is as for assign_aggregate. */
-static void
-aggregate_assign_from_choices (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
+bool
+ada_discrete_range_association::uses_objfile (struct objfile *objfile)
+{
+ return m_low->uses_objfile (objfile) || m_high->uses_objfile (objfile);
+}
+
+void
+ada_discrete_range_association::dump (ui_file *stream, int depth)
{
- int j;
- int n_choices = longest_to_int (exp->elts[*pos+1].longconst);
- int choice_pos, expr_pc;
- int is_array = ada_is_direct_array_type (value_type (lhs));
+ fprintf_filtered (stream, _("%*sDiscrete range:\n"), depth, "");
+ m_low->dump (stream, depth + 1);
+ m_high->dump (stream, depth + 1);
+}
- choice_pos = *pos += 3;
+void
+ada_discrete_range_association::assign (struct value *container,
+ struct value *lhs,
+ struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op)
+{
+ LONGEST lower = value_as_long (m_low->evaluate (nullptr, exp, EVAL_NORMAL));
+ LONGEST upper = value_as_long (m_high->evaluate (nullptr, exp, EVAL_NORMAL));
- for (j = 0; j < n_choices; j += 1)
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
- expr_pc = *pos;
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
-
- for (j = 0; j < n_choices; j += 1)
+ if (lower <= upper && (lower < low || upper > high))
+ error (_("Index in component association out of bounds."));
+
+ add_component_interval (lower, upper, indices);
+ while (lower <= upper)
{
- LONGEST lower, upper;
- enum exp_opcode op = exp->elts[choice_pos].opcode;
+ assign_component (container, lhs, lower, exp, op);
+ lower += 1;
+ }
+}
- if (op == OP_DISCRETE_RANGE)
- {
- choice_pos += 1;
- lower = value_as_long (ada_evaluate_subexp (NULL, exp, pos,
- EVAL_NORMAL));
- upper = value_as_long (ada_evaluate_subexp (NULL, exp, pos,
- EVAL_NORMAL));
- }
- else if (is_array)
- {
- lower = value_as_long (ada_evaluate_subexp (NULL, exp, &choice_pos,
- EVAL_NORMAL));
- upper = lower;
- }
- else
- {
- int ind;
- const char *name;
+bool
+ada_name_association::uses_objfile (struct objfile *objfile)
+{
+ return m_val->uses_objfile (objfile);
+}
- switch (op)
- {
- case OP_NAME:
- name = &exp->elts[choice_pos + 2].string;
- break;
- case OP_VAR_VALUE:
- name = exp->elts[choice_pos + 2].symbol->natural_name ();
- break;
- default:
- error (_("Invalid record component association."));
- }
- ada_evaluate_subexp (NULL, exp, &choice_pos, EVAL_SKIP);
- ind = 0;
- if (! find_struct_field (name, value_type (lhs), 0,
- NULL, NULL, NULL, NULL, &ind))
- error (_("Unknown component name: %s."), name);
- lower = upper = ind;
- }
+void
+ada_name_association::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sName:\n"), depth, "");
+ m_val->dump (stream, depth + 1);
+}
- if (lower <= upper && (lower < low || upper > high))
- error (_("Index in component association out of bounds."));
+void
+ada_name_association::assign (struct value *container,
+ struct value *lhs,
+ struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high,
+ operation_up &op)
+{
+ int index;
- add_component_interval (lower, upper, indices);
- while (lower <= upper)
- {
- int pos1;
+ if (ada_is_direct_array_type (value_type (lhs)))
+ index = longest_to_int (value_as_long (m_val->evaluate (nullptr, exp,
+ EVAL_NORMAL)));
+ else
+ {
+ ada_string_operation *strop
+ = dynamic_cast<ada_string_operation *> (m_val.get ());
- pos1 = expr_pc;
- assign_component (container, lhs, lower, exp, &pos1);
- lower += 1;
+ const char *name;
+ if (strop != nullptr)
+ name = strop->get_name ();
+ else
+ {
+ ada_var_value_operation *vvo
+ = dynamic_cast<ada_var_value_operation *> (m_val.get ());
+ if (vvo != nullptr)
+ error (_("Invalid record component association."));
+ name = vvo->get_symbol ()->natural_name ();
}
+
+ index = 0;
+ if (! find_struct_field (name, value_type (lhs), 0,
+ NULL, NULL, NULL, NULL, &index))
+ error (_("Unknown component name: %s."), name);
}
+
+ add_component_interval (index, index, indices);
+ assign_component (container, lhs, index, exp, op);
+}
+
+bool
+ada_choices_component::uses_objfile (struct objfile *objfile)
+{
+ if (m_op->uses_objfile (objfile))
+ return true;
+ for (const auto &item : m_assocs)
+ if (item->uses_objfile (objfile))
+ return true;
+ return false;
+}
+
+void
+ada_choices_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sChoices:\n"), depth, "");
+ m_op->dump (stream, depth + 1);
+ for (const auto &item : m_assocs)
+ item->dump (stream, depth + 1);
+}
+
+/* Assign into the components of LHS indexed by the OP_CHOICES
+ construct at *POS, updating *POS past the construct, given that
+ the allowable indices are LOW..HIGH. Record the indices assigned
+ to in INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_choices_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
+{
+ for (auto &item : m_assocs)
+ item->assign (container, lhs, exp, indices, low, high, m_op);
+}
+
+bool
+ada_others_component::uses_objfile (struct objfile *objfile)
+{
+ return m_op->uses_objfile (objfile);
+}
+
+void
+ada_others_component::dump (ui_file *stream, int depth)
+{
+ fprintf_filtered (stream, _("%*sOthers:\n"), depth, "");
+ m_op->dump (stream, depth + 1);
}
/* Assign the value of the expression in the OP_OTHERS construct in
EXP at *POS into the components of LHS indexed from LOW .. HIGH that
have not been previously assigned. The index intervals already assigned
- are in INDICES. Updates *POS to after the OP_OTHERS clause.
- CONTAINER is as for assign_aggregate. */
-static void
-aggregate_assign_others (struct value *container,
- struct value *lhs, struct expression *exp,
- int *pos, std::vector<LONGEST> &indices,
- LONGEST low, LONGEST high)
+ are in INDICES. CONTAINER is as for assign_aggregate. */
+void
+ada_others_component::assign (struct value *container,
+ struct value *lhs, struct expression *exp,
+ std::vector<LONGEST> &indices,
+ LONGEST low, LONGEST high)
{
- int i;
- int expr_pc = *pos + 1;
-
int num_indices = indices.size ();
- for (i = 0; i < num_indices - 2; i += 2)
+ for (int i = 0; i < num_indices - 2; i += 2)
{
- LONGEST ind;
+ for (LONGEST ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
+ assign_component (container, lhs, ind, exp, m_op);
+ }
+}
- for (ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
- {
- int localpos;
+struct value *
+ada_assign_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
- localpos = expr_pc;
- assign_component (container, lhs, ind, exp, &localpos);
- }
+ ada_aggregate_operation *ag_op
+ = dynamic_cast<ada_aggregate_operation *> (std::get<1> (m_storage).get ());
+ if (ag_op != nullptr)
+ {
+ if (noside != EVAL_NORMAL)
+ return arg1;
+
+ arg1 = ag_op->assign_aggregate (arg1, arg1, exp);
+ return ada_value_assign (arg1, arg1);
+ }
+ /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
+ except if the lhs of our assignment is a convenience variable.
+ In the case of assigning to a convenience variable, the lhs
+ should be exactly the result of the evaluation of the rhs. */
+ struct type *type = value_type (arg1);
+ if (VALUE_LVAL (arg1) == lval_internalvar)
+ type = NULL;
+ value *arg2 = std::get<1> (m_storage)->evaluate (type, exp, noside);
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return arg1;
+ if (VALUE_LVAL (arg1) == lval_internalvar)
+ {
+ /* Nothing. */
}
- ada_evaluate_subexp (NULL, exp, pos, EVAL_SKIP);
+ else
+ arg2 = coerce_for_assign (value_type (arg1), arg2);
+ return ada_value_assign (arg1, arg2);
}
+} /* namespace expr */
+
/* Add the interval [LOW .. HIGH] to the sorted set of intervals
[ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
overlap. */
entity. Results in this case are unpredictable, as we usually read
past the buffer containing the data =:-o. */
-/* Evaluate a subexpression of EXP, at index *POS, and return a value
- for that subexpression cast to TO_TYPE. Advance *POS over the
- subexpression. */
-
-static value *
-ada_evaluate_subexp_for_cast (expression *exp, int *pos,
- enum noside noside, struct type *to_type)
-{
- int pc = *pos;
-
- if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE
- || exp->elts[pc].opcode == OP_VAR_VALUE)
- {
- (*pos) += 4;
-
- value *val;
- if (exp->elts[pc].opcode == OP_VAR_MSYM_VALUE)
- {
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (to_type, not_lval);
-
- val = evaluate_var_msym_value (noside,
- exp->elts[pc + 1].objfile,
- exp->elts[pc + 2].msymbol);
- }
- else
- val = evaluate_var_value (noside,
- exp->elts[pc + 1].block,
- exp->elts[pc + 2].symbol);
-
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
-
- val = ada_value_cast (to_type, val);
-
- /* Follow the Ada language semantics that do not allow taking
- an address of the result of a cast (view conversion in Ada). */
- if (VALUE_LVAL (val) == lval_memory)
- {
- if (value_lazy (val))
- value_fetch_lazy (val);
- VALUE_LVAL (val) = not_lval;
- }
- return val;
- }
-
- value *val = evaluate_subexp (to_type, exp, pos, noside);
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
- return ada_value_cast (to_type, val);
-}
-
/* A helper function for TERNOP_IN_RANGE. */
static value *
enum noside noside,
value *arg1, value *arg2, value *arg3)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
-
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
enum noside noside, enum exp_opcode op,
struct value *arg1)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
unop_promote (exp->language_defn, exp->gdbarch, &arg1);
return value_neg (arg1);
}
enum noside noside, enum exp_opcode op,
struct value *arg1, struct type *type)
{
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
-
struct value *arg2, *arg3;
switch (type->code ())
{
if (type->code () == TYPE_CODE_REF)
type = TYPE_TARGET_TYPE (type);
- if (noside == EVAL_SKIP)
- return eval_skip_value (exp);
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (builtin_type (exp->gdbarch)->builtin_int, not_lval);
else
return value_from_longest (builtin_type (exp->gdbarch)->builtin_int,
/* A helper function for OP_ATR_MIN and OP_ATR_MAX. */
-static struct value *
+struct value *
ada_binop_minmax (struct type *expect_type,
struct expression *exp,
enum noside noside, enum exp_opcode op,
else
{
binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- return value_binop (arg1, arg2,
- op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
+ return value_binop (arg1, arg2, op);
}
}
/* A helper function for BINOP_EXP. */
-static struct value *
+struct value *
ada_binop_exp (struct type *expect_type,
struct expression *exp,
enum noside noside, enum exp_opcode op,
namespace expr
{
+/* See ada-exp.h. */
+
+operation_up
+ada_resolvable::replace (operation_up &&owner,
+ struct expression *exp,
+ bool deprocedure_p,
+ bool parse_completion,
+ innermost_block_tracker *tracker,
+ struct type *context_type)
+{
+ if (resolve (exp, deprocedure_p, parse_completion, tracker, context_type))
+ return (make_operation<ada_funcall_operation>
+ (std::move (owner),
+ std::vector<operation_up> ()));
+ return std::move (owner);
+}
+
+/* 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 (f).name ();
+ size_t elen = strlen (ename);
+
+ if (elen >= len && strcmp (name, ename + elen - len) == 0)
+ return type->field (f).loc_enumval ();
+ }
+ return val;
+}
+
+/* See ada-exp.h. */
+
+operation_up
+ada_char_operation::replace (operation_up &&owner,
+ struct expression *exp,
+ bool deprocedure_p,
+ bool parse_completion,
+ innermost_block_tracker *tracker,
+ struct type *context_type)
+{
+ operation_up result = std::move (owner);
+
+ if (context_type != nullptr && context_type->code () == TYPE_CODE_ENUM)
+ {
+ gdb_assert (result.get () == this);
+ std::get<0> (m_storage) = context_type;
+ std::get<1> (m_storage)
+ = convert_char_literal (context_type, std::get<1> (m_storage));
+ }
+
+ return make_operation<ada_wrapped_operation> (std::move (result));
+}
+
value *
ada_wrapped_operation::evaluate (struct type *expect_type,
struct expression *exp,
val, type_arg, std::get<2> (m_storage));
}
+value *
+ada_var_msym_value_operation::evaluate_for_cast (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (expect_type, not_lval);
+
+ const bound_minimal_symbol &b = std::get<0> (m_storage);
+ value *val = evaluate_var_msym_value (noside, b.objfile, b.minsym);
+
+ val = ada_value_cast (expect_type, val);
+
+ /* Follow the Ada language semantics that do not allow taking
+ an address of the result of a cast (view conversion in Ada). */
+ if (VALUE_LVAL (val) == lval_memory)
+ {
+ if (value_lazy (val))
+ value_fetch_lazy (val);
+ VALUE_LVAL (val) = not_lval;
+ }
+ return val;
+}
+
value *
ada_var_value_operation::evaluate_for_cast (struct type *expect_type,
struct expression *exp,
enum noside noside)
{
value *val = evaluate_var_value (noside,
- std::get<1> (m_storage),
- std::get<0> (m_storage));
+ std::get<0> (m_storage).block,
+ std::get<0> (m_storage).symbol);
val = ada_value_cast (expect_type, val);
struct expression *exp,
enum noside noside)
{
- symbol *sym = std::get<0> (m_storage);
+ symbol *sym = std::get<0> (m_storage).symbol;
if (SYMBOL_DOMAIN (sym) == UNDEF_DOMAIN)
/* Only encountered when an unresolved symbol occurs in a
a fixed type would result in the loss of that type name,
thus preventing us from printing the name of the ancestor
type in the type description. */
- value *arg1 = var_value_operation::evaluate (nullptr, exp,
- EVAL_NORMAL);
+ value *arg1 = evaluate (nullptr, exp, EVAL_NORMAL);
if (type->code () != TYPE_CODE_REF)
{
return ada_to_fixed_value (arg1);
}
-}
-
-/* Implement the evaluate_exp routine in the exp_descriptor structure
- for the Ada language. */
-
-static struct value *
-ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
- int *pos, enum noside noside)
+bool
+ada_var_value_operation::resolve (struct expression *exp,
+ bool deprocedure_p,
+ bool parse_completion,
+ innermost_block_tracker *tracker,
+ struct type *context_type)
{
- enum exp_opcode op;
- int tem;
- int pc;
- int preeval_pos;
- struct value *arg1 = NULL, *arg2 = NULL, *arg3;
- struct type *type;
- int nargs, oplen;
- struct value **argvec;
-
- pc = *pos;
- *pos += 1;
- op = exp->elts[pc].opcode;
-
- switch (op)
+ symbol *sym = std::get<0> (m_storage).symbol;
+ if (SYMBOL_DOMAIN (sym) == UNDEF_DOMAIN)
{
- default:
- *pos -= 1;
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
-
- if (noside == EVAL_NORMAL)
- arg1 = unwrap_value (arg1);
+ block_symbol resolved
+ = ada_resolve_variable (sym, std::get<0> (m_storage).block,
+ context_type, parse_completion,
+ deprocedure_p, tracker);
+ std::get<0> (m_storage) = resolved;
+ }
- /* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
- then we need to perform the conversion manually, because
- evaluate_subexp_standard doesn't do it. This conversion is
- necessary in Ada because the different kinds of float/fixed
- types in Ada have different representations.
+ if (deprocedure_p
+ && (SYMBOL_TYPE (std::get<0> (m_storage).symbol)->code ()
+ == TYPE_CODE_FUNC))
+ return true;
- Similarly, we need to perform the conversion from OP_LONG
- ourselves. */
- if ((op == OP_FLOAT || op == OP_LONG) && expect_type != NULL)
- arg1 = ada_value_cast (expect_type, arg1);
+ return false;
+}
- return arg1;
+value *
+ada_atr_val_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
+ return ada_val_atr (noside, std::get<0> (m_storage), arg);
+}
- case OP_STRING:
- {
- struct value *result;
-
- *pos -= 1;
- result = evaluate_subexp_standard (expect_type, exp, pos, noside);
- /* The result type will have code OP_STRING, bashed there from
- OP_ARRAY. Bash it back. */
- if (value_type (result)->code () == TYPE_CODE_STRING)
- value_type (result)->set_code (TYPE_CODE_ARRAY);
- return result;
- }
+value *
+ada_unop_ind_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg1 = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
- case UNOP_CAST:
- (*pos) += 2;
- type = exp->elts[pc + 1].type;
- return ada_evaluate_subexp_for_cast (exp, pos, noside, type);
-
- case UNOP_QUAL:
- (*pos) += 2;
- type = exp->elts[pc + 1].type;
- return ada_evaluate_subexp (type, exp, pos, noside);
-
- case BINOP_ASSIGN:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (exp->elts[*pos].opcode == OP_AGGREGATE)
- {
- arg1 = assign_aggregate (arg1, arg1, exp, pos, noside);
- if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
- return arg1;
- return ada_value_assign (arg1, arg1);
- }
- /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
- except if the lhs of our assignment is a convenience variable.
- In the case of assigning to a convenience variable, the lhs
- should be exactly the result of the evaluation of the rhs. */
- type = value_type (arg1);
- if (VALUE_LVAL (arg1) == lval_internalvar)
- type = NULL;
- arg2 = evaluate_subexp (type, exp, pos, noside);
- if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
- return arg1;
- if (VALUE_LVAL (arg1) == lval_internalvar)
+ struct type *type = ada_check_typedef (value_type (arg1));
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ if (ada_is_array_descriptor_type (type))
+ /* GDB allows dereferencing GNAT array descriptors. */
{
- /* Nothing. */
- }
- else
- arg2 = coerce_for_assign (value_type (arg1), arg2);
- return ada_value_assign (arg1, arg2);
-
- case BINOP_ADD:
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- if (value_type (arg1)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg1),
- value_as_long (arg1) + value_as_long (arg2)));
- if (value_type (arg2)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg2),
- value_as_long (arg1) + value_as_long (arg2)));
- /* Preserve the original type for use by the range case below.
- We cannot cast the result to a reference type, so if ARG1 is
- a reference type, find its underlying type. */
- type = value_type (arg1);
- while (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- arg1 = value_binop (arg1, arg2, BINOP_ADD);
- /* We need to special-case the result of adding to a range.
- This is done for the benefit of "ptype". gdb's Ada support
- historically used the LHS to set the result type here, so
- preserve this behavior. */
- if (type->code () == TYPE_CODE_RANGE)
- arg1 = value_cast (type, arg1);
- return arg1;
-
- case BINOP_SUB:
- arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
- arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- if (value_type (arg1)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg1),
- value_as_long (arg1) - value_as_long (arg2)));
- if (value_type (arg2)->code () == TYPE_CODE_PTR)
- return (value_from_longest
- (value_type (arg2),
- value_as_long (arg1) - value_as_long (arg2)));
- /* Preserve the original type for use by the range case below.
- We cannot cast the result to a reference type, so if ARG1 is
- a reference type, find its underlying type. */
- type = value_type (arg1);
- while (type->code () == TYPE_CODE_REF)
- type = TYPE_TARGET_TYPE (type);
- binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
- arg1 = value_binop (arg1, arg2, BINOP_SUB);
- /* We need to special-case the result of adding to a range.
- This is done for the benefit of "ptype". gdb's Ada support
- historically used the LHS to set the result type here, so
- preserve this behavior. */
- if (type->code () == TYPE_CODE_RANGE)
- arg1 = value_cast (type, arg1);
- return arg1;
-
- case BINOP_MUL:
- case BINOP_DIV:
- case BINOP_REM:
- case BINOP_MOD:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_mult_binop (expect_type, exp, noside, op,
- arg1, arg2);
-
- case BINOP_EQUAL:
- case BINOP_NOTEQUAL:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_equal_binop (expect_type, exp, noside, op, arg1, arg2);
-
- case UNOP_NEG:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- return ada_unop_neg (expect_type, exp, noside, op, arg1);
-
- case BINOP_LOGICAL_AND:
- case BINOP_LOGICAL_OR:
- case UNOP_LOGICAL_NOT:
- {
- struct value *val;
-
- *pos -= 1;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
- type = language_bool_type (exp->language_defn, exp->gdbarch);
- return value_cast (type, val);
- }
-
- case BINOP_BITWISE_AND:
- case BINOP_BITWISE_IOR:
- case BINOP_BITWISE_XOR:
- {
- struct value *val;
-
- arg1 = evaluate_subexp (nullptr, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
- *pos = pc;
- val = evaluate_subexp_standard (expect_type, exp, pos, noside);
+ struct type *arrType = ada_type_of_array (arg1, 0);
- return value_cast (value_type (arg1), val);
- }
-
- case OP_VAR_VALUE:
- *pos -= 1;
-
- if (noside == EVAL_SKIP)
- {
- *pos += 4;
- goto nosideret;
+ if (arrType == NULL)
+ error (_("Attempt to dereference null array pointer."));
+ return value_at_lazy (arrType, 0);
}
-
- if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
- /* Only encountered when an unresolved symbol occurs in a
- context other than a function call, in which case, it is
- invalid. */
- error (_("Unexpected unresolved symbol, %s, during evaluation"),
- exp->elts[pc + 2].symbol->print_name ());
-
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ else if (type->code () == TYPE_CODE_PTR
+ || type->code () == TYPE_CODE_REF
+ /* In C you can dereference an array to get the 1st elt. */
+ || type->code () == TYPE_CODE_ARRAY)
{
- type = static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
- /* Check to see if this is a tagged type. We also need to handle
- the case where the type is a reference to a tagged type, but
- we have to be careful to exclude pointers to tagged types.
- The latter should be shown as usual (as a pointer), whereas
- a reference should mostly be transparent to the user. */
- if (ada_is_tagged_type (type, 0)
- || (type->code () == TYPE_CODE_REF
- && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0)))
- {
- /* Tagged types are a little special in the fact that the real
- type is dynamic and can only be determined by inspecting the
- object's tag. This means that we need to get the object's
- value first (EVAL_NORMAL) and then extract the actual object
- type from its tag.
-
- Note that we cannot skip the final step where we extract
- the object type from its tag, because the EVAL_NORMAL phase
- results in dynamic components being resolved into fixed ones.
- This can cause problems when trying to print the type
- description of tagged types whose parent has a dynamic size:
- We use the type name of the "_parent" component in order
- to print the name of the ancestor type in the type description.
- If that component had a dynamic size, the resolution into
- a fixed type would result in the loss of that type name,
- thus preventing us from printing the name of the ancestor
- type in the type description. */
- arg1 = evaluate_subexp (nullptr, exp, pos, EVAL_NORMAL);
-
- if (type->code () != TYPE_CODE_REF)
- {
- struct type *actual_type;
-
- actual_type = type_from_tag (ada_value_tag (arg1));
- if (actual_type == NULL)
- /* If, for some reason, we were unable to determine
- the actual type from the tag, then use the static
- approximation that we just computed as a fallback.
- This can happen if the debugging information is
- incomplete, for instance. */
- actual_type = type;
- return value_zero (actual_type, not_lval);
- }
- else
- {
- /* In the case of a ref, ada_coerce_ref takes care
- of determining the actual type. But the evaluation
- should return a ref as it should be valid to ask
- for its address; so rebuild a ref after coerce. */
- arg1 = ada_coerce_ref (arg1);
- return value_ref (arg1, TYPE_CODE_REF);
- }
- }
+ /* As mentioned in the OP_VAR_VALUE case, tagged types can
+ only be determined by inspecting the object's tag.
+ This means that we need to evaluate completely the
+ expression in order to get its type. */
- /* Records and unions for which GNAT encodings have been
- generated need to be statically fixed as well.
- Otherwise, non-static fixing produces a type where
- all dynamic properties are removed, which prevents "ptype"
- from being able to completely describe the type.
- For instance, a case statement in a variant record would be
- replaced by the relevant components based on the actual
- value of the discriminants. */
- if ((type->code () == TYPE_CODE_STRUCT
- && dynamic_template_type (type) != NULL)
- || (type->code () == TYPE_CODE_UNION
- && ada_find_parallel_type (type, "___XVU") != NULL))
+ if ((type->code () == TYPE_CODE_REF
+ || type->code () == TYPE_CODE_PTR)
+ && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
{
- *pos += 4;
- return value_zero (to_static_fixed_type (type), not_lval);
+ arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp,
+ EVAL_NORMAL);
+ type = value_type (ada_value_ind (arg1));
}
- }
-
- arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
- return ada_to_fixed_value (arg1);
-
- case OP_FUNCALL:
- (*pos) += 2;
-
- /* Allocate arg vector, including space for the function to be
- called in argvec[0] and a terminating NULL. */
- nargs = longest_to_int (exp->elts[pc + 1].longconst);
- argvec = XALLOCAVEC (struct value *, nargs + 2);
-
- if (exp->elts[*pos].opcode == OP_VAR_VALUE
- && SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
- error (_("Unexpected unresolved symbol, %s, during evaluation"),
- exp->elts[pc + 5].symbol->print_name ());
- else
- {
- for (tem = 0; tem <= nargs; tem += 1)
- argvec[tem] = evaluate_subexp (nullptr, exp, pos, noside);
- argvec[tem] = 0;
-
- if (noside == EVAL_SKIP)
- goto nosideret;
- }
-
- if (ada_is_constrained_packed_array_type
- (desc_base_type (value_type (argvec[0]))))
- argvec[0] = ada_coerce_to_simple_array (argvec[0]);
- else if (value_type (argvec[0])->code () == TYPE_CODE_ARRAY
- && TYPE_FIELD_BITSIZE (value_type (argvec[0]), 0) != 0)
- /* This is a packed array that has already been fixed, and
- therefore already coerced to a simple array. Nothing further
- to do. */
- ;
- else if (value_type (argvec[0])->code () == TYPE_CODE_REF)
- {
- /* Make sure we dereference references so that all the code below
- feels like it's really handling the referenced value. Wrapping
- types (for alignment) may be there, so make sure we strip them as
- well. */
- argvec[0] = ada_to_fixed_value (coerce_ref (argvec[0]));
- }
- else if (value_type (argvec[0])->code () == TYPE_CODE_ARRAY
- && VALUE_LVAL (argvec[0]) == lval_memory)
- argvec[0] = value_addr (argvec[0]);
-
- type = ada_check_typedef (value_type (argvec[0]));
-
- /* Ada allows us to implicitly dereference arrays when subscripting
- them. So, if this is an array typedef (encoding use for array
- access types encoded as fat pointers), strip it now. */
- if (type->code () == TYPE_CODE_TYPEDEF)
- type = ada_typedef_target_type (type);
-
- if (type->code () == TYPE_CODE_PTR)
- {
- switch (ada_check_typedef (TYPE_TARGET_TYPE (type))->code ())
+ else
{
- case TYPE_CODE_FUNC:
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
- break;
- case TYPE_CODE_ARRAY:
- break;
- case TYPE_CODE_STRUCT:
- if (noside != EVAL_AVOID_SIDE_EFFECTS)
- argvec[0] = ada_value_ind (argvec[0]);
- type = ada_check_typedef (TYPE_TARGET_TYPE (type));
- break;
- default:
- error (_("cannot subscript or call something of type `%s'"),
- ada_type_name (value_type (argvec[0])));
- break;
+ type = to_static_fixed_type
+ (ada_aligned_type
+ (ada_check_typedef (TYPE_TARGET_TYPE (type))));
}
+ return value_zero (type, lval_memory);
}
-
- switch (type->code ())
+ else if (type->code () == TYPE_CODE_INT)
{
- case TYPE_CODE_FUNC:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- if (TYPE_TARGET_TYPE (type) == NULL)
- error_call_unknown_return_type (NULL);
- return allocate_value (TYPE_TARGET_TYPE (type));
- }
- return call_function_by_hand (argvec[0], NULL,
- gdb::make_array_view (argvec + 1,
- nargs));
- case TYPE_CODE_INTERNAL_FUNCTION:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- /* We don't know anything about what the internal
- function might return, but we have to return
- something. */
+ /* GDB allows dereferencing an int. */
+ if (expect_type == NULL)
return value_zero (builtin_type (exp->gdbarch)->builtin_int,
- not_lval);
+ lval_memory);
else
- return call_internal_function (exp->gdbarch, exp->language_defn,
- argvec[0], nargs, argvec + 1);
-
- case TYPE_CODE_STRUCT:
- {
- int arity;
-
- arity = ada_array_arity (type);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("cannot subscript or call a record"));
- if (arity != nargs)
- error (_("wrong number of subscripts; expecting %d"), arity);
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (ada_aligned_type (type), lval_memory);
- return
- unwrap_value (ada_value_subscript
- (argvec[0], nargs, argvec + 1));
- }
- case TYPE_CODE_ARRAY:
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
+ expect_type =
+ to_static_fixed_type (ada_aligned_type (expect_type));
+ return value_zero (expect_type, lval_memory);
}
- return
- unwrap_value (ada_value_subscript
- (ada_coerce_to_simple_array (argvec[0]),
- nargs, argvec + 1));
- case TYPE_CODE_PTR: /* Pointer to array */
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- {
- type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
- type = ada_array_element_type (type, nargs);
- if (type == NULL)
- error (_("element type of array unknown"));
- else
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- return
- unwrap_value (ada_value_ptr_subscript (argvec[0],
- nargs, argvec + 1));
-
- default:
- error (_("Attempt to index or call something other than an "
- "array or function"));
}
+ else
+ error (_("Attempt to take contents of a non-pointer value."));
+ }
+ arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
+ type = ada_check_typedef (value_type (arg1));
- case TERNOP_SLICE:
- {
- struct value *array = evaluate_subexp (nullptr, exp, pos, noside);
- struct value *low_bound_val
- = evaluate_subexp (nullptr, exp, pos, noside);
- struct value *high_bound_val
- = evaluate_subexp (nullptr, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- return ada_ternop_slice (exp, noside, array, low_bound_val,
- high_bound_val);
- }
-
- case UNOP_IN_RANGE:
- (*pos) += 2;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- type = check_typedef (exp->elts[pc + 1].type);
- return ada_unop_in_range (expect_type, exp, noside, op, arg1, type);
-
- case BINOP_IN_BOUNDS:
- (*pos) += 2;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- tem = longest_to_int (exp->elts[pc + 1].longconst);
-
- return ada_binop_in_bounds (exp, noside, arg1, arg2, tem);
-
- case TERNOP_IN_RANGE:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- arg3 = evaluate_subexp (nullptr, exp, pos, noside);
-
- return eval_ternop_in_range (expect_type, exp, noside, arg1, arg2, arg3);
-
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- {
- struct type *type_arg;
-
- if (exp->elts[*pos].opcode == OP_TYPE)
- {
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = NULL;
- type_arg = check_typedef (exp->elts[pc + 2].type);
- }
- else
- {
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- type_arg = NULL;
- }
-
- if (exp->elts[*pos].opcode != OP_LONG)
- error (_("Invalid operand to '%s"), ada_attribute_name (op));
- tem = longest_to_int (exp->elts[*pos + 2].longconst);
- *pos += 4;
-
- if (noside == EVAL_SKIP)
- goto nosideret;
-
- return ada_unop_atr (exp, noside, op, arg1, type_arg, tem);
- }
-
- case OP_ATR_TAG:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_atr_tag (expect_type, exp, noside, op, arg1);
-
- case OP_ATR_MIN:
- case OP_ATR_MAX:
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_binop_minmax (expect_type, exp, noside, op, arg1, arg2);
-
- case OP_ATR_MODULUS:
- {
- struct type *type_arg = check_typedef (exp->elts[pc + 2].type);
+ if (type->code () == TYPE_CODE_INT)
+ /* GDB allows dereferencing an int. If we were given
+ the expect_type, then use that as the target type.
+ Otherwise, assume that the target type is an int. */
+ {
+ if (expect_type != NULL)
+ return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
+ arg1));
+ else
+ return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
+ (CORE_ADDR) value_as_address (arg1));
+ }
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- if (noside == EVAL_SKIP)
- goto nosideret;
+ if (ada_is_array_descriptor_type (type))
+ /* GDB allows dereferencing GNAT array descriptors. */
+ return ada_coerce_to_simple_array (arg1);
+ else
+ return ada_value_ind (arg1);
+}
- if (!ada_is_modular_type (type_arg))
- error (_("'modulus must be applied to modular type"));
+value *
+ada_structop_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
+ const char *str = std::get<1> (m_storage).c_str ();
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ struct type *type;
+ struct type *type1 = value_type (arg1);
- return value_from_longest (TYPE_TARGET_TYPE (type_arg),
- ada_modulus (type_arg));
- }
+ if (ada_is_tagged_type (type1, 1))
+ {
+ type = ada_lookup_struct_elt_type (type1, str, 1, 1);
+ /* If the field is not found, check if it exists in the
+ extension of this object's type. This means that we
+ need to evaluate completely the expression. */
- case OP_ATR_POS:
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- type = builtin_type (exp->gdbarch)->builtin_int;
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return value_zero (type, not_lval);
+ if (type == NULL)
+ {
+ arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp,
+ EVAL_NORMAL);
+ arg1 = ada_value_struct_elt (arg1, str, 0);
+ arg1 = unwrap_value (arg1);
+ type = value_type (ada_to_fixed_value (arg1));
+ }
+ }
else
- return value_pos_atr (type, arg1);
-
- case OP_ATR_SIZE:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- return ada_atr_size (expect_type, exp, noside, op, arg1);
+ type = ada_lookup_struct_elt_type (type1, str, 1, 0);
- case OP_ATR_VAL:
- evaluate_subexp (nullptr, exp, pos, EVAL_SKIP);
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- type = exp->elts[pc + 2].type;
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_val_atr (noside, type, arg1);
+ return value_zero (ada_aligned_type (type), lval_memory);
+ }
+ else
+ {
+ arg1 = ada_value_struct_elt (arg1, str, 0);
+ arg1 = unwrap_value (arg1);
+ return ada_to_fixed_value (arg1);
+ }
+}
- case BINOP_EXP:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- arg2 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_binop_exp (expect_type, exp, noside, op, arg1, arg2);
+value *
+ada_funcall_operation::evaluate (struct type *expect_type,
+ struct expression *exp,
+ enum noside noside)
+{
+ const std::vector<operation_up> &args_up = std::get<1> (m_storage);
+ int nargs = args_up.size ();
+ std::vector<value *> argvec (nargs);
+ operation_up &callee_op = std::get<0> (m_storage);
- case UNOP_PLUS:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- else
- return arg1;
+ ada_var_value_operation *avv
+ = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
+ if (avv != nullptr
+ && SYMBOL_DOMAIN (avv->get_symbol ()) == UNDEF_DOMAIN)
+ error (_("Unexpected unresolved symbol, %s, during evaluation"),
+ avv->get_symbol ()->print_name ());
+
+ value *callee = callee_op->evaluate (nullptr, exp, noside);
+ for (int i = 0; i < args_up.size (); ++i)
+ argvec[i] = args_up[i]->evaluate (nullptr, exp, noside);
+
+ if (ada_is_constrained_packed_array_type
+ (desc_base_type (value_type (callee))))
+ callee = ada_coerce_to_simple_array (callee);
+ else if (value_type (callee)->code () == TYPE_CODE_ARRAY
+ && TYPE_FIELD_BITSIZE (value_type (callee), 0) != 0)
+ /* This is a packed array that has already been fixed, and
+ therefore already coerced to a simple array. Nothing further
+ to do. */
+ ;
+ else if (value_type (callee)->code () == TYPE_CODE_REF)
+ {
+ /* Make sure we dereference references so that all the code below
+ feels like it's really handling the referenced value. Wrapping
+ types (for alignment) may be there, so make sure we strip them as
+ well. */
+ callee = ada_to_fixed_value (coerce_ref (callee));
+ }
+ else if (value_type (callee)->code () == TYPE_CODE_ARRAY
+ && VALUE_LVAL (callee) == lval_memory)
+ callee = value_addr (callee);
+
+ struct type *type = ada_check_typedef (value_type (callee));
+
+ /* Ada allows us to implicitly dereference arrays when subscripting
+ them. So, if this is an array typedef (encoding use for array
+ access types encoded as fat pointers), strip it now. */
+ if (type->code () == TYPE_CODE_TYPEDEF)
+ type = ada_typedef_target_type (type);
- case UNOP_ABS:
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- return ada_abs (expect_type, exp, noside, op, arg1);
-
- case UNOP_IND:
- preeval_pos = *pos;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
- type = ada_check_typedef (value_type (arg1));
- if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ if (type->code () == TYPE_CODE_PTR)
+ {
+ switch (ada_check_typedef (TYPE_TARGET_TYPE (type))->code ())
{
- if (ada_is_array_descriptor_type (type))
- /* GDB allows dereferencing GNAT array descriptors. */
- {
- struct type *arrType = ada_type_of_array (arg1, 0);
+ case TYPE_CODE_FUNC:
+ type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+ break;
+ case TYPE_CODE_ARRAY:
+ break;
+ case TYPE_CODE_STRUCT:
+ if (noside != EVAL_AVOID_SIDE_EFFECTS)
+ callee = ada_value_ind (callee);
+ type = ada_check_typedef (TYPE_TARGET_TYPE (type));
+ break;
+ default:
+ error (_("cannot subscript or call something of type `%s'"),
+ ada_type_name (value_type (callee)));
+ break;
+ }
+ }
- if (arrType == NULL)
- error (_("Attempt to dereference null array pointer."));
- return value_at_lazy (arrType, 0);
- }
- else if (type->code () == TYPE_CODE_PTR
- || type->code () == TYPE_CODE_REF
- /* In C you can dereference an array to get the 1st elt. */
- || type->code () == TYPE_CODE_ARRAY)
- {
- /* As mentioned in the OP_VAR_VALUE case, tagged types can
- only be determined by inspecting the object's tag.
- This means that we need to evaluate completely the
- expression in order to get its type. */
-
- if ((type->code () == TYPE_CODE_REF
- || type->code () == TYPE_CODE_PTR)
- && ada_is_tagged_type (TYPE_TARGET_TYPE (type), 0))
- {
- arg1
- = evaluate_subexp (nullptr, exp, &preeval_pos, EVAL_NORMAL);
- type = value_type (ada_value_ind (arg1));
- }
- else
- {
- type = to_static_fixed_type
- (ada_aligned_type
- (ada_check_typedef (TYPE_TARGET_TYPE (type))));
- }
- ada_ensure_varsize_limit (type);
- return value_zero (type, lval_memory);
- }
- else if (type->code () == TYPE_CODE_INT)
- {
- /* GDB allows dereferencing an int. */
- if (expect_type == NULL)
- return value_zero (builtin_type (exp->gdbarch)->builtin_int,
- lval_memory);
- else
- {
- expect_type =
- to_static_fixed_type (ada_aligned_type (expect_type));
- return value_zero (expect_type, lval_memory);
- }
- }
- else
- error (_("Attempt to take contents of a non-pointer value."));
+ switch (type->code ())
+ {
+ case TYPE_CODE_FUNC:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ {
+ if (TYPE_TARGET_TYPE (type) == NULL)
+ error_call_unknown_return_type (NULL);
+ return allocate_value (TYPE_TARGET_TYPE (type));
}
- arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
- type = ada_check_typedef (value_type (arg1));
+ return call_function_by_hand (callee, NULL, argvec);
+ case TYPE_CODE_INTERNAL_FUNCTION:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ /* We don't know anything about what the internal
+ function might return, but we have to return
+ something. */
+ return value_zero (builtin_type (exp->gdbarch)->builtin_int,
+ not_lval);
+ else
+ return call_internal_function (exp->gdbarch, exp->language_defn,
+ callee, nargs,
+ argvec.data ());
- if (type->code () == TYPE_CODE_INT)
- /* GDB allows dereferencing an int. If we were given
- the expect_type, then use that as the target type.
- Otherwise, assume that the target type is an int. */
+ case TYPE_CODE_STRUCT:
+ {
+ int arity;
+
+ arity = ada_array_arity (type);
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("cannot subscript or call a record"));
+ if (arity != nargs)
+ error (_("wrong number of subscripts; expecting %d"), arity);
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
+ return value_zero (ada_aligned_type (type), lval_memory);
+ return
+ unwrap_value (ada_value_subscript
+ (callee, nargs, argvec.data ()));
+ }
+ case TYPE_CODE_ARRAY:
+ if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- if (expect_type != NULL)
- return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
- arg1));
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("element type of array unknown"));
else
- return value_at_lazy (builtin_type (exp->gdbarch)->builtin_int,
- (CORE_ADDR) value_as_address (arg1));
+ return value_zero (ada_aligned_type (type), lval_memory);
}
-
- if (ada_is_array_descriptor_type (type))
- /* GDB allows dereferencing GNAT array descriptors. */
- return ada_coerce_to_simple_array (arg1);
- else
- return ada_value_ind (arg1);
-
- case STRUCTOP_STRUCT:
- tem = longest_to_int (exp->elts[pc + 1].longconst);
- (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
- preeval_pos = *pos;
- arg1 = evaluate_subexp (nullptr, exp, pos, noside);
- if (noside == EVAL_SKIP)
- goto nosideret;
+ return
+ unwrap_value (ada_value_subscript
+ (ada_coerce_to_simple_array (callee),
+ nargs, argvec.data ()));
+ case TYPE_CODE_PTR: /* Pointer to array */
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
- struct type *type1 = value_type (arg1);
+ type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
+ type = ada_array_element_type (type, nargs);
+ if (type == NULL)
+ error (_("element type of array unknown"));
+ else
+ return value_zero (ada_aligned_type (type), lval_memory);
+ }
+ return
+ unwrap_value (ada_value_ptr_subscript (callee, nargs,
+ argvec.data ()));
- if (ada_is_tagged_type (type1, 1))
- {
- type = ada_lookup_struct_elt_type (type1,
- &exp->elts[pc + 2].string,
- 1, 1);
+ default:
+ error (_("Attempt to index or call something other than an "
+ "array or function"));
+ }
+}
- /* If the field is not found, check if it exists in the
- extension of this object's type. This means that we
- need to evaluate completely the expression. */
+bool
+ada_funcall_operation::resolve (struct expression *exp,
+ bool deprocedure_p,
+ bool parse_completion,
+ innermost_block_tracker *tracker,
+ struct type *context_type)
+{
+ operation_up &callee_op = std::get<0> (m_storage);
- if (type == NULL)
- {
- arg1
- = evaluate_subexp (nullptr, exp, &preeval_pos, EVAL_NORMAL);
- arg1 = ada_value_struct_elt (arg1,
- &exp->elts[pc + 2].string,
- 0);
- arg1 = unwrap_value (arg1);
- type = value_type (ada_to_fixed_value (arg1));
- }
- }
- else
- type =
- ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string, 1,
- 0);
+ ada_var_value_operation *avv
+ = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
+ if (avv == nullptr)
+ return false;
- return value_zero (ada_aligned_type (type), lval_memory);
- }
- else
- {
- arg1 = ada_value_struct_elt (arg1, &exp->elts[pc + 2].string, 0);
- arg1 = unwrap_value (arg1);
- return ada_to_fixed_value (arg1);
- }
+ symbol *sym = avv->get_symbol ();
+ if (SYMBOL_DOMAIN (sym) != UNDEF_DOMAIN)
+ return false;
- case OP_TYPE:
- /* The value is not supposed to be used. This is here to make it
- easier to accommodate expressions that contain types. */
- (*pos) += 2;
- if (noside == EVAL_SKIP)
- goto nosideret;
- else if (noside == EVAL_AVOID_SIDE_EFFECTS)
- return allocate_value (exp->elts[pc + 1].type);
- else
- error (_("Attempt to use a type name as an expression"));
-
- case OP_AGGREGATE:
- case OP_CHOICES:
- case OP_OTHERS:
- case OP_DISCRETE_RANGE:
- case OP_POSITIONAL:
- case OP_NAME:
- if (noside == EVAL_NORMAL)
- switch (op)
- {
- case OP_NAME:
- error (_("Undefined name, ambiguous name, or renaming used in "
- "component association: %s."), &exp->elts[pc+2].string);
- case OP_AGGREGATE:
- error (_("Aggregates only allowed on the right of an assignment"));
- default:
- internal_error (__FILE__, __LINE__,
- _("aggregate apparently mangled"));
- }
+ const std::vector<operation_up> &args_up = std::get<1> (m_storage);
+ int nargs = args_up.size ();
+ std::vector<value *> argvec (nargs);
- ada_forward_operator_length (exp, pc, &oplen, &nargs);
- *pos += oplen - 1;
- for (tem = 0; tem < nargs; tem += 1)
- ada_evaluate_subexp (NULL, exp, pos, noside);
- goto nosideret;
- }
+ for (int i = 0; i < args_up.size (); ++i)
+ argvec[i] = args_up[i]->evaluate (nullptr, exp, EVAL_AVOID_SIDE_EFFECTS);
+
+ const block *block = avv->get_block ();
+ block_symbol resolved
+ = ada_resolve_funcall (sym, block,
+ context_type, parse_completion,
+ nargs, argvec.data (),
+ tracker);
+
+ std::get<0> (m_storage)
+ = make_operation<ada_var_value_operation> (resolved);
+ return false;
+}
+
+bool
+ada_ternop_slice_operation::resolve (struct expression *exp,
+ bool deprocedure_p,
+ bool parse_completion,
+ innermost_block_tracker *tracker,
+ struct type *context_type)
+{
+ /* Historically this check was done during resolution, so we
+ continue that here. */
+ value *v = std::get<0> (m_storage)->evaluate (context_type, exp,
+ EVAL_AVOID_SIDE_EFFECTS);
+ if (ada_is_any_packed_array_type (value_type (v)))
+ error (_("cannot slice a packed array"));
+ return false;
+}
-nosideret:
- return eval_skip_value (exp);
}
+
\f
/* Return non-zero iff TYPE represents a System.Address type. */
create_excep_cond_exprs (struct ada_catchpoint *c,
enum ada_exception_catchpoint_kind ex)
{
- struct bp_location *bl;
-
/* Nothing to do if there's no specific exception to catch. */
if (c->excep_string.empty ())
return;
/* Iterate over all the catchpoint's locations, and parse an
expression for each. */
- for (bl = c->loc; bl != NULL; bl = bl->next)
+ for (bp_location *bl : c->locations ())
{
struct ada_catchpoint_location *ada_loc
= (struct ada_catchpoint_location *) bl;
user specified a specific exception, we only want to cause a stop
if the program thrown that exception. */
-static int
+static bool
should_stop_exception (const struct bp_location *bl)
{
struct ada_catchpoint *c = (struct ada_catchpoint *) bl->owner;
const struct ada_catchpoint_location *ada_loc
= (const struct ada_catchpoint_location *) bl;
- int stop;
+ bool stop;
struct internalvar *var = lookup_internalvar ("_ada_exception");
if (c->m_kind == ada_catch_assert)
/* With no specific exception, should always stop. */
if (c->excep_string.empty ())
- return 1;
+ return true;
if (ada_loc->excep_cond_expr == NULL)
{
/* We will have a NULL expression if back when we were creating
the expressions, this location's had failed to parse. */
- return 1;
+ return true;
}
- stop = 1;
+ stop = true;
try
{
struct value *mark;
for all exception catchpoint kinds. */
static void
-check_status_exception (bpstat bs)
+check_status_exception (bpstat *bs)
{
bs->stop = should_stop_exception (bs->bp_location_at.get ());
}
for all exception catchpoint kinds. */
static enum print_stop_action
-print_it_exception (bpstat bs)
+print_it_exception (bpstat *bs)
{
struct ui_out *uiout = current_uiout;
struct breakpoint *b = bs->breakpoint_at;
{
std::string info = string_printf (_("`%s' Ada exception"),
c->excep_string.c_str ());
- uiout->text (info.c_str ());
+ uiout->text (info);
}
else
uiout->text (_("all Ada exceptions"));
std::string info
= string_printf (_("`%s' Ada exception handlers"),
c->excep_string.c_str ());
- uiout->text (info.c_str ());
+ uiout->text (info);
}
else
uiout->text (_("all Ada exceptions handlers"));
print_recreate_thread (b, fp);
}
-/* Virtual tables for various breakpoint types. */
+/* Virtual table for breakpoint type. */
static struct breakpoint_ops catch_exception_breakpoint_ops;
-static struct breakpoint_ops catch_exception_unhandled_breakpoint_ops;
-static struct breakpoint_ops catch_assert_breakpoint_ops;
-static struct breakpoint_ops catch_handlers_breakpoint_ops;
/* See ada-lang.h. */
bool
is_ada_exception_catchpoint (breakpoint *bp)
{
- return (bp->ops == &catch_exception_breakpoint_ops
- || bp->ops == &catch_exception_unhandled_breakpoint_ops
- || bp->ops == &catch_assert_breakpoint_ops
- || bp->ops == &catch_handlers_breakpoint_ops);
+ return bp->ops == &catch_exception_breakpoint_ops;
}
/* Split the arguments specified in a "catch exception" command.
}
}
-/* Return the breakpoint ops "virtual table" used for catchpoints
- of the EX kind. */
-
-static const struct breakpoint_ops *
-ada_exception_breakpoint_ops (enum ada_exception_catchpoint_kind ex)
-{
- switch (ex)
- {
- case ada_catch_exception:
- return (&catch_exception_breakpoint_ops);
- break;
- case ada_catch_exception_unhandled:
- return (&catch_exception_unhandled_breakpoint_ops);
- break;
- case ada_catch_assert:
- return (&catch_assert_breakpoint_ops);
- break;
- case ada_catch_handlers:
- return (&catch_handlers_breakpoint_ops);
- break;
- default:
- internal_error (__FILE__, __LINE__,
- _("unexpected catchpoint kind (%d)"), ex);
- }
-}
-
/* Return the condition that will be used to match the current exception
being raised with the exception that the user wants to catch. This
assumes that this condition is used when the inferior just triggered
ada_exception_catchpoint_cond_string (const char *excep_string,
enum ada_exception_catchpoint_kind ex)
{
- int i;
bool is_standard_exc = false;
std::string result;
breakpoint condition is to use its fully-qualified named:
e.g. my_package.constraint_error. */
- for (i = 0; i < sizeof (standard_exc) / sizeof (char *); i++)
+ for (const char *name : standard_exc)
{
- if (strcmp (standard_exc [i], excep_string) == 0)
+ if (strcmp (name, excep_string) == 0)
{
is_standard_exc = true;
break;
*addr_string = sym_name;
/* Set OPS. */
- *ops = ada_exception_breakpoint_ops (ex);
+ *ops = &catch_exception_breakpoint_ops;
return find_function_start_sal (sym, 1);
}
std::string excep_string;
std::string cond_string;
- tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
+ tempflag = command->context () == CATCH_TEMPORARY;
if (!arg)
arg = "";
std::string excep_string;
std::string cond_string;
- tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
+ tempflag = command->context () == CATCH_TEMPORARY;
if (!arg)
arg = "";
int tempflag;
std::string cond_string;
- tempflag = get_cmd_context (command) == CATCH_TEMPORARY;
+ tempflag = command->context () == CATCH_TEMPORARY;
if (!arg)
arg = "";
static int
ada_is_non_standard_exception_sym (struct symbol *sym)
{
- int i;
-
if (!ada_is_exception_sym (sym))
return 0;
- for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
- if (strcmp (sym->linkage_name (), standard_exc[i]) == 0)
+ for (const char *name : standard_exc)
+ if (strcmp (sym->linkage_name (), name) == 0)
return 0; /* A standard exception. */
/* Numeric_Error is also a standard exception, so exclude it.
ada_add_standard_exceptions (compiled_regex *preg,
std::vector<ada_exc_info> *exceptions)
{
- int i;
-
- for (i = 0; i < ARRAY_SIZE (standard_exc); i++)
+ for (const char *name : standard_exc)
{
- if (preg == NULL
- || preg->exec (standard_exc[i], 0, NULL, 0) == 0)
+ if (preg == NULL || preg->exec (name, 0, NULL, 0) == 0)
{
struct bound_minimal_symbol msymbol
- = ada_lookup_simple_minsym (standard_exc[i]);
+ = ada_lookup_simple_minsym (name);
if (msymbol.minsym != NULL)
{
struct ada_exc_info info
- = {standard_exc[i], BMSYMBOL_VALUE_ADDRESS (msymbol)};
+ = {name, BMSYMBOL_VALUE_ADDRESS (msymbol)};
exceptions->push_back (info);
}
return name_matches_regex (decoded.c_str (), preg);
},
NULL,
+ SEARCH_GLOBAL_BLOCK | SEARCH_STATIC_BLOCK,
VARIABLES_DOMAIN);
for (objfile *objfile : current_program_space->objfiles ())
{
for (compunit_symtab *s : objfile->compunits ())
{
- const struct blockvector *bv = COMPUNIT_BLOCKVECTOR (s);
+ const struct blockvector *bv = s->blockvector ();
int i;
for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
printf_filtered ("%s: %s\n", info.name, paddress (gdbarch, info.addr));
}
- /* Operators */
-/* Information about operators given special treatment in functions
- below. */
-/* Format: OP_DEFN (<operator>, <operator length>, <# args>, <binop>). */
-
-#define ADA_OPERATORS \
- OP_DEFN (OP_VAR_VALUE, 4, 0, 0) \
- OP_DEFN (BINOP_IN_BOUNDS, 3, 2, 0) \
- OP_DEFN (TERNOP_IN_RANGE, 1, 3, 0) \
- OP_DEFN (OP_ATR_FIRST, 1, 2, 0) \
- OP_DEFN (OP_ATR_LAST, 1, 2, 0) \
- OP_DEFN (OP_ATR_LENGTH, 1, 2, 0) \
- OP_DEFN (OP_ATR_IMAGE, 1, 2, 0) \
- OP_DEFN (OP_ATR_MAX, 1, 3, 0) \
- OP_DEFN (OP_ATR_MIN, 1, 3, 0) \
- OP_DEFN (OP_ATR_MODULUS, 1, 1, 0) \
- OP_DEFN (OP_ATR_POS, 1, 2, 0) \
- OP_DEFN (OP_ATR_SIZE, 1, 1, 0) \
- OP_DEFN (OP_ATR_TAG, 1, 1, 0) \
- OP_DEFN (OP_ATR_VAL, 1, 2, 0) \
- OP_DEFN (UNOP_QUAL, 3, 1, 0) \
- OP_DEFN (UNOP_IN_RANGE, 3, 1, 0) \
- OP_DEFN (OP_OTHERS, 1, 1, 0) \
- OP_DEFN (OP_POSITIONAL, 3, 1, 0) \
- OP_DEFN (OP_DISCRETE_RANGE, 1, 2, 0)
-
-static void
-ada_operator_length (const struct expression *exp, int pc, int *oplenp,
- int *argsp)
-{
- switch (exp->elts[pc - 1].opcode)
- {
- default:
- operator_length_standard (exp, pc, oplenp, argsp);
- break;
-
-#define OP_DEFN(op, len, args, binop) \
- case op: *oplenp = len; *argsp = args; break;
- ADA_OPERATORS;
-#undef OP_DEFN
-
- case OP_AGGREGATE:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc - 2].longconst);
- break;
-
- case OP_CHOICES:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc - 2].longconst) + 1;
- break;
- }
-}
-
-/* Implementation of the exp_descriptor method operator_check. */
-
-static int
-ada_operator_check (struct expression *exp, int pos,
- int (*objfile_func) (struct objfile *objfile, void *data),
- void *data)
-{
- const union exp_element *const elts = exp->elts;
- struct type *type = NULL;
-
- switch (elts[pos].opcode)
- {
- case UNOP_IN_RANGE:
- case UNOP_QUAL:
- type = elts[pos + 1].type;
- break;
-
- default:
- return operator_check_standard (exp, pos, objfile_func, data);
- }
-
- /* Invoke callbacks for TYPE and OBJFILE if they were set as non-NULL. */
-
- if (type != nullptr && type->objfile_owner () != nullptr
- && objfile_func (type->objfile_owner (), data))
- return 1;
-
- return 0;
-}
-
-/* As for operator_length, but assumes PC is pointing at the first
- element of the operator, and gives meaningful results only for the
- Ada-specific operators, returning 0 for *OPLENP and *ARGSP otherwise. */
-
-static void
-ada_forward_operator_length (struct expression *exp, int pc,
- int *oplenp, int *argsp)
-{
- switch (exp->elts[pc].opcode)
- {
- default:
- *oplenp = *argsp = 0;
- break;
-
-#define OP_DEFN(op, len, args, binop) \
- case op: *oplenp = len; *argsp = args; break;
- ADA_OPERATORS;
-#undef OP_DEFN
-
- case OP_AGGREGATE:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc + 1].longconst);
- break;
-
- case OP_CHOICES:
- *oplenp = 3;
- *argsp = longest_to_int (exp->elts[pc + 1].longconst) + 1;
- break;
-
- case OP_STRING:
- case OP_NAME:
- {
- int len = longest_to_int (exp->elts[pc + 1].longconst);
-
- *oplenp = 4 + BYTES_TO_EXP_ELEM (len + 1);
- *argsp = 0;
- break;
- }
- }
-}
-
-static int
-ada_dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
-{
- enum exp_opcode op = exp->elts[elt].opcode;
- int oplen, nargs;
- int pc = elt;
- int i;
-
- ada_forward_operator_length (exp, elt, &oplen, &nargs);
-
- switch (op)
- {
- /* Ada attributes ('Foo). */
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- case OP_ATR_IMAGE:
- case OP_ATR_MAX:
- case OP_ATR_MIN:
- case OP_ATR_MODULUS:
- case OP_ATR_POS:
- case OP_ATR_SIZE:
- case OP_ATR_TAG:
- case OP_ATR_VAL:
- break;
-
- case UNOP_IN_RANGE:
- case UNOP_QUAL:
- /* XXX: gdb_sprint_host_address, type_sprint */
- fprintf_filtered (stream, _("Type @"));
- gdb_print_host_address (exp->elts[pc + 1].type, stream);
- fprintf_filtered (stream, " (");
- type_print (exp->elts[pc + 1].type, NULL, stream, 0);
- fprintf_filtered (stream, ")");
- break;
- case BINOP_IN_BOUNDS:
- fprintf_filtered (stream, " (%d)",
- longest_to_int (exp->elts[pc + 2].longconst));
- break;
- case TERNOP_IN_RANGE:
- break;
-
- case OP_AGGREGATE:
- case OP_OTHERS:
- case OP_DISCRETE_RANGE:
- case OP_POSITIONAL:
- case OP_CHOICES:
- break;
-
- case OP_NAME:
- case OP_STRING:
- {
- char *name = &exp->elts[elt + 2].string;
- int len = longest_to_int (exp->elts[elt + 1].longconst);
-
- fprintf_filtered (stream, "Text: `%.*s'", len, name);
- break;
- }
-
- default:
- return dump_subexp_body_standard (exp, stream, elt);
- }
-
- elt += oplen;
- for (i = 0; i < nargs; i += 1)
- elt = dump_subexp (exp, stream, elt);
-
- return elt;
-}
-
-/* The Ada extension of print_subexp (q.v.). */
-
-static void
-ada_print_subexp (struct expression *exp, int *pos,
- struct ui_file *stream, enum precedence prec)
-{
- int oplen, nargs, i;
- int pc = *pos;
- enum exp_opcode op = exp->elts[pc].opcode;
-
- ada_forward_operator_length (exp, pc, &oplen, &nargs);
-
- *pos += oplen;
- switch (op)
- {
- default:
- *pos -= oplen;
- print_subexp_standard (exp, pos, stream, prec);
- return;
-
- case OP_VAR_VALUE:
- fputs_filtered (exp->elts[pc + 2].symbol->natural_name (), stream);
- return;
-
- case BINOP_IN_BOUNDS:
- /* XXX: sprint_subexp */
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" in ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered ("'range", stream);
- if (exp->elts[pc + 1].longconst > 1)
- fprintf_filtered (stream, "(%ld)",
- (long) exp->elts[pc + 1].longconst);
- return;
-
- case TERNOP_IN_RANGE:
- if (prec >= PREC_EQUAL)
- fputs_filtered ("(", stream);
- /* XXX: sprint_subexp */
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" in ", stream);
- print_subexp (exp, pos, stream, PREC_EQUAL);
- fputs_filtered (" .. ", stream);
- print_subexp (exp, pos, stream, PREC_EQUAL);
- if (prec >= PREC_EQUAL)
- fputs_filtered (")", stream);
- return;
-
- case OP_ATR_FIRST:
- case OP_ATR_LAST:
- case OP_ATR_LENGTH:
- case OP_ATR_IMAGE:
- case OP_ATR_MAX:
- case OP_ATR_MIN:
- case OP_ATR_MODULUS:
- case OP_ATR_POS:
- case OP_ATR_SIZE:
- case OP_ATR_TAG:
- case OP_ATR_VAL:
- if (exp->elts[*pos].opcode == OP_TYPE)
- {
- if (exp->elts[*pos + 1].type->code () != TYPE_CODE_VOID)
- LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0,
- &type_print_raw_options);
- *pos += 3;
- }
- else
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fprintf_filtered (stream, "'%s", ada_attribute_name (op));
- if (nargs > 1)
- {
- int tem;
-
- for (tem = 1; tem < nargs; tem += 1)
- {
- fputs_filtered ((tem == 1) ? " (" : ", ", stream);
- print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
- }
- fputs_filtered (")", stream);
- }
- return;
-
- case UNOP_QUAL:
- type_print (exp->elts[pc + 1].type, "", stream, 0);
- fputs_filtered ("'(", stream);
- print_subexp (exp, pos, stream, PREC_PREFIX);
- fputs_filtered (")", stream);
- return;
-
- case UNOP_IN_RANGE:
- /* XXX: sprint_subexp */
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered (" in ", stream);
- LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0,
- &type_print_raw_options);
- return;
-
- case OP_DISCRETE_RANGE:
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- fputs_filtered ("..", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_OTHERS:
- fputs_filtered ("others => ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_CHOICES:
- for (i = 0; i < nargs-1; i += 1)
- {
- if (i > 0)
- fputs_filtered ("|", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- }
- fputs_filtered (" => ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_POSITIONAL:
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- return;
-
- case OP_AGGREGATE:
- fputs_filtered ("(", stream);
- for (i = 0; i < nargs; i += 1)
- {
- if (i > 0)
- fputs_filtered (", ", stream);
- print_subexp (exp, pos, stream, PREC_SUFFIX);
- }
- fputs_filtered (")", stream);
- return;
- }
-}
-
-/* Table mapping opcodes into strings for printing operators
- and precedences of the operators. */
-
-static const struct op_print ada_op_print_tab[] = {
- {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
- {"or else", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
- {"and then", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
- {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0},
- {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0},
- {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0},
- {"=", BINOP_EQUAL, PREC_EQUAL, 0},
- {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
- {"<=", BINOP_LEQ, PREC_ORDER, 0},
- {">=", BINOP_GEQ, PREC_ORDER, 0},
- {">", BINOP_GTR, PREC_ORDER, 0},
- {"<", BINOP_LESS, PREC_ORDER, 0},
- {">>", BINOP_RSH, PREC_SHIFT, 0},
- {"<<", BINOP_LSH, PREC_SHIFT, 0},
- {"+", BINOP_ADD, PREC_ADD, 0},
- {"-", BINOP_SUB, PREC_ADD, 0},
- {"&", BINOP_CONCAT, PREC_ADD, 0},
- {"*", BINOP_MUL, PREC_MUL, 0},
- {"/", BINOP_DIV, PREC_MUL, 0},
- {"rem", BINOP_REM, PREC_MUL, 0},
- {"mod", BINOP_MOD, PREC_MUL, 0},
- {"**", BINOP_EXP, PREC_REPEAT, 0},
- {"@", BINOP_REPEAT, PREC_REPEAT, 0},
- {"-", UNOP_NEG, PREC_PREFIX, 0},
- {"+", UNOP_PLUS, PREC_PREFIX, 0},
- {"not ", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
- {"not ", UNOP_COMPLEMENT, PREC_PREFIX, 0},
- {"abs ", UNOP_ABS, PREC_PREFIX, 0},
- {".all", UNOP_IND, PREC_SUFFIX, 1},
- {"'access", UNOP_ADDR, PREC_SUFFIX, 1},
- {"'size", OP_ATR_SIZE, PREC_SUFFIX, 1},
- {NULL, OP_NULL, PREC_SUFFIX, 0}
-};
\f
/* Language vector */
-static const struct exp_descriptor ada_exp_descriptor = {
- ada_print_subexp,
- ada_operator_length,
- ada_operator_check,
- ada_dump_subexp_body,
- ada_evaluate_subexp
-};
-
/* symbol_name_matcher_ftype adapter for wild_match. */
static bool
return language_defn::read_var_value (var, var_block, frame);
}
+ /* See language.h. */
+ virtual bool symbol_printing_suppressed (struct symbol *symbol) const override
+ {
+ return symbol->artificial;
+ }
+
/* See language.h. */
void language_arch_info (struct gdbarch *gdbarch,
struct language_arch_info *lai) const override
}
/* See language.h. */
- bool sniff_from_mangled_name (const char *mangled,
- char **out) const override
+ bool sniff_from_mangled_name
+ (const char *mangled,
+ gdb::unique_xmalloc_ptr<char> *out) const override
{
std::string demangled = ada_decode (mangled);
/* See language.h. */
- char *demangle_symbol (const char *mangled, int options) const override
+ gdb::unique_xmalloc_ptr<char> demangle_symbol (const char *mangled,
+ int options) const override
{
- return ada_la_decode (mangled, options);
+ return make_unique_xstrdup (ada_decode (mangled).c_str ());
}
/* See language.h. */
lookup_name,
NULL,
NULL,
+ SEARCH_GLOBAL_BLOCK | SEARCH_STATIC_BLOCK,
ALL_DOMAIN);
/* At this point scan through the misc symbol vectors and add each
for (compunit_symtab *s : objfile->compunits ())
{
QUIT;
- b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
+ b = BLOCKVECTOR_BLOCK (s->blockvector (), GLOBAL_BLOCK);
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
if (completion_skip_symbol (mode, sym))
for (compunit_symtab *s : objfile->compunits ())
{
QUIT;
- b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
+ b = BLOCKVECTOR_BLOCK (s->blockvector (), STATIC_BLOCK);
/* Don't do this block twice. */
if (b == surrounding_static_block)
continue;
{
type = check_typedef (TYPE_TARGET_TYPE (check_typedef (type)));
std::string name = type_to_string (type);
- return gdb::unique_xmalloc_ptr<char>
- (xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr)));
+ return xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr));
}
/* See language.h. */
return ada_parse (ps);
}
- /* See language.h.
-
- Same as evaluate_type (*EXP), but resolves ambiguous symbol references
- (marked by OP_VAR_VALUE nodes in which the symbol has an undefined
- namespace) and converts operators that are user-defined into
- appropriate function calls. If CONTEXT_TYPE is non-null, it provides
- a preferred result type [at the moment, only type void has any
- effect---causing procedures to be preferred over functions in calls].
- A null CONTEXT_TYPE indicates that a non-void return type is
- preferred. May change (expand) *EXP. */
-
- void post_parser (expression_up *expp, struct parser_state *ps)
- const override
- {
- struct type *context_type = NULL;
- int pc = 0;
-
- if (ps->void_context_p)
- context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
-
- resolve_subexp (expp, &pc, 1, context_type, ps->parse_completion,
- ps->block_tracker);
- }
-
/* See language.h. */
void emitchar (int ch, struct type *chtype,
const struct lang_varobj_ops *varobj_ops () const override
{ return &ada_varobj_ops; }
- /* See language.h. */
-
- const struct exp_descriptor *expression_ops () const override
- { return &ada_exp_descriptor; }
-
- /* See language.h. */
-
- const struct op_print *opcode_print_table () const override
- { return ada_op_print_tab; }
-
protected:
/* See language.h. */
ops->print_one = print_one_exception;
ops->print_mention = print_mention_exception;
ops->print_recreate = print_recreate_exception;
-
- ops = &catch_exception_unhandled_breakpoint_ops;
- *ops = bkpt_breakpoint_ops;
- ops->allocate_location = allocate_location_exception;
- ops->re_set = re_set_exception;
- ops->check_status = check_status_exception;
- ops->print_it = print_it_exception;
- ops->print_one = print_one_exception;
- ops->print_mention = print_mention_exception;
- ops->print_recreate = print_recreate_exception;
-
- ops = &catch_assert_breakpoint_ops;
- *ops = bkpt_breakpoint_ops;
- ops->allocate_location = allocate_location_exception;
- ops->re_set = re_set_exception;
- ops->check_status = check_status_exception;
- ops->print_it = print_it_exception;
- ops->print_one = print_one_exception;
- ops->print_mention = print_mention_exception;
- ops->print_recreate = print_recreate_exception;
-
- ops = &catch_handlers_breakpoint_ops;
- *ops = bkpt_breakpoint_ops;
- ops->allocate_location = allocate_location_exception;
- ops->re_set = re_set_exception;
- ops->check_status = check_status_exception;
- ops->print_it = print_it_exception;
- ops->print_one = print_one_exception;
- ops->print_mention = print_mention_exception;
- ops->print_recreate = print_recreate_exception;
}
/* This module's 'new_objfile' observer. */
{
initialize_ada_catchpoint_ops ();
- add_basic_prefix_cmd ("ada", no_class,
- _("Prefix command for changing Ada-specific settings."),
- &set_ada_list, "set ada ", 0, &setlist);
-
- add_show_prefix_cmd ("ada", no_class,
- _("Generic command for showing Ada-specific settings."),
- &show_ada_list, "show ada ", 0, &showlist);
+ add_setshow_prefix_cmd
+ ("ada", no_class,
+ _("Prefix command for changing Ada-specific settings."),
+ _("Generic command for showing Ada-specific settings."),
+ &set_ada_list, &show_ada_list,
+ &setlist, &showlist);
add_setshow_boolean_cmd ("trust-PAD-over-XVS", class_obscure,
&trust_pad_over_xvs, _("\
CATCH_PERMANENT,
CATCH_TEMPORARY);
- varsize_limit = 65536;
- add_setshow_uinteger_cmd ("varsize-limit", class_support,
- &varsize_limit, _("\
-Set the maximum number of bytes allowed in a variable-size object."), _("\
-Show the maximum number of bytes allowed in a variable-size object."), _("\
-Attempts to access an object whose size is not a compile-time constant\n\
-and exceeds this limit will cause an error."),
- NULL, NULL, &setlist, &showlist);
-
add_info ("exceptions", info_exceptions_command,
_("\
List all Ada exception names.\n\
If a regular expression is passed as an argument, only those matching\n\
the regular expression are listed."));
- add_basic_prefix_cmd ("ada", class_maintenance,
- _("Set Ada maintenance-related variables."),
- &maint_set_ada_cmdlist, "maintenance set ada ",
- 0/*allow-unknown*/, &maintenance_set_cmdlist);
-
- add_show_prefix_cmd ("ada", class_maintenance,
- _("Show Ada maintenance-related variables."),
- &maint_show_ada_cmdlist, "maintenance show ada ",
- 0/*allow-unknown*/, &maintenance_show_cmdlist);
+ add_setshow_prefix_cmd ("ada", class_maintenance,
+ _("Set Ada maintenance-related variables."),
+ _("Show Ada maintenance-related variables."),
+ &maint_set_ada_cmdlist, &maint_show_ada_cmdlist,
+ &maintenance_set_cmdlist, &maintenance_show_cmdlist);
add_setshow_boolean_cmd
("ignore-descriptive-types", class_maintenance,
DWARF attribute."),
NULL, NULL, &maint_set_ada_cmdlist, &maint_show_ada_cmdlist);
- decoded_names_store = htab_create_alloc (256, htab_hash_string, streq_hash,
+ decoded_names_store = htab_create_alloc (256, htab_hash_string,
+ htab_eq_string,
NULL, xcalloc, xfree);
/* The ada-lang observers. */
- gdb::observers::new_objfile.attach (ada_new_objfile_observer);
- gdb::observers::free_objfile.attach (ada_free_objfile_observer);
- gdb::observers::inferior_exit.attach (ada_inferior_exit);
+ gdb::observers::new_objfile.attach (ada_new_objfile_observer, "ada-lang");
+ gdb::observers::free_objfile.attach (ada_free_objfile_observer, "ada-lang");
+ gdb::observers::inferior_exit.attach (ada_inferior_exit, "ada-lang");
}
projects / binutils-gdb.git / blobdiff