#include "defs.h"
#include <stdio.h>
#include "gdb_string.h"
#include <ctype.h>
#include <stdarg.h>
#include "demangle.h"
#include "gdb_regex.h"
#include "frame.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "gdbcmd.h"
#include "expression.h"
#include "parser-defs.h"
#include "language.h"
#include "c-lang.h"
#include "inferior.h"
#include "symfile.h"
#include "objfiles.h"
#include "breakpoint.h"
#include "gdbcore.h"
#include "hashtab.h"
#include "gdb_obstack.h"
#include "ada-lang.h"
#include "completer.h"
#include "gdb_stat.h"
#ifdef UI_OUT
#include "ui-out.h"
#endif
#include "block.h"
#include "infcall.h"
#include "dictionary.h"
#include "exceptions.h"
#ifndef ADA_RETAIN_DOTS
#define ADA_RETAIN_DOTS 0
#endif
#ifndef TRUNCATION_TOWARDS_ZERO
#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
#endif
static void extract_string (CORE_ADDR addr, char *buf);
static struct type *ada_create_fundamental_type (struct objfile *, int);
static void modify_general_field (char *, LONGEST, int, int);
static struct type *desc_base_type (struct type *);
static struct type *desc_bounds_type (struct type *);
static struct value *desc_bounds (struct value *);
static int fat_pntr_bounds_bitpos (struct type *);
static int fat_pntr_bounds_bitsize (struct type *);
static struct type *desc_data_type (struct type *);
static struct value *desc_data (struct value *);
static int fat_pntr_data_bitpos (struct type *);
static int fat_pntr_data_bitsize (struct type *);
static struct value *desc_one_bound (struct value *, int, int);
static int desc_bound_bitpos (struct type *, int, int);
static int desc_bound_bitsize (struct type *, int, int);
static struct type *desc_index_type (struct type *, int);
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 *ensure_lval (struct value *, CORE_ADDR *);
static struct value *convert_actual (struct value *, struct type *,
CORE_ADDR *);
static struct value *make_array_descriptor (struct type *, struct value *,
CORE_ADDR *);
static void ada_add_block_symbols (struct obstack *,
struct block *, const char *,
domain_enum, struct objfile *,
struct symtab *, int);
static int is_nonfunction (struct ada_symbol_info *, int);
static void add_defn_to_vec (struct obstack *, struct symbol *,
struct block *, struct symtab *);
static int num_defns_collected (struct obstack *);
static struct ada_symbol_info *defns_collected (struct obstack *, int);
static struct partial_symbol *ada_lookup_partial_symbol (struct partial_symtab
*, const char *, int,
domain_enum, int);
static struct symtab *symtab_for_sym (struct symbol *);
static struct value *resolve_subexp (struct expression **, int *, int,
struct type *);
static void replace_operator_with_call (struct expression **, int, int, int,
struct symbol *, struct block *);
static int possible_user_operator_p (enum exp_opcode, struct value **);
static char *ada_op_name (enum exp_opcode);
static const char *ada_decoded_op_name (enum exp_opcode);
static int numeric_type_p (struct type *);
static int integer_type_p (struct type *);
static int scalar_type_p (struct type *);
static int discrete_type_p (struct type *);
static struct type *ada_lookup_struct_elt_type (struct type *, char *,
int, int, int *);
static struct value *evaluate_subexp (struct type *, struct expression *,
int *, enum noside);
static struct value *evaluate_subexp_type (struct expression *, int *);
static int is_dynamic_field (struct type *, int);
static struct type *to_fixed_variant_branch_type (struct type *,
const gdb_byte *,
CORE_ADDR, struct value *);
static struct type *to_fixed_array_type (struct type *, struct value *, int);
static struct type *to_fixed_range_type (char *, struct value *,
struct objfile *);
static struct type *to_static_fixed_type (struct type *);
static struct value *unwrap_value (struct value *);
static struct type *packed_array_type (struct type *, long *);
static struct type *decode_packed_array_type (struct type *);
static struct value *decode_packed_array (struct value *);
static struct value *value_subscript_packed (struct value *, int,
struct value **);
static struct value *coerce_unspec_val_to_type (struct value *,
struct type *);
static struct value *get_var_value (char *, char *);
static int lesseq_defined_than (struct symbol *, struct symbol *);
static int equiv_types (struct type *, struct type *);
static int is_name_suffix (const char *);
static int wild_match (const char *, int, const char *);
static struct value *ada_coerce_ref (struct value *);
static LONGEST pos_atr (struct value *);
static struct value *value_pos_atr (struct value *);
static struct value *value_val_atr (struct type *, struct value *);
static struct symbol *standard_lookup (const char *, const struct block *,
domain_enum);
static struct value *ada_search_struct_field (char *, struct value *, int,
struct type *);
static struct value *ada_value_primitive_field (struct value *, int, int,
struct type *);
static int find_struct_field (char *, struct type *, int,
struct type **, int *, int *, int *);
static struct value *ada_to_fixed_value_create (struct type *, CORE_ADDR,
struct value *);
static struct value *ada_to_fixed_value (struct value *);
static int ada_resolve_function (struct ada_symbol_info *, int,
struct value **, int, const char *,
struct type *);
static struct value *ada_coerce_to_simple_array (struct value *);
static int ada_is_direct_array_type (struct type *);
static void ada_language_arch_info (struct gdbarch *,
struct language_arch_info *);
static void check_size (struct type *);
static unsigned int varsize_limit;
static char *ada_completer_word_break_characters =
#ifdef VMS
" \t\n!@#%^&*()+=|~`}{[]\";:?/,-";
#else
" \t\n!@#$%^&*()+=|~`}{[]\";:?/,-";
#endif
static const char ADA_MAIN_PROGRAM_SYMBOL_NAME[]
= "__gnat_ada_main_program_name";
static const char raise_sym_name[] = "__gnat_raise_nodefer_with_msg";
static const char raise_unhandled_sym_name[] = "__gnat_unhandled_exception";
static const char raise_assert_sym_name[] =
"system__assertions__raise_assert_failure";
static const char process_raise_exception_name[] =
"ada__exceptions__process_raise_exception";
static const char longest_exception_template[] =
"'__gnat_raise_nodefer_with_msg' if long_integer(e) = long_integer(&)";
static int warning_limit = 2;
static int warnings_issued = 0;
static const char *known_runtime_file_name_patterns[] = {
ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS NULL
};
static const char *known_auxiliary_function_name_patterns[] = {
ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS NULL
};
static struct obstack symbol_list_obstack;
static char *
ada_get_gdb_completer_word_break_characters (void)
{
return ada_completer_word_break_characters;
}
static void
extract_string (CORE_ADDR addr, char *buf)
{
int char_index = 0;
do
{
target_read_memory (addr + char_index * sizeof (char),
buf + char_index * sizeof (char), sizeof (char));
char_index++;
}
while (buf[char_index - 1] != '\000');
}
void *
grow_vect (void *vect, size_t *size, size_t min_size, int element_size)
{
if (*size < min_size)
{
*size *= 2;
if (*size < min_size)
*size = min_size;
vect = xrealloc (vect, *size * element_size);
}
return vect;
}
static int
field_name_match (const char *field_name, const char *target)
{
int len = strlen (target);
return
(strncmp (field_name, target, len) == 0
&& (field_name[len] == '\0'
|| (strncmp (field_name + len, "___", 3) == 0
&& strcmp (field_name + strlen (field_name) - 6,
"___XVN") != 0)));
}
int
ada_get_field_index (const struct type *type, const char *field_name,
int maybe_missing)
{
int fieldno;
for (fieldno = 0; fieldno < TYPE_NFIELDS (type); fieldno++)
if (field_name_match (TYPE_FIELD_NAME (type, fieldno), field_name))
return fieldno;
if (!maybe_missing)
error (_("Unable to find field %s in struct %s. Aborting"),
field_name, TYPE_NAME (type));
return -1;
}
int
ada_name_prefix_len (const char *name)
{
if (name == NULL)
return 0;
else
{
const char *p = strstr (name, "___");
if (p == NULL)
return strlen (name);
else
return p - name;
}
}
static int
is_suffix (const char *str, const char *suffix)
{
int len1, len2;
if (str == NULL)
return 0;
len1 = strlen (str);
len2 = strlen (suffix);
return (len1 >= len2 && strcmp (str + len1 - len2, suffix) == 0);
}
struct value *
value_from_contents_and_address (struct type *type,
const gdb_byte *valaddr,
CORE_ADDR address)
{
struct value *v = allocate_value (type);
if (valaddr == NULL)
set_value_lazy (v, 1);
else
memcpy (value_contents_raw (v), valaddr, TYPE_LENGTH (type));
VALUE_ADDRESS (v) = address;
if (address != 0)
VALUE_LVAL (v) = lval_memory;
return v;
}
static struct value *
coerce_unspec_val_to_type (struct value *val, struct type *type)
{
type = ada_check_typedef (type);
if (value_type (val) == type)
return val;
else
{
struct value *result;
check_size (type);
result = allocate_value (type);
VALUE_LVAL (result) = VALUE_LVAL (val);
set_value_bitsize (result, value_bitsize (val));
set_value_bitpos (result, value_bitpos (val));
VALUE_ADDRESS (result) = VALUE_ADDRESS (val) + value_offset (val);
if (value_lazy (val)
|| TYPE_LENGTH (type) > TYPE_LENGTH (value_type (val)))
set_value_lazy (result, 1);
else
memcpy (value_contents_raw (result), value_contents (val),
TYPE_LENGTH (type));
return result;
}
}
static const gdb_byte *
cond_offset_host (const gdb_byte *valaddr, long offset)
{
if (valaddr == NULL)
return NULL;
else
return valaddr + offset;
}
static CORE_ADDR
cond_offset_target (CORE_ADDR address, long offset)
{
if (address == 0)
return 0;
else
return address + offset;
}
static void lim_warning (const char *format, ...) ATTR_FORMAT (printf, 1, 2);
static void
lim_warning (const char *format, ...)
{
va_list args;
va_start (args, format);
warnings_issued += 1;
if (warnings_issued <= warning_limit)
vwarning (format, args);
va_end (args);
}
static void
check_size (struct type *type)
{
if (TYPE_LENGTH (type) > varsize_limit)
error (_("object size is larger than varsize-limit"));
}
static LONGEST
max_of_size (int size)
{
LONGEST top_bit = (LONGEST) 1 << (size * 8 - 2);
return top_bit | (top_bit - 1);
}
static LONGEST
min_of_size (int size)
{
return -max_of_size (size) - 1;
}
static ULONGEST
umax_of_size (int size)
{
ULONGEST top_bit = (ULONGEST) 1 << (size * 8 - 1);
return top_bit | (top_bit - 1);
}
static LONGEST
max_of_type (struct type *t)
{
if (TYPE_UNSIGNED (t))
return (LONGEST) umax_of_size (TYPE_LENGTH (t));
else
return max_of_size (TYPE_LENGTH (t));
}
static LONGEST
min_of_type (struct type *t)
{
if (TYPE_UNSIGNED (t))
return 0;
else
return min_of_size (TYPE_LENGTH (t));
}
static struct value *
discrete_type_high_bound (struct type *type)
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
return value_from_longest (TYPE_TARGET_TYPE (type),
TYPE_HIGH_BOUND (type));
case TYPE_CODE_ENUM:
return
value_from_longest (type,
TYPE_FIELD_BITPOS_ASSIGN (type,
TYPE_NFIELDS (type) - 1));
case TYPE_CODE_INT:
return value_from_longest (type, max_of_type (type));
default:
error (_("Unexpected type in discrete_type_high_bound."));
}
}
static struct value *
discrete_type_low_bound (struct type *type)
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_RANGE:
return value_from_longest (TYPE_TARGET_TYPE (type),
TYPE_LOW_BOUND (type));
case TYPE_CODE_ENUM:
return value_from_longest (type, TYPE_FIELD_BITPOS (type, 0));
case TYPE_CODE_INT:
return value_from_longest (type, min_of_type (type));
default:
error (_("Unexpected type in discrete_type_low_bound."));
}
}
static struct type *
base_type (struct type *type)
{
while (type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE)
{
if (type == TYPE_TARGET_TYPE (type) || TYPE_TARGET_TYPE (type) == NULL)
return type;
type = TYPE_TARGET_TYPE (type);
}
return type;
}
enum language
ada_update_initial_language (enum language lang,
struct partial_symtab *main_pst)
{
if (lookup_minimal_symbol ("adainit", (const char *) NULL,
(struct objfile *) NULL) != NULL)
return language_ada;
return lang;
}
char *
ada_main_name (void)
{
struct minimal_symbol *msym;
CORE_ADDR main_program_name_addr;
static char main_program_name[1024];
msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL);
if (msym != NULL)
{
main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym);
if (main_program_name_addr == 0)
error (_("Invalid address for Ada main program name."));
extract_string (main_program_name_addr, main_program_name);
return main_program_name;
}
return NULL;
}
const struct ada_opname_map ada_opname_table[] = {
{"Oadd", "\"+\"", BINOP_ADD},
{"Osubtract", "\"-\"", BINOP_SUB},
{"Omultiply", "\"*\"", BINOP_MUL},
{"Odivide", "\"/\"", BINOP_DIV},
{"Omod", "\"mod\"", BINOP_MOD},
{"Orem", "\"rem\"", BINOP_REM},
{"Oexpon", "\"**\"", BINOP_EXP},
{"Olt", "\"<\"", BINOP_LESS},
{"Ole", "\"<=\"", BINOP_LEQ},
{"Ogt", "\">\"", BINOP_GTR},
{"Oge", "\">=\"", BINOP_GEQ},
{"Oeq", "\"=\"", BINOP_EQUAL},
{"One", "\"/=\"", BINOP_NOTEQUAL},
{"Oand", "\"and\"", BINOP_BITWISE_AND},
{"Oor", "\"or\"", BINOP_BITWISE_IOR},
{"Oxor", "\"xor\"", BINOP_BITWISE_XOR},
{"Oconcat", "\"&\"", BINOP_CONCAT},
{"Oabs", "\"abs\"", UNOP_ABS},
{"Onot", "\"not\"", UNOP_LOGICAL_NOT},
{"Oadd", "\"+\"", UNOP_PLUS},
{"Osubtract", "\"-\"", UNOP_NEG},
{NULL, NULL}
};
static int
is_suppressed_name (const char *str)
{
if (strncmp (str, "_ada_", 5) == 0)
str += 5;
if (str[0] == '_' || str[0] == '\000')
return 1;
else
{
const char *p;
const char *suffix = strstr (str, "___");
if (suffix != NULL && suffix[3] != 'X')
return 1;
if (suffix == NULL)
suffix = str + strlen (str);
for (p = suffix - 1; p != str; p -= 1)
if (isupper (*p))
{
int i;
if (p[0] == 'X' && p[-1] != '_')
goto OK;
if (*p != 'O')
return 1;
for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
if (strncmp (ada_opname_table[i].encoded, p,
strlen (ada_opname_table[i].encoded)) == 0)
goto OK;
return 1;
OK:;
}
return 0;
}
}
char *
ada_encode (const char *decoded)
{
static char *encoding_buffer = NULL;
static size_t encoding_buffer_size = 0;
const char *p;
int k;
if (decoded == NULL)
return NULL;
GROW_VECT (encoding_buffer, encoding_buffer_size,
2 * strlen (decoded) + 10);
k = 0;
for (p = decoded; *p != '\0'; p += 1)
{
if (!ADA_RETAIN_DOTS && *p == '.')
{
encoding_buffer[k] = encoding_buffer[k + 1] = '_';
k += 2;
}
else if (*p == '"')
{
const struct ada_opname_map *mapping;
for (mapping = ada_opname_table;
mapping->encoded != NULL
&& strncmp (mapping->decoded, p,
strlen (mapping->decoded)) != 0; mapping += 1)
;
if (mapping->encoded == NULL)
error (_("invalid Ada operator name: %s"), p);
strcpy (encoding_buffer + k, mapping->encoded);
k += strlen (mapping->encoded);
break;
}
else
{
encoding_buffer[k] = *p;
k += 1;
}
}
encoding_buffer[k] = '\0';
return encoding_buffer;
}
char *
ada_fold_name (const char *name)
{
static char *fold_buffer = NULL;
static size_t fold_buffer_size = 0;
int len = strlen (name);
GROW_VECT (fold_buffer, fold_buffer_size, len + 1);
if (name[0] == '\'')
{
strncpy (fold_buffer, name + 1, len - 2);
fold_buffer[len - 2] = '\000';
}
else
{
int i;
for (i = 0; i <= len; i += 1)
fold_buffer[i] = tolower (name[i]);
}
return fold_buffer;
}
const char *
ada_decode (const char *encoded)
{
int i, j;
int len0;
const char *p;
char *decoded;
int at_start_name;
static char *decoding_buffer = NULL;
static size_t decoding_buffer_size = 0;
if (strncmp (encoded, "_ada_", 5) == 0)
encoded += 5;
if (encoded[0] == '_' || encoded[0] == '<')
goto Suppress;
len0 = strlen (encoded);
if (len0 > 1 && isdigit (encoded[len0 - 1]))
{
i = len0 - 2;
while (i > 0 && isdigit (encoded[i]))
i--;
if (i >= 0 && encoded[i] == '.')
len0 = i;
else if (i >= 2 && strncmp (encoded + i - 2, "___", 3) == 0)
len0 = i - 2;
}
p = strstr (encoded, "___");
if (p != NULL && p - encoded < len0 - 3)
{
if (p[3] == 'X')
len0 = p - encoded;
else
goto Suppress;
}
if (len0 > 3 && strncmp (encoded + len0 - 3, "TKB", 3) == 0)
len0 -= 3;
if (len0 > 1 && strncmp (encoded + len0 - 1, "B", 1) == 0)
len0 -= 1;
GROW_VECT (decoding_buffer, decoding_buffer_size, 2 * len0 + 1);
decoded = decoding_buffer;
if (len0 > 1 && isdigit (encoded[len0 - 1]))
{
i = len0 - 2;
while ((i >= 0 && isdigit (encoded[i]))
|| (i >= 1 && encoded[i] == '_' && isdigit (encoded[i - 1])))
i -= 1;
if (i > 1 && encoded[i] == '_' && encoded[i - 1] == '_')
len0 = i - 1;
else if (encoded[i] == '$')
len0 = i;
}
for (i = 0, j = 0; i < len0 && !isalpha (encoded[i]); i += 1, j += 1)
decoded[j] = encoded[i];
at_start_name = 1;
while (i < len0)
{
if (at_start_name && encoded[i] == 'O')
{
int k;
for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
{
int op_len = strlen (ada_opname_table[k].encoded);
if ((strncmp (ada_opname_table[k].encoded + 1, encoded + i + 1,
op_len - 1) == 0)
&& !isalnum (encoded[i + op_len]))
{
strcpy (decoded + j, ada_opname_table[k].decoded);
at_start_name = 0;
i += op_len;
j += strlen (ada_opname_table[k].decoded);
break;
}
}
if (ada_opname_table[k].encoded != NULL)
continue;
}
at_start_name = 0;
if (i < len0 - 4 && strncmp (encoded + i, "TK__", 4) == 0)
i += 2;
if (encoded[i] == 'X' && i != 0 && isalnum (encoded[i - 1]))
{
do
i += 1;
while (i < len0 && (encoded[i] == 'b' || encoded[i] == 'n'));
if (i < len0)
goto Suppress;
}
else if (!ADA_RETAIN_DOTS
&& i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
{
decoded[j] = '.';
at_start_name = 1;
i += 2;
j += 1;
}
else
{
decoded[j] = encoded[i];
i += 1;
j += 1;
}
}
decoded[j] = '\000';
for (i = 0; decoded[i] != '\0'; i += 1)
if (isupper (decoded[i]) || decoded[i] == ' ')
goto Suppress;
if (strcmp (decoded, encoded) == 0)
return encoded;
else
return decoded;
Suppress:
GROW_VECT (decoding_buffer, decoding_buffer_size, strlen (encoded) + 3);
decoded = decoding_buffer;
if (encoded[0] == '<')
strcpy (decoded, encoded);
else
sprintf (decoded, "<%s>", encoded);
return decoded;
}
static struct htab *decoded_names_store;
char *
ada_decode_symbol (const struct general_symbol_info *gsymbol)
{
char **resultp =
(char **) &gsymbol->language_specific.cplus_specific.demangled_name;
if (*resultp == NULL)
{
const char *decoded = ada_decode (gsymbol->name);
if (gsymbol->bfd_section != NULL)
{
bfd *obfd = gsymbol->bfd_section->owner;
if (obfd != NULL)
{
struct objfile *objf;
ALL_OBJFILES (objf)
{
if (obfd == objf->obfd)
{
*resultp = obsavestring (decoded, strlen (decoded),
&objf->objfile_obstack);
break;
}
}
}
}
if (*resultp == NULL)
{
char **slot = (char **) htab_find_slot (decoded_names_store,
decoded, INSERT);
if (*slot == NULL)
*slot = xstrdup (decoded);
*resultp = *slot;
}
}
return *resultp;
}
char *
ada_la_decode (const char *encoded, int options)
{
return xstrdup (ada_decode (encoded));
}
int
ada_match_name (const char *sym_name, const char *name, int wild)
{
if (sym_name == NULL || name == NULL)
return 0;
else if (wild)
return wild_match (name, strlen (name), sym_name);
else
{
int len_name = strlen (name);
return (strncmp (sym_name, name, len_name) == 0
&& is_name_suffix (sym_name + len_name))
|| (strncmp (sym_name, "_ada_", 5) == 0
&& strncmp (sym_name + 5, name, len_name) == 0
&& is_name_suffix (sym_name + len_name + 5));
}
}
int
ada_suppress_symbol_printing (struct symbol *sym)
{
if (SYMBOL_DOMAIN (sym) == STRUCT_DOMAIN)
return 1;
else
return is_suppressed_name (SYMBOL_LINKAGE_NAME (sym));
}
static char *bound_name[] = {
"LB0", "UB0", "LB1", "UB1", "LB2", "UB2", "LB3", "UB3",
"LB4", "UB4", "LB5", "UB5", "LB6", "UB6", "LB7", "UB7"
};
#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char *)))
static void
modify_general_field (char *addr, LONGEST fieldval, int bitpos, int bitsize)
{
modify_field (addr + bitpos / 8, fieldval, bitpos % 8, bitsize);
}
static struct type *
desc_base_type (struct type *type)
{
if (type == NULL)
return NULL;
type = ada_check_typedef (type);
if (type != NULL
&& (TYPE_CODE (type) == TYPE_CODE_PTR
|| TYPE_CODE (type) == TYPE_CODE_REF))
return ada_check_typedef (TYPE_TARGET_TYPE (type));
else
return type;
}
static int
is_thin_pntr (struct type *type)
{
return
is_suffix (ada_type_name (desc_base_type (type)), "___XUT")
|| is_suffix (ada_type_name (desc_base_type (type)), "___XUT___XVE");
}
static struct type *
thin_descriptor_type (struct type *type)
{
struct type *base_type = desc_base_type (type);
if (base_type == NULL)
return NULL;
if (is_suffix (ada_type_name (base_type), "___XVE"))
return base_type;
else
{
struct type *alt_type = ada_find_parallel_type (base_type, "___XVE");
if (alt_type == NULL)
return base_type;
else
return alt_type;
}
}
static struct value *
thin_data_pntr (struct value *val)
{
struct type *type = value_type (val);
if (TYPE_CODE (type) == TYPE_CODE_PTR)
return value_cast (desc_data_type (thin_descriptor_type (type)),
value_copy (val));
else
return value_from_longest (desc_data_type (thin_descriptor_type (type)),
VALUE_ADDRESS (val) + value_offset (val));
}
static int
is_thick_pntr (struct type *type)
{
type = desc_base_type (type);
return (type != NULL && TYPE_CODE (type) == TYPE_CODE_STRUCT
&& lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
}
static struct type *
desc_bounds_type (struct type *type)
{
struct type *r;
type = desc_base_type (type);
if (type == NULL)
return NULL;
else if (is_thin_pntr (type))
{
type = thin_descriptor_type (type);
if (type == NULL)
return NULL;
r = lookup_struct_elt_type (type, "BOUNDS", 1);
if (r != NULL)
return ada_check_typedef (r);
}
else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
if (r != NULL)
return ada_check_typedef (TYPE_TARGET_TYPE (ada_check_typedef (r)));
}
return NULL;
}
static struct value *
desc_bounds (struct value *arr)
{
struct type *type = ada_check_typedef (value_type (arr));
if (is_thin_pntr (type))
{
struct type *bounds_type =
desc_bounds_type (thin_descriptor_type (type));
LONGEST addr;
if (desc_bounds_type == NULL)
error (_("Bad GNAT array descriptor"));
if (TYPE_CODE (type) == TYPE_CODE_PTR)
addr = value_as_long (arr);
else
addr = VALUE_ADDRESS (arr) + value_offset (arr);
return
value_from_longest (lookup_pointer_type (bounds_type),
addr - TYPE_LENGTH (bounds_type));
}
else if (is_thick_pntr (type))
return value_struct_elt (&arr, NULL, "P_BOUNDS", NULL,
_("Bad GNAT array descriptor"));
else
return NULL;
}
static int
fat_pntr_bounds_bitpos (struct type *type)
{
return TYPE_FIELD_BITPOS (desc_base_type (type), 1);
}
static int
fat_pntr_bounds_bitsize (struct type *type)
{
type = desc_base_type (type);
if (TYPE_FIELD_BITSIZE (type, 1) > 0)
return TYPE_FIELD_BITSIZE (type, 1);
else
return 8 * TYPE_LENGTH (ada_check_typedef (TYPE_FIELD_TYPE (type, 1)));
}
static struct type *
desc_data_type (struct type *type)
{
type = desc_base_type (type);
if (is_thin_pntr (type))
return lookup_pointer_type
(desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1)));
else if (is_thick_pntr (type))
return lookup_struct_elt_type (type, "P_ARRAY", 1);
else
return NULL;
}
static struct value *
desc_data (struct value *arr)
{
struct type *type = value_type (arr);
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,
_("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);
}
static int
fat_pntr_data_bitsize (struct type *type)
{
type = desc_base_type (type);
if (TYPE_FIELD_BITSIZE (type, 0) > 0)
return TYPE_FIELD_BITSIZE (type, 0);
else
return TARGET_CHAR_BIT * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0));
}
static struct value *
desc_one_bound (struct value *bounds, int i, int which)
{
return value_struct_elt (&bounds, NULL, bound_name[2 * i + which - 2], 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);
}
static int
desc_bound_bitsize (struct type *type, int i, int which)
{
type = desc_base_type (type);
if (TYPE_FIELD_BITSIZE (type, 2 * i + which - 2) > 0)
return TYPE_FIELD_BITSIZE (type, 2 * i + which - 2);
else
return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 2 * i + which - 2));
}
static struct type *
desc_index_type (struct type *type, int i)
{
type = desc_base_type (type);
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
return lookup_struct_elt_type (type, bound_name[2 * i - 2], 1);
else
return NULL;
}
static int
desc_arity (struct type *type)
{
type = desc_base_type (type);
if (type != NULL)
return TYPE_NFIELDS (type) / 2;
return 0;
}
static int
ada_is_direct_array_type (struct type *type)
{
if (type == NULL)
return 0;
type = ada_check_typedef (type);
return (TYPE_CODE (type) == TYPE_CODE_ARRAY
|| ada_is_array_descriptor_type (type));
}
int
ada_is_simple_array_type (struct type *type)
{
if (type == NULL)
return 0;
type = ada_check_typedef (type);
return (TYPE_CODE (type) == TYPE_CODE_ARRAY
|| (TYPE_CODE (type) == TYPE_CODE_PTR
&& TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY));
}
int
ada_is_array_descriptor_type (struct type *type)
{
struct type *data_type = desc_data_type (type);
if (type == NULL)
return 0;
type = ada_check_typedef (type);
return
data_type != NULL
&& ((TYPE_CODE (data_type) == TYPE_CODE_PTR
&& TYPE_TARGET_TYPE (data_type) != NULL
&& TYPE_CODE (TYPE_TARGET_TYPE (data_type)) == TYPE_CODE_ARRAY)
|| TYPE_CODE (data_type) == TYPE_CODE_ARRAY)
&& desc_arity (desc_bounds_type (type)) > 0;
}
int
ada_is_bogus_array_descriptor (struct type *type)
{
return
type != NULL
&& TYPE_CODE (type) == TYPE_CODE_STRUCT
&& (lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL
|| lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL)
&& !ada_is_array_descriptor_type (type);
}
struct type *
ada_type_of_array (struct value *arr, int bounds)
{
if (ada_is_packed_array_type (value_type (arr)))
return decode_packed_array_type (value_type (arr));
if (!ada_is_array_descriptor_type (value_type (arr)))
return value_type (arr);
if (!bounds)
return
ada_check_typedef (TYPE_TARGET_TYPE (desc_data_type (value_type (arr))));
else
{
struct type *elt_type;
int arity;
struct value *descriptor;
struct objfile *objf = TYPE_OBJFILE (value_type (arr));
elt_type = ada_array_element_type (value_type (arr), -1);
arity = ada_array_arity (value_type (arr));
if (elt_type == NULL || arity == 0)
return ada_check_typedef (value_type (arr));
descriptor = desc_bounds (arr);
if (value_as_long (descriptor) == 0)
return NULL;
while (arity > 0)
{
struct type *range_type = alloc_type (objf);
struct type *array_type = alloc_type (objf);
struct value *low = desc_one_bound (descriptor, arity, 0);
struct value *high = desc_one_bound (descriptor, arity, 1);
arity -= 1;
create_range_type (range_type, value_type (low),
(int) value_as_long (low),
(int) value_as_long (high));
elt_type = create_array_type (array_type, elt_type, range_type);
}
return lookup_pointer_type (elt_type);
}
}
struct value *
ada_coerce_to_simple_array_ptr (struct value *arr)
{
if (ada_is_array_descriptor_type (value_type (arr)))
{
struct type *arrType = ada_type_of_array (arr, 1);
if (arrType == NULL)
return NULL;
return value_cast (arrType, value_copy (desc_data (arr)));
}
else if (ada_is_packed_array_type (value_type (arr)))
return decode_packed_array (arr);
else
return arr;
}
static struct value *
ada_coerce_to_simple_array (struct value *arr)
{
if (ada_is_array_descriptor_type (value_type (arr)))
{
struct value *arrVal = ada_coerce_to_simple_array_ptr (arr);
if (arrVal == NULL)
error (_("Bounds unavailable for null array pointer."));
return value_ind (arrVal);
}
else if (ada_is_packed_array_type (value_type (arr)))
return decode_packed_array (arr);
else
return arr;
}
struct type *
ada_coerce_to_simple_array_type (struct type *type)
{
struct value *mark = value_mark ();
struct value *dummy = value_from_longest (builtin_type_long, 0);
struct type *result;
deprecated_set_value_type (dummy, type);
result = ada_type_of_array (dummy, 0);
value_free_to_mark (mark);
return result;
}
int
ada_is_packed_array_type (struct type *type)
{
if (type == NULL)
return 0;
type = desc_base_type (type);
type = ada_check_typedef (type);
return
ada_type_name (type) != NULL
&& strstr (ada_type_name (type), "___XP") != NULL;
}
static struct type *
packed_array_type (struct type *type, long *elt_bits)
{
struct type *new_elt_type;
struct type *new_type;
LONGEST low_bound, high_bound;
type = ada_check_typedef (type);
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
return type;
new_type = alloc_type (TYPE_OBJFILE (type));
new_elt_type = packed_array_type (ada_check_typedef (TYPE_TARGET_TYPE (type)),
elt_bits);
create_array_type (new_type, new_elt_type, TYPE_FIELD_TYPE (type, 0));
TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
TYPE_NAME (new_type) = ada_type_name (type);
if (get_discrete_bounds (TYPE_FIELD_TYPE (type, 0),
&low_bound, &high_bound) < 0)
low_bound = high_bound = 0;
if (high_bound < low_bound)
*elt_bits = TYPE_LENGTH_ASSIGN (new_type) = 0;
else
{
*elt_bits *= (high_bound - low_bound + 1);
TYPE_LENGTH_ASSIGN (new_type) =
(*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
}
TYPE_FLAGS (new_type) |= TYPE_FLAG_FIXED_INSTANCE;
return new_type;
}
static struct type *
decode_packed_array_type (struct type *type)
{
struct symbol *sym;
const char *raw_name = ada_type_name (ada_check_typedef (type));
char *name = (char *) alloca (strlen (raw_name) + 1);
char *tail = strstr (raw_name, "___XP");
struct type *shadow_type;
long bits;
type = desc_base_type (type);
memcpy (name, raw_name, tail - raw_name);
name[tail - raw_name] = '\000';
sym = standard_lookup (name, get_selected_block (0), VAR_DOMAIN);
if (sym == NULL || SYMBOL_TYPE (sym) == NULL)
{
lim_warning (_("could not find bounds information on packed array"));
return NULL;
}
shadow_type = SYMBOL_TYPE (sym);
if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
{
lim_warning (_("could not understand bounds information on packed array"));
return NULL;
}
if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
{
lim_warning
(_("could not understand bit size information on packed array"));
return NULL;
}
return packed_array_type (shadow_type, &bits);
}
static struct value *
decode_packed_array (struct value *arr)
{
struct type *type;
arr = ada_coerce_ref (arr);
if (TYPE_CODE (value_type (arr)) == TYPE_CODE_PTR)
arr = ada_value_ind (arr);
type = decode_packed_array_type (value_type (arr));
if (type == NULL)
{
error (_("can't unpack array"));
return NULL;
}
if (BITS_BIG_ENDIAN && ada_is_modular_type (value_type (arr)))
{
int bit_size, bit_pos;
ULONGEST mod;
mod = ada_modulus (value_type (arr)) - 1;
bit_size = 0;
while (mod > 0)
{
bit_size += 1;
mod >>= 1;
}
bit_pos = HOST_CHAR_BIT * TYPE_LENGTH (value_type (arr)) - bit_size;
arr = ada_value_primitive_packed_val (arr, NULL,
bit_pos / HOST_CHAR_BIT,
bit_pos % HOST_CHAR_BIT,
bit_size,
type);
}
return coerce_unspec_val_to_type (arr, type);
}
static struct value *
value_subscript_packed (struct value *arr, int arity, struct value **ind)
{
int i;
int bits, elt_off, bit_off;
long elt_total_bit_offset;
struct type *elt_type;
struct value *v;
bits = 0;
elt_total_bit_offset = 0;
elt_type = ada_check_typedef (value_type (arr));
for (i = 0; i < arity; i += 1)
{
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY
|| TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
error
(_("attempt to do packed indexing of something other than a packed array"));
else
{
struct type *range_type = TYPE_INDEX_TYPE (elt_type);
LONGEST lowerbound, upperbound;
LONGEST idx;
if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
{
lim_warning (_("don't know bounds of array"));
lowerbound = upperbound = 0;
}
idx = value_as_long (value_pos_atr (ind[i]));
if (idx < lowerbound || idx > upperbound)
lim_warning (_("packed array index %ld out of bounds"), (long) idx);
bits = TYPE_FIELD_BITSIZE (elt_type, 0);
elt_total_bit_offset += (idx - lowerbound) * bits;
elt_type = ada_check_typedef (TYPE_TARGET_TYPE (elt_type));
}
}
elt_off = elt_total_bit_offset / HOST_CHAR_BIT;
bit_off = elt_total_bit_offset % HOST_CHAR_BIT;
v = ada_value_primitive_packed_val (arr, NULL, elt_off, bit_off,
bits, elt_type);
if (VALUE_LVAL (arr) == lval_internalvar)
VALUE_LVAL (v) = lval_internalvar_component;
else
VALUE_LVAL (v) = VALUE_LVAL (arr);
return v;
}
static int
has_negatives (struct type *type)
{
switch (TYPE_CODE (type))
{
default:
return 0;
case TYPE_CODE_INT:
return !TYPE_UNSIGNED (type);
case TYPE_CODE_RANGE:
return TYPE_LOW_BOUND (type) < 0;
}
}
struct value *
ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
long offset, int bit_offset, int bit_size,
struct type *type)
{
struct value *v;
int src,
targ,
srcBitsLeft,
nsrc, ntarg,
unusedLS,
accumSize;
unsigned char *bytes;
unsigned char *unpacked;
unsigned long accum;
unsigned char sign;
int len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
int delta = BITS_BIG_ENDIAN ? -1 : 1;
type = ada_check_typedef (type);
if (obj == NULL)
{
v = allocate_value (type);
bytes = (unsigned char *) (valaddr + offset);
}
else if (value_lazy (obj))
{
v = value_at (type,
VALUE_ADDRESS (obj) + value_offset (obj) + offset);
bytes = (unsigned char *) alloca (len);
read_memory (VALUE_ADDRESS (v), bytes, len);
}
else
{
v = allocate_value (type);
bytes = (unsigned char *) value_contents (obj) + offset;
}
if (obj != NULL)
{
VALUE_LVAL (v) = VALUE_LVAL (obj);
if (VALUE_LVAL (obj) == lval_internalvar)
VALUE_LVAL (v) = lval_internalvar_component;
VALUE_ADDRESS (v) = VALUE_ADDRESS (obj) + value_offset (obj) + offset;
set_value_bitpos (v, bit_offset + value_bitpos (obj));
set_value_bitsize (v, bit_size);
if (value_bitpos (v) >= HOST_CHAR_BIT)
{
VALUE_ADDRESS (v) += 1;
set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
}
}
else
set_value_bitsize (v, bit_size);
unpacked = (unsigned char *) value_contents (v);
srcBitsLeft = bit_size;
nsrc = len;
ntarg = TYPE_LENGTH (type);
sign = 0;
if (bit_size == 0)
{
memset (unpacked, 0, TYPE_LENGTH (type));
return v;
}
else if (BITS_BIG_ENDIAN)
{
src = len - 1;
if (has_negatives (type)
&& ((bytes[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1))))
sign = ~0;
unusedLS =
(HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
% HOST_CHAR_BIT;
switch (TYPE_CODE (type))
{
case TYPE_CODE_ARRAY:
case TYPE_CODE_UNION:
case TYPE_CODE_STRUCT:
accumSize =
(HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
targ = src;
break;
default:
accumSize = 0;
targ = TYPE_LENGTH (type) - 1;
break;
}
}
else
{
int sign_bit_offset = (bit_size + bit_offset - 1) % 8;
src = targ = 0;
unusedLS = bit_offset;
accumSize = 0;
if (has_negatives (type) && (bytes[len - 1] & (1 << sign_bit_offset)))
sign = ~0;
}
accum = 0;
while (nsrc > 0)
{
unsigned int unusedMSMask =
(1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
1;
unsigned int signMask = sign & ~unusedMSMask;
accum |=
(((bytes[src] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
accumSize += HOST_CHAR_BIT - unusedLS;
if (accumSize >= HOST_CHAR_BIT)
{
unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
accumSize -= HOST_CHAR_BIT;
accum >>= HOST_CHAR_BIT;
ntarg -= 1;
targ += delta;
}
srcBitsLeft -= HOST_CHAR_BIT - unusedLS;
unusedLS = 0;
nsrc -= 1;
src += delta;
}
while (ntarg > 0)
{
accum |= sign << accumSize;
unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT);
accumSize -= HOST_CHAR_BIT;
accum >>= HOST_CHAR_BIT;
ntarg -= 1;
targ += delta;
}
return v;
}
static void
move_bits (gdb_byte *target, int targ_offset, const gdb_byte *source,
int src_offset, int n)
{
unsigned int accum, mask;
int accum_bits, chunk_size;
target += targ_offset / HOST_CHAR_BIT;
targ_offset %= HOST_CHAR_BIT;
source += src_offset / HOST_CHAR_BIT;
src_offset %= HOST_CHAR_BIT;
if (BITS_BIG_ENDIAN)
{
accum = (unsigned char) *source;
source += 1;
accum_bits = HOST_CHAR_BIT - src_offset;
while (n > 0)
{
int unused_right;
accum = (accum << HOST_CHAR_BIT) + (unsigned char) *source;
accum_bits += HOST_CHAR_BIT;
source += 1;
chunk_size = HOST_CHAR_BIT - targ_offset;
if (chunk_size > n)
chunk_size = n;
unused_right = HOST_CHAR_BIT - (chunk_size + targ_offset);
mask = ((1 << chunk_size) - 1) << unused_right;
*target =
(*target & ~mask)
| ((accum >> (accum_bits - chunk_size - unused_right)) & mask);
n -= chunk_size;
accum_bits -= chunk_size;
target += 1;
targ_offset = 0;
}
}
else
{
accum = (unsigned char) *source >> src_offset;
source += 1;
accum_bits = HOST_CHAR_BIT - src_offset;
while (n > 0)
{
accum = accum + ((unsigned char) *source << accum_bits);
accum_bits += HOST_CHAR_BIT;
source += 1;
chunk_size = HOST_CHAR_BIT - targ_offset;
if (chunk_size > n)
chunk_size = n;
mask = ((1 << chunk_size) - 1) << targ_offset;
*target = (*target & ~mask) | ((accum << targ_offset) & mask);
n -= chunk_size;
accum_bits -= chunk_size;
accum >>= chunk_size;
target += 1;
targ_offset = 0;
}
}
}
static struct value *
ada_value_assign (struct value *toval, struct value *fromval)
{
struct type *type = value_type (toval);
int bits = value_bitsize (toval);
if (!deprecated_value_modifiable (toval))
error (_("Left operand of assignment is not a modifiable lvalue."));
toval = coerce_ref (toval);
if (VALUE_LVAL (toval) == lval_memory
&& bits > 0
&& (TYPE_CODE (type) == TYPE_CODE_FLT
|| TYPE_CODE (type) == TYPE_CODE_STRUCT))
{
int len = (value_bitpos (toval)
+ bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
char *buffer = (char *) alloca (len);
struct value *val;
if (TYPE_CODE (type) == TYPE_CODE_FLT)
fromval = value_cast (type, fromval);
read_memory (VALUE_ADDRESS (toval) + value_offset (toval), buffer, len);
if (BITS_BIG_ENDIAN)
move_bits (buffer, value_bitpos (toval),
value_contents (fromval),
TYPE_LENGTH (value_type (fromval)) * TARGET_CHAR_BIT -
bits, bits);
else
move_bits (buffer, value_bitpos (toval), value_contents (fromval),
0, bits);
write_memory (VALUE_ADDRESS (toval) + value_offset (toval), buffer,
len);
val = value_copy (toval);
memcpy (value_contents_raw (val), value_contents (fromval),
TYPE_LENGTH (type));
deprecated_set_value_type (val, type);
return val;
}
return value_assign (toval, fromval);
}
struct value *
ada_value_subscript (struct value *arr, int arity, struct value **ind)
{
int k;
struct value *elt;
struct type *elt_type;
elt = ada_coerce_to_simple_array (arr);
elt_type = ada_check_typedef (value_type (elt));
if (TYPE_CODE (elt_type) == TYPE_CODE_ARRAY
&& TYPE_FIELD_BITSIZE (elt_type, 0) > 0)
return value_subscript_packed (elt, arity, ind);
for (k = 0; k < arity; k += 1)
{
if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
elt = value_subscript (elt, value_pos_atr (ind[k]));
}
return elt;
}
struct value *
ada_value_ptr_subscript (struct value *arr, struct type *type, int arity,
struct value **ind)
{
int k;
for (k = 0; k < arity; k += 1)
{
LONGEST lwb, upb;
struct value *idx;
if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
error (_("too many subscripts (%d expected)"), k);
arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)),
value_copy (arr));
get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb);
idx = value_pos_atr (ind[k]);
if (lwb != 0)
idx = value_sub (idx, value_from_longest (builtin_type_int, lwb));
arr = value_add (arr, idx);
type = TYPE_TARGET_TYPE (type);
}
return value_ind (arr);
}
static struct value *
ada_value_slice_ptr (struct value *array_ptr, struct type *type,
int low, int high)
{
CORE_ADDR base = value_as_address (array_ptr)
+ ((low - TYPE_LOW_BOUND (TYPE_INDEX_TYPE (type)))
* TYPE_LENGTH (TYPE_TARGET_TYPE (type)));
struct type *index_type =
create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (type)),
low, high);
struct type *slice_type =
create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
return value_from_pointer (lookup_reference_type (slice_type), base);
}
static struct value *
ada_value_slice (struct value *array, int low, int high)
{
struct type *type = value_type (array);
struct type *index_type =
create_range_type (NULL, TYPE_INDEX_TYPE (type), low, high);
struct type *slice_type =
create_array_type (NULL, TYPE_TARGET_TYPE (type), index_type);
return value_cast (slice_type, value_slice (array, low, high - low + 1));
}
int
ada_array_arity (struct type *type)
{
int arity;
if (type == NULL)
return 0;
type = desc_base_type (type);
arity = 0;
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
return desc_arity (desc_bounds_type (type));
else
while (TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
arity += 1;
type = ada_check_typedef (TYPE_TARGET_TYPE (type));
}
return arity;
}
struct type *
ada_array_element_type (struct type *type, int nindices)
{
type = desc_base_type (type);
if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
int k;
struct type *p_array_type;
p_array_type = desc_data_type (type);
k = ada_array_arity (type);
if (k == 0)
return NULL;
if (nindices >= 0 && k > nindices)
k = nindices;
p_array_type = TYPE_TARGET_TYPE (p_array_type);
while (k > 0 && p_array_type != NULL)
{
p_array_type = ada_check_typedef (TYPE_TARGET_TYPE (p_array_type));
k -= 1;
}
return p_array_type;
}
else if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
while (nindices != 0 && TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
type = TYPE_TARGET_TYPE (type);
nindices -= 1;
}
return type;
}
return NULL;
}
struct type *
ada_index_type (struct type *type, int n)
{
struct type *result_type;
type = desc_base_type (type);
if (n > ada_array_arity (type))
return NULL;
if (ada_is_simple_array_type (type))
{
int i;
for (i = 1; i < n; i += 1)
type = TYPE_TARGET_TYPE (type);
result_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
if (result_type == NULL || TYPE_CODE (result_type) == TYPE_CODE_UNDEF)
result_type = builtin_type_int;
return result_type;
}
else
return desc_index_type (desc_bounds_type (type), n);
}
LONGEST
ada_array_bound_from_type (struct type * arr_type, int n, int which,
struct type ** typep)
{
struct type *type;
struct type *index_type_desc;
if (ada_is_packed_array_type (arr_type))
arr_type = decode_packed_array_type (arr_type);
if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
{
if (typep != NULL)
*typep = builtin_type_int;
return (LONGEST) - which;
}
if (TYPE_CODE (arr_type) == TYPE_CODE_PTR)
type = TYPE_TARGET_TYPE (arr_type);
else
type = arr_type;
index_type_desc = ada_find_parallel_type (type, "___XA");
if (index_type_desc == NULL)
{
struct type *range_type;
struct type *index_type;
while (n > 1)
{
type = TYPE_TARGET_TYPE (type);
n -= 1;
}
range_type = TYPE_INDEX_TYPE (type);
index_type = TYPE_TARGET_TYPE (range_type);
if (TYPE_CODE (index_type) == TYPE_CODE_UNDEF)
index_type = builtin_type_long;
if (typep != NULL)
*typep = index_type;
return
(LONGEST) (which == 0
? TYPE_LOW_BOUND (range_type)
: TYPE_HIGH_BOUND (range_type));
}
else
{
struct type *index_type =
to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1),
NULL, TYPE_OBJFILE (arr_type));
if (typep != NULL)
*typep = TYPE_TARGET_TYPE (index_type);
return
(LONGEST) (which == 0
? TYPE_LOW_BOUND (index_type)
: TYPE_HIGH_BOUND (index_type));
}
}
struct value *
ada_array_bound (struct value *arr, int n, int which)
{
struct type *arr_type = value_type (arr);
if (ada_is_packed_array_type (arr_type))
return ada_array_bound (decode_packed_array (arr), n, which);
else if (ada_is_simple_array_type (arr_type))
{
struct type *type;
LONGEST v = ada_array_bound_from_type (arr_type, n, which, &type);
return value_from_longest (type, v);
}
else
return desc_one_bound (desc_bounds (arr), n, which);
}
struct value *
ada_array_length (struct value *arr, int n)
{
struct type *arr_type = ada_check_typedef (value_type (arr));
if (ada_is_packed_array_type (arr_type))
return ada_array_length (decode_packed_array (arr), n);
if (ada_is_simple_array_type (arr_type))
{
struct type *type;
LONGEST v =
ada_array_bound_from_type (arr_type, n, 1, &type) -
ada_array_bound_from_type (arr_type, n, 0, NULL) + 1;
return value_from_longest (type, v);
}
else
return
value_from_longest (builtin_type_int,
value_as_long (desc_one_bound (desc_bounds (arr),
n, 1))
- value_as_long (desc_one_bound (desc_bounds (arr),
n, 0)) + 1);
}
static struct value *
empty_array (struct type *arr_type, int low)
{
struct type *index_type =
create_range_type (NULL, TYPE_TARGET_TYPE (TYPE_INDEX_TYPE (arr_type)),
low, low - 1);
struct type *elt_type = ada_array_element_type (arr_type, 1);
return allocate_value (create_array_type (NULL, elt_type, index_type));
}
static const char *
ada_decoded_op_name (enum exp_opcode op)
{
int i;
for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
{
if (ada_opname_table[i].op == op)
return ada_opname_table[i].decoded;
}
error (_("Could not find operator name for opcode"));
}
static void
resolve (struct expression **expp, int void_context_p)
{
int pc;
pc = 0;
resolve_subexp (expp, &pc, 1, void_context_p ? builtin_type_void : NULL);
}
static struct value *
resolve_subexp (struct expression **expp, int *pos, int deprocedure_p,
struct type *context_type)
{
int pc = *pos;
int i;
struct expression *exp;
enum exp_opcode op = (*expp)->elts[pc].opcode;
struct value **argvec;
int nargs;
argvec = NULL;
nargs = 0;
exp = *expp;
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;
resolve_subexp (expp, pos, 0, NULL);
}
nargs = longest_to_int (exp->elts[pc + 1].longconst);
break;
case UNOP_QUAL:
*pos += 3;
resolve_subexp (expp, pos, 1, exp->elts[pc + 1].type);
break;
case UNOP_ADDR:
*pos += 1;
resolve_subexp (expp, pos, 0, NULL);
break;
case OP_ATR_MODULUS:
*pos += 4;
break;
case OP_ATR_SIZE:
case OP_ATR_TAG:
*pos += 1;
nargs = 1;
break;
case OP_ATR_FIRST:
case OP_ATR_LAST:
case OP_ATR_LENGTH:
case OP_ATR_POS:
case OP_ATR_VAL:
*pos += 1;
nargs = 2;
break;
case OP_ATR_MIN:
case OP_ATR_MAX:
*pos += 1;
nargs = 3;
break;
case BINOP_ASSIGN:
{
struct value *arg1;
*pos += 1;
arg1 = resolve_subexp (expp, pos, 0, NULL);
if (arg1 == NULL)
resolve_subexp (expp, pos, 1, NULL);
else
resolve_subexp (expp, pos, 1, value_type (arg1));
break;
}
case UNOP_CAST:
case UNOP_IN_RANGE:
*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_DOUBLE:
case OP_VAR_VALUE:
*pos += 4;
break;
case OP_TYPE:
case OP_BOOL:
case OP_LAST:
case OP_REGISTER:
case OP_INTERNALVAR:
*pos += 3;
break;
case UNOP_MEMVAL:
*pos += 3;
nargs = 1;
break;
case STRUCTOP_STRUCT:
*pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
nargs = 1;
break;
case OP_STRING:
(*pos) += 3
+ BYTES_TO_EXP_ELEM (longest_to_int (exp->elts[pc + 1].longconst)
+ 1);
break;
case TERNOP_SLICE:
case TERNOP_IN_RANGE:
*pos += 1;
nargs = 3;
break;
case BINOP_IN_BOUNDS:
*pos += 3;
nargs = 2;
break;
default:
error (_("Unexpected operator during name resolution"));
}
argvec = (struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
for (i = 0; i < nargs; i += 1)
argvec[i] = resolve_subexp (expp, pos, 1, NULL);
argvec[i] = NULL;
exp = *expp;
switch (op)
{
default:
break;
case OP_VAR_VALUE:
if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
{
struct ada_symbol_info *candidates;
int n_candidates;
n_candidates =
ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME
(exp->elts[pc + 2].symbol),
exp->elts[pc + 1].block, VAR_DOMAIN,
&candidates);
if (n_candidates > 1)
{
int j;
for (j = 0; j < n_candidates; j += 1)
switch (SYMBOL_CLASS (candidates[j].sym))
{
case LOC_REGISTER:
case LOC_ARG:
case LOC_REF_ARG:
case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_LOCAL:
case LOC_LOCAL_ARG:
case LOC_BASEREG:
case LOC_BASEREG_ARG:
case LOC_COMPUTED:
case LOC_COMPUTED_ARG:
goto FoundNonType;
default:
break;
}
FoundNonType:
if (j < n_candidates)
{
j = 0;
while (j < n_candidates)
{
if (SYMBOL_CLASS (candidates[j].sym) == LOC_TYPEDEF)
{
candidates[j] = candidates[n_candidates - 1];
n_candidates -= 1;
}
else
j += 1;
}
}
}
if (n_candidates == 0)
error (_("No definition found for %s"),
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
else if (n_candidates == 1)
i = 0;
else if (deprocedure_p
&& !is_nonfunction (candidates, n_candidates))
{
i = ada_resolve_function
(candidates, n_candidates, NULL, 0,
SYMBOL_LINKAGE_NAME (exp->elts[pc + 2].symbol),
context_type);
if (i < 0)
error (_("Could not find a match for %s"),
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
}
else
{
printf_filtered (_("Multiple matches for %s\n"),
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
user_select_syms (candidates, n_candidates, 1);
i = 0;
}
exp->elts[pc + 1].block = candidates[i].block;
exp->elts[pc + 2].symbol = candidates[i].sym;
if (innermost_block == NULL
|| contained_in (candidates[i].block, innermost_block))
innermost_block = candidates[i].block;
}
if (deprocedure_p
&& (TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol))
== TYPE_CODE_FUNC))
{
replace_operator_with_call (expp, pc, 0, 0,
exp->elts[pc + 2].symbol,
exp->elts[pc + 1].block);
exp = *expp;
}
break;
case OP_FUNCALL:
{
if (exp->elts[pc + 3].opcode == OP_VAR_VALUE
&& SYMBOL_DOMAIN (exp->elts[pc + 5].symbol) == UNDEF_DOMAIN)
{
struct ada_symbol_info *candidates;
int n_candidates;
n_candidates =
ada_lookup_symbol_list (SYMBOL_LINKAGE_NAME
(exp->elts[pc + 5].symbol),
exp->elts[pc + 4].block, VAR_DOMAIN,
&candidates);
if (n_candidates == 1)
i = 0;
else
{
i = ada_resolve_function
(candidates, n_candidates,
argvec, nargs,
SYMBOL_LINKAGE_NAME (exp->elts[pc + 5].symbol),
context_type);
if (i < 0)
error (_("Could not find a match for %s"),
SYMBOL_PRINT_NAME (exp->elts[pc + 5].symbol));
}
exp->elts[pc + 4].block = candidates[i].block;
exp->elts[pc + 5].symbol = candidates[i].sym;
if (innermost_block == NULL
|| contained_in (candidates[i].block, innermost_block))
innermost_block = candidates[i].block;
}
}
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:
if (possible_user_operator_p (op, argvec))
{
struct ada_symbol_info *candidates;
int n_candidates;
n_candidates =
ada_lookup_symbol_list (ada_encode (ada_decoded_op_name (op)),
(struct block *) NULL, VAR_DOMAIN,
&candidates);
i = ada_resolve_function (candidates, n_candidates, argvec, nargs,
ada_decoded_op_name (op), NULL);
if (i < 0)
break;
replace_operator_with_call (expp, pc, nargs, 1,
candidates[i].sym, candidates[i].block);
exp = *expp;
}
break;
case OP_TYPE:
return NULL;
}
*pos = pc;
return evaluate_subexp_type (exp, pos);
}
static int
ada_type_match (struct type *ftype, struct type *atype, int may_deref)
{
ftype = ada_check_typedef (ftype);
atype = ada_check_typedef (atype);
if (TYPE_CODE (ftype) == TYPE_CODE_REF)
ftype = TYPE_TARGET_TYPE (ftype);
if (TYPE_CODE (atype) == TYPE_CODE_REF)
atype = TYPE_TARGET_TYPE (atype);
if (TYPE_CODE (ftype) == TYPE_CODE_VOID
|| TYPE_CODE (atype) == TYPE_CODE_VOID)
return 1;
switch (TYPE_CODE (ftype))
{
default:
return 1;
case TYPE_CODE_PTR:
if (TYPE_CODE (atype) == 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));
case TYPE_CODE_INT:
case TYPE_CODE_ENUM:
case TYPE_CODE_RANGE:
switch (TYPE_CODE (atype))
{
case TYPE_CODE_INT:
case TYPE_CODE_ENUM:
case TYPE_CODE_RANGE:
return 1;
default:
return 0;
}
case TYPE_CODE_ARRAY:
return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
|| ada_is_array_descriptor_type (atype));
case TYPE_CODE_STRUCT:
if (ada_is_array_descriptor_type (ftype))
return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
|| ada_is_array_descriptor_type (atype));
else
return (TYPE_CODE (atype) == TYPE_CODE_STRUCT
&& !ada_is_array_descriptor_type (atype));
case TYPE_CODE_UNION:
case TYPE_CODE_FLT:
return (TYPE_CODE (atype) == TYPE_CODE (ftype));
}
}
static int
ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
{
int i;
struct type *func_type = SYMBOL_TYPE (func);
if (SYMBOL_CLASS (func) == LOC_CONST
&& TYPE_CODE (func_type) == TYPE_CODE_ENUM)
return (n_actuals == 0);
else if (func_type == NULL || TYPE_CODE (func_type) != TYPE_CODE_FUNC)
return 0;
if (TYPE_NFIELDS (func_type) != n_actuals)
return 0;
for (i = 0; i < n_actuals; i += 1)
{
if (actuals[i] == NULL)
return 0;
else
{
struct type *ftype = ada_check_typedef (TYPE_FIELD_TYPE (func_type, i));
struct type *atype = ada_check_typedef (value_type (actuals[i]));
if (!ada_type_match (ftype, atype, 1))
return 0;
}
}
return 1;
}
static int
return_match (struct type *func_type, struct type *context_type)
{
struct type *return_type;
if (func_type == NULL)
return 1;
if (TYPE_CODE (func_type) == TYPE_CODE_FUNC)
return_type = base_type (TYPE_TARGET_TYPE (func_type));
else
return_type = base_type (func_type);
if (return_type == NULL)
return 1;
context_type = base_type (context_type);
if (TYPE_CODE (return_type) == TYPE_CODE_ENUM)
return context_type == NULL || return_type == context_type;
else if (context_type == NULL)
return TYPE_CODE (return_type) != TYPE_CODE_VOID;
else
return TYPE_CODE (return_type) == TYPE_CODE (context_type);
}
static int
ada_resolve_function (struct ada_symbol_info syms[],
int nsyms, struct value **args, int nargs,
const char *name, struct type *context_type)
{
int k;
int m;
struct type *fallback;
struct type *return_type;
return_type = context_type;
if (context_type == NULL)
fallback = builtin_type_void;
else
fallback = NULL;
m = 0;
while (1)
{
for (k = 0; k < nsyms; k += 1)
{
struct type *type = ada_check_typedef (SYMBOL_TYPE (syms[k].sym));
if (ada_args_match (syms[k].sym, args, nargs)
&& return_match (type, return_type))
{
syms[m] = syms[k];
m += 1;
}
}
if (m > 0 || return_type == fallback)
break;
else
return_type = fallback;
}
if (m == 0)
return -1;
else if (m > 1)
{
printf_filtered (_("Multiple matches for %s\n"), name);
user_select_syms (syms, m, 1);
return 0;
}
return 0;
}
static int
encoded_ordered_before (char *N0, char *N1)
{
if (N1 == NULL)
return 0;
else if (N0 == NULL)
return 1;
else
{
int k0, k1;
for (k0 = strlen (N0) - 1; k0 > 0 && isdigit (N0[k0]); k0 -= 1)
;
for (k1 = strlen (N1) - 1; k1 > 0 && isdigit (N1[k1]); k1 -= 1)
;
if ((N0[k0] == '_' || N0[k0] == '$') && N0[k0 + 1] != '\000'
&& (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
{
int n0, n1;
n0 = k0;
while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
n0 -= 1;
n1 = k1;
while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_')
n1 -= 1;
if (n0 == n1 && strncmp (N0, N1, n0) == 0)
return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
}
return (strcmp (N0, N1) < 0);
}
}
static void
sort_choices (struct ada_symbol_info syms[], int nsyms)
{
int i;
for (i = 1; i < nsyms; i += 1)
{
struct ada_symbol_info sym = syms[i];
int j;
for (j = i - 1; j >= 0; j -= 1)
{
if (encoded_ordered_before (SYMBOL_LINKAGE_NAME (syms[j].sym),
SYMBOL_LINKAGE_NAME (sym.sym)))
break;
syms[j + 1] = syms[j];
}
syms[j + 1] = sym;
}
}
int
user_select_syms (struct ada_symbol_info *syms, int nsyms, int max_results)
{
int i;
int *chosen = (int *) alloca (sizeof (int) * nsyms);
int n_chosen;
int first_choice = (max_results == 1) ? 1 : 2;
if (max_results < 1)
error (_("Request to select 0 symbols!"));
if (nsyms <= 1)
return nsyms;
printf_unfiltered (_("[0] cancel\n"));
if (max_results > 1)
printf_unfiltered (_("[1] all\n"));
sort_choices (syms, nsyms);
for (i = 0; i < nsyms; i += 1)
{
if (syms[i].sym == NULL)
continue;
if (SYMBOL_CLASS (syms[i].sym) == LOC_BLOCK)
{
struct symtab_and_line sal =
find_function_start_sal (syms[i].sym, 1);
if (sal.symtab == NULL)
printf_unfiltered (_("[%d] %s at <no source file available>:%d\n"),
i + first_choice,
SYMBOL_PRINT_NAME (syms[i].sym),
sal.line);
else
printf_unfiltered (_("[%d] %s at %s:%d\n"), i + first_choice,
SYMBOL_PRINT_NAME (syms[i].sym),
sal.symtab->filename, sal.line);
continue;
}
else
{
int is_enumeral =
(SYMBOL_CLASS (syms[i].sym) == LOC_CONST
&& SYMBOL_TYPE (syms[i].sym) != NULL
&& TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) == TYPE_CODE_ENUM);
struct symtab *symtab = symtab_for_sym (syms[i].sym);
if (SYMBOL_LINE (syms[i].sym) != 0 && symtab != NULL)
printf_unfiltered (_("[%d] %s at %s:%d\n"),
i + first_choice,
SYMBOL_PRINT_NAME (syms[i].sym),
symtab->filename, SYMBOL_LINE (syms[i].sym));
else if (is_enumeral
&& TYPE_NAME (SYMBOL_TYPE (syms[i].sym)) != NULL)
{
printf_unfiltered (("[%d] "), i + first_choice);
ada_print_type (SYMBOL_TYPE (syms[i].sym), NULL,
gdb_stdout, -1, 0);
printf_unfiltered (_("'(%s) (enumeral)\n"),
SYMBOL_PRINT_NAME (syms[i].sym));
}
else if (symtab != NULL)
printf_unfiltered (is_enumeral
? _("[%d] %s in %s (enumeral)\n")
: _("[%d] %s at %s:?\n"),
i + first_choice,
SYMBOL_PRINT_NAME (syms[i].sym),
symtab->filename);
else
printf_unfiltered (is_enumeral
? _("[%d] %s (enumeral)\n")
: _("[%d] %s at ?\n"),
i + first_choice,
SYMBOL_PRINT_NAME (syms[i].sym));
}
}
n_chosen = get_selections (chosen, nsyms, max_results, max_results > 1,
"overload-choice");
for (i = 0; i < n_chosen; i += 1)
syms[i] = syms[chosen[i]];
return n_chosen;
}
int
get_selections (int *choices, int n_choices, int max_results,
int is_all_choice, char *annotation_suffix)
{
char *args;
const char *prompt;
int n_chosen;
int first_choice = is_all_choice ? 2 : 1;
prompt = getenv ("PS2");
if (prompt == NULL)
prompt = ">";
printf_unfiltered (("%s "), prompt);
gdb_flush (gdb_stdout);
args = command_line_input ((char *) NULL, 0, annotation_suffix);
if (args == NULL)
error_no_arg (_("one or more choice numbers"));
n_chosen = 0;
while (1)
{
char *args2;
int choice, j;
while (isspace (*args))
args += 1;
if (*args == '\0' && n_chosen == 0)
error_no_arg (_("one or more choice numbers"));
else if (*args == '\0')
break;
choice = strtol (args, &args2, 10);
if (args == args2 || choice < 0
|| choice > n_choices + first_choice - 1)
error (_("Argument must be choice number"));
args = args2;
if (choice == 0)
error (_("cancelled"));
if (choice < first_choice)
{
n_chosen = n_choices;
for (j = 0; j < n_choices; j += 1)
choices[j] = j;
break;
}
choice -= first_choice;
for (j = n_chosen - 1; j >= 0 && choice < choices[j]; j -= 1)
{
}
if (j < 0 || choice != choices[j])
{
int k;
for (k = n_chosen - 1; k > j; k -= 1)
choices[k + 1] = choices[k];
choices[j + 1] = choice;
n_chosen += 1;
}
}
if (n_chosen > max_results)
error (_("Select no more than %d of the above"), max_results);
return n_chosen;
}
static void
replace_operator_with_call (struct expression **expp, int pc, int nargs,
int oplen, struct symbol *sym,
struct block *block)
{
struct expression *newexp = (struct expression *)
xmalloc (sizeof (struct expression)
+ EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen));
struct expression *exp = *expp;
newexp->nelts = exp->nelts + 7 - oplen;
newexp->language_defn = exp->language_defn;
memcpy (newexp->elts, exp->elts, EXP_ELEM_TO_BYTES (pc));
memcpy (newexp->elts + pc + 7, exp->elts + pc + oplen,
EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen));
newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode = OP_FUNCALL;
newexp->elts[pc + 1].longconst = (LONGEST) nargs;
newexp->elts[pc + 3].opcode = newexp->elts[pc + 6].opcode = OP_VAR_VALUE;
newexp->elts[pc + 4].block = block;
newexp->elts[pc + 5].symbol = sym;
*expp = newexp;
xfree (exp);
}
static int
numeric_type_p (struct type *type)
{
if (type == NULL)
return 0;
else
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_INT:
case TYPE_CODE_FLT:
return 1;
case TYPE_CODE_RANGE:
return (type == TYPE_TARGET_TYPE (type)
|| numeric_type_p (TYPE_TARGET_TYPE (type)));
default:
return 0;
}
}
}
static int
integer_type_p (struct type *type)
{
if (type == NULL)
return 0;
else
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_INT:
return 1;
case TYPE_CODE_RANGE:
return (type == TYPE_TARGET_TYPE (type)
|| integer_type_p (TYPE_TARGET_TYPE (type)));
default:
return 0;
}
}
}
static int
scalar_type_p (struct type *type)
{
if (type == NULL)
return 0;
else
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_INT:
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
case TYPE_CODE_FLT:
return 1;
default:
return 0;
}
}
}
static int
discrete_type_p (struct type *type)
{
if (type == NULL)
return 0;
else
{
switch (TYPE_CODE (type))
{
case TYPE_CODE_INT:
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
return 1;
default:
return 0;
}
}
}
static int
possible_user_operator_p (enum exp_opcode op, struct value *args[])
{
struct type *type0 =
(args[0] == NULL) ? NULL : ada_check_typedef (value_type (args[0]));
struct type *type1 =
(args[1] == NULL) ? NULL : ada_check_typedef (value_type (args[1]));
if (type0 == NULL)
return 0;
switch (op)
{
default:
return 0;
case BINOP_ADD:
case BINOP_SUB:
case BINOP_MUL:
case BINOP_DIV:
return (!(numeric_type_p (type0) && numeric_type_p (type1)));
case BINOP_REM:
case BINOP_MOD:
case BINOP_BITWISE_AND:
case BINOP_BITWISE_IOR:
case BINOP_BITWISE_XOR:
return (!(integer_type_p (type0) && integer_type_p (type1)));
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
case BINOP_LESS:
case BINOP_GTR:
case BINOP_LEQ:
case BINOP_GEQ:
return (!(scalar_type_p (type0) && scalar_type_p (type1)));
case BINOP_CONCAT:
return
((TYPE_CODE (type0) != TYPE_CODE_ARRAY
&& (TYPE_CODE (type0) != TYPE_CODE_PTR
|| TYPE_CODE (TYPE_TARGET_TYPE (type0)) != TYPE_CODE_ARRAY))
|| (TYPE_CODE (type1) != TYPE_CODE_ARRAY
&& (TYPE_CODE (type1) != TYPE_CODE_PTR
|| (TYPE_CODE (TYPE_TARGET_TYPE (type1))
!= TYPE_CODE_ARRAY))));
case BINOP_EXP:
return (!(numeric_type_p (type0) && integer_type_p (type1)));
case UNOP_NEG:
case UNOP_PLUS:
case UNOP_LOGICAL_NOT:
case UNOP_ABS:
return (!numeric_type_p (type0));
}
}
const char *
ada_renaming_type (struct type *type)
{
if (type != NULL && TYPE_CODE (type) == TYPE_CODE_ENUM)
{
const char *name = type_name_no_tag (type);
const char *suffix = (name == NULL) ? NULL : strstr (name, "___XR");
if (suffix == NULL
|| (suffix[5] != '\000' && strchr ("PES_", suffix[5]) == NULL))
return NULL;
else
return suffix + 3;
}
else
return NULL;
}
int
ada_is_object_renaming (struct symbol *sym)
{
const char *renaming_type = ada_renaming_type (SYMBOL_TYPE (sym));
return renaming_type != NULL
&& (renaming_type[2] == '\0' || renaming_type[2] == '_');
}
char *
ada_simple_renamed_entity (struct symbol *sym)
{
struct type *type;
const char *raw_name;
int len;
char *result;
type = SYMBOL_TYPE (sym);
if (type == NULL || TYPE_NFIELDS (type) < 1)
error (_("Improperly encoded renaming."));
raw_name = TYPE_FIELD_NAME (type, 0);
len = (raw_name == NULL ? 0 : strlen (raw_name)) - 5;
if (len <= 0)
error (_("Improperly encoded renaming."));
result = xmalloc (len + 1);
strncpy (result, raw_name, len);
result[len] = '\000';
return result;
}
static struct value *
ensure_lval (struct value *val, CORE_ADDR *sp)
{
if (! VALUE_LVAL (val))
{
int len = TYPE_LENGTH (ada_check_typedef (value_type (val)));
if (INNER_THAN (1, 2))
{
*sp -= len;
if (gdbarch_frame_align_p (current_gdbarch))
*sp = gdbarch_frame_align (current_gdbarch, *sp);
VALUE_ADDRESS (val) = *sp;
}
else
{
if (gdbarch_frame_align_p (current_gdbarch))
*sp = gdbarch_frame_align (current_gdbarch, *sp);
VALUE_ADDRESS (val) = *sp;
*sp += len;
if (gdbarch_frame_align_p (current_gdbarch))
*sp = gdbarch_frame_align (current_gdbarch, *sp);
}
write_memory (VALUE_ADDRESS (val), value_contents_raw (val), len);
}
return val;
}
static struct value *
convert_actual (struct value *actual, struct type *formal_type0,
CORE_ADDR *sp)
{
struct type *actual_type = ada_check_typedef (value_type (actual));
struct type *formal_type = ada_check_typedef (formal_type0);
struct type *formal_target =
TYPE_CODE (formal_type) == TYPE_CODE_PTR
? ada_check_typedef (TYPE_TARGET_TYPE (formal_type)) : formal_type;
struct type *actual_target =
TYPE_CODE (actual_type) == TYPE_CODE_PTR
? ada_check_typedef (TYPE_TARGET_TYPE (actual_type)) : actual_type;
if (ada_is_array_descriptor_type (formal_target)
&& TYPE_CODE (actual_target) == TYPE_CODE_ARRAY)
return make_array_descriptor (formal_type, actual, sp);
else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR)
{
if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY
&& ada_is_array_descriptor_type (actual_target))
return desc_data (actual);
else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR)
{
if (VALUE_LVAL (actual) != lval_memory)
{
struct value *val;
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));
actual = ensure_lval (val, sp);
}
return value_addr (actual);
}
}
else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR)
return ada_value_ind (actual);
return actual;
}
static struct value *
make_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp)
{
struct type *bounds_type = desc_bounds_type (type);
struct type *desc_type = desc_base_type (type);
struct value *descriptor = allocate_value (desc_type);
struct value *bounds = allocate_value (bounds_type);
int i;
for (i = ada_array_arity (ada_check_typedef (value_type (arr))); i > 0; i -= 1)
{
modify_general_field (value_contents_writeable (bounds),
value_as_long (ada_array_bound (arr, i, 0)),
desc_bound_bitpos (bounds_type, i, 0),
desc_bound_bitsize (bounds_type, i, 0));
modify_general_field (value_contents_writeable (bounds),
value_as_long (ada_array_bound (arr, i, 1)),
desc_bound_bitpos (bounds_type, i, 1),
desc_bound_bitsize (bounds_type, i, 1));
}
bounds = ensure_lval (bounds, sp);
modify_general_field (value_contents_writeable (descriptor),
VALUE_ADDRESS (ensure_lval (arr, sp)),
fat_pntr_data_bitpos (desc_type),
fat_pntr_data_bitsize (desc_type));
modify_general_field (value_contents_writeable (descriptor),
VALUE_ADDRESS (bounds),
fat_pntr_bounds_bitpos (desc_type),
fat_pntr_bounds_bitsize (desc_type));
descriptor = ensure_lval (descriptor, sp);
if (TYPE_CODE (type) == TYPE_CODE_PTR)
return value_addr (descriptor);
else
return descriptor;
}
void
ada_convert_actuals (struct value *func, int nargs, struct value *args[],
CORE_ADDR *sp)
{
int i;
if (TYPE_NFIELDS (value_type (func)) == 0
|| nargs != TYPE_NFIELDS (value_type (func)))
return;
for (i = 0; i < nargs; i += 1)
args[i] =
convert_actual (args[i], TYPE_FIELD_TYPE (value_type (func), i), sp);
}
static int
lookup_cached_symbol (const char *name, domain_enum namespace,
struct symbol **sym, struct block **block,
struct symtab **symtab)
{
return 0;
}
static void
cache_symbol (const char *name, domain_enum namespace, struct symbol *sym,
struct block *block, struct symtab *symtab)
{
}
static struct symbol *
standard_lookup (const char *name, const struct block *block,
domain_enum domain)
{
struct symbol *sym;
struct symtab *symtab;
if (lookup_cached_symbol (name, domain, &sym, NULL, NULL))
return sym;
sym =
lookup_symbol_in_language (name, block, domain, language_c, 0, &symtab);
cache_symbol (name, domain, sym, block_found, symtab);
return sym;
}
static int
is_nonfunction (struct ada_symbol_info syms[], int n)
{
int i;
for (i = 0; i < n; i += 1)
if (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_FUNC
&& (TYPE_CODE (SYMBOL_TYPE (syms[i].sym)) != TYPE_CODE_ENUM
|| SYMBOL_CLASS (syms[i].sym) != LOC_CONST))
return 1;
return 0;
}
static int
equiv_types (struct type *type0, struct type *type1)
{
if (type0 == type1)
return 1;
if (type0 == NULL || type1 == NULL
|| TYPE_CODE (type0) != TYPE_CODE (type1))
return 0;
if ((TYPE_CODE (type0) == TYPE_CODE_STRUCT
|| TYPE_CODE (type0) == TYPE_CODE_ENUM)
&& ada_type_name (type0) != NULL && ada_type_name (type1) != NULL
&& strcmp (ada_type_name (type0), ada_type_name (type1)) == 0)
return 1;
return 0;
}
static int
lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
{
if (sym0 == sym1)
return 1;
if (SYMBOL_DOMAIN (sym0) != SYMBOL_DOMAIN (sym1)
|| SYMBOL_CLASS (sym0) != SYMBOL_CLASS (sym1))
return 0;
switch (SYMBOL_CLASS (sym0))
{
case LOC_UNDEF:
return 1;
case LOC_TYPEDEF:
{
struct type *type0 = SYMBOL_TYPE (sym0);
struct type *type1 = SYMBOL_TYPE (sym1);
char *name0 = SYMBOL_LINKAGE_NAME (sym0);
char *name1 = SYMBOL_LINKAGE_NAME (sym1);
int len0 = strlen (name0);
return
TYPE_CODE (type0) == TYPE_CODE (type1)
&& (equiv_types (type0, type1)
|| (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
&& strncmp (name1 + len0, "___XV", 5) == 0));
}
case LOC_CONST:
return SYMBOL_VALUE (sym0) == SYMBOL_VALUE (sym1)
&& equiv_types (SYMBOL_TYPE (sym0), SYMBOL_TYPE (sym1));
default:
return 0;
}
}
static void
add_defn_to_vec (struct obstack *obstackp,
struct symbol *sym,
struct block *block, struct symtab *symtab)
{
int i;
struct ada_symbol_info *prevDefns = defns_collected (obstackp, 0);
if (SYMBOL_TYPE (sym) != NULL)
SYMBOL_TYPE (sym) = ada_check_typedef (SYMBOL_TYPE (sym));
for (i = num_defns_collected (obstackp) - 1; i >= 0; i -= 1)
{
if (lesseq_defined_than (sym, prevDefns[i].sym))
return;
else if (lesseq_defined_than (prevDefns[i].sym, sym))
{
prevDefns[i].sym = sym;
prevDefns[i].block = block;
prevDefns[i].symtab = symtab;
return;
}
}
{
struct ada_symbol_info info;
info.sym = sym;
info.block = block;
info.symtab = symtab;
obstack_grow (obstackp, &info, sizeof (struct ada_symbol_info));
}
}
static int
num_defns_collected (struct obstack *obstackp)
{
return obstack_object_size (obstackp) / sizeof (struct ada_symbol_info);
}
static struct ada_symbol_info *
defns_collected (struct obstack *obstackp, int finish)
{
if (finish)
return obstack_finish (obstackp);
else
return (struct ada_symbol_info *) obstack_base (obstackp);
}
static struct partial_symbol *
ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
int global, domain_enum namespace, int wild)
{
struct partial_symbol **start;
int name_len = strlen (name);
int length = (global ? pst->n_global_syms : pst->n_static_syms);
int i;
if (length == 0)
{
return (NULL);
}
start = (global ?
pst->objfile->global_psymbols.list + pst->globals_offset :
pst->objfile->static_psymbols.list + pst->statics_offset);
if (wild)
{
for (i = 0; i < length; i += 1)
{
struct partial_symbol *psym = start[i];
if (SYMBOL_DOMAIN (psym) == namespace
&& wild_match (name, name_len, SYMBOL_LINKAGE_NAME (psym)))
return psym;
}
return NULL;
}
else
{
if (global)
{
int U;
i = 0;
U = length - 1;
while (U - i > 4)
{
int M = (U + i) >> 1;
struct partial_symbol *psym = start[M];
if (SYMBOL_LINKAGE_NAME (psym)[0] < name[0])
i = M + 1;
else if (SYMBOL_LINKAGE_NAME (psym)[0] > name[0])
U = M - 1;
else if (strcmp (SYMBOL_LINKAGE_NAME (psym), name) < 0)
i = M + 1;
else
U = M;
}
}
else
i = 0;
while (i < length)
{
struct partial_symbol *psym = start[i];
if (SYMBOL_DOMAIN (psym) == namespace)
{
int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym), name_len);
if (cmp < 0)
{
if (global)
break;
}
else if (cmp == 0
&& is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
+ name_len))
return psym;
}
i += 1;
}
if (global)
{
int U;
i = 0;
U = length - 1;
while (U - i > 4)
{
int M = (U + i) >> 1;
struct partial_symbol *psym = start[M];
if (SYMBOL_LINKAGE_NAME (psym)[0] < '_')
i = M + 1;
else if (SYMBOL_LINKAGE_NAME (psym)[0] > '_')
U = M - 1;
else if (strcmp (SYMBOL_LINKAGE_NAME (psym), "_ada_") < 0)
i = M + 1;
else
U = M;
}
}
else
i = 0;
while (i < length)
{
struct partial_symbol *psym = start[i];
if (SYMBOL_DOMAIN (psym) == namespace)
{
int cmp;
cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (psym)[0];
if (cmp == 0)
{
cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (psym), 5);
if (cmp == 0)
cmp = strncmp (name, SYMBOL_LINKAGE_NAME (psym) + 5,
name_len);
}
if (cmp < 0)
{
if (global)
break;
}
else if (cmp == 0
&& is_name_suffix (SYMBOL_LINKAGE_NAME (psym)
+ name_len + 5))
return psym;
}
i += 1;
}
}
return NULL;
}
static struct symtab *
symtab_for_sym (struct symbol *sym)
{
struct symtab *s;
struct objfile *objfile;
struct block *b;
struct symbol *tmp_sym;
struct dict_iterator iter;
int j;
ALL_SYMTABS (objfile, s)
{
switch (SYMBOL_CLASS (sym))
{
case LOC_CONST:
case LOC_STATIC:
case LOC_TYPEDEF:
case LOC_REGISTER:
case LOC_LABEL:
case LOC_BLOCK:
case LOC_CONST_BYTES:
b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK);
ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
return s;
b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK);
ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
return s;
break;
default:
break;
}
switch (SYMBOL_CLASS (sym))
{
case LOC_REGISTER:
case LOC_ARG:
case LOC_REF_ARG:
case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_LOCAL:
case LOC_TYPEDEF:
case LOC_LOCAL_ARG:
case LOC_BASEREG:
case LOC_BASEREG_ARG:
case LOC_COMPUTED:
case LOC_COMPUTED_ARG:
for (j = FIRST_LOCAL_BLOCK;
j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1)
{
b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), j);
ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym)
return s;
}
break;
default:
break;
}
}
return NULL;
}
struct minimal_symbol *
ada_lookup_simple_minsym (const char *name)
{
struct objfile *objfile;
struct minimal_symbol *msymbol;
int wild_match;
if (strncmp (name, "standard__", sizeof ("standard__") - 1) == 0)
{
name += sizeof ("standard__") - 1;
wild_match = 0;
}
else
wild_match = (strstr (name, "__") == NULL);
ALL_MSYMBOLS (objfile, msymbol)
{
if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match)
&& MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
return msymbol;
}
return NULL;
}
static void
add_symbols_from_enclosing_procs (struct obstack *obstackp,
const char *name, domain_enum namespace,
int wild_match)
{
}
static void
restore_language (void *lang)
{
set_language ((enum language) lang);
}
struct symbol *
lookup_symbol_in_language (const char *name, const struct block *block,
domain_enum domain, enum language lang,
int *is_a_field_of_this, struct symtab **symtab)
{
struct cleanup *old_chain
= make_cleanup (restore_language, (void *) current_language->la_language);
struct symbol *result;
set_language (lang);
result = lookup_symbol (name, block, domain, is_a_field_of_this, symtab);
do_cleanups (old_chain);
return result;
}
static int
is_nondebugging_type (struct type *type)
{
char *name = ada_type_name (type);
return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
}
static int
remove_extra_symbols (struct ada_symbol_info *syms, int nsyms)
{
int i, j;
i = 0;
while (i < nsyms)
{
if (SYMBOL_LINKAGE_NAME (syms[i].sym) != NULL
&& SYMBOL_CLASS (syms[i].sym) == LOC_STATIC
&& is_nondebugging_type (SYMBOL_TYPE (syms[i].sym)))
{
for (j = 0; j < nsyms; j += 1)
{
if (i != j
&& SYMBOL_LINKAGE_NAME (syms[j].sym) != NULL
&& strcmp (SYMBOL_LINKAGE_NAME (syms[i].sym),
SYMBOL_LINKAGE_NAME (syms[j].sym)) == 0
&& SYMBOL_CLASS (syms[i].sym) == SYMBOL_CLASS (syms[j].sym)
&& SYMBOL_VALUE_ADDRESS (syms[i].sym)
== SYMBOL_VALUE_ADDRESS (syms[j].sym))
{
int k;
for (k = i + 1; k < nsyms; k += 1)
syms[k - 1] = syms[k];
nsyms -= 1;
goto NextSymbol;
}
}
}
i += 1;
NextSymbol:
;
}
return nsyms;
}
static char *
xget_renaming_scope (struct type *renaming_type)
{
const char *name = type_name_no_tag (renaming_type);
char *suffix = strstr (name, "___XR");
char *last;
int scope_len;
char *scope;
for (last = suffix - 3; last > name; last--)
if (last[0] == '_' && last[1] == '_')
break;
scope_len = last - name;
scope = (char *) xmalloc ((scope_len + 1) * sizeof (char));
strncpy (scope, name, scope_len);
scope[scope_len] = '\0';
return scope;
}
static int
is_package_name (const char *name)
{
char *fun_name;
if (standard_lookup (name, NULL, VAR_DOMAIN) != NULL)
return 0;
if (strstr (name, "__") != NULL)
return 0;
fun_name = xstrprintf ("_ada_%s", name);
return (standard_lookup (fun_name, NULL, VAR_DOMAIN) == NULL);
}
static int
renaming_is_visible (const struct symbol *sym, char *function_name)
{
char *scope = xget_renaming_scope (SYMBOL_TYPE (sym));
make_cleanup (xfree, scope);
if (is_package_name (scope))
return 1;
if (strncmp (function_name, "_ada_", 5) == 0)
function_name += 5;
return (strncmp (function_name, scope, strlen (scope)) == 0);
}
static int
remove_out_of_scope_renamings (struct ada_symbol_info *syms,
int nsyms, struct block *current_block)
{
struct symbol *current_function;
char *current_function_name;
int i;
if (current_block == NULL)
return nsyms;
current_function = block_function (current_block);
if (current_function == NULL)
return nsyms;
current_function_name = SYMBOL_LINKAGE_NAME (current_function);
if (current_function_name == NULL)
return nsyms;
i = 0;
while (i < nsyms)
{
if (ada_is_object_renaming (syms[i].sym)
&& !renaming_is_visible (syms[i].sym, current_function_name))
{
int j;
for (j = i + 1; j < nsyms; j++)
syms[j - 1] = syms[j];
nsyms -= 1;
}
else
i += 1;
}
return nsyms;
}
int
ada_lookup_symbol_list (const char *name0, const struct block *block0,
domain_enum namespace,
struct ada_symbol_info **results)
{
struct symbol *sym;
struct symtab *s;
struct partial_symtab *ps;
struct blockvector *bv;
struct objfile *objfile;
struct block *block;
const char *name;
struct minimal_symbol *msymbol;
int wild_match;
int cacheIfUnique;
int block_depth;
int ndefns;
obstack_free (&symbol_list_obstack, NULL);
obstack_init (&symbol_list_obstack);
cacheIfUnique = 0;
wild_match = (strstr (name0, "__") == NULL);
name = name0;
block = (struct block *) block0;
if (strncmp (name0, "standard__", sizeof ("standard__") - 1) == 0)
{
wild_match = 0;
block = NULL;
name = name0 + sizeof ("standard__") - 1;
}
block_depth = 0;
while (block != NULL)
{
block_depth += 1;
ada_add_block_symbols (&symbol_list_obstack, block, name,
namespace, NULL, NULL, wild_match);
if (is_nonfunction (defns_collected (&symbol_list_obstack, 0),
num_defns_collected (&symbol_list_obstack)))
goto done;
block = BLOCK_SUPERBLOCK (block);
}
if (num_defns_collected (&symbol_list_obstack) == 0 && block_depth > 2)
add_symbols_from_enclosing_procs (&symbol_list_obstack,
name, namespace, wild_match);
if (num_defns_collected (&symbol_list_obstack) > 0)
goto done;
cacheIfUnique = 1;
if (lookup_cached_symbol (name0, namespace, &sym, &block, &s))
{
if (sym != NULL)
add_defn_to_vec (&symbol_list_obstack, sym, block, s);
goto done;
}
ALL_SYMTABS (objfile, s)
{
QUIT;
if (!s->primary)
continue;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
objfile, s, wild_match);
}
if (namespace == VAR_DOMAIN)
{
ALL_MSYMBOLS (objfile, msymbol)
{
if (ada_match_name (SYMBOL_LINKAGE_NAME (msymbol), name, wild_match))
{
switch (MSYMBOL_TYPE (msymbol))
{
case mst_solib_trampoline:
break;
default:
s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol));
if (s != NULL)
{
int ndefns0 = num_defns_collected (&symbol_list_obstack);
QUIT;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
ada_add_block_symbols (&symbol_list_obstack, block,
SYMBOL_LINKAGE_NAME (msymbol),
namespace, objfile, s, wild_match);
if (num_defns_collected (&symbol_list_obstack) == ndefns0)
{
block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
ada_add_block_symbols (&symbol_list_obstack, block,
SYMBOL_LINKAGE_NAME (msymbol),
namespace, objfile, s,
wild_match);
}
}
}
}
}
}
ALL_PSYMTABS (objfile, ps)
{
QUIT;
if (!ps->readin
&& ada_lookup_partial_symbol (ps, name, 1, namespace, wild_match))
{
s = PSYMTAB_TO_SYMTAB (ps);
if (!s->primary)
continue;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
ada_add_block_symbols (&symbol_list_obstack, block, name,
namespace, objfile, s, wild_match);
}
}
if (num_defns_collected (&symbol_list_obstack) == 0)
{
ALL_SYMTABS (objfile, s)
{
QUIT;
if (!s->primary)
continue;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
ada_add_block_symbols (&symbol_list_obstack, block, name, namespace,
objfile, s, wild_match);
}
ALL_PSYMTABS (objfile, ps)
{
QUIT;
if (!ps->readin
&& ada_lookup_partial_symbol (ps, name, 0, namespace, wild_match))
{
s = PSYMTAB_TO_SYMTAB (ps);
bv = BLOCKVECTOR (s);
if (!s->primary)
continue;
block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
ada_add_block_symbols (&symbol_list_obstack, block, name,
namespace, objfile, s, wild_match);
}
}
}
done:
ndefns = num_defns_collected (&symbol_list_obstack);
*results = defns_collected (&symbol_list_obstack, 1);
ndefns = remove_extra_symbols (*results, ndefns);
if (ndefns == 0)
cache_symbol (name0, namespace, NULL, NULL, NULL);
if (ndefns == 1 && cacheIfUnique)
cache_symbol (name0, namespace, (*results)[0].sym, (*results)[0].block,
(*results)[0].symtab);
ndefns = remove_out_of_scope_renamings (*results, ndefns,
(struct block *) block0);
return ndefns;
}
struct symbol *
ada_lookup_symbol (const char *name, const struct block *block0,
domain_enum namespace, int *is_a_field_of_this,
struct symtab **symtab)
{
struct ada_symbol_info *candidates;
int n_candidates;
n_candidates = ada_lookup_symbol_list (ada_encode (ada_fold_name (name)),
block0, namespace, &candidates);
if (n_candidates == 0)
return NULL;
if (is_a_field_of_this != NULL)
*is_a_field_of_this = 0;
if (symtab != NULL)
{
*symtab = candidates[0].symtab;
if (*symtab == NULL && candidates[0].block != NULL)
{
struct objfile *objfile;
struct symtab *s;
struct block *b;
struct blockvector *bv;
ALL_SYMTABS (objfile, s)
{
CORE_ADDR end;
bv = BLOCKVECTOR (s);
b = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
end = BLOCK_HIGHEST_PC (b);
if (BLOCK_LOWEST_PC (b) <= BLOCK_LOWEST_PC (candidates[0].block)
&& end > BLOCK_LOWEST_PC (candidates[0].block))
{
*symtab = s;
return fixup_symbol_section (candidates[0].sym, objfile);
}
return fixup_symbol_section (candidates[0].sym, NULL);
}
}
}
return candidates[0].sym;
}
static struct symbol *
ada_lookup_symbol_nonlocal (const char *name,
const char *linkage_name,
const struct block *block,
const domain_enum domain, struct symtab **symtab)
{
if (linkage_name == NULL)
linkage_name = name;
return ada_lookup_symbol (linkage_name, block_static_block (block), domain,
NULL, symtab);
}
static int
is_name_suffix (const char *str)
{
int k;
const char *matching;
const int len = strlen (str);
matching = str;
if (len > 3 && str[0] == '_' && str[1] == '_' && isdigit (str[2]))
{
matching += 3;
while (isdigit (matching[0]))
matching += 1;
if (matching[0] == '\0')
return 1;
}
if (matching[0] == '.')
{
matching += 1;
while (isdigit (matching[0]))
matching += 1;
if (matching[0] == '\0')
return 1;
}
if (len > 3 && str[0] == '_' && str[1] == '_' && str[2] == '_')
{
matching = str + 3;
while (isdigit (matching[0]))
matching += 1;
if (matching[0] == '\0')
return 1;
}
if (str[0] == 'X')
{
str += 1;
while (str[0] != '_' && str[0] != '\0')
{
if (str[0] != 'n' && str[0] != 'b')
return 0;
str += 1;
}
}
if (str[0] == '\000')
return 1;
if (str[0] == '_')
{
if (str[1] != '_' || str[2] == '\000')
return 0;
if (str[2] == '_')
{
if (strcmp (str + 3, "JM") == 0)
return 1;
if (strcmp (str + 3, "LJM") == 0)
return 1;
if (str[3] != 'X')
return 0;
if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B'
|| str[4] == 'U' || str[4] == 'P')
return 1;
if (str[4] == 'R' && str[5] != 'T')
return 1;
return 0;
}
if (!isdigit (str[2]))
return 0;
for (k = 3; str[k] != '\0'; k += 1)
if (!isdigit (str[k]) && str[k] != '_')
return 0;
return 1;
}
if (str[0] == '$' && isdigit (str[1]))
{
for (k = 2; str[k] != '\0'; k += 1)
if (!isdigit (str[k]) && str[k] != '_')
return 0;
return 1;
}
return 0;
}
static int
is_dot_digits_suffix (const char *str)
{
if (str[0] != '.')
return 0;
str++;
while (isdigit (str[0]))
str++;
return (str[0] == '\0');
}
static int
wild_match (const char *patn0, int patn_len, const char *name0)
{
int name_len;
char *name;
char *patn;
{
char *dot;
name_len = strlen (name0);
name = (char *) alloca ((name_len + 1) * sizeof (char));
strcpy (name, name0);
dot = strrchr (name, '.');
if (dot != NULL && is_dot_digits_suffix (dot))
*dot = '\0';
patn = (char *) alloca ((patn_len + 1) * sizeof (char));
strncpy (patn, patn0, patn_len);
patn[patn_len] = '\0';
dot = strrchr (patn, '.');
if (dot != NULL && is_dot_digits_suffix (dot))
{
*dot = '\0';
patn_len = dot - patn;
}
}
name_len = strlen (name);
if (name_len >= patn_len + 5 && strncmp (name, "_ada_", 5) == 0
&& strncmp (patn, name + 5, patn_len) == 0
&& is_name_suffix (name + patn_len + 5))
return 1;
while (name_len >= patn_len)
{
if (strncmp (patn, name, patn_len) == 0
&& is_name_suffix (name + patn_len))
return 1;
do
{
name += 1;
name_len -= 1;
}
while (name_len > 0
&& name[0] != '.' && (name[0] != '_' || name[1] != '_'));
if (name_len <= 0)
return 0;
if (name[0] == '_')
{
if (!islower (name[2]))
return 0;
name += 2;
name_len -= 2;
}
else
{
if (!islower (name[1]))
return 0;
name += 1;
name_len -= 1;
}
}
return 0;
}
static void
ada_add_block_symbols (struct obstack *obstackp,
struct block *block, const char *name,
domain_enum domain, struct objfile *objfile,
struct symtab *symtab, int wild)
{
struct dict_iterator iter;
int name_len = strlen (name);
struct symbol *arg_sym;
int found_sym;
struct symbol *sym;
arg_sym = NULL;
found_sym = 0;
if (wild)
{
struct symbol *sym;
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
if (SYMBOL_DOMAIN (sym) == domain
&& wild_match (name, name_len, SYMBOL_LINKAGE_NAME (sym)))
{
switch (SYMBOL_CLASS (sym))
{
case LOC_ARG:
case LOC_LOCAL_ARG:
case LOC_REF_ARG:
case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_BASEREG_ARG:
case LOC_COMPUTED_ARG:
arg_sym = sym;
break;
case LOC_UNRESOLVED:
continue;
default:
found_sym = 1;
add_defn_to_vec (obstackp,
fixup_symbol_section (sym, objfile),
block, symtab);
break;
}
}
}
}
else
{
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
if (SYMBOL_DOMAIN (sym) == domain)
{
int cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym), name_len);
if (cmp == 0
&& is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len))
{
switch (SYMBOL_CLASS (sym))
{
case LOC_ARG:
case LOC_LOCAL_ARG:
case LOC_REF_ARG:
case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_BASEREG_ARG:
case LOC_COMPUTED_ARG:
arg_sym = sym;
break;
case LOC_UNRESOLVED:
break;
default:
found_sym = 1;
add_defn_to_vec (obstackp,
fixup_symbol_section (sym, objfile),
block, symtab);
break;
}
}
}
}
}
if (!found_sym && arg_sym != NULL)
{
add_defn_to_vec (obstackp,
fixup_symbol_section (arg_sym, objfile),
block, symtab);
}
if (!wild)
{
arg_sym = NULL;
found_sym = 0;
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
if (SYMBOL_DOMAIN (sym) == domain)
{
int cmp;
cmp = (int) '_' - (int) SYMBOL_LINKAGE_NAME (sym)[0];
if (cmp == 0)
{
cmp = strncmp ("_ada_", SYMBOL_LINKAGE_NAME (sym), 5);
if (cmp == 0)
cmp = strncmp (name, SYMBOL_LINKAGE_NAME (sym) + 5,
name_len);
}
if (cmp == 0
&& is_name_suffix (SYMBOL_LINKAGE_NAME (sym) + name_len + 5))
{
switch (SYMBOL_CLASS (sym))
{
case LOC_ARG:
case LOC_LOCAL_ARG:
case LOC_REF_ARG:
case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_BASEREG_ARG:
case LOC_COMPUTED_ARG:
arg_sym = sym;
break;
case LOC_UNRESOLVED:
break;
default:
found_sym = 1;
add_defn_to_vec (obstackp,
fixup_symbol_section (sym, objfile),
block, symtab);
break;
}
}
}
}
if (!found_sym && arg_sym != NULL)
{
add_defn_to_vec (obstackp,
fixup_symbol_section (arg_sym, objfile),
block, symtab);
}
}
}
int
ada_is_ignored_field (struct type *type, int field_num)
{
if (field_num < 0 || field_num > TYPE_NFIELDS (type))
return 1;
else
{
const char *name = TYPE_FIELD_NAME (type, field_num);
return (name == NULL
|| (name[0] == '_' && strncmp (name, "_parent", 7) != 0));
}
}
int
ada_is_tagged_type (struct type *type, int refok)
{
return (ada_lookup_struct_elt_type (type, "_tag", refok, 1, NULL) != NULL);
}
int
ada_is_tag_type (struct type *type)
{
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_PTR)
return 0;
else
{
const char *name = ada_type_name (TYPE_TARGET_TYPE (type));
return (name != NULL
&& strcmp (name, "ada__tags__dispatch_table") == 0);
}
}
struct type *
ada_tag_type (struct value *val)
{
return ada_lookup_struct_elt_type (value_type (val), "_tag", 1, 0, NULL);
}
struct value *
ada_value_tag (struct value *val)
{
return ada_value_struct_elt (val, "_tag", "record");
}
static struct value *
value_tag_from_contents_and_address (struct type *type,
const gdb_byte *valaddr,
CORE_ADDR address)
{
int tag_byte_offset, dummy1, dummy2;
struct type *tag_type;
if (find_struct_field ("_tag", type, 0, &tag_type, &tag_byte_offset,
&dummy1, &dummy2))
{
const gdb_byte *valaddr1 = ((valaddr == NULL)
? NULL
: valaddr + tag_byte_offset);
CORE_ADDR address1 = (address == 0) ? 0 : address + tag_byte_offset;
return value_from_contents_and_address (tag_type, valaddr1, address1);
}
return NULL;
}
static struct type *
type_from_tag (struct value *tag)
{
const char *type_name = ada_tag_name (tag);
if (type_name != NULL)
return ada_find_any_type (ada_encode (type_name));
return NULL;
}
struct tag_args
{
struct value *tag;
char *name;
};
static int
ada_tag_name_1 (void *args0)
{
struct tag_args *args = (struct tag_args *) args0;
static char name[1024];
char *p;
struct value *val;
args->name = NULL;
val = ada_value_struct_elt (args->tag, "tsd", NULL);
if (val == NULL)
return 0;
val = ada_value_struct_elt (val, "expanded_name", NULL);
if (val == NULL)
return 0;
read_memory_string (value_as_address (val), name, sizeof (name) - 1);
for (p = name; *p != '\0'; p += 1)
if (isalpha (*p))
*p = tolower (*p);
args->name = name;
return 0;
}
const char *
ada_tag_name (struct value *tag)
{
struct tag_args args;
if (!ada_is_tag_type (value_type (tag)))
return NULL;
args.tag = tag;
args.name = NULL;
catch_errors (ada_tag_name_1, &args, NULL, RETURN_MASK_ALL);
return args.name;
}
struct type *
ada_parent_type (struct type *type)
{
int i;
type = ada_check_typedef (type);
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT)
return NULL;
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
if (ada_is_parent_field (type, i))
return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
return NULL;
}
int
ada_is_parent_field (struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (ada_check_typedef (type), field_num);
return (name != NULL
&& (strncmp (name, "PARENT", 6) == 0
|| strncmp (name, "_parent", 7) == 0));
}
int
ada_is_wrapper_field (struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (type, field_num);
return (name != NULL
&& (strncmp (name, "PARENT", 6) == 0
|| strcmp (name, "REP") == 0
|| strncmp (name, "_parent", 7) == 0
|| name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
}
int
ada_is_variant_part (struct type *type, int field_num)
{
struct type *field_type = TYPE_FIELD_TYPE (type, field_num);
return (TYPE_CODE (field_type) == TYPE_CODE_UNION
|| (is_dynamic_field (type, field_num)
&& (TYPE_CODE (TYPE_TARGET_TYPE (field_type))
== TYPE_CODE_UNION)));
}
struct type *
ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
{
char *name = ada_variant_discrim_name (var_type);
struct type *type =
ada_lookup_struct_elt_type (outer_type, name, 1, 1, NULL);
if (type == NULL)
return builtin_type_int;
else
return type;
}
int
ada_is_others_clause (struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (type, field_num);
return (name != NULL && name[0] == 'O');
}
char *
ada_variant_discrim_name (struct type *type0)
{
static char *result = NULL;
static size_t result_len = 0;
struct type *type;
const char *name;
const char *discrim_end;
const char *discrim_start;
if (TYPE_CODE (type0) == TYPE_CODE_PTR)
type = TYPE_TARGET_TYPE (type0);
else
type = type0;
name = ada_type_name (type);
if (name == NULL || name[0] == '\000')
return "";
for (discrim_end = name + strlen (name) - 6; discrim_end != name;
discrim_end -= 1)
{
if (strncmp (discrim_end, "___XVN", 6) == 0)
break;
}
if (discrim_end == name)
return "";
for (discrim_start = discrim_end; discrim_start != name + 3;
discrim_start -= 1)
{
if (discrim_start == name + 1)
return "";
if ((discrim_start > name + 3
&& strncmp (discrim_start - 3, "___", 3) == 0)
|| discrim_start[-1] == '.')
break;
}
GROW_VECT (result, result_len, discrim_end - discrim_start + 1);
strncpy (result, discrim_start, discrim_end - discrim_start);
result[discrim_end - discrim_start] = '\0';
return result;
}
int
ada_scan_number (const char str[], int k, LONGEST * R, int *new_k)
{
ULONGEST RU;
if (!isdigit (str[k]))
return 0;
RU = 0;
while (isdigit (str[k]))
{
RU = RU * 10 + (str[k] - '0');
k += 1;
}
if (str[k] == 'm')
{
if (R != NULL)
*R = (-(LONGEST) (RU - 1)) - 1;
k += 1;
}
else if (R != NULL)
*R = (LONGEST) RU;
if (new_k != NULL)
*new_k = k;
return 1;
}
int
ada_in_variant (LONGEST val, struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (type, field_num);
int p;
p = 0;
while (1)
{
switch (name[p])
{
case '\0':
return 0;
case 'S':
{
LONGEST W;
if (!ada_scan_number (name, p + 1, &W, &p))
return 0;
if (val == W)
return 1;
break;
}
case 'R':
{
LONGEST L, U;
if (!ada_scan_number (name, p + 1, &L, &p)
|| name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
return 0;
if (val >= L && val <= U)
return 1;
break;
}
case 'O':
return 1;
default:
return 0;
}
}
}
static struct value *
ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
struct type *arg_type)
{
struct type *type;
arg_type = ada_check_typedef (arg_type);
type = TYPE_FIELD_TYPE (arg_type, fieldno);
if (TYPE_FIELD_BITSIZE (arg_type, fieldno) != 0)
{
int bit_pos = TYPE_FIELD_BITPOS (arg_type, fieldno);
int bit_size = TYPE_FIELD_BITSIZE (arg_type, fieldno);
return ada_value_primitive_packed_val (arg1, value_contents (arg1),
offset + bit_pos / 8,
bit_pos % 8, bit_size, type);
}
else
return value_primitive_field (arg1, offset, fieldno, arg_type);
}
static int
find_struct_field (char *name, struct type *type, int offset,
struct type **field_type_p,
int *byte_offset_p, int *bit_offset_p, int *bit_size_p)
{
int i;
type = ada_check_typedef (type);
*field_type_p = NULL;
*byte_offset_p = *bit_offset_p = *bit_size_p = 0;
for (i = TYPE_NFIELDS (type) - 1; i >= 0; i -= 1)
{
int bit_pos = TYPE_FIELD_BITPOS (type, i);
int fld_offset = offset + bit_pos / 8;
char *t_field_name = TYPE_FIELD_NAME (type, i);
if (t_field_name == NULL)
continue;
else if (field_name_match (t_field_name, name))
{
int bit_size = TYPE_FIELD_BITSIZE (type, i);
*field_type_p = TYPE_FIELD_TYPE (type, i);
*byte_offset_p = fld_offset;
*bit_offset_p = bit_pos % 8;
*bit_size_p = bit_size;
return 1;
}
else if (ada_is_wrapper_field (type, i))
{
if (find_struct_field (name, TYPE_FIELD_TYPE (type, i), fld_offset,
field_type_p, byte_offset_p, bit_offset_p,
bit_size_p))
return 1;
}
else if (ada_is_variant_part (type, i))
{
int j;
struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
{
if (find_struct_field (name, TYPE_FIELD_TYPE (field_type, j),
fld_offset
+ TYPE_FIELD_BITPOS (field_type, j) / 8,
field_type_p, byte_offset_p,
bit_offset_p, bit_size_p))
return 1;
}
}
}
return 0;
}
static struct value *
ada_search_struct_field (char *name, struct value *arg, int offset,
struct type *type)
{
int i;
type = ada_check_typedef (type);
for (i = TYPE_NFIELDS (type) - 1; i >= 0; i -= 1)
{
char *t_field_name = TYPE_FIELD_NAME (type, i);
if (t_field_name == NULL)
continue;
else if (field_name_match (t_field_name, name))
return ada_value_primitive_field (arg, offset, i, type);
else if (ada_is_wrapper_field (type, i))
{
struct value *v =
ada_search_struct_field (name, arg,
offset + TYPE_FIELD_BITPOS (type, i) / 8,
TYPE_FIELD_TYPE (type, i));
if (v != NULL)
return v;
}
else if (ada_is_variant_part (type, i))
{
int j;
struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8;
for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
{
struct value *v = ada_search_struct_field
(name, arg,
var_offset + TYPE_FIELD_BITPOS (field_type, j) / 8,
TYPE_FIELD_TYPE (field_type, j));
if (v != NULL)
return v;
}
}
}
return NULL;
}
struct value *
ada_value_struct_elt (struct value *arg, char *name, char *err)
{
struct type *t, *t1;
struct value *v;
v = NULL;
t1 = t = ada_check_typedef (value_type (arg));
if (TYPE_CODE (t) == TYPE_CODE_REF)
{
t1 = TYPE_TARGET_TYPE (t);
if (t1 == NULL)
{
if (err == NULL)
return NULL;
else
error (_("Bad value type in a %s."), err);
}
t1 = ada_check_typedef (t1);
if (TYPE_CODE (t1) == TYPE_CODE_PTR)
{
arg = coerce_ref (arg);
t = t1;
}
}
while (TYPE_CODE (t) == TYPE_CODE_PTR)
{
t1 = TYPE_TARGET_TYPE (t);
if (t1 == NULL)
{
if (err == NULL)
return NULL;
else
error (_("Bad value type in a %s."), err);
}
t1 = ada_check_typedef (t1);
if (TYPE_CODE (t1) == TYPE_CODE_PTR)
{
arg = value_ind (arg);
t = t1;
}
else
break;
}
if (TYPE_CODE (t1) != TYPE_CODE_STRUCT && TYPE_CODE (t1) != TYPE_CODE_UNION)
{
if (err == NULL)
return NULL;
else
error (_("Attempt to extract a component of a value that is not a %s."),
err);
}
if (t1 == t)
v = ada_search_struct_field (name, arg, 0, t);
else
{
int bit_offset, bit_size, byte_offset;
struct type *field_type;
CORE_ADDR address;
if (TYPE_CODE (t) == TYPE_CODE_PTR)
address = value_as_address (arg);
else
address = unpack_pointer (t, value_contents (arg));
t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL, address, NULL);
if (find_struct_field (name, t1, 0,
&field_type, &byte_offset, &bit_offset,
&bit_size))
{
if (bit_size != 0)
{
if (TYPE_CODE (t) == TYPE_CODE_REF)
arg = ada_coerce_ref (arg);
else
arg = ada_value_ind (arg);
v = ada_value_primitive_packed_val (arg, NULL, byte_offset,
bit_offset, bit_size,
field_type);
}
else
v = value_from_pointer (lookup_reference_type (field_type),
address + byte_offset);
}
}
if (v == NULL && err != NULL)
error (_("There is no member named %s."), name);
return v;
}
static struct type *
ada_lookup_struct_elt_type (struct type *type, char *name, int refok,
int noerr, int *dispp)
{
int i;
if (name == NULL)
goto BadName;
if (refok && type != NULL)
while (1)
{
type = ada_check_typedef (type);
if (TYPE_CODE (type) != TYPE_CODE_PTR
&& TYPE_CODE (type) != TYPE_CODE_REF)
break;
type = TYPE_TARGET_TYPE (type);
}
if (type == NULL
|| (TYPE_CODE (type) != TYPE_CODE_STRUCT
&& TYPE_CODE (type) != TYPE_CODE_UNION))
{
if (noerr)
return NULL;
else
{
target_terminal_ours ();
gdb_flush (gdb_stdout);
if (type == NULL)
error (_("Type (null) is not a structure or union type"));
else
{
fprintf_unfiltered (gdb_stderr, _("Type "));
type_print (type, "", gdb_stderr, -1);
error (_(" is not a structure or union type"));
}
}
}
type = to_static_fixed_type (type);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
char *t_field_name = TYPE_FIELD_NAME (type, i);
struct type *t;
int disp;
if (t_field_name == NULL)
continue;
else if (field_name_match (t_field_name, name))
{
if (dispp != NULL)
*dispp += TYPE_FIELD_BITPOS (type, i) / 8;
return ada_check_typedef (TYPE_FIELD_TYPE (type, i));
}
else if (ada_is_wrapper_field (type, i))
{
disp = 0;
t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name,
0, 1, &disp);
if (t != NULL)
{
if (dispp != NULL)
*dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
return t;
}
}
else if (ada_is_variant_part (type, i))
{
int j;
struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type, i));
for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1)
{
disp = 0;
t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j),
name, 0, 1, &disp);
if (t != NULL)
{
if (dispp != NULL)
*dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8;
return t;
}
}
}
}
BadName:
if (!noerr)
{
target_terminal_ours ();
gdb_flush (gdb_stdout);
if (name == NULL)
{
fprintf_unfiltered (gdb_stderr, _("Type "));
type_print (type, "", gdb_stderr, -1);
error (_(" has no component named <null>"));
}
else
{
fprintf_unfiltered (gdb_stderr, _("Type "));
type_print (type, "", gdb_stderr, -1);
error (_(" has no component named %s"), name);
}
}
return NULL;
}
int
ada_which_variant_applies (struct type *var_type, struct type *outer_type,
const gdb_byte *outer_valaddr)
{
int others_clause;
int i;
int disp;
struct type *discrim_type;
char *discrim_name = ada_variant_discrim_name (var_type);
LONGEST discrim_val;
disp = 0;
discrim_type =
ada_lookup_struct_elt_type (outer_type, discrim_name, 1, 1, &disp);
if (discrim_type == NULL)
return -1;
discrim_val = unpack_long (discrim_type, outer_valaddr + disp);
others_clause = -1;
for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
{
if (ada_is_others_clause (var_type, i))
others_clause = i;
else if (ada_in_variant (discrim_val, var_type, i))
return i;
}
return others_clause;
}
struct value *
ada_value_ind (struct value *val0)
{
struct value *val = unwrap_value (value_ind (val0));
return ada_to_fixed_value (val);
}
static struct value *
ada_coerce_ref (struct value *val0)
{
if (TYPE_CODE (value_type (val0)) == TYPE_CODE_REF)
{
struct value *val = val0;
val = coerce_ref (val);
val = unwrap_value (val);
return ada_to_fixed_value (val);
}
else
return val0;
}
static unsigned int
align_value (unsigned int off, unsigned int alignment)
{
return (off + alignment - 1) & ~(alignment - 1);
}
static unsigned int
field_alignment (struct type *type, int f)
{
const char *name = TYPE_FIELD_NAME (type, f);
int len = (name == NULL) ? 0 : strlen (name);
int align_offset;
if (!isdigit (name[len - 1]))
return 1;
if (isdigit (name[len - 2]))
align_offset = len - 2;
else
align_offset = len - 1;
if (align_offset < 7 || strncmp ("___XV", name + align_offset - 6, 5) != 0)
return TARGET_CHAR_BIT;
return atoi (name + align_offset) * TARGET_CHAR_BIT;
}
struct symbol *
ada_find_any_symbol (const char *name)
{
struct symbol *sym;
sym = standard_lookup (name, get_selected_block (NULL), VAR_DOMAIN);
if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
return sym;
sym = standard_lookup (name, NULL, STRUCT_DOMAIN);
return sym;
}
struct type *
ada_find_any_type (const char *name)
{
struct symbol *sym = ada_find_any_symbol (name);
if (sym != NULL)
return SYMBOL_TYPE (sym);
return NULL;
}
struct symbol *
ada_find_renaming_symbol (const char *name, struct block *block)
{
const struct symbol *function_sym = block_function (block);
char *rename;
if (function_sym != NULL)
{
char *function_name = SYMBOL_LINKAGE_NAME (function_sym);
const int function_name_len = strlen (function_name);
const int rename_len = function_name_len + 2
+ strlen (name) + 6 ;
if (function_name_len > 5
&& strstr (function_name, "_ada_") == function_name)
function_name = function_name + 5;
rename = (char *) alloca (rename_len * sizeof (char));
sprintf (rename, "%s__%s___XR", function_name, name);
}
else
{
const int rename_len = strlen (name) + 6;
rename = (char *) alloca (rename_len * sizeof (char));
sprintf (rename, "%s___XR", name);
}
return ada_find_any_symbol (rename);
}
int
ada_prefer_type (struct type *type0, struct type *type1)
{
if (type1 == NULL)
return 1;
else if (type0 == NULL)
return 0;
else if (TYPE_CODE (type1) == TYPE_CODE_VOID)
return 1;
else if (TYPE_CODE (type0) == TYPE_CODE_VOID)
return 0;
else if (TYPE_NAME (type1) == NULL && TYPE_NAME (type0) != NULL)
return 1;
else if (ada_is_packed_array_type (type0))
return 1;
else if (ada_is_array_descriptor_type (type0)
&& !ada_is_array_descriptor_type (type1))
return 1;
else if (ada_renaming_type (type0) != NULL
&& ada_renaming_type (type1) == NULL)
return 1;
return 0;
}
char *
ada_type_name (struct type *type)
{
if (type == NULL)
return NULL;
else if (TYPE_NAME (type) != NULL)
return TYPE_NAME (type);
else
return TYPE_TAG_NAME (type);
}
struct type *
ada_find_parallel_type (struct type *type, const char *suffix)
{
static char *name;
static size_t name_len = 0;
int len;
char *typename = ada_type_name (type);
if (typename == NULL)
return NULL;
len = strlen (typename);
GROW_VECT (name, name_len, len + strlen (suffix) + 1);
strcpy (name, typename);
strcpy (name + len, suffix);
return ada_find_any_type (name);
}
static struct type *
dynamic_template_type (struct type *type)
{
type = ada_check_typedef (type);
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT
|| ada_type_name (type) == NULL)
return NULL;
else
{
int len = strlen (ada_type_name (type));
if (len > 6 && strcmp (ada_type_name (type) + len - 6, "___XVE") == 0)
return type;
else
return ada_find_parallel_type (type, "___XVE");
}
}
static int
is_dynamic_field (struct type *templ_type, int field_num)
{
const char *name = TYPE_FIELD_NAME (templ_type, field_num);
return name != NULL
&& TYPE_CODE (TYPE_FIELD_TYPE (templ_type, field_num)) == TYPE_CODE_PTR
&& strstr (name, "___XVL") != NULL;
}
static int
variant_field_index (struct type *type)
{
int f;
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT)
return -1;
for (f = 0; f < TYPE_NFIELDS (type); f += 1)
{
if (ada_is_variant_part (type, f))
return f;
}
return -1;
}
static struct type *
empty_record (struct objfile *objfile)
{
struct type *type = alloc_type (objfile);
TYPE_CODE (type) = TYPE_CODE_STRUCT;
TYPE_NFIELDS (type) = 0;
TYPE_FIELDS (type) = NULL;
TYPE_NAME (type) = "<empty>";
TYPE_TAG_NAME (type) = NULL;
TYPE_FLAGS (type) = 0;
TYPE_LENGTH_ASSIGN (type) = 0;
return type;
}
struct type *
ada_template_to_fixed_record_type_1 (struct type *type,
const gdb_byte *valaddr,
CORE_ADDR address, struct value *dval0,
int keep_dynamic_fields)
{
struct value *mark = value_mark ();
struct value *dval;
struct type *rtype;
int nfields, bit_len;
int variant_field;
long off;
int fld_bit_len, bit_incr;
int f;
if (keep_dynamic_fields)
nfields = TYPE_NFIELDS (type);
else
{
nfields = 0;
while (nfields < TYPE_NFIELDS (type)
&& !ada_is_variant_part (type, nfields)
&& !is_dynamic_field (type, nfields))
nfields++;
}
rtype = alloc_type (TYPE_OBJFILE (type));
TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
INIT_CPLUS_SPECIFIC (rtype);
TYPE_NFIELDS (rtype) = nfields;
TYPE_FIELDS (rtype) = (struct field *)
TYPE_ALLOC (rtype, nfields * sizeof (struct field));
memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields);
TYPE_NAME (rtype) = ada_type_name (type);
TYPE_TAG_NAME (rtype) = NULL;
TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
off = 0;
bit_len = 0;
variant_field = -1;
for (f = 0; f < nfields; f += 1)
{
off = align_value (off, field_alignment (type, f))
+ TYPE_FIELD_BITPOS (type, f);
TYPE_FIELD_BITPOS_ASSIGN (rtype, f) = off;
TYPE_FIELD_BITSIZE (rtype, f) = 0;
if (ada_is_variant_part (type, f))
{
variant_field = f;
fld_bit_len = bit_incr = 0;
}
else if (is_dynamic_field (type, f))
{
if (dval0 == NULL)
dval = value_from_contents_and_address (rtype, valaddr, address);
else
dval = dval0;
TYPE_FIELD_TYPE (rtype, f) =
ada_to_fixed_type
(ada_get_base_type
(TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f))),
cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
bit_incr = fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
}
else
{
TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f);
TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f);
if (TYPE_FIELD_BITSIZE (type, f) > 0)
bit_incr = fld_bit_len =
TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f);
else
bit_incr = fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (type, f)) * TARGET_CHAR_BIT;
}
if (off + fld_bit_len > bit_len)
bit_len = off + fld_bit_len;
off += bit_incr;
TYPE_LENGTH_ASSIGN (rtype) =
align_value (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
}
if (variant_field >= 0)
{
struct type *branch_type;
off = TYPE_FIELD_BITPOS (rtype, variant_field);
if (dval0 == NULL)
dval = value_from_contents_and_address (rtype, valaddr, address);
else
dval = dval0;
branch_type =
to_fixed_variant_branch_type
(TYPE_FIELD_TYPE (type, variant_field),
cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
{
for (f = variant_field + 1; f < TYPE_NFIELDS (rtype); f += 1)
TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
TYPE_NFIELDS (rtype) -= 1;
}
else
{
TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
TYPE_FIELD_NAME (rtype, variant_field) = "S";
fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, variant_field)) *
TARGET_CHAR_BIT;
if (off + fld_bit_len > bit_len)
bit_len = off + fld_bit_len;
TYPE_LENGTH_ASSIGN (rtype) =
align_value (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT;
}
}
if (TYPE_LENGTH (type) <= 0)
{
if (TYPE_NAME (rtype))
warning (_("Invalid type size for `%s' detected: %d."),
TYPE_NAME (rtype), TYPE_LENGTH (type));
else
warning (_("Invalid type size for <unnamed> detected: %d."),
TYPE_LENGTH (type));
}
else
{
TYPE_LENGTH_ASSIGN (rtype) = align_value (TYPE_LENGTH (rtype),
TYPE_LENGTH (type));
}
value_free_to_mark (mark);
if (TYPE_LENGTH (rtype) > varsize_limit)
error (_("record type with dynamic size is larger than varsize-limit"));
return rtype;
}
static struct type *
template_to_fixed_record_type (struct type *type, const gdb_byte *valaddr,
CORE_ADDR address, struct value *dval0)
{
return ada_template_to_fixed_record_type_1 (type, valaddr,
address, dval0, 1);
}
static struct type *
template_to_static_fixed_type (struct type *type0)
{
struct type *type;
int nfields;
int f;
if (TYPE_TARGET_TYPE (type0) != NULL)
return TYPE_TARGET_TYPE (type0);
nfields = TYPE_NFIELDS (type0);
type = type0;
for (f = 0; f < nfields; f += 1)
{
struct type *field_type = ada_check_typedef (TYPE_FIELD_TYPE (type0, f));
struct type *new_type;
if (is_dynamic_field (type0, f))
new_type = to_static_fixed_type (TYPE_TARGET_TYPE (field_type));
else
new_type = to_static_fixed_type (field_type);
if (type == type0 && new_type != field_type)
{
TYPE_TARGET_TYPE (type0) = type = alloc_type (TYPE_OBJFILE (type0));
TYPE_CODE (type) = TYPE_CODE (type0);
INIT_CPLUS_SPECIFIC (type);
TYPE_NFIELDS (type) = nfields;
TYPE_FIELDS (type) = (struct field *)
TYPE_ALLOC (type, nfields * sizeof (struct field));
memcpy (TYPE_FIELDS (type), TYPE_FIELDS (type0),
sizeof (struct field) * nfields);
TYPE_NAME (type) = ada_type_name (type0);
TYPE_TAG_NAME (type) = NULL;
TYPE_FLAGS (type) |= TYPE_FLAG_FIXED_INSTANCE;
TYPE_LENGTH_ASSIGN (type) = 0;
}
TYPE_FIELD_TYPE (type, f) = new_type;
TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (type0, f);
}
return type;
}
static struct type *
to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
CORE_ADDR address, struct value *dval0)
{
struct value *mark = value_mark ();
struct value *dval;
struct type *rtype;
struct type *branch_type;
int nfields = TYPE_NFIELDS (type);
int variant_field = variant_field_index (type);
if (variant_field == -1)
return type;
if (dval0 == NULL)
dval = value_from_contents_and_address (type, valaddr, address);
else
dval = dval0;
rtype = alloc_type (TYPE_OBJFILE (type));
TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
INIT_CPLUS_SPECIFIC (rtype);
TYPE_NFIELDS (rtype) = nfields;
TYPE_FIELDS (rtype) =
(struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type),
sizeof (struct field) * nfields);
TYPE_NAME (rtype) = ada_type_name (type);
TYPE_TAG_NAME (rtype) = NULL;
TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE;
TYPE_LENGTH_ASSIGN (rtype) = TYPE_LENGTH (type);
branch_type = to_fixed_variant_branch_type
(TYPE_FIELD_TYPE (type, variant_field),
cond_offset_host (valaddr,
TYPE_FIELD_BITPOS (type, variant_field)
/ TARGET_CHAR_BIT),
cond_offset_target (address,
TYPE_FIELD_BITPOS (type, variant_field)
/ TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
{
int f;
for (f = variant_field + 1; f < nfields; f += 1)
TYPE_FIELDS (rtype)[f - 1] = TYPE_FIELDS (rtype)[f];
TYPE_NFIELDS (rtype) -= 1;
}
else
{
TYPE_FIELD_TYPE (rtype, variant_field) = branch_type;
TYPE_FIELD_NAME (rtype, variant_field) = "S";
TYPE_FIELD_BITSIZE (rtype, variant_field) = 0;
TYPE_LENGTH_ASSIGN (rtype) += TYPE_LENGTH (branch_type);
}
TYPE_LENGTH_ASSIGN (rtype) -= TYPE_LENGTH (TYPE_FIELD_TYPE (type, variant_field));
value_free_to_mark (mark);
return rtype;
}
static struct type *
to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
CORE_ADDR address, struct value *dval)
{
struct type *templ_type;
if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
return type0;
templ_type = dynamic_template_type (type0);
if (templ_type != NULL)
return template_to_fixed_record_type (templ_type, valaddr, address, dval);
else if (variant_field_index (type0) >= 0)
{
if (dval == NULL && valaddr == NULL && address == 0)
return type0;
return to_record_with_fixed_variant_part (type0, valaddr, address,
dval);
}
else
{
TYPE_FLAGS (type0) |= TYPE_FLAG_FIXED_INSTANCE;
return type0;
}
}
static struct type *
to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
CORE_ADDR address, struct value *dval)
{
int which;
struct type *templ_type;
struct type *var_type;
if (TYPE_CODE (var_type0) == TYPE_CODE_PTR)
var_type = TYPE_TARGET_TYPE (var_type0);
else
var_type = var_type0;
templ_type = ada_find_parallel_type (var_type, "___XVU");
if (templ_type != NULL)
var_type = templ_type;
which =
ada_which_variant_applies (var_type,
value_type (dval), value_contents (dval));
if (which < 0)
return empty_record (TYPE_OBJFILE (var_type));
else if (is_dynamic_field (var_type, which))
return to_fixed_record_type
(TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)),
valaddr, address, dval);
else if (variant_field_index (TYPE_FIELD_TYPE (var_type, which)) >= 0)
return
to_fixed_record_type
(TYPE_FIELD_TYPE (var_type, which), valaddr, address, dval);
else
return TYPE_FIELD_TYPE (var_type, which);
}
static struct type *
to_fixed_array_type (struct type *type0, struct value *dval,
int ignore_too_big)
{
struct type *index_type_desc;
struct type *result;
if (ada_is_packed_array_type (type0)
|| (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE))
return type0;
index_type_desc = ada_find_parallel_type (type0, "___XA");
if (index_type_desc == NULL)
{
struct type *elt_type0 = ada_check_typedef (TYPE_TARGET_TYPE (type0));
struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval);
if (elt_type0 == elt_type)
result = type0;
else
result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
elt_type, TYPE_INDEX_TYPE (type0));
}
else
{
int i;
struct type *elt_type0;
elt_type0 = type0;
for (i = TYPE_NFIELDS (index_type_desc); i > 0; i -= 1)
elt_type0 = TYPE_TARGET_TYPE (elt_type0);
result = ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval);
for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1)
{
struct type *range_type =
to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i),
dval, TYPE_OBJFILE (type0));
result = create_array_type (alloc_type (TYPE_OBJFILE (type0)),
result, range_type);
}
if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit)
error (_("array type with dynamic size is larger than varsize-limit"));
}
TYPE_FLAGS (result) |= TYPE_FLAG_FIXED_INSTANCE;
return result;
}
struct type *
ada_to_fixed_type (struct type *type, const gdb_byte *valaddr,
CORE_ADDR address, struct value *dval)
{
type = ada_check_typedef (type);
switch (TYPE_CODE (type))
{
default:
return type;
case TYPE_CODE_STRUCT:
{
struct type *static_type = to_static_fixed_type (type);
if (ada_is_tagged_type (static_type, 0))
{
struct type *real_type =
type_from_tag (value_tag_from_contents_and_address (static_type,
valaddr,
address));
if (real_type != NULL)
type = real_type;
}
return to_fixed_record_type (type, valaddr, address, NULL);
}
case TYPE_CODE_ARRAY:
return to_fixed_array_type (type, dval, 1);
case TYPE_CODE_UNION:
if (dval == NULL)
return type;
else
return to_fixed_variant_branch_type (type, valaddr, address, dval);
}
}
static struct type *
to_static_fixed_type (struct type *type0)
{
struct type *type;
if (type0 == NULL)
return NULL;
if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)
return type0;
type0 = ada_check_typedef (type0);
switch (TYPE_CODE (type0))
{
default:
return type0;
case TYPE_CODE_STRUCT:
type = dynamic_template_type (type0);
if (type != NULL)
return template_to_static_fixed_type (type);
else
return template_to_static_fixed_type (type0);
case TYPE_CODE_UNION:
type = ada_find_parallel_type (type0, "___XVU");
if (type != NULL)
return template_to_static_fixed_type (type);
else
return template_to_static_fixed_type (type0);
}
}
static struct type *
static_unwrap_type (struct type *type)
{
if (ada_is_aligner_type (type))
{
struct type *type1 = TYPE_FIELD_TYPE (ada_check_typedef (type), 0);
if (ada_type_name (type1) == NULL)
TYPE_NAME (type1) = ada_type_name (type);
return static_unwrap_type (type1);
}
else
{
struct type *raw_real_type = ada_get_base_type (type);
if (raw_real_type == type)
return type;
else
return to_static_fixed_type (raw_real_type);
}
}
struct type *
ada_check_typedef (struct type *type)
{
CHECK_TYPEDEF (type);
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM
|| (TYPE_FLAGS (type) & TYPE_FLAG_STUB) == 0
|| TYPE_TAG_NAME (type) == NULL)
return type;
else
{
char *name = TYPE_TAG_NAME (type);
struct type *type1 = ada_find_any_type (name);
return (type1 == NULL) ? type : type1;
}
}
static struct value *
ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
struct value *val0)
{
struct type *type = ada_to_fixed_type (type0, 0, address, NULL);
if (type == type0 && val0 != NULL)
return val0;
else
return value_from_contents_and_address (type, 0, address);
}
static struct value *
ada_to_fixed_value (struct value *val)
{
return ada_to_fixed_value_create (value_type (val),
VALUE_ADDRESS (val) + value_offset (val),
val);
}
struct value *
ada_to_static_fixed_value (struct value *val)
{
struct type *type =
to_static_fixed_type (static_unwrap_type (value_type (val)));
if (type == value_type (val))
return val;
else
return coerce_unspec_val_to_type (val, type);
}
static const char *attribute_names[] = {
"<?>",
"first",
"last",
"length",
"image",
"max",
"min",
"modulus",
"pos",
"size",
"tag",
"val",
0
};
const char *
ada_attribute_name (enum exp_opcode n)
{
if (n >= OP_ATR_FIRST && n <= (int) OP_ATR_VAL)
return attribute_names[n - OP_ATR_FIRST + 1];
else
return attribute_names[0];
}
static LONGEST
pos_atr (struct value *arg)
{
struct type *type = value_type (arg);
if (!discrete_type_p (type))
error (_("'POS only defined on discrete types"));
if (TYPE_CODE (type) == TYPE_CODE_ENUM)
{
int i;
LONGEST v = value_as_long (arg);
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
if (v == TYPE_FIELD_BITPOS (type, i))
return i;
}
error (_("enumeration value is invalid: can't find 'POS"));
}
else
return value_as_long (arg);
}
static struct value *
value_pos_atr (struct value *arg)
{
return value_from_longest (builtin_type_int, pos_atr (arg));
}
static struct value *
value_val_atr (struct type *type, struct value *arg)
{
if (!discrete_type_p (type))
error (_("'VAL only defined on discrete types"));
if (!integer_type_p (value_type (arg)))
error (_("'VAL requires integral argument"));
if (TYPE_CODE (type) == TYPE_CODE_ENUM)
{
long pos = value_as_long (arg);
if (pos < 0 || pos >= TYPE_NFIELDS (type))
error (_("argument to 'VAL out of range"));
return value_from_longest (type, TYPE_FIELD_BITPOS (type, pos));
}
else
return value_from_longest (type, value_as_long (arg));
}
int
ada_is_character_type (struct type *type)
{
const char *name = ada_type_name (type);
return
name != NULL
&& (TYPE_CODE (type) == TYPE_CODE_CHAR
|| TYPE_CODE (type) == TYPE_CODE_INT
|| TYPE_CODE (type) == TYPE_CODE_RANGE)
&& (strcmp (name, "character") == 0
|| strcmp (name, "wide_character") == 0
|| strcmp (name, "unsigned char") == 0);
}
int
ada_is_string_type (struct type *type)
{
type = ada_check_typedef (type);
if (type != NULL
&& TYPE_CODE (type) != TYPE_CODE_PTR
&& (ada_is_simple_array_type (type)
|| ada_is_array_descriptor_type (type))
&& ada_array_arity (type) == 1)
{
struct type *elttype = ada_array_element_type (type, 1);
return ada_is_character_type (elttype);
}
else
return 0;
}
int
ada_is_aligner_type (struct type *type)
{
type = ada_check_typedef (type);
if (ada_find_parallel_type (type, "___XVS") != NULL)
return 0;
return (TYPE_CODE (type) == TYPE_CODE_STRUCT
&& TYPE_NFIELDS (type) == 1
&& strcmp (TYPE_FIELD_NAME (type, 0), "F") == 0);
}
struct type *
ada_get_base_type (struct type *raw_type)
{
struct type *real_type_namer;
struct type *raw_real_type;
if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT)
return raw_type;
real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
if (real_type_namer == NULL
|| TYPE_CODE (real_type_namer) != TYPE_CODE_STRUCT
|| TYPE_NFIELDS (real_type_namer) != 1)
return raw_type;
raw_real_type = ada_find_any_type (TYPE_FIELD_NAME (real_type_namer, 0));
if (raw_real_type == NULL)
return raw_type;
else
return raw_real_type;
}
struct type *
ada_aligned_type (struct type *type)
{
if (ada_is_aligner_type (type))
return ada_aligned_type (TYPE_FIELD_TYPE (type, 0));
else
return ada_get_base_type (type);
}
const gdb_byte *
ada_aligned_value_addr (struct type *type, const gdb_byte *valaddr)
{
if (ada_is_aligner_type (type))
return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0),
valaddr +
TYPE_FIELD_BITPOS (type,
0) / TARGET_CHAR_BIT);
else
return valaddr;
}
const char *
ada_enum_name (const char *name)
{
static char *result;
static size_t result_len = 0;
char *tmp;
tmp = strrchr (name, '.');
if (tmp != NULL)
name = tmp + 1;
else
{
while ((tmp = strstr (name, "__")) != NULL)
{
if (isdigit (tmp[2]))
break;
else
name = tmp + 2;
}
}
if (name[0] == 'Q')
{
int v;
if (name[1] == 'U' || name[1] == 'W')
{
if (sscanf (name + 2, "%x", &v) != 1)
return name;
}
else
return name;
GROW_VECT (result, result_len, 16);
if (isascii (v) && isprint (v))
sprintf (result, "'%c'", v);
else if (name[1] == 'U')
sprintf (result, "[\"%02x\"]", v);
else
sprintf (result, "[\"%04x\"]", v);
return result;
}
else
{
tmp = strstr (name, "__");
if (tmp == NULL)
tmp = strstr (name, "$");
if (tmp != NULL)
{
GROW_VECT (result, result_len, tmp - name + 1);
strncpy (result, name, tmp - name);
result[tmp - name] = '\0';
return result;
}
return name;
}
}
static struct value *
evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
enum noside noside)
{
return (*exp->language_defn->la_exp_desc->evaluate_exp)
(expect_type, exp, pos, noside);
}
static struct value *
evaluate_subexp_type (struct expression *exp, int *pos)
{
return (*exp->language_defn->la_exp_desc->evaluate_exp)
(NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
}
static struct value *
unwrap_value (struct value *val)
{
struct type *type = ada_check_typedef (value_type (val));
if (ada_is_aligner_type (type))
{
struct value *v = value_struct_elt (&val, NULL, "F",
NULL, "internal structure");
struct type *val_type = ada_check_typedef (value_type (v));
if (ada_type_name (val_type) == NULL)
TYPE_NAME (val_type) = ada_type_name (type);
return unwrap_value (v);
}
else
{
struct type *raw_real_type =
ada_check_typedef (ada_get_base_type (type));
if (type == raw_real_type)
return val;
return
coerce_unspec_val_to_type
(val, ada_to_fixed_type (raw_real_type, 0,
VALUE_ADDRESS (val) + value_offset (val),
NULL));
}
}
static struct value *
cast_to_fixed (struct type *type, struct value *arg)
{
LONGEST val;
if (type == value_type (arg))
return arg;
else if (ada_is_fixed_point_type (value_type (arg)))
val = ada_float_to_fixed (type,
ada_fixed_to_float (value_type (arg),
value_as_long (arg)));
else
{
DOUBLEST argd =
value_as_double (value_cast (builtin_type_double, value_copy (arg)));
val = ada_float_to_fixed (type, argd);
}
return value_from_longest (type, val);
}
static struct value *
cast_from_fixed_to_double (struct value *arg)
{
DOUBLEST val = ada_fixed_to_float (value_type (arg),
value_as_long (arg));
return value_from_double (builtin_type_double, val);
}
static struct value *
coerce_for_assign (struct type *type, struct value *val)
{
struct type *type2 = value_type (val);
if (type == type2)
return val;
type2 = ada_check_typedef (type2);
type = ada_check_typedef (type);
if (TYPE_CODE (type2) == TYPE_CODE_PTR
&& TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
val = ada_value_ind (val);
type2 = value_type (val);
}
if (TYPE_CODE (type2) == TYPE_CODE_ARRAY
&& TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
if (TYPE_LENGTH (type2) != TYPE_LENGTH (type)
|| TYPE_LENGTH (TYPE_TARGET_TYPE (type2))
!= TYPE_LENGTH (TYPE_TARGET_TYPE (type2)))
error (_("Incompatible types in assignment"));
deprecated_set_value_type (val, type);
}
return val;
}
static struct value *
ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
{
struct value *val;
struct type *type1, *type2;
LONGEST v, v1, v2;
arg1 = coerce_ref (arg1);
arg2 = coerce_ref (arg2);
type1 = base_type (ada_check_typedef (value_type (arg1)));
type2 = base_type (ada_check_typedef (value_type (arg2)));
if (TYPE_CODE (type1) != TYPE_CODE_INT
|| TYPE_CODE (type2) != TYPE_CODE_INT)
return value_binop (arg1, arg2, op);
switch (op)
{
case BINOP_MOD:
case BINOP_DIV:
case BINOP_REM:
break;
default:
return value_binop (arg1, arg2, op);
}
v2 = value_as_long (arg2);
if (v2 == 0)
error (_("second operand of %s must not be zero."), op_string (op));
if (TYPE_UNSIGNED (type1) || op == BINOP_MOD)
return value_binop (arg1, arg2, op);
v1 = value_as_long (arg1);
switch (op)
{
case BINOP_DIV:
v = v1 / v2;
if (!TRUNCATION_TOWARDS_ZERO && v1 * (v1 % v2) < 0)
v += v > 0 ? -1 : 1;
break;
case BINOP_REM:
v = v1 % v2;
if (v * v1 < 0)
v -= v2;
break;
default:
v = 0;
}
val = allocate_value (type1);
store_unsigned_integer (value_contents_raw (val),
TYPE_LENGTH (value_type (val)), v);
return val;
}
static int
ada_value_equal (struct value *arg1, struct value *arg2)
{
if (ada_is_direct_array_type (value_type (arg1))
|| ada_is_direct_array_type (value_type (arg2)))
{
arg1 = ada_coerce_to_simple_array (arg1);
arg2 = ada_coerce_to_simple_array (arg2);
if (TYPE_CODE (value_type (arg1)) != TYPE_CODE_ARRAY
|| TYPE_CODE (value_type (arg2)) != TYPE_CODE_ARRAY)
error (_("Attempt to compare array with non-array"));
return
TYPE_LENGTH (value_type (arg1)) == TYPE_LENGTH (value_type (arg2))
&& memcmp (value_contents (arg1), value_contents (arg2),
TYPE_LENGTH (value_type (arg1))) == 0;
}
return value_equal (arg1, arg2);
}
struct value *
ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
int *pos, enum noside noside)
{
enum exp_opcode op;
int tem;
int pc;
struct value *arg1 = NULL, *arg2 = NULL, *arg3;
struct type *type;
int nargs;
struct value **argvec;
pc = *pos;
*pos += 1;
op = exp->elts[pc].opcode;
switch (op)
{
default:
*pos -= 1;
return
unwrap_value (evaluate_subexp_standard
(expect_type, exp, pos, noside));
case OP_STRING:
{
struct value *result;
*pos -= 1;
result = evaluate_subexp_standard (expect_type, exp, pos, noside);
if (TYPE_CODE (value_type (result)) == TYPE_CODE_STRING)
TYPE_CODE (value_type (result)) = TYPE_CODE_ARRAY;
return result;
}
case UNOP_CAST:
(*pos) += 2;
type = exp->elts[pc + 1].type;
arg1 = evaluate_subexp (type, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (type != ada_check_typedef (value_type (arg1)))
{
if (ada_is_fixed_point_type (type))
arg1 = cast_to_fixed (type, arg1);
else if (ada_is_fixed_point_type (value_type (arg1)))
arg1 = value_cast (type, cast_from_fixed_to_double (arg1));
else if (VALUE_LVAL (arg1) == lval_memory)
{
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (to_static_fixed_type (type), not_lval);
arg1 =
ada_to_fixed_value_create
(type, VALUE_ADDRESS (arg1) + value_offset (arg1), 0);
}
else
arg1 = value_cast (type, arg1);
}
return arg1;
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 (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
return arg1;
if (ada_is_fixed_point_type (value_type (arg1)))
arg2 = cast_to_fixed (value_type (arg1), arg2);
else if (ada_is_fixed_point_type (value_type (arg2)))
error
(_("Fixed-point values must be assigned to fixed-point variables"));
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 ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
error (_("Operands of fixed-point addition must have the same type"));
return value_cast (value_type (arg1), value_add (arg1, arg2));
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 ((ada_is_fixed_point_type (value_type (arg1))
|| ada_is_fixed_point_type (value_type (arg2)))
&& value_type (arg1) != value_type (arg2))
error (_("Operands of fixed-point subtraction must have the same type"));
return value_cast (value_type (arg1), value_sub (arg1, arg2));
case BINOP_MUL:
case BINOP_DIV:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS
&& (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
return value_zero (value_type (arg1), not_lval);
else
{
if (ada_is_fixed_point_type (value_type (arg1)))
arg1 = cast_from_fixed_to_double (arg1);
if (ada_is_fixed_point_type (value_type (arg2)))
arg2 = cast_from_fixed_to_double (arg2);
return ada_value_binop (arg1, arg2, op);
}
case BINOP_REM:
case BINOP_MOD:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS
&& (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD))
return value_zero (value_type (arg1), not_lval);
else
return ada_value_binop (arg1, arg2, op);
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
tem = 0;
else
tem = ada_value_equal (arg1, arg2);
if (op == BINOP_NOTEQUAL)
tem = !tem;
return value_from_longest (LA_BOOL_TYPE, (LONGEST) tem);
case UNOP_NEG:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (ada_is_fixed_point_type (value_type (arg1)))
return value_cast (value_type (arg1), value_neg (arg1));
else
return value_neg (arg1);
case OP_VAR_VALUE:
*pos -= 1;
if (noside == EVAL_SKIP)
{
*pos += 4;
goto nosideret;
}
else if (SYMBOL_DOMAIN (exp->elts[pc + 2].symbol) == UNDEF_DOMAIN)
error (_("Unexpected unresolved symbol, %s, during evaluation"),
SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol));
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
*pos += 4;
return value_zero
(to_static_fixed_type
(static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))),
not_lval);
}
else
{
arg1 =
unwrap_value (evaluate_subexp_standard
(expect_type, exp, pos, noside));
return ada_to_fixed_value (arg1);
}
case OP_FUNCALL:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
argvec =
(struct value **) alloca (sizeof (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"),
SYMBOL_PRINT_NAME (exp->elts[pc + 5].symbol));
else
{
for (tem = 0; tem <= nargs; tem += 1)
argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside);
argvec[tem] = 0;
if (noside == EVAL_SKIP)
goto nosideret;
}
if (ada_is_packed_array_type (desc_base_type (value_type (argvec[0]))))
argvec[0] = ada_coerce_to_simple_array (argvec[0]);
else if (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_REF
|| (TYPE_CODE (value_type (argvec[0])) == TYPE_CODE_ARRAY
&& VALUE_LVAL (argvec[0]) == lval_memory))
argvec[0] = value_addr (argvec[0]);
type = ada_check_typedef (value_type (argvec[0]));
if (TYPE_CODE (type) == TYPE_CODE_PTR)
{
switch (TYPE_CODE (ada_check_typedef (TYPE_TARGET_TYPE (type))))
{
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;
}
}
switch (TYPE_CODE (type))
{
case TYPE_CODE_FUNC:
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (TYPE_TARGET_TYPE (type));
return call_function_by_hand (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 allocate_value (ada_aligned_type (type));
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 allocate_value (ada_aligned_type (type));
}
return
unwrap_value (ada_value_subscript
(ada_coerce_to_simple_array (argvec[0]),
nargs, argvec + 1));
case TYPE_CODE_PTR:
type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1);
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
type = ada_array_element_type (type, nargs);
if (type == NULL)
error (_("element type of array unknown"));
else
return allocate_value (ada_aligned_type (type));
}
return
unwrap_value (ada_value_ptr_subscript (argvec[0], type,
nargs, argvec + 1));
default:
error (_("Attempt to index or call something other than an \
array or function"));
}
case TERNOP_SLICE:
{
struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
struct value *low_bound_val =
evaluate_subexp (NULL_TYPE, exp, pos, noside);
struct value *high_bound_val =
evaluate_subexp (NULL_TYPE, exp, pos, noside);
LONGEST low_bound;
LONGEST high_bound;
low_bound_val = coerce_ref (low_bound_val);
high_bound_val = coerce_ref (high_bound_val);
low_bound = pos_atr (low_bound_val);
high_bound = pos_atr (high_bound_val);
if (noside == EVAL_SKIP)
goto nosideret;
if (TYPE_CODE (value_type (array)) == TYPE_CODE_REF
&& ada_is_aligner_type (TYPE_TARGET_TYPE (value_type (array))))
TYPE_TARGET_TYPE (value_type (array)) =
ada_aligned_type (TYPE_TARGET_TYPE (value_type (array)));
if (ada_is_packed_array_type (value_type (array)))
error (_("cannot slice a packed array"));
if (TYPE_CODE (value_type (array)) == TYPE_CODE_REF
|| (TYPE_CODE (value_type (array)) == TYPE_CODE_ARRAY
&& VALUE_LVAL (array) == lval_memory))
array = value_addr (array);
if (noside == EVAL_AVOID_SIDE_EFFECTS
&& ada_is_array_descriptor_type (ada_check_typedef
(value_type (array))))
return empty_array (ada_type_of_array (array, 0), low_bound);
array = ada_coerce_to_simple_array_ptr (array);
while (TYPE_CODE (value_type (array)) == TYPE_CODE_PTR
&& (TYPE_CODE (TYPE_TARGET_TYPE (value_type (array)))
== TYPE_CODE_PTR))
array = value_ind (array);
if (!ada_is_simple_array_type (value_type (array)))
error (_("cannot take slice of non-array"));
if (TYPE_CODE (value_type (array)) == TYPE_CODE_PTR)
{
if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
return empty_array (TYPE_TARGET_TYPE (value_type (array)),
low_bound);
else
{
struct type *arr_type0 =
to_fixed_array_type (TYPE_TARGET_TYPE (value_type (array)),
NULL, 1);
return ada_value_slice_ptr (array, arr_type0,
(int) low_bound,
(int) high_bound);
}
}
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return array;
else if (high_bound < low_bound)
return empty_array (value_type (array), low_bound);
else
return ada_value_slice (array, (int) low_bound, (int) high_bound);
}
case UNOP_IN_RANGE:
(*pos) += 2;
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
type = exp->elts[pc + 1].type;
if (noside == EVAL_SKIP)
goto nosideret;
switch (TYPE_CODE (type))
{
default:
lim_warning (_("Membership test incompletely implemented; \
always returns true"));
return value_from_longest (builtin_type_int, (LONGEST) 1);
case TYPE_CODE_RANGE:
arg2 = value_from_longest (builtin_type_int, TYPE_LOW_BOUND (type));
arg3 = value_from_longest (builtin_type_int,
TYPE_HIGH_BOUND (type));
return
value_from_longest (builtin_type_int,
(value_less (arg1, arg3)
|| value_equal (arg1, arg3))
&& (value_less (arg2, arg1)
|| value_equal (arg2, arg1)));
}
case BINOP_IN_BOUNDS:
(*pos) += 2;
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (builtin_type_int, not_lval);
tem = longest_to_int (exp->elts[pc + 1].longconst);
if (tem < 1 || tem > ada_array_arity (value_type (arg2)))
error (_("invalid dimension number to 'range"));
arg3 = ada_array_bound (arg2, tem, 1);
arg2 = ada_array_bound (arg2, tem, 0);
return
value_from_longest (builtin_type_int,
(value_less (arg1, arg3)
|| value_equal (arg1, arg3))
&& (value_less (arg2, arg1)
|| value_equal (arg2, arg1)));
case TERNOP_IN_RANGE:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
return
value_from_longest (builtin_type_int,
(value_less (arg1, arg3)
|| value_equal (arg1, arg3))
&& (value_less (arg2, arg1)
|| value_equal (arg2, arg1)));
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 (NULL_TYPE, exp, pos, EVAL_SKIP);
arg1 = NULL;
type_arg = exp->elts[pc + 2].type;
}
else
{
arg1 = evaluate_subexp (NULL_TYPE, 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;
if (type_arg == NULL)
{
arg1 = ada_coerce_ref (arg1);
if (ada_is_packed_array_type (value_type (arg1)))
arg1 = ada_coerce_to_simple_array (arg1);
if (tem < 1 || tem > ada_array_arity (value_type (arg1)))
error (_("invalid dimension number to '%s"),
ada_attribute_name (op));
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
type = ada_index_type (value_type (arg1), tem);
if (type == NULL)
error
(_("attempt to take bound of something that is not an array"));
return allocate_value (type);
}
switch (op)
{
default:
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
return ada_array_bound (arg1, tem, 0);
case OP_ATR_LAST:
return ada_array_bound (arg1, tem, 1);
case OP_ATR_LENGTH:
return ada_array_length (arg1, tem);
}
}
else if (discrete_type_p (type_arg))
{
struct type *range_type;
char *name = ada_type_name (type_arg);
range_type = NULL;
if (name != NULL && TYPE_CODE (type_arg) != TYPE_CODE_ENUM)
range_type =
to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg));
if (range_type == NULL)
range_type = type_arg;
switch (op)
{
default:
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
return discrete_type_low_bound (range_type);
case OP_ATR_LAST:
return discrete_type_high_bound (range_type);
case OP_ATR_LENGTH:
error (_("the 'length attribute applies only to array types"));
}
}
else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT)
error (_("unimplemented type attribute"));
else
{
LONGEST low, high;
if (ada_is_packed_array_type (type_arg))
type_arg = decode_packed_array_type (type_arg);
if (tem < 1 || tem > ada_array_arity (type_arg))
error (_("invalid dimension number to '%s"),
ada_attribute_name (op));
type = ada_index_type (type_arg, tem);
if (type == NULL)
error
(_("attempt to take bound of something that is not an array"));
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (type);
switch (op)
{
default:
error (_("unexpected attribute encountered"));
case OP_ATR_FIRST:
low = ada_array_bound_from_type (type_arg, tem, 0, &type);
return value_from_longest (type, low);
case OP_ATR_LAST:
high = ada_array_bound_from_type (type_arg, tem, 1, &type);
return value_from_longest (type, high);
case OP_ATR_LENGTH:
low = ada_array_bound_from_type (type_arg, tem, 0, &type);
high = ada_array_bound_from_type (type_arg, tem, 1, NULL);
return value_from_longest (type, high - low + 1);
}
}
}
case OP_ATR_TAG:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (ada_tag_type (arg1), not_lval);
return ada_value_tag (arg1);
case OP_ATR_MIN:
case OP_ATR_MAX:
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (value_type (arg1), not_lval);
else
return value_binop (arg1, arg2,
op == OP_ATR_MIN ? BINOP_MIN : BINOP_MAX);
case OP_ATR_MODULUS:
{
struct type *type_arg = exp->elts[pc + 2].type;
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
if (noside == EVAL_SKIP)
goto nosideret;
if (!ada_is_modular_type (type_arg))
error (_("'modulus must be applied to modular type"));
return value_from_longest (TYPE_TARGET_TYPE (type_arg),
ada_modulus (type_arg));
}
case OP_ATR_POS:
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (builtin_type_int, not_lval);
else
return value_pos_atr (arg1);
case OP_ATR_SIZE:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (builtin_type_int, not_lval);
else
return value_from_longest (builtin_type_int,
TARGET_CHAR_BIT
* TYPE_LENGTH (value_type (arg1)));
case OP_ATR_VAL:
evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP);
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
type = exp->elts[pc + 2].type;
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (type, not_lval);
else
return value_val_atr (type, arg1);
case BINOP_EXP:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return value_zero (value_type (arg1), not_lval);
else
return value_binop (arg1, arg2, op);
case UNOP_PLUS:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
else
return arg1;
case UNOP_ABS:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
return value_neg (arg1);
else
return arg1;
case UNOP_IND:
if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR)
expect_type = TYPE_TARGET_TYPE (ada_check_typedef (expect_type));
arg1 = evaluate_subexp (expect_type, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
type = ada_check_typedef (value_type (arg1));
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
if (ada_is_array_descriptor_type (type))
{
struct type *arrType = ada_type_of_array (arg1, 0);
if (arrType == NULL)
error (_("Attempt to dereference null array pointer."));
return value_at_lazy (arrType, 0);
}
else if (TYPE_CODE (type) == TYPE_CODE_PTR
|| TYPE_CODE (type) == TYPE_CODE_REF
|| TYPE_CODE (type) == TYPE_CODE_ARRAY)
{
type = to_static_fixed_type
(ada_aligned_type
(ada_check_typedef (TYPE_TARGET_TYPE (type))));
check_size (type);
return value_zero (type, lval_memory);
}
else if (TYPE_CODE (type) == TYPE_CODE_INT)
return value_zero (builtin_type_int, lval_memory);
else
error (_("Attempt to take contents of a non-pointer value."));
}
arg1 = ada_coerce_ref (arg1);
type = ada_check_typedef (value_type (arg1));
if (ada_is_array_descriptor_type (type))
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);
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
struct type *type1 = value_type (arg1);
if (ada_is_tagged_type (type1, 1))
{
type = ada_lookup_struct_elt_type (type1,
&exp->elts[pc + 2].string,
1, 1, NULL);
if (type == NULL)
return value_zero (builtin_type_void, lval_memory);
}
else
type =
ada_lookup_struct_elt_type (type1, &exp->elts[pc + 2].string, 1,
0, NULL);
return value_zero (ada_aligned_type (type), lval_memory);
}
else
return
ada_to_fixed_value (unwrap_value
(ada_value_struct_elt
(arg1, &exp->elts[pc + 2].string, "record")));
case OP_TYPE:
(*pos) += 2;
if (noside == EVAL_SKIP)
goto nosideret;
else if (noside == EVAL_AVOID_SIDE_EFFECTS)
return allocate_value (builtin_type_void);
else
error (_("Attempt to use a type name as an expression"));
}
nosideret:
return value_from_longest (builtin_type_long, (LONGEST) 1);
}
static const char *
fixed_type_info (struct type *type)
{
const char *name = ada_type_name (type);
enum type_code code = (type == NULL) ? TYPE_CODE_UNDEF : TYPE_CODE (type);
if ((code == TYPE_CODE_INT || code == TYPE_CODE_RANGE) && name != NULL)
{
const char *tail = strstr (name, "___XF_");
if (tail == NULL)
return NULL;
else
return tail + 5;
}
else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type)
return fixed_type_info (TYPE_TARGET_TYPE (type));
else
return NULL;
}
int
ada_is_fixed_point_type (struct type *type)
{
return fixed_type_info (type) != NULL;
}
int
ada_is_system_address_type (struct type *type)
{
return (TYPE_NAME (type)
&& strcmp (TYPE_NAME (type), "system__address") == 0);
}
DOUBLEST
ada_delta (struct type *type)
{
const char *encoding = fixed_type_info (type);
long num, den;
if (sscanf (encoding, "_%ld_%ld", &num, &den) < 2)
return -1.0;
else
return (DOUBLEST) num / (DOUBLEST) den;
}
static DOUBLEST
scaling_factor (struct type *type)
{
const char *encoding = fixed_type_info (type);
unsigned long num0, den0, num1, den1;
int n;
n = sscanf (encoding, "_%lu_%lu_%lu_%lu", &num0, &den0, &num1, &den1);
if (n < 2)
return 1.0;
else if (n == 4)
return (DOUBLEST) num1 / (DOUBLEST) den1;
else
return (DOUBLEST) num0 / (DOUBLEST) den0;
}
DOUBLEST
ada_fixed_to_float (struct type *type, LONGEST x)
{
return (DOUBLEST) x *scaling_factor (type);
}
LONGEST
ada_float_to_fixed (struct type *type, DOUBLEST x)
{
return (LONGEST) (x / scaling_factor (type) + 0.5);
}
int
ada_is_vax_floating_type (struct type *type)
{
int name_len =
(ada_type_name (type) == NULL) ? 0 : strlen (ada_type_name (type));
return
name_len > 6
&& (TYPE_CODE (type) == TYPE_CODE_INT
|| TYPE_CODE (type) == TYPE_CODE_RANGE)
&& strncmp (ada_type_name (type) + name_len - 6, "___XF", 5) == 0;
}
int
ada_vax_float_type_suffix (struct type *type)
{
return ada_type_name (type)[strlen (ada_type_name (type)) - 1];
}
struct value *
ada_vax_float_print_function (struct type *type)
{
switch (ada_vax_float_type_suffix (type))
{
case 'F':
return get_var_value ("DEBUG_STRING_F", 0);
case 'D':
return get_var_value ("DEBUG_STRING_D", 0);
case 'G':
return get_var_value ("DEBUG_STRING_G", 0);
default:
error (_("invalid VAX floating-point type"));
}
}
static int
scan_discrim_bound (char *str, int k, struct value *dval, LONGEST * px,
int *pnew_k)
{
static char *bound_buffer = NULL;
static size_t bound_buffer_len = 0;
char *bound;
char *pend;
struct value *bound_val;
if (dval == NULL || str == NULL || str[k] == '\0')
return 0;
pend = strstr (str + k, "__");
if (pend == NULL)
{
bound = str + k;
k += strlen (bound);
}
else
{
GROW_VECT (bound_buffer, bound_buffer_len, pend - (str + k) + 1);
bound = bound_buffer;
strncpy (bound_buffer, str + k, pend - (str + k));
bound[pend - (str + k)] = '\0';
k = pend - str;
}
bound_val = ada_search_struct_field (bound, dval, 0, value_type (dval));
if (bound_val == NULL)
return 0;
*px = value_as_long (bound_val);
if (pnew_k != NULL)
*pnew_k = k;
return 1;
}
static struct value *
get_var_value (char *name, char *err_msg)
{
struct ada_symbol_info *syms;
int nsyms;
nsyms = ada_lookup_symbol_list (name, get_selected_block (0), VAR_DOMAIN,
&syms);
if (nsyms != 1)
{
if (err_msg == NULL)
return 0;
else
error (("%s"), err_msg);
}
return value_of_variable (syms[0].sym, syms[0].block);
}
LONGEST
get_int_var_value (char *name, int *flag)
{
struct value *var_val = get_var_value (name, 0);
if (var_val == 0)
{
if (flag != NULL)
*flag = 0;
return 0;
}
else
{
if (flag != NULL)
*flag = 1;
return value_as_long (var_val);
}
}
static struct type *
to_fixed_range_type (char *name, struct value *dval, struct objfile *objfile)
{
struct type *raw_type = ada_find_any_type (name);
struct type *base_type;
char *subtype_info;
if (raw_type == NULL)
base_type = builtin_type_int;
else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL)
return raw_type;
else
{
static char *name_buf = NULL;
static size_t name_len = 0;
int prefix_len = subtype_info - name;
LONGEST L, U;
struct type *type;
char *bounds_str;
int n;
GROW_VECT (name_buf, name_len, prefix_len + 5);
strncpy (name_buf, name, prefix_len);
name_buf[prefix_len] = '\0';
subtype_info += 5;
bounds_str = strchr (subtype_info, '_');
n = 1;
if (*subtype_info == 'L')
{
if (!ada_scan_number (bounds_str, n, &L, &n)
&& !scan_discrim_bound (bounds_str, n, dval, &L, &n))
return raw_type;
if (bounds_str[n] == '_')
n += 2;
else if (bounds_str[n] == '.')
n += 1;
subtype_info += 1;
}
else
{
int ok;
strcpy (name_buf + prefix_len, "___L");
L = get_int_var_value (name_buf, &ok);
if (!ok)
{
lim_warning (_("Unknown lower bound, using 1."));
L = 1;
}
}
if (*subtype_info == 'U')
{
if (!ada_scan_number (bounds_str, n, &U, &n)
&& !scan_discrim_bound (bounds_str, n, dval, &U, &n))
return raw_type;
}
else
{
int ok;
strcpy (name_buf + prefix_len, "___U");
U = get_int_var_value (name_buf, &ok);
if (!ok)
{
lim_warning (_("Unknown upper bound, using %ld."), (long) L);
U = L;
}
}
if (objfile == NULL)
objfile = TYPE_OBJFILE (base_type);
type = create_range_type (alloc_type (objfile), base_type, L, U);
TYPE_NAME (type) = name;
return type;
}
}
int
ada_is_range_type_name (const char *name)
{
return (name != NULL && strstr (name, "___XD"));
}
int
ada_is_modular_type (struct type *type)
{
struct type *subranged_type = base_type (type);
return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
&& TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
&& TYPE_UNSIGNED (subranged_type));
}
ULONGEST
ada_modulus (struct type * type)
{
return (ULONGEST) TYPE_HIGH_BOUND (type) + 1;
}
#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)
static void
ada_operator_length (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
}
}
static char *
ada_op_name (enum exp_opcode opcode)
{
switch (opcode)
{
default:
return op_name_standard (opcode);
#define OP_DEFN(op, len, args, binop) case op: return #op;
ADA_OPERATORS;
#undef OP_DEFN
}
}
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
}
}
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)
{
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:
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)", (int) exp->elts[pc + 2].longconst);
break;
case TERNOP_IN_RANGE:
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;
}
static void
ada_print_subexp (struct expression *exp, int *pos,
struct ui_file *stream, enum precedence prec)
{
int oplen, nargs;
int pc = *pos;
enum exp_opcode op = exp->elts[pc].opcode;
ada_forward_operator_length (exp, pc, &oplen, &nargs);
switch (op)
{
default:
print_subexp_standard (exp, pos, stream, prec);
return;
case OP_VAR_VALUE:
*pos += oplen;
fputs_filtered (SYMBOL_NATURAL_NAME (exp->elts[pc + 2].symbol), stream);
return;
case BINOP_IN_BOUNDS:
*pos += oplen;
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:
*pos += oplen;
if (prec >= PREC_EQUAL)
fputs_filtered ("(", stream);
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:
*pos += oplen;
if (exp->elts[*pos].opcode == OP_TYPE)
{
if (TYPE_CODE (exp->elts[*pos + 1].type) != TYPE_CODE_VOID)
LA_PRINT_TYPE (exp->elts[*pos + 1].type, "", stream, 0, 0);
*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:
*pos += oplen;
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:
*pos += oplen;
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (" in ", stream);
LA_PRINT_TYPE (exp->elts[pc + 1].type, "", stream, 1, 0);
return;
}
}
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, 0, 0, 0}
};
static struct type *
ada_create_fundamental_type (struct objfile *objfile, int typeid)
{
struct type *type = NULL;
switch (typeid)
{
default:
type = init_type (TYPE_CODE_INT,
TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "<?type?>", objfile);
warning (_("internal error: no Ada fundamental type %d"), typeid);
break;
case FT_VOID:
type = init_type (TYPE_CODE_VOID,
TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0, "void", objfile);
break;
case FT_CHAR:
type = init_type (TYPE_CODE_INT,
TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0, "character", objfile);
break;
case FT_SIGNED_CHAR:
type = init_type (TYPE_CODE_INT,
TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0, "signed char", objfile);
break;
case FT_UNSIGNED_CHAR:
type = init_type (TYPE_CODE_INT,
TARGET_CHAR_BIT / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
break;
case FT_SHORT:
type = init_type (TYPE_CODE_INT,
TARGET_SHORT_BIT / TARGET_CHAR_BIT,
0, "short_integer", objfile);
break;
case FT_SIGNED_SHORT:
type = init_type (TYPE_CODE_INT,
TARGET_SHORT_BIT / TARGET_CHAR_BIT,
0, "short_integer", objfile);
break;
case FT_UNSIGNED_SHORT:
type = init_type (TYPE_CODE_INT,
TARGET_SHORT_BIT / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
break;
case FT_INTEGER:
type = init_type (TYPE_CODE_INT,
TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "integer", objfile);
break;
case FT_SIGNED_INTEGER:
type = init_type (TYPE_CODE_INT, TARGET_INT_BIT /
TARGET_CHAR_BIT,
0, "integer", objfile);
break;
case FT_UNSIGNED_INTEGER:
type = init_type (TYPE_CODE_INT,
TARGET_INT_BIT / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
break;
case FT_LONG:
type = init_type (TYPE_CODE_INT,
TARGET_LONG_BIT / TARGET_CHAR_BIT,
0, "long_integer", objfile);
break;
case FT_SIGNED_LONG:
type = init_type (TYPE_CODE_INT,
TARGET_LONG_BIT / TARGET_CHAR_BIT,
0, "long_integer", objfile);
break;
case FT_UNSIGNED_LONG:
type = init_type (TYPE_CODE_INT,
TARGET_LONG_BIT / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
break;
case FT_LONG_LONG:
type = init_type (TYPE_CODE_INT,
TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
0, "long_long_integer", objfile);
break;
case FT_SIGNED_LONG_LONG:
type = init_type (TYPE_CODE_INT,
TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
0, "long_long_integer", objfile);
break;
case FT_UNSIGNED_LONG_LONG:
type = init_type (TYPE_CODE_INT,
TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
break;
case FT_FLOAT:
type = init_type (TYPE_CODE_FLT,
TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0, "float", objfile);
break;
case FT_DBL_PREC_FLOAT:
type = init_type (TYPE_CODE_FLT,
TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long_float", objfile);
break;
case FT_EXT_PREC_FLOAT:
type = init_type (TYPE_CODE_FLT,
TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long_long_float", objfile);
break;
}
return (type);
}
enum ada_primitive_types {
ada_primitive_type_int,
ada_primitive_type_long,
ada_primitive_type_short,
ada_primitive_type_char,
ada_primitive_type_float,
ada_primitive_type_double,
ada_primitive_type_void,
ada_primitive_type_long_long,
ada_primitive_type_long_double,
ada_primitive_type_natural,
ada_primitive_type_positive,
ada_primitive_type_system_address,
nr_ada_primitive_types
};
static void
ada_language_arch_info (struct gdbarch *current_gdbarch,
struct language_arch_info *lai)
{
const struct builtin_type *builtin = builtin_type (current_gdbarch);
lai->primitive_type_vector
= GDBARCH_OBSTACK_CALLOC (current_gdbarch, nr_ada_primitive_types + 1,
struct type *);
lai->primitive_type_vector [ada_primitive_type_int] =
init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "integer", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_long] =
init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
0, "long_integer", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_short] =
init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
0, "short_integer", (struct objfile *) NULL);
lai->string_char_type =
lai->primitive_type_vector [ada_primitive_type_char] =
init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0, "character", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_float] =
init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0, "float", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_double] =
init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long_float", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_long_long] =
init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
0, "long_long_integer", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_long_double] =
init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long_long_float", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_natural] =
init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "natural", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_positive] =
init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "positive", (struct objfile *) NULL);
lai->primitive_type_vector [ada_primitive_type_void] = builtin->builtin_void;
lai->primitive_type_vector [ada_primitive_type_system_address] =
lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
(struct objfile *) NULL));
TYPE_NAME (lai->primitive_type_vector [ada_primitive_type_system_address])
= "system__address";
}
static void
emit_char (int c, struct ui_file *stream, int quoter)
{
ada_emit_char (c, stream, quoter, 1);
}
static int
parse (void)
{
warnings_issued = 0;
return ada_parse ();
}
static const struct exp_descriptor ada_exp_descriptor = {
ada_print_subexp,
ada_operator_length,
ada_op_name,
ada_dump_subexp_body,
ada_evaluate_subexp
};
const struct language_defn ada_language_defn = {
"ada",
language_ada,
NULL,
range_check_off,
type_check_off,
case_sensitive_on,
array_row_major,
&ada_exp_descriptor,
parse,
ada_error,
resolve,
ada_printchar,
ada_printstr,
emit_char,
ada_create_fundamental_type,
ada_print_type,
ada_val_print,
ada_value_print,
NULL,
NULL,
ada_lookup_symbol_nonlocal,
basic_lookup_transparent_type,
ada_la_decode,
NULL,
ada_op_print_tab,
0,
1,
NULL,
ada_get_gdb_completer_word_break_characters,
ada_language_arch_info,
LANG_MAGIC
};
void
_initialize_ada_language (void)
{
add_language (&ada_language_defn);
varsize_limit = 65536;
obstack_init (&symbol_list_obstack);
decoded_names_store = htab_create_alloc
(256, htab_hash_string, (int (*)(const void *, const void *)) streq,
NULL, xcalloc, xfree);
}