1130803Smarcel/* Ada language support routines for GDB, the GNU debugger. Copyright 2130803Smarcel 1992, 1993, 1994, 1997, 1998, 1999, 2000, 2003, 2004 3130803Smarcel Free Software Foundation, Inc. 4130803Smarcel 5130803SmarcelThis file is part of GDB. 6130803Smarcel 7130803SmarcelThis program is free software; you can redistribute it and/or modify 8130803Smarcelit under the terms of the GNU General Public License as published by 9130803Smarcelthe Free Software Foundation; either version 2 of the License, or 10130803Smarcel(at your option) any later version. 11130803Smarcel 12130803SmarcelThis program is distributed in the hope that it will be useful, 13130803Smarcelbut WITHOUT ANY WARRANTY; without even the implied warranty of 14130803SmarcelMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15130803SmarcelGNU General Public License for more details. 16130803Smarcel 17130803SmarcelYou should have received a copy of the GNU General Public License 18130803Smarcelalong with this program; if not, write to the Free Software 19130803SmarcelFoundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ 20130803Smarcel 21130803Smarcel#include <stdio.h> 22130803Smarcel#include "gdb_string.h" 23130803Smarcel#include <ctype.h> 24130803Smarcel#include <stdarg.h> 25130803Smarcel#include "demangle.h" 26130803Smarcel#include "defs.h" 27130803Smarcel#include "symtab.h" 28130803Smarcel#include "gdbtypes.h" 29130803Smarcel#include "gdbcmd.h" 30130803Smarcel#include "expression.h" 31130803Smarcel#include "parser-defs.h" 32130803Smarcel#include "language.h" 33130803Smarcel#include "c-lang.h" 34130803Smarcel#include "inferior.h" 35130803Smarcel#include "symfile.h" 36130803Smarcel#include "objfiles.h" 37130803Smarcel#include "breakpoint.h" 38130803Smarcel#include "gdbcore.h" 39130803Smarcel#include "ada-lang.h" 40130803Smarcel#include "ui-out.h" 41130803Smarcel#include "block.h" 42130803Smarcel#include "infcall.h" 43130803Smarcel#include "dictionary.h" 44130803Smarcel 45130803Smarcelstruct cleanup *unresolved_names; 46130803Smarcel 47130803Smarcelvoid extract_string (CORE_ADDR addr, char *buf); 48130803Smarcel 49130803Smarcelstatic struct type *ada_create_fundamental_type (struct objfile *, int); 50130803Smarcel 51130803Smarcelstatic void modify_general_field (char *, LONGEST, int, int); 52130803Smarcel 53130803Smarcelstatic struct type *desc_base_type (struct type *); 54130803Smarcel 55130803Smarcelstatic struct type *desc_bounds_type (struct type *); 56130803Smarcel 57130803Smarcelstatic struct value *desc_bounds (struct value *); 58130803Smarcel 59130803Smarcelstatic int fat_pntr_bounds_bitpos (struct type *); 60130803Smarcel 61130803Smarcelstatic int fat_pntr_bounds_bitsize (struct type *); 62130803Smarcel 63130803Smarcelstatic struct type *desc_data_type (struct type *); 64130803Smarcel 65130803Smarcelstatic struct value *desc_data (struct value *); 66130803Smarcel 67130803Smarcelstatic int fat_pntr_data_bitpos (struct type *); 68130803Smarcel 69130803Smarcelstatic int fat_pntr_data_bitsize (struct type *); 70130803Smarcel 71130803Smarcelstatic struct value *desc_one_bound (struct value *, int, int); 72130803Smarcel 73130803Smarcelstatic int desc_bound_bitpos (struct type *, int, int); 74130803Smarcel 75130803Smarcelstatic int desc_bound_bitsize (struct type *, int, int); 76130803Smarcel 77130803Smarcelstatic struct type *desc_index_type (struct type *, int); 78130803Smarcel 79130803Smarcelstatic int desc_arity (struct type *); 80130803Smarcel 81130803Smarcelstatic int ada_type_match (struct type *, struct type *, int); 82130803Smarcel 83130803Smarcelstatic int ada_args_match (struct symbol *, struct value **, int); 84130803Smarcel 85130803Smarcelstatic struct value *place_on_stack (struct value *, CORE_ADDR *); 86130803Smarcel 87130803Smarcelstatic struct value *convert_actual (struct value *, struct type *, 88130803Smarcel CORE_ADDR *); 89130803Smarcel 90130803Smarcelstatic struct value *make_array_descriptor (struct type *, struct value *, 91130803Smarcel CORE_ADDR *); 92130803Smarcel 93130803Smarcelstatic void ada_add_block_symbols (struct block *, const char *, 94130803Smarcel domain_enum, struct objfile *, int); 95130803Smarcel 96130803Smarcelstatic void fill_in_ada_prototype (struct symbol *); 97130803Smarcel 98130803Smarcelstatic int is_nonfunction (struct symbol **, int); 99130803Smarcel 100130803Smarcelstatic void add_defn_to_vec (struct symbol *, struct block *); 101130803Smarcel 102130803Smarcelstatic struct partial_symbol *ada_lookup_partial_symbol (struct partial_symtab 103130803Smarcel *, const char *, int, 104130803Smarcel domain_enum, int); 105130803Smarcel 106130803Smarcelstatic struct symtab *symtab_for_sym (struct symbol *); 107130803Smarcel 108130803Smarcelstatic struct value *ada_resolve_subexp (struct expression **, int *, int, 109130803Smarcel struct type *); 110130803Smarcel 111130803Smarcelstatic void replace_operator_with_call (struct expression **, int, int, int, 112130803Smarcel struct symbol *, struct block *); 113130803Smarcel 114130803Smarcelstatic int possible_user_operator_p (enum exp_opcode, struct value **); 115130803Smarcel 116130803Smarcelstatic const char *ada_op_name (enum exp_opcode); 117130803Smarcel 118130803Smarcelstatic int numeric_type_p (struct type *); 119130803Smarcel 120130803Smarcelstatic int integer_type_p (struct type *); 121130803Smarcel 122130803Smarcelstatic int scalar_type_p (struct type *); 123130803Smarcel 124130803Smarcelstatic int discrete_type_p (struct type *); 125130803Smarcel 126130803Smarcelstatic char *extended_canonical_line_spec (struct symtab_and_line, 127130803Smarcel const char *); 128130803Smarcel 129130803Smarcelstatic struct value *evaluate_subexp (struct type *, struct expression *, 130130803Smarcel int *, enum noside); 131130803Smarcel 132130803Smarcelstatic struct value *evaluate_subexp_type (struct expression *, int *); 133130803Smarcel 134130803Smarcelstatic struct type *ada_create_fundamental_type (struct objfile *, int); 135130803Smarcel 136130803Smarcelstatic int is_dynamic_field (struct type *, int); 137130803Smarcel 138130803Smarcelstatic struct type *to_fixed_variant_branch_type (struct type *, char *, 139130803Smarcel CORE_ADDR, struct value *); 140130803Smarcel 141130803Smarcelstatic struct type *to_fixed_range_type (char *, struct value *, 142130803Smarcel struct objfile *); 143130803Smarcel 144130803Smarcelstatic struct type *to_static_fixed_type (struct type *); 145130803Smarcel 146130803Smarcelstatic struct value *unwrap_value (struct value *); 147130803Smarcel 148130803Smarcelstatic struct type *packed_array_type (struct type *, long *); 149130803Smarcel 150130803Smarcelstatic struct type *decode_packed_array_type (struct type *); 151130803Smarcel 152130803Smarcelstatic struct value *decode_packed_array (struct value *); 153130803Smarcel 154130803Smarcelstatic struct value *value_subscript_packed (struct value *, int, 155130803Smarcel struct value **); 156130803Smarcel 157130803Smarcelstatic struct value *coerce_unspec_val_to_type (struct value *, long, 158130803Smarcel struct type *); 159130803Smarcel 160130803Smarcelstatic struct value *get_var_value (char *, char *); 161130803Smarcel 162130803Smarcelstatic int lesseq_defined_than (struct symbol *, struct symbol *); 163130803Smarcel 164130803Smarcelstatic int equiv_types (struct type *, struct type *); 165130803Smarcel 166130803Smarcelstatic int is_name_suffix (const char *); 167130803Smarcel 168130803Smarcelstatic int wild_match (const char *, int, const char *); 169130803Smarcel 170130803Smarcelstatic struct symtabs_and_lines find_sal_from_funcs_and_line (const char *, 171130803Smarcel int, 172130803Smarcel struct symbol 173130803Smarcel **, int); 174130803Smarcel 175130803Smarcelstatic int find_line_in_linetable (struct linetable *, int, struct symbol **, 176130803Smarcel int, int *); 177130803Smarcel 178130803Smarcelstatic int find_next_line_in_linetable (struct linetable *, int, int, int); 179130803Smarcel 180130803Smarcelstatic struct symtabs_and_lines all_sals_for_line (const char *, int, 181130803Smarcel char ***); 182130803Smarcel 183130803Smarcelstatic void read_all_symtabs (const char *); 184130803Smarcel 185130803Smarcelstatic int is_plausible_func_for_line (struct symbol *, int); 186130803Smarcel 187130803Smarcelstatic struct value *ada_coerce_ref (struct value *); 188130803Smarcel 189130803Smarcelstatic struct value *value_pos_atr (struct value *); 190130803Smarcel 191130803Smarcelstatic struct value *value_val_atr (struct type *, struct value *); 192130803Smarcel 193130803Smarcelstatic struct symbol *standard_lookup (const char *, domain_enum); 194130803Smarcel 195130803Smarcelextern void markTimeStart (int index); 196130803Smarcelextern void markTimeStop (int index); 197130803Smarcel 198130803Smarcel 199130803Smarcel 200130803Smarcel/* Maximum-sized dynamic type. */ 201130803Smarcelstatic unsigned int varsize_limit; 202130803Smarcel 203130803Smarcelstatic const char *ada_completer_word_break_characters = 204130803Smarcel " \t\n!@#$%^&*()+=|~`}{[]\";:?/,-"; 205130803Smarcel 206130803Smarcel/* The name of the symbol to use to get the name of the main subprogram */ 207130803Smarcel#define ADA_MAIN_PROGRAM_SYMBOL_NAME "__gnat_ada_main_program_name" 208130803Smarcel 209130803Smarcel /* Utilities */ 210130803Smarcel 211130803Smarcel/* extract_string 212130803Smarcel * 213130803Smarcel * read the string located at ADDR from the inferior and store the 214130803Smarcel * result into BUF 215130803Smarcel */ 216130803Smarcelvoid 217130803Smarcelextract_string (CORE_ADDR addr, char *buf) 218130803Smarcel{ 219130803Smarcel int char_index = 0; 220130803Smarcel 221130803Smarcel /* Loop, reading one byte at a time, until we reach the '\000' 222130803Smarcel end-of-string marker */ 223130803Smarcel do 224130803Smarcel { 225130803Smarcel target_read_memory (addr + char_index * sizeof (char), 226130803Smarcel buf + char_index * sizeof (char), sizeof (char)); 227130803Smarcel char_index++; 228130803Smarcel } 229130803Smarcel while (buf[char_index - 1] != '\000'); 230130803Smarcel} 231130803Smarcel 232130803Smarcel/* Assuming *OLD_VECT points to an array of *SIZE objects of size 233130803Smarcel ELEMENT_SIZE, grow it to contain at least MIN_SIZE objects, 234130803Smarcel updating *OLD_VECT and *SIZE as necessary. */ 235130803Smarcel 236130803Smarcelvoid 237130803Smarcelgrow_vect (void **old_vect, size_t * size, size_t min_size, int element_size) 238130803Smarcel{ 239130803Smarcel if (*size < min_size) 240130803Smarcel { 241130803Smarcel *size *= 2; 242130803Smarcel if (*size < min_size) 243130803Smarcel *size = min_size; 244130803Smarcel *old_vect = xrealloc (*old_vect, *size * element_size); 245130803Smarcel } 246130803Smarcel} 247130803Smarcel 248130803Smarcel/* True (non-zero) iff TARGET matches FIELD_NAME up to any trailing 249130803Smarcel suffix of FIELD_NAME beginning "___" */ 250130803Smarcel 251130803Smarcelstatic int 252130803Smarcelfield_name_match (const char *field_name, const char *target) 253130803Smarcel{ 254130803Smarcel int len = strlen (target); 255130803Smarcel return 256130803Smarcel DEPRECATED_STREQN (field_name, target, len) 257130803Smarcel && (field_name[len] == '\0' 258130803Smarcel || (DEPRECATED_STREQN (field_name + len, "___", 3) 259130803Smarcel && !DEPRECATED_STREQ (field_name + strlen (field_name) - 6, "___XVN"))); 260130803Smarcel} 261130803Smarcel 262130803Smarcel 263130803Smarcel/* The length of the prefix of NAME prior to any "___" suffix. */ 264130803Smarcel 265130803Smarcelint 266130803Smarcelada_name_prefix_len (const char *name) 267130803Smarcel{ 268130803Smarcel if (name == NULL) 269130803Smarcel return 0; 270130803Smarcel else 271130803Smarcel { 272130803Smarcel const char *p = strstr (name, "___"); 273130803Smarcel if (p == NULL) 274130803Smarcel return strlen (name); 275130803Smarcel else 276130803Smarcel return p - name; 277130803Smarcel } 278130803Smarcel} 279130803Smarcel 280130803Smarcel/* SUFFIX is a suffix of STR. False if STR is null. */ 281130803Smarcelstatic int 282130803Smarcelis_suffix (const char *str, const char *suffix) 283130803Smarcel{ 284130803Smarcel int len1, len2; 285130803Smarcel if (str == NULL) 286130803Smarcel return 0; 287130803Smarcel len1 = strlen (str); 288130803Smarcel len2 = strlen (suffix); 289130803Smarcel return (len1 >= len2 && DEPRECATED_STREQ (str + len1 - len2, suffix)); 290130803Smarcel} 291130803Smarcel 292130803Smarcel/* Create a value of type TYPE whose contents come from VALADDR, if it 293130803Smarcel * is non-null, and whose memory address (in the inferior) is 294130803Smarcel * ADDRESS. */ 295130803Smarcelstruct value * 296130803Smarcelvalue_from_contents_and_address (struct type *type, char *valaddr, 297130803Smarcel CORE_ADDR address) 298130803Smarcel{ 299130803Smarcel struct value *v = allocate_value (type); 300130803Smarcel if (valaddr == NULL) 301130803Smarcel VALUE_LAZY (v) = 1; 302130803Smarcel else 303130803Smarcel memcpy (VALUE_CONTENTS_RAW (v), valaddr, TYPE_LENGTH (type)); 304130803Smarcel VALUE_ADDRESS (v) = address; 305130803Smarcel if (address != 0) 306130803Smarcel VALUE_LVAL (v) = lval_memory; 307130803Smarcel return v; 308130803Smarcel} 309130803Smarcel 310130803Smarcel/* The contents of value VAL, beginning at offset OFFSET, treated as a 311130803Smarcel value of type TYPE. The result is an lval in memory if VAL is. */ 312130803Smarcel 313130803Smarcelstatic struct value * 314130803Smarcelcoerce_unspec_val_to_type (struct value *val, long offset, struct type *type) 315130803Smarcel{ 316130803Smarcel CHECK_TYPEDEF (type); 317130803Smarcel if (VALUE_LVAL (val) == lval_memory) 318130803Smarcel return value_at_lazy (type, 319130803Smarcel VALUE_ADDRESS (val) + VALUE_OFFSET (val) + offset, 320130803Smarcel NULL); 321130803Smarcel else 322130803Smarcel { 323130803Smarcel struct value *result = allocate_value (type); 324130803Smarcel VALUE_LVAL (result) = not_lval; 325130803Smarcel if (VALUE_ADDRESS (val) == 0) 326130803Smarcel memcpy (VALUE_CONTENTS_RAW (result), VALUE_CONTENTS (val) + offset, 327130803Smarcel TYPE_LENGTH (type) > TYPE_LENGTH (VALUE_TYPE (val)) 328130803Smarcel ? TYPE_LENGTH (VALUE_TYPE (val)) : TYPE_LENGTH (type)); 329130803Smarcel else 330130803Smarcel { 331130803Smarcel VALUE_ADDRESS (result) = 332130803Smarcel VALUE_ADDRESS (val) + VALUE_OFFSET (val) + offset; 333130803Smarcel VALUE_LAZY (result) = 1; 334130803Smarcel } 335130803Smarcel return result; 336130803Smarcel } 337130803Smarcel} 338130803Smarcel 339130803Smarcelstatic char * 340130803Smarcelcond_offset_host (char *valaddr, long offset) 341130803Smarcel{ 342130803Smarcel if (valaddr == NULL) 343130803Smarcel return NULL; 344130803Smarcel else 345130803Smarcel return valaddr + offset; 346130803Smarcel} 347130803Smarcel 348130803Smarcelstatic CORE_ADDR 349130803Smarcelcond_offset_target (CORE_ADDR address, long offset) 350130803Smarcel{ 351130803Smarcel if (address == 0) 352130803Smarcel return 0; 353130803Smarcel else 354130803Smarcel return address + offset; 355130803Smarcel} 356130803Smarcel 357130803Smarcel/* Perform execute_command on the result of concatenating all 358130803Smarcel arguments up to NULL. */ 359130803Smarcelstatic void 360130803Smarceldo_command (const char *arg, ...) 361130803Smarcel{ 362130803Smarcel int len; 363130803Smarcel char *cmd; 364130803Smarcel const char *s; 365130803Smarcel va_list ap; 366130803Smarcel 367130803Smarcel va_start (ap, arg); 368130803Smarcel len = 0; 369130803Smarcel s = arg; 370130803Smarcel cmd = ""; 371130803Smarcel for (; s != NULL; s = va_arg (ap, const char *)) 372130803Smarcel { 373130803Smarcel char *cmd1; 374130803Smarcel len += strlen (s); 375130803Smarcel cmd1 = alloca (len + 1); 376130803Smarcel strcpy (cmd1, cmd); 377130803Smarcel strcat (cmd1, s); 378130803Smarcel cmd = cmd1; 379130803Smarcel } 380130803Smarcel va_end (ap); 381130803Smarcel execute_command (cmd, 0); 382130803Smarcel} 383130803Smarcel 384130803Smarcel 385130803Smarcel /* Language Selection */ 386130803Smarcel 387130803Smarcel/* If the main program is in Ada, return language_ada, otherwise return LANG 388130803Smarcel (the main program is in Ada iif the adainit symbol is found). 389130803Smarcel 390130803Smarcel MAIN_PST is not used. */ 391130803Smarcel 392130803Smarcelenum language 393130803Smarcelada_update_initial_language (enum language lang, 394130803Smarcel struct partial_symtab *main_pst) 395130803Smarcel{ 396130803Smarcel if (lookup_minimal_symbol ("adainit", (const char *) NULL, 397130803Smarcel (struct objfile *) NULL) != NULL) 398130803Smarcel /* return language_ada; */ 399130803Smarcel /* FIXME: language_ada should be defined in defs.h */ 400130803Smarcel return language_unknown; 401130803Smarcel 402130803Smarcel return lang; 403130803Smarcel} 404130803Smarcel 405130803Smarcel 406130803Smarcel /* Symbols */ 407130803Smarcel 408130803Smarcel/* Table of Ada operators and their GNAT-mangled names. Last entry is pair 409130803Smarcel of NULLs. */ 410130803Smarcel 411130803Smarcelconst struct ada_opname_map ada_opname_table[] = { 412130803Smarcel {"Oadd", "\"+\"", BINOP_ADD}, 413130803Smarcel {"Osubtract", "\"-\"", BINOP_SUB}, 414130803Smarcel {"Omultiply", "\"*\"", BINOP_MUL}, 415130803Smarcel {"Odivide", "\"/\"", BINOP_DIV}, 416130803Smarcel {"Omod", "\"mod\"", BINOP_MOD}, 417130803Smarcel {"Orem", "\"rem\"", BINOP_REM}, 418130803Smarcel {"Oexpon", "\"**\"", BINOP_EXP}, 419130803Smarcel {"Olt", "\"<\"", BINOP_LESS}, 420130803Smarcel {"Ole", "\"<=\"", BINOP_LEQ}, 421130803Smarcel {"Ogt", "\">\"", BINOP_GTR}, 422130803Smarcel {"Oge", "\">=\"", BINOP_GEQ}, 423130803Smarcel {"Oeq", "\"=\"", BINOP_EQUAL}, 424130803Smarcel {"One", "\"/=\"", BINOP_NOTEQUAL}, 425130803Smarcel {"Oand", "\"and\"", BINOP_BITWISE_AND}, 426130803Smarcel {"Oor", "\"or\"", BINOP_BITWISE_IOR}, 427130803Smarcel {"Oxor", "\"xor\"", BINOP_BITWISE_XOR}, 428130803Smarcel {"Oconcat", "\"&\"", BINOP_CONCAT}, 429130803Smarcel {"Oabs", "\"abs\"", UNOP_ABS}, 430130803Smarcel {"Onot", "\"not\"", UNOP_LOGICAL_NOT}, 431130803Smarcel {"Oadd", "\"+\"", UNOP_PLUS}, 432130803Smarcel {"Osubtract", "\"-\"", UNOP_NEG}, 433130803Smarcel {NULL, NULL} 434130803Smarcel}; 435130803Smarcel 436130803Smarcel/* True if STR should be suppressed in info listings. */ 437130803Smarcelstatic int 438130803Smarcelis_suppressed_name (const char *str) 439130803Smarcel{ 440130803Smarcel if (DEPRECATED_STREQN (str, "_ada_", 5)) 441130803Smarcel str += 5; 442130803Smarcel if (str[0] == '_' || str[0] == '\000') 443130803Smarcel return 1; 444130803Smarcel else 445130803Smarcel { 446130803Smarcel const char *p; 447130803Smarcel const char *suffix = strstr (str, "___"); 448130803Smarcel if (suffix != NULL && suffix[3] != 'X') 449130803Smarcel return 1; 450130803Smarcel if (suffix == NULL) 451130803Smarcel suffix = str + strlen (str); 452130803Smarcel for (p = suffix - 1; p != str; p -= 1) 453130803Smarcel if (isupper (*p)) 454130803Smarcel { 455130803Smarcel int i; 456130803Smarcel if (p[0] == 'X' && p[-1] != '_') 457130803Smarcel goto OK; 458130803Smarcel if (*p != 'O') 459130803Smarcel return 1; 460130803Smarcel for (i = 0; ada_opname_table[i].mangled != NULL; i += 1) 461130803Smarcel if (DEPRECATED_STREQN (ada_opname_table[i].mangled, p, 462130803Smarcel strlen (ada_opname_table[i].mangled))) 463130803Smarcel goto OK; 464130803Smarcel return 1; 465130803Smarcel OK:; 466130803Smarcel } 467130803Smarcel return 0; 468130803Smarcel } 469130803Smarcel} 470130803Smarcel 471130803Smarcel/* The "mangled" form of DEMANGLED, according to GNAT conventions. 472130803Smarcel * The result is valid until the next call to ada_mangle. */ 473130803Smarcelchar * 474130803Smarcelada_mangle (const char *demangled) 475130803Smarcel{ 476130803Smarcel static char *mangling_buffer = NULL; 477130803Smarcel static size_t mangling_buffer_size = 0; 478130803Smarcel const char *p; 479130803Smarcel int k; 480130803Smarcel 481130803Smarcel if (demangled == NULL) 482130803Smarcel return NULL; 483130803Smarcel 484130803Smarcel GROW_VECT (mangling_buffer, mangling_buffer_size, 485130803Smarcel 2 * strlen (demangled) + 10); 486130803Smarcel 487130803Smarcel k = 0; 488130803Smarcel for (p = demangled; *p != '\0'; p += 1) 489130803Smarcel { 490130803Smarcel if (*p == '.') 491130803Smarcel { 492130803Smarcel mangling_buffer[k] = mangling_buffer[k + 1] = '_'; 493130803Smarcel k += 2; 494130803Smarcel } 495130803Smarcel else if (*p == '"') 496130803Smarcel { 497130803Smarcel const struct ada_opname_map *mapping; 498130803Smarcel 499130803Smarcel for (mapping = ada_opname_table; 500130803Smarcel mapping->mangled != NULL && 501130803Smarcel !DEPRECATED_STREQN (mapping->demangled, p, strlen (mapping->demangled)); 502130803Smarcel p += 1) 503130803Smarcel ; 504130803Smarcel if (mapping->mangled == NULL) 505130803Smarcel error ("invalid Ada operator name: %s", p); 506130803Smarcel strcpy (mangling_buffer + k, mapping->mangled); 507130803Smarcel k += strlen (mapping->mangled); 508130803Smarcel break; 509130803Smarcel } 510130803Smarcel else 511130803Smarcel { 512130803Smarcel mangling_buffer[k] = *p; 513130803Smarcel k += 1; 514130803Smarcel } 515130803Smarcel } 516130803Smarcel 517130803Smarcel mangling_buffer[k] = '\0'; 518130803Smarcel return mangling_buffer; 519130803Smarcel} 520130803Smarcel 521130803Smarcel/* Return NAME folded to lower case, or, if surrounded by single 522130803Smarcel * quotes, unfolded, but with the quotes stripped away. Result good 523130803Smarcel * to next call. */ 524130803Smarcelchar * 525130803Smarcelada_fold_name (const char *name) 526130803Smarcel{ 527130803Smarcel static char *fold_buffer = NULL; 528130803Smarcel static size_t fold_buffer_size = 0; 529130803Smarcel 530130803Smarcel int len = strlen (name); 531130803Smarcel GROW_VECT (fold_buffer, fold_buffer_size, len + 1); 532130803Smarcel 533130803Smarcel if (name[0] == '\'') 534130803Smarcel { 535130803Smarcel strncpy (fold_buffer, name + 1, len - 2); 536130803Smarcel fold_buffer[len - 2] = '\000'; 537130803Smarcel } 538130803Smarcel else 539130803Smarcel { 540130803Smarcel int i; 541130803Smarcel for (i = 0; i <= len; i += 1) 542130803Smarcel fold_buffer[i] = tolower (name[i]); 543130803Smarcel } 544130803Smarcel 545130803Smarcel return fold_buffer; 546130803Smarcel} 547130803Smarcel 548130803Smarcel/* Demangle: 549130803Smarcel 1. Discard final __{DIGIT}+ or ${DIGIT}+ 550130803Smarcel 2. Convert other instances of embedded "__" to `.'. 551130803Smarcel 3. Discard leading _ada_. 552130803Smarcel 4. Convert operator names to the appropriate quoted symbols. 553130803Smarcel 5. Remove everything after first ___ if it is followed by 554130803Smarcel 'X'. 555130803Smarcel 6. Replace TK__ with __, and a trailing B or TKB with nothing. 556130803Smarcel 7. Put symbols that should be suppressed in <...> brackets. 557130803Smarcel 8. Remove trailing X[bn]* suffix (indicating names in package bodies). 558130803Smarcel The resulting string is valid until the next call of ada_demangle. 559130803Smarcel */ 560130803Smarcel 561130803Smarcelchar * 562130803Smarcelada_demangle (const char *mangled) 563130803Smarcel{ 564130803Smarcel int i, j; 565130803Smarcel int len0; 566130803Smarcel const char *p; 567130803Smarcel char *demangled; 568130803Smarcel int at_start_name; 569130803Smarcel static char *demangling_buffer = NULL; 570130803Smarcel static size_t demangling_buffer_size = 0; 571130803Smarcel 572130803Smarcel if (DEPRECATED_STREQN (mangled, "_ada_", 5)) 573130803Smarcel mangled += 5; 574130803Smarcel 575130803Smarcel if (mangled[0] == '_' || mangled[0] == '<') 576130803Smarcel goto Suppress; 577130803Smarcel 578130803Smarcel p = strstr (mangled, "___"); 579130803Smarcel if (p == NULL) 580130803Smarcel len0 = strlen (mangled); 581130803Smarcel else 582130803Smarcel { 583130803Smarcel if (p[3] == 'X') 584130803Smarcel len0 = p - mangled; 585130803Smarcel else 586130803Smarcel goto Suppress; 587130803Smarcel } 588130803Smarcel if (len0 > 3 && DEPRECATED_STREQ (mangled + len0 - 3, "TKB")) 589130803Smarcel len0 -= 3; 590130803Smarcel if (len0 > 1 && DEPRECATED_STREQ (mangled + len0 - 1, "B")) 591130803Smarcel len0 -= 1; 592130803Smarcel 593130803Smarcel /* Make demangled big enough for possible expansion by operator name. */ 594130803Smarcel GROW_VECT (demangling_buffer, demangling_buffer_size, 2 * len0 + 1); 595130803Smarcel demangled = demangling_buffer; 596130803Smarcel 597130803Smarcel if (isdigit (mangled[len0 - 1])) 598130803Smarcel { 599130803Smarcel for (i = len0 - 2; i >= 0 && isdigit (mangled[i]); i -= 1) 600130803Smarcel ; 601130803Smarcel if (i > 1 && mangled[i] == '_' && mangled[i - 1] == '_') 602130803Smarcel len0 = i - 1; 603130803Smarcel else if (mangled[i] == '$') 604130803Smarcel len0 = i; 605130803Smarcel } 606130803Smarcel 607130803Smarcel for (i = 0, j = 0; i < len0 && !isalpha (mangled[i]); i += 1, j += 1) 608130803Smarcel demangled[j] = mangled[i]; 609130803Smarcel 610130803Smarcel at_start_name = 1; 611130803Smarcel while (i < len0) 612130803Smarcel { 613130803Smarcel if (at_start_name && mangled[i] == 'O') 614130803Smarcel { 615130803Smarcel int k; 616130803Smarcel for (k = 0; ada_opname_table[k].mangled != NULL; k += 1) 617130803Smarcel { 618130803Smarcel int op_len = strlen (ada_opname_table[k].mangled); 619130803Smarcel if (DEPRECATED_STREQN 620130803Smarcel (ada_opname_table[k].mangled + 1, mangled + i + 1, 621130803Smarcel op_len - 1) && !isalnum (mangled[i + op_len])) 622130803Smarcel { 623130803Smarcel strcpy (demangled + j, ada_opname_table[k].demangled); 624130803Smarcel at_start_name = 0; 625130803Smarcel i += op_len; 626130803Smarcel j += strlen (ada_opname_table[k].demangled); 627130803Smarcel break; 628130803Smarcel } 629130803Smarcel } 630130803Smarcel if (ada_opname_table[k].mangled != NULL) 631130803Smarcel continue; 632130803Smarcel } 633130803Smarcel at_start_name = 0; 634130803Smarcel 635130803Smarcel if (i < len0 - 4 && DEPRECATED_STREQN (mangled + i, "TK__", 4)) 636130803Smarcel i += 2; 637130803Smarcel if (mangled[i] == 'X' && i != 0 && isalnum (mangled[i - 1])) 638130803Smarcel { 639130803Smarcel do 640130803Smarcel i += 1; 641130803Smarcel while (i < len0 && (mangled[i] == 'b' || mangled[i] == 'n')); 642130803Smarcel if (i < len0) 643130803Smarcel goto Suppress; 644130803Smarcel } 645130803Smarcel else if (i < len0 - 2 && mangled[i] == '_' && mangled[i + 1] == '_') 646130803Smarcel { 647130803Smarcel demangled[j] = '.'; 648130803Smarcel at_start_name = 1; 649130803Smarcel i += 2; 650130803Smarcel j += 1; 651130803Smarcel } 652130803Smarcel else 653130803Smarcel { 654130803Smarcel demangled[j] = mangled[i]; 655130803Smarcel i += 1; 656130803Smarcel j += 1; 657130803Smarcel } 658130803Smarcel } 659130803Smarcel demangled[j] = '\000'; 660130803Smarcel 661130803Smarcel for (i = 0; demangled[i] != '\0'; i += 1) 662130803Smarcel if (isupper (demangled[i]) || demangled[i] == ' ') 663130803Smarcel goto Suppress; 664130803Smarcel 665130803Smarcel return demangled; 666130803Smarcel 667130803SmarcelSuppress: 668130803Smarcel GROW_VECT (demangling_buffer, demangling_buffer_size, strlen (mangled) + 3); 669130803Smarcel demangled = demangling_buffer; 670130803Smarcel if (mangled[0] == '<') 671130803Smarcel strcpy (demangled, mangled); 672130803Smarcel else 673130803Smarcel sprintf (demangled, "<%s>", mangled); 674130803Smarcel return demangled; 675130803Smarcel 676130803Smarcel} 677130803Smarcel 678130803Smarcel/* Returns non-zero iff SYM_NAME matches NAME, ignoring any trailing 679130803Smarcel * suffixes that encode debugging information or leading _ada_ on 680130803Smarcel * SYM_NAME (see is_name_suffix commentary for the debugging 681130803Smarcel * information that is ignored). If WILD, then NAME need only match a 682130803Smarcel * suffix of SYM_NAME minus the same suffixes. Also returns 0 if 683130803Smarcel * either argument is NULL. */ 684130803Smarcel 685130803Smarcelint 686130803Smarcelada_match_name (const char *sym_name, const char *name, int wild) 687130803Smarcel{ 688130803Smarcel if (sym_name == NULL || name == NULL) 689130803Smarcel return 0; 690130803Smarcel else if (wild) 691130803Smarcel return wild_match (name, strlen (name), sym_name); 692130803Smarcel else 693130803Smarcel { 694130803Smarcel int len_name = strlen (name); 695130803Smarcel return (DEPRECATED_STREQN (sym_name, name, len_name) 696130803Smarcel && is_name_suffix (sym_name + len_name)) 697130803Smarcel || (DEPRECATED_STREQN (sym_name, "_ada_", 5) 698130803Smarcel && DEPRECATED_STREQN (sym_name + 5, name, len_name) 699130803Smarcel && is_name_suffix (sym_name + len_name + 5)); 700130803Smarcel } 701130803Smarcel} 702130803Smarcel 703130803Smarcel/* True (non-zero) iff in Ada mode, the symbol SYM should be 704130803Smarcel suppressed in info listings. */ 705130803Smarcel 706130803Smarcelint 707130803Smarcelada_suppress_symbol_printing (struct symbol *sym) 708130803Smarcel{ 709130803Smarcel if (SYMBOL_DOMAIN (sym) == STRUCT_DOMAIN) 710130803Smarcel return 1; 711130803Smarcel else 712130803Smarcel return is_suppressed_name (DEPRECATED_SYMBOL_NAME (sym)); 713130803Smarcel} 714130803Smarcel 715130803Smarcel 716130803Smarcel /* Arrays */ 717130803Smarcel 718130803Smarcel/* Names of MAX_ADA_DIMENS bounds in P_BOUNDS fields of 719130803Smarcel array descriptors. */ 720130803Smarcel 721130803Smarcelstatic char *bound_name[] = { 722130803Smarcel "LB0", "UB0", "LB1", "UB1", "LB2", "UB2", "LB3", "UB3", 723130803Smarcel "LB4", "UB4", "LB5", "UB5", "LB6", "UB6", "LB7", "UB7" 724130803Smarcel}; 725130803Smarcel 726130803Smarcel/* Maximum number of array dimensions we are prepared to handle. */ 727130803Smarcel 728130803Smarcel#define MAX_ADA_DIMENS (sizeof(bound_name) / (2*sizeof(char*))) 729130803Smarcel 730130803Smarcel/* Like modify_field, but allows bitpos > wordlength. */ 731130803Smarcel 732130803Smarcelstatic void 733130803Smarcelmodify_general_field (char *addr, LONGEST fieldval, int bitpos, int bitsize) 734130803Smarcel{ 735130803Smarcel modify_field (addr + sizeof (LONGEST) * bitpos / (8 * sizeof (LONGEST)), 736130803Smarcel fieldval, bitpos % (8 * sizeof (LONGEST)), bitsize); 737130803Smarcel} 738130803Smarcel 739130803Smarcel 740130803Smarcel/* The desc_* routines return primitive portions of array descriptors 741130803Smarcel (fat pointers). */ 742130803Smarcel 743130803Smarcel/* The descriptor or array type, if any, indicated by TYPE; removes 744130803Smarcel level of indirection, if needed. */ 745130803Smarcelstatic struct type * 746130803Smarceldesc_base_type (struct type *type) 747130803Smarcel{ 748130803Smarcel if (type == NULL) 749130803Smarcel return NULL; 750130803Smarcel CHECK_TYPEDEF (type); 751130803Smarcel if (type != NULL && TYPE_CODE (type) == TYPE_CODE_PTR) 752130803Smarcel return check_typedef (TYPE_TARGET_TYPE (type)); 753130803Smarcel else 754130803Smarcel return type; 755130803Smarcel} 756130803Smarcel 757130803Smarcel/* True iff TYPE indicates a "thin" array pointer type. */ 758130803Smarcelstatic int 759130803Smarcelis_thin_pntr (struct type *type) 760130803Smarcel{ 761130803Smarcel return 762130803Smarcel is_suffix (ada_type_name (desc_base_type (type)), "___XUT") 763130803Smarcel || is_suffix (ada_type_name (desc_base_type (type)), "___XUT___XVE"); 764130803Smarcel} 765130803Smarcel 766130803Smarcel/* The descriptor type for thin pointer type TYPE. */ 767130803Smarcelstatic struct type * 768130803Smarcelthin_descriptor_type (struct type *type) 769130803Smarcel{ 770130803Smarcel struct type *base_type = desc_base_type (type); 771130803Smarcel if (base_type == NULL) 772130803Smarcel return NULL; 773130803Smarcel if (is_suffix (ada_type_name (base_type), "___XVE")) 774130803Smarcel return base_type; 775130803Smarcel else 776130803Smarcel { 777130803Smarcel struct type *alt_type = ada_find_parallel_type (base_type, "___XVE"); 778130803Smarcel if (alt_type == NULL) 779130803Smarcel return base_type; 780130803Smarcel else 781130803Smarcel return alt_type; 782130803Smarcel } 783130803Smarcel} 784130803Smarcel 785130803Smarcel/* A pointer to the array data for thin-pointer value VAL. */ 786130803Smarcelstatic struct value * 787130803Smarcelthin_data_pntr (struct value *val) 788130803Smarcel{ 789130803Smarcel struct type *type = VALUE_TYPE (val); 790130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_PTR) 791130803Smarcel return value_cast (desc_data_type (thin_descriptor_type (type)), 792130803Smarcel value_copy (val)); 793130803Smarcel else 794130803Smarcel return value_from_longest (desc_data_type (thin_descriptor_type (type)), 795130803Smarcel VALUE_ADDRESS (val) + VALUE_OFFSET (val)); 796130803Smarcel} 797130803Smarcel 798130803Smarcel/* True iff TYPE indicates a "thick" array pointer type. */ 799130803Smarcelstatic int 800130803Smarcelis_thick_pntr (struct type *type) 801130803Smarcel{ 802130803Smarcel type = desc_base_type (type); 803130803Smarcel return (type != NULL && TYPE_CODE (type) == TYPE_CODE_STRUCT 804130803Smarcel && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL); 805130803Smarcel} 806130803Smarcel 807130803Smarcel/* If TYPE is the type of an array descriptor (fat or thin pointer) or a 808130803Smarcel pointer to one, the type of its bounds data; otherwise, NULL. */ 809130803Smarcelstatic struct type * 810130803Smarceldesc_bounds_type (struct type *type) 811130803Smarcel{ 812130803Smarcel struct type *r; 813130803Smarcel 814130803Smarcel type = desc_base_type (type); 815130803Smarcel 816130803Smarcel if (type == NULL) 817130803Smarcel return NULL; 818130803Smarcel else if (is_thin_pntr (type)) 819130803Smarcel { 820130803Smarcel type = thin_descriptor_type (type); 821130803Smarcel if (type == NULL) 822130803Smarcel return NULL; 823130803Smarcel r = lookup_struct_elt_type (type, "BOUNDS", 1); 824130803Smarcel if (r != NULL) 825130803Smarcel return check_typedef (r); 826130803Smarcel } 827130803Smarcel else if (TYPE_CODE (type) == TYPE_CODE_STRUCT) 828130803Smarcel { 829130803Smarcel r = lookup_struct_elt_type (type, "P_BOUNDS", 1); 830130803Smarcel if (r != NULL) 831130803Smarcel return check_typedef (TYPE_TARGET_TYPE (check_typedef (r))); 832130803Smarcel } 833130803Smarcel return NULL; 834130803Smarcel} 835130803Smarcel 836130803Smarcel/* If ARR is an array descriptor (fat or thin pointer), or pointer to 837130803Smarcel one, a pointer to its bounds data. Otherwise NULL. */ 838130803Smarcelstatic struct value * 839130803Smarceldesc_bounds (struct value *arr) 840130803Smarcel{ 841130803Smarcel struct type *type = check_typedef (VALUE_TYPE (arr)); 842130803Smarcel if (is_thin_pntr (type)) 843130803Smarcel { 844130803Smarcel struct type *bounds_type = 845130803Smarcel desc_bounds_type (thin_descriptor_type (type)); 846130803Smarcel LONGEST addr; 847130803Smarcel 848130803Smarcel if (desc_bounds_type == NULL) 849130803Smarcel error ("Bad GNAT array descriptor"); 850130803Smarcel 851130803Smarcel /* NOTE: The following calculation is not really kosher, but 852130803Smarcel since desc_type is an XVE-encoded type (and shouldn't be), 853130803Smarcel the correct calculation is a real pain. FIXME (and fix GCC). */ 854130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_PTR) 855130803Smarcel addr = value_as_long (arr); 856130803Smarcel else 857130803Smarcel addr = VALUE_ADDRESS (arr) + VALUE_OFFSET (arr); 858130803Smarcel 859130803Smarcel return 860130803Smarcel value_from_longest (lookup_pointer_type (bounds_type), 861130803Smarcel addr - TYPE_LENGTH (bounds_type)); 862130803Smarcel } 863130803Smarcel 864130803Smarcel else if (is_thick_pntr (type)) 865130803Smarcel return value_struct_elt (&arr, NULL, "P_BOUNDS", NULL, 866130803Smarcel "Bad GNAT array descriptor"); 867130803Smarcel else 868130803Smarcel return NULL; 869130803Smarcel} 870130803Smarcel 871130803Smarcel/* If TYPE is the type of an array-descriptor (fat pointer), the bit 872130803Smarcel position of the field containing the address of the bounds data. */ 873130803Smarcelstatic int 874130803Smarcelfat_pntr_bounds_bitpos (struct type *type) 875130803Smarcel{ 876130803Smarcel return TYPE_FIELD_BITPOS (desc_base_type (type), 1); 877130803Smarcel} 878130803Smarcel 879130803Smarcel/* If TYPE is the type of an array-descriptor (fat pointer), the bit 880130803Smarcel size of the field containing the address of the bounds data. */ 881130803Smarcelstatic int 882130803Smarcelfat_pntr_bounds_bitsize (struct type *type) 883130803Smarcel{ 884130803Smarcel type = desc_base_type (type); 885130803Smarcel 886130803Smarcel if (TYPE_FIELD_BITSIZE (type, 1) > 0) 887130803Smarcel return TYPE_FIELD_BITSIZE (type, 1); 888130803Smarcel else 889130803Smarcel return 8 * TYPE_LENGTH (check_typedef (TYPE_FIELD_TYPE (type, 1))); 890130803Smarcel} 891130803Smarcel 892130803Smarcel/* If TYPE is the type of an array descriptor (fat or thin pointer) or a 893130803Smarcel pointer to one, the type of its array data (a 894130803Smarcel pointer-to-array-with-no-bounds type); otherwise, NULL. Use 895130803Smarcel ada_type_of_array to get an array type with bounds data. */ 896130803Smarcelstatic struct type * 897130803Smarceldesc_data_type (struct type *type) 898130803Smarcel{ 899130803Smarcel type = desc_base_type (type); 900130803Smarcel 901130803Smarcel /* NOTE: The following is bogus; see comment in desc_bounds. */ 902130803Smarcel if (is_thin_pntr (type)) 903130803Smarcel return lookup_pointer_type 904130803Smarcel (desc_base_type (TYPE_FIELD_TYPE (thin_descriptor_type (type), 1))); 905130803Smarcel else if (is_thick_pntr (type)) 906130803Smarcel return lookup_struct_elt_type (type, "P_ARRAY", 1); 907130803Smarcel else 908130803Smarcel return NULL; 909130803Smarcel} 910130803Smarcel 911130803Smarcel/* If ARR is an array descriptor (fat or thin pointer), a pointer to 912130803Smarcel its array data. */ 913130803Smarcelstatic struct value * 914130803Smarceldesc_data (struct value *arr) 915130803Smarcel{ 916130803Smarcel struct type *type = VALUE_TYPE (arr); 917130803Smarcel if (is_thin_pntr (type)) 918130803Smarcel return thin_data_pntr (arr); 919130803Smarcel else if (is_thick_pntr (type)) 920130803Smarcel return value_struct_elt (&arr, NULL, "P_ARRAY", NULL, 921130803Smarcel "Bad GNAT array descriptor"); 922130803Smarcel else 923130803Smarcel return NULL; 924130803Smarcel} 925130803Smarcel 926130803Smarcel 927130803Smarcel/* If TYPE is the type of an array-descriptor (fat pointer), the bit 928130803Smarcel position of the field containing the address of the data. */ 929130803Smarcelstatic int 930130803Smarcelfat_pntr_data_bitpos (struct type *type) 931130803Smarcel{ 932130803Smarcel return TYPE_FIELD_BITPOS (desc_base_type (type), 0); 933130803Smarcel} 934130803Smarcel 935130803Smarcel/* If TYPE is the type of an array-descriptor (fat pointer), the bit 936130803Smarcel size of the field containing the address of the data. */ 937130803Smarcelstatic int 938130803Smarcelfat_pntr_data_bitsize (struct type *type) 939130803Smarcel{ 940130803Smarcel type = desc_base_type (type); 941130803Smarcel 942130803Smarcel if (TYPE_FIELD_BITSIZE (type, 0) > 0) 943130803Smarcel return TYPE_FIELD_BITSIZE (type, 0); 944130803Smarcel else 945130803Smarcel return TARGET_CHAR_BIT * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)); 946130803Smarcel} 947130803Smarcel 948130803Smarcel/* If BOUNDS is an array-bounds structure (or pointer to one), return 949130803Smarcel the Ith lower bound stored in it, if WHICH is 0, and the Ith upper 950130803Smarcel bound, if WHICH is 1. The first bound is I=1. */ 951130803Smarcelstatic struct value * 952130803Smarceldesc_one_bound (struct value *bounds, int i, int which) 953130803Smarcel{ 954130803Smarcel return value_struct_elt (&bounds, NULL, bound_name[2 * i + which - 2], NULL, 955130803Smarcel "Bad GNAT array descriptor bounds"); 956130803Smarcel} 957130803Smarcel 958130803Smarcel/* If BOUNDS is an array-bounds structure type, return the bit position 959130803Smarcel of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper 960130803Smarcel bound, if WHICH is 1. The first bound is I=1. */ 961130803Smarcelstatic int 962130803Smarceldesc_bound_bitpos (struct type *type, int i, int which) 963130803Smarcel{ 964130803Smarcel return TYPE_FIELD_BITPOS (desc_base_type (type), 2 * i + which - 2); 965130803Smarcel} 966130803Smarcel 967130803Smarcel/* If BOUNDS is an array-bounds structure type, return the bit field size 968130803Smarcel of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper 969130803Smarcel bound, if WHICH is 1. The first bound is I=1. */ 970130803Smarcelstatic int 971130803Smarceldesc_bound_bitsize (struct type *type, int i, int which) 972130803Smarcel{ 973130803Smarcel type = desc_base_type (type); 974130803Smarcel 975130803Smarcel if (TYPE_FIELD_BITSIZE (type, 2 * i + which - 2) > 0) 976130803Smarcel return TYPE_FIELD_BITSIZE (type, 2 * i + which - 2); 977130803Smarcel else 978130803Smarcel return 8 * TYPE_LENGTH (TYPE_FIELD_TYPE (type, 2 * i + which - 2)); 979130803Smarcel} 980130803Smarcel 981130803Smarcel/* If TYPE is the type of an array-bounds structure, the type of its 982130803Smarcel Ith bound (numbering from 1). Otherwise, NULL. */ 983130803Smarcelstatic struct type * 984130803Smarceldesc_index_type (struct type *type, int i) 985130803Smarcel{ 986130803Smarcel type = desc_base_type (type); 987130803Smarcel 988130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_STRUCT) 989130803Smarcel return lookup_struct_elt_type (type, bound_name[2 * i - 2], 1); 990130803Smarcel else 991130803Smarcel return NULL; 992130803Smarcel} 993130803Smarcel 994130803Smarcel/* The number of index positions in the array-bounds type TYPE. 0 995130803Smarcel if TYPE is NULL. */ 996130803Smarcelstatic int 997130803Smarceldesc_arity (struct type *type) 998130803Smarcel{ 999130803Smarcel type = desc_base_type (type); 1000130803Smarcel 1001130803Smarcel if (type != NULL) 1002130803Smarcel return TYPE_NFIELDS (type) / 2; 1003130803Smarcel return 0; 1004130803Smarcel} 1005130803Smarcel 1006130803Smarcel 1007130803Smarcel/* Non-zero iff type is a simple array type (or pointer to one). */ 1008130803Smarcelint 1009130803Smarcelada_is_simple_array (struct type *type) 1010130803Smarcel{ 1011130803Smarcel if (type == NULL) 1012130803Smarcel return 0; 1013130803Smarcel CHECK_TYPEDEF (type); 1014130803Smarcel return (TYPE_CODE (type) == TYPE_CODE_ARRAY 1015130803Smarcel || (TYPE_CODE (type) == TYPE_CODE_PTR 1016130803Smarcel && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)); 1017130803Smarcel} 1018130803Smarcel 1019130803Smarcel/* Non-zero iff type belongs to a GNAT array descriptor. */ 1020130803Smarcelint 1021130803Smarcelada_is_array_descriptor (struct type *type) 1022130803Smarcel{ 1023130803Smarcel struct type *data_type = desc_data_type (type); 1024130803Smarcel 1025130803Smarcel if (type == NULL) 1026130803Smarcel return 0; 1027130803Smarcel CHECK_TYPEDEF (type); 1028130803Smarcel return 1029130803Smarcel data_type != NULL 1030130803Smarcel && ((TYPE_CODE (data_type) == TYPE_CODE_PTR 1031130803Smarcel && TYPE_TARGET_TYPE (data_type) != NULL 1032130803Smarcel && TYPE_CODE (TYPE_TARGET_TYPE (data_type)) == TYPE_CODE_ARRAY) 1033130803Smarcel || 1034130803Smarcel TYPE_CODE (data_type) == TYPE_CODE_ARRAY) 1035130803Smarcel && desc_arity (desc_bounds_type (type)) > 0; 1036130803Smarcel} 1037130803Smarcel 1038130803Smarcel/* Non-zero iff type is a partially mal-formed GNAT array 1039130803Smarcel descriptor. (FIXME: This is to compensate for some problems with 1040130803Smarcel debugging output from GNAT. Re-examine periodically to see if it 1041130803Smarcel is still needed. */ 1042130803Smarcelint 1043130803Smarcelada_is_bogus_array_descriptor (struct type *type) 1044130803Smarcel{ 1045130803Smarcel return 1046130803Smarcel type != NULL 1047130803Smarcel && TYPE_CODE (type) == TYPE_CODE_STRUCT 1048130803Smarcel && (lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL 1049130803Smarcel || lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL) 1050130803Smarcel && !ada_is_array_descriptor (type); 1051130803Smarcel} 1052130803Smarcel 1053130803Smarcel 1054130803Smarcel/* If ARR has a record type in the form of a standard GNAT array descriptor, 1055130803Smarcel (fat pointer) returns the type of the array data described---specifically, 1056130803Smarcel a pointer-to-array type. If BOUNDS is non-zero, the bounds data are filled 1057130803Smarcel in from the descriptor; otherwise, they are left unspecified. If 1058130803Smarcel the ARR denotes a null array descriptor and BOUNDS is non-zero, 1059130803Smarcel returns NULL. The result is simply the type of ARR if ARR is not 1060130803Smarcel a descriptor. */ 1061130803Smarcelstruct type * 1062130803Smarcelada_type_of_array (struct value *arr, int bounds) 1063130803Smarcel{ 1064130803Smarcel if (ada_is_packed_array_type (VALUE_TYPE (arr))) 1065130803Smarcel return decode_packed_array_type (VALUE_TYPE (arr)); 1066130803Smarcel 1067130803Smarcel if (!ada_is_array_descriptor (VALUE_TYPE (arr))) 1068130803Smarcel return VALUE_TYPE (arr); 1069130803Smarcel 1070130803Smarcel if (!bounds) 1071130803Smarcel return 1072130803Smarcel check_typedef (TYPE_TARGET_TYPE (desc_data_type (VALUE_TYPE (arr)))); 1073130803Smarcel else 1074130803Smarcel { 1075130803Smarcel struct type *elt_type; 1076130803Smarcel int arity; 1077130803Smarcel struct value *descriptor; 1078130803Smarcel struct objfile *objf = TYPE_OBJFILE (VALUE_TYPE (arr)); 1079130803Smarcel 1080130803Smarcel elt_type = ada_array_element_type (VALUE_TYPE (arr), -1); 1081130803Smarcel arity = ada_array_arity (VALUE_TYPE (arr)); 1082130803Smarcel 1083130803Smarcel if (elt_type == NULL || arity == 0) 1084130803Smarcel return check_typedef (VALUE_TYPE (arr)); 1085130803Smarcel 1086130803Smarcel descriptor = desc_bounds (arr); 1087130803Smarcel if (value_as_long (descriptor) == 0) 1088130803Smarcel return NULL; 1089130803Smarcel while (arity > 0) 1090130803Smarcel { 1091130803Smarcel struct type *range_type = alloc_type (objf); 1092130803Smarcel struct type *array_type = alloc_type (objf); 1093130803Smarcel struct value *low = desc_one_bound (descriptor, arity, 0); 1094130803Smarcel struct value *high = desc_one_bound (descriptor, arity, 1); 1095130803Smarcel arity -= 1; 1096130803Smarcel 1097130803Smarcel create_range_type (range_type, VALUE_TYPE (low), 1098130803Smarcel (int) value_as_long (low), 1099130803Smarcel (int) value_as_long (high)); 1100130803Smarcel elt_type = create_array_type (array_type, elt_type, range_type); 1101130803Smarcel } 1102130803Smarcel 1103130803Smarcel return lookup_pointer_type (elt_type); 1104130803Smarcel } 1105130803Smarcel} 1106130803Smarcel 1107130803Smarcel/* If ARR does not represent an array, returns ARR unchanged. 1108130803Smarcel Otherwise, returns either a standard GDB array with bounds set 1109130803Smarcel appropriately or, if ARR is a non-null fat pointer, a pointer to a standard 1110130803Smarcel GDB array. Returns NULL if ARR is a null fat pointer. */ 1111130803Smarcelstruct value * 1112130803Smarcelada_coerce_to_simple_array_ptr (struct value *arr) 1113130803Smarcel{ 1114130803Smarcel if (ada_is_array_descriptor (VALUE_TYPE (arr))) 1115130803Smarcel { 1116130803Smarcel struct type *arrType = ada_type_of_array (arr, 1); 1117130803Smarcel if (arrType == NULL) 1118130803Smarcel return NULL; 1119130803Smarcel return value_cast (arrType, value_copy (desc_data (arr))); 1120130803Smarcel } 1121130803Smarcel else if (ada_is_packed_array_type (VALUE_TYPE (arr))) 1122130803Smarcel return decode_packed_array (arr); 1123130803Smarcel else 1124130803Smarcel return arr; 1125130803Smarcel} 1126130803Smarcel 1127130803Smarcel/* If ARR does not represent an array, returns ARR unchanged. 1128130803Smarcel Otherwise, returns a standard GDB array describing ARR (which may 1129130803Smarcel be ARR itself if it already is in the proper form). */ 1130130803Smarcelstruct value * 1131130803Smarcelada_coerce_to_simple_array (struct value *arr) 1132130803Smarcel{ 1133130803Smarcel if (ada_is_array_descriptor (VALUE_TYPE (arr))) 1134130803Smarcel { 1135130803Smarcel struct value *arrVal = ada_coerce_to_simple_array_ptr (arr); 1136130803Smarcel if (arrVal == NULL) 1137130803Smarcel error ("Bounds unavailable for null array pointer."); 1138130803Smarcel return value_ind (arrVal); 1139130803Smarcel } 1140130803Smarcel else if (ada_is_packed_array_type (VALUE_TYPE (arr))) 1141130803Smarcel return decode_packed_array (arr); 1142130803Smarcel else 1143130803Smarcel return arr; 1144130803Smarcel} 1145130803Smarcel 1146130803Smarcel/* If TYPE represents a GNAT array type, return it translated to an 1147130803Smarcel ordinary GDB array type (possibly with BITSIZE fields indicating 1148130803Smarcel packing). For other types, is the identity. */ 1149130803Smarcelstruct type * 1150130803Smarcelada_coerce_to_simple_array_type (struct type *type) 1151130803Smarcel{ 1152130803Smarcel struct value *mark = value_mark (); 1153130803Smarcel struct value *dummy = value_from_longest (builtin_type_long, 0); 1154130803Smarcel struct type *result; 1155130803Smarcel VALUE_TYPE (dummy) = type; 1156130803Smarcel result = ada_type_of_array (dummy, 0); 1157130803Smarcel value_free_to_mark (dummy); 1158130803Smarcel return result; 1159130803Smarcel} 1160130803Smarcel 1161130803Smarcel/* Non-zero iff TYPE represents a standard GNAT packed-array type. */ 1162130803Smarcelint 1163130803Smarcelada_is_packed_array_type (struct type *type) 1164130803Smarcel{ 1165130803Smarcel if (type == NULL) 1166130803Smarcel return 0; 1167130803Smarcel CHECK_TYPEDEF (type); 1168130803Smarcel return 1169130803Smarcel ada_type_name (type) != NULL 1170130803Smarcel && strstr (ada_type_name (type), "___XP") != NULL; 1171130803Smarcel} 1172130803Smarcel 1173130803Smarcel/* Given that TYPE is a standard GDB array type with all bounds filled 1174130803Smarcel in, and that the element size of its ultimate scalar constituents 1175130803Smarcel (that is, either its elements, or, if it is an array of arrays, its 1176130803Smarcel elements' elements, etc.) is *ELT_BITS, return an identical type, 1177130803Smarcel but with the bit sizes of its elements (and those of any 1178130803Smarcel constituent arrays) recorded in the BITSIZE components of its 1179130803Smarcel TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size 1180130803Smarcel in bits. */ 1181130803Smarcelstatic struct type * 1182130803Smarcelpacked_array_type (struct type *type, long *elt_bits) 1183130803Smarcel{ 1184130803Smarcel struct type *new_elt_type; 1185130803Smarcel struct type *new_type; 1186130803Smarcel LONGEST low_bound, high_bound; 1187130803Smarcel 1188130803Smarcel CHECK_TYPEDEF (type); 1189130803Smarcel if (TYPE_CODE (type) != TYPE_CODE_ARRAY) 1190130803Smarcel return type; 1191130803Smarcel 1192130803Smarcel new_type = alloc_type (TYPE_OBJFILE (type)); 1193130803Smarcel new_elt_type = packed_array_type (check_typedef (TYPE_TARGET_TYPE (type)), 1194130803Smarcel elt_bits); 1195130803Smarcel create_array_type (new_type, new_elt_type, TYPE_FIELD_TYPE (type, 0)); 1196130803Smarcel TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits; 1197130803Smarcel TYPE_NAME (new_type) = ada_type_name (type); 1198130803Smarcel 1199130803Smarcel if (get_discrete_bounds (TYPE_FIELD_TYPE (type, 0), 1200130803Smarcel &low_bound, &high_bound) < 0) 1201130803Smarcel low_bound = high_bound = 0; 1202130803Smarcel if (high_bound < low_bound) 1203130803Smarcel *elt_bits = TYPE_LENGTH (new_type) = 0; 1204130803Smarcel else 1205130803Smarcel { 1206130803Smarcel *elt_bits *= (high_bound - low_bound + 1); 1207130803Smarcel TYPE_LENGTH (new_type) = 1208130803Smarcel (*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT; 1209130803Smarcel } 1210130803Smarcel 1211130803Smarcel /* TYPE_FLAGS (new_type) |= TYPE_FLAG_FIXED_INSTANCE; */ 1212130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 1213130803Smarcel return new_type; 1214130803Smarcel} 1215130803Smarcel 1216130803Smarcel/* The array type encoded by TYPE, where ada_is_packed_array_type (TYPE). 1217130803Smarcel */ 1218130803Smarcelstatic struct type * 1219130803Smarceldecode_packed_array_type (struct type *type) 1220130803Smarcel{ 1221130803Smarcel struct symbol **syms; 1222130803Smarcel struct block **blocks; 1223130803Smarcel const char *raw_name = ada_type_name (check_typedef (type)); 1224130803Smarcel char *name = (char *) alloca (strlen (raw_name) + 1); 1225130803Smarcel char *tail = strstr (raw_name, "___XP"); 1226130803Smarcel struct type *shadow_type; 1227130803Smarcel long bits; 1228130803Smarcel int i, n; 1229130803Smarcel 1230130803Smarcel memcpy (name, raw_name, tail - raw_name); 1231130803Smarcel name[tail - raw_name] = '\000'; 1232130803Smarcel 1233130803Smarcel /* NOTE: Use ada_lookup_symbol_list because of bug in some versions 1234130803Smarcel * of gcc (Solaris, e.g.). FIXME when compiler is fixed. */ 1235130803Smarcel n = ada_lookup_symbol_list (name, get_selected_block (NULL), 1236130803Smarcel VAR_DOMAIN, &syms, &blocks); 1237130803Smarcel for (i = 0; i < n; i += 1) 1238130803Smarcel if (syms[i] != NULL && SYMBOL_CLASS (syms[i]) == LOC_TYPEDEF 1239130803Smarcel && DEPRECATED_STREQ (name, ada_type_name (SYMBOL_TYPE (syms[i])))) 1240130803Smarcel break; 1241130803Smarcel if (i >= n) 1242130803Smarcel { 1243130803Smarcel warning ("could not find bounds information on packed array"); 1244130803Smarcel return NULL; 1245130803Smarcel } 1246130803Smarcel shadow_type = SYMBOL_TYPE (syms[i]); 1247130803Smarcel 1248130803Smarcel if (TYPE_CODE (shadow_type) != TYPE_CODE_ARRAY) 1249130803Smarcel { 1250130803Smarcel warning ("could not understand bounds information on packed array"); 1251130803Smarcel return NULL; 1252130803Smarcel } 1253130803Smarcel 1254130803Smarcel if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1) 1255130803Smarcel { 1256130803Smarcel warning ("could not understand bit size information on packed array"); 1257130803Smarcel return NULL; 1258130803Smarcel } 1259130803Smarcel 1260130803Smarcel return packed_array_type (shadow_type, &bits); 1261130803Smarcel} 1262130803Smarcel 1263130803Smarcel/* Given that ARR is a struct value* indicating a GNAT packed array, 1264130803Smarcel returns a simple array that denotes that array. Its type is a 1265130803Smarcel standard GDB array type except that the BITSIZEs of the array 1266130803Smarcel target types are set to the number of bits in each element, and the 1267130803Smarcel type length is set appropriately. */ 1268130803Smarcel 1269130803Smarcelstatic struct value * 1270130803Smarceldecode_packed_array (struct value *arr) 1271130803Smarcel{ 1272130803Smarcel struct type *type = decode_packed_array_type (VALUE_TYPE (arr)); 1273130803Smarcel 1274130803Smarcel if (type == NULL) 1275130803Smarcel { 1276130803Smarcel error ("can't unpack array"); 1277130803Smarcel return NULL; 1278130803Smarcel } 1279130803Smarcel else 1280130803Smarcel return coerce_unspec_val_to_type (arr, 0, type); 1281130803Smarcel} 1282130803Smarcel 1283130803Smarcel 1284130803Smarcel/* The value of the element of packed array ARR at the ARITY indices 1285130803Smarcel given in IND. ARR must be a simple array. */ 1286130803Smarcel 1287130803Smarcelstatic struct value * 1288130803Smarcelvalue_subscript_packed (struct value *arr, int arity, struct value **ind) 1289130803Smarcel{ 1290130803Smarcel int i; 1291130803Smarcel int bits, elt_off, bit_off; 1292130803Smarcel long elt_total_bit_offset; 1293130803Smarcel struct type *elt_type; 1294130803Smarcel struct value *v; 1295130803Smarcel 1296130803Smarcel bits = 0; 1297130803Smarcel elt_total_bit_offset = 0; 1298130803Smarcel elt_type = check_typedef (VALUE_TYPE (arr)); 1299130803Smarcel for (i = 0; i < arity; i += 1) 1300130803Smarcel { 1301130803Smarcel if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY 1302130803Smarcel || TYPE_FIELD_BITSIZE (elt_type, 0) == 0) 1303130803Smarcel error 1304130803Smarcel ("attempt to do packed indexing of something other than a packed array"); 1305130803Smarcel else 1306130803Smarcel { 1307130803Smarcel struct type *range_type = TYPE_INDEX_TYPE (elt_type); 1308130803Smarcel LONGEST lowerbound, upperbound; 1309130803Smarcel LONGEST idx; 1310130803Smarcel 1311130803Smarcel if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0) 1312130803Smarcel { 1313130803Smarcel warning ("don't know bounds of array"); 1314130803Smarcel lowerbound = upperbound = 0; 1315130803Smarcel } 1316130803Smarcel 1317130803Smarcel idx = value_as_long (value_pos_atr (ind[i])); 1318130803Smarcel if (idx < lowerbound || idx > upperbound) 1319130803Smarcel warning ("packed array index %ld out of bounds", (long) idx); 1320130803Smarcel bits = TYPE_FIELD_BITSIZE (elt_type, 0); 1321130803Smarcel elt_total_bit_offset += (idx - lowerbound) * bits; 1322130803Smarcel elt_type = check_typedef (TYPE_TARGET_TYPE (elt_type)); 1323130803Smarcel } 1324130803Smarcel } 1325130803Smarcel elt_off = elt_total_bit_offset / HOST_CHAR_BIT; 1326130803Smarcel bit_off = elt_total_bit_offset % HOST_CHAR_BIT; 1327130803Smarcel 1328130803Smarcel v = ada_value_primitive_packed_val (arr, NULL, elt_off, bit_off, 1329130803Smarcel bits, elt_type); 1330130803Smarcel if (VALUE_LVAL (arr) == lval_internalvar) 1331130803Smarcel VALUE_LVAL (v) = lval_internalvar_component; 1332130803Smarcel else 1333130803Smarcel VALUE_LVAL (v) = VALUE_LVAL (arr); 1334130803Smarcel return v; 1335130803Smarcel} 1336130803Smarcel 1337130803Smarcel/* Non-zero iff TYPE includes negative integer values. */ 1338130803Smarcel 1339130803Smarcelstatic int 1340130803Smarcelhas_negatives (struct type *type) 1341130803Smarcel{ 1342130803Smarcel switch (TYPE_CODE (type)) 1343130803Smarcel { 1344130803Smarcel default: 1345130803Smarcel return 0; 1346130803Smarcel case TYPE_CODE_INT: 1347130803Smarcel return !TYPE_UNSIGNED (type); 1348130803Smarcel case TYPE_CODE_RANGE: 1349130803Smarcel return TYPE_LOW_BOUND (type) < 0; 1350130803Smarcel } 1351130803Smarcel} 1352130803Smarcel 1353130803Smarcel 1354130803Smarcel/* Create a new value of type TYPE from the contents of OBJ starting 1355130803Smarcel at byte OFFSET, and bit offset BIT_OFFSET within that byte, 1356130803Smarcel proceeding for BIT_SIZE bits. If OBJ is an lval in memory, then 1357130803Smarcel assigning through the result will set the field fetched from. OBJ 1358130803Smarcel may also be NULL, in which case, VALADDR+OFFSET must address the 1359130803Smarcel start of storage containing the packed value. The value returned 1360130803Smarcel in this case is never an lval. 1361130803Smarcel Assumes 0 <= BIT_OFFSET < HOST_CHAR_BIT. */ 1362130803Smarcel 1363130803Smarcelstruct value * 1364130803Smarcelada_value_primitive_packed_val (struct value *obj, char *valaddr, long offset, 1365130803Smarcel int bit_offset, int bit_size, 1366130803Smarcel struct type *type) 1367130803Smarcel{ 1368130803Smarcel struct value *v; 1369130803Smarcel int src, /* Index into the source area. */ 1370130803Smarcel targ, /* Index into the target area. */ 1371130803Smarcel i, srcBitsLeft, /* Number of source bits left to move. */ 1372130803Smarcel nsrc, ntarg, /* Number of source and target bytes. */ 1373130803Smarcel unusedLS, /* Number of bits in next significant 1374130803Smarcel * byte of source that are unused. */ 1375130803Smarcel accumSize; /* Number of meaningful bits in accum */ 1376130803Smarcel unsigned char *bytes; /* First byte containing data to unpack. */ 1377130803Smarcel unsigned char *unpacked; 1378130803Smarcel unsigned long accum; /* Staging area for bits being transferred */ 1379130803Smarcel unsigned char sign; 1380130803Smarcel int len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8; 1381130803Smarcel /* Transmit bytes from least to most significant; delta is the 1382130803Smarcel * direction the indices move. */ 1383130803Smarcel int delta = BITS_BIG_ENDIAN ? -1 : 1; 1384130803Smarcel 1385130803Smarcel CHECK_TYPEDEF (type); 1386130803Smarcel 1387130803Smarcel if (obj == NULL) 1388130803Smarcel { 1389130803Smarcel v = allocate_value (type); 1390130803Smarcel bytes = (unsigned char *) (valaddr + offset); 1391130803Smarcel } 1392130803Smarcel else if (VALUE_LAZY (obj)) 1393130803Smarcel { 1394130803Smarcel v = value_at (type, 1395130803Smarcel VALUE_ADDRESS (obj) + VALUE_OFFSET (obj) + offset, NULL); 1396130803Smarcel bytes = (unsigned char *) alloca (len); 1397130803Smarcel read_memory (VALUE_ADDRESS (v), bytes, len); 1398130803Smarcel } 1399130803Smarcel else 1400130803Smarcel { 1401130803Smarcel v = allocate_value (type); 1402130803Smarcel bytes = (unsigned char *) VALUE_CONTENTS (obj) + offset; 1403130803Smarcel } 1404130803Smarcel 1405130803Smarcel if (obj != NULL) 1406130803Smarcel { 1407130803Smarcel VALUE_LVAL (v) = VALUE_LVAL (obj); 1408130803Smarcel if (VALUE_LVAL (obj) == lval_internalvar) 1409130803Smarcel VALUE_LVAL (v) = lval_internalvar_component; 1410130803Smarcel VALUE_ADDRESS (v) = VALUE_ADDRESS (obj) + VALUE_OFFSET (obj) + offset; 1411130803Smarcel VALUE_BITPOS (v) = bit_offset + VALUE_BITPOS (obj); 1412130803Smarcel VALUE_BITSIZE (v) = bit_size; 1413130803Smarcel if (VALUE_BITPOS (v) >= HOST_CHAR_BIT) 1414130803Smarcel { 1415130803Smarcel VALUE_ADDRESS (v) += 1; 1416130803Smarcel VALUE_BITPOS (v) -= HOST_CHAR_BIT; 1417130803Smarcel } 1418130803Smarcel } 1419130803Smarcel else 1420130803Smarcel VALUE_BITSIZE (v) = bit_size; 1421130803Smarcel unpacked = (unsigned char *) VALUE_CONTENTS (v); 1422130803Smarcel 1423130803Smarcel srcBitsLeft = bit_size; 1424130803Smarcel nsrc = len; 1425130803Smarcel ntarg = TYPE_LENGTH (type); 1426130803Smarcel sign = 0; 1427130803Smarcel if (bit_size == 0) 1428130803Smarcel { 1429130803Smarcel memset (unpacked, 0, TYPE_LENGTH (type)); 1430130803Smarcel return v; 1431130803Smarcel } 1432130803Smarcel else if (BITS_BIG_ENDIAN) 1433130803Smarcel { 1434130803Smarcel src = len - 1; 1435130803Smarcel if (has_negatives (type) && 1436130803Smarcel ((bytes[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1)))) 1437130803Smarcel sign = ~0; 1438130803Smarcel 1439130803Smarcel unusedLS = 1440130803Smarcel (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT) 1441130803Smarcel % HOST_CHAR_BIT; 1442130803Smarcel 1443130803Smarcel switch (TYPE_CODE (type)) 1444130803Smarcel { 1445130803Smarcel case TYPE_CODE_ARRAY: 1446130803Smarcel case TYPE_CODE_UNION: 1447130803Smarcel case TYPE_CODE_STRUCT: 1448130803Smarcel /* Non-scalar values must be aligned at a byte boundary. */ 1449130803Smarcel accumSize = 1450130803Smarcel (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT; 1451130803Smarcel /* And are placed at the beginning (most-significant) bytes 1452130803Smarcel * of the target. */ 1453130803Smarcel targ = src; 1454130803Smarcel break; 1455130803Smarcel default: 1456130803Smarcel accumSize = 0; 1457130803Smarcel targ = TYPE_LENGTH (type) - 1; 1458130803Smarcel break; 1459130803Smarcel } 1460130803Smarcel } 1461130803Smarcel else 1462130803Smarcel { 1463130803Smarcel int sign_bit_offset = (bit_size + bit_offset - 1) % 8; 1464130803Smarcel 1465130803Smarcel src = targ = 0; 1466130803Smarcel unusedLS = bit_offset; 1467130803Smarcel accumSize = 0; 1468130803Smarcel 1469130803Smarcel if (has_negatives (type) && (bytes[len - 1] & (1 << sign_bit_offset))) 1470130803Smarcel sign = ~0; 1471130803Smarcel } 1472130803Smarcel 1473130803Smarcel accum = 0; 1474130803Smarcel while (nsrc > 0) 1475130803Smarcel { 1476130803Smarcel /* Mask for removing bits of the next source byte that are not 1477130803Smarcel * part of the value. */ 1478130803Smarcel unsigned int unusedMSMask = 1479130803Smarcel (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) - 1480130803Smarcel 1; 1481130803Smarcel /* Sign-extend bits for this byte. */ 1482130803Smarcel unsigned int signMask = sign & ~unusedMSMask; 1483130803Smarcel accum |= 1484130803Smarcel (((bytes[src] >> unusedLS) & unusedMSMask) | signMask) << accumSize; 1485130803Smarcel accumSize += HOST_CHAR_BIT - unusedLS; 1486130803Smarcel if (accumSize >= HOST_CHAR_BIT) 1487130803Smarcel { 1488130803Smarcel unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT); 1489130803Smarcel accumSize -= HOST_CHAR_BIT; 1490130803Smarcel accum >>= HOST_CHAR_BIT; 1491130803Smarcel ntarg -= 1; 1492130803Smarcel targ += delta; 1493130803Smarcel } 1494130803Smarcel srcBitsLeft -= HOST_CHAR_BIT - unusedLS; 1495130803Smarcel unusedLS = 0; 1496130803Smarcel nsrc -= 1; 1497130803Smarcel src += delta; 1498130803Smarcel } 1499130803Smarcel while (ntarg > 0) 1500130803Smarcel { 1501130803Smarcel accum |= sign << accumSize; 1502130803Smarcel unpacked[targ] = accum & ~(~0L << HOST_CHAR_BIT); 1503130803Smarcel accumSize -= HOST_CHAR_BIT; 1504130803Smarcel accum >>= HOST_CHAR_BIT; 1505130803Smarcel ntarg -= 1; 1506130803Smarcel targ += delta; 1507130803Smarcel } 1508130803Smarcel 1509130803Smarcel return v; 1510130803Smarcel} 1511130803Smarcel 1512130803Smarcel/* Move N bits from SOURCE, starting at bit offset SRC_OFFSET to 1513130803Smarcel TARGET, starting at bit offset TARG_OFFSET. SOURCE and TARGET must 1514130803Smarcel not overlap. */ 1515130803Smarcelstatic void 1516130803Smarcelmove_bits (char *target, int targ_offset, char *source, int src_offset, int n) 1517130803Smarcel{ 1518130803Smarcel unsigned int accum, mask; 1519130803Smarcel int accum_bits, chunk_size; 1520130803Smarcel 1521130803Smarcel target += targ_offset / HOST_CHAR_BIT; 1522130803Smarcel targ_offset %= HOST_CHAR_BIT; 1523130803Smarcel source += src_offset / HOST_CHAR_BIT; 1524130803Smarcel src_offset %= HOST_CHAR_BIT; 1525130803Smarcel if (BITS_BIG_ENDIAN) 1526130803Smarcel { 1527130803Smarcel accum = (unsigned char) *source; 1528130803Smarcel source += 1; 1529130803Smarcel accum_bits = HOST_CHAR_BIT - src_offset; 1530130803Smarcel 1531130803Smarcel while (n > 0) 1532130803Smarcel { 1533130803Smarcel int unused_right; 1534130803Smarcel accum = (accum << HOST_CHAR_BIT) + (unsigned char) *source; 1535130803Smarcel accum_bits += HOST_CHAR_BIT; 1536130803Smarcel source += 1; 1537130803Smarcel chunk_size = HOST_CHAR_BIT - targ_offset; 1538130803Smarcel if (chunk_size > n) 1539130803Smarcel chunk_size = n; 1540130803Smarcel unused_right = HOST_CHAR_BIT - (chunk_size + targ_offset); 1541130803Smarcel mask = ((1 << chunk_size) - 1) << unused_right; 1542130803Smarcel *target = 1543130803Smarcel (*target & ~mask) 1544130803Smarcel | ((accum >> (accum_bits - chunk_size - unused_right)) & mask); 1545130803Smarcel n -= chunk_size; 1546130803Smarcel accum_bits -= chunk_size; 1547130803Smarcel target += 1; 1548130803Smarcel targ_offset = 0; 1549130803Smarcel } 1550130803Smarcel } 1551130803Smarcel else 1552130803Smarcel { 1553130803Smarcel accum = (unsigned char) *source >> src_offset; 1554130803Smarcel source += 1; 1555130803Smarcel accum_bits = HOST_CHAR_BIT - src_offset; 1556130803Smarcel 1557130803Smarcel while (n > 0) 1558130803Smarcel { 1559130803Smarcel accum = accum + ((unsigned char) *source << accum_bits); 1560130803Smarcel accum_bits += HOST_CHAR_BIT; 1561130803Smarcel source += 1; 1562130803Smarcel chunk_size = HOST_CHAR_BIT - targ_offset; 1563130803Smarcel if (chunk_size > n) 1564130803Smarcel chunk_size = n; 1565130803Smarcel mask = ((1 << chunk_size) - 1) << targ_offset; 1566130803Smarcel *target = (*target & ~mask) | ((accum << targ_offset) & mask); 1567130803Smarcel n -= chunk_size; 1568130803Smarcel accum_bits -= chunk_size; 1569130803Smarcel accum >>= chunk_size; 1570130803Smarcel target += 1; 1571130803Smarcel targ_offset = 0; 1572130803Smarcel } 1573130803Smarcel } 1574130803Smarcel} 1575130803Smarcel 1576130803Smarcel 1577130803Smarcel/* Store the contents of FROMVAL into the location of TOVAL. 1578130803Smarcel Return a new value with the location of TOVAL and contents of 1579130803Smarcel FROMVAL. Handles assignment into packed fields that have 1580130803Smarcel floating-point or non-scalar types. */ 1581130803Smarcel 1582130803Smarcelstatic struct value * 1583130803Smarcelada_value_assign (struct value *toval, struct value *fromval) 1584130803Smarcel{ 1585130803Smarcel struct type *type = VALUE_TYPE (toval); 1586130803Smarcel int bits = VALUE_BITSIZE (toval); 1587130803Smarcel 1588130803Smarcel if (!toval->modifiable) 1589130803Smarcel error ("Left operand of assignment is not a modifiable lvalue."); 1590130803Smarcel 1591130803Smarcel COERCE_REF (toval); 1592130803Smarcel 1593130803Smarcel if (VALUE_LVAL (toval) == lval_memory 1594130803Smarcel && bits > 0 1595130803Smarcel && (TYPE_CODE (type) == TYPE_CODE_FLT 1596130803Smarcel || TYPE_CODE (type) == TYPE_CODE_STRUCT)) 1597130803Smarcel { 1598130803Smarcel int len = 1599130803Smarcel (VALUE_BITPOS (toval) + bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT; 1600130803Smarcel char *buffer = (char *) alloca (len); 1601130803Smarcel struct value *val; 1602130803Smarcel 1603130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_FLT) 1604130803Smarcel fromval = value_cast (type, fromval); 1605130803Smarcel 1606130803Smarcel read_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval), buffer, len); 1607130803Smarcel if (BITS_BIG_ENDIAN) 1608130803Smarcel move_bits (buffer, VALUE_BITPOS (toval), 1609130803Smarcel VALUE_CONTENTS (fromval), 1610130803Smarcel TYPE_LENGTH (VALUE_TYPE (fromval)) * TARGET_CHAR_BIT - 1611130803Smarcel bits, bits); 1612130803Smarcel else 1613130803Smarcel move_bits (buffer, VALUE_BITPOS (toval), VALUE_CONTENTS (fromval), 1614130803Smarcel 0, bits); 1615130803Smarcel write_memory (VALUE_ADDRESS (toval) + VALUE_OFFSET (toval), buffer, 1616130803Smarcel len); 1617130803Smarcel 1618130803Smarcel val = value_copy (toval); 1619130803Smarcel memcpy (VALUE_CONTENTS_RAW (val), VALUE_CONTENTS (fromval), 1620130803Smarcel TYPE_LENGTH (type)); 1621130803Smarcel VALUE_TYPE (val) = type; 1622130803Smarcel 1623130803Smarcel return val; 1624130803Smarcel } 1625130803Smarcel 1626130803Smarcel return value_assign (toval, fromval); 1627130803Smarcel} 1628130803Smarcel 1629130803Smarcel 1630130803Smarcel/* The value of the element of array ARR at the ARITY indices given in IND. 1631130803Smarcel ARR may be either a simple array, GNAT array descriptor, or pointer 1632130803Smarcel thereto. */ 1633130803Smarcel 1634130803Smarcelstruct value * 1635130803Smarcelada_value_subscript (struct value *arr, int arity, struct value **ind) 1636130803Smarcel{ 1637130803Smarcel int k; 1638130803Smarcel struct value *elt; 1639130803Smarcel struct type *elt_type; 1640130803Smarcel 1641130803Smarcel elt = ada_coerce_to_simple_array (arr); 1642130803Smarcel 1643130803Smarcel elt_type = check_typedef (VALUE_TYPE (elt)); 1644130803Smarcel if (TYPE_CODE (elt_type) == TYPE_CODE_ARRAY 1645130803Smarcel && TYPE_FIELD_BITSIZE (elt_type, 0) > 0) 1646130803Smarcel return value_subscript_packed (elt, arity, ind); 1647130803Smarcel 1648130803Smarcel for (k = 0; k < arity; k += 1) 1649130803Smarcel { 1650130803Smarcel if (TYPE_CODE (elt_type) != TYPE_CODE_ARRAY) 1651130803Smarcel error ("too many subscripts (%d expected)", k); 1652130803Smarcel elt = value_subscript (elt, value_pos_atr (ind[k])); 1653130803Smarcel } 1654130803Smarcel return elt; 1655130803Smarcel} 1656130803Smarcel 1657130803Smarcel/* Assuming ARR is a pointer to a standard GDB array of type TYPE, the 1658130803Smarcel value of the element of *ARR at the ARITY indices given in 1659130803Smarcel IND. Does not read the entire array into memory. */ 1660130803Smarcel 1661130803Smarcelstruct value * 1662130803Smarcelada_value_ptr_subscript (struct value *arr, struct type *type, int arity, 1663130803Smarcel struct value **ind) 1664130803Smarcel{ 1665130803Smarcel int k; 1666130803Smarcel 1667130803Smarcel for (k = 0; k < arity; k += 1) 1668130803Smarcel { 1669130803Smarcel LONGEST lwb, upb; 1670130803Smarcel struct value *idx; 1671130803Smarcel 1672130803Smarcel if (TYPE_CODE (type) != TYPE_CODE_ARRAY) 1673130803Smarcel error ("too many subscripts (%d expected)", k); 1674130803Smarcel arr = value_cast (lookup_pointer_type (TYPE_TARGET_TYPE (type)), 1675130803Smarcel value_copy (arr)); 1676130803Smarcel get_discrete_bounds (TYPE_INDEX_TYPE (type), &lwb, &upb); 1677130803Smarcel if (lwb == 0) 1678130803Smarcel idx = ind[k]; 1679130803Smarcel else 1680130803Smarcel idx = value_sub (ind[k], value_from_longest (builtin_type_int, lwb)); 1681130803Smarcel arr = value_add (arr, idx); 1682130803Smarcel type = TYPE_TARGET_TYPE (type); 1683130803Smarcel } 1684130803Smarcel 1685130803Smarcel return value_ind (arr); 1686130803Smarcel} 1687130803Smarcel 1688130803Smarcel/* If type is a record type in the form of a standard GNAT array 1689130803Smarcel descriptor, returns the number of dimensions for type. If arr is a 1690130803Smarcel simple array, returns the number of "array of"s that prefix its 1691130803Smarcel type designation. Otherwise, returns 0. */ 1692130803Smarcel 1693130803Smarcelint 1694130803Smarcelada_array_arity (struct type *type) 1695130803Smarcel{ 1696130803Smarcel int arity; 1697130803Smarcel 1698130803Smarcel if (type == NULL) 1699130803Smarcel return 0; 1700130803Smarcel 1701130803Smarcel type = desc_base_type (type); 1702130803Smarcel 1703130803Smarcel arity = 0; 1704130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_STRUCT) 1705130803Smarcel return desc_arity (desc_bounds_type (type)); 1706130803Smarcel else 1707130803Smarcel while (TYPE_CODE (type) == TYPE_CODE_ARRAY) 1708130803Smarcel { 1709130803Smarcel arity += 1; 1710130803Smarcel type = check_typedef (TYPE_TARGET_TYPE (type)); 1711130803Smarcel } 1712130803Smarcel 1713130803Smarcel return arity; 1714130803Smarcel} 1715130803Smarcel 1716130803Smarcel/* If TYPE is a record type in the form of a standard GNAT array 1717130803Smarcel descriptor or a simple array type, returns the element type for 1718130803Smarcel TYPE after indexing by NINDICES indices, or by all indices if 1719130803Smarcel NINDICES is -1. Otherwise, returns NULL. */ 1720130803Smarcel 1721130803Smarcelstruct type * 1722130803Smarcelada_array_element_type (struct type *type, int nindices) 1723130803Smarcel{ 1724130803Smarcel type = desc_base_type (type); 1725130803Smarcel 1726130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_STRUCT) 1727130803Smarcel { 1728130803Smarcel int k; 1729130803Smarcel struct type *p_array_type; 1730130803Smarcel 1731130803Smarcel p_array_type = desc_data_type (type); 1732130803Smarcel 1733130803Smarcel k = ada_array_arity (type); 1734130803Smarcel if (k == 0) 1735130803Smarcel return NULL; 1736130803Smarcel 1737130803Smarcel /* Initially p_array_type = elt_type(*)[]...(k times)...[] */ 1738130803Smarcel if (nindices >= 0 && k > nindices) 1739130803Smarcel k = nindices; 1740130803Smarcel p_array_type = TYPE_TARGET_TYPE (p_array_type); 1741130803Smarcel while (k > 0 && p_array_type != NULL) 1742130803Smarcel { 1743130803Smarcel p_array_type = check_typedef (TYPE_TARGET_TYPE (p_array_type)); 1744130803Smarcel k -= 1; 1745130803Smarcel } 1746130803Smarcel return p_array_type; 1747130803Smarcel } 1748130803Smarcel else if (TYPE_CODE (type) == TYPE_CODE_ARRAY) 1749130803Smarcel { 1750130803Smarcel while (nindices != 0 && TYPE_CODE (type) == TYPE_CODE_ARRAY) 1751130803Smarcel { 1752130803Smarcel type = TYPE_TARGET_TYPE (type); 1753130803Smarcel nindices -= 1; 1754130803Smarcel } 1755130803Smarcel return type; 1756130803Smarcel } 1757130803Smarcel 1758130803Smarcel return NULL; 1759130803Smarcel} 1760130803Smarcel 1761130803Smarcel/* The type of nth index in arrays of given type (n numbering from 1). Does 1762130803Smarcel not examine memory. */ 1763130803Smarcel 1764130803Smarcelstruct type * 1765130803Smarcelada_index_type (struct type *type, int n) 1766130803Smarcel{ 1767130803Smarcel type = desc_base_type (type); 1768130803Smarcel 1769130803Smarcel if (n > ada_array_arity (type)) 1770130803Smarcel return NULL; 1771130803Smarcel 1772130803Smarcel if (ada_is_simple_array (type)) 1773130803Smarcel { 1774130803Smarcel int i; 1775130803Smarcel 1776130803Smarcel for (i = 1; i < n; i += 1) 1777130803Smarcel type = TYPE_TARGET_TYPE (type); 1778130803Smarcel 1779130803Smarcel return TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)); 1780130803Smarcel } 1781130803Smarcel else 1782130803Smarcel return desc_index_type (desc_bounds_type (type), n); 1783130803Smarcel} 1784130803Smarcel 1785130803Smarcel/* Given that arr is an array type, returns the lower bound of the 1786130803Smarcel Nth index (numbering from 1) if WHICH is 0, and the upper bound if 1787130803Smarcel WHICH is 1. This returns bounds 0 .. -1 if ARR_TYPE is an 1788130803Smarcel array-descriptor type. If TYPEP is non-null, *TYPEP is set to the 1789130803Smarcel bounds type. It works for other arrays with bounds supplied by 1790130803Smarcel run-time quantities other than discriminants. */ 1791130803Smarcel 1792130803SmarcelLONGEST 1793130803Smarcelada_array_bound_from_type (struct type * arr_type, int n, int which, 1794130803Smarcel struct type ** typep) 1795130803Smarcel{ 1796130803Smarcel struct type *type; 1797130803Smarcel struct type *index_type_desc; 1798130803Smarcel 1799130803Smarcel if (ada_is_packed_array_type (arr_type)) 1800130803Smarcel arr_type = decode_packed_array_type (arr_type); 1801130803Smarcel 1802130803Smarcel if (arr_type == NULL || !ada_is_simple_array (arr_type)) 1803130803Smarcel { 1804130803Smarcel if (typep != NULL) 1805130803Smarcel *typep = builtin_type_int; 1806130803Smarcel return (LONGEST) - which; 1807130803Smarcel } 1808130803Smarcel 1809130803Smarcel if (TYPE_CODE (arr_type) == TYPE_CODE_PTR) 1810130803Smarcel type = TYPE_TARGET_TYPE (arr_type); 1811130803Smarcel else 1812130803Smarcel type = arr_type; 1813130803Smarcel 1814130803Smarcel index_type_desc = ada_find_parallel_type (type, "___XA"); 1815130803Smarcel if (index_type_desc == NULL) 1816130803Smarcel { 1817130803Smarcel struct type *range_type; 1818130803Smarcel struct type *index_type; 1819130803Smarcel 1820130803Smarcel while (n > 1) 1821130803Smarcel { 1822130803Smarcel type = TYPE_TARGET_TYPE (type); 1823130803Smarcel n -= 1; 1824130803Smarcel } 1825130803Smarcel 1826130803Smarcel range_type = TYPE_INDEX_TYPE (type); 1827130803Smarcel index_type = TYPE_TARGET_TYPE (range_type); 1828130803Smarcel if (TYPE_CODE (index_type) == TYPE_CODE_UNDEF) 1829130803Smarcel index_type = builtin_type_long; 1830130803Smarcel if (typep != NULL) 1831130803Smarcel *typep = index_type; 1832130803Smarcel return 1833130803Smarcel (LONGEST) (which == 0 1834130803Smarcel ? TYPE_LOW_BOUND (range_type) 1835130803Smarcel : TYPE_HIGH_BOUND (range_type)); 1836130803Smarcel } 1837130803Smarcel else 1838130803Smarcel { 1839130803Smarcel struct type *index_type = 1840130803Smarcel to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, n - 1), 1841130803Smarcel NULL, TYPE_OBJFILE (arr_type)); 1842130803Smarcel if (typep != NULL) 1843130803Smarcel *typep = TYPE_TARGET_TYPE (index_type); 1844130803Smarcel return 1845130803Smarcel (LONGEST) (which == 0 1846130803Smarcel ? TYPE_LOW_BOUND (index_type) 1847130803Smarcel : TYPE_HIGH_BOUND (index_type)); 1848130803Smarcel } 1849130803Smarcel} 1850130803Smarcel 1851130803Smarcel/* Given that arr is an array value, returns the lower bound of the 1852130803Smarcel nth index (numbering from 1) if which is 0, and the upper bound if 1853130803Smarcel which is 1. This routine will also work for arrays with bounds 1854130803Smarcel supplied by run-time quantities other than discriminants. */ 1855130803Smarcel 1856130803Smarcelstruct value * 1857130803Smarcelada_array_bound (struct value *arr, int n, int which) 1858130803Smarcel{ 1859130803Smarcel struct type *arr_type = VALUE_TYPE (arr); 1860130803Smarcel 1861130803Smarcel if (ada_is_packed_array_type (arr_type)) 1862130803Smarcel return ada_array_bound (decode_packed_array (arr), n, which); 1863130803Smarcel else if (ada_is_simple_array (arr_type)) 1864130803Smarcel { 1865130803Smarcel struct type *type; 1866130803Smarcel LONGEST v = ada_array_bound_from_type (arr_type, n, which, &type); 1867130803Smarcel return value_from_longest (type, v); 1868130803Smarcel } 1869130803Smarcel else 1870130803Smarcel return desc_one_bound (desc_bounds (arr), n, which); 1871130803Smarcel} 1872130803Smarcel 1873130803Smarcel/* Given that arr is an array value, returns the length of the 1874130803Smarcel nth index. This routine will also work for arrays with bounds 1875130803Smarcel supplied by run-time quantities other than discriminants. Does not 1876130803Smarcel work for arrays indexed by enumeration types with representation 1877130803Smarcel clauses at the moment. */ 1878130803Smarcel 1879130803Smarcelstruct value * 1880130803Smarcelada_array_length (struct value *arr, int n) 1881130803Smarcel{ 1882130803Smarcel struct type *arr_type = check_typedef (VALUE_TYPE (arr)); 1883130803Smarcel struct type *index_type_desc; 1884130803Smarcel 1885130803Smarcel if (ada_is_packed_array_type (arr_type)) 1886130803Smarcel return ada_array_length (decode_packed_array (arr), n); 1887130803Smarcel 1888130803Smarcel if (ada_is_simple_array (arr_type)) 1889130803Smarcel { 1890130803Smarcel struct type *type; 1891130803Smarcel LONGEST v = 1892130803Smarcel ada_array_bound_from_type (arr_type, n, 1, &type) - 1893130803Smarcel ada_array_bound_from_type (arr_type, n, 0, NULL) + 1; 1894130803Smarcel return value_from_longest (type, v); 1895130803Smarcel } 1896130803Smarcel else 1897130803Smarcel return 1898130803Smarcel value_from_longest (builtin_type_ada_int, 1899130803Smarcel value_as_long (desc_one_bound (desc_bounds (arr), 1900130803Smarcel n, 1)) 1901130803Smarcel - value_as_long (desc_one_bound (desc_bounds (arr), 1902130803Smarcel n, 0)) + 1); 1903130803Smarcel} 1904130803Smarcel 1905130803Smarcel 1906130803Smarcel /* Name resolution */ 1907130803Smarcel 1908130803Smarcel/* The "demangled" name for the user-definable Ada operator corresponding 1909130803Smarcel to op. */ 1910130803Smarcel 1911130803Smarcelstatic const char * 1912130803Smarcelada_op_name (enum exp_opcode op) 1913130803Smarcel{ 1914130803Smarcel int i; 1915130803Smarcel 1916130803Smarcel for (i = 0; ada_opname_table[i].mangled != NULL; i += 1) 1917130803Smarcel { 1918130803Smarcel if (ada_opname_table[i].op == op) 1919130803Smarcel return ada_opname_table[i].demangled; 1920130803Smarcel } 1921130803Smarcel error ("Could not find operator name for opcode"); 1922130803Smarcel} 1923130803Smarcel 1924130803Smarcel 1925130803Smarcel/* Same as evaluate_type (*EXP), but resolves ambiguous symbol 1926130803Smarcel references (OP_UNRESOLVED_VALUES) and converts operators that are 1927130803Smarcel user-defined into appropriate function calls. If CONTEXT_TYPE is 1928130803Smarcel non-null, it provides a preferred result type [at the moment, only 1929130803Smarcel type void has any effect---causing procedures to be preferred over 1930130803Smarcel functions in calls]. A null CONTEXT_TYPE indicates that a non-void 1931130803Smarcel return type is preferred. The variable unresolved_names contains a list 1932130803Smarcel of character strings referenced by expout that should be freed. 1933130803Smarcel May change (expand) *EXP. */ 1934130803Smarcel 1935130803Smarcelvoid 1936130803Smarcelada_resolve (struct expression **expp, struct type *context_type) 1937130803Smarcel{ 1938130803Smarcel int pc; 1939130803Smarcel pc = 0; 1940130803Smarcel ada_resolve_subexp (expp, &pc, 1, context_type); 1941130803Smarcel} 1942130803Smarcel 1943130803Smarcel/* Resolve the operator of the subexpression beginning at 1944130803Smarcel position *POS of *EXPP. "Resolving" consists of replacing 1945130803Smarcel OP_UNRESOLVED_VALUE with an appropriate OP_VAR_VALUE, replacing 1946130803Smarcel built-in operators with function calls to user-defined operators, 1947130803Smarcel where appropriate, and (when DEPROCEDURE_P is non-zero), converting 1948130803Smarcel function-valued variables into parameterless calls. May expand 1949130803Smarcel EXP. The CONTEXT_TYPE functions as in ada_resolve, above. */ 1950130803Smarcel 1951130803Smarcelstatic struct value * 1952130803Smarcelada_resolve_subexp (struct expression **expp, int *pos, int deprocedure_p, 1953130803Smarcel struct type *context_type) 1954130803Smarcel{ 1955130803Smarcel int pc = *pos; 1956130803Smarcel int i; 1957130803Smarcel struct expression *exp; /* Convenience: == *expp */ 1958130803Smarcel enum exp_opcode op = (*expp)->elts[pc].opcode; 1959130803Smarcel struct value **argvec; /* Vector of operand types (alloca'ed). */ 1960130803Smarcel int nargs; /* Number of operands */ 1961130803Smarcel 1962130803Smarcel argvec = NULL; 1963130803Smarcel nargs = 0; 1964130803Smarcel exp = *expp; 1965130803Smarcel 1966130803Smarcel /* Pass one: resolve operands, saving their types and updating *pos. */ 1967130803Smarcel switch (op) 1968130803Smarcel { 1969130803Smarcel case OP_VAR_VALUE: 1970130803Smarcel /* case OP_UNRESOLVED_VALUE: */ 1971130803Smarcel /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 1972130803Smarcel *pos += 4; 1973130803Smarcel break; 1974130803Smarcel 1975130803Smarcel case OP_FUNCALL: 1976130803Smarcel nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1; 1977130803Smarcel /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 1978130803Smarcel /* if (exp->elts[pc+3].opcode == OP_UNRESOLVED_VALUE) 1979130803Smarcel { 1980130803Smarcel *pos += 7; 1981130803Smarcel 1982130803Smarcel argvec = (struct value* *) alloca (sizeof (struct value*) * (nargs + 1)); 1983130803Smarcel for (i = 0; i < nargs-1; i += 1) 1984130803Smarcel argvec[i] = ada_resolve_subexp (expp, pos, 1, NULL); 1985130803Smarcel argvec[i] = NULL; 1986130803Smarcel } 1987130803Smarcel else 1988130803Smarcel { 1989130803Smarcel *pos += 3; 1990130803Smarcel ada_resolve_subexp (expp, pos, 0, NULL); 1991130803Smarcel for (i = 1; i < nargs; i += 1) 1992130803Smarcel ada_resolve_subexp (expp, pos, 1, NULL); 1993130803Smarcel } 1994130803Smarcel */ 1995130803Smarcel exp = *expp; 1996130803Smarcel break; 1997130803Smarcel 1998130803Smarcel /* FIXME: UNOP_QUAL should be defined in expression.h */ 1999130803Smarcel /* case UNOP_QUAL: 2000130803Smarcel nargs = 1; 2001130803Smarcel *pos += 3; 2002130803Smarcel ada_resolve_subexp (expp, pos, 1, exp->elts[pc + 1].type); 2003130803Smarcel exp = *expp; 2004130803Smarcel break; 2005130803Smarcel */ 2006130803Smarcel /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 2007130803Smarcel /* case OP_ATTRIBUTE: 2008130803Smarcel nargs = longest_to_int (exp->elts[pc + 1].longconst) + 1; 2009130803Smarcel *pos += 4; 2010130803Smarcel for (i = 0; i < nargs; i += 1) 2011130803Smarcel ada_resolve_subexp (expp, pos, 1, NULL); 2012130803Smarcel exp = *expp; 2013130803Smarcel break; 2014130803Smarcel */ 2015130803Smarcel case UNOP_ADDR: 2016130803Smarcel nargs = 1; 2017130803Smarcel *pos += 1; 2018130803Smarcel ada_resolve_subexp (expp, pos, 0, NULL); 2019130803Smarcel exp = *expp; 2020130803Smarcel break; 2021130803Smarcel 2022130803Smarcel case BINOP_ASSIGN: 2023130803Smarcel { 2024130803Smarcel struct value *arg1; 2025130803Smarcel nargs = 2; 2026130803Smarcel *pos += 1; 2027130803Smarcel arg1 = ada_resolve_subexp (expp, pos, 0, NULL); 2028130803Smarcel if (arg1 == NULL) 2029130803Smarcel ada_resolve_subexp (expp, pos, 1, NULL); 2030130803Smarcel else 2031130803Smarcel ada_resolve_subexp (expp, pos, 1, VALUE_TYPE (arg1)); 2032130803Smarcel break; 2033130803Smarcel } 2034130803Smarcel 2035130803Smarcel default: 2036130803Smarcel switch (op) 2037130803Smarcel { 2038130803Smarcel default: 2039130803Smarcel error ("Unexpected operator during name resolution"); 2040130803Smarcel case UNOP_CAST: 2041130803Smarcel /* case UNOP_MBR: 2042130803Smarcel nargs = 1; 2043130803Smarcel *pos += 3; 2044130803Smarcel break; 2045130803Smarcel */ 2046130803Smarcel case BINOP_ADD: 2047130803Smarcel case BINOP_SUB: 2048130803Smarcel case BINOP_MUL: 2049130803Smarcel case BINOP_DIV: 2050130803Smarcel case BINOP_REM: 2051130803Smarcel case BINOP_MOD: 2052130803Smarcel case BINOP_EXP: 2053130803Smarcel case BINOP_CONCAT: 2054130803Smarcel case BINOP_LOGICAL_AND: 2055130803Smarcel case BINOP_LOGICAL_OR: 2056130803Smarcel case BINOP_BITWISE_AND: 2057130803Smarcel case BINOP_BITWISE_IOR: 2058130803Smarcel case BINOP_BITWISE_XOR: 2059130803Smarcel 2060130803Smarcel case BINOP_EQUAL: 2061130803Smarcel case BINOP_NOTEQUAL: 2062130803Smarcel case BINOP_LESS: 2063130803Smarcel case BINOP_GTR: 2064130803Smarcel case BINOP_LEQ: 2065130803Smarcel case BINOP_GEQ: 2066130803Smarcel 2067130803Smarcel case BINOP_REPEAT: 2068130803Smarcel case BINOP_SUBSCRIPT: 2069130803Smarcel case BINOP_COMMA: 2070130803Smarcel nargs = 2; 2071130803Smarcel *pos += 1; 2072130803Smarcel break; 2073130803Smarcel 2074130803Smarcel case UNOP_NEG: 2075130803Smarcel case UNOP_PLUS: 2076130803Smarcel case UNOP_LOGICAL_NOT: 2077130803Smarcel case UNOP_ABS: 2078130803Smarcel case UNOP_IND: 2079130803Smarcel nargs = 1; 2080130803Smarcel *pos += 1; 2081130803Smarcel break; 2082130803Smarcel 2083130803Smarcel case OP_LONG: 2084130803Smarcel case OP_DOUBLE: 2085130803Smarcel case OP_VAR_VALUE: 2086130803Smarcel *pos += 4; 2087130803Smarcel break; 2088130803Smarcel 2089130803Smarcel case OP_TYPE: 2090130803Smarcel case OP_BOOL: 2091130803Smarcel case OP_LAST: 2092130803Smarcel case OP_REGISTER: 2093130803Smarcel case OP_INTERNALVAR: 2094130803Smarcel *pos += 3; 2095130803Smarcel break; 2096130803Smarcel 2097130803Smarcel case UNOP_MEMVAL: 2098130803Smarcel *pos += 3; 2099130803Smarcel nargs = 1; 2100130803Smarcel break; 2101130803Smarcel 2102130803Smarcel case STRUCTOP_STRUCT: 2103130803Smarcel case STRUCTOP_PTR: 2104130803Smarcel nargs = 1; 2105130803Smarcel *pos += 4 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1); 2106130803Smarcel break; 2107130803Smarcel 2108130803Smarcel case OP_ARRAY: 2109130803Smarcel *pos += 4; 2110130803Smarcel nargs = longest_to_int (exp->elts[pc + 2].longconst) + 1; 2111130803Smarcel nargs -= longest_to_int (exp->elts[pc + 1].longconst); 2112130803Smarcel /* A null array contains one dummy element to give the type. */ 2113130803Smarcel /* if (nargs == 0) 2114130803Smarcel nargs = 1; 2115130803Smarcel break; */ 2116130803Smarcel 2117130803Smarcel case TERNOP_SLICE: 2118130803Smarcel /* FIXME: TERNOP_MBR should be defined in expression.h */ 2119130803Smarcel /* case TERNOP_MBR: 2120130803Smarcel *pos += 1; 2121130803Smarcel nargs = 3; 2122130803Smarcel break; 2123130803Smarcel */ 2124130803Smarcel /* FIXME: BINOP_MBR should be defined in expression.h */ 2125130803Smarcel /* case BINOP_MBR: 2126130803Smarcel *pos += 3; 2127130803Smarcel nargs = 2; 2128130803Smarcel break; */ 2129130803Smarcel } 2130130803Smarcel 2131130803Smarcel argvec = 2132130803Smarcel (struct value * *) alloca (sizeof (struct value *) * (nargs + 1)); 2133130803Smarcel for (i = 0; i < nargs; i += 1) 2134130803Smarcel argvec[i] = ada_resolve_subexp (expp, pos, 1, NULL); 2135130803Smarcel argvec[i] = NULL; 2136130803Smarcel exp = *expp; 2137130803Smarcel break; 2138130803Smarcel } 2139130803Smarcel 2140130803Smarcel /* Pass two: perform any resolution on principal operator. */ 2141130803Smarcel switch (op) 2142130803Smarcel { 2143130803Smarcel default: 2144130803Smarcel break; 2145130803Smarcel 2146130803Smarcel /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 2147130803Smarcel /* case OP_UNRESOLVED_VALUE: 2148130803Smarcel { 2149130803Smarcel struct symbol** candidate_syms; 2150130803Smarcel struct block** candidate_blocks; 2151130803Smarcel int n_candidates; 2152130803Smarcel 2153130803Smarcel n_candidates = ada_lookup_symbol_list (exp->elts[pc + 2].name, 2154130803Smarcel exp->elts[pc + 1].block, 2155130803Smarcel VAR_DOMAIN, 2156130803Smarcel &candidate_syms, 2157130803Smarcel &candidate_blocks); 2158130803Smarcel 2159130803Smarcel if (n_candidates > 1) 2160130803Smarcel { */ 2161130803Smarcel /* Types tend to get re-introduced locally, so if there 2162130803Smarcel are any local symbols that are not types, first filter 2163130803Smarcel out all types. *//* 2164130803Smarcel int j; 2165130803Smarcel for (j = 0; j < n_candidates; j += 1) 2166130803Smarcel switch (SYMBOL_CLASS (candidate_syms[j])) 2167130803Smarcel { 2168130803Smarcel case LOC_REGISTER: 2169130803Smarcel case LOC_ARG: 2170130803Smarcel case LOC_REF_ARG: 2171130803Smarcel case LOC_REGPARM: 2172130803Smarcel case LOC_REGPARM_ADDR: 2173130803Smarcel case LOC_LOCAL: 2174130803Smarcel case LOC_LOCAL_ARG: 2175130803Smarcel case LOC_BASEREG: 2176130803Smarcel case LOC_BASEREG_ARG: 2177130803Smarcel case LOC_COMPUTED: 2178130803Smarcel case LOC_COMPUTED_ARG: 2179130803Smarcel goto FoundNonType; 2180130803Smarcel default: 2181130803Smarcel break; 2182130803Smarcel } 2183130803Smarcel FoundNonType: 2184130803Smarcel if (j < n_candidates) 2185130803Smarcel { 2186130803Smarcel j = 0; 2187130803Smarcel while (j < n_candidates) 2188130803Smarcel { 2189130803Smarcel if (SYMBOL_CLASS (candidate_syms[j]) == LOC_TYPEDEF) 2190130803Smarcel { 2191130803Smarcel candidate_syms[j] = candidate_syms[n_candidates-1]; 2192130803Smarcel candidate_blocks[j] = candidate_blocks[n_candidates-1]; 2193130803Smarcel n_candidates -= 1; 2194130803Smarcel } 2195130803Smarcel else 2196130803Smarcel j += 1; 2197130803Smarcel } 2198130803Smarcel } 2199130803Smarcel } 2200130803Smarcel 2201130803Smarcel if (n_candidates == 0) 2202130803Smarcel error ("No definition found for %s", 2203130803Smarcel ada_demangle (exp->elts[pc + 2].name)); 2204130803Smarcel else if (n_candidates == 1) 2205130803Smarcel i = 0; 2206130803Smarcel else if (deprocedure_p 2207130803Smarcel && ! is_nonfunction (candidate_syms, n_candidates)) 2208130803Smarcel { 2209130803Smarcel i = ada_resolve_function (candidate_syms, candidate_blocks, 2210130803Smarcel n_candidates, NULL, 0, 2211130803Smarcel exp->elts[pc + 2].name, context_type); 2212130803Smarcel if (i < 0) 2213130803Smarcel error ("Could not find a match for %s", 2214130803Smarcel ada_demangle (exp->elts[pc + 2].name)); 2215130803Smarcel } 2216130803Smarcel else 2217130803Smarcel { 2218130803Smarcel printf_filtered ("Multiple matches for %s\n", 2219130803Smarcel ada_demangle (exp->elts[pc+2].name)); 2220130803Smarcel user_select_syms (candidate_syms, candidate_blocks, 2221130803Smarcel n_candidates, 1); 2222130803Smarcel i = 0; 2223130803Smarcel } 2224130803Smarcel 2225130803Smarcel exp->elts[pc].opcode = exp->elts[pc + 3].opcode = OP_VAR_VALUE; 2226130803Smarcel exp->elts[pc + 1].block = candidate_blocks[i]; 2227130803Smarcel exp->elts[pc + 2].symbol = candidate_syms[i]; 2228130803Smarcel if (innermost_block == NULL || 2229130803Smarcel contained_in (candidate_blocks[i], innermost_block)) 2230130803Smarcel innermost_block = candidate_blocks[i]; 2231130803Smarcel } */ 2232130803Smarcel /* FALL THROUGH */ 2233130803Smarcel 2234130803Smarcel case OP_VAR_VALUE: 2235130803Smarcel if (deprocedure_p && 2236130803Smarcel TYPE_CODE (SYMBOL_TYPE (exp->elts[pc + 2].symbol)) == 2237130803Smarcel TYPE_CODE_FUNC) 2238130803Smarcel { 2239130803Smarcel replace_operator_with_call (expp, pc, 0, 0, 2240130803Smarcel exp->elts[pc + 2].symbol, 2241130803Smarcel exp->elts[pc + 1].block); 2242130803Smarcel exp = *expp; 2243130803Smarcel } 2244130803Smarcel break; 2245130803Smarcel 2246130803Smarcel case OP_FUNCALL: 2247130803Smarcel { 2248130803Smarcel /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 2249130803Smarcel /* if (exp->elts[pc+3].opcode == OP_UNRESOLVED_VALUE) 2250130803Smarcel { 2251130803Smarcel struct symbol** candidate_syms; 2252130803Smarcel struct block** candidate_blocks; 2253130803Smarcel int n_candidates; 2254130803Smarcel 2255130803Smarcel n_candidates = ada_lookup_symbol_list (exp->elts[pc + 5].name, 2256130803Smarcel exp->elts[pc + 4].block, 2257130803Smarcel VAR_DOMAIN, 2258130803Smarcel &candidate_syms, 2259130803Smarcel &candidate_blocks); 2260130803Smarcel if (n_candidates == 1) 2261130803Smarcel i = 0; 2262130803Smarcel else 2263130803Smarcel { 2264130803Smarcel i = ada_resolve_function (candidate_syms, candidate_blocks, 2265130803Smarcel n_candidates, argvec, nargs-1, 2266130803Smarcel exp->elts[pc + 5].name, context_type); 2267130803Smarcel if (i < 0) 2268130803Smarcel error ("Could not find a match for %s", 2269130803Smarcel ada_demangle (exp->elts[pc + 5].name)); 2270130803Smarcel } 2271130803Smarcel 2272130803Smarcel exp->elts[pc + 3].opcode = exp->elts[pc + 6].opcode = OP_VAR_VALUE; 2273130803Smarcel exp->elts[pc + 4].block = candidate_blocks[i]; 2274130803Smarcel exp->elts[pc + 5].symbol = candidate_syms[i]; 2275130803Smarcel if (innermost_block == NULL || 2276130803Smarcel contained_in (candidate_blocks[i], innermost_block)) 2277130803Smarcel innermost_block = candidate_blocks[i]; 2278130803Smarcel } */ 2279130803Smarcel 2280130803Smarcel } 2281130803Smarcel break; 2282130803Smarcel case BINOP_ADD: 2283130803Smarcel case BINOP_SUB: 2284130803Smarcel case BINOP_MUL: 2285130803Smarcel case BINOP_DIV: 2286130803Smarcel case BINOP_REM: 2287130803Smarcel case BINOP_MOD: 2288130803Smarcel case BINOP_CONCAT: 2289130803Smarcel case BINOP_BITWISE_AND: 2290130803Smarcel case BINOP_BITWISE_IOR: 2291130803Smarcel case BINOP_BITWISE_XOR: 2292130803Smarcel case BINOP_EQUAL: 2293130803Smarcel case BINOP_NOTEQUAL: 2294130803Smarcel case BINOP_LESS: 2295130803Smarcel case BINOP_GTR: 2296130803Smarcel case BINOP_LEQ: 2297130803Smarcel case BINOP_GEQ: 2298130803Smarcel case BINOP_EXP: 2299130803Smarcel case UNOP_NEG: 2300130803Smarcel case UNOP_PLUS: 2301130803Smarcel case UNOP_LOGICAL_NOT: 2302130803Smarcel case UNOP_ABS: 2303130803Smarcel if (possible_user_operator_p (op, argvec)) 2304130803Smarcel { 2305130803Smarcel struct symbol **candidate_syms; 2306130803Smarcel struct block **candidate_blocks; 2307130803Smarcel int n_candidates; 2308130803Smarcel 2309130803Smarcel n_candidates = 2310130803Smarcel ada_lookup_symbol_list (ada_mangle (ada_op_name (op)), 2311130803Smarcel (struct block *) NULL, VAR_DOMAIN, 2312130803Smarcel &candidate_syms, &candidate_blocks); 2313130803Smarcel i = 2314130803Smarcel ada_resolve_function (candidate_syms, candidate_blocks, 2315130803Smarcel n_candidates, argvec, nargs, 2316130803Smarcel ada_op_name (op), NULL); 2317130803Smarcel if (i < 0) 2318130803Smarcel break; 2319130803Smarcel 2320130803Smarcel replace_operator_with_call (expp, pc, nargs, 1, 2321130803Smarcel candidate_syms[i], candidate_blocks[i]); 2322130803Smarcel exp = *expp; 2323130803Smarcel } 2324130803Smarcel break; 2325130803Smarcel } 2326130803Smarcel 2327130803Smarcel *pos = pc; 2328130803Smarcel return evaluate_subexp_type (exp, pos); 2329130803Smarcel} 2330130803Smarcel 2331130803Smarcel/* Return non-zero if formal type FTYPE matches actual type ATYPE. If 2332130803Smarcel MAY_DEREF is non-zero, the formal may be a pointer and the actual 2333130803Smarcel a non-pointer. */ 2334130803Smarcel/* The term "match" here is rather loose. The match is heuristic and 2335130803Smarcel liberal. FIXME: TOO liberal, in fact. */ 2336130803Smarcel 2337130803Smarcelstatic int 2338130803Smarcelada_type_match (struct type *ftype, struct type *atype, int may_deref) 2339130803Smarcel{ 2340130803Smarcel CHECK_TYPEDEF (ftype); 2341130803Smarcel CHECK_TYPEDEF (atype); 2342130803Smarcel 2343130803Smarcel if (TYPE_CODE (ftype) == TYPE_CODE_REF) 2344130803Smarcel ftype = TYPE_TARGET_TYPE (ftype); 2345130803Smarcel if (TYPE_CODE (atype) == TYPE_CODE_REF) 2346130803Smarcel atype = TYPE_TARGET_TYPE (atype); 2347130803Smarcel 2348130803Smarcel if (TYPE_CODE (ftype) == TYPE_CODE_VOID 2349130803Smarcel || TYPE_CODE (atype) == TYPE_CODE_VOID) 2350130803Smarcel return 1; 2351130803Smarcel 2352130803Smarcel switch (TYPE_CODE (ftype)) 2353130803Smarcel { 2354130803Smarcel default: 2355130803Smarcel return 1; 2356130803Smarcel case TYPE_CODE_PTR: 2357130803Smarcel if (TYPE_CODE (atype) == TYPE_CODE_PTR) 2358130803Smarcel return ada_type_match (TYPE_TARGET_TYPE (ftype), 2359130803Smarcel TYPE_TARGET_TYPE (atype), 0); 2360130803Smarcel else 2361130803Smarcel return (may_deref && 2362130803Smarcel ada_type_match (TYPE_TARGET_TYPE (ftype), atype, 0)); 2363130803Smarcel case TYPE_CODE_INT: 2364130803Smarcel case TYPE_CODE_ENUM: 2365130803Smarcel case TYPE_CODE_RANGE: 2366130803Smarcel switch (TYPE_CODE (atype)) 2367130803Smarcel { 2368130803Smarcel case TYPE_CODE_INT: 2369130803Smarcel case TYPE_CODE_ENUM: 2370130803Smarcel case TYPE_CODE_RANGE: 2371130803Smarcel return 1; 2372130803Smarcel default: 2373130803Smarcel return 0; 2374130803Smarcel } 2375130803Smarcel 2376130803Smarcel case TYPE_CODE_ARRAY: 2377130803Smarcel return (TYPE_CODE (atype) == TYPE_CODE_ARRAY 2378130803Smarcel || ada_is_array_descriptor (atype)); 2379130803Smarcel 2380130803Smarcel case TYPE_CODE_STRUCT: 2381130803Smarcel if (ada_is_array_descriptor (ftype)) 2382130803Smarcel return (TYPE_CODE (atype) == TYPE_CODE_ARRAY 2383130803Smarcel || ada_is_array_descriptor (atype)); 2384130803Smarcel else 2385130803Smarcel return (TYPE_CODE (atype) == TYPE_CODE_STRUCT 2386130803Smarcel && !ada_is_array_descriptor (atype)); 2387130803Smarcel 2388130803Smarcel case TYPE_CODE_UNION: 2389130803Smarcel case TYPE_CODE_FLT: 2390130803Smarcel return (TYPE_CODE (atype) == TYPE_CODE (ftype)); 2391130803Smarcel } 2392130803Smarcel} 2393130803Smarcel 2394130803Smarcel/* Return non-zero if the formals of FUNC "sufficiently match" the 2395130803Smarcel vector of actual argument types ACTUALS of size N_ACTUALS. FUNC 2396130803Smarcel may also be an enumeral, in which case it is treated as a 0- 2397130803Smarcel argument function. */ 2398130803Smarcel 2399130803Smarcelstatic int 2400130803Smarcelada_args_match (struct symbol *func, struct value **actuals, int n_actuals) 2401130803Smarcel{ 2402130803Smarcel int i; 2403130803Smarcel struct type *func_type = SYMBOL_TYPE (func); 2404130803Smarcel 2405130803Smarcel if (SYMBOL_CLASS (func) == LOC_CONST && 2406130803Smarcel TYPE_CODE (func_type) == TYPE_CODE_ENUM) 2407130803Smarcel return (n_actuals == 0); 2408130803Smarcel else if (func_type == NULL || TYPE_CODE (func_type) != TYPE_CODE_FUNC) 2409130803Smarcel return 0; 2410130803Smarcel 2411130803Smarcel if (TYPE_NFIELDS (func_type) != n_actuals) 2412130803Smarcel return 0; 2413130803Smarcel 2414130803Smarcel for (i = 0; i < n_actuals; i += 1) 2415130803Smarcel { 2416130803Smarcel struct type *ftype = check_typedef (TYPE_FIELD_TYPE (func_type, i)); 2417130803Smarcel struct type *atype = check_typedef (VALUE_TYPE (actuals[i])); 2418130803Smarcel 2419130803Smarcel if (!ada_type_match (TYPE_FIELD_TYPE (func_type, i), 2420130803Smarcel VALUE_TYPE (actuals[i]), 1)) 2421130803Smarcel return 0; 2422130803Smarcel } 2423130803Smarcel return 1; 2424130803Smarcel} 2425130803Smarcel 2426130803Smarcel/* False iff function type FUNC_TYPE definitely does not produce a value 2427130803Smarcel compatible with type CONTEXT_TYPE. Conservatively returns 1 if 2428130803Smarcel FUNC_TYPE is not a valid function type with a non-null return type 2429130803Smarcel or an enumerated type. A null CONTEXT_TYPE indicates any non-void type. */ 2430130803Smarcel 2431130803Smarcelstatic int 2432130803Smarcelreturn_match (struct type *func_type, struct type *context_type) 2433130803Smarcel{ 2434130803Smarcel struct type *return_type; 2435130803Smarcel 2436130803Smarcel if (func_type == NULL) 2437130803Smarcel return 1; 2438130803Smarcel 2439130803Smarcel /* FIXME: base_type should be declared in gdbtypes.h, implemented in valarith.c */ 2440130803Smarcel /* if (TYPE_CODE (func_type) == TYPE_CODE_FUNC) 2441130803Smarcel return_type = base_type (TYPE_TARGET_TYPE (func_type)); 2442130803Smarcel else 2443130803Smarcel return_type = base_type (func_type); */ 2444130803Smarcel if (return_type == NULL) 2445130803Smarcel return 1; 2446130803Smarcel 2447130803Smarcel /* FIXME: base_type should be declared in gdbtypes.h, implemented in valarith.c */ 2448130803Smarcel /* context_type = base_type (context_type); */ 2449130803Smarcel 2450130803Smarcel if (TYPE_CODE (return_type) == TYPE_CODE_ENUM) 2451130803Smarcel return context_type == NULL || return_type == context_type; 2452130803Smarcel else if (context_type == NULL) 2453130803Smarcel return TYPE_CODE (return_type) != TYPE_CODE_VOID; 2454130803Smarcel else 2455130803Smarcel return TYPE_CODE (return_type) == TYPE_CODE (context_type); 2456130803Smarcel} 2457130803Smarcel 2458130803Smarcel 2459130803Smarcel/* Return the index in SYMS[0..NSYMS-1] of symbol for the 2460130803Smarcel function (if any) that matches the types of the NARGS arguments in 2461130803Smarcel ARGS. If CONTEXT_TYPE is non-null, and there is at least one match 2462130803Smarcel that returns type CONTEXT_TYPE, then eliminate other matches. If 2463130803Smarcel CONTEXT_TYPE is null, prefer a non-void-returning function. 2464130803Smarcel Asks the user if there is more than one match remaining. Returns -1 2465130803Smarcel if there is no such symbol or none is selected. NAME is used 2466130803Smarcel solely for messages. May re-arrange and modify SYMS in 2467130803Smarcel the process; the index returned is for the modified vector. BLOCKS 2468130803Smarcel is modified in parallel to SYMS. */ 2469130803Smarcel 2470130803Smarcelint 2471130803Smarcelada_resolve_function (struct symbol *syms[], struct block *blocks[], 2472130803Smarcel int nsyms, struct value **args, int nargs, 2473130803Smarcel const char *name, struct type *context_type) 2474130803Smarcel{ 2475130803Smarcel int k; 2476130803Smarcel int m; /* Number of hits */ 2477130803Smarcel struct type *fallback; 2478130803Smarcel struct type *return_type; 2479130803Smarcel 2480130803Smarcel return_type = context_type; 2481130803Smarcel if (context_type == NULL) 2482130803Smarcel fallback = builtin_type_void; 2483130803Smarcel else 2484130803Smarcel fallback = NULL; 2485130803Smarcel 2486130803Smarcel m = 0; 2487130803Smarcel while (1) 2488130803Smarcel { 2489130803Smarcel for (k = 0; k < nsyms; k += 1) 2490130803Smarcel { 2491130803Smarcel struct type *type = check_typedef (SYMBOL_TYPE (syms[k])); 2492130803Smarcel 2493130803Smarcel if (ada_args_match (syms[k], args, nargs) 2494130803Smarcel && return_match (SYMBOL_TYPE (syms[k]), return_type)) 2495130803Smarcel { 2496130803Smarcel syms[m] = syms[k]; 2497130803Smarcel if (blocks != NULL) 2498130803Smarcel blocks[m] = blocks[k]; 2499130803Smarcel m += 1; 2500130803Smarcel } 2501130803Smarcel } 2502130803Smarcel if (m > 0 || return_type == fallback) 2503130803Smarcel break; 2504130803Smarcel else 2505130803Smarcel return_type = fallback; 2506130803Smarcel } 2507130803Smarcel 2508130803Smarcel if (m == 0) 2509130803Smarcel return -1; 2510130803Smarcel else if (m > 1) 2511130803Smarcel { 2512130803Smarcel printf_filtered ("Multiple matches for %s\n", name); 2513130803Smarcel user_select_syms (syms, blocks, m, 1); 2514130803Smarcel return 0; 2515130803Smarcel } 2516130803Smarcel return 0; 2517130803Smarcel} 2518130803Smarcel 2519130803Smarcel/* Returns true (non-zero) iff demangled name N0 should appear before N1 */ 2520130803Smarcel/* in a listing of choices during disambiguation (see sort_choices, below). */ 2521130803Smarcel/* The idea is that overloadings of a subprogram name from the */ 2522130803Smarcel/* same package should sort in their source order. We settle for ordering */ 2523130803Smarcel/* such symbols by their trailing number (__N or $N). */ 2524130803Smarcelstatic int 2525130803Smarcelmangled_ordered_before (char *N0, char *N1) 2526130803Smarcel{ 2527130803Smarcel if (N1 == NULL) 2528130803Smarcel return 0; 2529130803Smarcel else if (N0 == NULL) 2530130803Smarcel return 1; 2531130803Smarcel else 2532130803Smarcel { 2533130803Smarcel int k0, k1; 2534130803Smarcel for (k0 = strlen (N0) - 1; k0 > 0 && isdigit (N0[k0]); k0 -= 1) 2535130803Smarcel ; 2536130803Smarcel for (k1 = strlen (N1) - 1; k1 > 0 && isdigit (N1[k1]); k1 -= 1) 2537130803Smarcel ; 2538130803Smarcel if ((N0[k0] == '_' || N0[k0] == '$') && N0[k0 + 1] != '\000' 2539130803Smarcel && (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000') 2540130803Smarcel { 2541130803Smarcel int n0, n1; 2542130803Smarcel n0 = k0; 2543130803Smarcel while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_') 2544130803Smarcel n0 -= 1; 2545130803Smarcel n1 = k1; 2546130803Smarcel while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_') 2547130803Smarcel n1 -= 1; 2548130803Smarcel if (n0 == n1 && DEPRECATED_STREQN (N0, N1, n0)) 2549130803Smarcel return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1)); 2550130803Smarcel } 2551130803Smarcel return (strcmp (N0, N1) < 0); 2552130803Smarcel } 2553130803Smarcel} 2554130803Smarcel 2555130803Smarcel/* Sort SYMS[0..NSYMS-1] to put the choices in a canonical order by their */ 2556130803Smarcel/* mangled names, rearranging BLOCKS[0..NSYMS-1] according to the same */ 2557130803Smarcel/* permutation. */ 2558130803Smarcelstatic void 2559130803Smarcelsort_choices (struct symbol *syms[], struct block *blocks[], int nsyms) 2560130803Smarcel{ 2561130803Smarcel int i, j; 2562130803Smarcel for (i = 1; i < nsyms; i += 1) 2563130803Smarcel { 2564130803Smarcel struct symbol *sym = syms[i]; 2565130803Smarcel struct block *block = blocks[i]; 2566130803Smarcel int j; 2567130803Smarcel 2568130803Smarcel for (j = i - 1; j >= 0; j -= 1) 2569130803Smarcel { 2570130803Smarcel if (mangled_ordered_before (DEPRECATED_SYMBOL_NAME (syms[j]), 2571130803Smarcel DEPRECATED_SYMBOL_NAME (sym))) 2572130803Smarcel break; 2573130803Smarcel syms[j + 1] = syms[j]; 2574130803Smarcel blocks[j + 1] = blocks[j]; 2575130803Smarcel } 2576130803Smarcel syms[j + 1] = sym; 2577130803Smarcel blocks[j + 1] = block; 2578130803Smarcel } 2579130803Smarcel} 2580130803Smarcel 2581130803Smarcel/* Given a list of NSYMS symbols in SYMS and corresponding blocks in */ 2582130803Smarcel/* BLOCKS, select up to MAX_RESULTS>0 by asking the user (if */ 2583130803Smarcel/* necessary), returning the number selected, and setting the first */ 2584130803Smarcel/* elements of SYMS and BLOCKS to the selected symbols and */ 2585130803Smarcel/* corresponding blocks. Error if no symbols selected. BLOCKS may */ 2586130803Smarcel/* be NULL, in which case it is ignored. */ 2587130803Smarcel 2588130803Smarcel/* NOTE: Adapted from decode_line_2 in symtab.c, with which it ought 2589130803Smarcel to be re-integrated one of these days. */ 2590130803Smarcel 2591130803Smarcelint 2592130803Smarceluser_select_syms (struct symbol *syms[], struct block *blocks[], int nsyms, 2593130803Smarcel int max_results) 2594130803Smarcel{ 2595130803Smarcel int i; 2596130803Smarcel int *chosen = (int *) alloca (sizeof (int) * nsyms); 2597130803Smarcel int n_chosen; 2598130803Smarcel int first_choice = (max_results == 1) ? 1 : 2; 2599130803Smarcel 2600130803Smarcel if (max_results < 1) 2601130803Smarcel error ("Request to select 0 symbols!"); 2602130803Smarcel if (nsyms <= 1) 2603130803Smarcel return nsyms; 2604130803Smarcel 2605130803Smarcel printf_unfiltered ("[0] cancel\n"); 2606130803Smarcel if (max_results > 1) 2607130803Smarcel printf_unfiltered ("[1] all\n"); 2608130803Smarcel 2609130803Smarcel sort_choices (syms, blocks, nsyms); 2610130803Smarcel 2611130803Smarcel for (i = 0; i < nsyms; i += 1) 2612130803Smarcel { 2613130803Smarcel if (syms[i] == NULL) 2614130803Smarcel continue; 2615130803Smarcel 2616130803Smarcel if (SYMBOL_CLASS (syms[i]) == LOC_BLOCK) 2617130803Smarcel { 2618130803Smarcel struct symtab_and_line sal = find_function_start_sal (syms[i], 1); 2619130803Smarcel printf_unfiltered ("[%d] %s at %s:%d\n", 2620130803Smarcel i + first_choice, 2621130803Smarcel SYMBOL_PRINT_NAME (syms[i]), 2622130803Smarcel sal.symtab == NULL 2623130803Smarcel ? "<no source file available>" 2624130803Smarcel : sal.symtab->filename, sal.line); 2625130803Smarcel continue; 2626130803Smarcel } 2627130803Smarcel else 2628130803Smarcel { 2629130803Smarcel int is_enumeral = 2630130803Smarcel (SYMBOL_CLASS (syms[i]) == LOC_CONST 2631130803Smarcel && SYMBOL_TYPE (syms[i]) != NULL 2632130803Smarcel && TYPE_CODE (SYMBOL_TYPE (syms[i])) == TYPE_CODE_ENUM); 2633130803Smarcel struct symtab *symtab = symtab_for_sym (syms[i]); 2634130803Smarcel 2635130803Smarcel if (SYMBOL_LINE (syms[i]) != 0 && symtab != NULL) 2636130803Smarcel printf_unfiltered ("[%d] %s at %s:%d\n", 2637130803Smarcel i + first_choice, 2638130803Smarcel SYMBOL_PRINT_NAME (syms[i]), 2639130803Smarcel symtab->filename, SYMBOL_LINE (syms[i])); 2640130803Smarcel else if (is_enumeral && TYPE_NAME (SYMBOL_TYPE (syms[i])) != NULL) 2641130803Smarcel { 2642130803Smarcel printf_unfiltered ("[%d] ", i + first_choice); 2643130803Smarcel ada_print_type (SYMBOL_TYPE (syms[i]), NULL, gdb_stdout, -1, 0); 2644130803Smarcel printf_unfiltered ("'(%s) (enumeral)\n", 2645130803Smarcel SYMBOL_PRINT_NAME (syms[i])); 2646130803Smarcel } 2647130803Smarcel else if (symtab != NULL) 2648130803Smarcel printf_unfiltered (is_enumeral 2649130803Smarcel ? "[%d] %s in %s (enumeral)\n" 2650130803Smarcel : "[%d] %s at %s:?\n", 2651130803Smarcel i + first_choice, 2652130803Smarcel SYMBOL_PRINT_NAME (syms[i]), 2653130803Smarcel symtab->filename); 2654130803Smarcel else 2655130803Smarcel printf_unfiltered (is_enumeral 2656130803Smarcel ? "[%d] %s (enumeral)\n" 2657130803Smarcel : "[%d] %s at ?\n", 2658130803Smarcel i + first_choice, 2659130803Smarcel SYMBOL_PRINT_NAME (syms[i])); 2660130803Smarcel } 2661130803Smarcel } 2662130803Smarcel 2663130803Smarcel n_chosen = get_selections (chosen, nsyms, max_results, max_results > 1, 2664130803Smarcel "overload-choice"); 2665130803Smarcel 2666130803Smarcel for (i = 0; i < n_chosen; i += 1) 2667130803Smarcel { 2668130803Smarcel syms[i] = syms[chosen[i]]; 2669130803Smarcel if (blocks != NULL) 2670130803Smarcel blocks[i] = blocks[chosen[i]]; 2671130803Smarcel } 2672130803Smarcel 2673130803Smarcel return n_chosen; 2674130803Smarcel} 2675130803Smarcel 2676130803Smarcel/* Read and validate a set of numeric choices from the user in the 2677130803Smarcel range 0 .. N_CHOICES-1. Place the results in increasing 2678130803Smarcel order in CHOICES[0 .. N-1], and return N. 2679130803Smarcel 2680130803Smarcel The user types choices as a sequence of numbers on one line 2681130803Smarcel separated by blanks, encoding them as follows: 2682130803Smarcel 2683130803Smarcel + A choice of 0 means to cancel the selection, throwing an error. 2684130803Smarcel + If IS_ALL_CHOICE, a choice of 1 selects the entire set 0 .. N_CHOICES-1. 2685130803Smarcel + The user chooses k by typing k+IS_ALL_CHOICE+1. 2686130803Smarcel 2687130803Smarcel The user is not allowed to choose more than MAX_RESULTS values. 2688130803Smarcel 2689130803Smarcel ANNOTATION_SUFFIX, if present, is used to annotate the input 2690130803Smarcel prompts (for use with the -f switch). */ 2691130803Smarcel 2692130803Smarcelint 2693130803Smarcelget_selections (int *choices, int n_choices, int max_results, 2694130803Smarcel int is_all_choice, char *annotation_suffix) 2695130803Smarcel{ 2696130803Smarcel int i; 2697130803Smarcel char *args; 2698130803Smarcel const char *prompt; 2699130803Smarcel int n_chosen; 2700130803Smarcel int first_choice = is_all_choice ? 2 : 1; 2701130803Smarcel 2702130803Smarcel prompt = getenv ("PS2"); 2703130803Smarcel if (prompt == NULL) 2704130803Smarcel prompt = ">"; 2705130803Smarcel 2706130803Smarcel printf_unfiltered ("%s ", prompt); 2707130803Smarcel gdb_flush (gdb_stdout); 2708130803Smarcel 2709130803Smarcel args = command_line_input ((char *) NULL, 0, annotation_suffix); 2710130803Smarcel 2711130803Smarcel if (args == NULL) 2712130803Smarcel error_no_arg ("one or more choice numbers"); 2713130803Smarcel 2714130803Smarcel n_chosen = 0; 2715130803Smarcel 2716130803Smarcel /* Set choices[0 .. n_chosen-1] to the users' choices in ascending 2717130803Smarcel order, as given in args. Choices are validated. */ 2718130803Smarcel while (1) 2719130803Smarcel { 2720130803Smarcel char *args2; 2721130803Smarcel int choice, j; 2722130803Smarcel 2723130803Smarcel while (isspace (*args)) 2724130803Smarcel args += 1; 2725130803Smarcel if (*args == '\0' && n_chosen == 0) 2726130803Smarcel error_no_arg ("one or more choice numbers"); 2727130803Smarcel else if (*args == '\0') 2728130803Smarcel break; 2729130803Smarcel 2730130803Smarcel choice = strtol (args, &args2, 10); 2731130803Smarcel if (args == args2 || choice < 0 2732130803Smarcel || choice > n_choices + first_choice - 1) 2733130803Smarcel error ("Argument must be choice number"); 2734130803Smarcel args = args2; 2735130803Smarcel 2736130803Smarcel if (choice == 0) 2737130803Smarcel error ("cancelled"); 2738130803Smarcel 2739130803Smarcel if (choice < first_choice) 2740130803Smarcel { 2741130803Smarcel n_chosen = n_choices; 2742130803Smarcel for (j = 0; j < n_choices; j += 1) 2743130803Smarcel choices[j] = j; 2744130803Smarcel break; 2745130803Smarcel } 2746130803Smarcel choice -= first_choice; 2747130803Smarcel 2748130803Smarcel for (j = n_chosen - 1; j >= 0 && choice < choices[j]; j -= 1) 2749130803Smarcel { 2750130803Smarcel } 2751130803Smarcel 2752130803Smarcel if (j < 0 || choice != choices[j]) 2753130803Smarcel { 2754130803Smarcel int k; 2755130803Smarcel for (k = n_chosen - 1; k > j; k -= 1) 2756130803Smarcel choices[k + 1] = choices[k]; 2757130803Smarcel choices[j + 1] = choice; 2758130803Smarcel n_chosen += 1; 2759130803Smarcel } 2760130803Smarcel } 2761130803Smarcel 2762130803Smarcel if (n_chosen > max_results) 2763130803Smarcel error ("Select no more than %d of the above", max_results); 2764130803Smarcel 2765130803Smarcel return n_chosen; 2766130803Smarcel} 2767130803Smarcel 2768130803Smarcel/* Replace the operator of length OPLEN at position PC in *EXPP with a call */ 2769130803Smarcel/* on the function identified by SYM and BLOCK, and taking NARGS */ 2770130803Smarcel/* arguments. Update *EXPP as needed to hold more space. */ 2771130803Smarcel 2772130803Smarcelstatic void 2773130803Smarcelreplace_operator_with_call (struct expression **expp, int pc, int nargs, 2774130803Smarcel int oplen, struct symbol *sym, 2775130803Smarcel struct block *block) 2776130803Smarcel{ 2777130803Smarcel /* A new expression, with 6 more elements (3 for funcall, 4 for function 2778130803Smarcel symbol, -oplen for operator being replaced). */ 2779130803Smarcel struct expression *newexp = (struct expression *) 2780130803Smarcel xmalloc (sizeof (struct expression) 2781130803Smarcel + EXP_ELEM_TO_BYTES ((*expp)->nelts + 7 - oplen)); 2782130803Smarcel struct expression *exp = *expp; 2783130803Smarcel 2784130803Smarcel newexp->nelts = exp->nelts + 7 - oplen; 2785130803Smarcel newexp->language_defn = exp->language_defn; 2786130803Smarcel memcpy (newexp->elts, exp->elts, EXP_ELEM_TO_BYTES (pc)); 2787130803Smarcel memcpy (newexp->elts + pc + 7, exp->elts + pc + oplen, 2788130803Smarcel EXP_ELEM_TO_BYTES (exp->nelts - pc - oplen)); 2789130803Smarcel 2790130803Smarcel newexp->elts[pc].opcode = newexp->elts[pc + 2].opcode = OP_FUNCALL; 2791130803Smarcel newexp->elts[pc + 1].longconst = (LONGEST) nargs; 2792130803Smarcel 2793130803Smarcel newexp->elts[pc + 3].opcode = newexp->elts[pc + 6].opcode = OP_VAR_VALUE; 2794130803Smarcel newexp->elts[pc + 4].block = block; 2795130803Smarcel newexp->elts[pc + 5].symbol = sym; 2796130803Smarcel 2797130803Smarcel *expp = newexp; 2798130803Smarcel xfree (exp); 2799130803Smarcel} 2800130803Smarcel 2801130803Smarcel/* Type-class predicates */ 2802130803Smarcel 2803130803Smarcel/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type), or */ 2804130803Smarcel/* FLOAT.) */ 2805130803Smarcel 2806130803Smarcelstatic int 2807130803Smarcelnumeric_type_p (struct type *type) 2808130803Smarcel{ 2809130803Smarcel if (type == NULL) 2810130803Smarcel return 0; 2811130803Smarcel else 2812130803Smarcel { 2813130803Smarcel switch (TYPE_CODE (type)) 2814130803Smarcel { 2815130803Smarcel case TYPE_CODE_INT: 2816130803Smarcel case TYPE_CODE_FLT: 2817130803Smarcel return 1; 2818130803Smarcel case TYPE_CODE_RANGE: 2819130803Smarcel return (type == TYPE_TARGET_TYPE (type) 2820130803Smarcel || numeric_type_p (TYPE_TARGET_TYPE (type))); 2821130803Smarcel default: 2822130803Smarcel return 0; 2823130803Smarcel } 2824130803Smarcel } 2825130803Smarcel} 2826130803Smarcel 2827130803Smarcel/* True iff TYPE is integral (an INT or RANGE of INTs). */ 2828130803Smarcel 2829130803Smarcelstatic int 2830130803Smarcelinteger_type_p (struct type *type) 2831130803Smarcel{ 2832130803Smarcel if (type == NULL) 2833130803Smarcel return 0; 2834130803Smarcel else 2835130803Smarcel { 2836130803Smarcel switch (TYPE_CODE (type)) 2837130803Smarcel { 2838130803Smarcel case TYPE_CODE_INT: 2839130803Smarcel return 1; 2840130803Smarcel case TYPE_CODE_RANGE: 2841130803Smarcel return (type == TYPE_TARGET_TYPE (type) 2842130803Smarcel || integer_type_p (TYPE_TARGET_TYPE (type))); 2843130803Smarcel default: 2844130803Smarcel return 0; 2845130803Smarcel } 2846130803Smarcel } 2847130803Smarcel} 2848130803Smarcel 2849130803Smarcel/* True iff TYPE is scalar (INT, RANGE, FLOAT, ENUM). */ 2850130803Smarcel 2851130803Smarcelstatic int 2852130803Smarcelscalar_type_p (struct type *type) 2853130803Smarcel{ 2854130803Smarcel if (type == NULL) 2855130803Smarcel return 0; 2856130803Smarcel else 2857130803Smarcel { 2858130803Smarcel switch (TYPE_CODE (type)) 2859130803Smarcel { 2860130803Smarcel case TYPE_CODE_INT: 2861130803Smarcel case TYPE_CODE_RANGE: 2862130803Smarcel case TYPE_CODE_ENUM: 2863130803Smarcel case TYPE_CODE_FLT: 2864130803Smarcel return 1; 2865130803Smarcel default: 2866130803Smarcel return 0; 2867130803Smarcel } 2868130803Smarcel } 2869130803Smarcel} 2870130803Smarcel 2871130803Smarcel/* True iff TYPE is discrete (INT, RANGE, ENUM). */ 2872130803Smarcel 2873130803Smarcelstatic int 2874130803Smarceldiscrete_type_p (struct type *type) 2875130803Smarcel{ 2876130803Smarcel if (type == NULL) 2877130803Smarcel return 0; 2878130803Smarcel else 2879130803Smarcel { 2880130803Smarcel switch (TYPE_CODE (type)) 2881130803Smarcel { 2882130803Smarcel case TYPE_CODE_INT: 2883130803Smarcel case TYPE_CODE_RANGE: 2884130803Smarcel case TYPE_CODE_ENUM: 2885130803Smarcel return 1; 2886130803Smarcel default: 2887130803Smarcel return 0; 2888130803Smarcel } 2889130803Smarcel } 2890130803Smarcel} 2891130803Smarcel 2892130803Smarcel/* Returns non-zero if OP with operatands in the vector ARGS could be 2893130803Smarcel a user-defined function. Errs on the side of pre-defined operators 2894130803Smarcel (i.e., result 0). */ 2895130803Smarcel 2896130803Smarcelstatic int 2897130803Smarcelpossible_user_operator_p (enum exp_opcode op, struct value *args[]) 2898130803Smarcel{ 2899130803Smarcel struct type *type0 = check_typedef (VALUE_TYPE (args[0])); 2900130803Smarcel struct type *type1 = 2901130803Smarcel (args[1] == NULL) ? NULL : check_typedef (VALUE_TYPE (args[1])); 2902130803Smarcel 2903130803Smarcel switch (op) 2904130803Smarcel { 2905130803Smarcel default: 2906130803Smarcel return 0; 2907130803Smarcel 2908130803Smarcel case BINOP_ADD: 2909130803Smarcel case BINOP_SUB: 2910130803Smarcel case BINOP_MUL: 2911130803Smarcel case BINOP_DIV: 2912130803Smarcel return (!(numeric_type_p (type0) && numeric_type_p (type1))); 2913130803Smarcel 2914130803Smarcel case BINOP_REM: 2915130803Smarcel case BINOP_MOD: 2916130803Smarcel case BINOP_BITWISE_AND: 2917130803Smarcel case BINOP_BITWISE_IOR: 2918130803Smarcel case BINOP_BITWISE_XOR: 2919130803Smarcel return (!(integer_type_p (type0) && integer_type_p (type1))); 2920130803Smarcel 2921130803Smarcel case BINOP_EQUAL: 2922130803Smarcel case BINOP_NOTEQUAL: 2923130803Smarcel case BINOP_LESS: 2924130803Smarcel case BINOP_GTR: 2925130803Smarcel case BINOP_LEQ: 2926130803Smarcel case BINOP_GEQ: 2927130803Smarcel return (!(scalar_type_p (type0) && scalar_type_p (type1))); 2928130803Smarcel 2929130803Smarcel case BINOP_CONCAT: 2930130803Smarcel return ((TYPE_CODE (type0) != TYPE_CODE_ARRAY && 2931130803Smarcel (TYPE_CODE (type0) != TYPE_CODE_PTR || 2932130803Smarcel TYPE_CODE (TYPE_TARGET_TYPE (type0)) 2933130803Smarcel != TYPE_CODE_ARRAY)) 2934130803Smarcel || (TYPE_CODE (type1) != TYPE_CODE_ARRAY && 2935130803Smarcel (TYPE_CODE (type1) != TYPE_CODE_PTR || 2936130803Smarcel TYPE_CODE (TYPE_TARGET_TYPE (type1)) != TYPE_CODE_ARRAY))); 2937130803Smarcel 2938130803Smarcel case BINOP_EXP: 2939130803Smarcel return (!(numeric_type_p (type0) && integer_type_p (type1))); 2940130803Smarcel 2941130803Smarcel case UNOP_NEG: 2942130803Smarcel case UNOP_PLUS: 2943130803Smarcel case UNOP_LOGICAL_NOT: 2944130803Smarcel case UNOP_ABS: 2945130803Smarcel return (!numeric_type_p (type0)); 2946130803Smarcel 2947130803Smarcel } 2948130803Smarcel} 2949130803Smarcel 2950130803Smarcel /* Renaming */ 2951130803Smarcel 2952130803Smarcel/** NOTE: In the following, we assume that a renaming type's name may 2953130803Smarcel * have an ___XD suffix. It would be nice if this went away at some 2954130803Smarcel * point. */ 2955130803Smarcel 2956130803Smarcel/* If TYPE encodes a renaming, returns the renaming suffix, which 2957130803Smarcel * is XR for an object renaming, XRP for a procedure renaming, XRE for 2958130803Smarcel * an exception renaming, and XRS for a subprogram renaming. Returns 2959130803Smarcel * NULL if NAME encodes none of these. */ 2960130803Smarcelconst char * 2961130803Smarcelada_renaming_type (struct type *type) 2962130803Smarcel{ 2963130803Smarcel if (type != NULL && TYPE_CODE (type) == TYPE_CODE_ENUM) 2964130803Smarcel { 2965130803Smarcel const char *name = type_name_no_tag (type); 2966130803Smarcel const char *suffix = (name == NULL) ? NULL : strstr (name, "___XR"); 2967130803Smarcel if (suffix == NULL 2968130803Smarcel || (suffix[5] != '\000' && strchr ("PES_", suffix[5]) == NULL)) 2969130803Smarcel return NULL; 2970130803Smarcel else 2971130803Smarcel return suffix + 3; 2972130803Smarcel } 2973130803Smarcel else 2974130803Smarcel return NULL; 2975130803Smarcel} 2976130803Smarcel 2977130803Smarcel/* Return non-zero iff SYM encodes an object renaming. */ 2978130803Smarcelint 2979130803Smarcelada_is_object_renaming (struct symbol *sym) 2980130803Smarcel{ 2981130803Smarcel const char *renaming_type = ada_renaming_type (SYMBOL_TYPE (sym)); 2982130803Smarcel return renaming_type != NULL 2983130803Smarcel && (renaming_type[2] == '\0' || renaming_type[2] == '_'); 2984130803Smarcel} 2985130803Smarcel 2986130803Smarcel/* Assuming that SYM encodes a non-object renaming, returns the original 2987130803Smarcel * name of the renamed entity. The name is good until the end of 2988130803Smarcel * parsing. */ 2989130803Smarcelconst char * 2990130803Smarcelada_simple_renamed_entity (struct symbol *sym) 2991130803Smarcel{ 2992130803Smarcel struct type *type; 2993130803Smarcel const char *raw_name; 2994130803Smarcel int len; 2995130803Smarcel char *result; 2996130803Smarcel 2997130803Smarcel type = SYMBOL_TYPE (sym); 2998130803Smarcel if (type == NULL || TYPE_NFIELDS (type) < 1) 2999130803Smarcel error ("Improperly encoded renaming."); 3000130803Smarcel 3001130803Smarcel raw_name = TYPE_FIELD_NAME (type, 0); 3002130803Smarcel len = (raw_name == NULL ? 0 : strlen (raw_name)) - 5; 3003130803Smarcel if (len <= 0) 3004130803Smarcel error ("Improperly encoded renaming."); 3005130803Smarcel 3006130803Smarcel result = xmalloc (len + 1); 3007130803Smarcel /* FIXME: add_name_string_cleanup should be defined in parse.c */ 3008130803Smarcel /* add_name_string_cleanup (result); */ 3009130803Smarcel strncpy (result, raw_name, len); 3010130803Smarcel result[len] = '\000'; 3011130803Smarcel return result; 3012130803Smarcel} 3013130803Smarcel 3014130803Smarcel 3015130803Smarcel /* Evaluation: Function Calls */ 3016130803Smarcel 3017130803Smarcel/* Copy VAL onto the stack, using and updating *SP as the stack 3018130803Smarcel pointer. Return VAL as an lvalue. */ 3019130803Smarcel 3020130803Smarcelstatic struct value * 3021130803Smarcelplace_on_stack (struct value *val, CORE_ADDR *sp) 3022130803Smarcel{ 3023130803Smarcel CORE_ADDR old_sp = *sp; 3024130803Smarcel 3025130803Smarcel#ifdef DEPRECATED_STACK_ALIGN 3026130803Smarcel *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val), 3027130803Smarcel DEPRECATED_STACK_ALIGN (TYPE_LENGTH 3028130803Smarcel (check_typedef (VALUE_TYPE (val))))); 3029130803Smarcel#else 3030130803Smarcel *sp = push_bytes (*sp, VALUE_CONTENTS_RAW (val), 3031130803Smarcel TYPE_LENGTH (check_typedef (VALUE_TYPE (val)))); 3032130803Smarcel#endif 3033130803Smarcel 3034130803Smarcel VALUE_LVAL (val) = lval_memory; 3035130803Smarcel if (INNER_THAN (1, 2)) 3036130803Smarcel VALUE_ADDRESS (val) = *sp; 3037130803Smarcel else 3038130803Smarcel VALUE_ADDRESS (val) = old_sp; 3039130803Smarcel 3040130803Smarcel return val; 3041130803Smarcel} 3042130803Smarcel 3043130803Smarcel/* Return the value ACTUAL, converted to be an appropriate value for a 3044130803Smarcel formal of type FORMAL_TYPE. Use *SP as a stack pointer for 3045130803Smarcel allocating any necessary descriptors (fat pointers), or copies of 3046130803Smarcel values not residing in memory, updating it as needed. */ 3047130803Smarcel 3048130803Smarcelstatic struct value * 3049130803Smarcelconvert_actual (struct value *actual, struct type *formal_type0, 3050130803Smarcel CORE_ADDR *sp) 3051130803Smarcel{ 3052130803Smarcel struct type *actual_type = check_typedef (VALUE_TYPE (actual)); 3053130803Smarcel struct type *formal_type = check_typedef (formal_type0); 3054130803Smarcel struct type *formal_target = 3055130803Smarcel TYPE_CODE (formal_type) == TYPE_CODE_PTR 3056130803Smarcel ? check_typedef (TYPE_TARGET_TYPE (formal_type)) : formal_type; 3057130803Smarcel struct type *actual_target = 3058130803Smarcel TYPE_CODE (actual_type) == TYPE_CODE_PTR 3059130803Smarcel ? check_typedef (TYPE_TARGET_TYPE (actual_type)) : actual_type; 3060130803Smarcel 3061130803Smarcel if (ada_is_array_descriptor (formal_target) 3062130803Smarcel && TYPE_CODE (actual_target) == TYPE_CODE_ARRAY) 3063130803Smarcel return make_array_descriptor (formal_type, actual, sp); 3064130803Smarcel else if (TYPE_CODE (formal_type) == TYPE_CODE_PTR) 3065130803Smarcel { 3066130803Smarcel if (TYPE_CODE (formal_target) == TYPE_CODE_ARRAY 3067130803Smarcel && ada_is_array_descriptor (actual_target)) 3068130803Smarcel return desc_data (actual); 3069130803Smarcel else if (TYPE_CODE (actual_type) != TYPE_CODE_PTR) 3070130803Smarcel { 3071130803Smarcel if (VALUE_LVAL (actual) != lval_memory) 3072130803Smarcel { 3073130803Smarcel struct value *val; 3074130803Smarcel actual_type = check_typedef (VALUE_TYPE (actual)); 3075130803Smarcel val = allocate_value (actual_type); 3076130803Smarcel memcpy ((char *) VALUE_CONTENTS_RAW (val), 3077130803Smarcel (char *) VALUE_CONTENTS (actual), 3078130803Smarcel TYPE_LENGTH (actual_type)); 3079130803Smarcel actual = place_on_stack (val, sp); 3080130803Smarcel } 3081130803Smarcel return value_addr (actual); 3082130803Smarcel } 3083130803Smarcel } 3084130803Smarcel else if (TYPE_CODE (actual_type) == TYPE_CODE_PTR) 3085130803Smarcel return ada_value_ind (actual); 3086130803Smarcel 3087130803Smarcel return actual; 3088130803Smarcel} 3089130803Smarcel 3090130803Smarcel 3091130803Smarcel/* Push a descriptor of type TYPE for array value ARR on the stack at 3092130803Smarcel *SP, updating *SP to reflect the new descriptor. Return either 3093130803Smarcel an lvalue representing the new descriptor, or (if TYPE is a pointer- 3094130803Smarcel to-descriptor type rather than a descriptor type), a struct value* 3095130803Smarcel representing a pointer to this descriptor. */ 3096130803Smarcel 3097130803Smarcelstatic struct value * 3098130803Smarcelmake_array_descriptor (struct type *type, struct value *arr, CORE_ADDR *sp) 3099130803Smarcel{ 3100130803Smarcel struct type *bounds_type = desc_bounds_type (type); 3101130803Smarcel struct type *desc_type = desc_base_type (type); 3102130803Smarcel struct value *descriptor = allocate_value (desc_type); 3103130803Smarcel struct value *bounds = allocate_value (bounds_type); 3104130803Smarcel CORE_ADDR bounds_addr; 3105130803Smarcel int i; 3106130803Smarcel 3107130803Smarcel for (i = ada_array_arity (check_typedef (VALUE_TYPE (arr))); i > 0; i -= 1) 3108130803Smarcel { 3109130803Smarcel modify_general_field (VALUE_CONTENTS (bounds), 3110130803Smarcel value_as_long (ada_array_bound (arr, i, 0)), 3111130803Smarcel desc_bound_bitpos (bounds_type, i, 0), 3112130803Smarcel desc_bound_bitsize (bounds_type, i, 0)); 3113130803Smarcel modify_general_field (VALUE_CONTENTS (bounds), 3114130803Smarcel value_as_long (ada_array_bound (arr, i, 1)), 3115130803Smarcel desc_bound_bitpos (bounds_type, i, 1), 3116130803Smarcel desc_bound_bitsize (bounds_type, i, 1)); 3117130803Smarcel } 3118130803Smarcel 3119130803Smarcel bounds = place_on_stack (bounds, sp); 3120130803Smarcel 3121130803Smarcel modify_general_field (VALUE_CONTENTS (descriptor), 3122130803Smarcel arr, 3123130803Smarcel fat_pntr_data_bitpos (desc_type), 3124130803Smarcel fat_pntr_data_bitsize (desc_type)); 3125130803Smarcel modify_general_field (VALUE_CONTENTS (descriptor), 3126130803Smarcel VALUE_ADDRESS (bounds), 3127130803Smarcel fat_pntr_bounds_bitpos (desc_type), 3128130803Smarcel fat_pntr_bounds_bitsize (desc_type)); 3129130803Smarcel 3130130803Smarcel descriptor = place_on_stack (descriptor, sp); 3131130803Smarcel 3132130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_PTR) 3133130803Smarcel return value_addr (descriptor); 3134130803Smarcel else 3135130803Smarcel return descriptor; 3136130803Smarcel} 3137130803Smarcel 3138130803Smarcel 3139130803Smarcel/* Assuming a dummy frame has been established on the target, perform any 3140130803Smarcel conversions needed for calling function FUNC on the NARGS actual 3141130803Smarcel parameters in ARGS, other than standard C conversions. Does 3142130803Smarcel nothing if FUNC does not have Ada-style prototype data, or if NARGS 3143130803Smarcel does not match the number of arguments expected. Use *SP as a 3144130803Smarcel stack pointer for additional data that must be pushed, updating its 3145130803Smarcel value as needed. */ 3146130803Smarcel 3147130803Smarcelvoid 3148130803Smarcelada_convert_actuals (struct value *func, int nargs, struct value *args[], 3149130803Smarcel CORE_ADDR *sp) 3150130803Smarcel{ 3151130803Smarcel int i; 3152130803Smarcel 3153130803Smarcel if (TYPE_NFIELDS (VALUE_TYPE (func)) == 0 3154130803Smarcel || nargs != TYPE_NFIELDS (VALUE_TYPE (func))) 3155130803Smarcel return; 3156130803Smarcel 3157130803Smarcel for (i = 0; i < nargs; i += 1) 3158130803Smarcel args[i] = 3159130803Smarcel convert_actual (args[i], TYPE_FIELD_TYPE (VALUE_TYPE (func), i), sp); 3160130803Smarcel} 3161130803Smarcel 3162130803Smarcel 3163130803Smarcel /* Symbol Lookup */ 3164130803Smarcel 3165130803Smarcel 3166130803Smarcel/* The vectors of symbols and blocks ultimately returned from */ 3167130803Smarcel/* ada_lookup_symbol_list. */ 3168130803Smarcel 3169130803Smarcel/* Current size of defn_symbols and defn_blocks */ 3170130803Smarcelstatic size_t defn_vector_size = 0; 3171130803Smarcel 3172130803Smarcel/* Current number of symbols found. */ 3173130803Smarcelstatic int ndefns = 0; 3174130803Smarcel 3175130803Smarcelstatic struct symbol **defn_symbols = NULL; 3176130803Smarcelstatic struct block **defn_blocks = NULL; 3177130803Smarcel 3178130803Smarcel/* Return the result of a standard (literal, C-like) lookup of NAME in 3179130803Smarcel * given DOMAIN. */ 3180130803Smarcel 3181130803Smarcelstatic struct symbol * 3182130803Smarcelstandard_lookup (const char *name, domain_enum domain) 3183130803Smarcel{ 3184130803Smarcel struct symbol *sym; 3185130803Smarcel sym = lookup_symbol (name, (struct block *) NULL, domain, 0, NULL); 3186130803Smarcel return sym; 3187130803Smarcel} 3188130803Smarcel 3189130803Smarcel 3190130803Smarcel/* Non-zero iff there is at least one non-function/non-enumeral symbol */ 3191130803Smarcel/* in SYMS[0..N-1]. We treat enumerals as functions, since they */ 3192130803Smarcel/* contend in overloading in the same way. */ 3193130803Smarcelstatic int 3194130803Smarcelis_nonfunction (struct symbol *syms[], int n) 3195130803Smarcel{ 3196130803Smarcel int i; 3197130803Smarcel 3198130803Smarcel for (i = 0; i < n; i += 1) 3199130803Smarcel if (TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_FUNC 3200130803Smarcel && TYPE_CODE (SYMBOL_TYPE (syms[i])) != TYPE_CODE_ENUM) 3201130803Smarcel return 1; 3202130803Smarcel 3203130803Smarcel return 0; 3204130803Smarcel} 3205130803Smarcel 3206130803Smarcel/* If true (non-zero), then TYPE0 and TYPE1 represent equivalent 3207130803Smarcel struct types. Otherwise, they may not. */ 3208130803Smarcel 3209130803Smarcelstatic int 3210130803Smarcelequiv_types (struct type *type0, struct type *type1) 3211130803Smarcel{ 3212130803Smarcel if (type0 == type1) 3213130803Smarcel return 1; 3214130803Smarcel if (type0 == NULL || type1 == NULL 3215130803Smarcel || TYPE_CODE (type0) != TYPE_CODE (type1)) 3216130803Smarcel return 0; 3217130803Smarcel if ((TYPE_CODE (type0) == TYPE_CODE_STRUCT 3218130803Smarcel || TYPE_CODE (type0) == TYPE_CODE_ENUM) 3219130803Smarcel && ada_type_name (type0) != NULL && ada_type_name (type1) != NULL 3220130803Smarcel && DEPRECATED_STREQ (ada_type_name (type0), ada_type_name (type1))) 3221130803Smarcel return 1; 3222130803Smarcel 3223130803Smarcel return 0; 3224130803Smarcel} 3225130803Smarcel 3226130803Smarcel/* True iff SYM0 represents the same entity as SYM1, or one that is 3227130803Smarcel no more defined than that of SYM1. */ 3228130803Smarcel 3229130803Smarcelstatic int 3230130803Smarcellesseq_defined_than (struct symbol *sym0, struct symbol *sym1) 3231130803Smarcel{ 3232130803Smarcel if (sym0 == sym1) 3233130803Smarcel return 1; 3234130803Smarcel if (SYMBOL_DOMAIN (sym0) != SYMBOL_DOMAIN (sym1) 3235130803Smarcel || SYMBOL_CLASS (sym0) != SYMBOL_CLASS (sym1)) 3236130803Smarcel return 0; 3237130803Smarcel 3238130803Smarcel switch (SYMBOL_CLASS (sym0)) 3239130803Smarcel { 3240130803Smarcel case LOC_UNDEF: 3241130803Smarcel return 1; 3242130803Smarcel case LOC_TYPEDEF: 3243130803Smarcel { 3244130803Smarcel struct type *type0 = SYMBOL_TYPE (sym0); 3245130803Smarcel struct type *type1 = SYMBOL_TYPE (sym1); 3246130803Smarcel char *name0 = DEPRECATED_SYMBOL_NAME (sym0); 3247130803Smarcel char *name1 = DEPRECATED_SYMBOL_NAME (sym1); 3248130803Smarcel int len0 = strlen (name0); 3249130803Smarcel return 3250130803Smarcel TYPE_CODE (type0) == TYPE_CODE (type1) 3251130803Smarcel && (equiv_types (type0, type1) 3252130803Smarcel || (len0 < strlen (name1) && DEPRECATED_STREQN (name0, name1, len0) 3253130803Smarcel && DEPRECATED_STREQN (name1 + len0, "___XV", 5))); 3254130803Smarcel } 3255130803Smarcel case LOC_CONST: 3256130803Smarcel return SYMBOL_VALUE (sym0) == SYMBOL_VALUE (sym1) 3257130803Smarcel && equiv_types (SYMBOL_TYPE (sym0), SYMBOL_TYPE (sym1)); 3258130803Smarcel default: 3259130803Smarcel return 0; 3260130803Smarcel } 3261130803Smarcel} 3262130803Smarcel 3263130803Smarcel/* Append SYM to the end of defn_symbols, and BLOCK to the end of 3264130803Smarcel defn_blocks, updating ndefns, and expanding defn_symbols and 3265130803Smarcel defn_blocks as needed. Do not include SYM if it is a duplicate. */ 3266130803Smarcel 3267130803Smarcelstatic void 3268130803Smarceladd_defn_to_vec (struct symbol *sym, struct block *block) 3269130803Smarcel{ 3270130803Smarcel int i; 3271130803Smarcel size_t tmp; 3272130803Smarcel 3273130803Smarcel if (SYMBOL_TYPE (sym) != NULL) 3274130803Smarcel CHECK_TYPEDEF (SYMBOL_TYPE (sym)); 3275130803Smarcel for (i = 0; i < ndefns; i += 1) 3276130803Smarcel { 3277130803Smarcel if (lesseq_defined_than (sym, defn_symbols[i])) 3278130803Smarcel return; 3279130803Smarcel else if (lesseq_defined_than (defn_symbols[i], sym)) 3280130803Smarcel { 3281130803Smarcel defn_symbols[i] = sym; 3282130803Smarcel defn_blocks[i] = block; 3283130803Smarcel return; 3284130803Smarcel } 3285130803Smarcel } 3286130803Smarcel 3287130803Smarcel tmp = defn_vector_size; 3288130803Smarcel GROW_VECT (defn_symbols, tmp, ndefns + 2); 3289130803Smarcel GROW_VECT (defn_blocks, defn_vector_size, ndefns + 2); 3290130803Smarcel 3291130803Smarcel defn_symbols[ndefns] = sym; 3292130803Smarcel defn_blocks[ndefns] = block; 3293130803Smarcel ndefns += 1; 3294130803Smarcel} 3295130803Smarcel 3296130803Smarcel/* Look, in partial_symtab PST, for symbol NAME in given domain. 3297130803Smarcel Check the global symbols if GLOBAL, the static symbols if not. Do 3298130803Smarcel wild-card match if WILD. */ 3299130803Smarcel 3300130803Smarcelstatic struct partial_symbol * 3301130803Smarcelada_lookup_partial_symbol (struct partial_symtab *pst, const char *name, 3302130803Smarcel int global, domain_enum domain, int wild) 3303130803Smarcel{ 3304130803Smarcel struct partial_symbol **start; 3305130803Smarcel int name_len = strlen (name); 3306130803Smarcel int length = (global ? pst->n_global_syms : pst->n_static_syms); 3307130803Smarcel int i; 3308130803Smarcel 3309130803Smarcel if (length == 0) 3310130803Smarcel { 3311130803Smarcel return (NULL); 3312130803Smarcel } 3313130803Smarcel 3314130803Smarcel start = (global ? 3315130803Smarcel pst->objfile->global_psymbols.list + pst->globals_offset : 3316130803Smarcel pst->objfile->static_psymbols.list + pst->statics_offset); 3317130803Smarcel 3318130803Smarcel if (wild) 3319130803Smarcel { 3320130803Smarcel for (i = 0; i < length; i += 1) 3321130803Smarcel { 3322130803Smarcel struct partial_symbol *psym = start[i]; 3323130803Smarcel 3324130803Smarcel if (SYMBOL_DOMAIN (psym) == domain && 3325130803Smarcel wild_match (name, name_len, DEPRECATED_SYMBOL_NAME (psym))) 3326130803Smarcel return psym; 3327130803Smarcel } 3328130803Smarcel return NULL; 3329130803Smarcel } 3330130803Smarcel else 3331130803Smarcel { 3332130803Smarcel if (global) 3333130803Smarcel { 3334130803Smarcel int U; 3335130803Smarcel i = 0; 3336130803Smarcel U = length - 1; 3337130803Smarcel while (U - i > 4) 3338130803Smarcel { 3339130803Smarcel int M = (U + i) >> 1; 3340130803Smarcel struct partial_symbol *psym = start[M]; 3341130803Smarcel if (DEPRECATED_SYMBOL_NAME (psym)[0] < name[0]) 3342130803Smarcel i = M + 1; 3343130803Smarcel else if (DEPRECATED_SYMBOL_NAME (psym)[0] > name[0]) 3344130803Smarcel U = M - 1; 3345130803Smarcel else if (strcmp (DEPRECATED_SYMBOL_NAME (psym), name) < 0) 3346130803Smarcel i = M + 1; 3347130803Smarcel else 3348130803Smarcel U = M; 3349130803Smarcel } 3350130803Smarcel } 3351130803Smarcel else 3352130803Smarcel i = 0; 3353130803Smarcel 3354130803Smarcel while (i < length) 3355130803Smarcel { 3356130803Smarcel struct partial_symbol *psym = start[i]; 3357130803Smarcel 3358130803Smarcel if (SYMBOL_DOMAIN (psym) == domain) 3359130803Smarcel { 3360130803Smarcel int cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (psym), name_len); 3361130803Smarcel 3362130803Smarcel if (cmp < 0) 3363130803Smarcel { 3364130803Smarcel if (global) 3365130803Smarcel break; 3366130803Smarcel } 3367130803Smarcel else if (cmp == 0 3368130803Smarcel && is_name_suffix (DEPRECATED_SYMBOL_NAME (psym) + name_len)) 3369130803Smarcel return psym; 3370130803Smarcel } 3371130803Smarcel i += 1; 3372130803Smarcel } 3373130803Smarcel 3374130803Smarcel if (global) 3375130803Smarcel { 3376130803Smarcel int U; 3377130803Smarcel i = 0; 3378130803Smarcel U = length - 1; 3379130803Smarcel while (U - i > 4) 3380130803Smarcel { 3381130803Smarcel int M = (U + i) >> 1; 3382130803Smarcel struct partial_symbol *psym = start[M]; 3383130803Smarcel if (DEPRECATED_SYMBOL_NAME (psym)[0] < '_') 3384130803Smarcel i = M + 1; 3385130803Smarcel else if (DEPRECATED_SYMBOL_NAME (psym)[0] > '_') 3386130803Smarcel U = M - 1; 3387130803Smarcel else if (strcmp (DEPRECATED_SYMBOL_NAME (psym), "_ada_") < 0) 3388130803Smarcel i = M + 1; 3389130803Smarcel else 3390130803Smarcel U = M; 3391130803Smarcel } 3392130803Smarcel } 3393130803Smarcel else 3394130803Smarcel i = 0; 3395130803Smarcel 3396130803Smarcel while (i < length) 3397130803Smarcel { 3398130803Smarcel struct partial_symbol *psym = start[i]; 3399130803Smarcel 3400130803Smarcel if (SYMBOL_DOMAIN (psym) == domain) 3401130803Smarcel { 3402130803Smarcel int cmp; 3403130803Smarcel 3404130803Smarcel cmp = (int) '_' - (int) DEPRECATED_SYMBOL_NAME (psym)[0]; 3405130803Smarcel if (cmp == 0) 3406130803Smarcel { 3407130803Smarcel cmp = strncmp ("_ada_", DEPRECATED_SYMBOL_NAME (psym), 5); 3408130803Smarcel if (cmp == 0) 3409130803Smarcel cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (psym) + 5, name_len); 3410130803Smarcel } 3411130803Smarcel 3412130803Smarcel if (cmp < 0) 3413130803Smarcel { 3414130803Smarcel if (global) 3415130803Smarcel break; 3416130803Smarcel } 3417130803Smarcel else if (cmp == 0 3418130803Smarcel && is_name_suffix (DEPRECATED_SYMBOL_NAME (psym) + name_len + 5)) 3419130803Smarcel return psym; 3420130803Smarcel } 3421130803Smarcel i += 1; 3422130803Smarcel } 3423130803Smarcel 3424130803Smarcel } 3425130803Smarcel return NULL; 3426130803Smarcel} 3427130803Smarcel 3428130803Smarcel 3429130803Smarcel/* Find a symbol table containing symbol SYM or NULL if none. */ 3430130803Smarcelstatic struct symtab * 3431130803Smarcelsymtab_for_sym (struct symbol *sym) 3432130803Smarcel{ 3433130803Smarcel struct symtab *s; 3434130803Smarcel struct objfile *objfile; 3435130803Smarcel struct block *b; 3436130803Smarcel struct symbol *tmp_sym; 3437130803Smarcel struct dict_iterator iter; 3438130803Smarcel int j; 3439130803Smarcel 3440130803Smarcel ALL_SYMTABS (objfile, s) 3441130803Smarcel { 3442130803Smarcel switch (SYMBOL_CLASS (sym)) 3443130803Smarcel { 3444130803Smarcel case LOC_CONST: 3445130803Smarcel case LOC_STATIC: 3446130803Smarcel case LOC_TYPEDEF: 3447130803Smarcel case LOC_REGISTER: 3448130803Smarcel case LOC_LABEL: 3449130803Smarcel case LOC_BLOCK: 3450130803Smarcel case LOC_CONST_BYTES: 3451130803Smarcel b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), GLOBAL_BLOCK); 3452130803Smarcel ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym) 3453130803Smarcel return s; 3454130803Smarcel b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), STATIC_BLOCK); 3455130803Smarcel ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym) 3456130803Smarcel return s; 3457130803Smarcel break; 3458130803Smarcel default: 3459130803Smarcel break; 3460130803Smarcel } 3461130803Smarcel switch (SYMBOL_CLASS (sym)) 3462130803Smarcel { 3463130803Smarcel case LOC_REGISTER: 3464130803Smarcel case LOC_ARG: 3465130803Smarcel case LOC_REF_ARG: 3466130803Smarcel case LOC_REGPARM: 3467130803Smarcel case LOC_REGPARM_ADDR: 3468130803Smarcel case LOC_LOCAL: 3469130803Smarcel case LOC_TYPEDEF: 3470130803Smarcel case LOC_LOCAL_ARG: 3471130803Smarcel case LOC_BASEREG: 3472130803Smarcel case LOC_BASEREG_ARG: 3473130803Smarcel case LOC_COMPUTED: 3474130803Smarcel case LOC_COMPUTED_ARG: 3475130803Smarcel for (j = FIRST_LOCAL_BLOCK; 3476130803Smarcel j < BLOCKVECTOR_NBLOCKS (BLOCKVECTOR (s)); j += 1) 3477130803Smarcel { 3478130803Smarcel b = BLOCKVECTOR_BLOCK (BLOCKVECTOR (s), j); 3479130803Smarcel ALL_BLOCK_SYMBOLS (b, iter, tmp_sym) if (sym == tmp_sym) 3480130803Smarcel return s; 3481130803Smarcel } 3482130803Smarcel break; 3483130803Smarcel default: 3484130803Smarcel break; 3485130803Smarcel } 3486130803Smarcel } 3487130803Smarcel return NULL; 3488130803Smarcel} 3489130803Smarcel 3490130803Smarcel/* Return a minimal symbol matching NAME according to Ada demangling 3491130803Smarcel rules. Returns NULL if there is no such minimal symbol. */ 3492130803Smarcel 3493130803Smarcelstruct minimal_symbol * 3494130803Smarcelada_lookup_minimal_symbol (const char *name) 3495130803Smarcel{ 3496130803Smarcel struct objfile *objfile; 3497130803Smarcel struct minimal_symbol *msymbol; 3498130803Smarcel int wild_match = (strstr (name, "__") == NULL); 3499130803Smarcel 3500130803Smarcel ALL_MSYMBOLS (objfile, msymbol) 3501130803Smarcel { 3502130803Smarcel if (ada_match_name (DEPRECATED_SYMBOL_NAME (msymbol), name, wild_match) 3503130803Smarcel && MSYMBOL_TYPE (msymbol) != mst_solib_trampoline) 3504130803Smarcel return msymbol; 3505130803Smarcel } 3506130803Smarcel 3507130803Smarcel return NULL; 3508130803Smarcel} 3509130803Smarcel 3510130803Smarcel/* For all subprograms that statically enclose the subprogram of the 3511130803Smarcel * selected frame, add symbols matching identifier NAME in DOMAIN 3512130803Smarcel * and their blocks to vectors *defn_symbols and *defn_blocks, as for 3513130803Smarcel * ada_add_block_symbols (q.v.). If WILD, treat as NAME with a 3514130803Smarcel * wildcard prefix. At the moment, this function uses a heuristic to 3515130803Smarcel * find the frames of enclosing subprograms: it treats the 3516130803Smarcel * pointer-sized value at location 0 from the local-variable base of a 3517130803Smarcel * frame as a static link, and then searches up the call stack for a 3518130803Smarcel * frame with that same local-variable base. */ 3519130803Smarcelstatic void 3520130803Smarceladd_symbols_from_enclosing_procs (const char *name, domain_enum domain, 3521130803Smarcel int wild_match) 3522130803Smarcel{ 3523130803Smarcel#ifdef i386 3524130803Smarcel static struct symbol static_link_sym; 3525130803Smarcel static struct symbol *static_link; 3526130803Smarcel 3527130803Smarcel struct cleanup *old_chain = make_cleanup (null_cleanup, NULL); 3528130803Smarcel struct frame_info *frame; 3529130803Smarcel struct frame_info *target_frame; 3530130803Smarcel 3531130803Smarcel if (static_link == NULL) 3532130803Smarcel { 3533130803Smarcel /* Initialize the local variable symbol that stands for the 3534130803Smarcel * static link (when it exists). */ 3535130803Smarcel static_link = &static_link_sym; 3536130803Smarcel DEPRECATED_SYMBOL_NAME (static_link) = ""; 3537130803Smarcel SYMBOL_LANGUAGE (static_link) = language_unknown; 3538130803Smarcel SYMBOL_CLASS (static_link) = LOC_LOCAL; 3539130803Smarcel SYMBOL_DOMAIN (static_link) = VAR_DOMAIN; 3540130803Smarcel SYMBOL_TYPE (static_link) = lookup_pointer_type (builtin_type_void); 3541130803Smarcel SYMBOL_VALUE (static_link) = 3542130803Smarcel -(long) TYPE_LENGTH (SYMBOL_TYPE (static_link)); 3543130803Smarcel } 3544130803Smarcel 3545130803Smarcel frame = deprecated_selected_frame; 3546130803Smarcel while (frame != NULL && ndefns == 0) 3547130803Smarcel { 3548130803Smarcel struct block *block; 3549130803Smarcel struct value *target_link_val = read_var_value (static_link, frame); 3550130803Smarcel CORE_ADDR target_link; 3551130803Smarcel 3552130803Smarcel if (target_link_val == NULL) 3553130803Smarcel break; 3554130803Smarcel QUIT; 3555130803Smarcel 3556130803Smarcel target_link = target_link_val; 3557130803Smarcel do 3558130803Smarcel { 3559130803Smarcel QUIT; 3560130803Smarcel frame = get_prev_frame (frame); 3561130803Smarcel } 3562130803Smarcel while (frame != NULL && DEPRECATED_FRAME_LOCALS_ADDRESS (frame) != target_link); 3563130803Smarcel 3564130803Smarcel if (frame == NULL) 3565130803Smarcel break; 3566130803Smarcel 3567130803Smarcel block = get_frame_block (frame, 0); 3568130803Smarcel while (block != NULL && block_function (block) != NULL && ndefns == 0) 3569130803Smarcel { 3570130803Smarcel ada_add_block_symbols (block, name, domain, NULL, wild_match); 3571130803Smarcel 3572130803Smarcel block = BLOCK_SUPERBLOCK (block); 3573130803Smarcel } 3574130803Smarcel } 3575130803Smarcel 3576130803Smarcel do_cleanups (old_chain); 3577130803Smarcel#endif 3578130803Smarcel} 3579130803Smarcel 3580130803Smarcel/* True if TYPE is definitely an artificial type supplied to a symbol 3581130803Smarcel * for which no debugging information was given in the symbol file. */ 3582130803Smarcelstatic int 3583130803Smarcelis_nondebugging_type (struct type *type) 3584130803Smarcel{ 3585130803Smarcel char *name = ada_type_name (type); 3586130803Smarcel return (name != NULL && DEPRECATED_STREQ (name, "<variable, no debug info>")); 3587130803Smarcel} 3588130803Smarcel 3589130803Smarcel/* Remove any non-debugging symbols in SYMS[0 .. NSYMS-1] that definitely 3590130803Smarcel * duplicate other symbols in the list. (The only case I know of where 3591130803Smarcel * this happens is when object files containing stabs-in-ecoff are 3592130803Smarcel * linked with files containing ordinary ecoff debugging symbols (or no 3593130803Smarcel * debugging symbols)). Modifies SYMS to squeeze out deleted symbols, 3594130803Smarcel * and applies the same modification to BLOCKS to maintain the 3595130803Smarcel * correspondence between SYMS[i] and BLOCKS[i]. Returns the number 3596130803Smarcel * of symbols in the modified list. */ 3597130803Smarcelstatic int 3598130803Smarcelremove_extra_symbols (struct symbol **syms, struct block **blocks, int nsyms) 3599130803Smarcel{ 3600130803Smarcel int i, j; 3601130803Smarcel 3602130803Smarcel i = 0; 3603130803Smarcel while (i < nsyms) 3604130803Smarcel { 3605130803Smarcel if (DEPRECATED_SYMBOL_NAME (syms[i]) != NULL 3606130803Smarcel && SYMBOL_CLASS (syms[i]) == LOC_STATIC 3607130803Smarcel && is_nondebugging_type (SYMBOL_TYPE (syms[i]))) 3608130803Smarcel { 3609130803Smarcel for (j = 0; j < nsyms; j += 1) 3610130803Smarcel { 3611130803Smarcel if (i != j 3612130803Smarcel && DEPRECATED_SYMBOL_NAME (syms[j]) != NULL 3613130803Smarcel && DEPRECATED_STREQ (DEPRECATED_SYMBOL_NAME (syms[i]), DEPRECATED_SYMBOL_NAME (syms[j])) 3614130803Smarcel && SYMBOL_CLASS (syms[i]) == SYMBOL_CLASS (syms[j]) 3615130803Smarcel && SYMBOL_VALUE_ADDRESS (syms[i]) 3616130803Smarcel == SYMBOL_VALUE_ADDRESS (syms[j])) 3617130803Smarcel { 3618130803Smarcel int k; 3619130803Smarcel for (k = i + 1; k < nsyms; k += 1) 3620130803Smarcel { 3621130803Smarcel syms[k - 1] = syms[k]; 3622130803Smarcel blocks[k - 1] = blocks[k]; 3623130803Smarcel } 3624130803Smarcel nsyms -= 1; 3625130803Smarcel goto NextSymbol; 3626130803Smarcel } 3627130803Smarcel } 3628130803Smarcel } 3629130803Smarcel i += 1; 3630130803Smarcel NextSymbol: 3631130803Smarcel ; 3632130803Smarcel } 3633130803Smarcel return nsyms; 3634130803Smarcel} 3635130803Smarcel 3636130803Smarcel/* Find symbols in DOMAIN matching NAME, in BLOCK0 and enclosing 3637130803Smarcel scope and in global scopes, returning the number of matches. Sets 3638130803Smarcel *SYMS to point to a vector of matching symbols, with *BLOCKS 3639130803Smarcel pointing to the vector of corresponding blocks in which those 3640130803Smarcel symbols reside. These two vectors are transient---good only to the 3641130803Smarcel next call of ada_lookup_symbol_list. Any non-function/non-enumeral symbol 3642130803Smarcel match within the nest of blocks whose innermost member is BLOCK0, 3643130803Smarcel is the outermost match returned (no other matches in that or 3644130803Smarcel enclosing blocks is returned). If there are any matches in or 3645130803Smarcel surrounding BLOCK0, then these alone are returned. */ 3646130803Smarcel 3647130803Smarcelint 3648130803Smarcelada_lookup_symbol_list (const char *name, struct block *block0, 3649130803Smarcel domain_enum domain, struct symbol ***syms, 3650130803Smarcel struct block ***blocks) 3651130803Smarcel{ 3652130803Smarcel struct symbol *sym; 3653130803Smarcel struct symtab *s; 3654130803Smarcel struct partial_symtab *ps; 3655130803Smarcel struct blockvector *bv; 3656130803Smarcel struct objfile *objfile; 3657130803Smarcel struct block *b; 3658130803Smarcel struct block *block; 3659130803Smarcel struct minimal_symbol *msymbol; 3660130803Smarcel int wild_match = (strstr (name, "__") == NULL); 3661130803Smarcel int cacheIfUnique; 3662130803Smarcel 3663130803Smarcel#ifdef TIMING 3664130803Smarcel markTimeStart (0); 3665130803Smarcel#endif 3666130803Smarcel 3667130803Smarcel ndefns = 0; 3668130803Smarcel cacheIfUnique = 0; 3669130803Smarcel 3670130803Smarcel /* Search specified block and its superiors. */ 3671130803Smarcel 3672130803Smarcel block = block0; 3673130803Smarcel while (block != NULL) 3674130803Smarcel { 3675130803Smarcel ada_add_block_symbols (block, name, domain, NULL, wild_match); 3676130803Smarcel 3677130803Smarcel /* If we found a non-function match, assume that's the one. */ 3678130803Smarcel if (is_nonfunction (defn_symbols, ndefns)) 3679130803Smarcel goto done; 3680130803Smarcel 3681130803Smarcel block = BLOCK_SUPERBLOCK (block); 3682130803Smarcel } 3683130803Smarcel 3684130803Smarcel /* If we found ANY matches in the specified BLOCK, we're done. */ 3685130803Smarcel 3686130803Smarcel if (ndefns > 0) 3687130803Smarcel goto done; 3688130803Smarcel 3689130803Smarcel cacheIfUnique = 1; 3690130803Smarcel 3691130803Smarcel /* Now add symbols from all global blocks: symbol tables, minimal symbol 3692130803Smarcel tables, and psymtab's */ 3693130803Smarcel 3694130803Smarcel ALL_SYMTABS (objfile, s) 3695130803Smarcel { 3696130803Smarcel QUIT; 3697130803Smarcel if (!s->primary) 3698130803Smarcel continue; 3699130803Smarcel bv = BLOCKVECTOR (s); 3700130803Smarcel block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK); 3701130803Smarcel ada_add_block_symbols (block, name, domain, objfile, wild_match); 3702130803Smarcel } 3703130803Smarcel 3704130803Smarcel if (domain == VAR_DOMAIN) 3705130803Smarcel { 3706130803Smarcel ALL_MSYMBOLS (objfile, msymbol) 3707130803Smarcel { 3708130803Smarcel if (ada_match_name (DEPRECATED_SYMBOL_NAME (msymbol), name, wild_match)) 3709130803Smarcel { 3710130803Smarcel switch (MSYMBOL_TYPE (msymbol)) 3711130803Smarcel { 3712130803Smarcel case mst_solib_trampoline: 3713130803Smarcel break; 3714130803Smarcel default: 3715130803Smarcel s = find_pc_symtab (SYMBOL_VALUE_ADDRESS (msymbol)); 3716130803Smarcel if (s != NULL) 3717130803Smarcel { 3718130803Smarcel int old_ndefns = ndefns; 3719130803Smarcel QUIT; 3720130803Smarcel bv = BLOCKVECTOR (s); 3721130803Smarcel block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK); 3722130803Smarcel ada_add_block_symbols (block, 3723130803Smarcel DEPRECATED_SYMBOL_NAME (msymbol), 3724130803Smarcel domain, objfile, wild_match); 3725130803Smarcel if (ndefns == old_ndefns) 3726130803Smarcel { 3727130803Smarcel block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK); 3728130803Smarcel ada_add_block_symbols (block, 3729130803Smarcel DEPRECATED_SYMBOL_NAME (msymbol), 3730130803Smarcel domain, objfile, 3731130803Smarcel wild_match); 3732130803Smarcel } 3733130803Smarcel } 3734130803Smarcel } 3735130803Smarcel } 3736130803Smarcel } 3737130803Smarcel } 3738130803Smarcel 3739130803Smarcel ALL_PSYMTABS (objfile, ps) 3740130803Smarcel { 3741130803Smarcel QUIT; 3742130803Smarcel if (!ps->readin 3743130803Smarcel && ada_lookup_partial_symbol (ps, name, 1, domain, wild_match)) 3744130803Smarcel { 3745130803Smarcel s = PSYMTAB_TO_SYMTAB (ps); 3746130803Smarcel if (!s->primary) 3747130803Smarcel continue; 3748130803Smarcel bv = BLOCKVECTOR (s); 3749130803Smarcel block = BLOCKVECTOR_BLOCK (bv, GLOBAL_BLOCK); 3750130803Smarcel ada_add_block_symbols (block, name, domain, objfile, wild_match); 3751130803Smarcel } 3752130803Smarcel } 3753130803Smarcel 3754130803Smarcel /* Now add symbols from all per-file blocks if we've gotten no hits. 3755130803Smarcel (Not strictly correct, but perhaps better than an error). 3756130803Smarcel Do the symtabs first, then check the psymtabs */ 3757130803Smarcel 3758130803Smarcel if (ndefns == 0) 3759130803Smarcel { 3760130803Smarcel 3761130803Smarcel ALL_SYMTABS (objfile, s) 3762130803Smarcel { 3763130803Smarcel QUIT; 3764130803Smarcel if (!s->primary) 3765130803Smarcel continue; 3766130803Smarcel bv = BLOCKVECTOR (s); 3767130803Smarcel block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK); 3768130803Smarcel ada_add_block_symbols (block, name, domain, objfile, wild_match); 3769130803Smarcel } 3770130803Smarcel 3771130803Smarcel ALL_PSYMTABS (objfile, ps) 3772130803Smarcel { 3773130803Smarcel QUIT; 3774130803Smarcel if (!ps->readin 3775130803Smarcel && ada_lookup_partial_symbol (ps, name, 0, domain, wild_match)) 3776130803Smarcel { 3777130803Smarcel s = PSYMTAB_TO_SYMTAB (ps); 3778130803Smarcel bv = BLOCKVECTOR (s); 3779130803Smarcel if (!s->primary) 3780130803Smarcel continue; 3781130803Smarcel block = BLOCKVECTOR_BLOCK (bv, STATIC_BLOCK); 3782130803Smarcel ada_add_block_symbols (block, name, domain, 3783130803Smarcel objfile, wild_match); 3784130803Smarcel } 3785130803Smarcel } 3786130803Smarcel } 3787130803Smarcel 3788130803Smarcel /* Finally, we try to find NAME as a local symbol in some lexically 3789130803Smarcel enclosing block. We do this last, expecting this case to be 3790130803Smarcel rare. */ 3791130803Smarcel if (ndefns == 0) 3792130803Smarcel { 3793130803Smarcel add_symbols_from_enclosing_procs (name, domain, wild_match); 3794130803Smarcel if (ndefns > 0) 3795130803Smarcel goto done; 3796130803Smarcel } 3797130803Smarcel 3798130803Smarceldone: 3799130803Smarcel ndefns = remove_extra_symbols (defn_symbols, defn_blocks, ndefns); 3800130803Smarcel 3801130803Smarcel 3802130803Smarcel *syms = defn_symbols; 3803130803Smarcel *blocks = defn_blocks; 3804130803Smarcel#ifdef TIMING 3805130803Smarcel markTimeStop (0); 3806130803Smarcel#endif 3807130803Smarcel return ndefns; 3808130803Smarcel} 3809130803Smarcel 3810130803Smarcel/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing 3811130803Smarcel * scope and in global scopes, or NULL if none. NAME is folded to 3812130803Smarcel * lower case first, unless it is surrounded in single quotes. 3813130803Smarcel * Otherwise, the result is as for ada_lookup_symbol_list, but is 3814130803Smarcel * disambiguated by user query if needed. */ 3815130803Smarcel 3816130803Smarcelstruct symbol * 3817130803Smarcelada_lookup_symbol (const char *name, struct block *block0, 3818130803Smarcel domain_enum domain) 3819130803Smarcel{ 3820130803Smarcel struct symbol **candidate_syms; 3821130803Smarcel struct block **candidate_blocks; 3822130803Smarcel int n_candidates; 3823130803Smarcel 3824130803Smarcel n_candidates = ada_lookup_symbol_list (name, 3825130803Smarcel block0, domain, 3826130803Smarcel &candidate_syms, &candidate_blocks); 3827130803Smarcel 3828130803Smarcel if (n_candidates == 0) 3829130803Smarcel return NULL; 3830130803Smarcel else if (n_candidates != 1) 3831130803Smarcel user_select_syms (candidate_syms, candidate_blocks, n_candidates, 1); 3832130803Smarcel 3833130803Smarcel return candidate_syms[0]; 3834130803Smarcel} 3835130803Smarcel 3836130803Smarcel 3837130803Smarcel/* True iff STR is a possible encoded suffix of a normal Ada name 3838130803Smarcel * that is to be ignored for matching purposes. Suffixes of parallel 3839130803Smarcel * names (e.g., XVE) are not included here. Currently, the possible suffixes 3840130803Smarcel * are given by the regular expression: 3841130803Smarcel * (X[nb]*)?(__[0-9]+|\$[0-9]+|___(LJM|X([FDBUP].*|R[^T]?)))?$ 3842130803Smarcel * 3843130803Smarcel */ 3844130803Smarcelstatic int 3845130803Smarcelis_name_suffix (const char *str) 3846130803Smarcel{ 3847130803Smarcel int k; 3848130803Smarcel if (str[0] == 'X') 3849130803Smarcel { 3850130803Smarcel str += 1; 3851130803Smarcel while (str[0] != '_' && str[0] != '\0') 3852130803Smarcel { 3853130803Smarcel if (str[0] != 'n' && str[0] != 'b') 3854130803Smarcel return 0; 3855130803Smarcel str += 1; 3856130803Smarcel } 3857130803Smarcel } 3858130803Smarcel if (str[0] == '\000') 3859130803Smarcel return 1; 3860130803Smarcel if (str[0] == '_') 3861130803Smarcel { 3862130803Smarcel if (str[1] != '_' || str[2] == '\000') 3863130803Smarcel return 0; 3864130803Smarcel if (str[2] == '_') 3865130803Smarcel { 3866130803Smarcel if (DEPRECATED_STREQ (str + 3, "LJM")) 3867130803Smarcel return 1; 3868130803Smarcel if (str[3] != 'X') 3869130803Smarcel return 0; 3870130803Smarcel if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B' || 3871130803Smarcel str[4] == 'U' || str[4] == 'P') 3872130803Smarcel return 1; 3873130803Smarcel if (str[4] == 'R' && str[5] != 'T') 3874130803Smarcel return 1; 3875130803Smarcel return 0; 3876130803Smarcel } 3877130803Smarcel for (k = 2; str[k] != '\0'; k += 1) 3878130803Smarcel if (!isdigit (str[k])) 3879130803Smarcel return 0; 3880130803Smarcel return 1; 3881130803Smarcel } 3882130803Smarcel if (str[0] == '$' && str[1] != '\000') 3883130803Smarcel { 3884130803Smarcel for (k = 1; str[k] != '\0'; k += 1) 3885130803Smarcel if (!isdigit (str[k])) 3886130803Smarcel return 0; 3887130803Smarcel return 1; 3888130803Smarcel } 3889130803Smarcel return 0; 3890130803Smarcel} 3891130803Smarcel 3892130803Smarcel/* True if NAME represents a name of the form A1.A2....An, n>=1 and 3893130803Smarcel * PATN[0..PATN_LEN-1] = Ak.Ak+1.....An for some k >= 1. Ignores 3894130803Smarcel * informational suffixes of NAME (i.e., for which is_name_suffix is 3895130803Smarcel * true). */ 3896130803Smarcelstatic int 3897130803Smarcelwild_match (const char *patn, int patn_len, const char *name) 3898130803Smarcel{ 3899130803Smarcel int name_len; 3900130803Smarcel int s, e; 3901130803Smarcel 3902130803Smarcel name_len = strlen (name); 3903130803Smarcel if (name_len >= patn_len + 5 && DEPRECATED_STREQN (name, "_ada_", 5) 3904130803Smarcel && DEPRECATED_STREQN (patn, name + 5, patn_len) 3905130803Smarcel && is_name_suffix (name + patn_len + 5)) 3906130803Smarcel return 1; 3907130803Smarcel 3908130803Smarcel while (name_len >= patn_len) 3909130803Smarcel { 3910130803Smarcel if (DEPRECATED_STREQN (patn, name, patn_len) && is_name_suffix (name + patn_len)) 3911130803Smarcel return 1; 3912130803Smarcel do 3913130803Smarcel { 3914130803Smarcel name += 1; 3915130803Smarcel name_len -= 1; 3916130803Smarcel } 3917130803Smarcel while (name_len > 0 3918130803Smarcel && name[0] != '.' && (name[0] != '_' || name[1] != '_')); 3919130803Smarcel if (name_len <= 0) 3920130803Smarcel return 0; 3921130803Smarcel if (name[0] == '_') 3922130803Smarcel { 3923130803Smarcel if (!islower (name[2])) 3924130803Smarcel return 0; 3925130803Smarcel name += 2; 3926130803Smarcel name_len -= 2; 3927130803Smarcel } 3928130803Smarcel else 3929130803Smarcel { 3930130803Smarcel if (!islower (name[1])) 3931130803Smarcel return 0; 3932130803Smarcel name += 1; 3933130803Smarcel name_len -= 1; 3934130803Smarcel } 3935130803Smarcel } 3936130803Smarcel 3937130803Smarcel return 0; 3938130803Smarcel} 3939130803Smarcel 3940130803Smarcel 3941130803Smarcel/* Add symbols from BLOCK matching identifier NAME in DOMAIN to 3942130803Smarcel vector *defn_symbols, updating *defn_symbols (if necessary), *SZ (the size of 3943130803Smarcel the vector *defn_symbols), and *ndefns (the number of symbols 3944130803Smarcel currently stored in *defn_symbols). If WILD, treat as NAME with a 3945130803Smarcel wildcard prefix. OBJFILE is the section containing BLOCK. */ 3946130803Smarcel 3947130803Smarcelstatic void 3948130803Smarcelada_add_block_symbols (struct block *block, const char *name, 3949130803Smarcel domain_enum domain, struct objfile *objfile, 3950130803Smarcel int wild) 3951130803Smarcel{ 3952130803Smarcel struct dict_iterator iter; 3953130803Smarcel int name_len = strlen (name); 3954130803Smarcel /* A matching argument symbol, if any. */ 3955130803Smarcel struct symbol *arg_sym; 3956130803Smarcel /* Set true when we find a matching non-argument symbol */ 3957130803Smarcel int found_sym; 3958130803Smarcel struct symbol *sym; 3959130803Smarcel 3960130803Smarcel arg_sym = NULL; 3961130803Smarcel found_sym = 0; 3962130803Smarcel if (wild) 3963130803Smarcel { 3964130803Smarcel struct symbol *sym; 3965130803Smarcel ALL_BLOCK_SYMBOLS (block, iter, sym) 3966130803Smarcel { 3967130803Smarcel if (SYMBOL_DOMAIN (sym) == domain && 3968130803Smarcel wild_match (name, name_len, DEPRECATED_SYMBOL_NAME (sym))) 3969130803Smarcel { 3970130803Smarcel switch (SYMBOL_CLASS (sym)) 3971130803Smarcel { 3972130803Smarcel case LOC_ARG: 3973130803Smarcel case LOC_LOCAL_ARG: 3974130803Smarcel case LOC_REF_ARG: 3975130803Smarcel case LOC_REGPARM: 3976130803Smarcel case LOC_REGPARM_ADDR: 3977130803Smarcel case LOC_BASEREG_ARG: 3978130803Smarcel case LOC_COMPUTED_ARG: 3979130803Smarcel arg_sym = sym; 3980130803Smarcel break; 3981130803Smarcel case LOC_UNRESOLVED: 3982130803Smarcel continue; 3983130803Smarcel default: 3984130803Smarcel found_sym = 1; 3985130803Smarcel fill_in_ada_prototype (sym); 3986130803Smarcel add_defn_to_vec (fixup_symbol_section (sym, objfile), block); 3987130803Smarcel break; 3988130803Smarcel } 3989130803Smarcel } 3990130803Smarcel } 3991130803Smarcel } 3992130803Smarcel else 3993130803Smarcel { 3994130803Smarcel ALL_BLOCK_SYMBOLS (block, iter, sym) 3995130803Smarcel { 3996130803Smarcel if (SYMBOL_DOMAIN (sym) == domain) 3997130803Smarcel { 3998130803Smarcel int cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (sym), name_len); 3999130803Smarcel 4000130803Smarcel if (cmp == 0 4001130803Smarcel && is_name_suffix (DEPRECATED_SYMBOL_NAME (sym) + name_len)) 4002130803Smarcel { 4003130803Smarcel switch (SYMBOL_CLASS (sym)) 4004130803Smarcel { 4005130803Smarcel case LOC_ARG: 4006130803Smarcel case LOC_LOCAL_ARG: 4007130803Smarcel case LOC_REF_ARG: 4008130803Smarcel case LOC_REGPARM: 4009130803Smarcel case LOC_REGPARM_ADDR: 4010130803Smarcel case LOC_BASEREG_ARG: 4011130803Smarcel case LOC_COMPUTED_ARG: 4012130803Smarcel arg_sym = sym; 4013130803Smarcel break; 4014130803Smarcel case LOC_UNRESOLVED: 4015130803Smarcel break; 4016130803Smarcel default: 4017130803Smarcel found_sym = 1; 4018130803Smarcel fill_in_ada_prototype (sym); 4019130803Smarcel add_defn_to_vec (fixup_symbol_section (sym, objfile), 4020130803Smarcel block); 4021130803Smarcel break; 4022130803Smarcel } 4023130803Smarcel } 4024130803Smarcel } 4025130803Smarcel } 4026130803Smarcel } 4027130803Smarcel 4028130803Smarcel if (!found_sym && arg_sym != NULL) 4029130803Smarcel { 4030130803Smarcel fill_in_ada_prototype (arg_sym); 4031130803Smarcel add_defn_to_vec (fixup_symbol_section (arg_sym, objfile), block); 4032130803Smarcel } 4033130803Smarcel 4034130803Smarcel if (!wild) 4035130803Smarcel { 4036130803Smarcel arg_sym = NULL; 4037130803Smarcel found_sym = 0; 4038130803Smarcel 4039130803Smarcel ALL_BLOCK_SYMBOLS (block, iter, sym) 4040130803Smarcel { 4041130803Smarcel if (SYMBOL_DOMAIN (sym) == domain) 4042130803Smarcel { 4043130803Smarcel int cmp; 4044130803Smarcel 4045130803Smarcel cmp = (int) '_' - (int) DEPRECATED_SYMBOL_NAME (sym)[0]; 4046130803Smarcel if (cmp == 0) 4047130803Smarcel { 4048130803Smarcel cmp = strncmp ("_ada_", DEPRECATED_SYMBOL_NAME (sym), 5); 4049130803Smarcel if (cmp == 0) 4050130803Smarcel cmp = strncmp (name, DEPRECATED_SYMBOL_NAME (sym) + 5, name_len); 4051130803Smarcel } 4052130803Smarcel 4053130803Smarcel if (cmp == 0 4054130803Smarcel && is_name_suffix (DEPRECATED_SYMBOL_NAME (sym) + name_len + 5)) 4055130803Smarcel { 4056130803Smarcel switch (SYMBOL_CLASS (sym)) 4057130803Smarcel { 4058130803Smarcel case LOC_ARG: 4059130803Smarcel case LOC_LOCAL_ARG: 4060130803Smarcel case LOC_REF_ARG: 4061130803Smarcel case LOC_REGPARM: 4062130803Smarcel case LOC_REGPARM_ADDR: 4063130803Smarcel case LOC_BASEREG_ARG: 4064130803Smarcel case LOC_COMPUTED_ARG: 4065130803Smarcel arg_sym = sym; 4066130803Smarcel break; 4067130803Smarcel case LOC_UNRESOLVED: 4068130803Smarcel break; 4069130803Smarcel default: 4070130803Smarcel found_sym = 1; 4071130803Smarcel fill_in_ada_prototype (sym); 4072130803Smarcel add_defn_to_vec (fixup_symbol_section (sym, objfile), 4073130803Smarcel block); 4074130803Smarcel break; 4075130803Smarcel } 4076130803Smarcel } 4077130803Smarcel } 4078130803Smarcel } 4079130803Smarcel 4080130803Smarcel /* NOTE: This really shouldn't be needed for _ada_ symbols. 4081130803Smarcel They aren't parameters, right? */ 4082130803Smarcel if (!found_sym && arg_sym != NULL) 4083130803Smarcel { 4084130803Smarcel fill_in_ada_prototype (arg_sym); 4085130803Smarcel add_defn_to_vec (fixup_symbol_section (arg_sym, objfile), block); 4086130803Smarcel } 4087130803Smarcel } 4088130803Smarcel} 4089130803Smarcel 4090130803Smarcel 4091130803Smarcel /* Function Types */ 4092130803Smarcel 4093130803Smarcel/* Assuming that SYM is the symbol for a function, fill in its type 4094130803Smarcel with prototype information, if it is not already there. */ 4095130803Smarcel 4096130803Smarcelstatic void 4097130803Smarcelfill_in_ada_prototype (struct symbol *func) 4098130803Smarcel{ 4099130803Smarcel struct block *b; 4100130803Smarcel int nargs, nsyms; 4101130803Smarcel struct dict_iterator iter; 4102130803Smarcel struct type *ftype; 4103130803Smarcel struct type *rtype; 4104130803Smarcel size_t max_fields; 4105130803Smarcel struct symbol *sym; 4106130803Smarcel 4107130803Smarcel if (func == NULL 4108130803Smarcel || TYPE_CODE (SYMBOL_TYPE (func)) != TYPE_CODE_FUNC 4109130803Smarcel || TYPE_FIELDS (SYMBOL_TYPE (func)) != NULL) 4110130803Smarcel return; 4111130803Smarcel 4112130803Smarcel /* We make each function type unique, so that each may have its own */ 4113130803Smarcel /* parameter types. This particular way of doing so wastes space: */ 4114130803Smarcel /* it would be nicer to build the argument types while the original */ 4115130803Smarcel /* function type is being built (FIXME). */ 4116130803Smarcel rtype = check_typedef (TYPE_TARGET_TYPE (SYMBOL_TYPE (func))); 4117130803Smarcel ftype = alloc_type (TYPE_OBJFILE (SYMBOL_TYPE (func))); 4118130803Smarcel make_function_type (rtype, &ftype); 4119130803Smarcel SYMBOL_TYPE (func) = ftype; 4120130803Smarcel 4121130803Smarcel b = SYMBOL_BLOCK_VALUE (func); 4122130803Smarcel 4123130803Smarcel nargs = 0; 4124130803Smarcel max_fields = 8; 4125130803Smarcel TYPE_FIELDS (ftype) = 4126130803Smarcel (struct field *) xmalloc (sizeof (struct field) * max_fields); 4127130803Smarcel ALL_BLOCK_SYMBOLS (b, iter, sym) 4128130803Smarcel { 4129130803Smarcel GROW_VECT (TYPE_FIELDS (ftype), max_fields, nargs + 1); 4130130803Smarcel 4131130803Smarcel switch (SYMBOL_CLASS (sym)) 4132130803Smarcel { 4133130803Smarcel case LOC_REF_ARG: 4134130803Smarcel case LOC_REGPARM_ADDR: 4135130803Smarcel TYPE_FIELD_BITPOS (ftype, nargs) = nargs; 4136130803Smarcel TYPE_FIELD_BITSIZE (ftype, nargs) = 0; 4137130803Smarcel TYPE_FIELD_STATIC_KIND (ftype, nargs) = 0; 4138130803Smarcel TYPE_FIELD_TYPE (ftype, nargs) = 4139130803Smarcel lookup_pointer_type (check_typedef (SYMBOL_TYPE (sym))); 4140130803Smarcel TYPE_FIELD_NAME (ftype, nargs) = DEPRECATED_SYMBOL_NAME (sym); 4141130803Smarcel nargs += 1; 4142130803Smarcel 4143130803Smarcel break; 4144130803Smarcel 4145130803Smarcel case LOC_ARG: 4146130803Smarcel case LOC_REGPARM: 4147130803Smarcel case LOC_LOCAL_ARG: 4148130803Smarcel case LOC_BASEREG_ARG: 4149130803Smarcel case LOC_COMPUTED_ARG: 4150130803Smarcel TYPE_FIELD_BITPOS (ftype, nargs) = nargs; 4151130803Smarcel TYPE_FIELD_BITSIZE (ftype, nargs) = 0; 4152130803Smarcel TYPE_FIELD_STATIC_KIND (ftype, nargs) = 0; 4153130803Smarcel TYPE_FIELD_TYPE (ftype, nargs) = check_typedef (SYMBOL_TYPE (sym)); 4154130803Smarcel TYPE_FIELD_NAME (ftype, nargs) = DEPRECATED_SYMBOL_NAME (sym); 4155130803Smarcel nargs += 1; 4156130803Smarcel 4157130803Smarcel break; 4158130803Smarcel 4159130803Smarcel default: 4160130803Smarcel break; 4161130803Smarcel } 4162130803Smarcel } 4163130803Smarcel 4164130803Smarcel /* Re-allocate fields vector; if there are no fields, make the */ 4165130803Smarcel /* fields pointer non-null anyway, to mark that this function type */ 4166130803Smarcel /* has been filled in. */ 4167130803Smarcel 4168130803Smarcel TYPE_NFIELDS (ftype) = nargs; 4169130803Smarcel if (nargs == 0) 4170130803Smarcel { 4171130803Smarcel static struct field dummy_field = { 0, 0, 0, 0 }; 4172130803Smarcel xfree (TYPE_FIELDS (ftype)); 4173130803Smarcel TYPE_FIELDS (ftype) = &dummy_field; 4174130803Smarcel } 4175130803Smarcel else 4176130803Smarcel { 4177130803Smarcel struct field *fields = 4178130803Smarcel (struct field *) TYPE_ALLOC (ftype, nargs * sizeof (struct field)); 4179130803Smarcel memcpy ((char *) fields, 4180130803Smarcel (char *) TYPE_FIELDS (ftype), nargs * sizeof (struct field)); 4181130803Smarcel xfree (TYPE_FIELDS (ftype)); 4182130803Smarcel TYPE_FIELDS (ftype) = fields; 4183130803Smarcel } 4184130803Smarcel} 4185130803Smarcel 4186130803Smarcel 4187130803Smarcel /* Breakpoint-related */ 4188130803Smarcel 4189130803Smarcelchar no_symtab_msg[] = 4190130803Smarcel "No symbol table is loaded. Use the \"file\" command."; 4191130803Smarcel 4192130803Smarcel/* Assuming that LINE is pointing at the beginning of an argument to 4193130803Smarcel 'break', return a pointer to the delimiter for the initial segment 4194130803Smarcel of that name. This is the first ':', ' ', or end of LINE. 4195130803Smarcel*/ 4196130803Smarcelchar * 4197130803Smarcelada_start_decode_line_1 (char *line) 4198130803Smarcel{ 4199130803Smarcel /* [NOTE: strpbrk would be more elegant, but I am reluctant to be 4200130803Smarcel the first to use such a library function in GDB code.] */ 4201130803Smarcel char *p; 4202130803Smarcel for (p = line; *p != '\000' && *p != ' ' && *p != ':'; p += 1) 4203130803Smarcel ; 4204130803Smarcel return p; 4205130803Smarcel} 4206130803Smarcel 4207130803Smarcel/* *SPEC points to a function and line number spec (as in a break 4208130803Smarcel command), following any initial file name specification. 4209130803Smarcel 4210130803Smarcel Return all symbol table/line specfications (sals) consistent with the 4211130803Smarcel information in *SPEC and FILE_TABLE in the 4212130803Smarcel following sense: 4213130803Smarcel + FILE_TABLE is null, or the sal refers to a line in the file 4214130803Smarcel named by FILE_TABLE. 4215130803Smarcel + If *SPEC points to an argument with a trailing ':LINENUM', 4216130803Smarcel then the sal refers to that line (or one following it as closely as 4217130803Smarcel possible). 4218130803Smarcel + If *SPEC does not start with '*', the sal is in a function with 4219130803Smarcel that name. 4220130803Smarcel 4221130803Smarcel Returns with 0 elements if no matching non-minimal symbols found. 4222130803Smarcel 4223130803Smarcel If *SPEC begins with a function name of the form <NAME>, then NAME 4224130803Smarcel is taken as a literal name; otherwise the function name is subject 4225130803Smarcel to the usual mangling. 4226130803Smarcel 4227130803Smarcel *SPEC is updated to point after the function/line number specification. 4228130803Smarcel 4229130803Smarcel FUNFIRSTLINE is non-zero if we desire the first line of real code 4230130803Smarcel in each function (this is ignored in the presence of a LINENUM spec.). 4231130803Smarcel 4232130803Smarcel If CANONICAL is non-NULL, and if any of the sals require a 4233130803Smarcel 'canonical line spec', then *CANONICAL is set to point to an array 4234130803Smarcel of strings, corresponding to and equal in length to the returned 4235130803Smarcel list of sals, such that (*CANONICAL)[i] is non-null and contains a 4236130803Smarcel canonical line spec for the ith returned sal, if needed. If no 4237130803Smarcel canonical line specs are required and CANONICAL is non-null, 4238130803Smarcel *CANONICAL is set to NULL. 4239130803Smarcel 4240130803Smarcel A 'canonical line spec' is simply a name (in the format of the 4241130803Smarcel breakpoint command) that uniquely identifies a breakpoint position, 4242130803Smarcel with no further contextual information or user selection. It is 4243130803Smarcel needed whenever the file name, function name, and line number 4244130803Smarcel information supplied is insufficient for this unique 4245130803Smarcel identification. Currently overloaded functions, the name '*', 4246130803Smarcel or static functions without a filename yield a canonical line spec. 4247130803Smarcel The array and the line spec strings are allocated on the heap; it 4248130803Smarcel is the caller's responsibility to free them. */ 4249130803Smarcel 4250130803Smarcelstruct symtabs_and_lines 4251130803Smarcelada_finish_decode_line_1 (char **spec, struct symtab *file_table, 4252130803Smarcel int funfirstline, char ***canonical) 4253130803Smarcel{ 4254130803Smarcel struct symbol **symbols; 4255130803Smarcel struct block **blocks; 4256130803Smarcel struct block *block; 4257130803Smarcel int n_matches, i, line_num; 4258130803Smarcel struct symtabs_and_lines selected; 4259130803Smarcel struct cleanup *old_chain = make_cleanup (null_cleanup, NULL); 4260130803Smarcel char *name; 4261130803Smarcel 4262130803Smarcel int len; 4263130803Smarcel char *lower_name; 4264130803Smarcel char *unquoted_name; 4265130803Smarcel 4266130803Smarcel if (file_table == NULL) 4267130803Smarcel block = get_selected_block (NULL); 4268130803Smarcel else 4269130803Smarcel block = BLOCKVECTOR_BLOCK (BLOCKVECTOR (file_table), STATIC_BLOCK); 4270130803Smarcel 4271130803Smarcel if (canonical != NULL) 4272130803Smarcel *canonical = (char **) NULL; 4273130803Smarcel 4274130803Smarcel name = *spec; 4275130803Smarcel if (**spec == '*') 4276130803Smarcel *spec += 1; 4277130803Smarcel else 4278130803Smarcel { 4279130803Smarcel while (**spec != '\000' && 4280130803Smarcel !strchr (ada_completer_word_break_characters, **spec)) 4281130803Smarcel *spec += 1; 4282130803Smarcel } 4283130803Smarcel len = *spec - name; 4284130803Smarcel 4285130803Smarcel line_num = -1; 4286130803Smarcel if (file_table != NULL && (*spec)[0] == ':' && isdigit ((*spec)[1])) 4287130803Smarcel { 4288130803Smarcel line_num = strtol (*spec + 1, spec, 10); 4289130803Smarcel while (**spec == ' ' || **spec == '\t') 4290130803Smarcel *spec += 1; 4291130803Smarcel } 4292130803Smarcel 4293130803Smarcel if (name[0] == '*') 4294130803Smarcel { 4295130803Smarcel if (line_num == -1) 4296130803Smarcel error ("Wild-card function with no line number or file name."); 4297130803Smarcel 4298130803Smarcel return all_sals_for_line (file_table->filename, line_num, canonical); 4299130803Smarcel } 4300130803Smarcel 4301130803Smarcel if (name[0] == '\'') 4302130803Smarcel { 4303130803Smarcel name += 1; 4304130803Smarcel len -= 2; 4305130803Smarcel } 4306130803Smarcel 4307130803Smarcel if (name[0] == '<') 4308130803Smarcel { 4309130803Smarcel unquoted_name = (char *) alloca (len - 1); 4310130803Smarcel memcpy (unquoted_name, name + 1, len - 2); 4311130803Smarcel unquoted_name[len - 2] = '\000'; 4312130803Smarcel lower_name = NULL; 4313130803Smarcel } 4314130803Smarcel else 4315130803Smarcel { 4316130803Smarcel unquoted_name = (char *) alloca (len + 1); 4317130803Smarcel memcpy (unquoted_name, name, len); 4318130803Smarcel unquoted_name[len] = '\000'; 4319130803Smarcel lower_name = (char *) alloca (len + 1); 4320130803Smarcel for (i = 0; i < len; i += 1) 4321130803Smarcel lower_name[i] = tolower (name[i]); 4322130803Smarcel lower_name[len] = '\000'; 4323130803Smarcel } 4324130803Smarcel 4325130803Smarcel n_matches = 0; 4326130803Smarcel if (lower_name != NULL) 4327130803Smarcel n_matches = ada_lookup_symbol_list (ada_mangle (lower_name), block, 4328130803Smarcel VAR_DOMAIN, &symbols, &blocks); 4329130803Smarcel if (n_matches == 0) 4330130803Smarcel n_matches = ada_lookup_symbol_list (unquoted_name, block, 4331130803Smarcel VAR_DOMAIN, &symbols, &blocks); 4332130803Smarcel if (n_matches == 0 && line_num >= 0) 4333130803Smarcel error ("No line number information found for %s.", unquoted_name); 4334130803Smarcel else if (n_matches == 0) 4335130803Smarcel { 4336130803Smarcel#ifdef HPPA_COMPILER_BUG 4337130803Smarcel /* FIXME: See comment in symtab.c::decode_line_1 */ 4338130803Smarcel#undef volatile 4339130803Smarcel volatile struct symtab_and_line val; 4340130803Smarcel#define volatile /*nothing */ 4341130803Smarcel#else 4342130803Smarcel struct symtab_and_line val; 4343130803Smarcel#endif 4344130803Smarcel struct minimal_symbol *msymbol; 4345130803Smarcel 4346130803Smarcel init_sal (&val); 4347130803Smarcel 4348130803Smarcel msymbol = NULL; 4349130803Smarcel if (lower_name != NULL) 4350130803Smarcel msymbol = ada_lookup_minimal_symbol (ada_mangle (lower_name)); 4351130803Smarcel if (msymbol == NULL) 4352130803Smarcel msymbol = ada_lookup_minimal_symbol (unquoted_name); 4353130803Smarcel if (msymbol != NULL) 4354130803Smarcel { 4355130803Smarcel val.pc = SYMBOL_VALUE_ADDRESS (msymbol); 4356130803Smarcel val.section = SYMBOL_BFD_SECTION (msymbol); 4357130803Smarcel if (funfirstline) 4358130803Smarcel { 4359130803Smarcel val.pc += FUNCTION_START_OFFSET; 4360130803Smarcel SKIP_PROLOGUE (val.pc); 4361130803Smarcel } 4362130803Smarcel selected.sals = (struct symtab_and_line *) 4363130803Smarcel xmalloc (sizeof (struct symtab_and_line)); 4364130803Smarcel selected.sals[0] = val; 4365130803Smarcel selected.nelts = 1; 4366130803Smarcel return selected; 4367130803Smarcel } 4368130803Smarcel 4369130803Smarcel if (!have_full_symbols () && 4370130803Smarcel !have_partial_symbols () && !have_minimal_symbols ()) 4371130803Smarcel error (no_symtab_msg); 4372130803Smarcel 4373130803Smarcel error ("Function \"%s\" not defined.", unquoted_name); 4374130803Smarcel return selected; /* for lint */ 4375130803Smarcel } 4376130803Smarcel 4377130803Smarcel if (line_num >= 0) 4378130803Smarcel { 4379130803Smarcel return 4380130803Smarcel find_sal_from_funcs_and_line (file_table->filename, line_num, 4381130803Smarcel symbols, n_matches); 4382130803Smarcel } 4383130803Smarcel else 4384130803Smarcel { 4385130803Smarcel selected.nelts = 4386130803Smarcel user_select_syms (symbols, blocks, n_matches, n_matches); 4387130803Smarcel } 4388130803Smarcel 4389130803Smarcel selected.sals = (struct symtab_and_line *) 4390130803Smarcel xmalloc (sizeof (struct symtab_and_line) * selected.nelts); 4391130803Smarcel memset (selected.sals, 0, selected.nelts * sizeof (selected.sals[i])); 4392130803Smarcel make_cleanup (xfree, selected.sals); 4393130803Smarcel 4394130803Smarcel i = 0; 4395130803Smarcel while (i < selected.nelts) 4396130803Smarcel { 4397130803Smarcel if (SYMBOL_CLASS (symbols[i]) == LOC_BLOCK) 4398130803Smarcel selected.sals[i] = find_function_start_sal (symbols[i], funfirstline); 4399130803Smarcel else if (SYMBOL_LINE (symbols[i]) != 0) 4400130803Smarcel { 4401130803Smarcel selected.sals[i].symtab = symtab_for_sym (symbols[i]); 4402130803Smarcel selected.sals[i].line = SYMBOL_LINE (symbols[i]); 4403130803Smarcel } 4404130803Smarcel else if (line_num >= 0) 4405130803Smarcel { 4406130803Smarcel /* Ignore this choice */ 4407130803Smarcel symbols[i] = symbols[selected.nelts - 1]; 4408130803Smarcel blocks[i] = blocks[selected.nelts - 1]; 4409130803Smarcel selected.nelts -= 1; 4410130803Smarcel continue; 4411130803Smarcel } 4412130803Smarcel else 4413130803Smarcel error ("Line number not known for symbol \"%s\"", unquoted_name); 4414130803Smarcel i += 1; 4415130803Smarcel } 4416130803Smarcel 4417130803Smarcel if (canonical != NULL && (line_num >= 0 || n_matches > 1)) 4418130803Smarcel { 4419130803Smarcel *canonical = (char **) xmalloc (sizeof (char *) * selected.nelts); 4420130803Smarcel for (i = 0; i < selected.nelts; i += 1) 4421130803Smarcel (*canonical)[i] = 4422130803Smarcel extended_canonical_line_spec (selected.sals[i], 4423130803Smarcel SYMBOL_PRINT_NAME (symbols[i])); 4424130803Smarcel } 4425130803Smarcel 4426130803Smarcel discard_cleanups (old_chain); 4427130803Smarcel return selected; 4428130803Smarcel} 4429130803Smarcel 4430130803Smarcel/* The (single) sal corresponding to line LINE_NUM in a symbol table 4431130803Smarcel with file name FILENAME that occurs in one of the functions listed 4432130803Smarcel in SYMBOLS[0 .. NSYMS-1]. */ 4433130803Smarcelstatic struct symtabs_and_lines 4434130803Smarcelfind_sal_from_funcs_and_line (const char *filename, int line_num, 4435130803Smarcel struct symbol **symbols, int nsyms) 4436130803Smarcel{ 4437130803Smarcel struct symtabs_and_lines sals; 4438130803Smarcel int best_index, best; 4439130803Smarcel struct linetable *best_linetable; 4440130803Smarcel struct objfile *objfile; 4441130803Smarcel struct symtab *s; 4442130803Smarcel struct symtab *best_symtab; 4443130803Smarcel 4444130803Smarcel read_all_symtabs (filename); 4445130803Smarcel 4446130803Smarcel best_index = 0; 4447130803Smarcel best_linetable = NULL; 4448130803Smarcel best_symtab = NULL; 4449130803Smarcel best = 0; 4450130803Smarcel ALL_SYMTABS (objfile, s) 4451130803Smarcel { 4452130803Smarcel struct linetable *l; 4453130803Smarcel int ind, exact; 4454130803Smarcel 4455130803Smarcel QUIT; 4456130803Smarcel 4457130803Smarcel if (!DEPRECATED_STREQ (filename, s->filename)) 4458130803Smarcel continue; 4459130803Smarcel l = LINETABLE (s); 4460130803Smarcel ind = find_line_in_linetable (l, line_num, symbols, nsyms, &exact); 4461130803Smarcel if (ind >= 0) 4462130803Smarcel { 4463130803Smarcel if (exact) 4464130803Smarcel { 4465130803Smarcel best_index = ind; 4466130803Smarcel best_linetable = l; 4467130803Smarcel best_symtab = s; 4468130803Smarcel goto done; 4469130803Smarcel } 4470130803Smarcel if (best == 0 || l->item[ind].line < best) 4471130803Smarcel { 4472130803Smarcel best = l->item[ind].line; 4473130803Smarcel best_index = ind; 4474130803Smarcel best_linetable = l; 4475130803Smarcel best_symtab = s; 4476130803Smarcel } 4477130803Smarcel } 4478130803Smarcel } 4479130803Smarcel 4480130803Smarcel if (best == 0) 4481130803Smarcel error ("Line number not found in designated function."); 4482130803Smarcel 4483130803Smarceldone: 4484130803Smarcel 4485130803Smarcel sals.nelts = 1; 4486130803Smarcel sals.sals = (struct symtab_and_line *) xmalloc (sizeof (sals.sals[0])); 4487130803Smarcel 4488130803Smarcel init_sal (&sals.sals[0]); 4489130803Smarcel 4490130803Smarcel sals.sals[0].line = best_linetable->item[best_index].line; 4491130803Smarcel sals.sals[0].pc = best_linetable->item[best_index].pc; 4492130803Smarcel sals.sals[0].symtab = best_symtab; 4493130803Smarcel 4494130803Smarcel return sals; 4495130803Smarcel} 4496130803Smarcel 4497130803Smarcel/* Return the index in LINETABLE of the best match for LINE_NUM whose 4498130803Smarcel pc falls within one of the functions denoted by SYMBOLS[0..NSYMS-1]. 4499130803Smarcel Set *EXACTP to the 1 if the match is exact, and 0 otherwise. */ 4500130803Smarcelstatic int 4501130803Smarcelfind_line_in_linetable (struct linetable *linetable, int line_num, 4502130803Smarcel struct symbol **symbols, int nsyms, int *exactp) 4503130803Smarcel{ 4504130803Smarcel int i, len, best_index, best; 4505130803Smarcel 4506130803Smarcel if (line_num <= 0 || linetable == NULL) 4507130803Smarcel return -1; 4508130803Smarcel 4509130803Smarcel len = linetable->nitems; 4510130803Smarcel for (i = 0, best_index = -1, best = 0; i < len; i += 1) 4511130803Smarcel { 4512130803Smarcel int k; 4513130803Smarcel struct linetable_entry *item = &(linetable->item[i]); 4514130803Smarcel 4515130803Smarcel for (k = 0; k < nsyms; k += 1) 4516130803Smarcel { 4517130803Smarcel if (symbols[k] != NULL && SYMBOL_CLASS (symbols[k]) == LOC_BLOCK 4518130803Smarcel && item->pc >= BLOCK_START (SYMBOL_BLOCK_VALUE (symbols[k])) 4519130803Smarcel && item->pc < BLOCK_END (SYMBOL_BLOCK_VALUE (symbols[k]))) 4520130803Smarcel goto candidate; 4521130803Smarcel } 4522130803Smarcel continue; 4523130803Smarcel 4524130803Smarcel candidate: 4525130803Smarcel 4526130803Smarcel if (item->line == line_num) 4527130803Smarcel { 4528130803Smarcel *exactp = 1; 4529130803Smarcel return i; 4530130803Smarcel } 4531130803Smarcel 4532130803Smarcel if (item->line > line_num && (best == 0 || item->line < best)) 4533130803Smarcel { 4534130803Smarcel best = item->line; 4535130803Smarcel best_index = i; 4536130803Smarcel } 4537130803Smarcel } 4538130803Smarcel 4539130803Smarcel *exactp = 0; 4540130803Smarcel return best_index; 4541130803Smarcel} 4542130803Smarcel 4543130803Smarcel/* Find the smallest k >= LINE_NUM such that k is a line number in 4544130803Smarcel LINETABLE, and k falls strictly within a named function that begins at 4545130803Smarcel or before LINE_NUM. Return -1 if there is no such k. */ 4546130803Smarcelstatic int 4547130803Smarcelnearest_line_number_in_linetable (struct linetable *linetable, int line_num) 4548130803Smarcel{ 4549130803Smarcel int i, len, best; 4550130803Smarcel 4551130803Smarcel if (line_num <= 0 || linetable == NULL || linetable->nitems == 0) 4552130803Smarcel return -1; 4553130803Smarcel len = linetable->nitems; 4554130803Smarcel 4555130803Smarcel i = 0; 4556130803Smarcel best = INT_MAX; 4557130803Smarcel while (i < len) 4558130803Smarcel { 4559130803Smarcel int k; 4560130803Smarcel struct linetable_entry *item = &(linetable->item[i]); 4561130803Smarcel 4562130803Smarcel if (item->line >= line_num && item->line < best) 4563130803Smarcel { 4564130803Smarcel char *func_name; 4565130803Smarcel CORE_ADDR start, end; 4566130803Smarcel 4567130803Smarcel func_name = NULL; 4568130803Smarcel find_pc_partial_function (item->pc, &func_name, &start, &end); 4569130803Smarcel 4570130803Smarcel if (func_name != NULL && item->pc < end) 4571130803Smarcel { 4572130803Smarcel if (item->line == line_num) 4573130803Smarcel return line_num; 4574130803Smarcel else 4575130803Smarcel { 4576130803Smarcel struct symbol *sym = 4577130803Smarcel standard_lookup (func_name, VAR_DOMAIN); 4578130803Smarcel if (is_plausible_func_for_line (sym, line_num)) 4579130803Smarcel best = item->line; 4580130803Smarcel else 4581130803Smarcel { 4582130803Smarcel do 4583130803Smarcel i += 1; 4584130803Smarcel while (i < len && linetable->item[i].pc < end); 4585130803Smarcel continue; 4586130803Smarcel } 4587130803Smarcel } 4588130803Smarcel } 4589130803Smarcel } 4590130803Smarcel 4591130803Smarcel i += 1; 4592130803Smarcel } 4593130803Smarcel 4594130803Smarcel return (best == INT_MAX) ? -1 : best; 4595130803Smarcel} 4596130803Smarcel 4597130803Smarcel 4598130803Smarcel/* Return the next higher index, k, into LINETABLE such that k > IND, 4599130803Smarcel entry k in LINETABLE has a line number equal to LINE_NUM, k 4600130803Smarcel corresponds to a PC that is in a function different from that 4601130803Smarcel corresponding to IND, and falls strictly within a named function 4602130803Smarcel that begins at a line at or preceding STARTING_LINE. 4603130803Smarcel Return -1 if there is no such k. 4604130803Smarcel IND == -1 corresponds to no function. */ 4605130803Smarcel 4606130803Smarcelstatic int 4607130803Smarcelfind_next_line_in_linetable (struct linetable *linetable, int line_num, 4608130803Smarcel int starting_line, int ind) 4609130803Smarcel{ 4610130803Smarcel int i, len; 4611130803Smarcel 4612130803Smarcel if (line_num <= 0 || linetable == NULL || ind >= linetable->nitems) 4613130803Smarcel return -1; 4614130803Smarcel len = linetable->nitems; 4615130803Smarcel 4616130803Smarcel if (ind >= 0) 4617130803Smarcel { 4618130803Smarcel CORE_ADDR start, end; 4619130803Smarcel 4620130803Smarcel if (find_pc_partial_function (linetable->item[ind].pc, 4621130803Smarcel (char **) NULL, &start, &end)) 4622130803Smarcel { 4623130803Smarcel while (ind < len && linetable->item[ind].pc < end) 4624130803Smarcel ind += 1; 4625130803Smarcel } 4626130803Smarcel else 4627130803Smarcel ind += 1; 4628130803Smarcel } 4629130803Smarcel else 4630130803Smarcel ind = 0; 4631130803Smarcel 4632130803Smarcel i = ind; 4633130803Smarcel while (i < len) 4634130803Smarcel { 4635130803Smarcel int k; 4636130803Smarcel struct linetable_entry *item = &(linetable->item[i]); 4637130803Smarcel 4638130803Smarcel if (item->line >= line_num) 4639130803Smarcel { 4640130803Smarcel char *func_name; 4641130803Smarcel CORE_ADDR start, end; 4642130803Smarcel 4643130803Smarcel func_name = NULL; 4644130803Smarcel find_pc_partial_function (item->pc, &func_name, &start, &end); 4645130803Smarcel 4646130803Smarcel if (func_name != NULL && item->pc < end) 4647130803Smarcel { 4648130803Smarcel if (item->line == line_num) 4649130803Smarcel { 4650130803Smarcel struct symbol *sym = 4651130803Smarcel standard_lookup (func_name, VAR_DOMAIN); 4652130803Smarcel if (is_plausible_func_for_line (sym, starting_line)) 4653130803Smarcel return i; 4654130803Smarcel else 4655130803Smarcel { 4656130803Smarcel while ((i + 1) < len && linetable->item[i + 1].pc < end) 4657130803Smarcel i += 1; 4658130803Smarcel } 4659130803Smarcel } 4660130803Smarcel } 4661130803Smarcel } 4662130803Smarcel i += 1; 4663130803Smarcel } 4664130803Smarcel 4665130803Smarcel return -1; 4666130803Smarcel} 4667130803Smarcel 4668130803Smarcel/* True iff function symbol SYM starts somewhere at or before line # 4669130803Smarcel LINE_NUM. */ 4670130803Smarcelstatic int 4671130803Smarcelis_plausible_func_for_line (struct symbol *sym, int line_num) 4672130803Smarcel{ 4673130803Smarcel struct symtab_and_line start_sal; 4674130803Smarcel 4675130803Smarcel if (sym == NULL) 4676130803Smarcel return 0; 4677130803Smarcel 4678130803Smarcel start_sal = find_function_start_sal (sym, 0); 4679130803Smarcel 4680130803Smarcel return (start_sal.line != 0 && line_num >= start_sal.line); 4681130803Smarcel} 4682130803Smarcel 4683130803Smarcelstatic void 4684130803Smarceldebug_print_lines (struct linetable *lt) 4685130803Smarcel{ 4686130803Smarcel int i; 4687130803Smarcel 4688130803Smarcel if (lt == NULL) 4689130803Smarcel return; 4690130803Smarcel 4691130803Smarcel fprintf (stderr, "\t"); 4692130803Smarcel for (i = 0; i < lt->nitems; i += 1) 4693130803Smarcel fprintf (stderr, "(%d->%p) ", lt->item[i].line, (void *) lt->item[i].pc); 4694130803Smarcel fprintf (stderr, "\n"); 4695130803Smarcel} 4696130803Smarcel 4697130803Smarcelstatic void 4698130803Smarceldebug_print_block (struct block *b) 4699130803Smarcel{ 4700130803Smarcel struct dict_iterator iter; 4701130803Smarcel struct symbol *sym; 4702130803Smarcel 4703130803Smarcel fprintf (stderr, "Block: %p; [0x%lx, 0x%lx]", 4704130803Smarcel b, BLOCK_START (b), BLOCK_END (b)); 4705130803Smarcel if (BLOCK_FUNCTION (b) != NULL) 4706130803Smarcel fprintf (stderr, " Function: %s", DEPRECATED_SYMBOL_NAME (BLOCK_FUNCTION (b))); 4707130803Smarcel fprintf (stderr, "\n"); 4708130803Smarcel fprintf (stderr, "\t Superblock: %p\n", BLOCK_SUPERBLOCK (b)); 4709130803Smarcel fprintf (stderr, "\t Symbols:"); 4710130803Smarcel ALL_BLOCK_SYMBOLS (b, iter, sym) 4711130803Smarcel { 4712130803Smarcel fprintf (stderr, " %s", DEPRECATED_SYMBOL_NAME (sym)); 4713130803Smarcel } 4714130803Smarcel fprintf (stderr, "\n"); 4715130803Smarcel} 4716130803Smarcel 4717130803Smarcelstatic void 4718130803Smarceldebug_print_blocks (struct blockvector *bv) 4719130803Smarcel{ 4720130803Smarcel int i; 4721130803Smarcel 4722130803Smarcel if (bv == NULL) 4723130803Smarcel return; 4724130803Smarcel for (i = 0; i < BLOCKVECTOR_NBLOCKS (bv); i += 1) 4725130803Smarcel { 4726130803Smarcel fprintf (stderr, "%6d. ", i); 4727130803Smarcel debug_print_block (BLOCKVECTOR_BLOCK (bv, i)); 4728130803Smarcel } 4729130803Smarcel} 4730130803Smarcel 4731130803Smarcelstatic void 4732130803Smarceldebug_print_symtab (struct symtab *s) 4733130803Smarcel{ 4734130803Smarcel fprintf (stderr, "Symtab %p\n File: %s; Dir: %s\n", s, 4735130803Smarcel s->filename, s->dirname); 4736130803Smarcel fprintf (stderr, " Blockvector: %p, Primary: %d\n", 4737130803Smarcel BLOCKVECTOR (s), s->primary); 4738130803Smarcel debug_print_blocks (BLOCKVECTOR (s)); 4739130803Smarcel fprintf (stderr, " Line table: %p\n", LINETABLE (s)); 4740130803Smarcel debug_print_lines (LINETABLE (s)); 4741130803Smarcel} 4742130803Smarcel 4743130803Smarcel/* Read in all symbol tables corresponding to partial symbol tables 4744130803Smarcel with file name FILENAME. */ 4745130803Smarcelstatic void 4746130803Smarcelread_all_symtabs (const char *filename) 4747130803Smarcel{ 4748130803Smarcel struct partial_symtab *ps; 4749130803Smarcel struct objfile *objfile; 4750130803Smarcel 4751130803Smarcel ALL_PSYMTABS (objfile, ps) 4752130803Smarcel { 4753130803Smarcel QUIT; 4754130803Smarcel 4755130803Smarcel if (DEPRECATED_STREQ (filename, ps->filename)) 4756130803Smarcel PSYMTAB_TO_SYMTAB (ps); 4757130803Smarcel } 4758130803Smarcel} 4759130803Smarcel 4760130803Smarcel/* All sals corresponding to line LINE_NUM in a symbol table from file 4761130803Smarcel FILENAME, as filtered by the user. If CANONICAL is not null, set 4762130803Smarcel it to a corresponding array of canonical line specs. */ 4763130803Smarcelstatic struct symtabs_and_lines 4764130803Smarcelall_sals_for_line (const char *filename, int line_num, char ***canonical) 4765130803Smarcel{ 4766130803Smarcel struct symtabs_and_lines result; 4767130803Smarcel struct objfile *objfile; 4768130803Smarcel struct symtab *s; 4769130803Smarcel struct cleanup *old_chain = make_cleanup (null_cleanup, NULL); 4770130803Smarcel size_t len; 4771130803Smarcel 4772130803Smarcel read_all_symtabs (filename); 4773130803Smarcel 4774130803Smarcel result.sals = 4775130803Smarcel (struct symtab_and_line *) xmalloc (4 * sizeof (result.sals[0])); 4776130803Smarcel result.nelts = 0; 4777130803Smarcel len = 4; 4778130803Smarcel make_cleanup (free_current_contents, &result.sals); 4779130803Smarcel 4780130803Smarcel ALL_SYMTABS (objfile, s) 4781130803Smarcel { 4782130803Smarcel int ind, target_line_num; 4783130803Smarcel 4784130803Smarcel QUIT; 4785130803Smarcel 4786130803Smarcel if (!DEPRECATED_STREQ (s->filename, filename)) 4787130803Smarcel continue; 4788130803Smarcel 4789130803Smarcel target_line_num = 4790130803Smarcel nearest_line_number_in_linetable (LINETABLE (s), line_num); 4791130803Smarcel if (target_line_num == -1) 4792130803Smarcel continue; 4793130803Smarcel 4794130803Smarcel ind = -1; 4795130803Smarcel while (1) 4796130803Smarcel { 4797130803Smarcel ind = 4798130803Smarcel find_next_line_in_linetable (LINETABLE (s), 4799130803Smarcel target_line_num, line_num, ind); 4800130803Smarcel 4801130803Smarcel if (ind < 0) 4802130803Smarcel break; 4803130803Smarcel 4804130803Smarcel GROW_VECT (result.sals, len, result.nelts + 1); 4805130803Smarcel init_sal (&result.sals[result.nelts]); 4806130803Smarcel result.sals[result.nelts].line = LINETABLE (s)->item[ind].line; 4807130803Smarcel result.sals[result.nelts].pc = LINETABLE (s)->item[ind].pc; 4808130803Smarcel result.sals[result.nelts].symtab = s; 4809130803Smarcel result.nelts += 1; 4810130803Smarcel } 4811130803Smarcel } 4812130803Smarcel 4813130803Smarcel if (canonical != NULL || result.nelts > 1) 4814130803Smarcel { 4815130803Smarcel int k; 4816130803Smarcel char **func_names = (char **) alloca (result.nelts * sizeof (char *)); 4817130803Smarcel int first_choice = (result.nelts > 1) ? 2 : 1; 4818130803Smarcel int n; 4819130803Smarcel int *choices = (int *) alloca (result.nelts * sizeof (int)); 4820130803Smarcel 4821130803Smarcel for (k = 0; k < result.nelts; k += 1) 4822130803Smarcel { 4823130803Smarcel find_pc_partial_function (result.sals[k].pc, &func_names[k], 4824130803Smarcel (CORE_ADDR *) NULL, (CORE_ADDR *) NULL); 4825130803Smarcel if (func_names[k] == NULL) 4826130803Smarcel error ("Could not find function for one or more breakpoints."); 4827130803Smarcel } 4828130803Smarcel 4829130803Smarcel if (result.nelts > 1) 4830130803Smarcel { 4831130803Smarcel printf_unfiltered ("[0] cancel\n"); 4832130803Smarcel if (result.nelts > 1) 4833130803Smarcel printf_unfiltered ("[1] all\n"); 4834130803Smarcel for (k = 0; k < result.nelts; k += 1) 4835130803Smarcel printf_unfiltered ("[%d] %s\n", k + first_choice, 4836130803Smarcel ada_demangle (func_names[k])); 4837130803Smarcel 4838130803Smarcel n = get_selections (choices, result.nelts, result.nelts, 4839130803Smarcel result.nelts > 1, "instance-choice"); 4840130803Smarcel 4841130803Smarcel for (k = 0; k < n; k += 1) 4842130803Smarcel { 4843130803Smarcel result.sals[k] = result.sals[choices[k]]; 4844130803Smarcel func_names[k] = func_names[choices[k]]; 4845130803Smarcel } 4846130803Smarcel result.nelts = n; 4847130803Smarcel } 4848130803Smarcel 4849130803Smarcel if (canonical != NULL) 4850130803Smarcel { 4851130803Smarcel *canonical = (char **) xmalloc (result.nelts * sizeof (char **)); 4852130803Smarcel make_cleanup (xfree, *canonical); 4853130803Smarcel for (k = 0; k < result.nelts; k += 1) 4854130803Smarcel { 4855130803Smarcel (*canonical)[k] = 4856130803Smarcel extended_canonical_line_spec (result.sals[k], func_names[k]); 4857130803Smarcel if ((*canonical)[k] == NULL) 4858130803Smarcel error ("Could not locate one or more breakpoints."); 4859130803Smarcel make_cleanup (xfree, (*canonical)[k]); 4860130803Smarcel } 4861130803Smarcel } 4862130803Smarcel } 4863130803Smarcel 4864130803Smarcel discard_cleanups (old_chain); 4865130803Smarcel return result; 4866130803Smarcel} 4867130803Smarcel 4868130803Smarcel 4869130803Smarcel/* A canonical line specification of the form FILE:NAME:LINENUM for 4870130803Smarcel symbol table and line data SAL. NULL if insufficient 4871130803Smarcel information. The caller is responsible for releasing any space 4872130803Smarcel allocated. */ 4873130803Smarcel 4874130803Smarcelstatic char * 4875130803Smarcelextended_canonical_line_spec (struct symtab_and_line sal, const char *name) 4876130803Smarcel{ 4877130803Smarcel char *r; 4878130803Smarcel 4879130803Smarcel if (sal.symtab == NULL || sal.symtab->filename == NULL || sal.line <= 0) 4880130803Smarcel return NULL; 4881130803Smarcel 4882130803Smarcel r = (char *) xmalloc (strlen (name) + strlen (sal.symtab->filename) 4883130803Smarcel + sizeof (sal.line) * 3 + 3); 4884130803Smarcel sprintf (r, "%s:'%s':%d", sal.symtab->filename, name, sal.line); 4885130803Smarcel return r; 4886130803Smarcel} 4887130803Smarcel 4888130803Smarcel#if 0 4889130803Smarcelint begin_bnum = -1; 4890130803Smarcel#endif 4891130803Smarcelint begin_annotate_level = 0; 4892130803Smarcel 4893130803Smarcelstatic void 4894130803Smarcelbegin_cleanup (void *dummy) 4895130803Smarcel{ 4896130803Smarcel begin_annotate_level = 0; 4897130803Smarcel} 4898130803Smarcel 4899130803Smarcelstatic void 4900130803Smarcelbegin_command (char *args, int from_tty) 4901130803Smarcel{ 4902130803Smarcel struct minimal_symbol *msym; 4903130803Smarcel CORE_ADDR main_program_name_addr; 4904130803Smarcel char main_program_name[1024]; 4905130803Smarcel struct cleanup *old_chain = make_cleanup (begin_cleanup, NULL); 4906130803Smarcel begin_annotate_level = 2; 4907130803Smarcel 4908130803Smarcel /* Check that there is a program to debug */ 4909130803Smarcel if (!have_full_symbols () && !have_partial_symbols ()) 4910130803Smarcel error ("No symbol table is loaded. Use the \"file\" command."); 4911130803Smarcel 4912130803Smarcel /* Check that we are debugging an Ada program */ 4913130803Smarcel /* if (ada_update_initial_language (language_unknown, NULL) != language_ada) 4914130803Smarcel error ("Cannot find the Ada initialization procedure. Is this an Ada main program?"); 4915130803Smarcel */ 4916130803Smarcel /* FIXME: language_ada should be defined in defs.h */ 4917130803Smarcel 4918130803Smarcel /* Get the address of the name of the main procedure */ 4919130803Smarcel msym = lookup_minimal_symbol (ADA_MAIN_PROGRAM_SYMBOL_NAME, NULL, NULL); 4920130803Smarcel 4921130803Smarcel if (msym != NULL) 4922130803Smarcel { 4923130803Smarcel main_program_name_addr = SYMBOL_VALUE_ADDRESS (msym); 4924130803Smarcel if (main_program_name_addr == 0) 4925130803Smarcel error ("Invalid address for Ada main program name."); 4926130803Smarcel 4927130803Smarcel /* Read the name of the main procedure */ 4928130803Smarcel extract_string (main_program_name_addr, main_program_name); 4929130803Smarcel 4930130803Smarcel /* Put a temporary breakpoint in the Ada main program and run */ 4931130803Smarcel do_command ("tbreak ", main_program_name, 0); 4932130803Smarcel do_command ("run ", args, 0); 4933130803Smarcel } 4934130803Smarcel else 4935130803Smarcel { 4936130803Smarcel /* If we could not find the symbol containing the name of the 4937130803Smarcel main program, that means that the compiler that was used to build 4938130803Smarcel was not recent enough. In that case, we fallback to the previous 4939130803Smarcel mechanism, which is a little bit less reliable, but has proved to work 4940130803Smarcel in most cases. The only cases where it will fail is when the user 4941130803Smarcel has set some breakpoints which will be hit before the end of the 4942130803Smarcel begin command processing (eg in the initialization code). 4943130803Smarcel 4944130803Smarcel The begining of the main Ada subprogram is located by breaking 4945130803Smarcel on the adainit procedure. Since we know that the binder generates 4946130803Smarcel the call to this procedure exactly 2 calls before the call to the 4947130803Smarcel Ada main subprogram, it is then easy to put a breakpoint on this 4948130803Smarcel Ada main subprogram once we hit adainit. 4949130803Smarcel */ 4950130803Smarcel do_command ("tbreak adainit", 0); 4951130803Smarcel do_command ("run ", args, 0); 4952130803Smarcel do_command ("up", 0); 4953130803Smarcel do_command ("tbreak +2", 0); 4954130803Smarcel do_command ("continue", 0); 4955130803Smarcel do_command ("step", 0); 4956130803Smarcel } 4957130803Smarcel 4958130803Smarcel do_cleanups (old_chain); 4959130803Smarcel} 4960130803Smarcel 4961130803Smarcelint 4962130803Smarcelis_ada_runtime_file (char *filename) 4963130803Smarcel{ 4964130803Smarcel return (DEPRECATED_STREQN (filename, "s-", 2) || 4965130803Smarcel DEPRECATED_STREQN (filename, "a-", 2) || 4966130803Smarcel DEPRECATED_STREQN (filename, "g-", 2) || DEPRECATED_STREQN (filename, "i-", 2)); 4967130803Smarcel} 4968130803Smarcel 4969130803Smarcel/* find the first frame that contains debugging information and that is not 4970130803Smarcel part of the Ada run-time, starting from fi and moving upward. */ 4971130803Smarcel 4972130803Smarcelint 4973130803Smarcelfind_printable_frame (struct frame_info *fi, int level) 4974130803Smarcel{ 4975130803Smarcel struct symtab_and_line sal; 4976130803Smarcel 4977130803Smarcel for (; fi != NULL; level += 1, fi = get_prev_frame (fi)) 4978130803Smarcel { 4979130803Smarcel find_frame_sal (fi, &sal); 4980130803Smarcel if (sal.symtab && !is_ada_runtime_file (sal.symtab->filename)) 4981130803Smarcel { 4982130803Smarcel#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET) 4983130803Smarcel /* libpthread.so contains some debugging information that prevents us 4984130803Smarcel from finding the right frame */ 4985130803Smarcel 4986130803Smarcel if (sal.symtab->objfile && 4987130803Smarcel DEPRECATED_STREQ (sal.symtab->objfile->name, "/usr/shlib/libpthread.so")) 4988130803Smarcel continue; 4989130803Smarcel#endif 4990130803Smarcel deprecated_selected_frame = fi; 4991130803Smarcel break; 4992130803Smarcel } 4993130803Smarcel } 4994130803Smarcel 4995130803Smarcel return level; 4996130803Smarcel} 4997130803Smarcel 4998130803Smarcelvoid 4999130803Smarcelada_report_exception_break (struct breakpoint *b) 5000130803Smarcel{ 5001130803Smarcel /* FIXME: break_on_exception should be defined in breakpoint.h */ 5002130803Smarcel /* if (b->break_on_exception == 1) 5003130803Smarcel { 5004130803Smarcel /* Assume that cond has 16 elements, the 15th 5005130803Smarcel being the exception *//* 5006130803Smarcel if (b->cond && b->cond->nelts == 16) 5007130803Smarcel { 5008130803Smarcel ui_out_text (uiout, "on "); 5009130803Smarcel ui_out_field_string (uiout, "exception", 5010130803Smarcel SYMBOL_NAME (b->cond->elts[14].symbol)); 5011130803Smarcel } 5012130803Smarcel else 5013130803Smarcel ui_out_text (uiout, "on all exceptions"); 5014130803Smarcel } 5015130803Smarcel else if (b->break_on_exception == 2) 5016130803Smarcel ui_out_text (uiout, "on unhandled exception"); 5017130803Smarcel else if (b->break_on_exception == 3) 5018130803Smarcel ui_out_text (uiout, "on assert failure"); 5019130803Smarcel #else 5020130803Smarcel if (b->break_on_exception == 1) 5021130803Smarcel { */ 5022130803Smarcel /* Assume that cond has 16 elements, the 15th 5023130803Smarcel being the exception *//* 5024130803Smarcel if (b->cond && b->cond->nelts == 16) 5025130803Smarcel { 5026130803Smarcel fputs_filtered ("on ", gdb_stdout); 5027130803Smarcel fputs_filtered (SYMBOL_NAME 5028130803Smarcel (b->cond->elts[14].symbol), gdb_stdout); 5029130803Smarcel } 5030130803Smarcel else 5031130803Smarcel fputs_filtered ("on all exceptions", gdb_stdout); 5032130803Smarcel } 5033130803Smarcel else if (b->break_on_exception == 2) 5034130803Smarcel fputs_filtered ("on unhandled exception", gdb_stdout); 5035130803Smarcel else if (b->break_on_exception == 3) 5036130803Smarcel fputs_filtered ("on assert failure", gdb_stdout); 5037130803Smarcel */ 5038130803Smarcel} 5039130803Smarcel 5040130803Smarcelint 5041130803Smarcelada_is_exception_sym (struct symbol *sym) 5042130803Smarcel{ 5043130803Smarcel char *type_name = type_name_no_tag (SYMBOL_TYPE (sym)); 5044130803Smarcel 5045130803Smarcel return (SYMBOL_CLASS (sym) != LOC_TYPEDEF 5046130803Smarcel && SYMBOL_CLASS (sym) != LOC_BLOCK 5047130803Smarcel && SYMBOL_CLASS (sym) != LOC_CONST 5048130803Smarcel && type_name != NULL && DEPRECATED_STREQ (type_name, "exception")); 5049130803Smarcel} 5050130803Smarcel 5051130803Smarcelint 5052130803Smarcelada_maybe_exception_partial_symbol (struct partial_symbol *sym) 5053130803Smarcel{ 5054130803Smarcel return (SYMBOL_CLASS (sym) != LOC_TYPEDEF 5055130803Smarcel && SYMBOL_CLASS (sym) != LOC_BLOCK 5056130803Smarcel && SYMBOL_CLASS (sym) != LOC_CONST); 5057130803Smarcel} 5058130803Smarcel 5059130803Smarcel/* If ARG points to an Ada exception or assert breakpoint, rewrite 5060130803Smarcel into equivalent form. Return resulting argument string. Set 5061130803Smarcel *BREAK_ON_EXCEPTIONP to 1 for ordinary break on exception, 2 for 5062130803Smarcel break on unhandled, 3 for assert, 0 otherwise. */ 5063130803Smarcelchar * 5064130803Smarcelada_breakpoint_rewrite (char *arg, int *break_on_exceptionp) 5065130803Smarcel{ 5066130803Smarcel if (arg == NULL) 5067130803Smarcel return arg; 5068130803Smarcel *break_on_exceptionp = 0; 5069130803Smarcel /* FIXME: language_ada should be defined in defs.h */ 5070130803Smarcel /* if (current_language->la_language == language_ada 5071130803Smarcel && DEPRECATED_STREQN (arg, "exception", 9) && 5072130803Smarcel (arg[9] == ' ' || arg[9] == '\t' || arg[9] == '\0')) 5073130803Smarcel { 5074130803Smarcel char *tok, *end_tok; 5075130803Smarcel int toklen; 5076130803Smarcel 5077130803Smarcel *break_on_exceptionp = 1; 5078130803Smarcel 5079130803Smarcel tok = arg+9; 5080130803Smarcel while (*tok == ' ' || *tok == '\t') 5081130803Smarcel tok += 1; 5082130803Smarcel 5083130803Smarcel end_tok = tok; 5084130803Smarcel 5085130803Smarcel while (*end_tok != ' ' && *end_tok != '\t' && *end_tok != '\000') 5086130803Smarcel end_tok += 1; 5087130803Smarcel 5088130803Smarcel toklen = end_tok - tok; 5089130803Smarcel 5090130803Smarcel arg = (char*) xmalloc (sizeof ("__gnat_raise_nodefer_with_msg if " 5091130803Smarcel "long_integer(e) = long_integer(&)") 5092130803Smarcel + toklen + 1); 5093130803Smarcel make_cleanup (xfree, arg); 5094130803Smarcel if (toklen == 0) 5095130803Smarcel strcpy (arg, "__gnat_raise_nodefer_with_msg"); 5096130803Smarcel else if (DEPRECATED_STREQN (tok, "unhandled", toklen)) 5097130803Smarcel { 5098130803Smarcel *break_on_exceptionp = 2; 5099130803Smarcel strcpy (arg, "__gnat_unhandled_exception"); 5100130803Smarcel } 5101130803Smarcel else 5102130803Smarcel { 5103130803Smarcel sprintf (arg, "__gnat_raise_nodefer_with_msg if " 5104130803Smarcel "long_integer(e) = long_integer(&%.*s)", 5105130803Smarcel toklen, tok); 5106130803Smarcel } 5107130803Smarcel } 5108130803Smarcel else if (current_language->la_language == language_ada 5109130803Smarcel && DEPRECATED_STREQN (arg, "assert", 6) && 5110130803Smarcel (arg[6] == ' ' || arg[6] == '\t' || arg[6] == '\0')) 5111130803Smarcel { 5112130803Smarcel char *tok = arg + 6; 5113130803Smarcel 5114130803Smarcel *break_on_exceptionp = 3; 5115130803Smarcel 5116130803Smarcel arg = (char*) 5117130803Smarcel xmalloc (sizeof ("system__assertions__raise_assert_failure") 5118130803Smarcel + strlen (tok) + 1); 5119130803Smarcel make_cleanup (xfree, arg); 5120130803Smarcel sprintf (arg, "system__assertions__raise_assert_failure%s", tok); 5121130803Smarcel } 5122130803Smarcel */ 5123130803Smarcel return arg; 5124130803Smarcel} 5125130803Smarcel 5126130803Smarcel 5127130803Smarcel /* Field Access */ 5128130803Smarcel 5129130803Smarcel/* True if field number FIELD_NUM in struct or union type TYPE is supposed 5130130803Smarcel to be invisible to users. */ 5131130803Smarcel 5132130803Smarcelint 5133130803Smarcelada_is_ignored_field (struct type *type, int field_num) 5134130803Smarcel{ 5135130803Smarcel if (field_num < 0 || field_num > TYPE_NFIELDS (type)) 5136130803Smarcel return 1; 5137130803Smarcel else 5138130803Smarcel { 5139130803Smarcel const char *name = TYPE_FIELD_NAME (type, field_num); 5140130803Smarcel return (name == NULL 5141130803Smarcel || (name[0] == '_' && !DEPRECATED_STREQN (name, "_parent", 7))); 5142130803Smarcel } 5143130803Smarcel} 5144130803Smarcel 5145130803Smarcel/* True iff structure type TYPE has a tag field. */ 5146130803Smarcel 5147130803Smarcelint 5148130803Smarcelada_is_tagged_type (struct type *type) 5149130803Smarcel{ 5150130803Smarcel if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT) 5151130803Smarcel return 0; 5152130803Smarcel 5153130803Smarcel return (ada_lookup_struct_elt_type (type, "_tag", 1, NULL) != NULL); 5154130803Smarcel} 5155130803Smarcel 5156130803Smarcel/* The type of the tag on VAL. */ 5157130803Smarcel 5158130803Smarcelstruct type * 5159130803Smarcelada_tag_type (struct value *val) 5160130803Smarcel{ 5161130803Smarcel return ada_lookup_struct_elt_type (VALUE_TYPE (val), "_tag", 0, NULL); 5162130803Smarcel} 5163130803Smarcel 5164130803Smarcel/* The value of the tag on VAL. */ 5165130803Smarcel 5166130803Smarcelstruct value * 5167130803Smarcelada_value_tag (struct value *val) 5168130803Smarcel{ 5169130803Smarcel return ada_value_struct_elt (val, "_tag", "record"); 5170130803Smarcel} 5171130803Smarcel 5172130803Smarcel/* The parent type of TYPE, or NULL if none. */ 5173130803Smarcel 5174130803Smarcelstruct type * 5175130803Smarcelada_parent_type (struct type *type) 5176130803Smarcel{ 5177130803Smarcel int i; 5178130803Smarcel 5179130803Smarcel CHECK_TYPEDEF (type); 5180130803Smarcel 5181130803Smarcel if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT) 5182130803Smarcel return NULL; 5183130803Smarcel 5184130803Smarcel for (i = 0; i < TYPE_NFIELDS (type); i += 1) 5185130803Smarcel if (ada_is_parent_field (type, i)) 5186130803Smarcel return check_typedef (TYPE_FIELD_TYPE (type, i)); 5187130803Smarcel 5188130803Smarcel return NULL; 5189130803Smarcel} 5190130803Smarcel 5191130803Smarcel/* True iff field number FIELD_NUM of structure type TYPE contains the 5192130803Smarcel parent-type (inherited) fields of a derived type. Assumes TYPE is 5193130803Smarcel a structure type with at least FIELD_NUM+1 fields. */ 5194130803Smarcel 5195130803Smarcelint 5196130803Smarcelada_is_parent_field (struct type *type, int field_num) 5197130803Smarcel{ 5198130803Smarcel const char *name = TYPE_FIELD_NAME (check_typedef (type), field_num); 5199130803Smarcel return (name != NULL && 5200130803Smarcel (DEPRECATED_STREQN (name, "PARENT", 6) || DEPRECATED_STREQN (name, "_parent", 7))); 5201130803Smarcel} 5202130803Smarcel 5203130803Smarcel/* True iff field number FIELD_NUM of structure type TYPE is a 5204130803Smarcel transparent wrapper field (which should be silently traversed when doing 5205130803Smarcel field selection and flattened when printing). Assumes TYPE is a 5206130803Smarcel structure type with at least FIELD_NUM+1 fields. Such fields are always 5207130803Smarcel structures. */ 5208130803Smarcel 5209130803Smarcelint 5210130803Smarcelada_is_wrapper_field (struct type *type, int field_num) 5211130803Smarcel{ 5212130803Smarcel const char *name = TYPE_FIELD_NAME (type, field_num); 5213130803Smarcel return (name != NULL 5214130803Smarcel && (DEPRECATED_STREQN (name, "PARENT", 6) || DEPRECATED_STREQ (name, "REP") 5215130803Smarcel || DEPRECATED_STREQN (name, "_parent", 7) 5216130803Smarcel || name[0] == 'S' || name[0] == 'R' || name[0] == 'O')); 5217130803Smarcel} 5218130803Smarcel 5219130803Smarcel/* True iff field number FIELD_NUM of structure or union type TYPE 5220130803Smarcel is a variant wrapper. Assumes TYPE is a structure type with at least 5221130803Smarcel FIELD_NUM+1 fields. */ 5222130803Smarcel 5223130803Smarcelint 5224130803Smarcelada_is_variant_part (struct type *type, int field_num) 5225130803Smarcel{ 5226130803Smarcel struct type *field_type = TYPE_FIELD_TYPE (type, field_num); 5227130803Smarcel return (TYPE_CODE (field_type) == TYPE_CODE_UNION 5228130803Smarcel || (is_dynamic_field (type, field_num) 5229130803Smarcel && TYPE_CODE (TYPE_TARGET_TYPE (field_type)) == 5230130803Smarcel TYPE_CODE_UNION)); 5231130803Smarcel} 5232130803Smarcel 5233130803Smarcel/* Assuming that VAR_TYPE is a variant wrapper (type of the variant part) 5234130803Smarcel whose discriminants are contained in the record type OUTER_TYPE, 5235130803Smarcel returns the type of the controlling discriminant for the variant. */ 5236130803Smarcel 5237130803Smarcelstruct type * 5238130803Smarcelada_variant_discrim_type (struct type *var_type, struct type *outer_type) 5239130803Smarcel{ 5240130803Smarcel char *name = ada_variant_discrim_name (var_type); 5241130803Smarcel struct type *type = ada_lookup_struct_elt_type (outer_type, name, 1, NULL); 5242130803Smarcel if (type == NULL) 5243130803Smarcel return builtin_type_int; 5244130803Smarcel else 5245130803Smarcel return type; 5246130803Smarcel} 5247130803Smarcel 5248130803Smarcel/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a 5249130803Smarcel valid field number within it, returns 1 iff field FIELD_NUM of TYPE 5250130803Smarcel represents a 'when others' clause; otherwise 0. */ 5251130803Smarcel 5252130803Smarcelint 5253130803Smarcelada_is_others_clause (struct type *type, int field_num) 5254130803Smarcel{ 5255130803Smarcel const char *name = TYPE_FIELD_NAME (type, field_num); 5256130803Smarcel return (name != NULL && name[0] == 'O'); 5257130803Smarcel} 5258130803Smarcel 5259130803Smarcel/* Assuming that TYPE0 is the type of the variant part of a record, 5260130803Smarcel returns the name of the discriminant controlling the variant. The 5261130803Smarcel value is valid until the next call to ada_variant_discrim_name. */ 5262130803Smarcel 5263130803Smarcelchar * 5264130803Smarcelada_variant_discrim_name (struct type *type0) 5265130803Smarcel{ 5266130803Smarcel static char *result = NULL; 5267130803Smarcel static size_t result_len = 0; 5268130803Smarcel struct type *type; 5269130803Smarcel const char *name; 5270130803Smarcel const char *discrim_end; 5271130803Smarcel const char *discrim_start; 5272130803Smarcel 5273130803Smarcel if (TYPE_CODE (type0) == TYPE_CODE_PTR) 5274130803Smarcel type = TYPE_TARGET_TYPE (type0); 5275130803Smarcel else 5276130803Smarcel type = type0; 5277130803Smarcel 5278130803Smarcel name = ada_type_name (type); 5279130803Smarcel 5280130803Smarcel if (name == NULL || name[0] == '\000') 5281130803Smarcel return ""; 5282130803Smarcel 5283130803Smarcel for (discrim_end = name + strlen (name) - 6; discrim_end != name; 5284130803Smarcel discrim_end -= 1) 5285130803Smarcel { 5286130803Smarcel if (DEPRECATED_STREQN (discrim_end, "___XVN", 6)) 5287130803Smarcel break; 5288130803Smarcel } 5289130803Smarcel if (discrim_end == name) 5290130803Smarcel return ""; 5291130803Smarcel 5292130803Smarcel for (discrim_start = discrim_end; discrim_start != name + 3; 5293130803Smarcel discrim_start -= 1) 5294130803Smarcel { 5295130803Smarcel if (discrim_start == name + 1) 5296130803Smarcel return ""; 5297130803Smarcel if ((discrim_start > name + 3 && DEPRECATED_STREQN (discrim_start - 3, "___", 3)) 5298130803Smarcel || discrim_start[-1] == '.') 5299130803Smarcel break; 5300130803Smarcel } 5301130803Smarcel 5302130803Smarcel GROW_VECT (result, result_len, discrim_end - discrim_start + 1); 5303130803Smarcel strncpy (result, discrim_start, discrim_end - discrim_start); 5304130803Smarcel result[discrim_end - discrim_start] = '\0'; 5305130803Smarcel return result; 5306130803Smarcel} 5307130803Smarcel 5308130803Smarcel/* Scan STR for a subtype-encoded number, beginning at position K. Put the 5309130803Smarcel position of the character just past the number scanned in *NEW_K, 5310130803Smarcel if NEW_K!=NULL. Put the scanned number in *R, if R!=NULL. Return 1 5311130803Smarcel if there was a valid number at the given position, and 0 otherwise. A 5312130803Smarcel "subtype-encoded" number consists of the absolute value in decimal, 5313130803Smarcel followed by the letter 'm' to indicate a negative number. Assumes 0m 5314130803Smarcel does not occur. */ 5315130803Smarcel 5316130803Smarcelint 5317130803Smarcelada_scan_number (const char str[], int k, LONGEST * R, int *new_k) 5318130803Smarcel{ 5319130803Smarcel ULONGEST RU; 5320130803Smarcel 5321130803Smarcel if (!isdigit (str[k])) 5322130803Smarcel return 0; 5323130803Smarcel 5324130803Smarcel /* Do it the hard way so as not to make any assumption about 5325130803Smarcel the relationship of unsigned long (%lu scan format code) and 5326130803Smarcel LONGEST. */ 5327130803Smarcel RU = 0; 5328130803Smarcel while (isdigit (str[k])) 5329130803Smarcel { 5330130803Smarcel RU = RU * 10 + (str[k] - '0'); 5331130803Smarcel k += 1; 5332130803Smarcel } 5333130803Smarcel 5334130803Smarcel if (str[k] == 'm') 5335130803Smarcel { 5336130803Smarcel if (R != NULL) 5337130803Smarcel *R = (-(LONGEST) (RU - 1)) - 1; 5338130803Smarcel k += 1; 5339130803Smarcel } 5340130803Smarcel else if (R != NULL) 5341130803Smarcel *R = (LONGEST) RU; 5342130803Smarcel 5343130803Smarcel /* NOTE on the above: Technically, C does not say what the results of 5344130803Smarcel - (LONGEST) RU or (LONGEST) -RU are for RU == largest positive 5345130803Smarcel number representable as a LONGEST (although either would probably work 5346130803Smarcel in most implementations). When RU>0, the locution in the then branch 5347130803Smarcel above is always equivalent to the negative of RU. */ 5348130803Smarcel 5349130803Smarcel if (new_k != NULL) 5350130803Smarcel *new_k = k; 5351130803Smarcel return 1; 5352130803Smarcel} 5353130803Smarcel 5354130803Smarcel/* Assuming that TYPE is a variant part wrapper type (a VARIANTS field), 5355130803Smarcel and FIELD_NUM is a valid field number within it, returns 1 iff VAL is 5356130803Smarcel in the range encoded by field FIELD_NUM of TYPE; otherwise 0. */ 5357130803Smarcel 5358130803Smarcelint 5359130803Smarcelada_in_variant (LONGEST val, struct type *type, int field_num) 5360130803Smarcel{ 5361130803Smarcel const char *name = TYPE_FIELD_NAME (type, field_num); 5362130803Smarcel int p; 5363130803Smarcel 5364130803Smarcel p = 0; 5365130803Smarcel while (1) 5366130803Smarcel { 5367130803Smarcel switch (name[p]) 5368130803Smarcel { 5369130803Smarcel case '\0': 5370130803Smarcel return 0; 5371130803Smarcel case 'S': 5372130803Smarcel { 5373130803Smarcel LONGEST W; 5374130803Smarcel if (!ada_scan_number (name, p + 1, &W, &p)) 5375130803Smarcel return 0; 5376130803Smarcel if (val == W) 5377130803Smarcel return 1; 5378130803Smarcel break; 5379130803Smarcel } 5380130803Smarcel case 'R': 5381130803Smarcel { 5382130803Smarcel LONGEST L, U; 5383130803Smarcel if (!ada_scan_number (name, p + 1, &L, &p) 5384130803Smarcel || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p)) 5385130803Smarcel return 0; 5386130803Smarcel if (val >= L && val <= U) 5387130803Smarcel return 1; 5388130803Smarcel break; 5389130803Smarcel } 5390130803Smarcel case 'O': 5391130803Smarcel return 1; 5392130803Smarcel default: 5393130803Smarcel return 0; 5394130803Smarcel } 5395130803Smarcel } 5396130803Smarcel} 5397130803Smarcel 5398130803Smarcel/* Given a value ARG1 (offset by OFFSET bytes) 5399130803Smarcel of a struct or union type ARG_TYPE, 5400130803Smarcel extract and return the value of one of its (non-static) fields. 5401130803Smarcel FIELDNO says which field. Differs from value_primitive_field only 5402130803Smarcel in that it can handle packed values of arbitrary type. */ 5403130803Smarcel 5404130803Smarcelstruct value * 5405130803Smarcelada_value_primitive_field (struct value *arg1, int offset, int fieldno, 5406130803Smarcel struct type *arg_type) 5407130803Smarcel{ 5408130803Smarcel struct value *v; 5409130803Smarcel struct type *type; 5410130803Smarcel 5411130803Smarcel CHECK_TYPEDEF (arg_type); 5412130803Smarcel type = TYPE_FIELD_TYPE (arg_type, fieldno); 5413130803Smarcel 5414130803Smarcel /* Handle packed fields */ 5415130803Smarcel 5416130803Smarcel if (TYPE_FIELD_BITSIZE (arg_type, fieldno) != 0) 5417130803Smarcel { 5418130803Smarcel int bit_pos = TYPE_FIELD_BITPOS (arg_type, fieldno); 5419130803Smarcel int bit_size = TYPE_FIELD_BITSIZE (arg_type, fieldno); 5420130803Smarcel 5421130803Smarcel return ada_value_primitive_packed_val (arg1, VALUE_CONTENTS (arg1), 5422130803Smarcel offset + bit_pos / 8, 5423130803Smarcel bit_pos % 8, bit_size, type); 5424130803Smarcel } 5425130803Smarcel else 5426130803Smarcel return value_primitive_field (arg1, offset, fieldno, arg_type); 5427130803Smarcel} 5428130803Smarcel 5429130803Smarcel 5430130803Smarcel/* Look for a field NAME in ARG. Adjust the address of ARG by OFFSET bytes, 5431130803Smarcel and search in it assuming it has (class) type TYPE. 5432130803Smarcel If found, return value, else return NULL. 5433130803Smarcel 5434130803Smarcel Searches recursively through wrapper fields (e.g., '_parent'). */ 5435130803Smarcel 5436130803Smarcelstruct value * 5437130803Smarcelada_search_struct_field (char *name, struct value *arg, int offset, 5438130803Smarcel struct type *type) 5439130803Smarcel{ 5440130803Smarcel int i; 5441130803Smarcel CHECK_TYPEDEF (type); 5442130803Smarcel 5443130803Smarcel for (i = TYPE_NFIELDS (type) - 1; i >= 0; i -= 1) 5444130803Smarcel { 5445130803Smarcel char *t_field_name = TYPE_FIELD_NAME (type, i); 5446130803Smarcel 5447130803Smarcel if (t_field_name == NULL) 5448130803Smarcel continue; 5449130803Smarcel 5450130803Smarcel else if (field_name_match (t_field_name, name)) 5451130803Smarcel return ada_value_primitive_field (arg, offset, i, type); 5452130803Smarcel 5453130803Smarcel else if (ada_is_wrapper_field (type, i)) 5454130803Smarcel { 5455130803Smarcel struct value *v = ada_search_struct_field (name, arg, 5456130803Smarcel offset + 5457130803Smarcel TYPE_FIELD_BITPOS (type, 5458130803Smarcel i) / 5459130803Smarcel 8, 5460130803Smarcel TYPE_FIELD_TYPE (type, 5461130803Smarcel i)); 5462130803Smarcel if (v != NULL) 5463130803Smarcel return v; 5464130803Smarcel } 5465130803Smarcel 5466130803Smarcel else if (ada_is_variant_part (type, i)) 5467130803Smarcel { 5468130803Smarcel int j; 5469130803Smarcel struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i)); 5470130803Smarcel int var_offset = offset + TYPE_FIELD_BITPOS (type, i) / 8; 5471130803Smarcel 5472130803Smarcel for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1) 5473130803Smarcel { 5474130803Smarcel struct value *v = ada_search_struct_field (name, arg, 5475130803Smarcel var_offset 5476130803Smarcel + 5477130803Smarcel TYPE_FIELD_BITPOS 5478130803Smarcel (field_type, j) / 8, 5479130803Smarcel TYPE_FIELD_TYPE 5480130803Smarcel (field_type, j)); 5481130803Smarcel if (v != NULL) 5482130803Smarcel return v; 5483130803Smarcel } 5484130803Smarcel } 5485130803Smarcel } 5486130803Smarcel return NULL; 5487130803Smarcel} 5488130803Smarcel 5489130803Smarcel/* Given ARG, a value of type (pointer to a)* structure/union, 5490130803Smarcel extract the component named NAME from the ultimate target structure/union 5491130803Smarcel and return it as a value with its appropriate type. 5492130803Smarcel 5493130803Smarcel The routine searches for NAME among all members of the structure itself 5494130803Smarcel and (recursively) among all members of any wrapper members 5495130803Smarcel (e.g., '_parent'). 5496130803Smarcel 5497130803Smarcel ERR is a name (for use in error messages) that identifies the class 5498130803Smarcel of entity that ARG is supposed to be. */ 5499130803Smarcel 5500130803Smarcelstruct value * 5501130803Smarcelada_value_struct_elt (struct value *arg, char *name, char *err) 5502130803Smarcel{ 5503130803Smarcel struct type *t; 5504130803Smarcel struct value *v; 5505130803Smarcel 5506130803Smarcel arg = ada_coerce_ref (arg); 5507130803Smarcel t = check_typedef (VALUE_TYPE (arg)); 5508130803Smarcel 5509130803Smarcel /* Follow pointers until we get to a non-pointer. */ 5510130803Smarcel 5511130803Smarcel while (TYPE_CODE (t) == TYPE_CODE_PTR || TYPE_CODE (t) == TYPE_CODE_REF) 5512130803Smarcel { 5513130803Smarcel arg = ada_value_ind (arg); 5514130803Smarcel t = check_typedef (VALUE_TYPE (arg)); 5515130803Smarcel } 5516130803Smarcel 5517130803Smarcel if (TYPE_CODE (t) != TYPE_CODE_STRUCT && TYPE_CODE (t) != TYPE_CODE_UNION) 5518130803Smarcel error ("Attempt to extract a component of a value that is not a %s.", 5519130803Smarcel err); 5520130803Smarcel 5521130803Smarcel v = ada_search_struct_field (name, arg, 0, t); 5522130803Smarcel if (v == NULL) 5523130803Smarcel error ("There is no member named %s.", name); 5524130803Smarcel 5525130803Smarcel return v; 5526130803Smarcel} 5527130803Smarcel 5528130803Smarcel/* Given a type TYPE, look up the type of the component of type named NAME. 5529130803Smarcel If DISPP is non-null, add its byte displacement from the beginning of a 5530130803Smarcel structure (pointed to by a value) of type TYPE to *DISPP (does not 5531130803Smarcel work for packed fields). 5532130803Smarcel 5533130803Smarcel Matches any field whose name has NAME as a prefix, possibly 5534130803Smarcel followed by "___". 5535130803Smarcel 5536130803Smarcel TYPE can be either a struct or union, or a pointer or reference to 5537130803Smarcel a struct or union. If it is a pointer or reference, its target 5538130803Smarcel type is automatically used. 5539130803Smarcel 5540130803Smarcel Looks recursively into variant clauses and parent types. 5541130803Smarcel 5542130803Smarcel If NOERR is nonzero, return NULL if NAME is not suitably defined. */ 5543130803Smarcel 5544130803Smarcelstruct type * 5545130803Smarcelada_lookup_struct_elt_type (struct type *type, char *name, int noerr, 5546130803Smarcel int *dispp) 5547130803Smarcel{ 5548130803Smarcel int i; 5549130803Smarcel 5550130803Smarcel if (name == NULL) 5551130803Smarcel goto BadName; 5552130803Smarcel 5553130803Smarcel while (1) 5554130803Smarcel { 5555130803Smarcel CHECK_TYPEDEF (type); 5556130803Smarcel if (TYPE_CODE (type) != TYPE_CODE_PTR 5557130803Smarcel && TYPE_CODE (type) != TYPE_CODE_REF) 5558130803Smarcel break; 5559130803Smarcel type = TYPE_TARGET_TYPE (type); 5560130803Smarcel } 5561130803Smarcel 5562130803Smarcel if (TYPE_CODE (type) != TYPE_CODE_STRUCT && 5563130803Smarcel TYPE_CODE (type) != TYPE_CODE_UNION) 5564130803Smarcel { 5565130803Smarcel target_terminal_ours (); 5566130803Smarcel gdb_flush (gdb_stdout); 5567130803Smarcel fprintf_unfiltered (gdb_stderr, "Type "); 5568130803Smarcel type_print (type, "", gdb_stderr, -1); 5569130803Smarcel error (" is not a structure or union type"); 5570130803Smarcel } 5571130803Smarcel 5572130803Smarcel type = to_static_fixed_type (type); 5573130803Smarcel 5574130803Smarcel for (i = 0; i < TYPE_NFIELDS (type); i += 1) 5575130803Smarcel { 5576130803Smarcel char *t_field_name = TYPE_FIELD_NAME (type, i); 5577130803Smarcel struct type *t; 5578130803Smarcel int disp; 5579130803Smarcel 5580130803Smarcel if (t_field_name == NULL) 5581130803Smarcel continue; 5582130803Smarcel 5583130803Smarcel else if (field_name_match (t_field_name, name)) 5584130803Smarcel { 5585130803Smarcel if (dispp != NULL) 5586130803Smarcel *dispp += TYPE_FIELD_BITPOS (type, i) / 8; 5587130803Smarcel return check_typedef (TYPE_FIELD_TYPE (type, i)); 5588130803Smarcel } 5589130803Smarcel 5590130803Smarcel else if (ada_is_wrapper_field (type, i)) 5591130803Smarcel { 5592130803Smarcel disp = 0; 5593130803Smarcel t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (type, i), name, 5594130803Smarcel 1, &disp); 5595130803Smarcel if (t != NULL) 5596130803Smarcel { 5597130803Smarcel if (dispp != NULL) 5598130803Smarcel *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8; 5599130803Smarcel return t; 5600130803Smarcel } 5601130803Smarcel } 5602130803Smarcel 5603130803Smarcel else if (ada_is_variant_part (type, i)) 5604130803Smarcel { 5605130803Smarcel int j; 5606130803Smarcel struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, i)); 5607130803Smarcel 5608130803Smarcel for (j = TYPE_NFIELDS (field_type) - 1; j >= 0; j -= 1) 5609130803Smarcel { 5610130803Smarcel disp = 0; 5611130803Smarcel t = ada_lookup_struct_elt_type (TYPE_FIELD_TYPE (field_type, j), 5612130803Smarcel name, 1, &disp); 5613130803Smarcel if (t != NULL) 5614130803Smarcel { 5615130803Smarcel if (dispp != NULL) 5616130803Smarcel *dispp += disp + TYPE_FIELD_BITPOS (type, i) / 8; 5617130803Smarcel return t; 5618130803Smarcel } 5619130803Smarcel } 5620130803Smarcel } 5621130803Smarcel 5622130803Smarcel } 5623130803Smarcel 5624130803SmarcelBadName: 5625130803Smarcel if (!noerr) 5626130803Smarcel { 5627130803Smarcel target_terminal_ours (); 5628130803Smarcel gdb_flush (gdb_stdout); 5629130803Smarcel fprintf_unfiltered (gdb_stderr, "Type "); 5630130803Smarcel type_print (type, "", gdb_stderr, -1); 5631130803Smarcel fprintf_unfiltered (gdb_stderr, " has no component named "); 5632130803Smarcel error ("%s", name == NULL ? "<null>" : name); 5633130803Smarcel } 5634130803Smarcel 5635130803Smarcel return NULL; 5636130803Smarcel} 5637130803Smarcel 5638130803Smarcel/* Assuming that VAR_TYPE is the type of a variant part of a record (a union), 5639130803Smarcel within a value of type OUTER_TYPE that is stored in GDB at 5640130803Smarcel OUTER_VALADDR, determine which variant clause (field number in VAR_TYPE, 5641130803Smarcel numbering from 0) is applicable. Returns -1 if none are. */ 5642130803Smarcel 5643130803Smarcelint 5644130803Smarcelada_which_variant_applies (struct type *var_type, struct type *outer_type, 5645130803Smarcel char *outer_valaddr) 5646130803Smarcel{ 5647130803Smarcel int others_clause; 5648130803Smarcel int i; 5649130803Smarcel int disp; 5650130803Smarcel struct type *discrim_type; 5651130803Smarcel char *discrim_name = ada_variant_discrim_name (var_type); 5652130803Smarcel LONGEST discrim_val; 5653130803Smarcel 5654130803Smarcel disp = 0; 5655130803Smarcel discrim_type = 5656130803Smarcel ada_lookup_struct_elt_type (outer_type, discrim_name, 1, &disp); 5657130803Smarcel if (discrim_type == NULL) 5658130803Smarcel return -1; 5659130803Smarcel discrim_val = unpack_long (discrim_type, outer_valaddr + disp); 5660130803Smarcel 5661130803Smarcel others_clause = -1; 5662130803Smarcel for (i = 0; i < TYPE_NFIELDS (var_type); i += 1) 5663130803Smarcel { 5664130803Smarcel if (ada_is_others_clause (var_type, i)) 5665130803Smarcel others_clause = i; 5666130803Smarcel else if (ada_in_variant (discrim_val, var_type, i)) 5667130803Smarcel return i; 5668130803Smarcel } 5669130803Smarcel 5670130803Smarcel return others_clause; 5671130803Smarcel} 5672130803Smarcel 5673130803Smarcel 5674130803Smarcel 5675130803Smarcel /* Dynamic-Sized Records */ 5676130803Smarcel 5677130803Smarcel/* Strategy: The type ostensibly attached to a value with dynamic size 5678130803Smarcel (i.e., a size that is not statically recorded in the debugging 5679130803Smarcel data) does not accurately reflect the size or layout of the value. 5680130803Smarcel Our strategy is to convert these values to values with accurate, 5681130803Smarcel conventional types that are constructed on the fly. */ 5682130803Smarcel 5683130803Smarcel/* There is a subtle and tricky problem here. In general, we cannot 5684130803Smarcel determine the size of dynamic records without its data. However, 5685130803Smarcel the 'struct value' data structure, which GDB uses to represent 5686130803Smarcel quantities in the inferior process (the target), requires the size 5687130803Smarcel of the type at the time of its allocation in order to reserve space 5688130803Smarcel for GDB's internal copy of the data. That's why the 5689130803Smarcel 'to_fixed_xxx_type' routines take (target) addresses as parameters, 5690130803Smarcel rather than struct value*s. 5691130803Smarcel 5692130803Smarcel However, GDB's internal history variables ($1, $2, etc.) are 5693130803Smarcel struct value*s containing internal copies of the data that are not, in 5694130803Smarcel general, the same as the data at their corresponding addresses in 5695130803Smarcel the target. Fortunately, the types we give to these values are all 5696130803Smarcel conventional, fixed-size types (as per the strategy described 5697130803Smarcel above), so that we don't usually have to perform the 5698130803Smarcel 'to_fixed_xxx_type' conversions to look at their values. 5699130803Smarcel Unfortunately, there is one exception: if one of the internal 5700130803Smarcel history variables is an array whose elements are unconstrained 5701130803Smarcel records, then we will need to create distinct fixed types for each 5702130803Smarcel element selected. */ 5703130803Smarcel 5704130803Smarcel/* The upshot of all of this is that many routines take a (type, host 5705130803Smarcel address, target address) triple as arguments to represent a value. 5706130803Smarcel The host address, if non-null, is supposed to contain an internal 5707130803Smarcel copy of the relevant data; otherwise, the program is to consult the 5708130803Smarcel target at the target address. */ 5709130803Smarcel 5710130803Smarcel/* Assuming that VAL0 represents a pointer value, the result of 5711130803Smarcel dereferencing it. Differs from value_ind in its treatment of 5712130803Smarcel dynamic-sized types. */ 5713130803Smarcel 5714130803Smarcelstruct value * 5715130803Smarcelada_value_ind (struct value *val0) 5716130803Smarcel{ 5717130803Smarcel struct value *val = unwrap_value (value_ind (val0)); 5718130803Smarcel return ada_to_fixed_value (VALUE_TYPE (val), 0, 5719130803Smarcel VALUE_ADDRESS (val) + VALUE_OFFSET (val), val); 5720130803Smarcel} 5721130803Smarcel 5722130803Smarcel/* The value resulting from dereferencing any "reference to" 5723130803Smarcel * qualifiers on VAL0. */ 5724130803Smarcelstatic struct value * 5725130803Smarcelada_coerce_ref (struct value *val0) 5726130803Smarcel{ 5727130803Smarcel if (TYPE_CODE (VALUE_TYPE (val0)) == TYPE_CODE_REF) 5728130803Smarcel { 5729130803Smarcel struct value *val = val0; 5730130803Smarcel COERCE_REF (val); 5731130803Smarcel val = unwrap_value (val); 5732130803Smarcel return ada_to_fixed_value (VALUE_TYPE (val), 0, 5733130803Smarcel VALUE_ADDRESS (val) + VALUE_OFFSET (val), 5734130803Smarcel val); 5735130803Smarcel } 5736130803Smarcel else 5737130803Smarcel return val0; 5738130803Smarcel} 5739130803Smarcel 5740130803Smarcel/* Return OFF rounded upward if necessary to a multiple of 5741130803Smarcel ALIGNMENT (a power of 2). */ 5742130803Smarcel 5743130803Smarcelstatic unsigned int 5744130803Smarcelalign_value (unsigned int off, unsigned int alignment) 5745130803Smarcel{ 5746130803Smarcel return (off + alignment - 1) & ~(alignment - 1); 5747130803Smarcel} 5748130803Smarcel 5749130803Smarcel/* Return the additional bit offset required by field F of template 5750130803Smarcel type TYPE. */ 5751130803Smarcel 5752130803Smarcelstatic unsigned int 5753130803Smarcelfield_offset (struct type *type, int f) 5754130803Smarcel{ 5755130803Smarcel int n = TYPE_FIELD_BITPOS (type, f); 5756130803Smarcel /* Kludge (temporary?) to fix problem with dwarf output. */ 5757130803Smarcel if (n < 0) 5758130803Smarcel return (unsigned int) n & 0xffff; 5759130803Smarcel else 5760130803Smarcel return n; 5761130803Smarcel} 5762130803Smarcel 5763130803Smarcel 5764130803Smarcel/* Return the bit alignment required for field #F of template type TYPE. */ 5765130803Smarcel 5766130803Smarcelstatic unsigned int 5767130803Smarcelfield_alignment (struct type *type, int f) 5768130803Smarcel{ 5769130803Smarcel const char *name = TYPE_FIELD_NAME (type, f); 5770130803Smarcel int len = (name == NULL) ? 0 : strlen (name); 5771130803Smarcel int align_offset; 5772130803Smarcel 5773130803Smarcel if (len < 8 || !isdigit (name[len - 1])) 5774130803Smarcel return TARGET_CHAR_BIT; 5775130803Smarcel 5776130803Smarcel if (isdigit (name[len - 2])) 5777130803Smarcel align_offset = len - 2; 5778130803Smarcel else 5779130803Smarcel align_offset = len - 1; 5780130803Smarcel 5781130803Smarcel if (align_offset < 7 || !DEPRECATED_STREQN ("___XV", name + align_offset - 6, 5)) 5782130803Smarcel return TARGET_CHAR_BIT; 5783130803Smarcel 5784130803Smarcel return atoi (name + align_offset) * TARGET_CHAR_BIT; 5785130803Smarcel} 5786130803Smarcel 5787130803Smarcel/* Find a type named NAME. Ignores ambiguity. */ 5788130803Smarcelstruct type * 5789130803Smarcelada_find_any_type (const char *name) 5790130803Smarcel{ 5791130803Smarcel struct symbol *sym; 5792130803Smarcel 5793130803Smarcel sym = standard_lookup (name, VAR_DOMAIN); 5794130803Smarcel if (sym != NULL && SYMBOL_CLASS (sym) == LOC_TYPEDEF) 5795130803Smarcel return SYMBOL_TYPE (sym); 5796130803Smarcel 5797130803Smarcel sym = standard_lookup (name, STRUCT_DOMAIN); 5798130803Smarcel if (sym != NULL) 5799130803Smarcel return SYMBOL_TYPE (sym); 5800130803Smarcel 5801130803Smarcel return NULL; 5802130803Smarcel} 5803130803Smarcel 5804130803Smarcel/* Because of GNAT encoding conventions, several GDB symbols may match a 5805130803Smarcel given type name. If the type denoted by TYPE0 is to be preferred to 5806130803Smarcel that of TYPE1 for purposes of type printing, return non-zero; 5807130803Smarcel otherwise return 0. */ 5808130803Smarcelint 5809130803Smarcelada_prefer_type (struct type *type0, struct type *type1) 5810130803Smarcel{ 5811130803Smarcel if (type1 == NULL) 5812130803Smarcel return 1; 5813130803Smarcel else if (type0 == NULL) 5814130803Smarcel return 0; 5815130803Smarcel else if (TYPE_CODE (type1) == TYPE_CODE_VOID) 5816130803Smarcel return 1; 5817130803Smarcel else if (TYPE_CODE (type0) == TYPE_CODE_VOID) 5818130803Smarcel return 0; 5819130803Smarcel else if (ada_is_packed_array_type (type0)) 5820130803Smarcel return 1; 5821130803Smarcel else if (ada_is_array_descriptor (type0) 5822130803Smarcel && !ada_is_array_descriptor (type1)) 5823130803Smarcel return 1; 5824130803Smarcel else if (ada_renaming_type (type0) != NULL 5825130803Smarcel && ada_renaming_type (type1) == NULL) 5826130803Smarcel return 1; 5827130803Smarcel return 0; 5828130803Smarcel} 5829130803Smarcel 5830130803Smarcel/* The name of TYPE, which is either its TYPE_NAME, or, if that is 5831130803Smarcel null, its TYPE_TAG_NAME. Null if TYPE is null. */ 5832130803Smarcelchar * 5833130803Smarcelada_type_name (struct type *type) 5834130803Smarcel{ 5835130803Smarcel if (type == NULL) 5836130803Smarcel return NULL; 5837130803Smarcel else if (TYPE_NAME (type) != NULL) 5838130803Smarcel return TYPE_NAME (type); 5839130803Smarcel else 5840130803Smarcel return TYPE_TAG_NAME (type); 5841130803Smarcel} 5842130803Smarcel 5843130803Smarcel/* Find a parallel type to TYPE whose name is formed by appending 5844130803Smarcel SUFFIX to the name of TYPE. */ 5845130803Smarcel 5846130803Smarcelstruct type * 5847130803Smarcelada_find_parallel_type (struct type *type, const char *suffix) 5848130803Smarcel{ 5849130803Smarcel static char *name; 5850130803Smarcel static size_t name_len = 0; 5851130803Smarcel struct symbol **syms; 5852130803Smarcel struct block **blocks; 5853130803Smarcel int nsyms; 5854130803Smarcel int len; 5855130803Smarcel char *typename = ada_type_name (type); 5856130803Smarcel 5857130803Smarcel if (typename == NULL) 5858130803Smarcel return NULL; 5859130803Smarcel 5860130803Smarcel len = strlen (typename); 5861130803Smarcel 5862130803Smarcel GROW_VECT (name, name_len, len + strlen (suffix) + 1); 5863130803Smarcel 5864130803Smarcel strcpy (name, typename); 5865130803Smarcel strcpy (name + len, suffix); 5866130803Smarcel 5867130803Smarcel return ada_find_any_type (name); 5868130803Smarcel} 5869130803Smarcel 5870130803Smarcel 5871130803Smarcel/* If TYPE is a variable-size record type, return the corresponding template 5872130803Smarcel type describing its fields. Otherwise, return NULL. */ 5873130803Smarcel 5874130803Smarcelstatic struct type * 5875130803Smarceldynamic_template_type (struct type *type) 5876130803Smarcel{ 5877130803Smarcel CHECK_TYPEDEF (type); 5878130803Smarcel 5879130803Smarcel if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT 5880130803Smarcel || ada_type_name (type) == NULL) 5881130803Smarcel return NULL; 5882130803Smarcel else 5883130803Smarcel { 5884130803Smarcel int len = strlen (ada_type_name (type)); 5885130803Smarcel if (len > 6 && DEPRECATED_STREQ (ada_type_name (type) + len - 6, "___XVE")) 5886130803Smarcel return type; 5887130803Smarcel else 5888130803Smarcel return ada_find_parallel_type (type, "___XVE"); 5889130803Smarcel } 5890130803Smarcel} 5891130803Smarcel 5892130803Smarcel/* Assuming that TEMPL_TYPE is a union or struct type, returns 5893130803Smarcel non-zero iff field FIELD_NUM of TEMPL_TYPE has dynamic size. */ 5894130803Smarcel 5895130803Smarcelstatic int 5896130803Smarcelis_dynamic_field (struct type *templ_type, int field_num) 5897130803Smarcel{ 5898130803Smarcel const char *name = TYPE_FIELD_NAME (templ_type, field_num); 5899130803Smarcel return name != NULL 5900130803Smarcel && TYPE_CODE (TYPE_FIELD_TYPE (templ_type, field_num)) == TYPE_CODE_PTR 5901130803Smarcel && strstr (name, "___XVL") != NULL; 5902130803Smarcel} 5903130803Smarcel 5904130803Smarcel/* Assuming that TYPE is a struct type, returns non-zero iff TYPE 5905130803Smarcel contains a variant part. */ 5906130803Smarcel 5907130803Smarcelstatic int 5908130803Smarcelcontains_variant_part (struct type *type) 5909130803Smarcel{ 5910130803Smarcel int f; 5911130803Smarcel 5912130803Smarcel if (type == NULL || TYPE_CODE (type) != TYPE_CODE_STRUCT 5913130803Smarcel || TYPE_NFIELDS (type) <= 0) 5914130803Smarcel return 0; 5915130803Smarcel return ada_is_variant_part (type, TYPE_NFIELDS (type) - 1); 5916130803Smarcel} 5917130803Smarcel 5918130803Smarcel/* A record type with no fields, . */ 5919130803Smarcelstatic struct type * 5920130803Smarcelempty_record (struct objfile *objfile) 5921130803Smarcel{ 5922130803Smarcel struct type *type = alloc_type (objfile); 5923130803Smarcel TYPE_CODE (type) = TYPE_CODE_STRUCT; 5924130803Smarcel TYPE_NFIELDS (type) = 0; 5925130803Smarcel TYPE_FIELDS (type) = NULL; 5926130803Smarcel TYPE_NAME (type) = "<empty>"; 5927130803Smarcel TYPE_TAG_NAME (type) = NULL; 5928130803Smarcel TYPE_FLAGS (type) = 0; 5929130803Smarcel TYPE_LENGTH (type) = 0; 5930130803Smarcel return type; 5931130803Smarcel} 5932130803Smarcel 5933130803Smarcel/* An ordinary record type (with fixed-length fields) that describes 5934130803Smarcel the value of type TYPE at VALADDR or ADDRESS (see comments at 5935130803Smarcel the beginning of this section) VAL according to GNAT conventions. 5936130803Smarcel DVAL0 should describe the (portion of a) record that contains any 5937130803Smarcel necessary discriminants. It should be NULL if VALUE_TYPE (VAL) is 5938130803Smarcel an outer-level type (i.e., as opposed to a branch of a variant.) A 5939130803Smarcel variant field (unless unchecked) is replaced by a particular branch 5940130803Smarcel of the variant. */ 5941130803Smarcel/* NOTE: Limitations: For now, we assume that dynamic fields and 5942130803Smarcel * variants occupy whole numbers of bytes. However, they need not be 5943130803Smarcel * byte-aligned. */ 5944130803Smarcel 5945130803Smarcelstatic struct type * 5946130803Smarceltemplate_to_fixed_record_type (struct type *type, char *valaddr, 5947130803Smarcel CORE_ADDR address, struct value *dval0) 5948130803Smarcel{ 5949130803Smarcel struct value *mark = value_mark (); 5950130803Smarcel struct value *dval; 5951130803Smarcel struct type *rtype; 5952130803Smarcel int nfields, bit_len; 5953130803Smarcel long off; 5954130803Smarcel int f; 5955130803Smarcel 5956130803Smarcel nfields = TYPE_NFIELDS (type); 5957130803Smarcel rtype = alloc_type (TYPE_OBJFILE (type)); 5958130803Smarcel TYPE_CODE (rtype) = TYPE_CODE_STRUCT; 5959130803Smarcel INIT_CPLUS_SPECIFIC (rtype); 5960130803Smarcel TYPE_NFIELDS (rtype) = nfields; 5961130803Smarcel TYPE_FIELDS (rtype) = (struct field *) 5962130803Smarcel TYPE_ALLOC (rtype, nfields * sizeof (struct field)); 5963130803Smarcel memset (TYPE_FIELDS (rtype), 0, sizeof (struct field) * nfields); 5964130803Smarcel TYPE_NAME (rtype) = ada_type_name (type); 5965130803Smarcel TYPE_TAG_NAME (rtype) = NULL; 5966130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in 5967130803Smarcel gdbtypes.h */ 5968130803Smarcel /* TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE; */ 5969130803Smarcel 5970130803Smarcel off = 0; 5971130803Smarcel bit_len = 0; 5972130803Smarcel for (f = 0; f < nfields; f += 1) 5973130803Smarcel { 5974130803Smarcel int fld_bit_len, bit_incr; 5975130803Smarcel off = 5976130803Smarcel align_value (off, 5977130803Smarcel field_alignment (type, f)) + TYPE_FIELD_BITPOS (type, f); 5978130803Smarcel /* NOTE: used to use field_offset above, but that causes 5979130803Smarcel * problems with really negative bit positions. So, let's 5980130803Smarcel * rediscover why we needed field_offset and fix it properly. */ 5981130803Smarcel TYPE_FIELD_BITPOS (rtype, f) = off; 5982130803Smarcel TYPE_FIELD_BITSIZE (rtype, f) = 0; 5983130803Smarcel TYPE_FIELD_STATIC_KIND (rtype, f) = 0; 5984130803Smarcel 5985130803Smarcel if (ada_is_variant_part (type, f)) 5986130803Smarcel { 5987130803Smarcel struct type *branch_type; 5988130803Smarcel 5989130803Smarcel if (dval0 == NULL) 5990130803Smarcel dval = value_from_contents_and_address (rtype, valaddr, address); 5991130803Smarcel else 5992130803Smarcel dval = dval0; 5993130803Smarcel 5994130803Smarcel branch_type = 5995130803Smarcel to_fixed_variant_branch_type 5996130803Smarcel (TYPE_FIELD_TYPE (type, f), 5997130803Smarcel cond_offset_host (valaddr, off / TARGET_CHAR_BIT), 5998130803Smarcel cond_offset_target (address, off / TARGET_CHAR_BIT), dval); 5999130803Smarcel if (branch_type == NULL) 6000130803Smarcel TYPE_NFIELDS (rtype) -= 1; 6001130803Smarcel else 6002130803Smarcel { 6003130803Smarcel TYPE_FIELD_TYPE (rtype, f) = branch_type; 6004130803Smarcel TYPE_FIELD_NAME (rtype, f) = "S"; 6005130803Smarcel } 6006130803Smarcel bit_incr = 0; 6007130803Smarcel fld_bit_len = 6008130803Smarcel TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT; 6009130803Smarcel } 6010130803Smarcel else if (is_dynamic_field (type, f)) 6011130803Smarcel { 6012130803Smarcel if (dval0 == NULL) 6013130803Smarcel dval = value_from_contents_and_address (rtype, valaddr, address); 6014130803Smarcel else 6015130803Smarcel dval = dval0; 6016130803Smarcel 6017130803Smarcel TYPE_FIELD_TYPE (rtype, f) = 6018130803Smarcel ada_to_fixed_type 6019130803Smarcel (ada_get_base_type 6020130803Smarcel (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, f))), 6021130803Smarcel cond_offset_host (valaddr, off / TARGET_CHAR_BIT), 6022130803Smarcel cond_offset_target (address, off / TARGET_CHAR_BIT), dval); 6023130803Smarcel TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f); 6024130803Smarcel bit_incr = fld_bit_len = 6025130803Smarcel TYPE_LENGTH (TYPE_FIELD_TYPE (rtype, f)) * TARGET_CHAR_BIT; 6026130803Smarcel } 6027130803Smarcel else 6028130803Smarcel { 6029130803Smarcel TYPE_FIELD_TYPE (rtype, f) = TYPE_FIELD_TYPE (type, f); 6030130803Smarcel TYPE_FIELD_NAME (rtype, f) = TYPE_FIELD_NAME (type, f); 6031130803Smarcel if (TYPE_FIELD_BITSIZE (type, f) > 0) 6032130803Smarcel bit_incr = fld_bit_len = 6033130803Smarcel TYPE_FIELD_BITSIZE (rtype, f) = TYPE_FIELD_BITSIZE (type, f); 6034130803Smarcel else 6035130803Smarcel bit_incr = fld_bit_len = 6036130803Smarcel TYPE_LENGTH (TYPE_FIELD_TYPE (type, f)) * TARGET_CHAR_BIT; 6037130803Smarcel } 6038130803Smarcel if (off + fld_bit_len > bit_len) 6039130803Smarcel bit_len = off + fld_bit_len; 6040130803Smarcel off += bit_incr; 6041130803Smarcel TYPE_LENGTH (rtype) = bit_len / TARGET_CHAR_BIT; 6042130803Smarcel } 6043130803Smarcel TYPE_LENGTH (rtype) = align_value (TYPE_LENGTH (rtype), TYPE_LENGTH (type)); 6044130803Smarcel 6045130803Smarcel value_free_to_mark (mark); 6046130803Smarcel if (TYPE_LENGTH (rtype) > varsize_limit) 6047130803Smarcel error ("record type with dynamic size is larger than varsize-limit"); 6048130803Smarcel return rtype; 6049130803Smarcel} 6050130803Smarcel 6051130803Smarcel/* As for template_to_fixed_record_type, but uses no run-time values. 6052130803Smarcel As a result, this type can only be approximate, but that's OK, 6053130803Smarcel since it is used only for type determinations. Works on both 6054130803Smarcel structs and unions. 6055130803Smarcel Representation note: to save space, we memoize the result of this 6056130803Smarcel function in the TYPE_TARGET_TYPE of the template type. */ 6057130803Smarcel 6058130803Smarcelstatic struct type * 6059130803Smarceltemplate_to_static_fixed_type (struct type *templ_type) 6060130803Smarcel{ 6061130803Smarcel struct type *type; 6062130803Smarcel int nfields; 6063130803Smarcel int f; 6064130803Smarcel 6065130803Smarcel if (TYPE_TARGET_TYPE (templ_type) != NULL) 6066130803Smarcel return TYPE_TARGET_TYPE (templ_type); 6067130803Smarcel 6068130803Smarcel nfields = TYPE_NFIELDS (templ_type); 6069130803Smarcel TYPE_TARGET_TYPE (templ_type) = type = 6070130803Smarcel alloc_type (TYPE_OBJFILE (templ_type)); 6071130803Smarcel TYPE_CODE (type) = TYPE_CODE (templ_type); 6072130803Smarcel INIT_CPLUS_SPECIFIC (type); 6073130803Smarcel TYPE_NFIELDS (type) = nfields; 6074130803Smarcel TYPE_FIELDS (type) = (struct field *) 6075130803Smarcel TYPE_ALLOC (type, nfields * sizeof (struct field)); 6076130803Smarcel memset (TYPE_FIELDS (type), 0, sizeof (struct field) * nfields); 6077130803Smarcel TYPE_NAME (type) = ada_type_name (templ_type); 6078130803Smarcel TYPE_TAG_NAME (type) = NULL; 6079130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6080130803Smarcel /* TYPE_FLAGS (type) |= TYPE_FLAG_FIXED_INSTANCE; */ 6081130803Smarcel TYPE_LENGTH (type) = 0; 6082130803Smarcel 6083130803Smarcel for (f = 0; f < nfields; f += 1) 6084130803Smarcel { 6085130803Smarcel TYPE_FIELD_BITPOS (type, f) = 0; 6086130803Smarcel TYPE_FIELD_BITSIZE (type, f) = 0; 6087130803Smarcel TYPE_FIELD_STATIC_KIND (type, f) = 0; 6088130803Smarcel 6089130803Smarcel if (is_dynamic_field (templ_type, f)) 6090130803Smarcel { 6091130803Smarcel TYPE_FIELD_TYPE (type, f) = 6092130803Smarcel to_static_fixed_type (TYPE_TARGET_TYPE 6093130803Smarcel (TYPE_FIELD_TYPE (templ_type, f))); 6094130803Smarcel TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (templ_type, f); 6095130803Smarcel } 6096130803Smarcel else 6097130803Smarcel { 6098130803Smarcel TYPE_FIELD_TYPE (type, f) = 6099130803Smarcel check_typedef (TYPE_FIELD_TYPE (templ_type, f)); 6100130803Smarcel TYPE_FIELD_NAME (type, f) = TYPE_FIELD_NAME (templ_type, f); 6101130803Smarcel } 6102130803Smarcel } 6103130803Smarcel 6104130803Smarcel return type; 6105130803Smarcel} 6106130803Smarcel 6107130803Smarcel/* A revision of TYPE0 -- a non-dynamic-sized record with a variant 6108130803Smarcel part -- in which the variant part is replaced with the appropriate 6109130803Smarcel branch. */ 6110130803Smarcelstatic struct type * 6111130803Smarcelto_record_with_fixed_variant_part (struct type *type, char *valaddr, 6112130803Smarcel CORE_ADDR address, struct value *dval) 6113130803Smarcel{ 6114130803Smarcel struct value *mark = value_mark (); 6115130803Smarcel struct type *rtype; 6116130803Smarcel struct type *branch_type; 6117130803Smarcel int nfields = TYPE_NFIELDS (type); 6118130803Smarcel 6119130803Smarcel if (dval == NULL) 6120130803Smarcel return type; 6121130803Smarcel 6122130803Smarcel rtype = alloc_type (TYPE_OBJFILE (type)); 6123130803Smarcel TYPE_CODE (rtype) = TYPE_CODE_STRUCT; 6124130803Smarcel INIT_CPLUS_SPECIFIC (type); 6125130803Smarcel TYPE_NFIELDS (rtype) = TYPE_NFIELDS (type); 6126130803Smarcel TYPE_FIELDS (rtype) = 6127130803Smarcel (struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field)); 6128130803Smarcel memcpy (TYPE_FIELDS (rtype), TYPE_FIELDS (type), 6129130803Smarcel sizeof (struct field) * nfields); 6130130803Smarcel TYPE_NAME (rtype) = ada_type_name (type); 6131130803Smarcel TYPE_TAG_NAME (rtype) = NULL; 6132130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6133130803Smarcel /* TYPE_FLAGS (rtype) |= TYPE_FLAG_FIXED_INSTANCE; */ 6134130803Smarcel TYPE_LENGTH (rtype) = TYPE_LENGTH (type); 6135130803Smarcel 6136130803Smarcel branch_type = 6137130803Smarcel to_fixed_variant_branch_type 6138130803Smarcel (TYPE_FIELD_TYPE (type, nfields - 1), 6139130803Smarcel cond_offset_host (valaddr, 6140130803Smarcel TYPE_FIELD_BITPOS (type, 6141130803Smarcel nfields - 1) / TARGET_CHAR_BIT), 6142130803Smarcel cond_offset_target (address, 6143130803Smarcel TYPE_FIELD_BITPOS (type, 6144130803Smarcel nfields - 1) / TARGET_CHAR_BIT), 6145130803Smarcel dval); 6146130803Smarcel if (branch_type == NULL) 6147130803Smarcel { 6148130803Smarcel TYPE_NFIELDS (rtype) -= 1; 6149130803Smarcel TYPE_LENGTH (rtype) -= 6150130803Smarcel TYPE_LENGTH (TYPE_FIELD_TYPE (type, nfields - 1)); 6151130803Smarcel } 6152130803Smarcel else 6153130803Smarcel { 6154130803Smarcel TYPE_FIELD_TYPE (rtype, nfields - 1) = branch_type; 6155130803Smarcel TYPE_FIELD_NAME (rtype, nfields - 1) = "S"; 6156130803Smarcel TYPE_FIELD_BITSIZE (rtype, nfields - 1) = 0; 6157130803Smarcel TYPE_FIELD_STATIC_KIND (rtype, nfields - 1) = 0; 6158130803Smarcel TYPE_LENGTH (rtype) += TYPE_LENGTH (branch_type); 6159130803Smarcel -TYPE_LENGTH (TYPE_FIELD_TYPE (type, nfields - 1)); 6160130803Smarcel } 6161130803Smarcel 6162130803Smarcel return rtype; 6163130803Smarcel} 6164130803Smarcel 6165130803Smarcel/* An ordinary record type (with fixed-length fields) that describes 6166130803Smarcel the value at (TYPE0, VALADDR, ADDRESS) [see explanation at 6167130803Smarcel beginning of this section]. Any necessary discriminants' values 6168130803Smarcel should be in DVAL, a record value; it should be NULL if the object 6169130803Smarcel at ADDR itself contains any necessary discriminant values. A 6170130803Smarcel variant field (unless unchecked) is replaced by a particular branch 6171130803Smarcel of the variant. */ 6172130803Smarcel 6173130803Smarcelstatic struct type * 6174130803Smarcelto_fixed_record_type (struct type *type0, char *valaddr, CORE_ADDR address, 6175130803Smarcel struct value *dval) 6176130803Smarcel{ 6177130803Smarcel struct type *templ_type; 6178130803Smarcel 6179130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6180130803Smarcel /* if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE) 6181130803Smarcel return type0; 6182130803Smarcel */ 6183130803Smarcel templ_type = dynamic_template_type (type0); 6184130803Smarcel 6185130803Smarcel if (templ_type != NULL) 6186130803Smarcel return template_to_fixed_record_type (templ_type, valaddr, address, dval); 6187130803Smarcel else if (contains_variant_part (type0)) 6188130803Smarcel return to_record_with_fixed_variant_part (type0, valaddr, address, dval); 6189130803Smarcel else 6190130803Smarcel { 6191130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6192130803Smarcel /* TYPE_FLAGS (type0) |= TYPE_FLAG_FIXED_INSTANCE; */ 6193130803Smarcel return type0; 6194130803Smarcel } 6195130803Smarcel 6196130803Smarcel} 6197130803Smarcel 6198130803Smarcel/* An ordinary record type (with fixed-length fields) that describes 6199130803Smarcel the value at (VAR_TYPE0, VALADDR, ADDRESS), where VAR_TYPE0 is a 6200130803Smarcel union type. Any necessary discriminants' values should be in DVAL, 6201130803Smarcel a record value. That is, this routine selects the appropriate 6202130803Smarcel branch of the union at ADDR according to the discriminant value 6203130803Smarcel indicated in the union's type name. */ 6204130803Smarcel 6205130803Smarcelstatic struct type * 6206130803Smarcelto_fixed_variant_branch_type (struct type *var_type0, char *valaddr, 6207130803Smarcel CORE_ADDR address, struct value *dval) 6208130803Smarcel{ 6209130803Smarcel int which; 6210130803Smarcel struct type *templ_type; 6211130803Smarcel struct type *var_type; 6212130803Smarcel 6213130803Smarcel if (TYPE_CODE (var_type0) == TYPE_CODE_PTR) 6214130803Smarcel var_type = TYPE_TARGET_TYPE (var_type0); 6215130803Smarcel else 6216130803Smarcel var_type = var_type0; 6217130803Smarcel 6218130803Smarcel templ_type = ada_find_parallel_type (var_type, "___XVU"); 6219130803Smarcel 6220130803Smarcel if (templ_type != NULL) 6221130803Smarcel var_type = templ_type; 6222130803Smarcel 6223130803Smarcel which = 6224130803Smarcel ada_which_variant_applies (var_type, 6225130803Smarcel VALUE_TYPE (dval), VALUE_CONTENTS (dval)); 6226130803Smarcel 6227130803Smarcel if (which < 0) 6228130803Smarcel return empty_record (TYPE_OBJFILE (var_type)); 6229130803Smarcel else if (is_dynamic_field (var_type, which)) 6230130803Smarcel return 6231130803Smarcel to_fixed_record_type 6232130803Smarcel (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (var_type, which)), 6233130803Smarcel valaddr, address, dval); 6234130803Smarcel else if (contains_variant_part (TYPE_FIELD_TYPE (var_type, which))) 6235130803Smarcel return 6236130803Smarcel to_fixed_record_type 6237130803Smarcel (TYPE_FIELD_TYPE (var_type, which), valaddr, address, dval); 6238130803Smarcel else 6239130803Smarcel return TYPE_FIELD_TYPE (var_type, which); 6240130803Smarcel} 6241130803Smarcel 6242130803Smarcel/* Assuming that TYPE0 is an array type describing the type of a value 6243130803Smarcel at ADDR, and that DVAL describes a record containing any 6244130803Smarcel discriminants used in TYPE0, returns a type for the value that 6245130803Smarcel contains no dynamic components (that is, no components whose sizes 6246130803Smarcel are determined by run-time quantities). Unless IGNORE_TOO_BIG is 6247130803Smarcel true, gives an error message if the resulting type's size is over 6248130803Smarcel varsize_limit. 6249130803Smarcel*/ 6250130803Smarcel 6251130803Smarcelstatic struct type * 6252130803Smarcelto_fixed_array_type (struct type *type0, struct value *dval, 6253130803Smarcel int ignore_too_big) 6254130803Smarcel{ 6255130803Smarcel struct type *index_type_desc; 6256130803Smarcel struct type *result; 6257130803Smarcel 6258130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6259130803Smarcel/* if (ada_is_packed_array_type (type0) /* revisit? *//* 6260130803Smarcel || (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE)) 6261130803Smarcel return type0; */ 6262130803Smarcel 6263130803Smarcel index_type_desc = ada_find_parallel_type (type0, "___XA"); 6264130803Smarcel if (index_type_desc == NULL) 6265130803Smarcel { 6266130803Smarcel struct type *elt_type0 = check_typedef (TYPE_TARGET_TYPE (type0)); 6267130803Smarcel /* NOTE: elt_type---the fixed version of elt_type0---should never 6268130803Smarcel * depend on the contents of the array in properly constructed 6269130803Smarcel * debugging data. */ 6270130803Smarcel struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval); 6271130803Smarcel 6272130803Smarcel if (elt_type0 == elt_type) 6273130803Smarcel result = type0; 6274130803Smarcel else 6275130803Smarcel result = create_array_type (alloc_type (TYPE_OBJFILE (type0)), 6276130803Smarcel elt_type, TYPE_INDEX_TYPE (type0)); 6277130803Smarcel } 6278130803Smarcel else 6279130803Smarcel { 6280130803Smarcel int i; 6281130803Smarcel struct type *elt_type0; 6282130803Smarcel 6283130803Smarcel elt_type0 = type0; 6284130803Smarcel for (i = TYPE_NFIELDS (index_type_desc); i > 0; i -= 1) 6285130803Smarcel elt_type0 = TYPE_TARGET_TYPE (elt_type0); 6286130803Smarcel 6287130803Smarcel /* NOTE: result---the fixed version of elt_type0---should never 6288130803Smarcel * depend on the contents of the array in properly constructed 6289130803Smarcel * debugging data. */ 6290130803Smarcel result = ada_to_fixed_type (check_typedef (elt_type0), 0, 0, dval); 6291130803Smarcel for (i = TYPE_NFIELDS (index_type_desc) - 1; i >= 0; i -= 1) 6292130803Smarcel { 6293130803Smarcel struct type *range_type = 6294130803Smarcel to_fixed_range_type (TYPE_FIELD_NAME (index_type_desc, i), 6295130803Smarcel dval, TYPE_OBJFILE (type0)); 6296130803Smarcel result = create_array_type (alloc_type (TYPE_OBJFILE (type0)), 6297130803Smarcel result, range_type); 6298130803Smarcel } 6299130803Smarcel if (!ignore_too_big && TYPE_LENGTH (result) > varsize_limit) 6300130803Smarcel error ("array type with dynamic size is larger than varsize-limit"); 6301130803Smarcel } 6302130803Smarcel 6303130803Smarcel/* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6304130803Smarcel/* TYPE_FLAGS (result) |= TYPE_FLAG_FIXED_INSTANCE; */ 6305130803Smarcel return result; 6306130803Smarcel} 6307130803Smarcel 6308130803Smarcel 6309130803Smarcel/* A standard type (containing no dynamically sized components) 6310130803Smarcel corresponding to TYPE for the value (TYPE, VALADDR, ADDRESS) 6311130803Smarcel DVAL describes a record containing any discriminants used in TYPE0, 6312130803Smarcel and may be NULL if there are none. */ 6313130803Smarcel 6314130803Smarcelstruct type * 6315130803Smarcelada_to_fixed_type (struct type *type, char *valaddr, CORE_ADDR address, 6316130803Smarcel struct value *dval) 6317130803Smarcel{ 6318130803Smarcel CHECK_TYPEDEF (type); 6319130803Smarcel switch (TYPE_CODE (type)) 6320130803Smarcel { 6321130803Smarcel default: 6322130803Smarcel return type; 6323130803Smarcel case TYPE_CODE_STRUCT: 6324130803Smarcel return to_fixed_record_type (type, valaddr, address, NULL); 6325130803Smarcel case TYPE_CODE_ARRAY: 6326130803Smarcel return to_fixed_array_type (type, dval, 0); 6327130803Smarcel case TYPE_CODE_UNION: 6328130803Smarcel if (dval == NULL) 6329130803Smarcel return type; 6330130803Smarcel else 6331130803Smarcel return to_fixed_variant_branch_type (type, valaddr, address, dval); 6332130803Smarcel } 6333130803Smarcel} 6334130803Smarcel 6335130803Smarcel/* A standard (static-sized) type corresponding as well as possible to 6336130803Smarcel TYPE0, but based on no runtime data. */ 6337130803Smarcel 6338130803Smarcelstatic struct type * 6339130803Smarcelto_static_fixed_type (struct type *type0) 6340130803Smarcel{ 6341130803Smarcel struct type *type; 6342130803Smarcel 6343130803Smarcel if (type0 == NULL) 6344130803Smarcel return NULL; 6345130803Smarcel 6346130803Smarcel /* FIXME: TYPE_FLAG_FIXED_INSTANCE should be defined in gdbtypes.h */ 6347130803Smarcel /* if (TYPE_FLAGS (type0) & TYPE_FLAG_FIXED_INSTANCE) 6348130803Smarcel return type0; 6349130803Smarcel */ 6350130803Smarcel CHECK_TYPEDEF (type0); 6351130803Smarcel 6352130803Smarcel switch (TYPE_CODE (type0)) 6353130803Smarcel { 6354130803Smarcel default: 6355130803Smarcel return type0; 6356130803Smarcel case TYPE_CODE_STRUCT: 6357130803Smarcel type = dynamic_template_type (type0); 6358130803Smarcel if (type != NULL) 6359130803Smarcel return template_to_static_fixed_type (type); 6360130803Smarcel return type0; 6361130803Smarcel case TYPE_CODE_UNION: 6362130803Smarcel type = ada_find_parallel_type (type0, "___XVU"); 6363130803Smarcel if (type != NULL) 6364130803Smarcel return template_to_static_fixed_type (type); 6365130803Smarcel return type0; 6366130803Smarcel } 6367130803Smarcel} 6368130803Smarcel 6369130803Smarcel/* A static approximation of TYPE with all type wrappers removed. */ 6370130803Smarcelstatic struct type * 6371130803Smarcelstatic_unwrap_type (struct type *type) 6372130803Smarcel{ 6373130803Smarcel if (ada_is_aligner_type (type)) 6374130803Smarcel { 6375130803Smarcel struct type *type1 = TYPE_FIELD_TYPE (check_typedef (type), 0); 6376130803Smarcel if (ada_type_name (type1) == NULL) 6377130803Smarcel TYPE_NAME (type1) = ada_type_name (type); 6378130803Smarcel 6379130803Smarcel return static_unwrap_type (type1); 6380130803Smarcel } 6381130803Smarcel else 6382130803Smarcel { 6383130803Smarcel struct type *raw_real_type = ada_get_base_type (type); 6384130803Smarcel if (raw_real_type == type) 6385130803Smarcel return type; 6386130803Smarcel else 6387130803Smarcel return to_static_fixed_type (raw_real_type); 6388130803Smarcel } 6389130803Smarcel} 6390130803Smarcel 6391130803Smarcel/* In some cases, incomplete and private types require 6392130803Smarcel cross-references that are not resolved as records (for example, 6393130803Smarcel type Foo; 6394130803Smarcel type FooP is access Foo; 6395130803Smarcel V: FooP; 6396130803Smarcel type Foo is array ...; 6397130803Smarcel ). In these cases, since there is no mechanism for producing 6398130803Smarcel cross-references to such types, we instead substitute for FooP a 6399130803Smarcel stub enumeration type that is nowhere resolved, and whose tag is 6400130803Smarcel the name of the actual type. Call these types "non-record stubs". */ 6401130803Smarcel 6402130803Smarcel/* A type equivalent to TYPE that is not a non-record stub, if one 6403130803Smarcel exists, otherwise TYPE. */ 6404130803Smarcelstruct type * 6405130803Smarcelada_completed_type (struct type *type) 6406130803Smarcel{ 6407130803Smarcel CHECK_TYPEDEF (type); 6408130803Smarcel if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM 6409130803Smarcel || (TYPE_FLAGS (type) & TYPE_FLAG_STUB) == 0 6410130803Smarcel || TYPE_TAG_NAME (type) == NULL) 6411130803Smarcel return type; 6412130803Smarcel else 6413130803Smarcel { 6414130803Smarcel char *name = TYPE_TAG_NAME (type); 6415130803Smarcel struct type *type1 = ada_find_any_type (name); 6416130803Smarcel return (type1 == NULL) ? type : type1; 6417130803Smarcel } 6418130803Smarcel} 6419130803Smarcel 6420130803Smarcel/* A value representing the data at VALADDR/ADDRESS as described by 6421130803Smarcel type TYPE0, but with a standard (static-sized) type that correctly 6422130803Smarcel describes it. If VAL0 is not NULL and TYPE0 already is a standard 6423130803Smarcel type, then return VAL0 [this feature is simply to avoid redundant 6424130803Smarcel creation of struct values]. */ 6425130803Smarcel 6426130803Smarcelstruct value * 6427130803Smarcelada_to_fixed_value (struct type *type0, char *valaddr, CORE_ADDR address, 6428130803Smarcel struct value *val0) 6429130803Smarcel{ 6430130803Smarcel struct type *type = ada_to_fixed_type (type0, valaddr, address, NULL); 6431130803Smarcel if (type == type0 && val0 != NULL) 6432130803Smarcel return val0; 6433130803Smarcel else 6434130803Smarcel return value_from_contents_and_address (type, valaddr, address); 6435130803Smarcel} 6436130803Smarcel 6437130803Smarcel/* A value representing VAL, but with a standard (static-sized) type 6438130803Smarcel chosen to approximate the real type of VAL as well as possible, but 6439130803Smarcel without consulting any runtime values. For Ada dynamic-sized 6440130803Smarcel types, therefore, the type of the result is likely to be inaccurate. */ 6441130803Smarcel 6442130803Smarcelstruct value * 6443130803Smarcelada_to_static_fixed_value (struct value *val) 6444130803Smarcel{ 6445130803Smarcel struct type *type = 6446130803Smarcel to_static_fixed_type (static_unwrap_type (VALUE_TYPE (val))); 6447130803Smarcel if (type == VALUE_TYPE (val)) 6448130803Smarcel return val; 6449130803Smarcel else 6450130803Smarcel return coerce_unspec_val_to_type (val, 0, type); 6451130803Smarcel} 6452130803Smarcel 6453130803Smarcel 6454130803Smarcel 6455130803Smarcel 6456130803Smarcel 6457130803Smarcel/* Attributes */ 6458130803Smarcel 6459130803Smarcel/* Table mapping attribute numbers to names */ 6460130803Smarcel/* NOTE: Keep up to date with enum ada_attribute definition in ada-lang.h */ 6461130803Smarcel 6462130803Smarcelstatic const char *attribute_names[] = { 6463130803Smarcel "<?>", 6464130803Smarcel 6465130803Smarcel "first", 6466130803Smarcel "last", 6467130803Smarcel "length", 6468130803Smarcel "image", 6469130803Smarcel "img", 6470130803Smarcel "max", 6471130803Smarcel "min", 6472130803Smarcel "pos" "tag", 6473130803Smarcel "val", 6474130803Smarcel 6475130803Smarcel 0 6476130803Smarcel}; 6477130803Smarcel 6478130803Smarcelconst char * 6479130803Smarcelada_attribute_name (int n) 6480130803Smarcel{ 6481130803Smarcel if (n > 0 && n < (int) ATR_END) 6482130803Smarcel return attribute_names[n]; 6483130803Smarcel else 6484130803Smarcel return attribute_names[0]; 6485130803Smarcel} 6486130803Smarcel 6487130803Smarcel/* Evaluate the 'POS attribute applied to ARG. */ 6488130803Smarcel 6489130803Smarcelstatic struct value * 6490130803Smarcelvalue_pos_atr (struct value *arg) 6491130803Smarcel{ 6492130803Smarcel struct type *type = VALUE_TYPE (arg); 6493130803Smarcel 6494130803Smarcel if (!discrete_type_p (type)) 6495130803Smarcel error ("'POS only defined on discrete types"); 6496130803Smarcel 6497130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_ENUM) 6498130803Smarcel { 6499130803Smarcel int i; 6500130803Smarcel LONGEST v = value_as_long (arg); 6501130803Smarcel 6502130803Smarcel for (i = 0; i < TYPE_NFIELDS (type); i += 1) 6503130803Smarcel { 6504130803Smarcel if (v == TYPE_FIELD_BITPOS (type, i)) 6505130803Smarcel return value_from_longest (builtin_type_ada_int, i); 6506130803Smarcel } 6507130803Smarcel error ("enumeration value is invalid: can't find 'POS"); 6508130803Smarcel } 6509130803Smarcel else 6510130803Smarcel return value_from_longest (builtin_type_ada_int, value_as_long (arg)); 6511130803Smarcel} 6512130803Smarcel 6513130803Smarcel/* Evaluate the TYPE'VAL attribute applied to ARG. */ 6514130803Smarcel 6515130803Smarcelstatic struct value * 6516130803Smarcelvalue_val_atr (struct type *type, struct value *arg) 6517130803Smarcel{ 6518130803Smarcel if (!discrete_type_p (type)) 6519130803Smarcel error ("'VAL only defined on discrete types"); 6520130803Smarcel if (!integer_type_p (VALUE_TYPE (arg))) 6521130803Smarcel error ("'VAL requires integral argument"); 6522130803Smarcel 6523130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_ENUM) 6524130803Smarcel { 6525130803Smarcel long pos = value_as_long (arg); 6526130803Smarcel if (pos < 0 || pos >= TYPE_NFIELDS (type)) 6527130803Smarcel error ("argument to 'VAL out of range"); 6528130803Smarcel return value_from_longest (type, TYPE_FIELD_BITPOS (type, pos)); 6529130803Smarcel } 6530130803Smarcel else 6531130803Smarcel return value_from_longest (type, value_as_long (arg)); 6532130803Smarcel} 6533130803Smarcel 6534130803Smarcel 6535130803Smarcel /* Evaluation */ 6536130803Smarcel 6537130803Smarcel/* True if TYPE appears to be an Ada character type. 6538130803Smarcel * [At the moment, this is true only for Character and Wide_Character; 6539130803Smarcel * It is a heuristic test that could stand improvement]. */ 6540130803Smarcel 6541130803Smarcelint 6542130803Smarcelada_is_character_type (struct type *type) 6543130803Smarcel{ 6544130803Smarcel const char *name = ada_type_name (type); 6545130803Smarcel return 6546130803Smarcel name != NULL 6547130803Smarcel && (TYPE_CODE (type) == TYPE_CODE_CHAR 6548130803Smarcel || TYPE_CODE (type) == TYPE_CODE_INT 6549130803Smarcel || TYPE_CODE (type) == TYPE_CODE_RANGE) 6550130803Smarcel && (DEPRECATED_STREQ (name, "character") || DEPRECATED_STREQ (name, "wide_character") 6551130803Smarcel || DEPRECATED_STREQ (name, "unsigned char")); 6552130803Smarcel} 6553130803Smarcel 6554130803Smarcel/* True if TYPE appears to be an Ada string type. */ 6555130803Smarcel 6556130803Smarcelint 6557130803Smarcelada_is_string_type (struct type *type) 6558130803Smarcel{ 6559130803Smarcel CHECK_TYPEDEF (type); 6560130803Smarcel if (type != NULL 6561130803Smarcel && TYPE_CODE (type) != TYPE_CODE_PTR 6562130803Smarcel && (ada_is_simple_array (type) || ada_is_array_descriptor (type)) 6563130803Smarcel && ada_array_arity (type) == 1) 6564130803Smarcel { 6565130803Smarcel struct type *elttype = ada_array_element_type (type, 1); 6566130803Smarcel 6567130803Smarcel return ada_is_character_type (elttype); 6568130803Smarcel } 6569130803Smarcel else 6570130803Smarcel return 0; 6571130803Smarcel} 6572130803Smarcel 6573130803Smarcel 6574130803Smarcel/* True if TYPE is a struct type introduced by the compiler to force the 6575130803Smarcel alignment of a value. Such types have a single field with a 6576130803Smarcel distinctive name. */ 6577130803Smarcel 6578130803Smarcelint 6579130803Smarcelada_is_aligner_type (struct type *type) 6580130803Smarcel{ 6581130803Smarcel CHECK_TYPEDEF (type); 6582130803Smarcel return (TYPE_CODE (type) == TYPE_CODE_STRUCT 6583130803Smarcel && TYPE_NFIELDS (type) == 1 6584130803Smarcel && DEPRECATED_STREQ (TYPE_FIELD_NAME (type, 0), "F")); 6585130803Smarcel} 6586130803Smarcel 6587130803Smarcel/* If there is an ___XVS-convention type parallel to SUBTYPE, return 6588130803Smarcel the parallel type. */ 6589130803Smarcel 6590130803Smarcelstruct type * 6591130803Smarcelada_get_base_type (struct type *raw_type) 6592130803Smarcel{ 6593130803Smarcel struct type *real_type_namer; 6594130803Smarcel struct type *raw_real_type; 6595130803Smarcel struct type *real_type; 6596130803Smarcel 6597130803Smarcel if (raw_type == NULL || TYPE_CODE (raw_type) != TYPE_CODE_STRUCT) 6598130803Smarcel return raw_type; 6599130803Smarcel 6600130803Smarcel real_type_namer = ada_find_parallel_type (raw_type, "___XVS"); 6601130803Smarcel if (real_type_namer == NULL 6602130803Smarcel || TYPE_CODE (real_type_namer) != TYPE_CODE_STRUCT 6603130803Smarcel || TYPE_NFIELDS (real_type_namer) != 1) 6604130803Smarcel return raw_type; 6605130803Smarcel 6606130803Smarcel raw_real_type = ada_find_any_type (TYPE_FIELD_NAME (real_type_namer, 0)); 6607130803Smarcel if (raw_real_type == NULL) 6608130803Smarcel return raw_type; 6609130803Smarcel else 6610130803Smarcel return raw_real_type; 6611130803Smarcel} 6612130803Smarcel 6613130803Smarcel/* The type of value designated by TYPE, with all aligners removed. */ 6614130803Smarcel 6615130803Smarcelstruct type * 6616130803Smarcelada_aligned_type (struct type *type) 6617130803Smarcel{ 6618130803Smarcel if (ada_is_aligner_type (type)) 6619130803Smarcel return ada_aligned_type (TYPE_FIELD_TYPE (type, 0)); 6620130803Smarcel else 6621130803Smarcel return ada_get_base_type (type); 6622130803Smarcel} 6623130803Smarcel 6624130803Smarcel 6625130803Smarcel/* The address of the aligned value in an object at address VALADDR 6626130803Smarcel having type TYPE. Assumes ada_is_aligner_type (TYPE). */ 6627130803Smarcel 6628130803Smarcelchar * 6629130803Smarcelada_aligned_value_addr (struct type *type, char *valaddr) 6630130803Smarcel{ 6631130803Smarcel if (ada_is_aligner_type (type)) 6632130803Smarcel return ada_aligned_value_addr (TYPE_FIELD_TYPE (type, 0), 6633130803Smarcel valaddr + 6634130803Smarcel TYPE_FIELD_BITPOS (type, 6635130803Smarcel 0) / TARGET_CHAR_BIT); 6636130803Smarcel else 6637130803Smarcel return valaddr; 6638130803Smarcel} 6639130803Smarcel 6640130803Smarcel/* The printed representation of an enumeration literal with encoded 6641130803Smarcel name NAME. The value is good to the next call of ada_enum_name. */ 6642130803Smarcelconst char * 6643130803Smarcelada_enum_name (const char *name) 6644130803Smarcel{ 6645130803Smarcel char *tmp; 6646130803Smarcel 6647130803Smarcel while (1) 6648130803Smarcel { 6649130803Smarcel if ((tmp = strstr (name, "__")) != NULL) 6650130803Smarcel name = tmp + 2; 6651130803Smarcel else if ((tmp = strchr (name, '.')) != NULL) 6652130803Smarcel name = tmp + 1; 6653130803Smarcel else 6654130803Smarcel break; 6655130803Smarcel } 6656130803Smarcel 6657130803Smarcel if (name[0] == 'Q') 6658130803Smarcel { 6659130803Smarcel static char result[16]; 6660130803Smarcel int v; 6661130803Smarcel if (name[1] == 'U' || name[1] == 'W') 6662130803Smarcel { 6663130803Smarcel if (sscanf (name + 2, "%x", &v) != 1) 6664130803Smarcel return name; 6665130803Smarcel } 6666130803Smarcel else 6667130803Smarcel return name; 6668130803Smarcel 6669130803Smarcel if (isascii (v) && isprint (v)) 6670130803Smarcel sprintf (result, "'%c'", v); 6671130803Smarcel else if (name[1] == 'U') 6672130803Smarcel sprintf (result, "[\"%02x\"]", v); 6673130803Smarcel else 6674130803Smarcel sprintf (result, "[\"%04x\"]", v); 6675130803Smarcel 6676130803Smarcel return result; 6677130803Smarcel } 6678130803Smarcel else 6679130803Smarcel return name; 6680130803Smarcel} 6681130803Smarcel 6682130803Smarcelstatic struct value * 6683130803Smarcelevaluate_subexp (struct type *expect_type, struct expression *exp, int *pos, 6684130803Smarcel enum noside noside) 6685130803Smarcel{ 6686130803Smarcel return (*exp->language_defn->evaluate_exp) (expect_type, exp, pos, noside); 6687130803Smarcel} 6688130803Smarcel 6689130803Smarcel/* Evaluate the subexpression of EXP starting at *POS as for 6690130803Smarcel evaluate_type, updating *POS to point just past the evaluated 6691130803Smarcel expression. */ 6692130803Smarcel 6693130803Smarcelstatic struct value * 6694130803Smarcelevaluate_subexp_type (struct expression *exp, int *pos) 6695130803Smarcel{ 6696130803Smarcel return (*exp->language_defn->evaluate_exp) 6697130803Smarcel (NULL_TYPE, exp, pos, EVAL_AVOID_SIDE_EFFECTS); 6698130803Smarcel} 6699130803Smarcel 6700130803Smarcel/* If VAL is wrapped in an aligner or subtype wrapper, return the 6701130803Smarcel value it wraps. */ 6702130803Smarcel 6703130803Smarcelstatic struct value * 6704130803Smarcelunwrap_value (struct value *val) 6705130803Smarcel{ 6706130803Smarcel struct type *type = check_typedef (VALUE_TYPE (val)); 6707130803Smarcel if (ada_is_aligner_type (type)) 6708130803Smarcel { 6709130803Smarcel struct value *v = value_struct_elt (&val, NULL, "F", 6710130803Smarcel NULL, "internal structure"); 6711130803Smarcel struct type *val_type = check_typedef (VALUE_TYPE (v)); 6712130803Smarcel if (ada_type_name (val_type) == NULL) 6713130803Smarcel TYPE_NAME (val_type) = ada_type_name (type); 6714130803Smarcel 6715130803Smarcel return unwrap_value (v); 6716130803Smarcel } 6717130803Smarcel else 6718130803Smarcel { 6719130803Smarcel struct type *raw_real_type = 6720130803Smarcel ada_completed_type (ada_get_base_type (type)); 6721130803Smarcel 6722130803Smarcel if (type == raw_real_type) 6723130803Smarcel return val; 6724130803Smarcel 6725130803Smarcel return 6726130803Smarcel coerce_unspec_val_to_type 6727130803Smarcel (val, 0, ada_to_fixed_type (raw_real_type, 0, 6728130803Smarcel VALUE_ADDRESS (val) + VALUE_OFFSET (val), 6729130803Smarcel NULL)); 6730130803Smarcel } 6731130803Smarcel} 6732130803Smarcel 6733130803Smarcelstatic struct value * 6734130803Smarcelcast_to_fixed (struct type *type, struct value *arg) 6735130803Smarcel{ 6736130803Smarcel LONGEST val; 6737130803Smarcel 6738130803Smarcel if (type == VALUE_TYPE (arg)) 6739130803Smarcel return arg; 6740130803Smarcel else if (ada_is_fixed_point_type (VALUE_TYPE (arg))) 6741130803Smarcel val = ada_float_to_fixed (type, 6742130803Smarcel ada_fixed_to_float (VALUE_TYPE (arg), 6743130803Smarcel value_as_long (arg))); 6744130803Smarcel else 6745130803Smarcel { 6746130803Smarcel DOUBLEST argd = 6747130803Smarcel value_as_double (value_cast (builtin_type_double, value_copy (arg))); 6748130803Smarcel val = ada_float_to_fixed (type, argd); 6749130803Smarcel } 6750130803Smarcel 6751130803Smarcel return value_from_longest (type, val); 6752130803Smarcel} 6753130803Smarcel 6754130803Smarcelstatic struct value * 6755130803Smarcelcast_from_fixed_to_double (struct value *arg) 6756130803Smarcel{ 6757130803Smarcel DOUBLEST val = ada_fixed_to_float (VALUE_TYPE (arg), 6758130803Smarcel value_as_long (arg)); 6759130803Smarcel return value_from_double (builtin_type_double, val); 6760130803Smarcel} 6761130803Smarcel 6762130803Smarcel/* Coerce VAL as necessary for assignment to an lval of type TYPE, and 6763130803Smarcel * return the converted value. */ 6764130803Smarcelstatic struct value * 6765130803Smarcelcoerce_for_assign (struct type *type, struct value *val) 6766130803Smarcel{ 6767130803Smarcel struct type *type2 = VALUE_TYPE (val); 6768130803Smarcel if (type == type2) 6769130803Smarcel return val; 6770130803Smarcel 6771130803Smarcel CHECK_TYPEDEF (type2); 6772130803Smarcel CHECK_TYPEDEF (type); 6773130803Smarcel 6774130803Smarcel if (TYPE_CODE (type2) == TYPE_CODE_PTR 6775130803Smarcel && TYPE_CODE (type) == TYPE_CODE_ARRAY) 6776130803Smarcel { 6777130803Smarcel val = ada_value_ind (val); 6778130803Smarcel type2 = VALUE_TYPE (val); 6779130803Smarcel } 6780130803Smarcel 6781130803Smarcel if (TYPE_CODE (type2) == TYPE_CODE_ARRAY 6782130803Smarcel && TYPE_CODE (type) == TYPE_CODE_ARRAY) 6783130803Smarcel { 6784130803Smarcel if (TYPE_LENGTH (type2) != TYPE_LENGTH (type) 6785130803Smarcel || TYPE_LENGTH (TYPE_TARGET_TYPE (type2)) 6786130803Smarcel != TYPE_LENGTH (TYPE_TARGET_TYPE (type2))) 6787130803Smarcel error ("Incompatible types in assignment"); 6788130803Smarcel VALUE_TYPE (val) = type; 6789130803Smarcel } 6790130803Smarcel return val; 6791130803Smarcel} 6792130803Smarcel 6793130803Smarcelstruct value * 6794130803Smarcelada_evaluate_subexp (struct type *expect_type, struct expression *exp, 6795130803Smarcel int *pos, enum noside noside) 6796130803Smarcel{ 6797130803Smarcel enum exp_opcode op; 6798130803Smarcel enum ada_attribute atr; 6799130803Smarcel int tem, tem2, tem3; 6800130803Smarcel int pc; 6801130803Smarcel struct value *arg1 = NULL, *arg2 = NULL, *arg3; 6802130803Smarcel struct type *type; 6803130803Smarcel int nargs; 6804130803Smarcel struct value **argvec; 6805130803Smarcel 6806130803Smarcel pc = *pos; 6807130803Smarcel *pos += 1; 6808130803Smarcel op = exp->elts[pc].opcode; 6809130803Smarcel 6810130803Smarcel switch (op) 6811130803Smarcel { 6812130803Smarcel default: 6813130803Smarcel *pos -= 1; 6814130803Smarcel return 6815130803Smarcel unwrap_value (evaluate_subexp_standard 6816130803Smarcel (expect_type, exp, pos, noside)); 6817130803Smarcel 6818130803Smarcel case UNOP_CAST: 6819130803Smarcel (*pos) += 2; 6820130803Smarcel type = exp->elts[pc + 1].type; 6821130803Smarcel arg1 = evaluate_subexp (type, exp, pos, noside); 6822130803Smarcel if (noside == EVAL_SKIP) 6823130803Smarcel goto nosideret; 6824130803Smarcel if (type != check_typedef (VALUE_TYPE (arg1))) 6825130803Smarcel { 6826130803Smarcel if (ada_is_fixed_point_type (type)) 6827130803Smarcel arg1 = cast_to_fixed (type, arg1); 6828130803Smarcel else if (ada_is_fixed_point_type (VALUE_TYPE (arg1))) 6829130803Smarcel arg1 = value_cast (type, cast_from_fixed_to_double (arg1)); 6830130803Smarcel else if (VALUE_LVAL (arg1) == lval_memory) 6831130803Smarcel { 6832130803Smarcel /* This is in case of the really obscure (and undocumented, 6833130803Smarcel but apparently expected) case of (Foo) Bar.all, where Bar 6834130803Smarcel is an integer constant and Foo is a dynamic-sized type. 6835130803Smarcel If we don't do this, ARG1 will simply be relabeled with 6836130803Smarcel TYPE. */ 6837130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 6838130803Smarcel return value_zero (to_static_fixed_type (type), not_lval); 6839130803Smarcel arg1 = 6840130803Smarcel ada_to_fixed_value 6841130803Smarcel (type, 0, VALUE_ADDRESS (arg1) + VALUE_OFFSET (arg1), 0); 6842130803Smarcel } 6843130803Smarcel else 6844130803Smarcel arg1 = value_cast (type, arg1); 6845130803Smarcel } 6846130803Smarcel return arg1; 6847130803Smarcel 6848130803Smarcel /* FIXME: UNOP_QUAL should be defined in expression.h */ 6849130803Smarcel /* case UNOP_QUAL: 6850130803Smarcel (*pos) += 2; 6851130803Smarcel type = exp->elts[pc + 1].type; 6852130803Smarcel return ada_evaluate_subexp (type, exp, pos, noside); 6853130803Smarcel */ 6854130803Smarcel case BINOP_ASSIGN: 6855130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 6856130803Smarcel arg2 = evaluate_subexp (VALUE_TYPE (arg1), exp, pos, noside); 6857130803Smarcel if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS) 6858130803Smarcel return arg1; 6859130803Smarcel if (binop_user_defined_p (op, arg1, arg2)) 6860130803Smarcel return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL); 6861130803Smarcel else 6862130803Smarcel { 6863130803Smarcel if (ada_is_fixed_point_type (VALUE_TYPE (arg1))) 6864130803Smarcel arg2 = cast_to_fixed (VALUE_TYPE (arg1), arg2); 6865130803Smarcel else if (ada_is_fixed_point_type (VALUE_TYPE (arg2))) 6866130803Smarcel error 6867130803Smarcel ("Fixed-point values must be assigned to fixed-point variables"); 6868130803Smarcel else 6869130803Smarcel arg2 = coerce_for_assign (VALUE_TYPE (arg1), arg2); 6870130803Smarcel return ada_value_assign (arg1, arg2); 6871130803Smarcel } 6872130803Smarcel 6873130803Smarcel case BINOP_ADD: 6874130803Smarcel arg1 = evaluate_subexp_with_coercion (exp, pos, noside); 6875130803Smarcel arg2 = evaluate_subexp_with_coercion (exp, pos, noside); 6876130803Smarcel if (noside == EVAL_SKIP) 6877130803Smarcel goto nosideret; 6878130803Smarcel if (binop_user_defined_p (op, arg1, arg2)) 6879130803Smarcel return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL); 6880130803Smarcel else 6881130803Smarcel { 6882130803Smarcel if ((ada_is_fixed_point_type (VALUE_TYPE (arg1)) 6883130803Smarcel || ada_is_fixed_point_type (VALUE_TYPE (arg2))) 6884130803Smarcel && VALUE_TYPE (arg1) != VALUE_TYPE (arg2)) 6885130803Smarcel error 6886130803Smarcel ("Operands of fixed-point addition must have the same type"); 6887130803Smarcel return value_cast (VALUE_TYPE (arg1), value_add (arg1, arg2)); 6888130803Smarcel } 6889130803Smarcel 6890130803Smarcel case BINOP_SUB: 6891130803Smarcel arg1 = evaluate_subexp_with_coercion (exp, pos, noside); 6892130803Smarcel arg2 = evaluate_subexp_with_coercion (exp, pos, noside); 6893130803Smarcel if (noside == EVAL_SKIP) 6894130803Smarcel goto nosideret; 6895130803Smarcel if (binop_user_defined_p (op, arg1, arg2)) 6896130803Smarcel return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL); 6897130803Smarcel else 6898130803Smarcel { 6899130803Smarcel if ((ada_is_fixed_point_type (VALUE_TYPE (arg1)) 6900130803Smarcel || ada_is_fixed_point_type (VALUE_TYPE (arg2))) 6901130803Smarcel && VALUE_TYPE (arg1) != VALUE_TYPE (arg2)) 6902130803Smarcel error 6903130803Smarcel ("Operands of fixed-point subtraction must have the same type"); 6904130803Smarcel return value_cast (VALUE_TYPE (arg1), value_sub (arg1, arg2)); 6905130803Smarcel } 6906130803Smarcel 6907130803Smarcel case BINOP_MUL: 6908130803Smarcel case BINOP_DIV: 6909130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 6910130803Smarcel arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 6911130803Smarcel if (noside == EVAL_SKIP) 6912130803Smarcel goto nosideret; 6913130803Smarcel if (binop_user_defined_p (op, arg1, arg2)) 6914130803Smarcel return value_x_binop (arg1, arg2, op, OP_NULL, EVAL_NORMAL); 6915130803Smarcel else 6916130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS 6917130803Smarcel && (op == BINOP_DIV || op == BINOP_REM || op == BINOP_MOD)) 6918130803Smarcel return value_zero (VALUE_TYPE (arg1), not_lval); 6919130803Smarcel else 6920130803Smarcel { 6921130803Smarcel if (ada_is_fixed_point_type (VALUE_TYPE (arg1))) 6922130803Smarcel arg1 = cast_from_fixed_to_double (arg1); 6923130803Smarcel if (ada_is_fixed_point_type (VALUE_TYPE (arg2))) 6924130803Smarcel arg2 = cast_from_fixed_to_double (arg2); 6925130803Smarcel return value_binop (arg1, arg2, op); 6926130803Smarcel } 6927130803Smarcel 6928130803Smarcel case UNOP_NEG: 6929130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 6930130803Smarcel if (noside == EVAL_SKIP) 6931130803Smarcel goto nosideret; 6932130803Smarcel if (unop_user_defined_p (op, arg1)) 6933130803Smarcel return value_x_unop (arg1, op, EVAL_NORMAL); 6934130803Smarcel else if (ada_is_fixed_point_type (VALUE_TYPE (arg1))) 6935130803Smarcel return value_cast (VALUE_TYPE (arg1), value_neg (arg1)); 6936130803Smarcel else 6937130803Smarcel return value_neg (arg1); 6938130803Smarcel 6939130803Smarcel /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 6940130803Smarcel /* case OP_UNRESOLVED_VALUE: 6941130803Smarcel /* Only encountered when an unresolved symbol occurs in a 6942130803Smarcel context other than a function call, in which case, it is 6943130803Smarcel illegal. *//* 6944130803Smarcel (*pos) += 3; 6945130803Smarcel if (noside == EVAL_SKIP) 6946130803Smarcel goto nosideret; 6947130803Smarcel else 6948130803Smarcel error ("Unexpected unresolved symbol, %s, during evaluation", 6949130803Smarcel ada_demangle (exp->elts[pc + 2].name)); 6950130803Smarcel */ 6951130803Smarcel case OP_VAR_VALUE: 6952130803Smarcel *pos -= 1; 6953130803Smarcel if (noside == EVAL_SKIP) 6954130803Smarcel { 6955130803Smarcel *pos += 4; 6956130803Smarcel goto nosideret; 6957130803Smarcel } 6958130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 6959130803Smarcel { 6960130803Smarcel *pos += 4; 6961130803Smarcel return value_zero 6962130803Smarcel (to_static_fixed_type 6963130803Smarcel (static_unwrap_type (SYMBOL_TYPE (exp->elts[pc + 2].symbol))), 6964130803Smarcel not_lval); 6965130803Smarcel } 6966130803Smarcel else 6967130803Smarcel { 6968130803Smarcel arg1 = 6969130803Smarcel unwrap_value (evaluate_subexp_standard 6970130803Smarcel (expect_type, exp, pos, noside)); 6971130803Smarcel return ada_to_fixed_value (VALUE_TYPE (arg1), 0, 6972130803Smarcel VALUE_ADDRESS (arg1) + 6973130803Smarcel VALUE_OFFSET (arg1), arg1); 6974130803Smarcel } 6975130803Smarcel 6976130803Smarcel case OP_ARRAY: 6977130803Smarcel (*pos) += 3; 6978130803Smarcel tem2 = longest_to_int (exp->elts[pc + 1].longconst); 6979130803Smarcel tem3 = longest_to_int (exp->elts[pc + 2].longconst); 6980130803Smarcel nargs = tem3 - tem2 + 1; 6981130803Smarcel type = expect_type ? check_typedef (expect_type) : NULL_TYPE; 6982130803Smarcel 6983130803Smarcel argvec = 6984130803Smarcel (struct value * *) alloca (sizeof (struct value *) * (nargs + 1)); 6985130803Smarcel for (tem = 0; tem == 0 || tem < nargs; tem += 1) 6986130803Smarcel /* At least one element gets inserted for the type */ 6987130803Smarcel { 6988130803Smarcel /* Ensure that array expressions are coerced into pointer objects. */ 6989130803Smarcel argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); 6990130803Smarcel } 6991130803Smarcel if (noside == EVAL_SKIP) 6992130803Smarcel goto nosideret; 6993130803Smarcel return value_array (tem2, tem3, argvec); 6994130803Smarcel 6995130803Smarcel case OP_FUNCALL: 6996130803Smarcel (*pos) += 2; 6997130803Smarcel 6998130803Smarcel /* Allocate arg vector, including space for the function to be 6999130803Smarcel called in argvec[0] and a terminating NULL */ 7000130803Smarcel nargs = longest_to_int (exp->elts[pc + 1].longconst); 7001130803Smarcel argvec = 7002130803Smarcel (struct value * *) alloca (sizeof (struct value *) * (nargs + 2)); 7003130803Smarcel 7004130803Smarcel /* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */ 7005130803Smarcel /* FIXME: name should be defined in expresion.h */ 7006130803Smarcel /* if (exp->elts[*pos].opcode == OP_UNRESOLVED_VALUE) 7007130803Smarcel error ("Unexpected unresolved symbol, %s, during evaluation", 7008130803Smarcel ada_demangle (exp->elts[pc + 5].name)); 7009130803Smarcel */ 7010130803Smarcel if (0) 7011130803Smarcel { 7012130803Smarcel error ("unexpected code path, FIXME"); 7013130803Smarcel } 7014130803Smarcel else 7015130803Smarcel { 7016130803Smarcel for (tem = 0; tem <= nargs; tem += 1) 7017130803Smarcel argvec[tem] = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7018130803Smarcel argvec[tem] = 0; 7019130803Smarcel 7020130803Smarcel if (noside == EVAL_SKIP) 7021130803Smarcel goto nosideret; 7022130803Smarcel } 7023130803Smarcel 7024130803Smarcel if (TYPE_CODE (VALUE_TYPE (argvec[0])) == TYPE_CODE_REF) 7025130803Smarcel argvec[0] = value_addr (argvec[0]); 7026130803Smarcel 7027130803Smarcel if (ada_is_packed_array_type (VALUE_TYPE (argvec[0]))) 7028130803Smarcel argvec[0] = ada_coerce_to_simple_array (argvec[0]); 7029130803Smarcel 7030130803Smarcel type = check_typedef (VALUE_TYPE (argvec[0])); 7031130803Smarcel if (TYPE_CODE (type) == TYPE_CODE_PTR) 7032130803Smarcel { 7033130803Smarcel switch (TYPE_CODE (check_typedef (TYPE_TARGET_TYPE (type)))) 7034130803Smarcel { 7035130803Smarcel case TYPE_CODE_FUNC: 7036130803Smarcel type = check_typedef (TYPE_TARGET_TYPE (type)); 7037130803Smarcel break; 7038130803Smarcel case TYPE_CODE_ARRAY: 7039130803Smarcel break; 7040130803Smarcel case TYPE_CODE_STRUCT: 7041130803Smarcel if (noside != EVAL_AVOID_SIDE_EFFECTS) 7042130803Smarcel argvec[0] = ada_value_ind (argvec[0]); 7043130803Smarcel type = check_typedef (TYPE_TARGET_TYPE (type)); 7044130803Smarcel break; 7045130803Smarcel default: 7046130803Smarcel error ("cannot subscript or call something of type `%s'", 7047130803Smarcel ada_type_name (VALUE_TYPE (argvec[0]))); 7048130803Smarcel break; 7049130803Smarcel } 7050130803Smarcel } 7051130803Smarcel 7052130803Smarcel switch (TYPE_CODE (type)) 7053130803Smarcel { 7054130803Smarcel case TYPE_CODE_FUNC: 7055130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7056130803Smarcel return allocate_value (TYPE_TARGET_TYPE (type)); 7057130803Smarcel return call_function_by_hand (argvec[0], nargs, argvec + 1); 7058130803Smarcel case TYPE_CODE_STRUCT: 7059130803Smarcel { 7060130803Smarcel int arity = ada_array_arity (type); 7061130803Smarcel type = ada_array_element_type (type, nargs); 7062130803Smarcel if (type == NULL) 7063130803Smarcel error ("cannot subscript or call a record"); 7064130803Smarcel if (arity != nargs) 7065130803Smarcel error ("wrong number of subscripts; expecting %d", arity); 7066130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7067130803Smarcel return allocate_value (ada_aligned_type (type)); 7068130803Smarcel return 7069130803Smarcel unwrap_value (ada_value_subscript 7070130803Smarcel (argvec[0], nargs, argvec + 1)); 7071130803Smarcel } 7072130803Smarcel case TYPE_CODE_ARRAY: 7073130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7074130803Smarcel { 7075130803Smarcel type = ada_array_element_type (type, nargs); 7076130803Smarcel if (type == NULL) 7077130803Smarcel error ("element type of array unknown"); 7078130803Smarcel else 7079130803Smarcel return allocate_value (ada_aligned_type (type)); 7080130803Smarcel } 7081130803Smarcel return 7082130803Smarcel unwrap_value (ada_value_subscript 7083130803Smarcel (ada_coerce_to_simple_array (argvec[0]), 7084130803Smarcel nargs, argvec + 1)); 7085130803Smarcel case TYPE_CODE_PTR: /* Pointer to array */ 7086130803Smarcel type = to_fixed_array_type (TYPE_TARGET_TYPE (type), NULL, 1); 7087130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7088130803Smarcel { 7089130803Smarcel type = ada_array_element_type (type, nargs); 7090130803Smarcel if (type == NULL) 7091130803Smarcel error ("element type of array unknown"); 7092130803Smarcel else 7093130803Smarcel return allocate_value (ada_aligned_type (type)); 7094130803Smarcel } 7095130803Smarcel return 7096130803Smarcel unwrap_value (ada_value_ptr_subscript (argvec[0], type, 7097130803Smarcel nargs, argvec + 1)); 7098130803Smarcel 7099130803Smarcel default: 7100130803Smarcel error ("Internal error in evaluate_subexp"); 7101130803Smarcel } 7102130803Smarcel 7103130803Smarcel case TERNOP_SLICE: 7104130803Smarcel { 7105130803Smarcel struct value *array = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7106130803Smarcel int lowbound 7107130803Smarcel = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); 7108130803Smarcel int upper 7109130803Smarcel = value_as_long (evaluate_subexp (NULL_TYPE, exp, pos, noside)); 7110130803Smarcel if (noside == EVAL_SKIP) 7111130803Smarcel goto nosideret; 7112130803Smarcel 7113130803Smarcel /* If this is a reference to an array, then dereference it */ 7114130803Smarcel if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_REF 7115130803Smarcel && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL 7116130803Smarcel && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) == 7117130803Smarcel TYPE_CODE_ARRAY 7118130803Smarcel && !ada_is_array_descriptor (check_typedef (VALUE_TYPE (array)))) 7119130803Smarcel { 7120130803Smarcel array = ada_coerce_ref (array); 7121130803Smarcel } 7122130803Smarcel 7123130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS && 7124130803Smarcel ada_is_array_descriptor (check_typedef (VALUE_TYPE (array)))) 7125130803Smarcel { 7126130803Smarcel /* Try to dereference the array, in case it is an access to array */ 7127130803Smarcel struct type *arrType = ada_type_of_array (array, 0); 7128130803Smarcel if (arrType != NULL) 7129130803Smarcel array = value_at_lazy (arrType, 0, NULL); 7130130803Smarcel } 7131130803Smarcel if (ada_is_array_descriptor (VALUE_TYPE (array))) 7132130803Smarcel array = ada_coerce_to_simple_array (array); 7133130803Smarcel 7134130803Smarcel /* If at this point we have a pointer to an array, it means that 7135130803Smarcel it is a pointer to a simple (non-ada) array. We just then 7136130803Smarcel dereference it */ 7137130803Smarcel if (TYPE_CODE (VALUE_TYPE (array)) == TYPE_CODE_PTR 7138130803Smarcel && TYPE_TARGET_TYPE (VALUE_TYPE (array)) != NULL 7139130803Smarcel && TYPE_CODE (TYPE_TARGET_TYPE (VALUE_TYPE (array))) == 7140130803Smarcel TYPE_CODE_ARRAY) 7141130803Smarcel { 7142130803Smarcel array = ada_value_ind (array); 7143130803Smarcel } 7144130803Smarcel 7145130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7146130803Smarcel /* The following will get the bounds wrong, but only in contexts 7147130803Smarcel where the value is not being requested (FIXME?). */ 7148130803Smarcel return array; 7149130803Smarcel else 7150130803Smarcel return value_slice (array, lowbound, upper - lowbound + 1); 7151130803Smarcel } 7152130803Smarcel 7153130803Smarcel /* FIXME: UNOP_MBR should be defined in expression.h */ 7154130803Smarcel /* case UNOP_MBR: 7155130803Smarcel (*pos) += 2; 7156130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7157130803Smarcel type = exp->elts[pc + 1].type; 7158130803Smarcel 7159130803Smarcel if (noside == EVAL_SKIP) 7160130803Smarcel goto nosideret; 7161130803Smarcel 7162130803Smarcel switch (TYPE_CODE (type)) 7163130803Smarcel { 7164130803Smarcel default: 7165130803Smarcel warning ("Membership test incompletely implemented; always returns true"); 7166130803Smarcel return value_from_longest (builtin_type_int, (LONGEST) 1); 7167130803Smarcel 7168130803Smarcel case TYPE_CODE_RANGE: 7169130803Smarcel arg2 = value_from_longest (builtin_type_int, 7170130803Smarcel (LONGEST) TYPE_LOW_BOUND (type)); 7171130803Smarcel arg3 = value_from_longest (builtin_type_int, 7172130803Smarcel (LONGEST) TYPE_HIGH_BOUND (type)); 7173130803Smarcel return 7174130803Smarcel value_from_longest (builtin_type_int, 7175130803Smarcel (value_less (arg1,arg3) 7176130803Smarcel || value_equal (arg1,arg3)) 7177130803Smarcel && (value_less (arg2,arg1) 7178130803Smarcel || value_equal (arg2,arg1))); 7179130803Smarcel } 7180130803Smarcel */ 7181130803Smarcel /* FIXME: BINOP_MBR should be defined in expression.h */ 7182130803Smarcel /* case BINOP_MBR: 7183130803Smarcel (*pos) += 2; 7184130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7185130803Smarcel arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7186130803Smarcel 7187130803Smarcel if (noside == EVAL_SKIP) 7188130803Smarcel goto nosideret; 7189130803Smarcel 7190130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7191130803Smarcel return value_zero (builtin_type_int, not_lval); 7192130803Smarcel 7193130803Smarcel tem = longest_to_int (exp->elts[pc + 1].longconst); 7194130803Smarcel 7195130803Smarcel if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg2))) 7196130803Smarcel error ("invalid dimension number to '%s", "range"); 7197130803Smarcel 7198130803Smarcel arg3 = ada_array_bound (arg2, tem, 1); 7199130803Smarcel arg2 = ada_array_bound (arg2, tem, 0); 7200130803Smarcel 7201130803Smarcel return 7202130803Smarcel value_from_longest (builtin_type_int, 7203130803Smarcel (value_less (arg1,arg3) 7204130803Smarcel || value_equal (arg1,arg3)) 7205130803Smarcel && (value_less (arg2,arg1) 7206130803Smarcel || value_equal (arg2,arg1))); 7207130803Smarcel */ 7208130803Smarcel /* FIXME: TERNOP_MBR should be defined in expression.h */ 7209130803Smarcel /* case TERNOP_MBR: 7210130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7211130803Smarcel arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7212130803Smarcel arg3 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7213130803Smarcel 7214130803Smarcel if (noside == EVAL_SKIP) 7215130803Smarcel goto nosideret; 7216130803Smarcel 7217130803Smarcel return 7218130803Smarcel value_from_longest (builtin_type_int, 7219130803Smarcel (value_less (arg1,arg3) 7220130803Smarcel || value_equal (arg1,arg3)) 7221130803Smarcel && (value_less (arg2,arg1) 7222130803Smarcel || value_equal (arg2,arg1))); 7223130803Smarcel */ 7224130803Smarcel /* FIXME: OP_ATTRIBUTE should be defined in expression.h */ 7225130803Smarcel /* case OP_ATTRIBUTE: 7226130803Smarcel *pos += 3; 7227130803Smarcel atr = (enum ada_attribute) longest_to_int (exp->elts[pc + 2].longconst); 7228130803Smarcel switch (atr) 7229130803Smarcel { 7230130803Smarcel default: 7231130803Smarcel error ("unexpected attribute encountered"); 7232130803Smarcel 7233130803Smarcel case ATR_FIRST: 7234130803Smarcel case ATR_LAST: 7235130803Smarcel case ATR_LENGTH: 7236130803Smarcel { 7237130803Smarcel struct type* type_arg; 7238130803Smarcel if (exp->elts[*pos].opcode == OP_TYPE) 7239130803Smarcel { 7240130803Smarcel evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); 7241130803Smarcel arg1 = NULL; 7242130803Smarcel type_arg = exp->elts[pc + 5].type; 7243130803Smarcel } 7244130803Smarcel else 7245130803Smarcel { 7246130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7247130803Smarcel type_arg = NULL; 7248130803Smarcel } 7249130803Smarcel 7250130803Smarcel if (exp->elts[*pos].opcode != OP_LONG) 7251130803Smarcel error ("illegal operand to '%s", ada_attribute_name (atr)); 7252130803Smarcel tem = longest_to_int (exp->elts[*pos+2].longconst); 7253130803Smarcel *pos += 4; 7254130803Smarcel 7255130803Smarcel if (noside == EVAL_SKIP) 7256130803Smarcel goto nosideret; 7257130803Smarcel 7258130803Smarcel if (type_arg == NULL) 7259130803Smarcel { 7260130803Smarcel arg1 = ada_coerce_ref (arg1); 7261130803Smarcel 7262130803Smarcel if (ada_is_packed_array_type (VALUE_TYPE (arg1))) 7263130803Smarcel arg1 = ada_coerce_to_simple_array (arg1); 7264130803Smarcel 7265130803Smarcel if (tem < 1 || tem > ada_array_arity (VALUE_TYPE (arg1))) 7266130803Smarcel error ("invalid dimension number to '%s", 7267130803Smarcel ada_attribute_name (atr)); 7268130803Smarcel 7269130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7270130803Smarcel { 7271130803Smarcel type = ada_index_type (VALUE_TYPE (arg1), tem); 7272130803Smarcel if (type == NULL) 7273130803Smarcel error ("attempt to take bound of something that is not an array"); 7274130803Smarcel return allocate_value (type); 7275130803Smarcel } 7276130803Smarcel 7277130803Smarcel switch (atr) 7278130803Smarcel { 7279130803Smarcel default: 7280130803Smarcel error ("unexpected attribute encountered"); 7281130803Smarcel case ATR_FIRST: 7282130803Smarcel return ada_array_bound (arg1, tem, 0); 7283130803Smarcel case ATR_LAST: 7284130803Smarcel return ada_array_bound (arg1, tem, 1); 7285130803Smarcel case ATR_LENGTH: 7286130803Smarcel return ada_array_length (arg1, tem); 7287130803Smarcel } 7288130803Smarcel } 7289130803Smarcel else if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE 7290130803Smarcel || TYPE_CODE (type_arg) == TYPE_CODE_INT) 7291130803Smarcel { 7292130803Smarcel struct type* range_type; 7293130803Smarcel char* name = ada_type_name (type_arg); 7294130803Smarcel if (name == NULL) 7295130803Smarcel { 7296130803Smarcel if (TYPE_CODE (type_arg) == TYPE_CODE_RANGE) 7297130803Smarcel range_type = type_arg; 7298130803Smarcel else 7299130803Smarcel error ("unimplemented type attribute"); 7300130803Smarcel } 7301130803Smarcel else 7302130803Smarcel range_type = 7303130803Smarcel to_fixed_range_type (name, NULL, TYPE_OBJFILE (type_arg)); 7304130803Smarcel switch (atr) 7305130803Smarcel { 7306130803Smarcel default: 7307130803Smarcel error ("unexpected attribute encountered"); 7308130803Smarcel case ATR_FIRST: 7309130803Smarcel return value_from_longest (TYPE_TARGET_TYPE (range_type), 7310130803Smarcel TYPE_LOW_BOUND (range_type)); 7311130803Smarcel case ATR_LAST: 7312130803Smarcel return value_from_longest (TYPE_TARGET_TYPE (range_type), 7313130803Smarcel TYPE_HIGH_BOUND (range_type)); 7314130803Smarcel } 7315130803Smarcel } 7316130803Smarcel else if (TYPE_CODE (type_arg) == TYPE_CODE_ENUM) 7317130803Smarcel { 7318130803Smarcel switch (atr) 7319130803Smarcel { 7320130803Smarcel default: 7321130803Smarcel error ("unexpected attribute encountered"); 7322130803Smarcel case ATR_FIRST: 7323130803Smarcel return value_from_longest 7324130803Smarcel (type_arg, TYPE_FIELD_BITPOS (type_arg, 0)); 7325130803Smarcel case ATR_LAST: 7326130803Smarcel return value_from_longest 7327130803Smarcel (type_arg, 7328130803Smarcel TYPE_FIELD_BITPOS (type_arg, 7329130803Smarcel TYPE_NFIELDS (type_arg) - 1)); 7330130803Smarcel } 7331130803Smarcel } 7332130803Smarcel else if (TYPE_CODE (type_arg) == TYPE_CODE_FLT) 7333130803Smarcel error ("unimplemented type attribute"); 7334130803Smarcel else 7335130803Smarcel { 7336130803Smarcel LONGEST low, high; 7337130803Smarcel 7338130803Smarcel if (ada_is_packed_array_type (type_arg)) 7339130803Smarcel type_arg = decode_packed_array_type (type_arg); 7340130803Smarcel 7341130803Smarcel if (tem < 1 || tem > ada_array_arity (type_arg)) 7342130803Smarcel error ("invalid dimension number to '%s", 7343130803Smarcel ada_attribute_name (atr)); 7344130803Smarcel 7345130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7346130803Smarcel { 7347130803Smarcel type = ada_index_type (type_arg, tem); 7348130803Smarcel if (type == NULL) 7349130803Smarcel error ("attempt to take bound of something that is not an array"); 7350130803Smarcel return allocate_value (type); 7351130803Smarcel } 7352130803Smarcel 7353130803Smarcel switch (atr) 7354130803Smarcel { 7355130803Smarcel default: 7356130803Smarcel error ("unexpected attribute encountered"); 7357130803Smarcel case ATR_FIRST: 7358130803Smarcel low = ada_array_bound_from_type (type_arg, tem, 0, &type); 7359130803Smarcel return value_from_longest (type, low); 7360130803Smarcel case ATR_LAST: 7361130803Smarcel high = ada_array_bound_from_type (type_arg, tem, 1, &type); 7362130803Smarcel return value_from_longest (type, high); 7363130803Smarcel case ATR_LENGTH: 7364130803Smarcel low = ada_array_bound_from_type (type_arg, tem, 0, &type); 7365130803Smarcel high = ada_array_bound_from_type (type_arg, tem, 1, NULL); 7366130803Smarcel return value_from_longest (type, high-low+1); 7367130803Smarcel } 7368130803Smarcel } 7369130803Smarcel } 7370130803Smarcel 7371130803Smarcel case ATR_TAG: 7372130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7373130803Smarcel if (noside == EVAL_SKIP) 7374130803Smarcel goto nosideret; 7375130803Smarcel 7376130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7377130803Smarcel return 7378130803Smarcel value_zero (ada_tag_type (arg1), not_lval); 7379130803Smarcel 7380130803Smarcel return ada_value_tag (arg1); 7381130803Smarcel 7382130803Smarcel case ATR_MIN: 7383130803Smarcel case ATR_MAX: 7384130803Smarcel evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); 7385130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7386130803Smarcel arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7387130803Smarcel if (noside == EVAL_SKIP) 7388130803Smarcel goto nosideret; 7389130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 7390130803Smarcel return value_zero (VALUE_TYPE (arg1), not_lval); 7391130803Smarcel else 7392130803Smarcel return value_binop (arg1, arg2, 7393130803Smarcel atr == ATR_MIN ? BINOP_MIN : BINOP_MAX); 7394130803Smarcel 7395130803Smarcel case ATR_MODULUS: 7396130803Smarcel { 7397130803Smarcel struct type* type_arg = exp->elts[pc + 5].type; 7398130803Smarcel evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); 7399130803Smarcel *pos += 4; 7400130803Smarcel 7401130803Smarcel if (noside == EVAL_SKIP) 7402130803Smarcel goto nosideret; 7403130803Smarcel 7404130803Smarcel if (! ada_is_modular_type (type_arg)) 7405130803Smarcel error ("'modulus must be applied to modular type"); 7406130803Smarcel 7407130803Smarcel return value_from_longest (TYPE_TARGET_TYPE (type_arg), 7408130803Smarcel ada_modulus (type_arg)); 7409130803Smarcel } 7410130803Smarcel 7411130803Smarcel 7412130803Smarcel case ATR_POS: 7413130803Smarcel evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); 7414130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7415130803Smarcel if (noside == EVAL_SKIP) 7416130803Smarcel goto nosideret; 7417130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 7418130803Smarcel return value_zero (builtin_type_ada_int, not_lval); 7419130803Smarcel else 7420130803Smarcel return value_pos_atr (arg1); 7421130803Smarcel 7422130803Smarcel case ATR_SIZE: 7423130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7424130803Smarcel if (noside == EVAL_SKIP) 7425130803Smarcel goto nosideret; 7426130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 7427130803Smarcel return value_zero (builtin_type_ada_int, not_lval); 7428130803Smarcel else 7429130803Smarcel return value_from_longest (builtin_type_ada_int, 7430130803Smarcel TARGET_CHAR_BIT 7431130803Smarcel * TYPE_LENGTH (VALUE_TYPE (arg1))); 7432130803Smarcel 7433130803Smarcel case ATR_VAL: 7434130803Smarcel evaluate_subexp (NULL_TYPE, exp, pos, EVAL_SKIP); 7435130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7436130803Smarcel type = exp->elts[pc + 5].type; 7437130803Smarcel if (noside == EVAL_SKIP) 7438130803Smarcel goto nosideret; 7439130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 7440130803Smarcel return value_zero (type, not_lval); 7441130803Smarcel else 7442130803Smarcel return value_val_atr (type, arg1); 7443130803Smarcel } */ 7444130803Smarcel case BINOP_EXP: 7445130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7446130803Smarcel arg2 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7447130803Smarcel if (noside == EVAL_SKIP) 7448130803Smarcel goto nosideret; 7449130803Smarcel if (binop_user_defined_p (op, arg1, arg2)) 7450130803Smarcel return unwrap_value (value_x_binop (arg1, arg2, op, OP_NULL, 7451130803Smarcel EVAL_NORMAL)); 7452130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 7453130803Smarcel return value_zero (VALUE_TYPE (arg1), not_lval); 7454130803Smarcel else 7455130803Smarcel return value_binop (arg1, arg2, op); 7456130803Smarcel 7457130803Smarcel case UNOP_PLUS: 7458130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7459130803Smarcel if (noside == EVAL_SKIP) 7460130803Smarcel goto nosideret; 7461130803Smarcel if (unop_user_defined_p (op, arg1)) 7462130803Smarcel return unwrap_value (value_x_unop (arg1, op, EVAL_NORMAL)); 7463130803Smarcel else 7464130803Smarcel return arg1; 7465130803Smarcel 7466130803Smarcel case UNOP_ABS: 7467130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7468130803Smarcel if (noside == EVAL_SKIP) 7469130803Smarcel goto nosideret; 7470130803Smarcel if (value_less (arg1, value_zero (VALUE_TYPE (arg1), not_lval))) 7471130803Smarcel return value_neg (arg1); 7472130803Smarcel else 7473130803Smarcel return arg1; 7474130803Smarcel 7475130803Smarcel case UNOP_IND: 7476130803Smarcel if (expect_type && TYPE_CODE (expect_type) == TYPE_CODE_PTR) 7477130803Smarcel expect_type = TYPE_TARGET_TYPE (check_typedef (expect_type)); 7478130803Smarcel arg1 = evaluate_subexp (expect_type, exp, pos, noside); 7479130803Smarcel if (noside == EVAL_SKIP) 7480130803Smarcel goto nosideret; 7481130803Smarcel type = check_typedef (VALUE_TYPE (arg1)); 7482130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7483130803Smarcel { 7484130803Smarcel if (ada_is_array_descriptor (type)) 7485130803Smarcel /* GDB allows dereferencing GNAT array descriptors. */ 7486130803Smarcel { 7487130803Smarcel struct type *arrType = ada_type_of_array (arg1, 0); 7488130803Smarcel if (arrType == NULL) 7489130803Smarcel error ("Attempt to dereference null array pointer."); 7490130803Smarcel return value_at_lazy (arrType, 0, NULL); 7491130803Smarcel } 7492130803Smarcel else if (TYPE_CODE (type) == TYPE_CODE_PTR 7493130803Smarcel || TYPE_CODE (type) == TYPE_CODE_REF 7494130803Smarcel /* In C you can dereference an array to get the 1st elt. */ 7495130803Smarcel || TYPE_CODE (type) == TYPE_CODE_ARRAY) 7496130803Smarcel return 7497130803Smarcel value_zero 7498130803Smarcel (to_static_fixed_type 7499130803Smarcel (ada_aligned_type (check_typedef (TYPE_TARGET_TYPE (type)))), 7500130803Smarcel lval_memory); 7501130803Smarcel else if (TYPE_CODE (type) == TYPE_CODE_INT) 7502130803Smarcel /* GDB allows dereferencing an int. */ 7503130803Smarcel return value_zero (builtin_type_int, lval_memory); 7504130803Smarcel else 7505130803Smarcel error ("Attempt to take contents of a non-pointer value."); 7506130803Smarcel } 7507130803Smarcel arg1 = ada_coerce_ref (arg1); 7508130803Smarcel type = check_typedef (VALUE_TYPE (arg1)); 7509130803Smarcel 7510130803Smarcel if (ada_is_array_descriptor (type)) 7511130803Smarcel /* GDB allows dereferencing GNAT array descriptors. */ 7512130803Smarcel return ada_coerce_to_simple_array (arg1); 7513130803Smarcel else 7514130803Smarcel return ada_value_ind (arg1); 7515130803Smarcel 7516130803Smarcel case STRUCTOP_STRUCT: 7517130803Smarcel tem = longest_to_int (exp->elts[pc + 1].longconst); 7518130803Smarcel (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1); 7519130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7520130803Smarcel if (noside == EVAL_SKIP) 7521130803Smarcel goto nosideret; 7522130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7523130803Smarcel return value_zero (ada_aligned_type 7524130803Smarcel (ada_lookup_struct_elt_type (VALUE_TYPE (arg1), 7525130803Smarcel &exp->elts[pc + 7526130803Smarcel 2].string, 7527130803Smarcel 0, NULL)), 7528130803Smarcel lval_memory); 7529130803Smarcel else 7530130803Smarcel return unwrap_value (ada_value_struct_elt (arg1, 7531130803Smarcel &exp->elts[pc + 2].string, 7532130803Smarcel "record")); 7533130803Smarcel case OP_TYPE: 7534130803Smarcel /* The value is not supposed to be used. This is here to make it 7535130803Smarcel easier to accommodate expressions that contain types. */ 7536130803Smarcel (*pos) += 2; 7537130803Smarcel if (noside == EVAL_SKIP) 7538130803Smarcel goto nosideret; 7539130803Smarcel else if (noside == EVAL_AVOID_SIDE_EFFECTS) 7540130803Smarcel return allocate_value (builtin_type_void); 7541130803Smarcel else 7542130803Smarcel error ("Attempt to use a type name as an expression"); 7543130803Smarcel 7544130803Smarcel case STRUCTOP_PTR: 7545130803Smarcel tem = longest_to_int (exp->elts[pc + 1].longconst); 7546130803Smarcel (*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1); 7547130803Smarcel arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside); 7548130803Smarcel if (noside == EVAL_SKIP) 7549130803Smarcel goto nosideret; 7550130803Smarcel if (noside == EVAL_AVOID_SIDE_EFFECTS) 7551130803Smarcel return value_zero (ada_aligned_type 7552130803Smarcel (ada_lookup_struct_elt_type (VALUE_TYPE (arg1), 7553130803Smarcel &exp->elts[pc + 7554130803Smarcel 2].string, 7555130803Smarcel 0, NULL)), 7556130803Smarcel lval_memory); 7557130803Smarcel else 7558130803Smarcel return unwrap_value (ada_value_struct_elt (arg1, 7559130803Smarcel &exp->elts[pc + 2].string, 7560130803Smarcel "record access")); 7561130803Smarcel } 7562130803Smarcel 7563130803Smarcelnosideret: 7564130803Smarcel return value_from_longest (builtin_type_long, (LONGEST) 1); 7565130803Smarcel} 7566130803Smarcel 7567130803Smarcel 7568130803Smarcel /* Fixed point */ 7569130803Smarcel 7570130803Smarcel/* If TYPE encodes an Ada fixed-point type, return the suffix of the 7571130803Smarcel type name that encodes the 'small and 'delta information. 7572130803Smarcel Otherwise, return NULL. */ 7573130803Smarcel 7574130803Smarcelstatic const char * 7575130803Smarcelfixed_type_info (struct type *type) 7576130803Smarcel{ 7577130803Smarcel const char *name = ada_type_name (type); 7578130803Smarcel enum type_code code = (type == NULL) ? TYPE_CODE_UNDEF : TYPE_CODE (type); 7579130803Smarcel 7580130803Smarcel if ((code == TYPE_CODE_INT || code == TYPE_CODE_RANGE) && name != NULL) 7581130803Smarcel { 7582130803Smarcel const char *tail = strstr (name, "___XF_"); 7583130803Smarcel if (tail == NULL) 7584130803Smarcel return NULL; 7585130803Smarcel else 7586130803Smarcel return tail + 5; 7587130803Smarcel } 7588130803Smarcel else if (code == TYPE_CODE_RANGE && TYPE_TARGET_TYPE (type) != type) 7589130803Smarcel return fixed_type_info (TYPE_TARGET_TYPE (type)); 7590130803Smarcel else 7591130803Smarcel return NULL; 7592130803Smarcel} 7593130803Smarcel 7594130803Smarcel/* Returns non-zero iff TYPE represents an Ada fixed-point type. */ 7595130803Smarcel 7596130803Smarcelint 7597130803Smarcelada_is_fixed_point_type (struct type *type) 7598130803Smarcel{ 7599130803Smarcel return fixed_type_info (type) != NULL; 7600130803Smarcel} 7601130803Smarcel 7602130803Smarcel/* Assuming that TYPE is the representation of an Ada fixed-point 7603130803Smarcel type, return its delta, or -1 if the type is malformed and the 7604130803Smarcel delta cannot be determined. */ 7605130803Smarcel 7606130803SmarcelDOUBLEST 7607130803Smarcelada_delta (struct type *type) 7608130803Smarcel{ 7609130803Smarcel const char *encoding = fixed_type_info (type); 7610130803Smarcel long num, den; 7611130803Smarcel 7612130803Smarcel if (sscanf (encoding, "_%ld_%ld", &num, &den) < 2) 7613130803Smarcel return -1.0; 7614130803Smarcel else 7615130803Smarcel return (DOUBLEST) num / (DOUBLEST) den; 7616130803Smarcel} 7617130803Smarcel 7618130803Smarcel/* Assuming that ada_is_fixed_point_type (TYPE), return the scaling 7619130803Smarcel factor ('SMALL value) associated with the type. */ 7620130803Smarcel 7621130803Smarcelstatic DOUBLEST 7622130803Smarcelscaling_factor (struct type *type) 7623130803Smarcel{ 7624130803Smarcel const char *encoding = fixed_type_info (type); 7625130803Smarcel unsigned long num0, den0, num1, den1; 7626130803Smarcel int n; 7627130803Smarcel 7628130803Smarcel n = sscanf (encoding, "_%lu_%lu_%lu_%lu", &num0, &den0, &num1, &den1); 7629130803Smarcel 7630130803Smarcel if (n < 2) 7631130803Smarcel return 1.0; 7632130803Smarcel else if (n == 4) 7633130803Smarcel return (DOUBLEST) num1 / (DOUBLEST) den1; 7634130803Smarcel else 7635130803Smarcel return (DOUBLEST) num0 / (DOUBLEST) den0; 7636130803Smarcel} 7637130803Smarcel 7638130803Smarcel 7639130803Smarcel/* Assuming that X is the representation of a value of fixed-point 7640130803Smarcel type TYPE, return its floating-point equivalent. */ 7641130803Smarcel 7642130803SmarcelDOUBLEST 7643130803Smarcelada_fixed_to_float (struct type *type, LONGEST x) 7644130803Smarcel{ 7645130803Smarcel return (DOUBLEST) x *scaling_factor (type); 7646130803Smarcel} 7647130803Smarcel 7648130803Smarcel/* The representation of a fixed-point value of type TYPE 7649130803Smarcel corresponding to the value X. */ 7650130803Smarcel 7651130803SmarcelLONGEST 7652130803Smarcelada_float_to_fixed (struct type *type, DOUBLEST x) 7653130803Smarcel{ 7654130803Smarcel return (LONGEST) (x / scaling_factor (type) + 0.5); 7655130803Smarcel} 7656130803Smarcel 7657130803Smarcel 7658130803Smarcel /* VAX floating formats */ 7659130803Smarcel 7660130803Smarcel/* Non-zero iff TYPE represents one of the special VAX floating-point 7661130803Smarcel types. */ 7662130803Smarcelint 7663130803Smarcelada_is_vax_floating_type (struct type *type) 7664130803Smarcel{ 7665130803Smarcel int name_len = 7666130803Smarcel (ada_type_name (type) == NULL) ? 0 : strlen (ada_type_name (type)); 7667130803Smarcel return 7668130803Smarcel name_len > 6 7669130803Smarcel && (TYPE_CODE (type) == TYPE_CODE_INT 7670130803Smarcel || TYPE_CODE (type) == TYPE_CODE_RANGE) 7671130803Smarcel && DEPRECATED_STREQN (ada_type_name (type) + name_len - 6, "___XF", 5); 7672130803Smarcel} 7673130803Smarcel 7674130803Smarcel/* The type of special VAX floating-point type this is, assuming 7675130803Smarcel ada_is_vax_floating_point */ 7676130803Smarcelint 7677130803Smarcelada_vax_float_type_suffix (struct type *type) 7678130803Smarcel{ 7679130803Smarcel return ada_type_name (type)[strlen (ada_type_name (type)) - 1]; 7680130803Smarcel} 7681130803Smarcel 7682130803Smarcel/* A value representing the special debugging function that outputs 7683130803Smarcel VAX floating-point values of the type represented by TYPE. Assumes 7684130803Smarcel ada_is_vax_floating_type (TYPE). */ 7685130803Smarcelstruct value * 7686130803Smarcelada_vax_float_print_function (struct type *type) 7687130803Smarcel{ 7688130803Smarcel switch (ada_vax_float_type_suffix (type)) 7689130803Smarcel { 7690130803Smarcel case 'F': 7691130803Smarcel return get_var_value ("DEBUG_STRING_F", 0); 7692130803Smarcel case 'D': 7693130803Smarcel return get_var_value ("DEBUG_STRING_D", 0); 7694130803Smarcel case 'G': 7695130803Smarcel return get_var_value ("DEBUG_STRING_G", 0); 7696130803Smarcel default: 7697130803Smarcel error ("invalid VAX floating-point type"); 7698130803Smarcel } 7699130803Smarcel} 7700130803Smarcel 7701130803Smarcel 7702130803Smarcel /* Range types */ 7703130803Smarcel 7704130803Smarcel/* Scan STR beginning at position K for a discriminant name, and 7705130803Smarcel return the value of that discriminant field of DVAL in *PX. If 7706130803Smarcel PNEW_K is not null, put the position of the character beyond the 7707130803Smarcel name scanned in *PNEW_K. Return 1 if successful; return 0 and do 7708130803Smarcel not alter *PX and *PNEW_K if unsuccessful. */ 7709130803Smarcel 7710130803Smarcelstatic int 7711130803Smarcelscan_discrim_bound (char *str, int k, struct value *dval, LONGEST * px, 7712130803Smarcel int *pnew_k) 7713130803Smarcel{ 7714130803Smarcel static char *bound_buffer = NULL; 7715130803Smarcel static size_t bound_buffer_len = 0; 7716130803Smarcel char *bound; 7717130803Smarcel char *pend; 7718130803Smarcel struct value *bound_val; 7719130803Smarcel 7720130803Smarcel if (dval == NULL || str == NULL || str[k] == '\0') 7721130803Smarcel return 0; 7722130803Smarcel 7723130803Smarcel pend = strstr (str + k, "__"); 7724130803Smarcel if (pend == NULL) 7725130803Smarcel { 7726130803Smarcel bound = str + k; 7727130803Smarcel k += strlen (bound); 7728130803Smarcel } 7729130803Smarcel else 7730130803Smarcel { 7731130803Smarcel GROW_VECT (bound_buffer, bound_buffer_len, pend - (str + k) + 1); 7732130803Smarcel bound = bound_buffer; 7733130803Smarcel strncpy (bound_buffer, str + k, pend - (str + k)); 7734130803Smarcel bound[pend - (str + k)] = '\0'; 7735130803Smarcel k = pend - str; 7736130803Smarcel } 7737130803Smarcel 7738130803Smarcel bound_val = ada_search_struct_field (bound, dval, 0, VALUE_TYPE (dval)); 7739130803Smarcel if (bound_val == NULL) 7740130803Smarcel return 0; 7741130803Smarcel 7742130803Smarcel *px = value_as_long (bound_val); 7743130803Smarcel if (pnew_k != NULL) 7744130803Smarcel *pnew_k = k; 7745130803Smarcel return 1; 7746130803Smarcel} 7747130803Smarcel 7748130803Smarcel/* Value of variable named NAME in the current environment. If 7749130803Smarcel no such variable found, then if ERR_MSG is null, returns 0, and 7750130803Smarcel otherwise causes an error with message ERR_MSG. */ 7751130803Smarcelstatic struct value * 7752130803Smarcelget_var_value (char *name, char *err_msg) 7753130803Smarcel{ 7754130803Smarcel struct symbol **syms; 7755130803Smarcel struct block **blocks; 7756130803Smarcel int nsyms; 7757130803Smarcel 7758130803Smarcel nsyms = 7759130803Smarcel ada_lookup_symbol_list (name, get_selected_block (NULL), VAR_DOMAIN, 7760130803Smarcel &syms, &blocks); 7761130803Smarcel 7762130803Smarcel if (nsyms != 1) 7763130803Smarcel { 7764130803Smarcel if (err_msg == NULL) 7765130803Smarcel return 0; 7766130803Smarcel else 7767130803Smarcel error ("%s", err_msg); 7768130803Smarcel } 7769130803Smarcel 7770130803Smarcel return value_of_variable (syms[0], blocks[0]); 7771130803Smarcel} 7772130803Smarcel 7773130803Smarcel/* Value of integer variable named NAME in the current environment. If 7774130803Smarcel no such variable found, then if ERR_MSG is null, returns 0, and sets 7775130803Smarcel *FLAG to 0. If successful, sets *FLAG to 1. */ 7776130803SmarcelLONGEST 7777130803Smarcelget_int_var_value (char *name, char *err_msg, int *flag) 7778130803Smarcel{ 7779130803Smarcel struct value *var_val = get_var_value (name, err_msg); 7780130803Smarcel 7781130803Smarcel if (var_val == 0) 7782130803Smarcel { 7783130803Smarcel if (flag != NULL) 7784130803Smarcel *flag = 0; 7785130803Smarcel return 0; 7786130803Smarcel } 7787130803Smarcel else 7788130803Smarcel { 7789130803Smarcel if (flag != NULL) 7790130803Smarcel *flag = 1; 7791130803Smarcel return value_as_long (var_val); 7792130803Smarcel } 7793130803Smarcel} 7794130803Smarcel 7795130803Smarcel 7796130803Smarcel/* Return a range type whose base type is that of the range type named 7797130803Smarcel NAME in the current environment, and whose bounds are calculated 7798130803Smarcel from NAME according to the GNAT range encoding conventions. 7799130803Smarcel Extract discriminant values, if needed, from DVAL. If a new type 7800130803Smarcel must be created, allocate in OBJFILE's space. The bounds 7801130803Smarcel information, in general, is encoded in NAME, the base type given in 7802130803Smarcel the named range type. */ 7803130803Smarcel 7804130803Smarcelstatic struct type * 7805130803Smarcelto_fixed_range_type (char *name, struct value *dval, struct objfile *objfile) 7806130803Smarcel{ 7807130803Smarcel struct type *raw_type = ada_find_any_type (name); 7808130803Smarcel struct type *base_type; 7809130803Smarcel LONGEST low, high; 7810130803Smarcel char *subtype_info; 7811130803Smarcel 7812130803Smarcel if (raw_type == NULL) 7813130803Smarcel base_type = builtin_type_int; 7814130803Smarcel else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE) 7815130803Smarcel base_type = TYPE_TARGET_TYPE (raw_type); 7816130803Smarcel else 7817130803Smarcel base_type = raw_type; 7818130803Smarcel 7819130803Smarcel subtype_info = strstr (name, "___XD"); 7820130803Smarcel if (subtype_info == NULL) 7821130803Smarcel return raw_type; 7822130803Smarcel else 7823130803Smarcel { 7824130803Smarcel static char *name_buf = NULL; 7825130803Smarcel static size_t name_len = 0; 7826130803Smarcel int prefix_len = subtype_info - name; 7827130803Smarcel LONGEST L, U; 7828130803Smarcel struct type *type; 7829130803Smarcel char *bounds_str; 7830130803Smarcel int n; 7831130803Smarcel 7832130803Smarcel GROW_VECT (name_buf, name_len, prefix_len + 5); 7833130803Smarcel strncpy (name_buf, name, prefix_len); 7834130803Smarcel name_buf[prefix_len] = '\0'; 7835130803Smarcel 7836130803Smarcel subtype_info += 5; 7837130803Smarcel bounds_str = strchr (subtype_info, '_'); 7838130803Smarcel n = 1; 7839130803Smarcel 7840130803Smarcel if (*subtype_info == 'L') 7841130803Smarcel { 7842130803Smarcel if (!ada_scan_number (bounds_str, n, &L, &n) 7843130803Smarcel && !scan_discrim_bound (bounds_str, n, dval, &L, &n)) 7844130803Smarcel return raw_type; 7845130803Smarcel if (bounds_str[n] == '_') 7846130803Smarcel n += 2; 7847130803Smarcel else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */ 7848130803Smarcel n += 1; 7849130803Smarcel subtype_info += 1; 7850130803Smarcel } 7851130803Smarcel else 7852130803Smarcel { 7853130803Smarcel strcpy (name_buf + prefix_len, "___L"); 7854130803Smarcel L = get_int_var_value (name_buf, "Index bound unknown.", NULL); 7855130803Smarcel } 7856130803Smarcel 7857130803Smarcel if (*subtype_info == 'U') 7858130803Smarcel { 7859130803Smarcel if (!ada_scan_number (bounds_str, n, &U, &n) 7860130803Smarcel && !scan_discrim_bound (bounds_str, n, dval, &U, &n)) 7861130803Smarcel return raw_type; 7862130803Smarcel } 7863130803Smarcel else 7864130803Smarcel { 7865130803Smarcel strcpy (name_buf + prefix_len, "___U"); 7866130803Smarcel U = get_int_var_value (name_buf, "Index bound unknown.", NULL); 7867130803Smarcel } 7868130803Smarcel 7869130803Smarcel if (objfile == NULL) 7870130803Smarcel objfile = TYPE_OBJFILE (base_type); 7871130803Smarcel type = create_range_type (alloc_type (objfile), base_type, L, U); 7872130803Smarcel TYPE_NAME (type) = name; 7873130803Smarcel return type; 7874130803Smarcel } 7875130803Smarcel} 7876130803Smarcel 7877130803Smarcel/* True iff NAME is the name of a range type. */ 7878130803Smarcelint 7879130803Smarcelada_is_range_type_name (const char *name) 7880130803Smarcel{ 7881130803Smarcel return (name != NULL && strstr (name, "___XD")); 7882130803Smarcel} 7883130803Smarcel 7884130803Smarcel 7885130803Smarcel /* Modular types */ 7886130803Smarcel 7887130803Smarcel/* True iff TYPE is an Ada modular type. */ 7888130803Smarcelint 7889130803Smarcelada_is_modular_type (struct type *type) 7890130803Smarcel{ 7891130803Smarcel /* FIXME: base_type should be declared in gdbtypes.h, implemented in 7892130803Smarcel valarith.c */ 7893130803Smarcel struct type *subranged_type; /* = base_type (type); */ 7894130803Smarcel 7895130803Smarcel return (subranged_type != NULL && TYPE_CODE (type) == TYPE_CODE_RANGE 7896130803Smarcel && TYPE_CODE (subranged_type) != TYPE_CODE_ENUM 7897130803Smarcel && TYPE_UNSIGNED (subranged_type)); 7898130803Smarcel} 7899130803Smarcel 7900130803Smarcel/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */ 7901130803SmarcelLONGEST 7902130803Smarcelada_modulus (struct type * type) 7903130803Smarcel{ 7904130803Smarcel return TYPE_HIGH_BOUND (type) + 1; 7905130803Smarcel} 7906130803Smarcel 7907130803Smarcel 7908130803Smarcel 7909130803Smarcel /* Operators */ 7910130803Smarcel 7911130803Smarcel/* Table mapping opcodes into strings for printing operators 7912130803Smarcel and precedences of the operators. */ 7913130803Smarcel 7914130803Smarcelstatic const struct op_print ada_op_print_tab[] = { 7915130803Smarcel {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, 7916130803Smarcel {"or else", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0}, 7917130803Smarcel {"and then", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0}, 7918130803Smarcel {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0}, 7919130803Smarcel {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0}, 7920130803Smarcel {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0}, 7921130803Smarcel {"=", BINOP_EQUAL, PREC_EQUAL, 0}, 7922130803Smarcel {"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0}, 7923130803Smarcel {"<=", BINOP_LEQ, PREC_ORDER, 0}, 7924130803Smarcel {">=", BINOP_GEQ, PREC_ORDER, 0}, 7925130803Smarcel {">", BINOP_GTR, PREC_ORDER, 0}, 7926130803Smarcel {"<", BINOP_LESS, PREC_ORDER, 0}, 7927130803Smarcel {">>", BINOP_RSH, PREC_SHIFT, 0}, 7928130803Smarcel {"<<", BINOP_LSH, PREC_SHIFT, 0}, 7929130803Smarcel {"+", BINOP_ADD, PREC_ADD, 0}, 7930130803Smarcel {"-", BINOP_SUB, PREC_ADD, 0}, 7931130803Smarcel {"&", BINOP_CONCAT, PREC_ADD, 0}, 7932130803Smarcel {"*", BINOP_MUL, PREC_MUL, 0}, 7933130803Smarcel {"/", BINOP_DIV, PREC_MUL, 0}, 7934130803Smarcel {"rem", BINOP_REM, PREC_MUL, 0}, 7935130803Smarcel {"mod", BINOP_MOD, PREC_MUL, 0}, 7936130803Smarcel {"**", BINOP_EXP, PREC_REPEAT, 0}, 7937130803Smarcel {"@", BINOP_REPEAT, PREC_REPEAT, 0}, 7938130803Smarcel {"-", UNOP_NEG, PREC_PREFIX, 0}, 7939130803Smarcel {"+", UNOP_PLUS, PREC_PREFIX, 0}, 7940130803Smarcel {"not ", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, 7941130803Smarcel {"not ", UNOP_COMPLEMENT, PREC_PREFIX, 0}, 7942130803Smarcel {"abs ", UNOP_ABS, PREC_PREFIX, 0}, 7943130803Smarcel {".all", UNOP_IND, PREC_SUFFIX, 1}, /* FIXME: postfix .ALL */ 7944130803Smarcel {"'access", UNOP_ADDR, PREC_SUFFIX, 1}, /* FIXME: postfix 'ACCESS */ 7945130803Smarcel {NULL, 0, 0, 0} 7946130803Smarcel}; 7947130803Smarcel 7948130803Smarcel /* Assorted Types and Interfaces */ 7949130803Smarcel 7950130803Smarcelstruct type *builtin_type_ada_int; 7951130803Smarcelstruct type *builtin_type_ada_short; 7952130803Smarcelstruct type *builtin_type_ada_long; 7953130803Smarcelstruct type *builtin_type_ada_long_long; 7954130803Smarcelstruct type *builtin_type_ada_char; 7955130803Smarcelstruct type *builtin_type_ada_float; 7956130803Smarcelstruct type *builtin_type_ada_double; 7957130803Smarcelstruct type *builtin_type_ada_long_double; 7958130803Smarcelstruct type *builtin_type_ada_natural; 7959130803Smarcelstruct type *builtin_type_ada_positive; 7960130803Smarcelstruct type *builtin_type_ada_system_address; 7961130803Smarcel 7962130803Smarcelstruct type **const (ada_builtin_types[]) = 7963130803Smarcel{ 7964130803Smarcel 7965130803Smarcel &builtin_type_ada_int, 7966130803Smarcel &builtin_type_ada_long, 7967130803Smarcel &builtin_type_ada_short, 7968130803Smarcel &builtin_type_ada_char, 7969130803Smarcel &builtin_type_ada_float, 7970130803Smarcel &builtin_type_ada_double, 7971130803Smarcel &builtin_type_ada_long_long, 7972130803Smarcel &builtin_type_ada_long_double, 7973130803Smarcel &builtin_type_ada_natural, &builtin_type_ada_positive, 7974130803Smarcel /* The following types are carried over from C for convenience. */ 7975130803Smarcel&builtin_type_int, 7976130803Smarcel &builtin_type_long, 7977130803Smarcel &builtin_type_short, 7978130803Smarcel &builtin_type_char, 7979130803Smarcel &builtin_type_float, 7980130803Smarcel &builtin_type_double, 7981130803Smarcel &builtin_type_long_long, 7982130803Smarcel &builtin_type_void, 7983130803Smarcel &builtin_type_signed_char, 7984130803Smarcel &builtin_type_unsigned_char, 7985130803Smarcel &builtin_type_unsigned_short, 7986130803Smarcel &builtin_type_unsigned_int, 7987130803Smarcel &builtin_type_unsigned_long, 7988130803Smarcel &builtin_type_unsigned_long_long, 7989130803Smarcel &builtin_type_long_double, 7990130803Smarcel &builtin_type_complex, &builtin_type_double_complex, 0}; 7991130803Smarcel 7992130803Smarcel/* Not really used, but needed in the ada_language_defn. */ 7993130803Smarcelstatic void 7994130803Smarcelemit_char (int c, struct ui_file *stream, int quoter) 7995130803Smarcel{ 7996130803Smarcel ada_emit_char (c, stream, quoter, 1); 7997130803Smarcel} 7998130803Smarcel 7999130803Smarcelconst struct language_defn ada_language_defn = { 8000130803Smarcel "ada", /* Language name */ 8001130803Smarcel /* language_ada, */ 8002130803Smarcel language_unknown, 8003130803Smarcel /* FIXME: language_ada should be defined in defs.h */ 8004130803Smarcel ada_builtin_types, 8005130803Smarcel range_check_off, 8006130803Smarcel type_check_off, 8007130803Smarcel case_sensitive_on, /* Yes, Ada is case-insensitive, but 8008130803Smarcel * that's not quite what this means. */ 8009130803Smarcel ada_parse, 8010130803Smarcel ada_error, 8011130803Smarcel ada_evaluate_subexp, 8012130803Smarcel ada_printchar, /* Print a character constant */ 8013130803Smarcel ada_printstr, /* Function to print string constant */ 8014130803Smarcel emit_char, /* Function to print single char (not used) */ 8015130803Smarcel ada_create_fundamental_type, /* Create fundamental type in this language */ 8016130803Smarcel ada_print_type, /* Print a type using appropriate syntax */ 8017130803Smarcel ada_val_print, /* Print a value using appropriate syntax */ 8018130803Smarcel ada_value_print, /* Print a top-level value */ 8019130803Smarcel NULL, /* Language specific skip_trampoline */ 8020130803Smarcel value_of_this, /* value_of_this */ 8021130803Smarcel basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */ 8022130803Smarcel basic_lookup_transparent_type,/* lookup_transparent_type */ 8023130803Smarcel NULL, /* Language specific symbol demangler */ 8024130803Smarcel {"", "", "", ""}, /* Binary format info */ 8025130803Smarcel#if 0 8026130803Smarcel {"8#%lo#", "8#", "o", "#"}, /* Octal format info */ 8027130803Smarcel {"%ld", "", "d", ""}, /* Decimal format info */ 8028130803Smarcel {"16#%lx#", "16#", "x", "#"}, /* Hex format info */ 8029130803Smarcel#else 8030130803Smarcel /* Copied from c-lang.c. */ 8031130803Smarcel {"0%lo", "0", "o", ""}, /* Octal format info */ 8032130803Smarcel {"%ld", "", "d", ""}, /* Decimal format info */ 8033130803Smarcel {"0x%lx", "0x", "x", ""}, /* Hex format info */ 8034130803Smarcel#endif 8035130803Smarcel ada_op_print_tab, /* expression operators for printing */ 8036130803Smarcel 1, /* c-style arrays (FIXME?) */ 8037130803Smarcel 0, /* String lower bound (FIXME?) */ 8038130803Smarcel &builtin_type_ada_char, 8039130803Smarcel default_word_break_characters, 8040130803Smarcel LANG_MAGIC 8041130803Smarcel}; 8042130803Smarcel 8043130803Smarcelvoid 8044130803Smarcel_initialize_ada_language (void) 8045130803Smarcel{ 8046130803Smarcel builtin_type_ada_int = 8047130803Smarcel init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 8048130803Smarcel 0, "integer", (struct objfile *) NULL); 8049130803Smarcel builtin_type_ada_long = 8050130803Smarcel init_type (TYPE_CODE_INT, TARGET_LONG_BIT / TARGET_CHAR_BIT, 8051130803Smarcel 0, "long_integer", (struct objfile *) NULL); 8052130803Smarcel builtin_type_ada_short = 8053130803Smarcel init_type (TYPE_CODE_INT, TARGET_SHORT_BIT / TARGET_CHAR_BIT, 8054130803Smarcel 0, "short_integer", (struct objfile *) NULL); 8055130803Smarcel builtin_type_ada_char = 8056130803Smarcel init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT, 8057130803Smarcel 0, "character", (struct objfile *) NULL); 8058130803Smarcel builtin_type_ada_float = 8059130803Smarcel init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 8060130803Smarcel 0, "float", (struct objfile *) NULL); 8061130803Smarcel builtin_type_ada_double = 8062130803Smarcel init_type (TYPE_CODE_FLT, TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 8063130803Smarcel 0, "long_float", (struct objfile *) NULL); 8064130803Smarcel builtin_type_ada_long_long = 8065130803Smarcel init_type (TYPE_CODE_INT, TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 8066130803Smarcel 0, "long_long_integer", (struct objfile *) NULL); 8067130803Smarcel builtin_type_ada_long_double = 8068130803Smarcel init_type (TYPE_CODE_FLT, TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 8069130803Smarcel 0, "long_long_float", (struct objfile *) NULL); 8070130803Smarcel builtin_type_ada_natural = 8071130803Smarcel init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 8072130803Smarcel 0, "natural", (struct objfile *) NULL); 8073130803Smarcel builtin_type_ada_positive = 8074130803Smarcel init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 8075130803Smarcel 0, "positive", (struct objfile *) NULL); 8076130803Smarcel 8077130803Smarcel 8078130803Smarcel builtin_type_ada_system_address = 8079130803Smarcel lookup_pointer_type (init_type (TYPE_CODE_VOID, 1, 0, "void", 8080130803Smarcel (struct objfile *) NULL)); 8081130803Smarcel TYPE_NAME (builtin_type_ada_system_address) = "system__address"; 8082130803Smarcel 8083130803Smarcel add_language (&ada_language_defn); 8084130803Smarcel 8085130803Smarcel add_show_from_set 8086130803Smarcel (add_set_cmd ("varsize-limit", class_support, var_uinteger, 8087130803Smarcel (char *) &varsize_limit, 8088130803Smarcel "Set maximum bytes in dynamic-sized object.", 8089130803Smarcel &setlist), &showlist); 8090130803Smarcel varsize_limit = 65536; 8091130803Smarcel 8092130803Smarcel add_com ("begin", class_breakpoint, begin_command, 8093130803Smarcel "Start the debugged program, stopping at the beginning of the\n\ 8094130803Smarcelmain program. You may specify command-line arguments to give it, as for\n\ 8095130803Smarcelthe \"run\" command (q.v.)."); 8096130803Smarcel} 8097130803Smarcel 8098130803Smarcel 8099130803Smarcel/* Create a fundamental Ada type using default reasonable for the current 8100130803Smarcel target machine. 8101130803Smarcel 8102130803Smarcel Some object/debugging file formats (DWARF version 1, COFF, etc) do not 8103130803Smarcel define fundamental types such as "int" or "double". Others (stabs or 8104130803Smarcel DWARF version 2, etc) do define fundamental types. For the formats which 8105130803Smarcel don't provide fundamental types, gdb can create such types using this 8106130803Smarcel function. 8107130803Smarcel 8108130803Smarcel FIXME: Some compilers distinguish explicitly signed integral types 8109130803Smarcel (signed short, signed int, signed long) from "regular" integral types 8110130803Smarcel (short, int, long) in the debugging information. There is some dis- 8111130803Smarcel agreement as to how useful this feature is. In particular, gcc does 8112130803Smarcel not support this. Also, only some debugging formats allow the 8113130803Smarcel distinction to be passed on to a debugger. For now, we always just 8114130803Smarcel use "short", "int", or "long" as the type name, for both the implicit 8115130803Smarcel and explicitly signed types. This also makes life easier for the 8116130803Smarcel gdb test suite since we don't have to account for the differences 8117130803Smarcel in output depending upon what the compiler and debugging format 8118130803Smarcel support. We will probably have to re-examine the issue when gdb 8119130803Smarcel starts taking it's fundamental type information directly from the 8120130803Smarcel debugging information supplied by the compiler. fnf@cygnus.com */ 8121130803Smarcel 8122130803Smarcelstatic struct type * 8123130803Smarcelada_create_fundamental_type (struct objfile *objfile, int typeid) 8124130803Smarcel{ 8125130803Smarcel struct type *type = NULL; 8126130803Smarcel 8127130803Smarcel switch (typeid) 8128130803Smarcel { 8129130803Smarcel default: 8130130803Smarcel /* FIXME: For now, if we are asked to produce a type not in this 8131130803Smarcel language, create the equivalent of a C integer type with the 8132130803Smarcel name "<?type?>". When all the dust settles from the type 8133130803Smarcel reconstruction work, this should probably become an error. */ 8134130803Smarcel type = init_type (TYPE_CODE_INT, 8135130803Smarcel TARGET_INT_BIT / TARGET_CHAR_BIT, 8136130803Smarcel 0, "<?type?>", objfile); 8137130803Smarcel warning ("internal error: no Ada fundamental type %d", typeid); 8138130803Smarcel break; 8139130803Smarcel case FT_VOID: 8140130803Smarcel type = init_type (TYPE_CODE_VOID, 8141130803Smarcel TARGET_CHAR_BIT / TARGET_CHAR_BIT, 8142130803Smarcel 0, "void", objfile); 8143130803Smarcel break; 8144130803Smarcel case FT_CHAR: 8145130803Smarcel type = init_type (TYPE_CODE_INT, 8146130803Smarcel TARGET_CHAR_BIT / TARGET_CHAR_BIT, 8147130803Smarcel 0, "character", objfile); 8148130803Smarcel break; 8149130803Smarcel case FT_SIGNED_CHAR: 8150130803Smarcel type = init_type (TYPE_CODE_INT, 8151130803Smarcel TARGET_CHAR_BIT / TARGET_CHAR_BIT, 8152130803Smarcel 0, "signed char", objfile); 8153130803Smarcel break; 8154130803Smarcel case FT_UNSIGNED_CHAR: 8155130803Smarcel type = init_type (TYPE_CODE_INT, 8156130803Smarcel TARGET_CHAR_BIT / TARGET_CHAR_BIT, 8157130803Smarcel TYPE_FLAG_UNSIGNED, "unsigned char", objfile); 8158130803Smarcel break; 8159130803Smarcel case FT_SHORT: 8160130803Smarcel type = init_type (TYPE_CODE_INT, 8161130803Smarcel TARGET_SHORT_BIT / TARGET_CHAR_BIT, 8162130803Smarcel 0, "short_integer", objfile); 8163130803Smarcel break; 8164130803Smarcel case FT_SIGNED_SHORT: 8165130803Smarcel type = init_type (TYPE_CODE_INT, 8166130803Smarcel TARGET_SHORT_BIT / TARGET_CHAR_BIT, 8167130803Smarcel 0, "short_integer", objfile); 8168130803Smarcel break; 8169130803Smarcel case FT_UNSIGNED_SHORT: 8170130803Smarcel type = init_type (TYPE_CODE_INT, 8171130803Smarcel TARGET_SHORT_BIT / TARGET_CHAR_BIT, 8172130803Smarcel TYPE_FLAG_UNSIGNED, "unsigned short", objfile); 8173130803Smarcel break; 8174130803Smarcel case FT_INTEGER: 8175130803Smarcel type = init_type (TYPE_CODE_INT, 8176130803Smarcel TARGET_INT_BIT / TARGET_CHAR_BIT, 8177130803Smarcel 0, "integer", objfile); 8178130803Smarcel break; 8179130803Smarcel case FT_SIGNED_INTEGER: 8180130803Smarcel type = init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT, 0, "integer", objfile); /* FIXME -fnf */ 8181130803Smarcel break; 8182130803Smarcel case FT_UNSIGNED_INTEGER: 8183130803Smarcel type = init_type (TYPE_CODE_INT, 8184130803Smarcel TARGET_INT_BIT / TARGET_CHAR_BIT, 8185130803Smarcel TYPE_FLAG_UNSIGNED, "unsigned int", objfile); 8186130803Smarcel break; 8187130803Smarcel case FT_LONG: 8188130803Smarcel type = init_type (TYPE_CODE_INT, 8189130803Smarcel TARGET_LONG_BIT / TARGET_CHAR_BIT, 8190130803Smarcel 0, "long_integer", objfile); 8191130803Smarcel break; 8192130803Smarcel case FT_SIGNED_LONG: 8193130803Smarcel type = init_type (TYPE_CODE_INT, 8194130803Smarcel TARGET_LONG_BIT / TARGET_CHAR_BIT, 8195130803Smarcel 0, "long_integer", objfile); 8196130803Smarcel break; 8197130803Smarcel case FT_UNSIGNED_LONG: 8198130803Smarcel type = init_type (TYPE_CODE_INT, 8199130803Smarcel TARGET_LONG_BIT / TARGET_CHAR_BIT, 8200130803Smarcel TYPE_FLAG_UNSIGNED, "unsigned long", objfile); 8201130803Smarcel break; 8202130803Smarcel case FT_LONG_LONG: 8203130803Smarcel type = init_type (TYPE_CODE_INT, 8204130803Smarcel TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 8205130803Smarcel 0, "long_long_integer", objfile); 8206130803Smarcel break; 8207130803Smarcel case FT_SIGNED_LONG_LONG: 8208130803Smarcel type = init_type (TYPE_CODE_INT, 8209130803Smarcel TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 8210130803Smarcel 0, "long_long_integer", objfile); 8211130803Smarcel break; 8212130803Smarcel case FT_UNSIGNED_LONG_LONG: 8213130803Smarcel type = init_type (TYPE_CODE_INT, 8214130803Smarcel TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, 8215130803Smarcel TYPE_FLAG_UNSIGNED, "unsigned long long", objfile); 8216130803Smarcel break; 8217130803Smarcel case FT_FLOAT: 8218130803Smarcel type = init_type (TYPE_CODE_FLT, 8219130803Smarcel TARGET_FLOAT_BIT / TARGET_CHAR_BIT, 8220130803Smarcel 0, "float", objfile); 8221130803Smarcel break; 8222130803Smarcel case FT_DBL_PREC_FLOAT: 8223130803Smarcel type = init_type (TYPE_CODE_FLT, 8224130803Smarcel TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, 8225130803Smarcel 0, "long_float", objfile); 8226130803Smarcel break; 8227130803Smarcel case FT_EXT_PREC_FLOAT: 8228130803Smarcel type = init_type (TYPE_CODE_FLT, 8229130803Smarcel TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, 8230130803Smarcel 0, "long_long_float", objfile); 8231130803Smarcel break; 8232130803Smarcel } 8233130803Smarcel return (type); 8234130803Smarcel} 8235130803Smarcel 8236130803Smarcelvoid 8237130803Smarcelada_dump_symtab (struct symtab *s) 8238130803Smarcel{ 8239130803Smarcel int i; 8240130803Smarcel fprintf (stderr, "New symtab: [\n"); 8241130803Smarcel fprintf (stderr, " Name: %s/%s;\n", 8242130803Smarcel s->dirname ? s->dirname : "?", s->filename ? s->filename : "?"); 8243130803Smarcel fprintf (stderr, " Format: %s;\n", s->debugformat); 8244130803Smarcel if (s->linetable != NULL) 8245130803Smarcel { 8246130803Smarcel fprintf (stderr, " Line table (section %d):\n", s->block_line_section); 8247130803Smarcel for (i = 0; i < s->linetable->nitems; i += 1) 8248130803Smarcel { 8249130803Smarcel struct linetable_entry *e = s->linetable->item + i; 8250130803Smarcel fprintf (stderr, " %4ld: %8lx\n", (long) e->line, (long) e->pc); 8251130803Smarcel } 8252130803Smarcel } 8253130803Smarcel fprintf (stderr, "]\n"); 8254130803Smarcel} 8255