+ void print_array_index (struct type *index_type,
+ LONGEST index,
+ struct ui_file *stream,
+ const value_print_options *options) const override
+ {
+ struct value *index_value = val_atr (index_type, index);
+
+ LA_VALUE_PRINT (index_value, stream, options);
+ fprintf_filtered (stream, " => ");
+ }
+
+ /* Implement the "read_var_value" language_defn method for Ada. */
+
+ struct value *read_var_value (struct symbol *var,
+ const struct block *var_block,
+ struct frame_info *frame) const override
+ {
+ /* The only case where default_read_var_value is not sufficient
+ is when VAR is a renaming... */
+ if (frame != nullptr)
+ {
+ const struct block *frame_block = get_frame_block (frame, NULL);
+ if (frame_block != nullptr && ada_is_renaming_symbol (var))
+ return ada_read_renaming_var_value (var, frame_block);
+ }
+
+ /* This is a typical case where we expect the default_read_var_value
+ function to work. */
+ return language_defn::read_var_value (var, var_block, frame);
+ }
+
+ /* See language.h. */
+ void language_arch_info (struct gdbarch *gdbarch,
+ struct language_arch_info *lai) const override
+ {
+ const struct builtin_type *builtin = builtin_type (gdbarch);
+
+ lai->primitive_type_vector
+ = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_ada_primitive_types + 1,
+ struct type *);
+
+ lai->primitive_type_vector [ada_primitive_type_int]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "integer");
+ lai->primitive_type_vector [ada_primitive_type_long]
+ = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch),
+ 0, "long_integer");
+ lai->primitive_type_vector [ada_primitive_type_short]
+ = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch),
+ 0, "short_integer");
+ lai->string_char_type
+ = lai->primitive_type_vector [ada_primitive_type_char]
+ = arch_character_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+ lai->primitive_type_vector [ada_primitive_type_float]
+ = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+ "float", gdbarch_float_format (gdbarch));
+ lai->primitive_type_vector [ada_primitive_type_double]
+ = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+ "long_float", gdbarch_double_format (gdbarch));
+ lai->primitive_type_vector [ada_primitive_type_long_long]
+ = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch),
+ 0, "long_long_integer");
+ lai->primitive_type_vector [ada_primitive_type_long_double]
+ = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+ "long_long_float", gdbarch_long_double_format (gdbarch));
+ lai->primitive_type_vector [ada_primitive_type_natural]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "natural");
+ lai->primitive_type_vector [ada_primitive_type_positive]
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch),
+ 0, "positive");
+ lai->primitive_type_vector [ada_primitive_type_void]
+ = builtin->builtin_void;
+
+ lai->primitive_type_vector [ada_primitive_type_system_address]
+ = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
+ "void"));
+ lai->primitive_type_vector [ada_primitive_type_system_address]
+ ->set_name ("system__address");
+
+ /* Create the equivalent of the System.Storage_Elements.Storage_Offset
+ type. This is a signed integral type whose size is the same as
+ the size of addresses. */
+ {
+ unsigned int addr_length = TYPE_LENGTH
+ (lai->primitive_type_vector [ada_primitive_type_system_address]);
+
+ lai->primitive_type_vector [ada_primitive_type_storage_offset]
+ = arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
+ "storage_offset");
+ }
+
+ lai->bool_type_symbol = NULL;
+ lai->bool_type_default = builtin->builtin_bool;
+ }
+
+ /* See language.h. */
+
+ bool iterate_over_symbols
+ (const struct block *block, const lookup_name_info &name,
+ domain_enum domain,
+ gdb::function_view<symbol_found_callback_ftype> callback) const override
+ {
+ std::vector<struct block_symbol> results;
+
+ ada_lookup_symbol_list_worker (name, block, domain, &results, 0);
+ for (block_symbol &sym : results)
+ {
+ if (!callback (&sym))
+ return false;
+ }
+
+ return true;
+ }
+
+ /* See language.h. */
+ bool sniff_from_mangled_name (const char *mangled,
+ char **out) const override
+ {
+ std::string demangled = ada_decode (mangled);
+
+ *out = NULL;
+
+ if (demangled != mangled && demangled[0] != '<')
+ {
+ /* Set the gsymbol language to Ada, but still return 0.
+ Two reasons for that:
+
+ 1. For Ada, we prefer computing the symbol's decoded name
+ on the fly rather than pre-compute it, in order to save
+ memory (Ada projects are typically very large).
+
+ 2. There are some areas in the definition of the GNAT
+ encoding where, with a bit of bad luck, we might be able
+ to decode a non-Ada symbol, generating an incorrect
+ demangled name (Eg: names ending with "TB" for instance
+ are identified as task bodies and so stripped from
+ the decoded name returned).
+
+ Returning true, here, but not setting *DEMANGLED, helps us get
+ a little bit of the best of both worlds. Because we're last,
+ we should not affect any of the other languages that were
+ able to demangle the symbol before us; we get to correctly
+ tag Ada symbols as such; and even if we incorrectly tagged a
+ non-Ada symbol, which should be rare, any routing through the
+ Ada language should be transparent (Ada tries to behave much
+ like C/C++ with non-Ada symbols). */
+ return true;
+ }
+
+ return false;
+ }
+
+ /* See language.h. */
+
+ char *demangle (const char *mangled, int options) const override
+ {
+ return ada_la_decode (mangled, options);
+ }
+
+ /* See language.h. */
+
+ void print_type (struct type *type, const char *varstring,
+ struct ui_file *stream, int show, int level,
+ const struct type_print_options *flags) const override
+ {
+ ada_print_type (type, varstring, stream, show, level, flags);
+ }
+
+ /* See language.h. */
+
+ const char *word_break_characters (void) const override
+ {
+ return ada_completer_word_break_characters;
+ }
+
+ /* See language.h. */
+
+ void collect_symbol_completion_matches (completion_tracker &tracker,
+ complete_symbol_mode mode,
+ symbol_name_match_type name_match_type,
+ const char *text, const char *word,
+ enum type_code code) const override
+ {
+ struct symbol *sym;
+ const struct block *b, *surrounding_static_block = 0;
+ struct block_iterator iter;
+
+ gdb_assert (code == TYPE_CODE_UNDEF);
+
+ lookup_name_info lookup_name (text, name_match_type, true);
+
+ /* First, look at the partial symtab symbols. */
+ expand_symtabs_matching (NULL,
+ lookup_name,
+ NULL,
+ NULL,
+ ALL_DOMAIN);
+
+ /* At this point scan through the misc symbol vectors and add each
+ symbol you find to the list. Eventually we want to ignore
+ anything that isn't a text symbol (everything else will be
+ handled by the psymtab code above). */
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (minimal_symbol *msymbol : objfile->msymbols ())
+ {
+ QUIT;
+
+ if (completion_skip_symbol (mode, msymbol))
+ continue;
+
+ language symbol_language = msymbol->language ();
+
+ /* Ada minimal symbols won't have their language set to Ada. If
+ we let completion_list_add_name compare using the
+ default/C-like matcher, then when completing e.g., symbols in a
+ package named "pck", we'd match internal Ada symbols like
+ "pckS", which are invalid in an Ada expression, unless you wrap
+ them in '<' '>' to request a verbatim match.
+
+ Unfortunately, some Ada encoded names successfully demangle as
+ C++ symbols (using an old mangling scheme), such as "name__2Xn"
+ -> "Xn::name(void)" and thus some Ada minimal symbols end up
+ with the wrong language set. Paper over that issue here. */
+ if (symbol_language == language_auto
+ || symbol_language == language_cplus)
+ symbol_language = language_ada;
+
+ completion_list_add_name (tracker,
+ symbol_language,
+ msymbol->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+
+ /* Search upwards from currently selected frame (so that we can
+ complete on local vars. */
+
+ for (b = get_selected_block (0); b != NULL; b = BLOCK_SUPERBLOCK (b))
+ {
+ if (!BLOCK_SUPERBLOCK (b))
+ surrounding_static_block = b; /* For elmin of dups */
+
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ {
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ sym->language (),
+ sym->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+
+ /* Go through the symtabs and check the externs and statics for
+ symbols which match. */
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (compunit_symtab *s : objfile->compunits ())
+ {
+ QUIT;
+ b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), GLOBAL_BLOCK);
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ {
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ sym->language (),
+ sym->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+ }
+
+ for (objfile *objfile : current_program_space->objfiles ())
+ {
+ for (compunit_symtab *s : objfile->compunits ())
+ {
+ QUIT;
+ b = BLOCKVECTOR_BLOCK (COMPUNIT_BLOCKVECTOR (s), STATIC_BLOCK);
+ /* Don't do this block twice. */
+ if (b == surrounding_static_block)
+ continue;
+ ALL_BLOCK_SYMBOLS (b, iter, sym)
+ {
+ if (completion_skip_symbol (mode, sym))
+ continue;
+
+ completion_list_add_name (tracker,
+ sym->language (),
+ sym->linkage_name (),
+ lookup_name, text, word);
+ }
+ }
+ }
+ }
+
+ /* See language.h. */
+
+ gdb::unique_xmalloc_ptr<char> watch_location_expression
+ (struct type *type, CORE_ADDR addr) const override
+ {
+ type = check_typedef (TYPE_TARGET_TYPE (check_typedef (type)));
+ std::string name = type_to_string (type);
+ return gdb::unique_xmalloc_ptr<char>
+ (xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr)));
+ }
+
+ /* See language.h. */
+
+ void value_print (struct value *val, struct ui_file *stream,
+ const struct value_print_options *options) const override
+ {
+ return ada_value_print (val, stream, options);
+ }
+
+ /* See language.h. */
+
+ void value_print_inner
+ (struct value *val, struct ui_file *stream, int recurse,
+ const struct value_print_options *options) const override
+ {
+ return ada_value_print_inner (val, stream, recurse, options);
+ }
+
+ /* See language.h. */
+
+ struct block_symbol lookup_symbol_nonlocal
+ (const char *name, const struct block *block,
+ const domain_enum domain) const override
+ {
+ struct block_symbol sym;
+
+ sym = ada_lookup_symbol (name, block_static_block (block), domain);
+ if (sym.symbol != NULL)
+ return sym;
+
+ /* If we haven't found a match at this point, try the primitive
+ types. In other languages, this search is performed before
+ searching for global symbols in order to short-circuit that
+ global-symbol search if it happens that the name corresponds
+ to a primitive type. But we cannot do the same in Ada, because
+ it is perfectly legitimate for a program to declare a type which
+ has the same name as a standard type. If looking up a type in
+ that situation, we have traditionally ignored the primitive type
+ in favor of user-defined types. This is why, unlike most other
+ languages, we search the primitive types this late and only after
+ having searched the global symbols without success. */
+
+ if (domain == VAR_DOMAIN)
+ {
+ struct gdbarch *gdbarch;
+
+ if (block == NULL)
+ gdbarch = target_gdbarch ();
+ else
+ gdbarch = block_gdbarch (block);
+ sym.symbol
+ = language_lookup_primitive_type_as_symbol (this, gdbarch, name);
+ if (sym.symbol != NULL)
+ return sym;
+ }
+
+ return {};
+ }
+
+ /* See language.h. */
+
+ int parser (struct parser_state *ps) const override
+ {
+ warnings_issued = 0;
+ return ada_parse (ps);
+ }
+
+ /* See language.h.
+
+ Same as evaluate_type (*EXP), but resolves ambiguous symbol references
+ (marked by OP_VAR_VALUE nodes in which the symbol has an undefined
+ namespace) and converts operators that are user-defined into
+ appropriate function calls. If CONTEXT_TYPE is non-null, it provides
+ a preferred result type [at the moment, only type void has any
+ effect---causing procedures to be preferred over functions in calls].
+ A null CONTEXT_TYPE indicates that a non-void return type is
+ preferred. May change (expand) *EXP. */
+
+ void post_parser (expression_up *expp, int void_context_p, int completing,
+ innermost_block_tracker *tracker) const override
+ {
+ struct type *context_type = NULL;
+ int pc = 0;
+
+ if (void_context_p)
+ context_type = builtin_type ((*expp)->gdbarch)->builtin_void;
+
+ resolve_subexp (expp, &pc, 1, context_type, completing, tracker);
+ }
+
+ /* See language.h. */
+
+ void emitchar (int ch, struct type *chtype,
+ struct ui_file *stream, int quoter) const override
+ {
+ ada_emit_char (ch, chtype, stream, quoter, 1);
+ }
+
+ /* See language.h. */
+
+ void printchar (int ch, struct type *chtype,
+ struct ui_file *stream) const override
+ {
+ ada_printchar (ch, chtype, stream);
+ }
+
+ /* See language.h. */
+
+ void printstr (struct ui_file *stream, struct type *elttype,
+ const gdb_byte *string, unsigned int length,
+ const char *encoding, int force_ellipses,
+ const struct value_print_options *options) const override
+ {
+ ada_printstr (stream, elttype, string, length, encoding,
+ force_ellipses, options);
+ }
+
+ /* See language.h. */
+
+ void print_typedef (struct type *type, struct symbol *new_symbol,
+ struct ui_file *stream) const override
+ {
+ ada_print_typedef (type, new_symbol, stream);
+ }
+
+ /* See language.h. */
+
+ bool is_string_type_p (struct type *type) const override
+ {
+ return ada_is_string_type (type);
+ }
+
+
+protected:
+ /* See language.h. */
+
+ symbol_name_matcher_ftype *get_symbol_name_matcher_inner
+ (const lookup_name_info &lookup_name) const override
+ {
+ return ada_get_symbol_name_matcher (lookup_name);
+ }
+};
+
+/* Single instance of the Ada language class. */
+
+static ada_language ada_language_defn;
+
+/* Command-list for the "set/show ada" prefix command. */
+static struct cmd_list_element *set_ada_list;
+static struct cmd_list_element *show_ada_list;