#include <stdio.h>
#include "gdb_string.h"
#include <ctype.h>
#include <stdarg.h>
#include "demangle.h"
#include "defs.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 "ada-lang.h"
#include "ui-out.h"
#include "block.h"
#include "infcall.h"
#include "dictionary.h"
struct cleanup *unresolved_names;
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 *place_on_stack (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 block *, const char *,
domain_enum, struct objfile *, int);
static void fill_in_ada_prototype (struct symbol *);
static int is_nonfunction (struct symbol **, int);
static void add_defn_to_vec (struct symbol *, struct block *);
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 *ada_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 const char *ada_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 char *extended_canonical_line_spec (struct symtab_and_line,
const char *);
static struct value *evaluate_subexp (struct type *, struct expression *,
int *, enum noside);
static struct value *evaluate_subexp_type (struct expression *, int *);
static struct type *ada_create_fundamental_type (struct objfile *, int);
static int is_dynamic_field (struct type *, int);
static struct type *to_fixed_variant_branch_type (struct type *, char *,
CORE_ADDR, struct value *);
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 *, long,
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 symtabs_and_lines find_sal_from_funcs_and_line (const char *,
int,
struct symbol
**, int);
static int find_line_in_linetable (struct linetable *, int, struct symbol **,
int, int *);
static int find_next_line_in_linetable (struct linetable *, int, int, int);
static struct symtabs_and_lines all_sals_for_line (const char *, int,
char ***);
static void read_all_symtabs (const char *);
static int is_plausible_func_for_line (struct symbol *, int);
static struct value *ada_coerce_ref (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 *, domain_enum);
extern void markTimeStart (int index);
extern void markTimeStop (int index);
static unsigned int varsize_limit;
static const char *ada_completer_word_break_characters =
" \t\n!@#$%^&*()+=|~`}{[]\";:?/,-";
#define ADA_MAIN_PROGRAM_SYMBOL_NAME "__gnat_ada_main_program_name"
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 **old_vect, size_t * size, size_t min_size, int element_size)
{
if (*size < min_size)
{
*size *= 2;
if (*size < min_size)
*size = min_size;
*old_vect = xrealloc (*old_vect, *size * element_size);
}
}
static int
field_name_match (const char *field_name, const char *target)
{
int len = strlen (target);
return
DEPRECATED_STREQN (field_name, target, len)
&& (field_name[len] == '\0'
|| (DEPRECATED_STREQN (field_name + len, "___", 3)
&& !DEPRECATED_STREQ (field_name + strlen (field_name) - 6, "___XVN")));
}
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 && DEPRECATED_STREQ (str + len1 - len2, suffix));
}
struct value *
value_from_contents_and_address (struct type *type, char *valaddr,
CORE_ADDR address)
{
struct value *v = allocate_value (type);
if (valaddr == NULL)
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, long offset, struct type *type)
{
CHECK_TYPEDEF (type);
if (VALUE_LVAL (val) == lval_memory)
return value_at_lazy (type,
VALUE_ADDRESS (val) + VALUE_OFFSET (val) + offset,
NULL);
else
{
struct value *result = allocate_value (type);
VALUE_LVAL (result) = not_lval;
if (VALUE_ADDRESS (val) == 0)
memcpy (VALUE_CONTENTS_RAW (result), VALUE_CONTENTS (val) + offset,
TYPE_LENGTH (type) > TYPE_LENGTH (VALUE_TYPE (val))
? TYPE_LENGTH (VALUE_TYPE (val)) : TYPE_LENGTH (type));
else
{
VALUE_ADDRESS (result) =
VALUE_ADDRESS (val) + VALUE_OFFSET (val) + offset;
VALUE_LAZY (result) = 1;
}
return result;
}
}
static char *
cond_offset_host (char *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
do_command (const char *arg, ...)
{
int len;
char *cmd;
const char *s;
va_list ap;
va_start (ap, arg);
len = 0;
s = arg;
cmd = "";
for (; s != NULL; s = va_arg (ap, const char *))
{
char *cmd1;
len += strlen (s);
cmd1 = alloca (len + 1);
strcpy (cmd1, cmd);
strcat (cmd1, s);
cmd = cmd1;
}
va_end (ap);
execute_command (cmd, 0);
}
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_unknown;
return lang;
}
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 (DEPRECATED_STREQN (str, "_ada_", 5))
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].mangled != NULL; i += 1)
if (DEPRECATED_STREQN (ada_opname_table[i].mangled, p,
strlen (ada_opname_table[i].mangled)))
goto OK;
return 1;
OK:;
}
return 0;
}
}
char *
ada_mangle (const char *demangled)
{
static char *mangling_buffer = NULL;
static size_t mangling_buffer_size = 0;
const char *p;
int k;
if (demangled == NULL)
return NULL;
GROW_VECT (mangling_buffer, mangling_buffer_size,
2 * strlen (demangled) + 10);
k = 0;
for (p = demangled; *p != '\0'; p += 1)
{
if (*p == '.')
{
mangling_buffer[k] = mangling_buffer[k + 1] = '_';
k += 2;
}
else if (*p == '"')
{
const struct ada_opname_map *mapping;
for (mapping = ada_opname_table;
mapping->mangled != NULL &&
!DEPRECATED_STREQN (mapping->demangled, p, strlen (mapping->demangled));
p += 1)
;
if (mapping->mangled == NULL)
error ("invalid Ada operator name: %s", p);
strcpy (mangling_buffer + k, mapping->mangled);
k += strlen (mapping->mangled);
break;
}
else
{
mangling_buffer[k] = *p;
k += 1;
}
}
mangling_buffer[k] = '\0';
return mangling_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;
}
char *
ada_demangle (const char *mangled)
{
int i, j;
int len0;
const char *p;
char *demangled;
int at_start_name;
static char *demangling_buffer = NULL;
static size_t demangling_buffer_size = 0;
if (DEPRECATED_STREQN (mangled, "_ada_", 5))
mangled += 5;
if (mangled[0] == '_' || mangled[0] == '<')
goto Suppress;
p = strstr (mangled, "___");
if (p == NULL)
len0 = strlen (mangled);
else
{
if (p[3] == 'X')
len0 = p - mangled;
else
goto Suppress;
}
if (len0 > 3 && DEPRECATED_STREQ (mangled + len0 - 3, "TKB"))
len0 -= 3;
if (len0 > 1 && DEPRECATED_STREQ (mangled + len0 - 1, "B"))
len0 -= 1;
GROW_VECT (demangling_buffer, demangling_buffer_size, 2 * len0 + 1);
demangled = demangling_buffer;
if (isdigit (mangled[len0 - 1]))
{
for (i = len0 - 2; i >= 0 && isdigit (mangled[i]); i -= 1)
;
if (i > 1 && mangled[i] == '_' && mangled[i - 1] == '_')
len0 = i - 1;
else if (mangled[i] == '$')
len0 = i;
}
for (i = 0, j = 0; i < len0 && !isalpha (mangled[i]); i += 1, j += 1)
demangled[j] = mangled[i];
at_start_name = 1;
while (i < len0)
{
if (at_start_name && mangled[i] == 'O')
{
int k;
for (k = 0; ada_opname_table[k].mangled != NULL; k += 1)
{
int op_len = strlen (ada_opname_table[k].mangled);
if (DEPRECATED_STREQN
(ada_opname_table[k].mangled + 1, mangled + i + 1,
op_len - 1) && !isalnum (mangled[i + op_len]))
{
strcpy (demangled + j, ada_opname_table[k].demangled);
at_start_name = 0;
i += op_len;
j += strlen (ada_opname_table[k].demangled);
break;
}
}
if (ada_opname_table[k].mangled != NULL)
continue;
}
at_start_name = 0;
if (i < len0 - 4 && DEPRECATED_STREQN (mangled + i, "TK__", 4))
i += 2;
if (mangled[i] == 'X' && i != 0 && isalnum (mangled[i - 1]))
{
do
i += 1;
while (i < len0 && (mangled[i] == 'b' || mangled[i] == 'n'));
if (i < len0)
goto Suppress;
}
else if (i < len0 - 2 && mangled[i] == '_' && mangled[i + 1] == '_')
{
demangled[j] = '.';
at_start_name = 1;
i += 2;
j += 1;
}
else
{
demangled[j] = mangled[i];
i += 1;
j += 1;
}
}
demangled[j] = '\000';
for (i = 0; demangled[i] != '\0'; i += 1)
if (isupper (demangled[i]) || demangled[i] == ' ')
goto Suppress;
return demangled;
Suppress:
GROW_VECT (demangling_buffer, demangling_buffer_size, strlen (mangled) + 3);
demangled = demangling_buffer;
if (mangled[0] == '<')
strcpy (demangled, mangled);
else
sprintf (demangled, "<%s>", mangled);
return demangled;
}
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 (DEPRECATED_STREQN (sym_name, name, len_name)
&& is_name_suffix (sym_name + len_name))
|| (DEPRECATED_STREQN (sym_name, "_ada_", 5)
&& DEPRECATED_STREQN (sym_name + 5, name, len_name)
&& 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 (DEPRECATED_SYMBOL_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 + sizeof (LONGEST) * bitpos / (8 * sizeof (LONGEST)),
fieldval, bitpos % (8 * sizeof (LONGEST)), bitsize);
}
static struct type *
desc_base_type (struct type *type)
{
if (type == NULL)
return NULL;
CHECK_TYPEDEF (type);
if (type != NULL && TYPE_CODE (type) == TYPE_CODE_PTR)
return 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 check_typedef (r);
}
else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
{
r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
if (r != NULL)
return check_typedef (TYPE_TARGET_TYPE (check_typedef (r)));
}
return NULL;
}
static struct value *
desc_bounds (struct value *arr)
{
struct type *type = 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 (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;
}
int
ada_is_simple_array (struct type *type)
{
if (type == NULL)
return 0;
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 (struct type *type)
{
struct type *data_type = desc_data_type (type);
if (type == NULL)
return 0;
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);
}
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 (VALUE_TYPE (arr)))
return VALUE_TYPE (arr);
if (!bounds)
return
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 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 (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;
}
struct value *
ada_coerce_to_simple_array (struct value *arr)
{
if (ada_is_array_descriptor (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;
VALUE_TYPE (dummy) = type;
result = ada_type_of_array (dummy, 0);
value_free_to_mark (dummy);
return result;
}
int
ada_is_packed_array_type (struct type *type)
{
if (type == NULL)
return 0;
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;
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 (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 (new_type) = 0;
else
{
*elt_bits *= (high_bound - low_bound + 1);
TYPE_LENGTH (new_type) =
(*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
}
return new_type;
}
static struct type *
decode_packed_array_type (struct type *type)
{
struct symbol **syms;
struct block **blocks;
const char *raw_name = ada_type_name (check_typedef (type));
char *name = (char *) alloca (strlen (raw_name) + 1);
char *tail = strstr (raw_name, "___XP");
struct type *shadow_type;
long bits;
int i, n;
memcpy (name, raw_name, tail - raw_name);
name[tail - raw_name] = '\000';
n = ada_lookup_symbol_list (name, get_selected_block (NULL),
VAR_DOMAIN, &syms, &blocks);
for (i = 0; i < n; i += 1)
if (syms[i] != NULL && SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF
&& DEPRECATED_STREQ (name, ada_type_name (SYMBOL_TYPE (syms[i]))))
break;
if (i >= n)
{
warning ("could not find bounds information on packed array");
return NULL;
}
shadow_type = SYMBOL_TYPE (syms[i]);
if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY)
{
warning ("could not understand bounds information on packed array");
return NULL;
}
if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
{
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 = decode_packed_array_type (VALUE_TYPE (arr));
if (type == NULL)
{
error ("can't unpack array");
return NULL;
}
else
return coerce_unspec_val_to_type (arr, 0, 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 = 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)
{
warning ("don't know bounds of array");
lowerbound = upperbound = 0;
}
idx = value_as_long (value_pos_atr (ind[i]));
if (idx < lowerbound || idx > upperbound)
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 = 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, char *valaddr, long offset,
int bit_offset, int bit_size,
struct type *type)
{
struct value *v;
int src,
targ,
i, 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;
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, NULL);
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;
VALUE_BITPOS (v) = bit_offset + VALUE_BITPOS (obj);
VALUE_BITSIZE (v) = bit_size;
if (VALUE_BITPOS (v) >= HOST_CHAR_BIT)
{
VALUE_ADDRESS (v) += 1;
VALUE_BITPOS (v) -= HOST_CHAR_BIT;
}
}
else
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 (char *target, int targ_offset, char *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 (!toval->modifiable)
error ("Left operand of assignment is not a modifiable lvalue.");
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));
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 = 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);
if (lwb == 0)
idx = ind[k];
else
idx = value_sub (ind[k], value_from_longest (builtin_type_int, lwb));
arr = value_add (arr, idx);
type = TYPE_TARGET_TYPE (type);
}
return value_ind (arr);
}
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 = 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 = 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)
{
type = desc_base_type (type);
if (n > ada_array_arity (type))
return NULL;
if (ada_is_simple_array (type))
{
int i;
for (i = 1; i < n; i += 1)
type = TYPE_TARGET_TYPE (type);
return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0));
}
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 (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 (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 = check_typedef (VALUE_TYPE (arr));
struct type *index_type_desc;
if (ada_is_packed_array_type (arr_type))
return ada_array_length (decode_packed_array (arr), n);
if (ada_is_simple_array (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_ada_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 const char *
ada_op_name (enum exp_opcode op)
{
int i;
for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
{
if (ada_opname_table[i].op == op)
return ada_opname_table[i].demangled;
}
error ("Could not find operator name for opcode");
}
void
ada_resolve (struct expression **expp, struct type *context_type)
{
int pc;
pc = 0;
ada_resolve_subexp (expp, &pc, 1, context_type);
}
static struct value *
ada_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_VAR_VALUE:
*pos += 4;
break;
case OP_FUNCALL:
nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1;
exp = *expp;
break;
case UNOP_ADDR:
nargs = 1;
*pos += 1;
ada_resolve_subexp (expp, pos, 0, NULL);
exp = *expp;
break;
case BINOP_ASSIGN:
{
struct value *arg1;
nargs = 2;
*pos += 1;
arg1 = ada_resolve_subexp (expp, pos, 0, NULL);
if (arg1 == NULL)
ada_resolve_subexp (expp, pos, 1, NULL);
else
ada_resolve_subexp (expp, pos, 1, VALUE_TYPE (arg1));
break;
}
default:
switch (op)
{
default:
error ("Unexpected operator during name resolution");
case UNOP_CAST:
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:
nargs = 2;
*pos += 1;
break;
case UNOP_NEG:
case UNOP_PLUS:
case UNOP_LOGICAL_NOT:
case UNOP_ABS:
case UNOP_IND:
nargs = 1;
*pos += 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:
case STRUCTOP_PTR:
nargs = 1;
*pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
break;
case OP_ARRAY:
*pos += 4;
nargs = longest_to_int (exp->elts[pc + 2].longconst) + 1;
nargs -= longest_to_int (exp->elts[pc + 1].longconst);
case TERNOP_SLICE:
}
argvec =
(struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
for (i = 0; i < nargs; i += 1)
argvec[i] = ada_resolve_subexp (expp, pos, 1, NULL);
argvec[i] = NULL;
exp = *expp;
break;
}
switch (op)
{
default:
break;
case OP_VAR_VALUE:
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:
{
}
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 symbol **candidate_syms;
struct block **candidate_blocks;
int n_candidates;
n_candidates =
ada_lookup_symbol_list (ada_mangle (ada_op_name (op)),
(struct block *) NULL, VAR_DOMAIN,
&candidate_syms, &candidate_blocks);
i =
ada_resolve_function (candidate_syms, candidate_blocks,
n_candidates, argvec, nargs,
ada_op_name (op), NULL);
if (i < 0)
break;
replace_operator_with_call (expp, pc, nargs, 1,
candidate_syms[i], candidate_blocks[i]);
exp = *expp;
}
break;
}
*pos = pc;
return evaluate_subexp_type (exp, pos);
}
static int
ada_type_match (struct type *ftype, struct type *atype, int may_deref)
{
CHECK_TYPEDEF (ftype);
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 (atype));
case TYPE_CODE_STRUCT:
if (ada_is_array_descriptor (ftype))
return (TYPE_CODE (atype) == TYPE_CODE_ARRAY
|| ada_is_array_descriptor (atype));
else
return (TYPE_CODE (atype) == TYPE_CODE_STRUCT
&& !ada_is_array_descriptor (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)
{
struct type *ftype = check_typedef (TYPE_FIELD_TYPE (func_type, i));
struct type *atype = check_typedef (VALUE_TYPE (actuals[i]));
if (!ada_type_match (TYPE_FIELD_TYPE (func_type, i),
VALUE_TYPE (actuals[i]), 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 (return_type == NULL)
return 1;
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);
}
int
ada_resolve_function (struct symbol *syms[], struct block *blocks[],
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 = check_typedef (SYMBOL_TYPE (syms[k]));
if (ada_args_match (syms[k], args, nargs)
&& return_match (SYMBOL_TYPE (syms[k]), return_type))
{
syms[m] = syms[k];
if (blocks != NULL)
blocks[m] = blocks[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, blocks, m, 1);
return 0;
}
return 0;
}
static int
mangled_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 && DEPRECATED_STREQN (N0, N1, n0))
return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
}
return (strcmp (N0, N1) < 0);
}
}
static void
sort_choices (struct symbol *syms[], struct block *blocks[], int nsyms)
{
int i, j;
for (i = 1; i < nsyms; i += 1)
{
struct symbol *sym = syms[i];
struct block *block = blocks[i];
int j;
for (j = i - 1; j >= 0; j -= 1)
{
if (mangled_ordered_before (DEPRECATED_SYMBOL_NAME (syms[j]),
DEPRECATED_SYMBOL_NAME (sym)))
break;
syms[j + 1] = syms[j];
blocks[j + 1] = blocks[j];
}
syms[j + 1] = sym;
blocks[j + 1] = block;
}
}
int
user_select_syms (struct symbol *syms[], struct block *blocks[], 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, blocks, nsyms);
for (i = 0; i < nsyms; i += 1)
{
if (syms[i] == NULL)
continue;
if (SYMBOL_CLASS (syms[i]) == LOC_BLOCK)
{
struct symtab_and_line sal = find_function_start_sal (syms[i], 1);
printf_unfiltered ("[%d] %s at %s:%d\n",
i + first_choice,
SYMBOL_PRINT_NAME (syms[i]),
sal.symtab == NULL
? "<no source file available>"
: sal.symtab->filename, sal.line);
continue;
}
else
{
int is_enumeral =
(SYMBOL_CLASS (syms[i]) == LOC_CONST
&& SYMBOL_TYPE (syms[i]) != NULL
&& TYPE_CODE (SYMBOL_TYPE (syms[i])) == TYPE_CODE_ENUM);
struct symtab *symtab = symtab_for_sym (syms[i]);
if (SYMBOL_LINE (syms[i]) != 0 && symtab != NULL)
printf_unfiltered ("[%d] %s at %s:%d\n",
i + first_choice,
SYMBOL_PRINT_NAME (syms[i]),
symtab->filename, SYMBOL_LINE (syms[i]));
else if (is_enumeral && TYPE_NAME (SYMBOL_TYPE (syms[i])) != NULL)
{
printf_unfiltered ("[%d] ", i + first_choice);
ada_print_type (SYMBOL_TYPE (syms[i]), NULL, gdb_stdout, -1, 0);
printf_unfiltered ("'(%s) (enumeral)\n",
SYMBOL_PRINT_NAME (syms[i]));
}
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]),
symtab->filename);
else
printf_unfiltered (is_enumeral
? "[%d] %s (enumeral)\n"
: "[%d] %s at ?\n",
i + first_choice,
SYMBOL_PRINT_NAME (syms[i]));
}
}
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]];
if (blocks != NULL)
blocks[i] = blocks[chosen[i]];
}
return n_chosen;
}
int
get_selections (int *choices, int n_choices, int max_results,
int is_all_choice, char *annotation_suffix)
{
int i;
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 = check_typedef (VALUE_TYPE (args[0]));
struct type *type1 =
(args[1] == NULL) ? NULL : check_typedef (VALUE_TYPE (args[1]));
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] == '_');
}
const 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 *
place_on_stack (struct value *val, CORE_ADDR *sp)
{
CORE_ADDR old_sp = *sp;
#ifdef DEPRECATED_STACK_ALIGN
*sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
DEPRECATED_STACK_ALIGN (TYPE_LENGTH
(check_typedef (VALUE_TYPE (val)))));
#else
*sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val),
TYPE_LENGTH (check_typedef (VALUE_TYPE (val))));
#endif
VALUE_LVAL (val) = lval_memory;
if (INNER_THAN (1, 2))
VALUE_ADDRESS (val) = *sp;
else
VALUE_ADDRESS (val) = old_sp;
return val;
}
static struct value *
convert_actual (struct value *actual, struct type *formal_type0,
CORE_ADDR *sp)
{
struct type *actual_type = check_typedef (VALUE_TYPE (actual));
struct type *formal_type = check_typedef (formal_type0);
struct type *formal_target =
TYPE_CODE (formal_type) == TYPE_CODE_PTR
? check_typedef (TYPE_TARGET_TYPE (formal_type)) : formal_type;
struct type *actual_target =
TYPE_CODE (actual_type) == TYPE_CODE_PTR
? check_typedef (TYPE_TARGET_TYPE (actual_type)) : actual_type;
if (ada_is_array_descriptor (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 (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 = 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 = place_on_stack (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);
CORE_ADDR bounds_addr;
int i;
for (i = ada_array_arity (check_typedef (VALUE_TYPE (arr))); i > 0; i -= 1)
{
modify_general_field (VALUE_CONTENTS (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 (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 = place_on_stack (bounds, sp);
modify_general_field (VALUE_CONTENTS (descriptor),
arr,
fat_pntr_data_bitpos (desc_type),
fat_pntr_data_bitsize (desc_type));
modify_general_field (VALUE_CONTENTS (descriptor),
VALUE_ADDRESS (bounds),
fat_pntr_bounds_bitpos (desc_type),
fat_pntr_bounds_bitsize (desc_type));
descriptor = place_on_stack (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 size_t defn_vector_size = 0;
static int ndefns = 0;
static struct symbol **defn_symbols = NULL;
static struct block **defn_blocks = NULL;
static struct symbol *
standard_lookup (const char *name, domain_enum domain)
{
struct symbol *sym;
sym = lookup_symbol (name, (struct block *) NULL, domain, 0, NULL);
return sym;
}
static int
is_nonfunction (struct symbol *syms[], int n)
{
int i;
for (i = 0; i < n; i += 1)
if (TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_FUNC
&& TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_ENUM)
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
&& DEPRECATED_STREQ (ada_type_name (type0), ada_type_name (type1)))
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 = DEPRECATED_SYMBOL_NAME (sym0);
char *name1 = DEPRECATED_SYMBOL_NAME (sym1);
int len0 = strlen (name0);
return
TYPE_CODE (type0) == TYPE_CODE (type1)
&& (equiv_types (type0, type1)
|| (len0 < strlen (name1) && DEPRECATED_STREQN (name0, name1, len0)
&& DEPRECATED_STREQN (name1 + len0, "___XV", 5)));
}
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 symbol *sym, struct block *block)
{
int i;
size_t tmp;
if (SYMBOL_TYPE (sym) != NULL)
CHECK_TYPEDEF (SYMBOL_TYPE (sym));
for (i = 0; i < ndefns; i += 1)
{
if (lesseq_defined_than (sym, defn_symbols[i]))
return;
else if (lesseq_defined_than (defn_symbols[i], sym))
{
defn_symbols[i] = sym;
defn_blocks[i] = block;
return;
}
}
tmp = defn_vector_size;
GROW_VECT (defn_symbols, tmp, ndefns + 2);
GROW_VECT (defn_blocks, defn_vector_size, ndefns + 2);
defn_symbols[ndefns] = sym;
defn_blocks[ndefns] = block;
ndefns += 1;
}
static struct partial_symbol *
ada_lookup_partial_symbol (struct partial_symtab *pst, const char *name,
int global, domain_enum domain, 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) == domain &&
wild_match (name, name_len, DEPRECATED_SYMBOL_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 (DEPRECATED_SYMBOL_NAME (psym)[0] < name[0])
i = M + 1;
else if (DEPRECATED_SYMBOL_NAME (psym)[0] > name[0])
U = M - 1;
else if (strcmp (DEPRECATED_SYMBOL_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) == domain)
{
int cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (psym), name_len);
if (cmp < 0)
{
if (global)
break;
}
else if (cmp == 0
&& is_name_suffix (DEPRECATED_SYMBOL_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 (DEPRECATED_SYMBOL_NAME (psym)[0] < '_')
i = M + 1;
else if (DEPRECATED_SYMBOL_NAME (psym)[0] > '_')
U = M - 1;
else if (strcmp (DEPRECATED_SYMBOL_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) == domain)
{
int cmp;
cmp = (int) '_' - (int) DEPRECATED_SYMBOL_NAME (psym)[0];
if (cmp == 0)
{
cmp = strncmp ("_ada_", DEPRECATED_SYMBOL_NAME (psym), 5);
if (cmp == 0)
cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (psym) + 5, name_len);
}
if (cmp < 0)
{
if (global)
break;
}
else if (cmp == 0
&& is_name_suffix (DEPRECATED_SYMBOL_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_minimal_symbol (const char *name)
{
struct objfile *objfile;
struct minimal_symbol *msymbol;
int wild_match = (strstr (name, "__") == NULL);
ALL_MSYMBOLS (objfile, msymbol)
{
if (ada_match_name (DEPRECATED_SYMBOL_NAME (msymbol), name, wild_match)
&& MSYMBOL_TYPE (msymbol) != mst_solib_trampoline)
return msymbol;
}
return NULL;
}
static void
add_symbols_from_enclosing_procs (const char *name, domain_enum domain,
int wild_match)
{
#ifdef i386
static struct symbol static_link_sym;
static struct symbol *static_link;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
struct frame_info *frame;
struct frame_info *target_frame;
if (static_link == NULL)
{
static_link = &static_link_sym;
DEPRECATED_SYMBOL_NAME (static_link) = "";
SYMBOL_LANGUAGE (static_link) = language_unknown;
SYMBOL_CLASS (static_link) = LOC_LOCAL;
SYMBOL_DOMAIN (static_link) = VAR_DOMAIN;
SYMBOL_TYPE (static_link) = lookup_pointer_type (builtin_type_void);
SYMBOL_VALUE (static_link) =
-(long) TYPE_LENGTH (SYMBOL_TYPE (static_link));
}
frame = deprecated_selected_frame;
while (frame != NULL && ndefns == 0)
{
struct block *block;
struct value *target_link_val = read_var_value (static_link, frame);
CORE_ADDR target_link;
if (target_link_val == NULL)
break;
QUIT;
target_link = target_link_val;
do
{
QUIT;
frame = get_prev_frame (frame);
}
while (frame != NULL && DEPRECATED_FRAME_LOCALS_ADDRESS (frame) != target_link);
if (frame == NULL)
break;
block = get_frame_block (frame, 0);
while (block != NULL && block_function (block) != NULL && ndefns == 0)
{
ada_add_block_symbols (block, name, domain, NULL, wild_match);
block = BLOCK_SUPERBLOCK (block);
}
}
do_cleanups (old_chain);
#endif
}
static int
is_nondebugging_type (struct type *type)
{
char *name = ada_type_name (type);
return (name != NULL && DEPRECATED_STREQ (name, "<variable, no debug info>"));
}
static int
remove_extra_symbols (struct symbol **syms, struct block **blocks, int nsyms)
{
int i, j;
i = 0;
while (i < nsyms)
{
if (DEPRECATED_SYMBOL_NAME (syms[i]) != NULL
&& SYMBOL_CLASS (syms[i]) == LOC_STATIC
&& is_nondebugging_type (SYMBOL_TYPE (syms[i])))
{
for (j = 0; j < nsyms; j += 1)
{
if (i != j
&& DEPRECATED_SYMBOL_NAME (syms[j]) != NULL
&& DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (syms[i]), DEPRECATED_SYMBOL_NAME (syms[j]))
&& SYMBOL_CLASS (syms[i]) == SYMBOL_CLASS (syms[j])
&& SYMBOL_VALUE_ADDRESS (syms[i])
== SYMBOL_VALUE_ADDRESS (syms[j]))
{
int k;
for (k = i + 1; k < nsyms; k += 1)
{
syms[k - 1] = syms[k];
blocks[k - 1] = blocks[k];
}
nsyms -= 1;
goto NextSymbol;
}
}
}
i += 1;
NextSymbol:
;
}
return nsyms;
}
int
ada_lookup_symbol_list (const char *name, struct block *block0,
domain_enum domain, struct symbol ***syms,
struct block ***blocks)
{
struct symbol *sym;
struct symtab *s;
struct partial_symtab *ps;
struct blockvector *bv;
struct objfile *objfile;
struct block *b;
struct block *block;
struct minimal_symbol *msymbol;
int wild_match = (strstr (name, "__") == NULL);
int cacheIfUnique;
#ifdef TIMING
markTimeStart (0);
#endif
ndefns = 0;
cacheIfUnique = 0;
block = block0;
while (block != NULL)
{
ada_add_block_symbols (block, name, domain, NULL, wild_match);
if (is_nonfunction (defn_symbols, ndefns))
goto done;
block = BLOCK_SUPERBLOCK (block);
}
if (ndefns > 0)
goto done;
cacheIfUnique = 1;
ALL_SYMTABS (objfile, s)
{
QUIT;
if (!s->primary)
continue;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
ada_add_block_symbols (block, name, domain, objfile, wild_match);
}
if (domain == VAR_DOMAIN)
{
ALL_MSYMBOLS (objfile, msymbol)
{
if (ada_match_name (DEPRECATED_SYMBOL_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 old_ndefns = ndefns;
QUIT;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
ada_add_block_symbols (block,
DEPRECATED_SYMBOL_NAME (msymbol),
domain, objfile, wild_match);
if (ndefns == old_ndefns)
{
block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
ada_add_block_symbols (block,
DEPRECATED_SYMBOL_NAME (msymbol),
domain, objfile,
wild_match);
}
}
}
}
}
}
ALL_PSYMTABS (objfile, ps)
{
QUIT;
if (!ps->readin
&& ada_lookup_partial_symbol (ps, name, 1, domain, wild_match))
{
s = PSYMTAB_TO_SYMTAB (ps);
if (!s->primary)
continue;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK);
ada_add_block_symbols (block, name, domain, objfile, wild_match);
}
}
if (ndefns == 0)
{
ALL_SYMTABS (objfile, s)
{
QUIT;
if (!s->primary)
continue;
bv = BLOCKVECTOR (s);
block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
ada_add_block_symbols (block, name, domain, objfile, wild_match);
}
ALL_PSYMTABS (objfile, ps)
{
QUIT;
if (!ps->readin
&& ada_lookup_partial_symbol (ps, name, 0, domain, wild_match))
{
s = PSYMTAB_TO_SYMTAB (ps);
bv = BLOCKVECTOR (s);
if (!s->primary)
continue;
block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK);
ada_add_block_symbols (block, name, domain,
objfile, wild_match);
}
}
}
if (ndefns == 0)
{
add_symbols_from_enclosing_procs (name, domain, wild_match);
if (ndefns > 0)
goto done;
}
done:
ndefns = remove_extra_symbols (defn_symbols, defn_blocks, ndefns);
*syms = defn_symbols;
*blocks = defn_blocks;
#ifdef TIMING
markTimeStop (0);
#endif
return ndefns;
}
struct symbol *
ada_lookup_symbol (const char *name, struct block *block0,
domain_enum domain)
{
struct symbol **candidate_syms;
struct block **candidate_blocks;
int n_candidates;
n_candidates = ada_lookup_symbol_list (name,
block0, domain,
&candidate_syms, &candidate_blocks);
if (n_candidates == 0)
return NULL;
else if (n_candidates != 1)
user_select_syms (candidate_syms, candidate_blocks, n_candidates, 1);
return candidate_syms[0];
}
static int
is_name_suffix (const char *str)
{
int k;
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 (DEPRECATED_STREQ (str + 3, "LJM"))
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;
}
for (k = 2; str[k] != '\0'; k += 1)
if (!isdigit (str[k]))
return 0;
return 1;
}
if (str[0] == '$' && str[1] != '\000')
{
for (k = 1; str[k] != '\0'; k += 1)
if (!isdigit (str[k]))
return 0;
return 1;
}
return 0;
}
static int
wild_match (const char *patn, int patn_len, const char *name)
{
int name_len;
int s, e;
name_len = strlen (name);
if (name_len >= patn_len + 5 && DEPRECATED_STREQN (name, "_ada_", 5)
&& DEPRECATED_STREQN (patn, name + 5, patn_len)
&& is_name_suffix (name + patn_len + 5))
return 1;
while (name_len >= patn_len)
{
if (DEPRECATED_STREQN (patn, name, patn_len) && 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 block *block, const char *name,
domain_enum domain, struct objfile *objfile,
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, DEPRECATED_SYMBOL_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;
fill_in_ada_prototype (sym);
add_defn_to_vec (fixup_symbol_section (sym, objfile), block);
break;
}
}
}
}
else
{
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
if (SYMBOL_DOMAIN (sym) == domain)
{
int cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (sym), name_len);
if (cmp == 0
&& is_name_suffix (DEPRECATED_SYMBOL_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;
fill_in_ada_prototype (sym);
add_defn_to_vec (fixup_symbol_section (sym, objfile),
block);
break;
}
}
}
}
}
if (!found_sym && arg_sym != NULL)
{
fill_in_ada_prototype (arg_sym);
add_defn_to_vec (fixup_symbol_section (arg_sym, objfile), block);
}
if (!wild)
{
arg_sym = NULL;
found_sym = 0;
ALL_BLOCK_SYMBOLS (block, iter, sym)
{
if (SYMBOL_DOMAIN (sym) == domain)
{
int cmp;
cmp = (int) '_' - (int) DEPRECATED_SYMBOL_NAME (sym)[0];
if (cmp == 0)
{
cmp = strncmp ("_ada_", DEPRECATED_SYMBOL_NAME (sym), 5);
if (cmp == 0)
cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (sym) + 5, name_len);
}
if (cmp == 0
&& is_name_suffix (DEPRECATED_SYMBOL_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;
fill_in_ada_prototype (sym);
add_defn_to_vec (fixup_symbol_section (sym, objfile),
block);
break;
}
}
}
}
if (!found_sym && arg_sym != NULL)
{
fill_in_ada_prototype (arg_sym);
add_defn_to_vec (fixup_symbol_section (arg_sym, objfile), block);
}
}
}
static void
fill_in_ada_prototype (struct symbol *func)
{
struct block *b;
int nargs, nsyms;
struct dict_iterator iter;
struct type *ftype;
struct type *rtype;
size_t max_fields;
struct symbol *sym;
if (func == NULL
|| TYPE_CODE (SYMBOL_TYPE (func)) != TYPE_CODE_FUNC
|| TYPE_FIELDS (SYMBOL_TYPE (func)) != NULL)
return;
rtype = check_typedef (TYPE_TARGET_TYPE (SYMBOL_TYPE (func)));
ftype = alloc_type (TYPE_OBJFILE (SYMBOL_TYPE (func)));
make_function_type (rtype, &ftype);
SYMBOL_TYPE (func) = ftype;
b = SYMBOL_BLOCK_VALUE (func);
nargs = 0;
max_fields = 8;
TYPE_FIELDS (ftype) =
(struct field *) xmalloc (sizeof (struct field) * max_fields);
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
GROW_VECT (TYPE_FIELDS (ftype), max_fields, nargs + 1);
switch (SYMBOL_CLASS (sym))
{
case LOC_REF_ARG:
case LOC_REGPARM_ADDR:
TYPE_FIELD_BITPOS (ftype, nargs) = nargs;
TYPE_FIELD_BITSIZE (ftype, nargs) = 0;
TYPE_FIELD_STATIC_KIND (ftype, nargs) = 0;
TYPE_FIELD_TYPE (ftype, nargs) =
lookup_pointer_type (check_typedef (SYMBOL_TYPE (sym)));
TYPE_FIELD_NAME (ftype, nargs) = DEPRECATED_SYMBOL_NAME (sym);
nargs += 1;
break;
case LOC_ARG:
case LOC_REGPARM:
case LOC_LOCAL_ARG:
case LOC_BASEREG_ARG:
case LOC_COMPUTED_ARG:
TYPE_FIELD_BITPOS (ftype, nargs) = nargs;
TYPE_FIELD_BITSIZE (ftype, nargs) = 0;
TYPE_FIELD_STATIC_KIND (ftype, nargs) = 0;
TYPE_FIELD_TYPE (ftype, nargs) = check_typedef (SYMBOL_TYPE (sym));
TYPE_FIELD_NAME (ftype, nargs) = DEPRECATED_SYMBOL_NAME (sym);
nargs += 1;
break;
default:
break;
}
}
TYPE_NFIELDS (ftype) = nargs;
if (nargs == 0)
{
static struct field dummy_field = { 0, 0, 0, 0 };
xfree (TYPE_FIELDS (ftype));
TYPE_FIELDS (ftype) = &dummy_field;
}
else
{
struct field *fields =
(struct field *) TYPE_ALLOC (ftype, nargs * sizeof (struct field));
memcpy ((char *) fields,
(char *) TYPE_FIELDS (ftype), nargs * sizeof (struct field));
xfree (TYPE_FIELDS (ftype));
TYPE_FIELDS (ftype) = fields;
}
}
char no_symtab_msg[] =
"No symbol table is loaded. Use the \"file\" command.";
char *
ada_start_decode_line_1 (char *line)
{
char *p;
for (p = line; *p != '\000' && *p != ' ' && *p != ':'; p += 1)
;
return p;
}
struct symtabs_and_lines
ada_finish_decode_line_1 (char **spec, struct symtab *file_table,
int funfirstline, char ***canonical)
{
struct symbol **symbols;
struct block **blocks;
struct block *block;
int n_matches, i, line_num;
struct symtabs_and_lines selected;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
char *name;
int len;
char *lower_name;
char *unquoted_name;
if (file_table == NULL)
block = get_selected_block (NULL);
else
block = BLOCKVECTOR_BLOCK (BLOCKVECTOR (file_table), STATIC_BLOCK);
if (canonical != NULL)
*canonical = (char **) NULL;
name = *spec;
if (**spec == '*')
*spec += 1;
else
{
while (**spec != '\000' &&
!strchr (ada_completer_word_break_characters, **spec))
*spec += 1;
}
len = *spec - name;
line_num = -1;
if (file_table != NULL && (*spec)[0] == ':' && isdigit ((*spec)[1]))
{
line_num = strtol (*spec + 1, spec, 10);
while (**spec == ' ' || **spec == '\t')
*spec += 1;
}
if (name[0] == '*')
{
if (line_num == -1)
error ("Wild-card function with no line number or file name.");
return all_sals_for_line (file_table->filename, line_num, canonical);
}
if (name[0] == '\'')
{
name += 1;
len -= 2;
}
if (name[0] == '<')
{
unquoted_name = (char *) alloca (len - 1);
memcpy (unquoted_name, name + 1, len - 2);
unquoted_name[len - 2] = '\000';
lower_name = NULL;
}
else
{
unquoted_name = (char *) alloca (len + 1);
memcpy (unquoted_name, name, len);
unquoted_name[len] = '\000';
lower_name = (char *) alloca (len + 1);
for (i = 0; i < len; i += 1)
lower_name[i] = tolower (name[i]);
lower_name[len] = '\000';
}
n_matches = 0;
if (lower_name != NULL)
n_matches = ada_lookup_symbol_list (ada_mangle (lower_name), block,
VAR_DOMAIN, &symbols, &blocks);
if (n_matches == 0)
n_matches = ada_lookup_symbol_list (unquoted_name, block,
VAR_DOMAIN, &symbols, &blocks);
if (n_matches == 0 && line_num >= 0)
error ("No line number information found for %s.", unquoted_name);
else if (n_matches == 0)
{
#ifdef HPPA_COMPILER_BUG
#undef volatile
volatile struct symtab_and_line val;
#define volatile
#else
struct symtab_and_line val;
#endif
struct minimal_symbol *msymbol;
init_sal (&val);
msymbol = NULL;
if (lower_name != NULL)
msymbol = ada_lookup_minimal_symbol (ada_mangle (lower_name));
if (msymbol == NULL)
msymbol = ada_lookup_minimal_symbol (unquoted_name);
if (msymbol != NULL)
{
val.pc = SYMBOL_VALUE_ADDRESS (msymbol);
val.section = SYMBOL_BFD_SECTION (msymbol);
if (funfirstline)
{
val.pc += FUNCTION_START_OFFSET;
SKIP_PROLOGUE (val.pc);
}
selected.sals = (struct symtab_and_line *)
xmalloc (sizeof (struct symtab_and_line));
selected.sals[0] = val;
selected.nelts = 1;
return selected;
}
if (!have_full_symbols () &&
!have_partial_symbols () && !have_minimal_symbols ())
error (no_symtab_msg);
error ("Function \"%s\" not defined.", unquoted_name);
return selected;
}
if (line_num >= 0)
{
return
find_sal_from_funcs_and_line (file_table->filename, line_num,
symbols, n_matches);
}
else
{
selected.nelts =
user_select_syms (symbols, blocks, n_matches, n_matches);
}
selected.sals = (struct symtab_and_line *)
xmalloc (sizeof (struct symtab_and_line) * selected.nelts);
memset (selected.sals, 0, selected.nelts * sizeof (selected.sals[i]));
make_cleanup (xfree, selected.sals);
i = 0;
while (i < selected.nelts)
{
if (SYMBOL_CLASS (symbols[i]) == LOC_BLOCK)
selected.sals[i] = find_function_start_sal (symbols[i], funfirstline);
else if (SYMBOL_LINE (symbols[i]) != 0)
{
selected.sals[i].symtab = symtab_for_sym (symbols[i]);
selected.sals[i].line = SYMBOL_LINE (symbols[i]);
}
else if (line_num >= 0)
{
symbols[i] = symbols[selected.nelts - 1];
blocks[i] = blocks[selected.nelts - 1];
selected.nelts -= 1;
continue;
}
else
error ("Line number not known for symbol \"%s\"", unquoted_name);
i += 1;
}
if (canonical != NULL && (line_num >= 0 || n_matches > 1))
{
*canonical = (char **) xmalloc (sizeof (char *) * selected.nelts);
for (i = 0; i < selected.nelts; i += 1)
(*canonical)[i] =
extended_canonical_line_spec (selected.sals[i],
SYMBOL_PRINT_NAME (symbols[i]));
}
discard_cleanups (old_chain);
return selected;
}
static struct symtabs_and_lines
find_sal_from_funcs_and_line (const char *filename, int line_num,
struct symbol **symbols, int nsyms)
{
struct symtabs_and_lines sals;
int best_index, best;
struct linetable *best_linetable;
struct objfile *objfile;
struct symtab *s;
struct symtab *best_symtab;
read_all_symtabs (filename);
best_index = 0;
best_linetable = NULL;
best_symtab = NULL;
best = 0;
ALL_SYMTABS (objfile, s)
{
struct linetable *l;
int ind, exact;
QUIT;
if (!DEPRECATED_STREQ (filename, s->filename))
continue;
l = LINETABLE (s);
ind = find_line_in_linetable (l, line_num, symbols, nsyms, &exact);
if (ind >= 0)
{
if (exact)
{
best_index = ind;
best_linetable = l;
best_symtab = s;
goto done;
}
if (best == 0 || l->item[ind].line < best)
{
best = l->item[ind].line;
best_index = ind;
best_linetable = l;
best_symtab = s;
}
}
}
if (best == 0)
error ("Line number not found in designated function.");
done:
sals.nelts = 1;
sals.sals = (struct symtab_and_line *) xmalloc (sizeof (sals.sals[0]));
init_sal (&sals.sals[0]);
sals.sals[0].line = best_linetable->item[best_index].line;
sals.sals[0].pc = best_linetable->item[best_index].pc;
sals.sals[0].symtab = best_symtab;
return sals;
}
static int
find_line_in_linetable (struct linetable *linetable, int line_num,
struct symbol **symbols, int nsyms, int *exactp)
{
int i, len, best_index, best;
if (line_num <= 0 || linetable == NULL)
return -1;
len = linetable->nitems;
for (i = 0, best_index = -1, best = 0; i < len; i += 1)
{
int k;
struct linetable_entry *item = &(linetable->item[i]);
for (k = 0; k < nsyms; k += 1)
{
if (symbols[k] != NULL && SYMBOL_CLASS (symbols[k]) == LOC_BLOCK
&& item->pc >= BLOCK_START (SYMBOL_BLOCK_VALUE (symbols[k]))
&& item->pc < BLOCK_END (SYMBOL_BLOCK_VALUE (symbols[k])))
goto candidate;
}
continue;
candidate:
if (item->line == line_num)
{
*exactp = 1;
return i;
}
if (item->line > line_num && (best == 0 || item->line < best))
{
best = item->line;
best_index = i;
}
}
*exactp = 0;
return best_index;
}
static int
nearest_line_number_in_linetable (struct linetable *linetable, int line_num)
{
int i, len, best;
if (line_num <= 0 || linetable == NULL || linetable->nitems == 0)
return -1;
len = linetable->nitems;
i = 0;
best = INT_MAX;
while (i < len)
{
int k;
struct linetable_entry *item = &(linetable->item[i]);
if (item->line >= line_num && item->line < best)
{
char *func_name;
CORE_ADDR start, end;
func_name = NULL;
find_pc_partial_function (item->pc, &func_name, &start, &end);
if (func_name != NULL && item->pc < end)
{
if (item->line == line_num)
return line_num;
else
{
struct symbol *sym =
standard_lookup (func_name, VAR_DOMAIN);
if (is_plausible_func_for_line (sym, line_num))
best = item->line;
else
{
do
i += 1;
while (i < len && linetable->item[i].pc < end);
continue;
}
}
}
}
i += 1;
}
return (best == INT_MAX) ? -1 : best;
}
static int
find_next_line_in_linetable (struct linetable *linetable, int line_num,
int starting_line, int ind)
{
int i, len;
if (line_num <= 0 || linetable == NULL || ind >= linetable->nitems)
return -1;
len = linetable->nitems;
if (ind >= 0)
{
CORE_ADDR start, end;
if (find_pc_partial_function (linetable->item[ind].pc,
(char **) NULL, &start, &end))
{
while (ind < len && linetable->item[ind].pc < end)
ind += 1;
}
else
ind += 1;
}
else
ind = 0;
i = ind;
while (i < len)
{
int k;
struct linetable_entry *item = &(linetable->item[i]);
if (item->line >= line_num)
{
char *func_name;
CORE_ADDR start, end;
func_name = NULL;
find_pc_partial_function (item->pc, &func_name, &start, &end);
if (func_name != NULL && item->pc < end)
{
if (item->line == line_num)
{
struct symbol *sym =
standard_lookup (func_name, VAR_DOMAIN);
if (is_plausible_func_for_line (sym, starting_line))
return i;
else
{
while ((i + 1) < len && linetable->item[i + 1].pc < end)
i += 1;
}
}
}
}
i += 1;
}
return -1;
}
static int
is_plausible_func_for_line (struct symbol *sym, int line_num)
{
struct symtab_and_line start_sal;
if (sym == NULL)
return 0;
start_sal = find_function_start_sal (sym, 0);
return (start_sal.line != 0 && line_num >= start_sal.line);
}
static void
debug_print_lines (struct linetable *lt)
{
int i;
if (lt == NULL)
return;
fprintf (stderr, "\t");
for (i = 0; i < lt->nitems; i += 1)
fprintf (stderr, "(%d->%p) ", lt->item[i].line, (void *) lt->item[i].pc);
fprintf (stderr, "\n");
}
static void
debug_print_block (struct block *b)
{
struct dict_iterator iter;
struct symbol *sym;
fprintf (stderr, "Block: %p; [0x%lx, 0x%lx]",
b, BLOCK_START (b), BLOCK_END (b));
if (BLOCK_FUNCTION (b) != NULL)
fprintf (stderr, " Function: %s", DEPRECATED_SYMBOL_NAME (BLOCK_FUNCTION (b)));
fprintf (stderr, "\n");
fprintf (stderr, "\t Superblock: %p\n", BLOCK_SUPERBLOCK (b));
fprintf (stderr, "\t Symbols:");
ALL_BLOCK_SYMBOLS (b, iter, sym)
{
fprintf (stderr, " %s", DEPRECATED_SYMBOL_NAME (sym));
}
fprintf (stderr, "\n");
}
static void
debug_print_blocks (struct blockvector *bv)
{
int i;
if (bv == NULL)
return;
for (i = 0; i < BLOCKVECTOR_NBLOCKS (bv); i += 1)
{
fprintf (stderr, "%6d. ", i);
debug_print_block (BLOCKVECTOR_BLOCK (bv, i));
}
}
static void
debug_print_symtab (struct symtab *s)
{
fprintf (stderr, "Symtab %p\n File: %s; Dir: %s\n", s,
s->filename, s->dirname);
fprintf (stderr, " Blockvector: %p, Primary: %d\n",
BLOCKVECTOR (s), s->primary);
debug_print_blocks (BLOCKVECTOR (s));
fprintf (stderr, " Line table: %p\n", LINETABLE (s));
debug_print_lines (LINETABLE (s));
}
static void
read_all_symtabs (const char *filename)
{
struct partial_symtab *ps;
struct objfile *objfile;
ALL_PSYMTABS (objfile, ps)
{
QUIT;
if (DEPRECATED_STREQ (filename, ps->filename))
PSYMTAB_TO_SYMTAB (ps);
}
}
static struct symtabs_and_lines
all_sals_for_line (const char *filename, int line_num, char ***canonical)
{
struct symtabs_and_lines result;
struct objfile *objfile;
struct symtab *s;
struct cleanup *old_chain = make_cleanup (null_cleanup, NULL);
size_t len;
read_all_symtabs (filename);
result.sals =
(struct symtab_and_line *) xmalloc (4 * sizeof (result.sals[0]));
result.nelts = 0;
len = 4;
make_cleanup (free_current_contents, &result.sals);
ALL_SYMTABS (objfile, s)
{
int ind, target_line_num;
QUIT;
if (!DEPRECATED_STREQ (s->filename, filename))
continue;
target_line_num =
nearest_line_number_in_linetable (LINETABLE (s), line_num);
if (target_line_num == -1)
continue;
ind = -1;
while (1)
{
ind =
find_next_line_in_linetable (LINETABLE (s),
target_line_num, line_num, ind);
if (ind < 0)
break;
GROW_VECT (result.sals, len, result.nelts + 1);
init_sal (&result.sals[result.nelts]);
result.sals[result.nelts].line = LINETABLE (s)->item[ind].line;
result.sals[result.nelts].pc = LINETABLE (s)->item[ind].pc;
result.sals[result.nelts].symtab = s;
result.nelts += 1;
}
}
if (canonical != NULL || result.nelts > 1)
{
int k;
char **func_names = (char **) alloca (result.nelts * sizeof (char *));
int first_choice = (result.nelts > 1) ? 2 : 1;
int n;
int *choices = (int *) alloca (result.nelts * sizeof (int));
for (k = 0; k < result.nelts; k += 1)
{
find_pc_partial_function (result.sals[k].pc, &func_names[k],
(CORE_ADDR *) NULL, (CORE_ADDR *) NULL);
if (func_names[k] == NULL)
error ("Could not find function for one or more breakpoints.");
}
if (result.nelts > 1)
{
printf_unfiltered ("[0] cancel\n");
if (result.nelts > 1)
printf_unfiltered ("[1] all\n");
for (k = 0; k < result.nelts; k += 1)
printf_unfiltered ("[%d] %s\n", k + first_choice,
ada_demangle (func_names[k]));
n = get_selections (choices, result.nelts, result.nelts,
result.nelts > 1, "instance-choice");
for (k = 0; k < n; k += 1)
{
result.sals[k] = result.sals[choices[k]];
func_names[k] = func_names[choices[k]];
}
result.nelts = n;
}
if (canonical != NULL)
{
*canonical = (char **) xmalloc (result.nelts * sizeof (char **));
make_cleanup (xfree, *canonical);
for (k = 0; k < result.nelts; k += 1)
{
(*canonical)[k] =
extended_canonical_line_spec (result.sals[k], func_names[k]);
if ((*canonical)[k] == NULL)
error ("Could not locate one or more breakpoints.");
make_cleanup (xfree, (*canonical)[k]);
}
}
}
discard_cleanups (old_chain);
return result;
}
static char *
extended_canonical_line_spec (struct symtab_and_line sal, const char *name)
{
char *r;
if (sal.symtab == NULL || sal.symtab->filename == NULL || sal.line <= 0)
return NULL;
r = (char *) xmalloc (strlen (name) + strlen (sal.symtab->filename)
+ sizeof (sal.line) * 3 + 3);
sprintf (r, "%s:'%s':%d", sal.symtab->filename, name, sal.line);
return r;
}
#if 0
int begin_bnum = -1;
#endif
int begin_annotate_level = 0;
static void
begin_cleanup (void *dummy)
{
begin_annotate_level = 0;
}
static void
begin_command (char *args, int from_tty)
{
struct minimal_symbol *msym;
CORE_ADDR main_program_name_addr;
char main_program_name[1024];
struct cleanup *old_chain = make_cleanup (begin_cleanup, NULL);
begin_annotate_level = 2;
if (!have_full_symbols () && !have_partial_symbols ())
error ("No symbol table is loaded. Use the \"file\" command.");
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);
do_command ("tbreak ", main_program_name, 0);
do_command ("run ", args, 0);
}
else
{
do_command ("tbreak adainit", 0);
do_command ("run ", args, 0);
do_command ("up", 0);
do_command ("tbreak +2", 0);
do_command ("continue", 0);
do_command ("step", 0);
}
do_cleanups (old_chain);
}
int
is_ada_runtime_file (char *filename)
{
return (DEPRECATED_STREQN (filename, "s-", 2) ||
DEPRECATED_STREQN (filename, "a-", 2) ||
DEPRECATED_STREQN (filename, "g-", 2) || DEPRECATED_STREQN (filename, "i-", 2));
}
int
find_printable_frame (struct frame_info *fi, int level)
{
struct symtab_and_line sal;
for (; fi != NULL; level += 1, fi = get_prev_frame (fi))
{
find_frame_sal (fi, &sal);
if (sal.symtab && !is_ada_runtime_file (sal.symtab->filename))
{
#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
if (sal.symtab->objfile &&
DEPRECATED_STREQ (sal.symtab->objfile->name, "/usr/shlib/libpthread.so"))
continue;
#endif
deprecated_selected_frame = fi;
break;
}
}
return level;
}
void
ada_report_exception_break (struct breakpoint *b)
{
}
int
ada_is_exception_sym (struct symbol *sym)
{
char *type_name = type_name_no_tag (SYMBOL_TYPE (sym));
return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
&& SYMBOL_CLASS (sym) != LOC_BLOCK
&& SYMBOL_CLASS (sym) != LOC_CONST
&& type_name != NULL && DEPRECATED_STREQ (type_name, "exception"));
}
int
ada_maybe_exception_partial_symbol (struct partial_symbol *sym)
{
return (SYMBOL_CLASS (sym) != LOC_TYPEDEF
&& SYMBOL_CLASS (sym) != LOC_BLOCK
&& SYMBOL_CLASS (sym) != LOC_CONST);
}
char *
ada_breakpoint_rewrite (char *arg, int *break_on_exceptionp)
{
if (arg == NULL)
return arg;
*break_on_exceptionp = 0;
return arg;
}
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] == '_' && !DEPRECATED_STREQN (name, "_parent", 7)));
}
}
int
ada_is_tagged_type (struct type *type)
{
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT)
return 0;
return (ada_lookup_struct_elt_type (type, "_tag", 1, NULL) != NULL);
}
struct type *
ada_tag_type (struct value *val)
{
return ada_lookup_struct_elt_type (VALUE_TYPE (val), "_tag", 0, NULL);
}
struct value *
ada_value_tag (struct value *val)
{
return ada_value_struct_elt (val, "_tag", "record");
}
struct type *
ada_parent_type (struct type *type)
{
int i;
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 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 (check_typedef (type), field_num);
return (name != NULL &&
(DEPRECATED_STREQN (name, "PARENT", 6) || DEPRECATED_STREQN (name, "_parent", 7)));
}
int
ada_is_wrapper_field (struct type *type, int field_num)
{
const char *name = TYPE_FIELD_NAME (type, field_num);
return (name != NULL
&& (DEPRECATED_STREQN (name, "PARENT", 6) || DEPRECATED_STREQ (name, "REP")
|| DEPRECATED_STREQN (name, "_parent", 7)
|| 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, 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 (DEPRECATED_STREQN (discrim_end, "___XVN", 6))
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 && DEPRECATED_STREQN (discrim_start - 3, "___", 3))
|| 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;
}
}
}
struct value *
ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
struct type *arg_type)
{
struct value *v;
struct type *type;
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);
}
struct value *
ada_search_struct_field (char *name, struct value *arg, int offset,
struct type *type)
{
int i;
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 = 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;
struct value *v;
arg = ada_coerce_ref (arg);
t = check_typedef (VALUE_TYPE (arg));
while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF)
{
arg = ada_value_ind (arg);
t = check_typedef (VALUE_TYPE (arg));
}
if (TYPE_CODE (t) != TYPE_CODE_STRUCT && TYPE_CODE (t) != TYPE_CODE_UNION)
error ("Attempt to extract a component of a value that is not a %s.",
err);
v = ada_search_struct_field (name, arg, 0, t);
if (v == NULL)
error ("There is no member named %s.", name);
return v;
}
struct type *
ada_lookup_struct_elt_type (struct type *type, char *name, int noerr,
int *dispp)
{
int i;
if (name == NULL)
goto BadName;
while (1)
{
CHECK_TYPEDEF (type);
if (TYPE_CODE (type) != TYPE_CODE_PTR
&& TYPE_CODE (type) != TYPE_CODE_REF)
break;
type = TYPE_TARGET_TYPE (type);
}
if (TYPE_CODE (type) != TYPE_CODE_STRUCT &&
TYPE_CODE (type) != TYPE_CODE_UNION)
{
target_terminal_ours ();
gdb_flush (gdb_stdout);
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 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,
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 = 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, 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);
fprintf_unfiltered (gdb_stderr, "Type ");
type_print (type, "", gdb_stderr, -1);
fprintf_unfiltered (gdb_stderr, " has no component named ");
error ("%s", name == NULL ? "<null>" : name);
}
return NULL;
}
int
ada_which_variant_applies (struct type *var_type, struct type *outer_type,
char *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, &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 (VALUE_TYPE (val), 0,
VALUE_ADDRESS (val) + VALUE_OFFSET (val), val);
}
static struct value *
ada_coerce_ref (struct value *val0)
{
if (TYPE_CODE (VALUE_TYPE (val0)) == TYPE_CODE_REF)
{
struct value *val = val0;
COERCE_REF (val);
val = unwrap_value (val);
return ada_to_fixed_value (VALUE_TYPE (val), 0,
VALUE_ADDRESS (val) + VALUE_OFFSET (val),
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_offset (struct type *type, int f)
{
int n = TYPE_FIELD_BITPOS (type, f);
if (n < 0)
return (unsigned int) n & 0xffff;
else
return n;
}
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 (len < 8 || !isdigit (name[len - 1]))
return TARGET_CHAR_BIT;
if (isdigit (name[len - 2]))
align_offset = len - 2;
else
align_offset = len - 1;
if (align_offset < 7 || !DEPRECATED_STREQN ("___XV", name + align_offset - 6, 5))
return TARGET_CHAR_BIT;
return atoi (name + align_offset) * TARGET_CHAR_BIT;
}
struct type *
ada_find_any_type (const char *name)
{
struct symbol *sym;
sym = standard_lookup (name, VAR_DOMAIN);
if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
return SYMBOL_TYPE (sym);
sym = standard_lookup (name, STRUCT_DOMAIN);
if (sym != NULL)
return SYMBOL_TYPE (sym);
return NULL;
}
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 (ada_is_packed_array_type (type0))
return 1;
else if (ada_is_array_descriptor (type0)
&& !ada_is_array_descriptor (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;
struct symbol **syms;
struct block **blocks;
int nsyms;
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)
{
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 && DEPRECATED_STREQ (ada_type_name (type) + len - 6, "___XVE"))
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
contains_variant_part (struct type *type)
{
int f;
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT
|| TYPE_NFIELDS (type) <= 0)
return 0;
return ada_is_variant_part (type, TYPE_NFIELDS (type) - 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 (type) = 0;
return type;
}
static struct type *
template_to_fixed_record_type (struct type *type, char *valaddr,
CORE_ADDR address, struct value *dval0)
{
struct value *mark = value_mark ();
struct value *dval;
struct type *rtype;
int nfields, bit_len;
long off;
int f;
nfields = TYPE_NFIELDS (type);
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;
off = 0;
bit_len = 0;
for (f = 0; f < nfields; f += 1)
{
int fld_bit_len, bit_incr;
off =
align_value (off,
field_alignment (type, f)) + TYPE_FIELD_BITPOS (type, f);
TYPE_FIELD_BITPOS (rtype, f) = off;
TYPE_FIELD_BITSIZE (rtype, f) = 0;
TYPE_FIELD_STATIC_KIND (rtype, f) = 0;
if (ada_is_variant_part (type, f))
{
struct type *branch_type;
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, f),
cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
if (branch_type == NULL)
TYPE_NFIELDS (rtype) -= 1;
else
{
TYPE_FIELD_TYPE (rtype, f) = branch_type;
TYPE_FIELD_NAME (rtype, f) = "S";
}
bit_incr = 0;
fld_bit_len =
TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT;
}
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 (rtype) = bit_len / TARGET_CHAR_BIT;
}
TYPE_LENGTH (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_static_fixed_type (struct type *templ_type)
{
struct type *type;
int nfields;
int f;
if (TYPE_TARGET_TYPE (templ_type) != NULL)
return TYPE_TARGET_TYPE (templ_type);
nfields = TYPE_NFIELDS (templ_type);
TYPE_TARGET_TYPE (templ_type) = type =
alloc_type (TYPE_OBJFILE (templ_type));
TYPE_CODE (type) = TYPE_CODE (templ_type);
INIT_CPLUS_SPECIFIC (type);
TYPE_NFIELDS (type) = nfields;
TYPE_FIELDS (type) = (struct field *)
TYPE_ALLOC (type, nfields * sizeof (struct field));
memset (TYPE_FIELDS (type), 0, sizeof (struct field) * nfields);
TYPE_NAME (type) = ada_type_name (templ_type);
TYPE_TAG_NAME (type) = NULL;
TYPE_LENGTH (type) = 0;
for (f = 0; f < nfields; f += 1)
{
TYPE_FIELD_BITPOS (type, f) = 0;
TYPE_FIELD_BITSIZE (type, f) = 0;
TYPE_FIELD_STATIC_KIND (type, f) = 0;
if (is_dynamic_field (templ_type, f))
{
TYPE_FIELD_TYPE (type, f) =
to_static_fixed_type (TYPE_TARGET_TYPE
(TYPE_FIELD_TYPE (templ_type, f)));
TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (templ_type, f);
}
else
{
TYPE_FIELD_TYPE (type, f) =
check_typedef (TYPE_FIELD_TYPE (templ_type, f));
TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (templ_type, f);
}
}
return type;
}
static struct type *
to_record_with_fixed_variant_part (struct type *type, char *valaddr,
CORE_ADDR address, struct value *dval)
{
struct value *mark = value_mark ();
struct type *rtype;
struct type *branch_type;
int nfields = TYPE_NFIELDS (type);
if (dval == NULL)
return type;
rtype = alloc_type (TYPE_OBJFILE (type));
TYPE_CODE (rtype) = TYPE_CODE_STRUCT;
INIT_CPLUS_SPECIFIC (type);
TYPE_NFIELDS (rtype) = TYPE_NFIELDS (type);
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_LENGTH (rtype) = TYPE_LENGTH (type);
branch_type =
to_fixed_variant_branch_type
(TYPE_FIELD_TYPE (type, nfields - 1),
cond_offset_host (valaddr,
TYPE_FIELD_BITPOS (type,
nfields - 1) / TARGET_CHAR_BIT),
cond_offset_target (address,
TYPE_FIELD_BITPOS (type,
nfields - 1) / TARGET_CHAR_BIT),
dval);
if (branch_type == NULL)
{
TYPE_NFIELDS (rtype) -= 1;
TYPE_LENGTH (rtype) -=
TYPE_LENGTH (TYPE_FIELD_TYPE (type, nfields - 1));
}
else
{
TYPE_FIELD_TYPE (rtype, nfields - 1) = branch_type;
TYPE_FIELD_NAME (rtype, nfields - 1) = "S";
TYPE_FIELD_BITSIZE (rtype, nfields - 1) = 0;
TYPE_FIELD_STATIC_KIND (rtype, nfields - 1) = 0;
TYPE_LENGTH (rtype) += TYPE_LENGTH (branch_type);
-TYPE_LENGTH (TYPE_FIELD_TYPE (type, nfields - 1));
}
return rtype;
}
static struct type *
to_fixed_record_type (struct type *type0, char *valaddr, CORE_ADDR address,
struct value *dval)
{
struct type *templ_type;
templ_type = dynamic_template_type (type0);
if (templ_type != NULL)
return template_to_fixed_record_type (templ_type, valaddr, address, dval);
else if (contains_variant_part (type0))
return to_record_with_fixed_variant_part (type0, valaddr, address, dval);
else
{
return type0;
}
}
static struct type *
to_fixed_variant_branch_type (struct type *var_type0, char *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 (contains_variant_part (TYPE_FIELD_TYPE (var_type, which)))
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;
index_type_desc = ada_find_parallel_type (type0, "___XA");
if (index_type_desc == NULL)
{
struct type *elt_type0 = 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 (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");
}
return result;
}
struct type *
ada_to_fixed_type (struct type *type, char *valaddr, CORE_ADDR address,
struct value *dval)
{
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
default:
return type;
case TYPE_CODE_STRUCT:
return to_fixed_record_type (type, valaddr, address, NULL);
case TYPE_CODE_ARRAY:
return to_fixed_array_type (type, dval, 0);
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;
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);
return type0;
case TYPE_CODE_UNION:
type = ada_find_parallel_type (type0, "___XVU");
if (type != NULL)
return template_to_static_fixed_type (type);
return type0;
}
}
static struct type *
static_unwrap_type (struct type *type)
{
if (ada_is_aligner_type (type))
{
struct type *type1 = TYPE_FIELD_TYPE (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_completed_type (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;
}
}
struct value *
ada_to_fixed_value (struct type *type0, char *valaddr, CORE_ADDR address,
struct value *val0)
{
struct type *type = ada_to_fixed_type (type0, valaddr, address, NULL);
if (type == type0 && val0 != NULL)
return val0;
else
return value_from_contents_and_address (type, valaddr, address);
}
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, 0, type);
}
static const char *attribute_names[] = {
"<?>",
"first",
"last",
"length",
"image",
"img",
"max",
"min",
"pos" "tag",
"val",
0
};
const char *
ada_attribute_name (int n)
{
if (n > 0 && n < (int) ATR_END)
return attribute_names[n];
else
return attribute_names[0];
}
static struct value *
value_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 value_from_longest (builtin_type_ada_int, i);
}
error ("enumeration value is invalid: can't find 'POS");
}
else
return value_from_longest (builtin_type_ada_int, value_as_long (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)
&& (DEPRECATED_STREQ (name, "character") || DEPRECATED_STREQ (name, "wide_character")
|| DEPRECATED_STREQ (name, "unsigned char"));
}
int
ada_is_string_type (struct type *type)
{
CHECK_TYPEDEF (type);
if (type != NULL
&& TYPE_CODE (type) != TYPE_CODE_PTR
&& (ada_is_simple_array (type) || ada_is_array_descriptor (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)
{
CHECK_TYPEDEF (type);
return (TYPE_CODE (type) == TYPE_CODE_STRUCT
&& TYPE_NFIELDS (type) == 1
&& DEPRECATED_STREQ (TYPE_FIELD_NAME (type, 0), "F"));
}
struct type *
ada_get_base_type (struct type *raw_type)
{
struct type *real_type_namer;
struct type *raw_real_type;
struct type *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);
}
char *
ada_aligned_value_addr (struct type *type, char *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)
{
char *tmp;
while (1)
{
if ((tmp = strstr (name, "__")) != NULL)
name = tmp + 2;
else if ((tmp = strchr (name, '.')) != NULL)
name = tmp + 1;
else
break;
}
if (name[0] == 'Q')
{
static char result[16];
int v;
if (name[1] == 'U' || name[1] == 'W')
{
if (sscanf (name + 2, "%x", &v) != 1)
return name;
}
else
return name;
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
return name;
}
static struct value *
evaluate_subexp (struct type *expect_type, struct expression *exp, int *pos,
enum noside noside)
{
return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside);
}
static struct value *
evaluate_subexp_type (struct expression *exp, int *pos)
{
return (*exp->language_defn->evaluate_exp)
(NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS);
}
static struct value *
unwrap_value (struct value *val)
{
struct type *type = 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 = 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_completed_type (ada_get_base_type (type));
if (type == raw_real_type)
return val;
return
coerce_unspec_val_to_type
(val, 0, 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;
CHECK_TYPEDEF (type2);
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");
VALUE_TYPE (val) = type;
}
return val;
}
struct value *
ada_evaluate_subexp (struct type *expect_type, struct expression *exp,
int *pos, enum noside noside)
{
enum exp_opcode op;
enum ada_attribute atr;
int tem, tem2, tem3;
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 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 != 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
(type, 0, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0);
}
else
arg1 = value_cast (type, arg1);
}
return arg1;
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 (binop_user_defined_p (op, arg1, arg2))
return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
else
{
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 (binop_user_defined_p (op, arg1, arg2))
return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
else
{
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 (binop_user_defined_p (op, arg1, arg2))
return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
else
{
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;
if (binop_user_defined_p (op, arg1, arg2))
return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL);
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 value_binop (arg1, arg2, op);
}
case UNOP_NEG:
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
if (unop_user_defined_p (op, arg1))
return value_x_unop (arg1, op, EVAL_NORMAL);
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 (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 (VALUE_TYPE (arg1), 0,
VALUE_ADDRESS (arg1) +
VALUE_OFFSET (arg1), arg1);
}
case OP_ARRAY:
(*pos) += 3;
tem2 = longest_to_int (exp->elts[pc + 1].longconst);
tem3 = longest_to_int (exp->elts[pc + 2].longconst);
nargs = tem3 - tem2 + 1;
type = expect_type ? check_typedef (expect_type) : NULL_TYPE;
argvec =
(struct value * *) alloca (sizeof (struct value *) * (nargs + 1));
for (tem = 0; tem == 0 || tem < nargs; tem += 1)
{
argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside);
}
if (noside == EVAL_SKIP)
goto nosideret;
return value_array (tem2, tem3, argvec);
case OP_FUNCALL:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
argvec =
(struct value * *) alloca (sizeof (struct value *) * (nargs + 2));
if (0)
{
error ("unexpected code path, FIXME");
}
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 (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF)
argvec[0] = value_addr (argvec[0]);
if (ada_is_packed_array_type (VALUE_TYPE (argvec[0])))
argvec[0] = ada_coerce_to_simple_array (argvec[0]);
type = check_typedef (VALUE_TYPE (argvec[0]));
if (TYPE_CODE (type) == TYPE_CODE_PTR)
{
switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type))))
{
case TYPE_CODE_FUNC:
type = 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 = 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 = 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 ("Internal error in evaluate_subexp");
}
case TERNOP_SLICE:
{
struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside);
int lowbound
= value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
int upper
= value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside));
if (noside == EVAL_SKIP)
goto nosideret;
if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF
&& TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
&& TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
TYPE_CODE_ARRAY
&& !ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
{
array = ada_coerce_ref (array);
}
if (noside == EVAL_AVOID_SIDE_EFFECTS &&
ada_is_array_descriptor (check_typedef (VALUE_TYPE (array))))
{
struct type *arrType = ada_type_of_array (array, 0);
if (arrType != NULL)
array = value_at_lazy (arrType, 0, NULL);
}
if (ada_is_array_descriptor (VALUE_TYPE (array)))
array = ada_coerce_to_simple_array (array);
if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR
&& TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL
&& TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) ==
TYPE_CODE_ARRAY)
{
array = ada_value_ind (array);
}
if (noside == EVAL_AVOID_SIDE_EFFECTS)
return array;
else
return value_slice (array, lowbound, upper - lowbound + 1);
}
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;
if (binop_user_defined_p (op, arg1, arg2))
return unwrap_value (value_x_binop (arg1, arg2, op, OP_NULL,
EVAL_NORMAL));
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;
if (unop_user_defined_p (op, arg1))
return unwrap_value (value_x_unop (arg1, op, EVAL_NORMAL));
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 (check_typedef (expect_type));
arg1 = evaluate_subexp (expect_type, exp, pos, noside);
if (noside == EVAL_SKIP)
goto nosideret;
type = check_typedef (VALUE_TYPE (arg1));
if (noside == EVAL_AVOID_SIDE_EFFECTS)
{
if (ada_is_array_descriptor (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, NULL);
}
else if (TYPE_CODE (type) == TYPE_CODE_PTR
|| TYPE_CODE (type) == TYPE_CODE_REF
|| TYPE_CODE (type) == TYPE_CODE_ARRAY)
return
value_zero
(to_static_fixed_type
(ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (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 = check_typedef (VALUE_TYPE (arg1));
if (ada_is_array_descriptor (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)
return value_zero (ada_aligned_type
(ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
&exp->elts[pc +
2].string,
0, NULL)),
lval_memory);
else
return 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");
case STRUCTOP_PTR:
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)
return value_zero (ada_aligned_type
(ada_lookup_struct_elt_type (VALUE_TYPE (arg1),
&exp->elts[pc +
2].string,
0, NULL)),
lval_memory);
else
return unwrap_value (ada_value_struct_elt (arg1,
&exp->elts[pc + 2].string,
"record access"));
}
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;
}
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)
&& DEPRECATED_STREQN (ada_type_name (type) + name_len - 6, "___XF", 5);
}
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 symbol **syms;
struct block **blocks;
int nsyms;
nsyms =
ada_lookup_symbol_list (name, get_selected_block (NULL), VAR_DOMAIN,
&syms, &blocks);
if (nsyms != 1)
{
if (err_msg == NULL)
return 0;
else
error ("%s", err_msg);
}
return value_of_variable (syms[0], blocks[0]);
}
LONGEST
get_int_var_value (char *name, char *err_msg, int *flag)
{
struct value *var_val = get_var_value (name, err_msg);
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;
LONGEST low, high;
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
{
strcpy (name_buf + prefix_len, "___L");
L = get_int_var_value (name_buf, "Index bound unknown.", NULL);
}
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
{
strcpy (name_buf + prefix_len, "___U");
U = get_int_var_value (name_buf, "Index bound unknown.", NULL);
}
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;
return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE
&& TYPE_CODE (subranged_type) != TYPE_CODE_ENUM
&& TYPE_UNSIGNED (subranged_type));
}
LONGEST
ada_modulus (struct type * type)
{
return TYPE_HIGH_BOUND (type) + 1;
}
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},
{NULL, 0, 0, 0}
};
struct type *builtin_type_ada_int;
struct type *builtin_type_ada_short;
struct type *builtin_type_ada_long;
struct type *builtin_type_ada_long_long;
struct type *builtin_type_ada_char;
struct type *builtin_type_ada_float;
struct type *builtin_type_ada_double;
struct type *builtin_type_ada_long_double;
struct type *builtin_type_ada_natural;
struct type *builtin_type_ada_positive;
struct type *builtin_type_ada_system_address;
struct type **const (ada_builtin_types[]) =
{
&builtin_type_ada_int,
&builtin_type_ada_long,
&builtin_type_ada_short,
&builtin_type_ada_char,
&builtin_type_ada_float,
&builtin_type_ada_double,
&builtin_type_ada_long_long,
&builtin_type_ada_long_double,
&builtin_type_ada_natural, &builtin_type_ada_positive,
&builtin_type_int,
&builtin_type_long,
&builtin_type_short,
&builtin_type_char,
&builtin_type_float,
&builtin_type_double,
&builtin_type_long_long,
&builtin_type_void,
&builtin_type_signed_char,
&builtin_type_unsigned_char,
&builtin_type_unsigned_short,
&builtin_type_unsigned_int,
&builtin_type_unsigned_long,
&builtin_type_unsigned_long_long,
&builtin_type_long_double,
&builtin_type_complex, &builtin_type_double_complex, 0};
static void
emit_char (int c, struct ui_file *stream, int quoter)
{
ada_emit_char (c, stream, quoter, 1);
}
const struct language_defn ada_language_defn = {
"ada",
language_unknown,
ada_builtin_types,
range_check_off,
type_check_off,
case_sensitive_on,
ada_parse,
ada_error,
ada_evaluate_subexp,
ada_printchar,
ada_printstr,
emit_char,
ada_create_fundamental_type,
ada_print_type,
ada_val_print,
ada_value_print,
NULL,
value_of_this,
basic_lookup_symbol_nonlocal,
basic_lookup_transparent_type,
NULL,
{"", "", "", ""},
#if 0
{"8#%lo#", "8#", "o", "#"},
{"%ld", "", "d", ""},
{"16#%lx#", "16#", "x", "#"},
#else
{"0%lo", "0", "o", ""},
{"%ld", "", "d", ""},
{"0x%lx", "0x", "x", ""},
#endif
ada_op_print_tab,
1,
0,
&builtin_type_ada_char,
default_word_break_characters,
LANG_MAGIC
};
void
_initialize_ada_language (void)
{
builtin_type_ada_int =
init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "integer", (struct objfile *) NULL);
builtin_type_ada_long =
init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT,
0, "long_integer", (struct objfile *) NULL);
builtin_type_ada_short =
init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT,
0, "short_integer", (struct objfile *) NULL);
builtin_type_ada_char =
init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
0, "character", (struct objfile *) NULL);
builtin_type_ada_float =
init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
0, "float", (struct objfile *) NULL);
builtin_type_ada_double =
init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long_float", (struct objfile *) NULL);
builtin_type_ada_long_long =
init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
0, "long_long_integer", (struct objfile *) NULL);
builtin_type_ada_long_double =
init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
0, "long_long_float", (struct objfile *) NULL);
builtin_type_ada_natural =
init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "natural", (struct objfile *) NULL);
builtin_type_ada_positive =
init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
0, "positive", (struct objfile *) NULL);
builtin_type_ada_system_address =
lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void",
(struct objfile *) NULL));
TYPE_NAME (builtin_type_ada_system_address) = "system__address";
add_language (&ada_language_defn);
add_show_from_set
(add_set_cmd ("varsize-limit", class_support, var_uinteger,
(char *) &varsize_limit,
"Set maximum bytes in dynamic-sized object.",
&setlist), &showlist);
varsize_limit = 65536;
add_com ("begin", class_breakpoint, begin_command,
"Start the debugged program, stopping at the beginning of the\n\
main program. You may specify command-line arguments to give it, as for\n\
the \"run\" command (q.v.).");
}
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);
}
void
ada_dump_symtab (struct symtab *s)
{
int i;
fprintf (stderr, "New symtab: [\n");
fprintf (stderr, " Name: %s/%s;\n",
s->dirname ? s->dirname : "?", s->filename ? s->filename : "?");
fprintf (stderr, " Format: %s;\n", s->debugformat);
if (s->linetable != NULL)
{
fprintf (stderr, " Line table (section %d):\n", s->block_line_section);
for (i = 0; i < s->linetable->nitems; i += 1)
{
struct linetable_entry *e = s->linetable->item + i;
fprintf (stderr, " %4ld: %8lx\n", (long) e->line, (long) e->pc);
}
}
fprintf (stderr, "]\n");
}