GDB (xrefs)
Loading...
Searching...
No Matches
ada-lang.c
Go to the documentation of this file.
1/* Ada language support routines for GDB, the GNU debugger.
2
3 Copyright (C) 1992-2023 Free Software Foundation, Inc.
4
5 This file is part of GDB.
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
19
20
21#include "defs.h"
22#include <ctype.h>
23#include "gdbsupport/gdb_regex.h"
24#include "frame.h"
25#include "symtab.h"
26#include "gdbtypes.h"
27#include "gdbcmd.h"
28#include "expression.h"
29#include "parser-defs.h"
30#include "language.h"
31#include "varobj.h"
32#include "inferior.h"
33#include "symfile.h"
34#include "objfiles.h"
35#include "breakpoint.h"
36#include "gdbcore.h"
37#include "hashtab.h"
38#include "gdbsupport/gdb_obstack.h"
39#include "ada-lang.h"
40#include "completer.h"
41#include "ui-out.h"
42#include "block.h"
43#include "infcall.h"
44#include "annotate.h"
45#include "valprint.h"
46#include "source.h"
47#include "observable.h"
48#include "stack.h"
49#include "typeprint.h"
50#include "namespace.h"
51#include "cli/cli-style.h"
52#include "cli/cli-decode.h"
53
54#include "value.h"
55#include "mi/mi-common.h"
56#include "arch-utils.h"
57#include "cli/cli-utils.h"
58#include "gdbsupport/function-view.h"
59#include "gdbsupport/byte-vector.h"
60#include "gdbsupport/selftest.h"
61#include <algorithm>
62#include "ada-exp.h"
63#include "charset.h"
64#include "ax-gdb.h"
65
66static struct type *desc_base_type (struct type *);
67
68static struct type *desc_bounds_type (struct type *);
69
70static struct value *desc_bounds (struct value *);
71
72static int fat_pntr_bounds_bitpos (struct type *);
73
74static int fat_pntr_bounds_bitsize (struct type *);
75
76static struct type *desc_data_target_type (struct type *);
77
78static struct value *desc_data (struct value *);
79
80static int fat_pntr_data_bitpos (struct type *);
81
82static int fat_pntr_data_bitsize (struct type *);
83
84static struct value *desc_one_bound (struct value *, int, int);
85
86static int desc_bound_bitpos (struct type *, int, int);
87
88static int desc_bound_bitsize (struct type *, int, int);
89
90static struct type *desc_index_type (struct type *, int);
91
92static int desc_arity (struct type *);
93
94static int ada_args_match (struct symbol *, struct value **, int);
95
96static struct value *make_array_descriptor (struct type *, struct value *);
97
98static void ada_add_block_symbols (std::vector<struct block_symbol> &,
99 const struct block *,
100 const lookup_name_info &lookup_name,
101 domain_enum, struct objfile *);
102
103static void ada_add_all_symbols (std::vector<struct block_symbol> &,
104 const struct block *,
105 const lookup_name_info &lookup_name,
106 domain_enum, int, int *);
107
108static int is_nonfunction (const std::vector<struct block_symbol> &);
109
110static void add_defn_to_vec (std::vector<struct block_symbol> &,
111 struct symbol *,
112 const struct block *);
113
114static int possible_user_operator_p (enum exp_opcode, struct value **);
115
116static const char *ada_decoded_op_name (enum exp_opcode);
117
118static int numeric_type_p (struct type *);
119
120static int integer_type_p (struct type *);
121
122static int scalar_type_p (struct type *);
123
124static int discrete_type_p (struct type *);
125
126static struct type *ada_lookup_struct_elt_type (struct type *, const char *,
127 int, int);
128
129static struct type *ada_find_parallel_type_with_name (struct type *,
130 const char *);
131
132static int is_dynamic_field (struct type *, int);
133
134static struct type *to_fixed_variant_branch_type (struct type *,
135 const gdb_byte *,
136 CORE_ADDR, struct value *);
137
138static struct type *to_fixed_array_type (struct type *, struct value *, int);
139
140static struct type *to_fixed_range_type (struct type *, struct value *);
141
142static struct type *to_static_fixed_type (struct type *);
143static struct type *static_unwrap_type (struct type *type);
144
145static struct value *unwrap_value (struct value *);
146
147static struct type *constrained_packed_array_type (struct type *, long *);
148
149static struct type *decode_constrained_packed_array_type (struct type *);
150
151static long decode_packed_array_bitsize (struct type *);
152
153static struct value *decode_constrained_packed_array (struct value *);
154
155static int ada_is_unconstrained_packed_array_type (struct type *);
156
157static struct value *value_subscript_packed (struct value *, int,
158 struct value **);
159
160static struct value *coerce_unspec_val_to_type (struct value *,
161 struct type *);
162
163static int lesseq_defined_than (struct symbol *, struct symbol *);
164
165static int equiv_types (struct type *, struct type *);
166
167static int is_name_suffix (const char *);
168
169static int advance_wild_match (const char **, const char *, char);
170
171static bool wild_match (const char *name, const char *patn);
172
173static struct value *ada_coerce_ref (struct value *);
174
175static LONGEST pos_atr (struct value *);
176
177static struct value *val_atr (struct type *, LONGEST);
178
179static struct symbol *standard_lookup (const char *, const struct block *,
181
182static struct value *ada_search_struct_field (const char *, struct value *, int,
183 struct type *);
184
185static int find_struct_field (const char *, struct type *, int,
186 struct type **, int *, int *, int *, int *);
187
188static int ada_resolve_function (std::vector<struct block_symbol> &,
189 struct value **, int, const char *,
190 struct type *, bool);
191
192static int ada_is_direct_array_type (struct type *);
193
194static struct value *ada_index_struct_field (int, struct value *, int,
195 struct type *);
196
197static void add_component_interval (LONGEST, LONGEST, std::vector<LONGEST> &);
198
199
200static struct type *ada_find_any_type (const char *name);
201
203 (const lookup_name_info &lookup_name);
204
206 (const std::vector<struct block_symbol> &syms);
207
208static int ada_identical_enum_types_p (struct type *type1, struct type *type2);
209
210
211/* The character set used for source files. */
212static const char *ada_source_charset;
213
214/* The string "UTF-8". This is here so we can check for the UTF-8
215 charset using == rather than strcmp. */
216static const char ada_utf8[] = "UTF-8";
217
218/* Each entry in the UTF-32 case-folding table is of this form. */
220{
221 /* The start and end, inclusive, of this range of codepoints. */
222 uint32_t start, end;
223 /* The delta to apply to get the upper-case form. 0 if this is
224 already upper-case. */
226 /* The delta to apply to get the lower-case form. 0 if this is
227 already lower-case. */
229
230 bool operator< (uint32_t val) const
231 {
232 return end < val;
233 }
234};
235
236static const utf8_entry ada_case_fold[] =
237{
238#include "ada-casefold.h"
239};
240
241
242
244#ifdef VMS
245 " \t\n!@#%^&*()+=|~`}{[]\";:?/,-";
246#else
247 " \t\n!@#$%^&*()+=|~`}{[]\";:?/,-";
248#endif
249
250/* The name of the symbol to use to get the name of the main subprogram. */
252 = "__gnat_ada_main_program_name";
253
254/* Limit on the number of warnings to raise per expression evaluation. */
255static int warning_limit = 2;
256
257/* Number of warning messages issued; reset to 0 by cleanups after
258 expression evaluation. */
259static int warnings_issued = 0;
260
261static const char * const known_runtime_file_name_patterns[] = {
263};
264
268
269/* Maintenance-related settings for this module. */
270
273
274/* The "maintenance ada set/show ignore-descriptive-type" value. */
275
277
278 /* Inferior-specific data. */
279
280/* Per-inferior data for this module. */
281
283{
284 /* The ada__tags__type_specific_data type, which is used when decoding
285 tagged types. With older versions of GNAT, this type was directly
286 accessible through a component ("tsd") in the object tag. But this
287 is no longer the case, so we cache it for each inferior. */
288 struct type *tsd_type = nullptr;
289
290 /* The exception_support_info data. This data is used to determine
291 how to implement support for Ada exception catchpoints in a given
292 inferior. */
293 const struct exception_support_info *exception_info = nullptr;
294};
295
296/* Our key to this module's inferior data. */
298
299/* Return our inferior data for the given inferior (INF).
300
301 This function always returns a valid pointer to an allocated
302 ada_inferior_data structure. If INF's inferior data has not
303 been previously set, this functions creates a new one with all
304 fields set to zero, sets INF's inferior to it, and then returns
305 a pointer to that newly allocated ada_inferior_data. */
306
307static struct ada_inferior_data *
309{
310 struct ada_inferior_data *data;
311
312 data = ada_inferior_data.get (inf);
313 if (data == NULL)
314 data = ada_inferior_data.emplace (inf);
315
316 return data;
317}
318
319/* Perform all necessary cleanups regarding our module's inferior data
320 that is required after the inferior INF just exited. */
321
322static void
324{
325 ada_inferior_data.clear (inf);
326}
327
328
329 /* program-space-specific data. */
330
331/* The result of a symbol lookup to be stored in our symbol cache. */
332
334{
335 /* The name used to perform the lookup. */
336 std::string name;
337 /* The namespace used during the lookup. */
339 /* The symbol returned by the lookup, or NULL if no matching symbol
340 was found. */
341 struct symbol *sym = nullptr;
342 /* The block where the symbol was found, or NULL if no matching
343 symbol was found. */
344 const struct block *block = nullptr;
345};
346
347/* The symbol cache uses this type when searching. */
348
350{
351 const char *name;
353
354 hashval_t hash () const
355 {
356 /* This must agree with hash_cache_entry, below. */
357 return htab_hash_string (name);
358 }
359};
360
361/* Hash function for cache_entry. */
362
363static hashval_t
364hash_cache_entry (const void *v)
365{
366 const cache_entry *entry = (const cache_entry *) v;
367 return htab_hash_string (entry->name.c_str ());
368}
369
370/* Equality function for cache_entry. */
371
372static int
373eq_cache_entry (const void *a, const void *b)
374{
375 const cache_entry *entrya = (const cache_entry *) a;
376 const cache_entry_search *entryb = (const cache_entry_search *) b;
377
378 return entrya->domain == entryb->domain && entrya->name == entryb->name;
379}
380
381/* Key to our per-program-space data. */
382static const registry<program_space>::key<htab, htab_deleter>
384
385/* Return this module's data for the given program space (PSPACE).
386 If not is found, add a zero'ed one now.
387
388 This function always returns a valid object. */
389
390static htab_t
392{
393 htab_t data = ada_pspace_data_handle.get (pspace);
394 if (data == nullptr)
395 {
396 data = htab_create_alloc (10, hash_cache_entry, eq_cache_entry,
397 htab_delete_entry<cache_entry>,
398 xcalloc, xfree);
399 ada_pspace_data_handle.set (pspace, data);
400 }
401
402 return data;
403}
404
405 /* Utilities */
406
407/* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
408 all typedef layers have been peeled. Otherwise, return TYPE.
409
410 Normally, we really expect a typedef type to only have 1 typedef layer.
411 In other words, we really expect the target type of a typedef type to be
412 a non-typedef type. This is particularly true for Ada units, because
413 the language does not have a typedef vs not-typedef distinction.
414 In that respect, the Ada compiler has been trying to eliminate as many
415 typedef definitions in the debugging information, since they generally
416 do not bring any extra information (we still use typedef under certain
417 circumstances related mostly to the GNAT encoding).
418
419 Unfortunately, we have seen situations where the debugging information
420 generated by the compiler leads to such multiple typedef layers. For
421 instance, consider the following example with stabs:
422
423 .stabs "pck__float_array___XUP:Tt(0,46)=s16P_ARRAY:(0,47)=[...]"[...]
424 .stabs "pck__float_array___XUP:t(0,36)=(0,46)",128,0,6,0
425
426 This is an error in the debugging information which causes type
427 pck__float_array___XUP to be defined twice, and the second time,
428 it is defined as a typedef of a typedef.
429
430 This is on the fringe of legality as far as debugging information is
431 concerned, and certainly unexpected. But it is easy to handle these
432 situations correctly, so we can afford to be lenient in this case. */
433
434static struct type *
436{
437 while (type->code () == TYPE_CODE_TYPEDEF)
438 type = type->target_type ();
439 return type;
440}
441
442/* Given DECODED_NAME a string holding a symbol name in its
443 decoded form (ie using the Ada dotted notation), returns
444 its unqualified name. */
445
446static const char *
447ada_unqualified_name (const char *decoded_name)
448{
449 const char *result;
450
451 /* If the decoded name starts with '<', it means that the encoded
452 name does not follow standard naming conventions, and thus that
453 it is not your typical Ada symbol name. Trying to unqualify it
454 is therefore pointless and possibly erroneous. */
455 if (decoded_name[0] == '<')
456 return decoded_name;
457
458 result = strrchr (decoded_name, '.');
459 if (result != NULL)
460 result++; /* Skip the dot... */
461 else
462 result = decoded_name;
463
464 return result;
465}
466
467/* Return a string starting with '<', followed by STR, and '>'. */
468
469static std::string
470add_angle_brackets (const char *str)
471{
472 return string_printf ("<%s>", str);
473}
474
475/* True (non-zero) iff TARGET matches FIELD_NAME up to any trailing
476 suffix of FIELD_NAME beginning "___". */
477
478static int
479field_name_match (const char *field_name, const char *target)
480{
481 int len = strlen (target);
482
483 return
484 (strncmp (field_name, target, len) == 0
485 && (field_name[len] == '\0'
486 || (startswith (field_name + len, "___")
487 && strcmp (field_name + strlen (field_name) - 6,
488 "___XVN") != 0)));
489}
490
491
492/* Assuming TYPE is a TYPE_CODE_STRUCT or a TYPE_CODE_TYPDEF to
493 a TYPE_CODE_STRUCT, find the field whose name matches FIELD_NAME,
494 and return its index. This function also handles fields whose name
495 have ___ suffixes because the compiler sometimes alters their name
496 by adding such a suffix to represent fields with certain constraints.
497 If the field could not be found, return a negative number if
498 MAYBE_MISSING is set. Otherwise raise an error. */
499
500int
501ada_get_field_index (const struct type *type, const char *field_name,
502 int maybe_missing)
503{
504 int fieldno;
505 struct type *struct_type = check_typedef ((struct type *) type);
506
507 for (fieldno = 0; fieldno < struct_type->num_fields (); fieldno++)
508 if (field_name_match (struct_type->field (fieldno).name (), field_name))
509 return fieldno;
510
511 if (!maybe_missing)
512 error (_("Unable to find field %s in struct %s. Aborting"),
513 field_name, struct_type->name ());
514
515 return -1;
516}
517
518/* The length of the prefix of NAME prior to any "___" suffix. */
519
520int
522{
523 if (name == NULL)
524 return 0;
525 else
526 {
527 const char *p = strstr (name, "___");
528
529 if (p == NULL)
530 return strlen (name);
531 else
532 return p - name;
533 }
534}
535
536/* Return non-zero if SUFFIX is a suffix of STR.
537 Return zero if STR is null. */
538
539static int
540is_suffix (const char *str, const char *suffix)
541{
542 int len1, len2;
543
544 if (str == NULL)
545 return 0;
546 len1 = strlen (str);
547 len2 = strlen (suffix);
548 return (len1 >= len2 && strcmp (str + len1 - len2, suffix) == 0);
549}
550
551/* The contents of value VAL, treated as a value of type TYPE. The
552 result is an lval in memory if VAL is. */
553
554static struct value *
556{
558 if (val->type () == type)
559 return val;
560 else
561 {
562 struct value *result;
563
564 if (val->optimized_out ())
566 else if (val->lazy ()
567 /* Be careful not to make a lazy not_lval value. */
568 || (val->lval () != not_lval
569 && type->length () > val->type ()->length ()))
570 result = value::allocate_lazy (type);
571 else
572 {
573 result = value::allocate (type);
574 val->contents_copy (result, 0, 0, type->length ());
575 }
576 result->set_component_location (val);
577 result->set_bitsize (val->bitsize ());
578 result->set_bitpos (val->bitpos ());
579 if (result->lval () == lval_memory)
580 result->set_address (val->address ());
581 return result;
582 }
583}
584
585static const gdb_byte *
586cond_offset_host (const gdb_byte *valaddr, long offset)
587{
588 if (valaddr == NULL)
589 return NULL;
590 else
591 return valaddr + offset;
592}
593
594static CORE_ADDR
596{
597 if (address == 0)
598 return 0;
599 else
600 return address + offset;
601}
602
603/* Issue a warning (as for the definition of warning in utils.c, but
604 with exactly one argument rather than ...), unless the limit on the
605 number of warnings has passed during the evaluation of the current
606 expression. */
607
608/* FIXME: cagney/2004-10-10: This function is mimicking the behavior
609 provided by "complaint". */
610static void lim_warning (const char *format, ...) ATTRIBUTE_PRINTF (1, 2);
611
612static void
613lim_warning (const char *format, ...)
614{
615 va_list args;
616
617 va_start (args, format);
618 warnings_issued += 1;
620 vwarning (format, args);
621
622 va_end (args);
623}
624
625/* Maximum value of a SIZE-byte signed integer type. */
626static LONGEST
628{
629 LONGEST top_bit = (LONGEST) 1 << (size * 8 - 2);
630
631 return top_bit | (top_bit - 1);
632}
633
634/* Minimum value of a SIZE-byte signed integer type. */
635static LONGEST
637{
638 return -max_of_size (size) - 1;
639}
640
641/* Maximum value of a SIZE-byte unsigned integer type. */
642static ULONGEST
644{
645 ULONGEST top_bit = (ULONGEST) 1 << (size * 8 - 1);
646
647 return top_bit | (top_bit - 1);
648}
649
650/* Maximum value of integral type T, as a signed quantity. */
651static LONGEST
652max_of_type (struct type *t)
653{
654 if (t->is_unsigned ())
655 return (LONGEST) umax_of_size (t->length ());
656 else
657 return max_of_size (t->length ());
658}
659
660/* Minimum value of integral type T, as a signed quantity. */
661static LONGEST
662min_of_type (struct type *t)
663{
664 if (t->is_unsigned ())
665 return 0;
666 else
667 return min_of_size (t->length ());
668}
669
670/* The largest value in the domain of TYPE, a discrete type, as an integer. */
671LONGEST
673{
674 type = resolve_dynamic_type (type, {}, 0);
675 switch (type->code ())
676 {
677 case TYPE_CODE_RANGE:
678 {
679 const dynamic_prop &high = type->bounds ()->high;
680
681 if (high.is_constant ())
682 return high.const_val ();
683 else
684 {
685 gdb_assert (high.kind () == PROP_UNDEFINED);
686
687 /* This happens when trying to evaluate a type's dynamic bound
688 without a live target. There is nothing relevant for us to
689 return here, so return 0. */
690 return 0;
691 }
692 }
693 case TYPE_CODE_ENUM:
694 return type->field (type->num_fields () - 1).loc_enumval ();
695 case TYPE_CODE_BOOL:
696 return 1;
697 case TYPE_CODE_CHAR:
698 case TYPE_CODE_INT:
699 return max_of_type (type);
700 default:
701 error (_("Unexpected type in ada_discrete_type_high_bound."));
702 }
703}
704
705/* The smallest value in the domain of TYPE, a discrete type, as an integer. */
706LONGEST
708{
709 type = resolve_dynamic_type (type, {}, 0);
710 switch (type->code ())
711 {
712 case TYPE_CODE_RANGE:
713 {
714 const dynamic_prop &low = type->bounds ()->low;
715
716 if (low.is_constant ())
717 return low.const_val ();
718 else
719 {
720 gdb_assert (low.kind () == PROP_UNDEFINED);
721
722 /* This happens when trying to evaluate a type's dynamic bound
723 without a live target. There is nothing relevant for us to
724 return here, so return 0. */
725 return 0;
726 }
727 }
728 case TYPE_CODE_ENUM:
729 return type->field (0).loc_enumval ();
730 case TYPE_CODE_BOOL:
731 return 0;
732 case TYPE_CODE_CHAR:
733 case TYPE_CODE_INT:
734 return min_of_type (type);
735 default:
736 error (_("Unexpected type in ada_discrete_type_low_bound."));
737 }
738}
739
740/* The identity on non-range types. For range types, the underlying
741 non-range scalar type. */
742
743static struct type *
745{
746 while (type != NULL && type->code () == TYPE_CODE_RANGE)
747 {
748 if (type == type->target_type () || type->target_type () == NULL)
749 return type;
750 type = type->target_type ();
751 }
752 return type;
753}
754
755/* Return a decoded version of the given VALUE. This means returning
756 a value whose type is obtained by applying all the GNAT-specific
757 encodings, making the resulting type a static but standard description
758 of the initial type. */
759
760struct value *
762{
763 struct type *type = ada_check_typedef (value->type ());
764
767 && type->code () != TYPE_CODE_PTR))
768 {
769 if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */
771 else
773 }
774 else
776
777 return value;
778}
779
780/* Same as ada_get_decoded_value, but with the given TYPE.
781 Because there is no associated actual value for this type,
782 the resulting type might be a best-effort approximation in
783 the case of dynamic types. */
784
785struct type *
793
794
795
796 /* Language Selection */
797
798/* If the main procedure is written in Ada, then return its name.
799 The result is good until the next call. Return NULL if the main
800 procedure doesn't appear to be in Ada. */
801
802const char *
804{
805 struct bound_minimal_symbol msym;
806 static gdb::unique_xmalloc_ptr<char> main_program_name;
807
808 /* For Ada, the name of the main procedure is stored in a specific
809 string constant, generated by the binder. Look for that symbol,
810 extract its address, and then read that string. If we didn't find
811 that string, then most probably the main procedure is not written
812 in Ada. */
814
815 if (msym.minsym != NULL)
816 {
817 CORE_ADDR main_program_name_addr = msym.value_address ();
818 if (main_program_name_addr == 0)
819 error (_("Invalid address for Ada main program name."));
820
821 /* Force trust_readonly, because we always want to fetch this
822 string from the executable, not from inferior memory. If the
823 user changes the exec-file and invokes "start", we want to
824 pick the "main" from the new executable, not one that may
825 come from the still-live inferior. */
826 scoped_restore save_trust_readonly
827 = make_scoped_restore (&trust_readonly, true);
828 main_program_name = target_read_string (main_program_name_addr, 1024);
829 return main_program_name.get ();
830 }
831
832 /* The main procedure doesn't seem to be in Ada. */
833 return NULL;
834}
835
836 /* Symbols */
837
838/* Table of Ada operators and their GNAT-encoded names. Last entry is pair
839 of NULLs. */
840
842 {"Oadd", "\"+\"", BINOP_ADD},
843 {"Osubtract", "\"-\"", BINOP_SUB},
844 {"Omultiply", "\"*\"", BINOP_MUL},
845 {"Odivide", "\"/\"", BINOP_DIV},
846 {"Omod", "\"mod\"", BINOP_MOD},
847 {"Orem", "\"rem\"", BINOP_REM},
848 {"Oexpon", "\"**\"", BINOP_EXP},
849 {"Olt", "\"<\"", BINOP_LESS},
850 {"Ole", "\"<=\"", BINOP_LEQ},
851 {"Ogt", "\">\"", BINOP_GTR},
852 {"Oge", "\">=\"", BINOP_GEQ},
853 {"Oeq", "\"=\"", BINOP_EQUAL},
854 {"One", "\"/=\"", BINOP_NOTEQUAL},
855 {"Oand", "\"and\"", BINOP_BITWISE_AND},
856 {"Oor", "\"or\"", BINOP_BITWISE_IOR},
857 {"Oxor", "\"xor\"", BINOP_BITWISE_XOR},
858 {"Oconcat", "\"&\"", BINOP_CONCAT},
859 {"Oabs", "\"abs\"", UNOP_ABS},
860 {"Onot", "\"not\"", UNOP_LOGICAL_NOT},
861 {"Oadd", "\"+\"", UNOP_PLUS},
862 {"Osubtract", "\"-\"", UNOP_NEG},
863 {NULL, NULL}
864};
865
866/* If STR is a decoded version of a compiler-provided suffix (like the
867 "[cold]" in "symbol[cold]"), return true. Otherwise, return
868 false. */
869
870static bool
871is_compiler_suffix (const char *str)
872{
873 gdb_assert (*str == '[');
874 ++str;
875 while (*str != '\0' && isalpha (*str))
876 ++str;
877 /* We accept a missing "]" in order to support completion. */
878 return *str == '\0' || (str[0] == ']' && str[1] == '\0');
879}
880
881/* Append a non-ASCII character to RESULT. */
882static void
883append_hex_encoded (std::string &result, uint32_t one_char)
884{
885 if (one_char <= 0xff)
886 {
887 result.append ("U");
888 result.append (phex (one_char, 1));
889 }
890 else if (one_char <= 0xffff)
891 {
892 result.append ("W");
893 result.append (phex (one_char, 2));
894 }
895 else
896 {
897 result.append ("WW");
898 result.append (phex (one_char, 4));
899 }
900}
901
902/* Return a string that is a copy of the data in STORAGE, with
903 non-ASCII characters replaced by the appropriate hex encoding. A
904 template is used because, for UTF-8, we actually want to work with
905 UTF-32 codepoints. */
906template<typename T>
907std::string
908copy_and_hex_encode (struct obstack *storage)
909{
910 const T *chars = (T *) obstack_base (storage);
911 int num_chars = obstack_object_size (storage) / sizeof (T);
912 std::string result;
913 for (int i = 0; i < num_chars; ++i)
914 {
915 if (chars[i] <= 0x7f)
916 {
917 /* The host character set has to be a superset of ASCII, as
918 are all the other character sets we can use. */
919 result.push_back (chars[i]);
920 }
921 else
922 append_hex_encoded (result, chars[i]);
923 }
924 return result;
925}
926
927/* The "encoded" form of DECODED, according to GNAT conventions. If
928 THROW_ERRORS, throw an error if invalid operator name is found.
929 Otherwise, return the empty string in that case. */
930
931static std::string
932ada_encode_1 (const char *decoded, bool throw_errors)
933{
934 if (decoded == NULL)
935 return {};
936
937 std::string encoding_buffer;
938 bool saw_non_ascii = false;
939 for (const char *p = decoded; *p != '\0'; p += 1)
940 {
941 if ((*p & 0x80) != 0)
942 saw_non_ascii = true;
943
944 if (*p == '.')
945 encoding_buffer.append ("__");
946 else if (*p == '[' && is_compiler_suffix (p))
947 {
948 encoding_buffer = encoding_buffer + "." + (p + 1);
949 if (encoding_buffer.back () == ']')
950 encoding_buffer.pop_back ();
951 break;
952 }
953 else if (*p == '"')
954 {
955 const struct ada_opname_map *mapping;
956
958 mapping->encoded != NULL
959 && !startswith (p, mapping->decoded); mapping += 1)
960 ;
961 if (mapping->encoded == NULL)
962 {
963 if (throw_errors)
964 error (_("invalid Ada operator name: %s"), p);
965 else
966 return {};
967 }
968 encoding_buffer.append (mapping->encoded);
969 break;
970 }
971 else
972 encoding_buffer.push_back (*p);
973 }
974
975 /* If a non-ASCII character is seen, we must convert it to the
976 appropriate hex form. As this is more expensive, we keep track
977 of whether it is even necessary. */
978 if (saw_non_ascii)
979 {
980 auto_obstack storage;
981 bool is_utf8 = ada_source_charset == ada_utf8;
982 try
983 {
985 (host_charset (),
986 is_utf8 ? HOST_UTF32 : ada_source_charset,
987 (const gdb_byte *) encoding_buffer.c_str (),
988 encoding_buffer.length (), 1,
989 &storage, translit_none);
990 }
991 catch (const gdb_exception &)
992 {
993 static bool warned = false;
994
995 /* Converting to UTF-32 shouldn't fail, so if it doesn't, we
996 might like to know why. */
997 if (!warned)
998 {
999 warned = true;
1000 warning (_("charset conversion failure for '%s'.\n"
1001 "You may have the wrong value for 'set ada source-charset'."),
1002 encoding_buffer.c_str ());
1003 }
1004
1005 /* We don't try to recover from errors. */
1006 return encoding_buffer;
1007 }
1008
1009 if (is_utf8)
1010 return copy_and_hex_encode<uint32_t> (&storage);
1011 return copy_and_hex_encode<gdb_byte> (&storage);
1012 }
1013
1014 return encoding_buffer;
1015}
1016
1017/* Find the entry for C in the case-folding table. Return nullptr if
1018 the entry does not cover C. */
1019static const utf8_entry *
1021{
1022 auto iter = std::lower_bound (std::begin (ada_case_fold),
1023 std::end (ada_case_fold),
1024 c);
1025 if (iter == std::end (ada_case_fold)
1026 || c < iter->start
1027 || c > iter->end)
1028 return nullptr;
1029 return &*iter;
1030}
1031
1032/* Return NAME folded to lower case, or, if surrounded by single
1033 quotes, unfolded, but with the quotes stripped away. If
1034 THROW_ON_ERROR is true, encoding failures will throw an exception
1035 rather than emitting a warning. Result good to next call. */
1036
1037static const char *
1038ada_fold_name (gdb::string_view name, bool throw_on_error = false)
1039{
1040 static std::string fold_storage;
1041
1042 if (!name.empty () && name[0] == '\'')
1043 fold_storage = gdb::to_string (name.substr (1, name.size () - 2));
1044 else
1045 {
1046 /* Why convert to UTF-32 and implement our own case-folding,
1047 rather than convert to wchar_t and use the platform's
1048 functions? I'm glad you asked.
1049
1050 The main problem is that GNAT implements an unusual rule for
1051 case folding. For ASCII letters, letters in single-byte
1052 encodings (such as ISO-8859-*), and Unicode letters that fit
1053 in a single byte (i.e., code point is <= 0xff), the letter is
1054 folded to lower case. Other Unicode letters are folded to
1055 upper case.
1056
1057 This rule means that the code must be able to examine the
1058 value of the character. And, some hosts do not use Unicode
1059 for wchar_t, so examining the value of such characters is
1060 forbidden. */
1061 auto_obstack storage;
1062 try
1063 {
1066 (const gdb_byte *) name.data (),
1067 name.length (), 1,
1068 &storage, translit_none);
1069 }
1070 catch (const gdb_exception &)
1071 {
1072 if (throw_on_error)
1073 throw;
1074
1075 static bool warned = false;
1076
1077 /* Converting to UTF-32 shouldn't fail, so if it doesn't, we
1078 might like to know why. */
1079 if (!warned)
1080 {
1081 warned = true;
1082 warning (_("could not convert '%s' from the host encoding (%s) to UTF-32.\n"
1083 "This normally should not happen, please file a bug report."),
1084 gdb::to_string (name).c_str (), host_charset ());
1085 }
1086
1087 /* We don't try to recover from errors; just return the
1088 original string. */
1089 fold_storage = gdb::to_string (name);
1090 return fold_storage.c_str ();
1091 }
1092
1093 bool is_utf8 = ada_source_charset == ada_utf8;
1094 uint32_t *chars = (uint32_t *) obstack_base (&storage);
1095 int num_chars = obstack_object_size (&storage) / sizeof (uint32_t);
1096 for (int i = 0; i < num_chars; ++i)
1097 {
1098 const struct utf8_entry *entry = find_case_fold_entry (chars[i]);
1099 if (entry != nullptr)
1100 {
1101 uint32_t low = chars[i] + entry->lower_delta;
1102 if (!is_utf8 || low <= 0xff)
1103 chars[i] = low;
1104 else
1105 chars[i] = chars[i] + entry->upper_delta;
1106 }
1107 }
1108
1109 /* Now convert back to ordinary characters. */
1110 auto_obstack reconverted;
1111 try
1112 {
1114 host_charset (),
1115 (const gdb_byte *) chars,
1116 num_chars * sizeof (uint32_t),
1117 sizeof (uint32_t),
1118 &reconverted,
1120 obstack_1grow (&reconverted, '\0');
1121 fold_storage = std::string ((const char *) obstack_base (&reconverted));
1122 }
1123 catch (const gdb_exception &)
1124 {
1125 if (throw_on_error)
1126 throw;
1127
1128 static bool warned = false;
1129
1130 /* Converting back from UTF-32 shouldn't normally fail, but
1131 there are some host encodings without upper/lower
1132 equivalence. */
1133 if (!warned)
1134 {
1135 warned = true;
1136 warning (_("could not convert the lower-cased variant of '%s'\n"
1137 "from UTF-32 to the host encoding (%s)."),
1138 gdb::to_string (name).c_str (), host_charset ());
1139 }
1140
1141 /* We don't try to recover from errors; just return the
1142 original string. */
1143 fold_storage = gdb::to_string (name);
1144 }
1145 }
1146
1147 return fold_storage.c_str ();
1148}
1149
1150/* The "encoded" form of DECODED, according to GNAT conventions. If
1151 FOLD is true (the default), case-fold any ordinary symbol. Symbols
1152 with <...> quoting are not folded in any case. */
1153
1154std::string
1155ada_encode (const char *decoded, bool fold)
1156{
1157 if (fold && decoded[0] != '<')
1158 decoded = ada_fold_name (decoded);
1159 return ada_encode_1 (decoded, true);
1160}
1161
1162/* Return nonzero if C is either a digit or a lowercase alphabet character. */
1163
1164static int
1165is_lower_alphanum (const char c)
1166{
1167 return (isdigit (c) || (isalpha (c) && islower (c)));
1168}
1169
1170/* ENCODED is the linkage name of a symbol and LEN contains its length.
1171 This function saves in LEN the length of that same symbol name but
1172 without either of these suffixes:
1173 . .{DIGIT}+
1174 . ${DIGIT}+
1175 . ___{DIGIT}+
1176 . __{DIGIT}+.
1177
1178 These are suffixes introduced by the compiler for entities such as
1179 nested subprogram for instance, in order to avoid name clashes.
1180 They do not serve any purpose for the debugger. */
1181
1182static void
1183ada_remove_trailing_digits (const char *encoded, int *len)
1184{
1185 if (*len > 1 && isdigit (encoded[*len - 1]))
1186 {
1187 int i = *len - 2;
1188
1189 while (i > 0 && isdigit (encoded[i]))
1190 i--;
1191 if (i >= 0 && encoded[i] == '.')
1192 *len = i;
1193 else if (i >= 0 && encoded[i] == '$')
1194 *len = i;
1195 else if (i >= 2 && startswith (encoded + i - 2, "___"))
1196 *len = i - 2;
1197 else if (i >= 1 && startswith (encoded + i - 1, "__"))
1198 *len = i - 1;
1199 }
1200}
1201
1202/* Remove the suffix introduced by the compiler for protected object
1203 subprograms. */
1204
1205static void
1206ada_remove_po_subprogram_suffix (const char *encoded, int *len)
1207{
1208 /* Remove trailing N. */
1209
1210 /* Protected entry subprograms are broken into two
1211 separate subprograms: The first one is unprotected, and has
1212 a 'N' suffix; the second is the protected version, and has
1213 the 'P' suffix. The second calls the first one after handling
1214 the protection. Since the P subprograms are internally generated,
1215 we leave these names undecoded, giving the user a clue that this
1216 entity is internal. */
1217
1218 if (*len > 1
1219 && encoded[*len - 1] == 'N'
1220 && (isdigit (encoded[*len - 2]) || islower (encoded[*len - 2])))
1221 *len = *len - 1;
1222}
1223
1224/* If ENCODED ends with a compiler-provided suffix (like ".cold"),
1225 then update *LEN to remove the suffix and return the offset of the
1226 character just past the ".". Otherwise, return -1. */
1227
1228static int
1229remove_compiler_suffix (const char *encoded, int *len)
1230{
1231 int offset = *len - 1;
1232 while (offset > 0 && isalpha (encoded[offset]))
1233 --offset;
1234 if (offset > 0 && encoded[offset] == '.')
1235 {
1236 *len = offset;
1237 return offset + 1;
1238 }
1239 return -1;
1240}
1241
1242/* Convert an ASCII hex string to a number. Reads exactly N
1243 characters from STR. Returns true on success, false if one of the
1244 digits was not a hex digit. */
1245static bool
1246convert_hex (const char *str, int n, uint32_t *out)
1247{
1248 uint32_t result = 0;
1249
1250 for (int i = 0; i < n; ++i)
1251 {
1252 if (!isxdigit (str[i]))
1253 return false;
1254 result <<= 4;
1255 result |= fromhex (str[i]);
1256 }
1257
1258 *out = result;
1259 return true;
1260}
1261
1262/* Convert a wide character from its ASCII hex representation in STR
1263 (consisting of exactly N characters) to the host encoding,
1264 appending the resulting bytes to OUT. If N==2 and the Ada source
1265 charset is not UTF-8, then hex refers to an encoding in the
1266 ADA_SOURCE_CHARSET; otherwise, use UTF-32. Return true on success.
1267 Return false and do not modify OUT on conversion failure. */
1268static bool
1269convert_from_hex_encoded (std::string &out, const char *str, int n)
1270{
1271 uint32_t value;
1272
1273 if (!convert_hex (str, n, &value))
1274 return false;
1275 try
1276 {
1277 auto_obstack bytes;
1278 /* In the 'U' case, the hex digits encode the character in the
1279 Ada source charset. However, if the source charset is UTF-8,
1280 this really means it is a single-byte UTF-32 character. */
1281 if (n == 2 && ada_source_charset != ada_utf8)
1282 {
1283 gdb_byte one_char = (gdb_byte) value;
1284
1286 &one_char,
1287 sizeof (one_char), sizeof (one_char),
1288 &bytes, translit_none);
1289 }
1290 else
1292 (const gdb_byte *) &value,
1293 sizeof (value), sizeof (value),
1294 &bytes, translit_none);
1295 obstack_1grow (&bytes, '\0');
1296 out.append ((const char *) obstack_base (&bytes));
1297 }
1298 catch (const gdb_exception &)
1299 {
1300 /* On failure, the caller will just let the encoded form
1301 through, which seems basically reasonable. */
1302 return false;
1303 }
1304
1305 return true;
1306}
1307
1308/* See ada-lang.h. */
1309
1310std::string
1311ada_decode (const char *encoded, bool wrap, bool operators)
1312{
1313 int i;
1314 int len0;
1315 const char *p;
1316 int at_start_name;
1317 std::string decoded;
1318 int suffix = -1;
1319
1320 /* With function descriptors on PPC64, the value of a symbol named
1321 ".FN", if it exists, is the entry point of the function "FN". */
1322 if (encoded[0] == '.')
1323 encoded += 1;
1324
1325 /* The name of the Ada main procedure starts with "_ada_".
1326 This prefix is not part of the decoded name, so skip this part
1327 if we see this prefix. */
1328 if (startswith (encoded, "_ada_"))
1329 encoded += 5;
1330 /* The "___ghost_" prefix is used for ghost entities. Normally
1331 these aren't preserved but when they are, it's useful to see
1332 them. */
1333 if (startswith (encoded, "___ghost_"))
1334 encoded += 9;
1335
1336 /* If the name starts with '_', then it is not a properly encoded
1337 name, so do not attempt to decode it. Similarly, if the name
1338 starts with '<', the name should not be decoded. */
1339 if (encoded[0] == '_' || encoded[0] == '<')
1340 goto Suppress;
1341
1342 len0 = strlen (encoded);
1343
1344 suffix = remove_compiler_suffix (encoded, &len0);
1345
1346 ada_remove_trailing_digits (encoded, &len0);
1347 ada_remove_po_subprogram_suffix (encoded, &len0);
1348
1349 /* Remove the ___X.* suffix if present. Do not forget to verify that
1350 the suffix is located before the current "end" of ENCODED. We want
1351 to avoid re-matching parts of ENCODED that have previously been
1352 marked as discarded (by decrementing LEN0). */
1353 p = strstr (encoded, "___");
1354 if (p != NULL && p - encoded < len0 - 3)
1355 {
1356 if (p[3] == 'X')
1357 len0 = p - encoded;
1358 else
1359 goto Suppress;
1360 }
1361
1362 /* Remove any trailing TKB suffix. It tells us that this symbol
1363 is for the body of a task, but that information does not actually
1364 appear in the decoded name. */
1365
1366 if (len0 > 3 && startswith (encoded + len0 - 3, "TKB"))
1367 len0 -= 3;
1368
1369 /* Remove any trailing TB suffix. The TB suffix is slightly different
1370 from the TKB suffix because it is used for non-anonymous task
1371 bodies. */
1372
1373 if (len0 > 2 && startswith (encoded + len0 - 2, "TB"))
1374 len0 -= 2;
1375
1376 /* Remove trailing "B" suffixes. */
1377 /* FIXME: brobecker/2006-04-19: Not sure what this are used for... */
1378
1379 if (len0 > 1 && startswith (encoded + len0 - 1, "B"))
1380 len0 -= 1;
1381
1382 /* Remove trailing __{digit}+ or trailing ${digit}+. */
1383
1384 if (len0 > 1 && isdigit (encoded[len0 - 1]))
1385 {
1386 i = len0 - 2;
1387 while ((i >= 0 && isdigit (encoded[i]))
1388 || (i >= 1 && encoded[i] == '_' && isdigit (encoded[i - 1])))
1389 i -= 1;
1390 if (i > 1 && encoded[i] == '_' && encoded[i - 1] == '_')
1391 len0 = i - 1;
1392 else if (i >= 0 && encoded[i] == '$')
1393 len0 = i;
1394 }
1395
1396 /* The first few characters that are not alphabetic are not part
1397 of any encoding we use, so we can copy them over verbatim. */
1398
1399 for (i = 0; i < len0 && !isalpha (encoded[i]); i += 1)
1400 decoded.push_back (encoded[i]);
1401
1402 at_start_name = 1;
1403 while (i < len0)
1404 {
1405 /* Is this a symbol function? */
1406 if (operators && at_start_name && encoded[i] == 'O')
1407 {
1408 int k;
1409
1410 for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
1411 {
1412 int op_len = strlen (ada_opname_table[k].encoded);
1413 if ((strncmp (ada_opname_table[k].encoded + 1, encoded + i + 1,
1414 op_len - 1) == 0)
1415 && !isalnum (encoded[i + op_len]))
1416 {
1417 decoded.append (ada_opname_table[k].decoded);
1418 at_start_name = 0;
1419 i += op_len;
1420 break;
1421 }
1422 }
1423 if (ada_opname_table[k].encoded != NULL)
1424 continue;
1425 }
1426 at_start_name = 0;
1427
1428 /* Replace "TK__" with "__", which will eventually be translated
1429 into "." (just below). */
1430
1431 if (i < len0 - 4 && startswith (encoded + i, "TK__"))
1432 i += 2;
1433
1434 /* Replace "__B_{DIGITS}+__" sequences by "__", which will eventually
1435 be translated into "." (just below). These are internal names
1436 generated for anonymous blocks inside which our symbol is nested. */
1437
1438 if (len0 - i > 5 && encoded [i] == '_' && encoded [i+1] == '_'
1439 && encoded [i+2] == 'B' && encoded [i+3] == '_'
1440 && isdigit (encoded [i+4]))
1441 {
1442 int k = i + 5;
1443
1444 while (k < len0 && isdigit (encoded[k]))
1445 k++; /* Skip any extra digit. */
1446
1447 /* Double-check that the "__B_{DIGITS}+" sequence we found
1448 is indeed followed by "__". */
1449 if (len0 - k > 2 && encoded [k] == '_' && encoded [k+1] == '_')
1450 i = k;
1451 }
1452
1453 /* Remove _E{DIGITS}+[sb] */
1454
1455 /* Just as for protected object subprograms, there are 2 categories
1456 of subprograms created by the compiler for each entry. The first
1457 one implements the actual entry code, and has a suffix following
1458 the convention above; the second one implements the barrier and
1459 uses the same convention as above, except that the 'E' is replaced
1460 by a 'B'.
1461
1462 Just as above, we do not decode the name of barrier functions
1463 to give the user a clue that the code he is debugging has been
1464 internally generated. */
1465
1466 if (len0 - i > 3 && encoded [i] == '_' && encoded[i+1] == 'E'
1467 && isdigit (encoded[i+2]))
1468 {
1469 int k = i + 3;
1470
1471 while (k < len0 && isdigit (encoded[k]))
1472 k++;
1473
1474 if (k < len0
1475 && (encoded[k] == 'b' || encoded[k] == 's'))
1476 {
1477 k++;
1478 /* Just as an extra precaution, make sure that if this
1479 suffix is followed by anything else, it is a '_'.
1480 Otherwise, we matched this sequence by accident. */
1481 if (k == len0
1482 || (k < len0 && encoded[k] == '_'))
1483 i = k;
1484 }
1485 }
1486
1487 /* Remove trailing "N" in [a-z0-9]+N__. The N is added by
1488 the GNAT front-end in protected object subprograms. */
1489
1490 if (i < len0 + 3
1491 && encoded[i] == 'N' && encoded[i+1] == '_' && encoded[i+2] == '_')
1492 {
1493 /* Backtrack a bit up until we reach either the begining of
1494 the encoded name, or "__". Make sure that we only find
1495 digits or lowercase characters. */
1496 const char *ptr = encoded + i - 1;
1497
1498 while (ptr >= encoded && is_lower_alphanum (ptr[0]))
1499 ptr--;
1500 if (ptr < encoded
1501 || (ptr > encoded && ptr[0] == '_' && ptr[-1] == '_'))
1502 i++;
1503 }
1504
1505 if (i < len0 + 3 && encoded[i] == 'U' && isxdigit (encoded[i + 1]))
1506 {
1507 if (convert_from_hex_encoded (decoded, &encoded[i + 1], 2))
1508 {
1509 i += 3;
1510 continue;
1511 }
1512 }
1513 else if (i < len0 + 5 && encoded[i] == 'W' && isxdigit (encoded[i + 1]))
1514 {
1515 if (convert_from_hex_encoded (decoded, &encoded[i + 1], 4))
1516 {
1517 i += 5;
1518 continue;
1519 }
1520 }
1521 else if (i < len0 + 10 && encoded[i] == 'W' && encoded[i + 1] == 'W'
1522 && isxdigit (encoded[i + 2]))
1523 {
1524 if (convert_from_hex_encoded (decoded, &encoded[i + 2], 8))
1525 {
1526 i += 10;
1527 continue;
1528 }
1529 }
1530
1531 if (encoded[i] == 'X' && i != 0 && isalnum (encoded[i - 1]))
1532 {
1533 /* This is a X[bn]* sequence not separated from the previous
1534 part of the name with a non-alpha-numeric character (in other
1535 words, immediately following an alpha-numeric character), then
1536 verify that it is placed at the end of the encoded name. If
1537 not, then the encoding is not valid and we should abort the
1538 decoding. Otherwise, just skip it, it is used in body-nested
1539 package names. */
1540 do
1541 i += 1;
1542 while (i < len0 && (encoded[i] == 'b' || encoded[i] == 'n'));
1543 if (i < len0)
1544 goto Suppress;
1545 }
1546 else if (i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
1547 {
1548 /* Replace '__' by '.'. */
1549 decoded.push_back ('.');
1550 at_start_name = 1;
1551 i += 2;
1552 }
1553 else
1554 {
1555 /* It's a character part of the decoded name, so just copy it
1556 over. */
1557 decoded.push_back (encoded[i]);
1558 i += 1;
1559 }
1560 }
1561
1562 /* Decoded names should never contain any uppercase character.
1563 Double-check this, and abort the decoding if we find one. */
1564
1565 if (operators)
1566 {
1567 for (i = 0; i < decoded.length(); ++i)
1568 if (isupper (decoded[i]) || decoded[i] == ' ')
1569 goto Suppress;
1570 }
1571
1572 /* If the compiler added a suffix, append it now. */
1573 if (suffix >= 0)
1574 decoded = decoded + "[" + &encoded[suffix] + "]";
1575
1576 return decoded;
1577
1578Suppress:
1579 if (!wrap)
1580 return {};
1581
1582 if (encoded[0] == '<')
1583 decoded = encoded;
1584 else
1585 decoded = '<' + std::string(encoded) + '>';
1586 return decoded;
1587}
1588
1589#ifdef GDB_SELF_TEST
1590
1591static void
1592ada_decode_tests ()
1593{
1594 /* This isn't valid, but used to cause a crash. PR gdb/30639. The
1595 result does not really matter very much. */
1596 SELF_CHECK (ada_decode ("44") == "44");
1597}
1598
1599#endif
1600
1601/* Table for keeping permanent unique copies of decoded names. Once
1602 allocated, names in this table are never released. While this is a
1603 storage leak, it should not be significant unless there are massive
1604 changes in the set of decoded names in successive versions of a
1605 symbol table loaded during a single session. */
1606static struct htab *decoded_names_store;
1607
1608/* Returns the decoded name of GSYMBOL, as for ada_decode, caching it
1609 in the language-specific part of GSYMBOL, if it has not been
1610 previously computed. Tries to save the decoded name in the same
1611 obstack as GSYMBOL, if possible, and otherwise on the heap (so that,
1612 in any case, the decoded symbol has a lifetime at least that of
1613 GSYMBOL).
1614 The GSYMBOL parameter is "mutable" in the C++ sense: logically
1615 const, but nevertheless modified to a semantically equivalent form
1616 when a decoded name is cached in it. */
1617
1618const char *
1620{
1621 struct general_symbol_info *gsymbol = (struct general_symbol_info *) arg;
1622 const char **resultp =
1624
1625 if (!gsymbol->ada_mangled)
1626 {
1627 std::string decoded = ada_decode (gsymbol->linkage_name ());
1628 struct obstack *obstack = gsymbol->language_specific.obstack;
1629
1630 gsymbol->ada_mangled = 1;
1631
1632 if (obstack != NULL)
1633 *resultp = obstack_strdup (obstack, decoded.c_str ());
1634 else
1635 {
1636 /* Sometimes, we can't find a corresponding objfile, in
1637 which case, we put the result on the heap. Since we only
1638 decode when needed, we hope this usually does not cause a
1639 significant memory leak (FIXME). */
1640
1641 char **slot = (char **) htab_find_slot (decoded_names_store,
1642 decoded.c_str (), INSERT);
1643
1644 if (*slot == NULL)
1645 *slot = xstrdup (decoded.c_str ());
1646 *resultp = *slot;
1647 }
1648 }
1649
1650 return *resultp;
1651}
1652
1653
1654
1655 /* Arrays */
1656
1657/* Assuming that INDEX_DESC_TYPE is an ___XA structure, a structure
1658 generated by the GNAT compiler to describe the index type used
1659 for each dimension of an array, check whether it follows the latest
1660 known encoding. If not, fix it up to conform to the latest encoding.
1661 Otherwise, do nothing. This function also does nothing if
1662 INDEX_DESC_TYPE is NULL.
1663
1664 The GNAT encoding used to describe the array index type evolved a bit.
1665 Initially, the information would be provided through the name of each
1666 field of the structure type only, while the type of these fields was
1667 described as unspecified and irrelevant. The debugger was then expected
1668 to perform a global type lookup using the name of that field in order
1669 to get access to the full index type description. Because these global
1670 lookups can be very expensive, the encoding was later enhanced to make
1671 the global lookup unnecessary by defining the field type as being
1672 the full index type description.
1673
1674 The purpose of this routine is to allow us to support older versions
1675 of the compiler by detecting the use of the older encoding, and by
1676 fixing up the INDEX_DESC_TYPE to follow the new one (at this point,
1677 we essentially replace each field's meaningless type by the associated
1678 index subtype). */
1679
1680void
1681ada_fixup_array_indexes_type (struct type *index_desc_type)
1682{
1683 int i;
1684
1685 if (index_desc_type == NULL)
1686 return;
1687 gdb_assert (index_desc_type->num_fields () > 0);
1688
1689 /* Check if INDEX_DESC_TYPE follows the older encoding (it is sufficient
1690 to check one field only, no need to check them all). If not, return
1691 now.
1692
1693 If our INDEX_DESC_TYPE was generated using the older encoding,
1694 the field type should be a meaningless integer type whose name
1695 is not equal to the field name. */
1696 if (index_desc_type->field (0).type ()->name () != NULL
1697 && strcmp (index_desc_type->field (0).type ()->name (),
1698 index_desc_type->field (0).name ()) == 0)
1699 return;
1700
1701 /* Fixup each field of INDEX_DESC_TYPE. */
1702 for (i = 0; i < index_desc_type->num_fields (); i++)
1703 {
1704 const char *name = index_desc_type->field (i).name ();
1705 struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
1706
1707 if (raw_type)
1708 index_desc_type->field (i).set_type (raw_type);
1709 }
1710}
1711
1712/* The desc_* routines return primitive portions of array descriptors
1713 (fat pointers). */
1714
1715/* The descriptor or array type, if any, indicated by TYPE; removes
1716 level of indirection, if needed. */
1717
1718static struct type *
1720{
1721 if (type == NULL)
1722 return NULL;
1724 if (type->code () == TYPE_CODE_TYPEDEF)
1726
1727 if (type != NULL
1728 && (type->code () == TYPE_CODE_PTR
1729 || type->code () == TYPE_CODE_REF))
1730 return ada_check_typedef (type->target_type ());
1731 else
1732 return type;
1733}
1734
1735/* True iff TYPE indicates a "thin" array pointer type. */
1736
1737static int
1739{
1740 return
1742 || is_suffix (ada_type_name (desc_base_type (type)), "___XUT___XVE");
1743}
1744
1745/* The descriptor type for thin pointer type TYPE. */
1746
1747static struct type *
1749{
1750 struct type *base_type = desc_base_type (type);
1751
1752 if (base_type == NULL)
1753 return NULL;
1754 if (is_suffix (ada_type_name (base_type), "___XVE"))
1755 return base_type;
1756 else
1757 {
1758 struct type *alt_type = ada_find_parallel_type (base_type, "___XVE");
1759
1760 if (alt_type == NULL)
1761 return base_type;
1762 else
1763 return alt_type;
1764 }
1765}
1766
1767/* A pointer to the array data for thin-pointer value VAL. */
1768
1769static struct value *
1771{
1772 struct type *type = ada_check_typedef (val->type ());
1773 struct type *data_type = desc_data_target_type (thin_descriptor_type (type));
1774
1775 data_type = lookup_pointer_type (data_type);
1776
1777 if (type->code () == TYPE_CODE_PTR)
1778 return value_cast (data_type, val->copy ());
1779 else
1780 return value_from_longest (data_type, val->address ());
1781}
1782
1783/* True iff TYPE indicates a "thick" array pointer type. */
1784
1785static int
1787{
1789 return (type != NULL && type->code () == TYPE_CODE_STRUCT
1790 && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
1791}
1792
1793/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
1794 pointer to one, the type of its bounds data; otherwise, NULL. */
1795
1796static struct type *
1798{
1799 struct type *r;
1800
1802
1803 if (type == NULL)
1804 return NULL;
1805 else if (is_thin_pntr (type))
1806 {
1808 if (type == NULL)
1809 return NULL;
1810 r = lookup_struct_elt_type (type, "BOUNDS", 1);
1811 if (r != NULL)
1812 return ada_check_typedef (r);
1813 }
1814 else if (type->code () == TYPE_CODE_STRUCT)
1815 {
1816 r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
1817 if (r != NULL)
1819 }
1820 return NULL;
1821}
1822
1823/* If ARR is an array descriptor (fat or thin pointer), or pointer to
1824 one, a pointer to its bounds data. Otherwise NULL. */
1825
1826static struct value *
1827desc_bounds (struct value *arr)
1828{
1829 struct type *type = ada_check_typedef (arr->type ());
1830
1831 if (is_thin_pntr (type))
1832 {
1833 struct type *bounds_type =
1835 LONGEST addr;
1836
1837 if (bounds_type == NULL)
1838 error (_("Bad GNAT array descriptor"));
1839
1840 /* NOTE: The following calculation is not really kosher, but
1841 since desc_type is an XVE-encoded type (and shouldn't be),
1842 the correct calculation is a real pain. FIXME (and fix GCC). */
1843 if (type->code () == TYPE_CODE_PTR)
1844 addr = value_as_long (arr);
1845 else
1846 addr = arr->address ();
1847
1848 return
1850 addr - bounds_type->length ());
1851 }
1852
1853 else if (is_thick_pntr (type))
1854 {
1855 struct value *p_bounds = value_struct_elt (&arr, {}, "P_BOUNDS", NULL,
1856 _("Bad GNAT array descriptor"));
1857 struct type *p_bounds_type = p_bounds->type ();
1858
1859 if (p_bounds_type
1860 && p_bounds_type->code () == TYPE_CODE_PTR)
1861 {
1862 struct type *target_type = p_bounds_type->target_type ();
1863
1864 if (target_type->is_stub ())
1867 p_bounds);
1868 }
1869 else
1870 error (_("Bad GNAT array descriptor"));
1871
1872 return p_bounds;
1873 }
1874 else
1875 return NULL;
1876}
1877
1878/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1879 position of the field containing the address of the bounds data. */
1880
1881static int
1883{
1884 return desc_base_type (type)->field (1).loc_bitpos ();
1885}
1886
1887/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1888 size of the field containing the address of the bounds data. */
1889
1890static int
1892{
1894
1895 if (type->field (1).bitsize () > 0)
1896 return type->field (1).bitsize ();
1897 else
1898 return 8 * ada_check_typedef (type->field (1).type ())->length ();
1899}
1900
1901/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
1902 pointer to one, the type of its array data (a array-with-no-bounds type);
1903 otherwise, NULL. Use ada_type_of_array to get an array type with bounds
1904 data. */
1905
1906static struct type *
1908{
1910
1911 /* NOTE: The following is bogus; see comment in desc_bounds. */
1912 if (is_thin_pntr (type))
1914 else if (is_thick_pntr (type))
1915 {
1916 struct type *data_type = lookup_struct_elt_type (type, "P_ARRAY", 1);
1917
1918 if (data_type
1919 && ada_check_typedef (data_type)->code () == TYPE_CODE_PTR)
1920 return ada_check_typedef (data_type->target_type ());
1921 }
1922
1923 return NULL;
1924}
1925
1926/* If ARR is an array descriptor (fat or thin pointer), a pointer to
1927 its array data. */
1928
1929static struct value *
1930desc_data (struct value *arr)
1931{
1932 struct type *type = arr->type ();
1933
1934 if (is_thin_pntr (type))
1935 return thin_data_pntr (arr);
1936 else if (is_thick_pntr (type))
1937 return value_struct_elt (&arr, {}, "P_ARRAY", NULL,
1938 _("Bad GNAT array descriptor"));
1939 else
1940 return NULL;
1941}
1942
1943
1944/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1945 position of the field containing the address of the data. */
1946
1947static int
1949{
1950 return desc_base_type (type)->field (0).loc_bitpos ();
1951}
1952
1953/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1954 size of the field containing the address of the data. */
1955
1956static int
1958{
1960
1961 if (type->field (0).bitsize () > 0)
1962 return type->field (0).bitsize ();
1963 else
1964 return TARGET_CHAR_BIT * type->field (0).type ()->length ();
1965}
1966
1967/* If BOUNDS is an array-bounds structure (or pointer to one), return
1968 the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
1969 bound, if WHICH is 1. The first bound is I=1. */
1970
1971static struct value *
1972desc_one_bound (struct value *bounds, int i, int which)
1973{
1974 char bound_name[20];
1975 xsnprintf (bound_name, sizeof (bound_name), "%cB%d",
1976 which ? 'U' : 'L', i - 1);
1977 return value_struct_elt (&bounds, {}, bound_name, NULL,
1978 _("Bad GNAT array descriptor bounds"));
1979}
1980
1981/* If BOUNDS is an array-bounds structure type, return the bit position
1982 of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
1983 bound, if WHICH is 1. The first bound is I=1. */
1984
1985static int
1986desc_bound_bitpos (struct type *type, int i, int which)
1987{
1988 return desc_base_type (type)->field (2 * i + which - 2).loc_bitpos ();
1989}
1990
1991/* If BOUNDS is an array-bounds structure type, return the bit field size
1992 of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
1993 bound, if WHICH is 1. The first bound is I=1. */
1994
1995static int
1996desc_bound_bitsize (struct type *type, int i, int which)
1997{
1999
2000 if (type->field (2 * i + which - 2).bitsize () > 0)
2001 return type->field (2 * i + which - 2).bitsize ();
2002 else
2003 return 8 * type->field (2 * i + which - 2).type ()->length ();
2004}
2005
2006/* If TYPE is the type of an array-bounds structure, the type of its
2007 Ith bound (numbering from 1). Otherwise, NULL. */
2008
2009static struct type *
2010desc_index_type (struct type *type, int i)
2011{
2013
2014 if (type->code () == TYPE_CODE_STRUCT)
2015 {
2016 char bound_name[20];
2017 xsnprintf (bound_name, sizeof (bound_name), "LB%d", i - 1);
2018 return lookup_struct_elt_type (type, bound_name, 1);
2019 }
2020 else
2021 return NULL;
2022}
2023
2024/* The number of index positions in the array-bounds type TYPE.
2025 Return 0 if TYPE is NULL. */
2026
2027static int
2029{
2031
2032 if (type != NULL)
2033 return type->num_fields () / 2;
2034 return 0;
2035}
2036
2037/* Non-zero iff TYPE is a simple array type (not a pointer to one) or
2038 an array descriptor type (representing an unconstrained array
2039 type). */
2040
2041static int
2043{
2044 if (type == NULL)
2045 return 0;
2047 return (type->code () == TYPE_CODE_ARRAY
2049}
2050
2051/* Non-zero iff TYPE represents any kind of array in Ada, or a pointer
2052 * to one. */
2053
2054static int
2056{
2057 while (type != NULL
2058 && (type->code () == TYPE_CODE_PTR
2059 || type->code () == TYPE_CODE_REF))
2060 type = type->target_type ();
2062}
2063
2064/* Non-zero iff TYPE is a simple array type or pointer to one. */
2065
2066int
2068{
2069 if (type == NULL)
2070 return 0;
2072 return (type->code () == TYPE_CODE_ARRAY
2073 || (type->code () == TYPE_CODE_PTR
2075 == TYPE_CODE_ARRAY)));
2076}
2077
2078/* Non-zero iff TYPE belongs to a GNAT array descriptor. */
2079
2080int
2082{
2083 struct type *data_type = desc_data_target_type (type);
2084
2085 if (type == NULL)
2086 return 0;
2088 return (data_type != NULL
2089 && data_type->code () == TYPE_CODE_ARRAY
2090 && desc_arity (desc_bounds_type (type)) > 0);
2091}
2092
2093/* If ARR has a record type in the form of a standard GNAT array descriptor,
2094 (fat pointer) returns the type of the array data described---specifically,
2095 a pointer-to-array type. If BOUNDS is non-zero, the bounds data are filled
2096 in from the descriptor; otherwise, they are left unspecified. If
2097 the ARR denotes a null array descriptor and BOUNDS is non-zero,
2098 returns NULL. The result is simply the type of ARR if ARR is not
2099 a descriptor. */
2100
2101static struct type *
2103{
2106
2107 if (!ada_is_array_descriptor_type (arr->type ()))
2108 return arr->type ();
2109
2110 if (!bounds)
2111 {
2112 struct type *array_type =
2114
2116 array_type->field (0).set_bitsize
2118
2119 return array_type;
2120 }
2121 else
2122 {
2123 struct type *elt_type;
2124 int arity;
2125 struct value *descriptor;
2126
2127 elt_type = ada_array_element_type (arr->type (), -1);
2128 arity = ada_array_arity (arr->type ());
2129
2130 if (elt_type == NULL || arity == 0)
2131 return ada_check_typedef (arr->type ());
2132
2133 descriptor = desc_bounds (arr);
2134 if (value_as_long (descriptor) == 0)
2135 return NULL;
2136 while (arity > 0)
2137 {
2138 type_allocator alloc (arr->type ());
2139 struct value *low = desc_one_bound (descriptor, arity, 0);
2140 struct value *high = desc_one_bound (descriptor, arity, 1);
2141
2142 arity -= 1;
2143 struct type *range_type
2144 = create_static_range_type (alloc, low->type (),
2146 longest_to_int (value_as_long (high)));
2147 elt_type = create_array_type (alloc, elt_type, range_type);
2148 INIT_GNAT_SPECIFIC (elt_type);
2149
2151 {
2152 /* We need to store the element packed bitsize, as well as
2153 recompute the array size, because it was previously
2154 computed based on the unpacked element size. */
2155 LONGEST lo = value_as_long (low);
2156 LONGEST hi = value_as_long (high);
2157
2158 elt_type->field (0).set_bitsize
2160
2161 /* If the array has no element, then the size is already
2162 zero, and does not need to be recomputed. */
2163 if (lo < hi)
2164 {
2165 int array_bitsize =
2166 (hi - lo + 1) * elt_type->field (0).bitsize ();
2167
2168 elt_type->set_length ((array_bitsize + 7) / 8);
2169 }
2170 }
2171 }
2172
2173 return lookup_pointer_type (elt_type);
2174 }
2175}
2176
2177/* If ARR does not represent an array, returns ARR unchanged.
2178 Otherwise, returns either a standard GDB array with bounds set
2179 appropriately or, if ARR is a non-null fat pointer, a pointer to a standard
2180 GDB array. Returns NULL if ARR is a null fat pointer. */
2181
2182struct value *
2184{
2185 if (ada_is_array_descriptor_type (arr->type ()))
2186 {
2187 struct type *arrType = ada_type_of_array (arr, 1);
2188
2189 if (arrType == NULL)
2190 return NULL;
2191 return value_cast (arrType, desc_data (arr)->copy ());
2192 }
2193 else if (ada_is_constrained_packed_array_type (arr->type ()))
2195 else
2196 return arr;
2197}
2198
2199/* If ARR does not represent an array, returns ARR unchanged.
2200 Otherwise, returns a standard GDB array describing ARR (which may
2201 be ARR itself if it already is in the proper form). */
2202
2203struct value *
2205{
2206 if (ada_is_array_descriptor_type (arr->type ()))
2207 {
2208 struct value *arrVal = ada_coerce_to_simple_array_ptr (arr);
2209
2210 if (arrVal == NULL)
2211 error (_("Bounds unavailable for null array pointer."));
2212 return value_ind (arrVal);
2213 }
2214 else if (ada_is_constrained_packed_array_type (arr->type ()))
2216 else
2217 return arr;
2218}
2219
2220/* If TYPE represents a GNAT array type, return it translated to an
2221 ordinary GDB array type (possibly with BITSIZE fields indicating
2222 packing). For other types, is the identity. */
2223
2224struct type *
2235
2236/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
2237
2238static int
2240{
2241 if (type == NULL)
2242 return 0;
2245 return
2246 ada_type_name (type) != NULL
2247 && strstr (ada_type_name (type), "___XP") != NULL;
2248}
2249
2250/* Non-zero iff TYPE represents a standard GNAT constrained
2251 packed-array type. */
2252
2253int
2259
2260/* Non-zero iff TYPE represents an array descriptor for a
2261 unconstrained packed-array type. */
2262
2263static int
2265{
2267 return 0;
2268
2270 return 1;
2271
2272 /* If we saw GNAT encodings, then the above code is sufficient.
2273 However, with minimal encodings, we will just have a thick
2274 pointer instead. */
2275 if (is_thick_pntr (type))
2276 {
2278 /* The structure's first field is a pointer to an array, so this
2279 fetches the array type. */
2280 type = type->field (0).type ()->target_type ();
2281 if (type->code () == TYPE_CODE_TYPEDEF)
2283 /* Now we can see if the array elements are packed. */
2284 return type->field (0).bitsize () > 0;
2285 }
2286
2287 return 0;
2288}
2289
2290/* Return true if TYPE is a (Gnat-encoded) constrained packed array
2291 type, or if it is an ordinary (non-Gnat-encoded) packed array. */
2292
2293static bool
2295{
2297 || (type->code () == TYPE_CODE_ARRAY
2298 && type->field (0).bitsize () % 8 != 0));
2299}
2300
2301/* Given that TYPE encodes a packed array type (constrained or unconstrained),
2302 return the size of its elements in bits. */
2303
2304static long
2306{
2307 const char *raw_name;
2308 const char *tail;
2309 long bits;
2310
2311 /* Access to arrays implemented as fat pointers are encoded as a typedef
2312 of the fat pointer type. We need the name of the fat pointer type
2313 to do the decoding, so strip the typedef layer. */
2314 if (type->code () == TYPE_CODE_TYPEDEF)
2316
2317 raw_name = ada_type_name (ada_check_typedef (type));
2318 if (!raw_name)
2319 raw_name = ada_type_name (desc_base_type (type));
2320
2321 if (!raw_name)
2322 return 0;
2323
2324 tail = strstr (raw_name, "___XP");
2325 if (tail == nullptr)
2326 {
2327 gdb_assert (is_thick_pntr (type));
2328 /* The structure's first field is a pointer to an array, so this
2329 fetches the array type. */
2330 type = type->field (0).type ()->target_type ();
2331 /* Now we can see if the array elements are packed. */
2332 return type->field (0).bitsize ();
2333 }
2334
2335 if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
2336 {
2338 (_("could not understand bit size information on packed array"));
2339 return 0;
2340 }
2341
2342 return bits;
2343}
2344
2345/* Given that TYPE is a standard GDB array type with all bounds filled
2346 in, and that the element size of its ultimate scalar constituents
2347 (that is, either its elements, or, if it is an array of arrays, its
2348 elements' elements, etc.) is *ELT_BITS, return an identical type,
2349 but with the bit sizes of its elements (and those of any
2350 constituent arrays) recorded in the BITSIZE components of its
2351 TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
2352 in bits.
2353
2354 Note that, for arrays whose index type has an XA encoding where
2355 a bound references a record discriminant, getting that discriminant,
2356 and therefore the actual value of that bound, is not possible
2357 because none of the given parameters gives us access to the record.
2358 This function assumes that it is OK in the context where it is being
2359 used to return an array whose bounds are still dynamic and where
2360 the length is arbitrary. */
2361
2362static struct type *
2363constrained_packed_array_type (struct type *type, long *elt_bits)
2364{
2365 struct type *new_elt_type;
2366 struct type *new_type;
2367 struct type *index_type_desc;
2368 struct type *index_type;
2369 LONGEST low_bound, high_bound;
2370
2372 if (type->code () != TYPE_CODE_ARRAY)
2373 return type;
2374
2375 index_type_desc = ada_find_parallel_type (type, "___XA");
2376 if (index_type_desc)
2377 index_type = to_fixed_range_type (index_type_desc->field (0).type (),
2378 NULL);
2379 else
2381
2382 type_allocator alloc (type);
2383 new_elt_type =
2385 elt_bits);
2386 new_type = create_array_type (alloc, new_elt_type, index_type);
2387 new_type->field (0).set_bitsize (*elt_bits);
2389
2390 if ((check_typedef (index_type)->code () == TYPE_CODE_RANGE
2392 || !get_discrete_bounds (index_type, &low_bound, &high_bound))
2393 low_bound = high_bound = 0;
2394 if (high_bound < low_bound)
2395 {
2396 *elt_bits = 0;
2397 new_type->set_length (0);
2398 }
2399 else
2400 {
2401 *elt_bits *= (high_bound - low_bound + 1);
2402 new_type->set_length ((*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
2403 }
2404
2406 return new_type;
2407}
2408
2409/* The array type encoded by TYPE, where
2410 ada_is_constrained_packed_array_type (TYPE). */
2411
2412static struct type *
2414{
2415 const char *raw_name = ada_type_name (ada_check_typedef (type));
2416 char *name;
2417 const char *tail;
2418 struct type *shadow_type;
2419 long bits;
2420
2421 if (!raw_name)
2422 raw_name = ada_type_name (desc_base_type (type));
2423
2424 if (!raw_name)
2425 return NULL;
2426
2427 name = (char *) alloca (strlen (raw_name) + 1);
2428 tail = strstr (raw_name, "___XP");
2430
2431 memcpy (name, raw_name, tail - raw_name);
2432 name[tail - raw_name] = '\000';
2433
2435
2436 if (shadow_type == NULL)
2437 {
2438 lim_warning (_("could not find bounds information on packed array"));
2439 return NULL;
2440 }
2441 shadow_type = check_typedef (shadow_type);
2442
2443 if (shadow_type->code () != TYPE_CODE_ARRAY)
2444 {
2445 lim_warning (_("could not understand bounds "
2446 "information on packed array"));
2447 return NULL;
2448 }
2449
2451 return constrained_packed_array_type (shadow_type, &bits);
2452}
2453
2454/* Helper function for decode_constrained_packed_array. Set the field
2455 bitsize on a series of packed arrays. Returns the number of
2456 elements in TYPE. */
2457
2458static LONGEST
2460{
2461 gdb_assert (type->code () == TYPE_CODE_ARRAY);
2462
2463 LONGEST low, high;
2464 if (!get_discrete_bounds (type->index_type (), &low, &high)
2465 || low > high)
2466 return 0;
2467 LONGEST our_len = high - low + 1;
2468
2469 struct type *elt_type = type->target_type ();
2470 if (elt_type->code () == TYPE_CODE_ARRAY)
2471 {
2472 LONGEST elt_len = recursively_update_array_bitsize (elt_type);
2473 LONGEST elt_bitsize = elt_len * elt_type->field (0).bitsize ();
2474 type->field (0).set_bitsize (elt_bitsize);
2475
2476 type->set_length (((our_len * elt_bitsize + HOST_CHAR_BIT - 1)
2477 / HOST_CHAR_BIT));
2478 }
2479
2480 return our_len;
2481}
2482
2483/* Given that ARR is a struct value *indicating a GNAT constrained packed
2484 array, returns a simple array that denotes that array. Its type is a
2485 standard GDB array type except that the BITSIZEs of the array
2486 target types are set to the number of bits in each element, and the
2487 type length is set appropriately. */
2488
2489static struct value *
2491{
2492 struct type *type;
2493
2494 /* If our value is a pointer, then dereference it. Likewise if
2495 the value is a reference. Make sure that this operation does not
2496 cause the target type to be fixed, as this would indirectly cause
2497 this array to be decoded. The rest of the routine assumes that
2498 the array hasn't been decoded yet, so we use the basic "coerce_ref"
2499 and "value_ind" routines to perform the dereferencing, as opposed
2500 to using "ada_coerce_ref" or "ada_value_ind". */
2501 arr = coerce_ref (arr);
2502 if (ada_check_typedef (arr->type ())->code () == TYPE_CODE_PTR)
2503 arr = value_ind (arr);
2504
2506 if (type == NULL)
2507 {
2508 error (_("can't unpack array"));
2509 return NULL;
2510 }
2511
2512 /* Decoding the packed array type could not correctly set the field
2513 bitsizes for any dimension except the innermost, because the
2514 bounds may be variable and were not passed to that function. So,
2515 we further resolve the array bounds here and then update the
2516 sizes. */
2517 const gdb_byte *valaddr = arr->contents_for_printing ().data ();
2518 CORE_ADDR address = arr->address ();
2519 gdb::array_view<const gdb_byte> view
2520 = gdb::make_array_view (valaddr, type->length ());
2521 type = resolve_dynamic_type (type, view, address);
2523
2524 if (type_byte_order (arr->type ()) == BFD_ENDIAN_BIG
2525 && ada_is_modular_type (arr->type ()))
2526 {
2527 /* This is a (right-justified) modular type representing a packed
2528 array with no wrapper. In order to interpret the value through
2529 the (left-justified) packed array type we just built, we must
2530 first left-justify it. */
2531 int bit_size, bit_pos;
2532 ULONGEST mod;
2533
2534 mod = ada_modulus (arr->type ()) - 1;
2535 bit_size = 0;
2536 while (mod > 0)
2537 {
2538 bit_size += 1;
2539 mod >>= 1;
2540 }
2541 bit_pos = HOST_CHAR_BIT * arr->type ()->length () - bit_size;
2542 arr = ada_value_primitive_packed_val (arr, NULL,
2543 bit_pos / HOST_CHAR_BIT,
2544 bit_pos % HOST_CHAR_BIT,
2545 bit_size,
2546 type);
2547 }
2548
2549 return coerce_unspec_val_to_type (arr, type);
2550}
2551
2552
2553/* The value of the element of packed array ARR at the ARITY indices
2554 given in IND. ARR must be a simple array. */
2555
2556static struct value *
2557value_subscript_packed (struct value *arr, int arity, struct value **ind)
2558{
2559 int i;
2560 int bits, elt_off, bit_off;
2561 long elt_total_bit_offset;
2562 struct type *elt_type;
2563 struct value *v;
2564
2565 bits = 0;
2566 elt_total_bit_offset = 0;
2567 elt_type = ada_check_typedef (arr->type ());
2568 for (i = 0; i < arity; i += 1)
2569 {
2570 if (elt_type->code () != TYPE_CODE_ARRAY
2571 || elt_type->field (0).bitsize () == 0)
2572 error
2573 (_("attempt to do packed indexing of "
2574 "something other than a packed array"));
2575 else
2576 {
2577 struct type *range_type = elt_type->index_type ();
2578 LONGEST lowerbound, upperbound;
2579 LONGEST idx;
2580
2581 if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
2582 {
2583 lim_warning (_("don't know bounds of array"));
2584 lowerbound = upperbound = 0;
2585 }
2586
2587 idx = pos_atr (ind[i]);
2588 if (idx < lowerbound || idx > upperbound)
2589 lim_warning (_("packed array index %ld out of bounds"),
2590 (long) idx);
2591 bits = elt_type->field (0).bitsize ();
2592 elt_total_bit_offset += (idx - lowerbound) * bits;
2593 elt_type = ada_check_typedef (elt_type->target_type ());
2594 }
2595 }
2596 elt_off = elt_total_bit_offset / HOST_CHAR_BIT;
2597 bit_off = elt_total_bit_offset % HOST_CHAR_BIT;
2598
2599 v = ada_value_primitive_packed_val (arr, NULL, elt_off, bit_off,
2600 bits, elt_type);
2601 return v;
2602}
2603
2604/* Non-zero iff TYPE includes negative integer values. */
2605
2606static int
2608{
2609 switch (type->code ())
2610 {
2611 default:
2612 return 0;
2613 case TYPE_CODE_INT:
2614 return !type->is_unsigned ();
2615 case TYPE_CODE_RANGE:
2616 return type->bounds ()->low.const_val () - type->bounds ()->bias < 0;
2617 }
2618}
2619
2620/* With SRC being a buffer containing BIT_SIZE bits of data at BIT_OFFSET,
2621 unpack that data into UNPACKED. UNPACKED_LEN is the size in bytes of
2622 the unpacked buffer.
2623
2624 The size of the unpacked buffer (UNPACKED_LEN) is expected to be large
2625 enough to contain at least BIT_OFFSET bits. If not, an error is raised.
2626
2627 IS_BIG_ENDIAN is nonzero if the data is stored in big endian mode,
2628 zero otherwise.
2629
2630 IS_SIGNED_TYPE is nonzero if the data corresponds to a signed type.
2631
2632 IS_SCALAR is nonzero if the data corresponds to a signed type. */
2633
2634static void
2635ada_unpack_from_contents (const gdb_byte *src, int bit_offset, int bit_size,
2636 gdb_byte *unpacked, int unpacked_len,
2637 int is_big_endian, int is_signed_type,
2638 int is_scalar)
2639{
2640 int src_len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
2641 int src_idx; /* Index into the source area */
2642 int src_bytes_left; /* Number of source bytes left to process. */
2643 int srcBitsLeft; /* Number of source bits left to move */
2644 int unusedLS; /* Number of bits in next significant
2645 byte of source that are unused */
2646
2647 int unpacked_idx; /* Index into the unpacked buffer */
2648 int unpacked_bytes_left; /* Number of bytes left to set in unpacked. */
2649
2650 unsigned long accum; /* Staging area for bits being transferred */
2651 int accumSize; /* Number of meaningful bits in accum */
2652 unsigned char sign;
2653
2654 /* Transmit bytes from least to most significant; delta is the direction
2655 the indices move. */
2656 int delta = is_big_endian ? -1 : 1;
2657
2658 /* Make sure that unpacked is large enough to receive the BIT_SIZE
2659 bits from SRC. .*/
2660 if ((bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT > unpacked_len)
2661 error (_("Cannot unpack %d bits into buffer of %d bytes"),
2662 bit_size, unpacked_len);
2663
2664 srcBitsLeft = bit_size;
2665 src_bytes_left = src_len;
2666 unpacked_bytes_left = unpacked_len;
2667 sign = 0;
2668
2669 if (is_big_endian)
2670 {
2671 src_idx = src_len - 1;
2672 if (is_signed_type
2673 && ((src[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1))))
2674 sign = ~0;
2675
2676 unusedLS =
2677 (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
2678 % HOST_CHAR_BIT;
2679
2680 if (is_scalar)
2681 {
2682 accumSize = 0;
2683 unpacked_idx = unpacked_len - 1;
2684 }
2685 else
2686 {
2687 /* Non-scalar values must be aligned at a byte boundary... */
2688 accumSize =
2689 (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
2690 /* ... And are placed at the beginning (most-significant) bytes
2691 of the target. */
2692 unpacked_idx = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT - 1;
2693 unpacked_bytes_left = unpacked_idx + 1;
2694 }
2695 }
2696 else
2697 {
2698 int sign_bit_offset = (bit_size + bit_offset - 1) % 8;
2699
2700 src_idx = unpacked_idx = 0;
2701 unusedLS = bit_offset;
2702 accumSize = 0;
2703
2704 if (is_signed_type && (src[src_len - 1] & (1 << sign_bit_offset)))
2705 sign = ~0;
2706 }
2707
2708 accum = 0;
2709 while (src_bytes_left > 0)
2710 {
2711 /* Mask for removing bits of the next source byte that are not
2712 part of the value. */
2713 unsigned int unusedMSMask =
2714 (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
2715 1;
2716 /* Sign-extend bits for this byte. */
2717 unsigned int signMask = sign & ~unusedMSMask;
2718
2719 accum |=
2720 (((src[src_idx] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
2721 accumSize += HOST_CHAR_BIT - unusedLS;
2722 if (accumSize >= HOST_CHAR_BIT)
2723 {
2724 unpacked[unpacked_idx] = accum & ~(~0UL << HOST_CHAR_BIT);
2725 accumSize -= HOST_CHAR_BIT;
2726 accum >>= HOST_CHAR_BIT;
2727 unpacked_bytes_left -= 1;
2728 unpacked_idx += delta;
2729 }
2730 srcBitsLeft -= HOST_CHAR_BIT - unusedLS;
2731 unusedLS = 0;
2732 src_bytes_left -= 1;
2733 src_idx += delta;
2734 }
2735 while (unpacked_bytes_left > 0)
2736 {
2737 accum |= sign << accumSize;
2738 unpacked[unpacked_idx] = accum & ~(~0UL << HOST_CHAR_BIT);
2739 accumSize -= HOST_CHAR_BIT;
2740 if (accumSize < 0)
2741 accumSize = 0;
2742 accum >>= HOST_CHAR_BIT;
2743 unpacked_bytes_left -= 1;
2744 unpacked_idx += delta;
2745 }
2746}
2747
2748/* Create a new value of type TYPE from the contents of OBJ starting
2749 at byte OFFSET, and bit offset BIT_OFFSET within that byte,
2750 proceeding for BIT_SIZE bits. If OBJ is an lval in memory, then
2751 assigning through the result will set the field fetched from.
2752 VALADDR is ignored unless OBJ is NULL, in which case,
2753 VALADDR+OFFSET must address the start of storage containing the
2754 packed value. The value returned in this case is never an lval.
2755 Assumes 0 <= BIT_OFFSET < HOST_CHAR_BIT. */
2756
2757struct value *
2758ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
2759 long offset, int bit_offset, int bit_size,
2760 struct type *type)
2761{
2762 struct value *v;
2763 const gdb_byte *src; /* First byte containing data to unpack */
2764 gdb_byte *unpacked;
2765 const int is_scalar = is_scalar_type (type);
2766 const int is_big_endian = type_byte_order (type) == BFD_ENDIAN_BIG;
2767 gdb::byte_vector staging;
2768
2770
2771 if (obj == NULL)
2772 src = valaddr + offset;
2773 else
2774 src = obj->contents ().data () + offset;
2775
2776 if (is_dynamic_type (type))
2777 {
2778 /* The length of TYPE might by dynamic, so we need to resolve
2779 TYPE in order to know its actual size, which we then use
2780 to create the contents buffer of the value we return.
2781 The difficulty is that the data containing our object is
2782 packed, and therefore maybe not at a byte boundary. So, what
2783 we do, is unpack the data into a byte-aligned buffer, and then
2784 use that buffer as our object's value for resolving the type. */
2785 int staging_len = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
2786 staging.resize (staging_len);
2787
2788 ada_unpack_from_contents (src, bit_offset, bit_size,
2789 staging.data (), staging.size (),
2790 is_big_endian, has_negatives (type),
2791 is_scalar);
2792 type = resolve_dynamic_type (type, staging, 0);
2793 if (type->length () < (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT)
2794 {
2795 /* This happens when the length of the object is dynamic,
2796 and is actually smaller than the space reserved for it.
2797 For instance, in an array of variant records, the bit_size
2798 we're given is the array stride, which is constant and
2799 normally equal to the maximum size of its element.
2800 But, in reality, each element only actually spans a portion
2801 of that stride. */
2802 bit_size = type->length () * HOST_CHAR_BIT;
2803 }
2804 }
2805
2806 if (obj == NULL)
2807 {
2808 v = value::allocate (type);
2809 src = valaddr + offset;
2810 }
2811 else if (obj->lval () == lval_memory && obj->lazy ())
2812 {
2813 int src_len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
2814 gdb_byte *buf;
2815
2816 v = value_at (type, obj->address () + offset);
2817 buf = (gdb_byte *) alloca (src_len);
2818 read_memory (v->address (), buf, src_len);
2819 src = buf;
2820 }
2821 else
2822 {
2823 v = value::allocate (type);
2824 src = obj->contents ().data () + offset;
2825 }
2826
2827 if (obj != NULL)
2828 {
2829 long new_offset = offset;
2830
2831 v->set_component_location (obj);
2832 v->set_bitpos (bit_offset + obj->bitpos ());
2833 v->set_bitsize (bit_size);
2834 if (v->bitpos () >= HOST_CHAR_BIT)
2835 {
2836 ++new_offset;
2837 v->set_bitpos (v->bitpos () - HOST_CHAR_BIT);
2838 }
2839 v->set_offset (new_offset);
2840
2841 /* Also set the parent value. This is needed when trying to
2842 assign a new value (in inferior memory). */
2843 v->set_parent (obj);
2844 }
2845 else
2846 v->set_bitsize (bit_size);
2847 unpacked = v->contents_writeable ().data ();
2848
2849 if (bit_size == 0)
2850 {
2851 memset (unpacked, 0, type->length ());
2852 return v;
2853 }
2854
2855 if (staging.size () == type->length ())
2856 {
2857 /* Small short-cut: If we've unpacked the data into a buffer
2858 of the same size as TYPE's length, then we can reuse that,
2859 instead of doing the unpacking again. */
2860 memcpy (unpacked, staging.data (), staging.size ());
2861 }
2862 else
2863 ada_unpack_from_contents (src, bit_offset, bit_size,
2864 unpacked, type->length (),
2865 is_big_endian, has_negatives (type), is_scalar);
2866
2867 return v;
2868}
2869
2870/* Store the contents of FROMVAL into the location of TOVAL.
2871 Return a new value with the location of TOVAL and contents of
2872 FROMVAL. Handles assignment into packed fields that have
2873 floating-point or non-scalar types. */
2874
2875static struct value *
2876ada_value_assign (struct value *toval, struct value *fromval)
2877{
2878 struct type *type = toval->type ();
2879 int bits = toval->bitsize ();
2880
2881 toval = ada_coerce_ref (toval);
2882 fromval = ada_coerce_ref (fromval);
2883
2884 if (ada_is_direct_array_type (toval->type ()))
2885 toval = ada_coerce_to_simple_array (toval);
2886 if (ada_is_direct_array_type (fromval->type ()))
2887 fromval = ada_coerce_to_simple_array (fromval);
2888
2889 if (!toval->deprecated_modifiable ())
2890 error (_("Left operand of assignment is not a modifiable lvalue."));
2891
2892 if (toval->lval () == lval_memory
2893 && bits > 0
2894 && (type->code () == TYPE_CODE_FLT
2895 || type->code () == TYPE_CODE_STRUCT))
2896 {
2897 int len = (toval->bitpos ()
2898 + bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
2899 int from_size;
2900 gdb_byte *buffer = (gdb_byte *) alloca (len);
2901 struct value *val;
2902 CORE_ADDR to_addr = toval->address ();
2903
2904 if (type->code () == TYPE_CODE_FLT)
2905 fromval = value_cast (type, fromval);
2906
2907 read_memory (to_addr, buffer, len);
2908 from_size = fromval->bitsize ();
2909 if (from_size == 0)
2910 from_size = fromval->type ()->length () * TARGET_CHAR_BIT;
2911
2912 const int is_big_endian = type_byte_order (type) == BFD_ENDIAN_BIG;
2913 ULONGEST from_offset = 0;
2914 if (is_big_endian && is_scalar_type (fromval->type ()))
2915 from_offset = from_size - bits;
2916 copy_bitwise (buffer, toval->bitpos (),
2917 fromval->contents ().data (), from_offset,
2918 bits, is_big_endian);
2919 write_memory_with_notification (to_addr, buffer, len);
2920
2921 val = toval->copy ();
2922 memcpy (val->contents_raw ().data (),
2923 fromval->contents ().data (),
2924 type->length ());
2926
2927 return val;
2928 }
2929
2930 return value_assign (toval, fromval);
2931}
2932
2933
2934/* Given that COMPONENT is a memory lvalue that is part of the lvalue
2935 CONTAINER, assign the contents of VAL to COMPONENTS's place in
2936 CONTAINER. Modifies the VALUE_CONTENTS of CONTAINER only, not
2937 COMPONENT, and not the inferior's memory. The current contents
2938 of COMPONENT are ignored.
2939
2940 Although not part of the initial design, this function also works
2941 when CONTAINER and COMPONENT are not_lval's: it works as if CONTAINER
2942 had a null address, and COMPONENT had an address which is equal to
2943 its offset inside CONTAINER. */
2944
2945static void
2946value_assign_to_component (struct value *container, struct value *component,
2947 struct value *val)
2948{
2949 LONGEST offset_in_container =
2950 (LONGEST) (component->address () - container->address ());
2951 int bit_offset_in_container =
2952 component->bitpos () - container->bitpos ();
2953 int bits;
2954
2955 val = value_cast (component->type (), val);
2956
2957 if (component->bitsize () == 0)
2958 bits = TARGET_CHAR_BIT * component->type ()->length ();
2959 else
2960 bits = component->bitsize ();
2961
2962 if (type_byte_order (container->type ()) == BFD_ENDIAN_BIG)
2963 {
2964 int src_offset;
2965
2966 if (is_scalar_type (check_typedef (component->type ())))
2967 src_offset
2968 = component->type ()->length () * TARGET_CHAR_BIT - bits;
2969 else
2970 src_offset = 0;
2971 copy_bitwise ((container->contents_writeable ().data ()
2972 + offset_in_container),
2973 container->bitpos () + bit_offset_in_container,
2974 val->contents ().data (), src_offset, bits, 1);
2975 }
2976 else
2977 copy_bitwise ((container->contents_writeable ().data ()
2978 + offset_in_container),
2979 container->bitpos () + bit_offset_in_container,
2980 val->contents ().data (), 0, bits, 0);
2981}
2982
2983/* Determine if TYPE is an access to an unconstrained array. */
2984
2985bool
2987{
2988 return (type->code () == TYPE_CODE_TYPEDEF
2990}
2991
2992/* The value of the element of array ARR at the ARITY indices given in IND.
2993 ARR may be either a simple array, GNAT array descriptor, or pointer
2994 thereto. */
2995
2996struct value *
2997ada_value_subscript (struct value *arr, int arity, struct value **ind)
2998{
2999 int k;
3000 struct value *elt;
3001 struct type *elt_type;
3002
3003 elt = ada_coerce_to_simple_array (arr);
3004
3005 elt_type = ada_check_typedef (elt->type ());
3006 if (elt_type->code () == TYPE_CODE_ARRAY
3007 && elt_type->field (0).bitsize () > 0)
3008 return value_subscript_packed (elt, arity, ind);
3009
3010 for (k = 0; k < arity; k += 1)
3011 {
3012 struct type *saved_elt_type = elt_type->target_type ();
3013
3014 if (elt_type->code () != TYPE_CODE_ARRAY)
3015 error (_("too many subscripts (%d expected)"), k);
3016
3017 elt = value_subscript (elt, pos_atr (ind[k]));
3018
3019 if (ada_is_access_to_unconstrained_array (saved_elt_type)
3020 && elt->type ()->code () != TYPE_CODE_TYPEDEF)
3021 {
3022 /* The element is a typedef to an unconstrained array,
3023 except that the value_subscript call stripped the
3024 typedef layer. The typedef layer is GNAT's way to
3025 specify that the element is, at the source level, an
3026 access to the unconstrained array, rather than the
3027 unconstrained array. So, we need to restore that
3028 typedef layer, which we can do by forcing the element's
3029 type back to its original type. Otherwise, the returned
3030 value is going to be printed as the array, rather
3031 than as an access. Another symptom of the same issue
3032 would be that an expression trying to dereference the
3033 element would also be improperly rejected. */
3034 elt->deprecated_set_type (saved_elt_type);
3035 }
3036
3037 elt_type = ada_check_typedef (elt->type ());
3038 }
3039
3040 return elt;
3041}
3042
3043/* Assuming ARR is a pointer to a GDB array, the value of the element
3044 of *ARR at the ARITY indices given in IND.
3045 Does not read the entire array into memory.
3046
3047 Note: Unlike what one would expect, this function is used instead of
3048 ada_value_subscript for basically all non-packed array types. The reason
3049 for this is that a side effect of doing our own pointer arithmetics instead
3050 of relying on value_subscript is that there is no implicit typedef peeling.
3051 This is important for arrays of array accesses, where it allows us to
3052 preserve the fact that the array's element is an array access, where the
3053 access part os encoded in a typedef layer. */
3054
3055static struct value *
3056ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
3057{
3058 int k;
3059 struct value *array_ind = ada_value_ind (arr);
3060 struct type *type
3061 = check_typedef (array_ind->enclosing_type ());
3062
3063 if (type->code () == TYPE_CODE_ARRAY
3064 && type->field (0).bitsize () > 0)
3065 return value_subscript_packed (array_ind, arity, ind);
3066
3067 for (k = 0; k < arity; k += 1)
3068 {
3069 LONGEST lwb, upb;
3070
3071 if (type->code () != TYPE_CODE_ARRAY)
3072 error (_("too many subscripts (%d expected)"), k);
3074 arr->copy ());
3075 get_discrete_bounds (type->index_type (), &lwb, &upb);
3076 arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
3077 type = type->target_type ();
3078 }
3079
3080 return value_ind (arr);
3081}
3082
3083/* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
3084 actual type of ARRAY_PTR is ignored), returns the Ada slice of
3085 HIGH'Pos-LOW'Pos+1 elements starting at index LOW. The lower bound of
3086 this array is LOW, as per Ada rules. */
3087static struct value *
3088ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
3089 int low, int high)
3090{
3091 struct type *type0 = ada_check_typedef (type);
3092 struct type *base_index_type = type0->index_type ()->target_type ();
3093 type_allocator alloc (base_index_type);
3094 struct type *index_type
3095 = create_static_range_type (alloc, base_index_type, low, high);
3096 struct type *slice_type = create_array_type_with_stride
3097 (alloc, type0->target_type (), index_type,
3099 type0->field (0).bitsize ());
3100 int base_low = ada_discrete_type_low_bound (type0->index_type ());
3101 gdb::optional<LONGEST> base_low_pos, low_pos;
3102 CORE_ADDR base;
3103
3104 low_pos = discrete_position (base_index_type, low);
3105 base_low_pos = discrete_position (base_index_type, base_low);
3106
3107 if (!low_pos.has_value () || !base_low_pos.has_value ())
3108 {
3109 warning (_("unable to get positions in slice, use bounds instead"));
3110 low_pos = low;
3111 base_low_pos = base_low;
3112 }
3113
3114 ULONGEST stride = slice_type->field (0).bitsize () / 8;
3115 if (stride == 0)
3116 stride = type0->target_type ()->length ();
3117
3118 base = value_as_address (array_ptr) + (*low_pos - *base_low_pos) * stride;
3119 return value_at_lazy (slice_type, base);
3120}
3121
3122
3123static struct value *
3124ada_value_slice (struct value *array, int low, int high)
3125{
3126 struct type *type = ada_check_typedef (array->type ());
3127 struct type *base_index_type = type->index_type ()->target_type ();
3128 type_allocator alloc (type->index_type ());
3129 struct type *index_type
3130 = create_static_range_type (alloc, type->index_type (), low, high);
3131 struct type *slice_type = create_array_type_with_stride
3132 (alloc, type->target_type (), index_type,
3134 type->field (0).bitsize ());
3135 gdb::optional<LONGEST> low_pos, high_pos;
3136
3137
3138 low_pos = discrete_position (base_index_type, low);
3139 high_pos = discrete_position (base_index_type, high);
3140
3141 if (!low_pos.has_value () || !high_pos.has_value ())
3142 {
3143 warning (_("unable to get positions in slice, use bounds instead"));
3144 low_pos = low;
3145 high_pos = high;
3146 }
3147
3148 return value_cast (slice_type,
3149 value_slice (array, low, *high_pos - *low_pos + 1));
3150}
3151
3152/* If type is a record type in the form of a standard GNAT array
3153 descriptor, returns the number of dimensions for type. If arr is a
3154 simple array, returns the number of "array of"s that prefix its
3155 type designation. Otherwise, returns 0. */
3156
3157int
3159{
3160 int arity;
3161
3162 if (type == NULL)
3163 return 0;
3164
3166
3167 arity = 0;
3168 if (type->code () == TYPE_CODE_STRUCT)
3169 return desc_arity (desc_bounds_type (type));
3170 else
3171 while (type->code () == TYPE_CODE_ARRAY)
3172 {
3173 arity += 1;
3175 }
3176
3177 return arity;
3178}
3179
3180/* If TYPE is a record type in the form of a standard GNAT array
3181 descriptor or a simple array type, returns the element type for
3182 TYPE after indexing by NINDICES indices, or by all indices if
3183 NINDICES is -1. Otherwise, returns NULL. */
3184
3185struct type *
3186ada_array_element_type (struct type *type, int nindices)
3187{
3189
3190 if (type->code () == TYPE_CODE_STRUCT)
3191 {
3192 int k;
3193 struct type *p_array_type;
3194
3195 p_array_type = desc_data_target_type (type);
3196
3197 k = ada_array_arity (type);
3198 if (k == 0)
3199 return NULL;
3200
3201 /* Initially p_array_type = elt_type(*)[]...(k times)...[]. */
3202 if (nindices >= 0 && k > nindices)
3203 k = nindices;
3204 while (k > 0 && p_array_type != NULL)
3205 {
3206 p_array_type = ada_check_typedef (p_array_type->target_type ());
3207 k -= 1;
3208 }
3209 return p_array_type;
3210 }
3211 else if (type->code () == TYPE_CODE_ARRAY)
3212 {
3213 while (nindices != 0 && type->code () == TYPE_CODE_ARRAY)
3214 {
3215 type = type->target_type ();
3216 /* A multi-dimensional array is represented using a sequence
3217 of array types. If one of these types has a name, then
3218 it is not another dimension of the outer array, but
3219 rather the element type of the outermost array. */
3220 if (type->name () != nullptr)
3221 break;
3222 nindices -= 1;
3223 }
3224 return type;
3225 }
3226
3227 return NULL;
3228}
3229
3230/* See ada-lang.h. */
3231
3232struct type *
3233ada_index_type (struct type *type, int n, const char *name)
3234{
3235 struct type *result_type;
3236
3238
3239 if (n < 0 || n > ada_array_arity (type))
3240 error (_("invalid dimension number to '%s"), name);
3241
3243 {
3244 int i;
3245
3246 for (i = 1; i < n; i += 1)
3247 {
3249 type = type->target_type ();
3250 }
3251 result_type = ada_check_typedef (type)->index_type ()->target_type ();
3252 /* FIXME: The stabs type r(0,0);bound;bound in an array type
3253 has a target type of TYPE_CODE_UNDEF. We compensate here, but
3254 perhaps stabsread.c would make more sense. */
3255 if (result_type && result_type->code () == TYPE_CODE_UNDEF)
3256 result_type = NULL;
3257 }
3258 else
3259 {
3260 result_type = desc_index_type (desc_bounds_type (type), n);
3261 if (result_type == NULL)
3262 error (_("attempt to take bound of something that is not an array"));
3263 }
3264
3265 return result_type;
3266}
3267
3268/* Given that arr is an array type, returns the lower bound of the
3269 Nth index (numbering from 1) if WHICH is 0, and the upper bound if
3270 WHICH is 1. This returns bounds 0 .. -1 if ARR_TYPE is an
3271 array-descriptor type. It works for other arrays with bounds supplied
3272 by run-time quantities other than discriminants. */
3273
3274static LONGEST
3275ada_array_bound_from_type (struct type *arr_type, int n, int which)
3276{
3277 struct type *type, *index_type_desc, *index_type;
3278 int i;
3279
3280 gdb_assert (which == 0 || which == 1);
3281
3283 arr_type = decode_constrained_packed_array_type (arr_type);
3284
3285 if (arr_type == NULL || !ada_is_simple_array_type (arr_type))
3286 return - which;
3287
3288 if (arr_type->code () == TYPE_CODE_PTR)
3289 type = arr_type->target_type ();
3290 else
3291 type = arr_type;
3292
3293 if (type->is_fixed_instance ())
3294 {
3295 /* The array has already been fixed, so we do not need to
3296 check the parallel ___XA type again. That encoding has
3297 already been applied, so ignore it now. */
3298 index_type_desc = NULL;
3299 }
3300 else
3301 {
3302 index_type_desc = ada_find_parallel_type (type, "___XA");
3303 ada_fixup_array_indexes_type (index_type_desc);
3304 }
3305
3306 if (index_type_desc != NULL)
3307 index_type = to_fixed_range_type (index_type_desc->field (n - 1).type (),
3308 NULL);
3309 else
3310 {
3311 struct type *elt_type = check_typedef (type);
3312
3313 for (i = 1; i < n; i++)
3314 elt_type = check_typedef (elt_type->target_type ());
3315
3316 index_type = elt_type->index_type ();
3317 }
3318
3319 return (which == 0
3322}
3323
3324/* Given that arr is an array value, returns the lower bound of the
3325 nth index (numbering from 1) if WHICH is 0, and the upper bound if
3326 WHICH is 1. This routine will also work for arrays with bounds
3327 supplied by run-time quantities other than discriminants. */
3328
3329static LONGEST
3330ada_array_bound (struct value *arr, int n, int which)
3331{
3332 struct type *arr_type;
3333
3334 if (check_typedef (arr->type ())->code () == TYPE_CODE_PTR)
3335 arr = value_ind (arr);
3336 arr_type = arr->enclosing_type ();
3337
3339 return ada_array_bound (decode_constrained_packed_array (arr), n, which);
3340 else if (ada_is_simple_array_type (arr_type))
3341 return ada_array_bound_from_type (arr_type, n, which);
3342 else
3343 return value_as_long (desc_one_bound (desc_bounds (arr), n, which));
3344}
3345
3346/* Given that arr is an array value, returns the length of the
3347 nth index. This routine will also work for arrays with bounds
3348 supplied by run-time quantities other than discriminants.
3349 Does not work for arrays indexed by enumeration types with representation
3350 clauses at the moment. */
3351
3352static LONGEST
3353ada_array_length (struct value *arr, int n)
3354{
3355 struct type *arr_type, *index_type;
3356 int low, high;
3357
3358 if (check_typedef (arr->type ())->code () == TYPE_CODE_PTR)
3359 arr = value_ind (arr);
3360 arr_type = arr->enclosing_type ();
3361
3364
3365 if (ada_is_simple_array_type (arr_type))
3366 {
3367 low = ada_array_bound_from_type (arr_type, n, 0);
3368 high = ada_array_bound_from_type (arr_type, n, 1);
3369 }
3370 else
3371 {
3372 low = value_as_long (desc_one_bound (desc_bounds (arr), n, 0));
3373 high = value_as_long (desc_one_bound (desc_bounds (arr), n, 1));
3374 }
3375
3376 arr_type = check_typedef (arr_type);
3377 index_type = ada_index_type (arr_type, n, "length");
3378 if (index_type != NULL)
3379 {
3380 struct type *base_type;
3381 if (index_type->code () == TYPE_CODE_RANGE)
3382 base_type = index_type->target_type ();
3383 else
3384 base_type = index_type;
3385
3386 low = pos_atr (value_from_longest (base_type, low));
3387 high = pos_atr (value_from_longest (base_type, high));
3388 }
3389 return high - low + 1;
3390}
3391
3392/* An array whose type is that of ARR_TYPE (an array type), with
3393 bounds LOW to HIGH, but whose contents are unimportant. If HIGH is
3394 less than LOW, then LOW-1 is used. */
3395
3396static struct value *
3397empty_array (struct type *arr_type, int low, int high)
3398{
3399 struct type *arr_type0 = ada_check_typedef (arr_type);
3400 type_allocator alloc (arr_type0->index_type ()->target_type ());
3401 struct type *index_type
3403 (alloc, arr_type0->index_type ()->target_type (), low,
3404 high < low ? low - 1 : high);
3405 struct type *elt_type = ada_array_element_type (arr_type0, 1);
3406
3407 return value::allocate (create_array_type (alloc, elt_type, index_type));
3408}
3409
3410
3411 /* Name resolution */
3412
3413/* The "decoded" name for the user-definable Ada operator corresponding
3414 to OP. */
3415
3416static const char *
3418{
3419 int i;
3420
3421 for (i = 0; ada_opname_table[i].encoded != NULL; i += 1)
3422 {
3423 if (ada_opname_table[i].op == op)
3424 return ada_opname_table[i].decoded;
3425 }
3426 error (_("Could not find operator name for opcode"));
3427}
3428
3429/* Returns true (non-zero) iff decoded name N0 should appear before N1
3430 in a listing of choices during disambiguation (see sort_choices, below).
3431 The idea is that overloadings of a subprogram name from the
3432 same package should sort in their source order. We settle for ordering
3433 such symbols by their trailing number (__N or $N). */
3434
3435static int
3436encoded_ordered_before (const char *N0, const char *N1)
3437{
3438 if (N1 == NULL)
3439 return 0;
3440 else if (N0 == NULL)
3441 return 1;
3442 else
3443 {
3444 int k0, k1;
3445
3446 for (k0 = strlen (N0) - 1; k0 > 0 && isdigit (N0[k0]); k0 -= 1)
3447 ;
3448 for (k1 = strlen (N1) - 1; k1 > 0 && isdigit (N1[k1]); k1 -= 1)
3449 ;
3450 if ((N0[k0] == '_' || N0[k0] == '$') && N0[k0 + 1] != '\000'
3451 && (N1[k1] == '_' || N1[k1] == '$') && N1[k1 + 1] != '\000')
3452 {
3453 int n0, n1;
3454
3455 n0 = k0;
3456 while (N0[n0] == '_' && n0 > 0 && N0[n0 - 1] == '_')
3457 n0 -= 1;
3458 n1 = k1;
3459 while (N1[n1] == '_' && n1 > 0 && N1[n1 - 1] == '_')
3460 n1 -= 1;
3461 if (n0 == n1 && strncmp (N0, N1, n0) == 0)
3462 return (atoi (N0 + k0 + 1) < atoi (N1 + k1 + 1));
3463 }
3464 return (strcmp (N0, N1) < 0);
3465 }
3466}
3467
3468/* Sort SYMS[0..NSYMS-1] to put the choices in a canonical order by the
3469 encoded names. */
3470
3471static void
3472sort_choices (struct block_symbol syms[], int nsyms)
3473{
3474 int i;
3475
3476 for (i = 1; i < nsyms; i += 1)
3477 {
3478 struct block_symbol sym = syms[i];
3479 int j;
3480
3481 for (j = i - 1; j >= 0; j -= 1)
3482 {
3484 sym.symbol->linkage_name ()))
3485 break;
3486 syms[j + 1] = syms[j];
3487 }
3488 syms[j + 1] = sym;
3489 }
3490}
3491
3492/* Whether GDB should display formals and return types for functions in the
3493 overloads selection menu. */
3494static bool print_signatures = true;
3495
3496/* Print the signature for SYM on STREAM according to the FLAGS options. For
3497 all but functions, the signature is just the name of the symbol. For
3498 functions, this is the name of the function, the list of types for formals
3499 and the return type (if any). */
3500
3501static void
3502ada_print_symbol_signature (struct ui_file *stream, struct symbol *sym,
3503 const struct type_print_options *flags)
3504{
3505 struct type *type = sym->type ();
3506
3507 gdb_printf (stream, "%s", sym->print_name ());
3508 if (!print_signatures
3509 || type == NULL
3510 || type->code () != TYPE_CODE_FUNC)
3511 return;
3512
3513 if (type->num_fields () > 0)
3514 {
3515 int i;
3516
3517 gdb_printf (stream, " (");
3518 for (i = 0; i < type->num_fields (); ++i)
3519 {
3520 if (i > 0)
3521 gdb_printf (stream, "; ");
3522 ada_print_type (type->field (i).type (), NULL, stream, -1, 0,
3523 flags);
3524 }
3525 gdb_printf (stream, ")");
3526 }
3527 if (type->target_type () != NULL
3528 && type->target_type ()->code () != TYPE_CODE_VOID)
3529 {
3530 gdb_printf (stream, " return ");
3531 ada_print_type (type->target_type (), NULL, stream, -1, 0, flags);
3532 }
3533}
3534
3535/* Read and validate a set of numeric choices from the user in the
3536 range 0 .. N_CHOICES-1. Place the results in increasing
3537 order in CHOICES[0 .. N-1], and return N.
3538
3539 The user types choices as a sequence of numbers on one line
3540 separated by blanks, encoding them as follows:
3541
3542 + A choice of 0 means to cancel the selection, throwing an error.
3543 + If IS_ALL_CHOICE, a choice of 1 selects the entire set 0 .. N_CHOICES-1.
3544 + The user chooses k by typing k+IS_ALL_CHOICE+1.
3545
3546 The user is not allowed to choose more than MAX_RESULTS values.
3547
3548 ANNOTATION_SUFFIX, if present, is used to annotate the input
3549 prompts (for use with the -f switch). */
3550
3551static int
3552get_selections (int *choices, int n_choices, int max_results,
3553 int is_all_choice, const char *annotation_suffix)
3554{
3555 const char *args;
3556 const char *prompt;
3557 int n_chosen;
3558 int first_choice = is_all_choice ? 2 : 1;
3559
3560 prompt = getenv ("PS2");
3561 if (prompt == NULL)
3562 prompt = "> ";
3563
3564 std::string buffer;
3565 args = command_line_input (buffer, prompt, annotation_suffix);
3566
3567 if (args == NULL)
3568 error_no_arg (_("one or more choice numbers"));
3569
3570 n_chosen = 0;
3571
3572 /* Set choices[0 .. n_chosen-1] to the users' choices in ascending
3573 order, as given in args. Choices are validated. */
3574 while (1)
3575 {
3576 char *args2;
3577 int choice, j;
3578
3579 args = skip_spaces (args);
3580 if (*args == '\0' && n_chosen == 0)
3581 error_no_arg (_("one or more choice numbers"));
3582 else if (*args == '\0')
3583 break;
3584
3585 choice = strtol (args, &args2, 10);
3586 if (args == args2 || choice < 0
3587 || choice > n_choices + first_choice - 1)
3588 error (_("Argument must be choice number"));
3589 args = args2;
3590
3591 if (choice == 0)
3592 error (_("cancelled"));
3593
3594 if (choice < first_choice)
3595 {
3596 n_chosen = n_choices;
3597 for (j = 0; j < n_choices; j += 1)
3598 choices[j] = j;
3599 break;
3600 }
3601 choice -= first_choice;
3602
3603 for (j = n_chosen - 1; j >= 0 && choice < choices[j]; j -= 1)
3604 {
3605 }
3606
3607 if (j < 0 || choice != choices[j])
3608 {
3609 int k;
3610
3611 for (k = n_chosen - 1; k > j; k -= 1)
3612 choices[k + 1] = choices[k];
3613 choices[j + 1] = choice;
3614 n_chosen += 1;
3615 }
3616 }
3617
3618 if (n_chosen > max_results)
3619 error (_("Select no more than %d of the above"), max_results);
3620
3621 return n_chosen;
3622}
3623
3624/* Given a list of NSYMS symbols in SYMS, select up to MAX_RESULTS>0
3625 by asking the user (if necessary), returning the number selected,
3626 and setting the first elements of SYMS items. Error if no symbols
3627 selected. */
3628
3629/* NOTE: Adapted from decode_line_2 in symtab.c, with which it ought
3630 to be re-integrated one of these days. */
3631
3632static int
3633user_select_syms (struct block_symbol *syms, int nsyms, int max_results)
3634{
3635 int i;
3636 int *chosen = XALLOCAVEC (int , nsyms);
3637 int n_chosen;
3638 int first_choice = (max_results == 1) ? 1 : 2;
3639 const char *select_mode = multiple_symbols_select_mode ();
3640
3641 if (max_results < 1)
3642 error (_("Request to select 0 symbols!"));
3643 if (nsyms <= 1)
3644 return nsyms;
3645
3646 if (select_mode == multiple_symbols_cancel)
3647 error (_("\
3648canceled because the command is ambiguous\n\
3649See set/show multiple-symbol."));
3650
3651 /* If select_mode is "all", then return all possible symbols.
3652 Only do that if more than one symbol can be selected, of course.
3653 Otherwise, display the menu as usual. */
3654 if (select_mode == multiple_symbols_all && max_results > 1)
3655 return nsyms;
3656
3657 gdb_printf (_("[0] cancel\n"));
3658 if (max_results > 1)
3659 gdb_printf (_("[1] all\n"));
3660
3661 sort_choices (syms, nsyms);
3662
3663 for (i = 0; i < nsyms; i += 1)
3664 {
3665 if (syms[i].symbol == NULL)
3666 continue;
3667
3668 if (syms[i].symbol->aclass () == LOC_BLOCK)
3669 {
3670 struct symtab_and_line sal =
3671 find_function_start_sal (syms[i].symbol, 1);
3672
3673 gdb_printf ("[%d] ", i + first_choice);
3676 if (sal.symtab == NULL)
3677 gdb_printf (_(" at %p[<no source file available>%p]:%d\n"),
3678 metadata_style.style ().ptr (), nullptr, sal.line);
3679 else
3681 (_(" at %ps:%d\n"),
3684 sal.line);
3685 continue;
3686 }
3687 else
3688 {
3689 int is_enumeral =
3690 (syms[i].symbol->aclass () == LOC_CONST
3691 && syms[i].symbol->type () != NULL
3692 && syms[i].symbol->type ()->code () == TYPE_CODE_ENUM);
3693 struct symtab *symtab = NULL;
3694
3695 if (syms[i].symbol->is_objfile_owned ())
3696 symtab = syms[i].symbol->symtab ();
3697
3698 if (syms[i].symbol->line () != 0 && symtab != NULL)
3699 {
3700 gdb_printf ("[%d] ", i + first_choice);
3703 gdb_printf (_(" at %s:%d\n"),
3705 syms[i].symbol->line ());
3706 }
3707 else if (is_enumeral
3708 && syms[i].symbol->type ()->name () != NULL)
3709 {
3710 gdb_printf (("[%d] "), i + first_choice);
3711 ada_print_type (syms[i].symbol->type (), NULL,
3713 gdb_printf (_("'(%s) (enumeral)\n"),
3714 syms[i].symbol->print_name ());
3715 }
3716 else
3717 {
3718 gdb_printf ("[%d] ", i + first_choice);
3721
3722 if (symtab != NULL)
3723 gdb_printf (is_enumeral
3724 ? _(" in %s (enumeral)\n")
3725 : _(" at %s:?\n"),
3727 else
3728 gdb_printf (is_enumeral
3729 ? _(" (enumeral)\n")
3730 : _(" at ?\n"));
3731 }
3732 }
3733 }
3734
3735 n_chosen = get_selections (chosen, nsyms, max_results, max_results > 1,
3736 "overload-choice");
3737
3738 for (i = 0; i < n_chosen; i += 1)
3739 syms[i] = syms[chosen[i]];
3740
3741 return n_chosen;
3742}
3743
3744/* See ada-lang.h. */
3745
3747ada_find_operator_symbol (enum exp_opcode op, bool parse_completion,
3748 int nargs, value *argvec[])
3749{
3750 if (possible_user_operator_p (op, argvec))
3751 {
3752 std::vector<struct block_symbol> candidates
3754 NULL, VAR_DOMAIN);
3755
3756 int i = ada_resolve_function (candidates, argvec,
3757 nargs, ada_decoded_op_name (op), NULL,
3758 parse_completion);
3759 if (i >= 0)
3760 return candidates[i];
3761 }
3762 return {};
3763}
3764
3765/* See ada-lang.h. */
3766
3768ada_resolve_funcall (struct symbol *sym, const struct block *block,
3769 struct type *context_type,
3770 bool parse_completion,
3771 int nargs, value *argvec[],
3772 innermost_block_tracker *tracker)
3773{
3774 std::vector<struct block_symbol> candidates
3776
3777 int i;
3778 if (candidates.size () == 1)
3779 i = 0;
3780 else
3781 {
3783 (candidates,
3784 argvec, nargs,
3785 sym->linkage_name (),
3786 context_type, parse_completion);
3787 if (i < 0)
3788 error (_("Could not find a match for %s"), sym->print_name ());
3789 }
3790
3791 tracker->update (candidates[i]);
3792 return candidates[i];
3793}
3794
3795/* Resolve a mention of a name where the context type is an
3796 enumeration type. */
3797
3798static int
3799ada_resolve_enum (std::vector<struct block_symbol> &syms,
3800 const char *name, struct type *context_type,
3801 bool parse_completion)
3802{
3803 gdb_assert (context_type->code () == TYPE_CODE_ENUM);
3804 context_type = ada_check_typedef (context_type);
3805
3806 /* We already know the name matches, so we're just looking for
3807 an element of the correct enum type. */
3808 struct type *type1 = context_type;
3809 for (int i = 0; i < syms.size (); ++i)
3810 {
3811 struct type *type2 = ada_check_typedef (syms[i].symbol->type ());
3812 if (type1 == type2)
3813 return i;
3814 }
3815
3816 for (int i = 0; i < syms.size (); ++i)
3817 {
3818 struct type *type2 = ada_check_typedef (syms[i].symbol->type ());
3819 if (type1->num_fields () != type2->num_fields ())
3820 continue;
3821 if (strcmp (type1->name (), type2->name ()) != 0)
3822 continue;
3823 if (ada_identical_enum_types_p (type1, type2))
3824 return i;
3825 }
3826
3827 error (_("No name '%s' in enumeration type '%s'"), name,
3828 ada_type_name (context_type));
3829}
3830
3831/* See ada-lang.h. */
3832
3834ada_resolve_variable (struct symbol *sym, const struct block *block,
3835 struct type *context_type,
3836 bool parse_completion,
3837 int deprocedure_p,
3838 innermost_block_tracker *tracker)
3839{
3840 std::vector<struct block_symbol> candidates
3842
3843 if (std::any_of (candidates.begin (),
3844 candidates.end (),
3845 [] (block_symbol &bsym)
3846 {
3847 switch (bsym.symbol->aclass ())
3848 {
3849 case LOC_REGISTER:
3850 case LOC_ARG:
3851 case LOC_REF_ARG:
3852 case LOC_REGPARM_ADDR:
3853 case LOC_LOCAL:
3854 case LOC_COMPUTED:
3855 return true;
3856 default:
3857 return false;
3858 }
3859 }))
3860 {
3861 /* Types tend to get re-introduced locally, so if there
3862 are any local symbols that are not types, first filter
3863 out all types. */
3864 candidates.erase
3865 (std::remove_if
3866 (candidates.begin (),
3867 candidates.end (),
3868 [] (block_symbol &bsym)
3869 {
3870 return bsym.symbol->aclass () == LOC_TYPEDEF;
3871 }),
3872 candidates.end ());
3873 }
3874
3875 /* Filter out artificial symbols. */
3876 candidates.erase
3877 (std::remove_if
3878 (candidates.begin (),
3879 candidates.end (),
3880 [] (block_symbol &bsym)
3881 {
3882 return bsym.symbol->is_artificial ();
3883 }),
3884 candidates.end ());
3885
3886 int i;
3887 if (candidates.empty ())
3888 error (_("No definition found for %s"), sym->print_name ());
3889 else if (candidates.size () == 1)
3890 i = 0;
3891 else if (context_type != nullptr
3892 && context_type->code () == TYPE_CODE_ENUM)
3893 i = ada_resolve_enum (candidates, sym->linkage_name (), context_type,
3894 parse_completion);
3895 else if (context_type == nullptr
3896 && symbols_are_identical_enums (candidates))
3897 {
3898 /* If all the remaining symbols are identical enumerals, then
3899 just keep the first one and discard the rest.
3900
3901 Unlike what we did previously, we do not discard any entry
3902 unless they are ALL identical. This is because the symbol
3903 comparison is not a strict comparison, but rather a practical
3904 comparison. If all symbols are considered identical, then
3905 we can just go ahead and use the first one and discard the rest.
3906 But if we cannot reduce the list to a single element, we have
3907 to ask the user to disambiguate anyways. And if we have to
3908 present a multiple-choice menu, it's less confusing if the list
3909 isn't missing some choices that were identical and yet distinct. */
3910 candidates.resize (1);
3911 i = 0;
3912 }
3913 else if (deprocedure_p && !is_nonfunction (candidates))
3914 {
3916 (candidates, NULL, 0,
3917 sym->linkage_name (),
3918 context_type, parse_completion);
3919 if (i < 0)
3920 error (_("Could not find a match for %s"), sym->print_name ());
3921 }
3922 else
3923 {
3924 gdb_printf (_("Multiple matches for %s\n"), sym->print_name ());
3925 user_select_syms (candidates.data (), candidates.size (), 1);
3926 i = 0;
3927 }
3928
3929 tracker->update (candidates[i]);
3930 return candidates[i];
3931}
3932
3933/* Return non-zero if formal type FTYPE matches actual type ATYPE. */
3934/* The term "match" here is rather loose. The match is heuristic and
3935 liberal. */
3936
3937static int
3938ada_type_match (struct type *ftype, struct type *atype)
3939{
3940 ftype = ada_check_typedef (ftype);
3941 atype = ada_check_typedef (atype);
3942
3943 if (ftype->code () == TYPE_CODE_REF)
3944 ftype = ftype->target_type ();
3945 if (atype->code () == TYPE_CODE_REF)
3946 atype = atype->target_type ();
3947
3948 switch (ftype->code ())
3949 {
3950 default:
3951 return ftype->code () == atype->code ();
3952 case TYPE_CODE_PTR:
3953 if (atype->code () != TYPE_CODE_PTR)
3954 return 0;
3955 atype = atype->target_type ();
3956 /* This can only happen if the actual argument is 'null'. */
3957 if (atype->code () == TYPE_CODE_INT && atype->length () == 0)
3958 return 1;
3959 return ada_type_match (ftype->target_type (), atype);
3960 case TYPE_CODE_INT:
3961 case TYPE_CODE_ENUM:
3962 case TYPE_CODE_RANGE:
3963 switch (atype->code ())
3964 {
3965 case TYPE_CODE_INT:
3966 case TYPE_CODE_ENUM:
3967 case TYPE_CODE_RANGE:
3968 return 1;
3969 default:
3970 return 0;
3971 }
3972
3973 case TYPE_CODE_ARRAY:
3974 return (atype->code () == TYPE_CODE_ARRAY
3975 || ada_is_array_descriptor_type (atype));
3976
3977 case TYPE_CODE_STRUCT:
3978 if (ada_is_array_descriptor_type (ftype))
3979 return (atype->code () == TYPE_CODE_ARRAY
3980 || ada_is_array_descriptor_type (atype));
3981 else
3982 return (atype->code () == TYPE_CODE_STRUCT
3983 && !ada_is_array_descriptor_type (atype));
3984
3985 case TYPE_CODE_UNION:
3986 case TYPE_CODE_FLT:
3987 return (atype->code () == ftype->code ());
3988 }
3989}
3990
3991/* Return non-zero if the formals of FUNC "sufficiently match" the
3992 vector of actual argument types ACTUALS of size N_ACTUALS. FUNC
3993 may also be an enumeral, in which case it is treated as a 0-
3994 argument function. */
3995
3996static int
3997ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
3998{
3999 int i;
4000 struct type *func_type = func->type ();
4001
4002 if (func->aclass () == LOC_CONST
4003 && func_type->code () == TYPE_CODE_ENUM)
4004 return (n_actuals == 0);
4005 else if (func_type == NULL || func_type->code () != TYPE_CODE_FUNC)
4006 return 0;
4007
4008 if (func_type->num_fields () != n_actuals)
4009 return 0;
4010
4011 for (i = 0; i < n_actuals; i += 1)
4012 {
4013 if (actuals[i] == NULL)
4014 return 0;
4015 else
4016 {
4017 struct type *ftype = ada_check_typedef (func_type->field (i).type ());
4018 struct type *atype = ada_check_typedef (actuals[i]->type ());
4019
4020 if (!ada_type_match (ftype, atype))
4021 return 0;
4022 }
4023 }
4024 return 1;
4025}
4026
4027/* False iff function type FUNC_TYPE definitely does not produce a value
4028 compatible with type CONTEXT_TYPE. Conservatively returns 1 if
4029 FUNC_TYPE is not a valid function type with a non-null return type
4030 or an enumerated type. A null CONTEXT_TYPE indicates any non-void type. */
4031
4032static int
4033return_match (struct type *func_type, struct type *context_type)
4034{
4035 struct type *return_type;
4036
4037 if (func_type == NULL)
4038 return 1;
4039
4040 if (func_type->code () == TYPE_CODE_FUNC)
4041 return_type = get_base_type (func_type->target_type ());
4042 else
4043 return_type = get_base_type (func_type);
4044 if (return_type == NULL)
4045 return 1;
4046
4047 context_type = get_base_type (context_type);
4048
4049 if (return_type->code () == TYPE_CODE_ENUM)
4050 return context_type == NULL || return_type == context_type;
4051 else if (context_type == NULL)
4052 return return_type->code () != TYPE_CODE_VOID;
4053 else
4054 return return_type->code () == context_type->code ();
4055}
4056
4057
4058/* Returns the index in SYMS that contains the symbol for the
4059 function (if any) that matches the types of the NARGS arguments in
4060 ARGS. If CONTEXT_TYPE is non-null and there is at least one match
4061 that returns that type, then eliminate matches that don't. If
4062 CONTEXT_TYPE is void and there is at least one match that does not
4063 return void, eliminate all matches that do.
4064
4065 Asks the user if there is more than one match remaining. Returns -1
4066 if there is no such symbol or none is selected. NAME is used
4067 solely for messages. May re-arrange and modify SYMS in
4068 the process; the index returned is for the modified vector. */
4069
4070static int
4071ada_resolve_function (std::vector<struct block_symbol> &syms,
4072 struct value **args, int nargs,
4073 const char *name, struct type *context_type,
4074 bool parse_completion)
4075{
4076 int fallback;
4077 int k;
4078 int m; /* Number of hits */
4079
4080 m = 0;
4081 /* In the first pass of the loop, we only accept functions matching
4082 context_type. If none are found, we add a second pass of the loop
4083 where every function is accepted. */
4084 for (fallback = 0; m == 0 && fallback < 2; fallback++)
4085 {
4086 for (k = 0; k < syms.size (); k += 1)
4087 {
4088 struct type *type = ada_check_typedef (syms[k].symbol->type ());
4089
4090 if (ada_args_match (syms[k].symbol, args, nargs)
4091 && (fallback || return_match (type, context_type)))
4092 {
4093 syms[m] = syms[k];
4094 m += 1;
4095 }
4096 }
4097 }
4098
4099 /* If we got multiple matches, ask the user which one to use. Don't do this
4100 interactive thing during completion, though, as the purpose of the
4101 completion is providing a list of all possible matches. Prompting the
4102 user to filter it down would be completely unexpected in this case. */
4103 if (m == 0)
4104 return -1;
4105 else if (m > 1 && !parse_completion)
4106 {
4107 gdb_printf (_("Multiple matches for %s\n"), name);
4108 user_select_syms (syms.data (), m, 1);
4109 return 0;
4110 }
4111 return 0;
4112}
4113
4114/* Type-class predicates */
4115
4116/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type),
4117 or FLOAT). */
4118
4119static int
4121{
4122 if (type == NULL)
4123 return 0;
4124 else
4125 {
4126 switch (type->code ())
4127 {
4128 case TYPE_CODE_INT:
4129 case TYPE_CODE_FLT:
4130 case TYPE_CODE_FIXED_POINT:
4131 return 1;
4132 case TYPE_CODE_RANGE:
4133 return (type == type->target_type ()
4135 default:
4136 return 0;
4137 }
4138 }
4139}
4140
4141/* True iff TYPE is integral (an INT or RANGE of INTs). */
4142
4143static int
4145{
4146 if (type == NULL)
4147 return 0;
4148 else
4149 {
4150 switch (type->code ())
4151 {
4152 case TYPE_CODE_INT:
4153 return 1;
4154 case TYPE_CODE_RANGE:
4155 return (type == type->target_type ()
4157 default:
4158 return 0;
4159 }
4160 }
4161}
4162
4163/* True iff TYPE is scalar (INT, RANGE, FLOAT, ENUM). */
4164
4165static int
4167{
4168 if (type == NULL)
4169 return 0;
4170 else
4171 {
4172 switch (type->code ())
4173 {
4174 case TYPE_CODE_INT:
4175 case TYPE_CODE_RANGE:
4176 case TYPE_CODE_ENUM:
4177 case TYPE_CODE_FLT:
4178 case TYPE_CODE_FIXED_POINT:
4179 return 1;
4180 default:
4181 return 0;
4182 }
4183 }
4184}
4185
4186/* True iff TYPE is discrete, as defined in the Ada Reference Manual.
4187 This essentially means one of (INT, RANGE, ENUM) -- but note that
4188 "enum" includes character and boolean as well. */
4189
4190static int
4192{
4193 if (type == NULL)
4194 return 0;
4195 else
4196 {
4197 switch (type->code ())
4198 {
4199 case TYPE_CODE_INT:
4200 case TYPE_CODE_RANGE:
4201 case TYPE_CODE_ENUM:
4202 case TYPE_CODE_BOOL:
4203 case TYPE_CODE_CHAR:
4204 return 1;
4205 default:
4206 return 0;
4207 }
4208 }
4209}
4210
4211/* Returns non-zero if OP with operands in the vector ARGS could be
4212 a user-defined function. Errs on the side of pre-defined operators
4213 (i.e., result 0). */
4214
4215static int
4217{
4218 struct type *type0 =
4219 (args[0] == NULL) ? NULL : ada_check_typedef (args[0]->type ());
4220 struct type *type1 =
4221 (args[1] == NULL) ? NULL : ada_check_typedef (args[1]->type ());
4222
4223 if (type0 == NULL)
4224 return 0;
4225
4226 switch (op)
4227 {
4228 default:
4229 return 0;
4230
4231 case BINOP_ADD:
4232 case BINOP_SUB:
4233 case BINOP_MUL:
4234 case BINOP_DIV:
4235 return (!(numeric_type_p (type0) && numeric_type_p (type1)));
4236
4237 case BINOP_REM:
4238 case BINOP_MOD:
4239 case BINOP_BITWISE_AND:
4240 case BINOP_BITWISE_IOR:
4241 case BINOP_BITWISE_XOR:
4242 return (!(integer_type_p (type0) && integer_type_p (type1)));
4243
4244 case BINOP_EQUAL:
4245 case BINOP_NOTEQUAL:
4246 case BINOP_LESS:
4247 case BINOP_GTR:
4248 case BINOP_LEQ:
4249 case BINOP_GEQ:
4250 return (!(scalar_type_p (type0) && scalar_type_p (type1)));
4251
4252 case BINOP_CONCAT:
4253 return !ada_is_array_type (type0) || !ada_is_array_type (type1);
4254
4255 case BINOP_EXP:
4256 return (!(numeric_type_p (type0) && integer_type_p (type1)));
4257
4258 case UNOP_NEG:
4259 case UNOP_PLUS:
4260 case UNOP_LOGICAL_NOT:
4261 case UNOP_ABS:
4262 return (!numeric_type_p (type0));
4263
4264 }
4265}
4266
4267 /* Renaming */
4268
4269/* NOTES:
4270
4271 1. In the following, we assume that a renaming type's name may
4272 have an ___XD suffix. It would be nice if this went away at some
4273 point.
4274 2. We handle both the (old) purely type-based representation of
4275 renamings and the (new) variable-based encoding. At some point,
4276 it is devoutly to be hoped that the former goes away
4277 (FIXME: hilfinger-2007-07-09).
4278 3. Subprogram renamings are not implemented, although the XRS
4279 suffix is recognized (FIXME: hilfinger-2007-07-09). */
4280
4281/* If SYM encodes a renaming,
4282
4283 <renaming> renames <renamed entity>,
4284
4285 sets *LEN to the length of the renamed entity's name,
4286 *RENAMED_ENTITY to that name (not null-terminated), and *RENAMING_EXPR to
4287 the string describing the subcomponent selected from the renamed
4288 entity. Returns ADA_NOT_RENAMING if SYM does not encode a renaming
4289 (in which case, the values of *RENAMED_ENTITY, *LEN, and *RENAMING_EXPR
4290 are undefined). Otherwise, returns a value indicating the category
4291 of entity renamed: an object (ADA_OBJECT_RENAMING), exception
4292 (ADA_EXCEPTION_RENAMING), package (ADA_PACKAGE_RENAMING), or
4293 subprogram (ADA_SUBPROGRAM_RENAMING). Does no allocation; the
4294 strings returned in *RENAMED_ENTITY and *RENAMING_EXPR should not be
4295 deallocated. The values of RENAMED_ENTITY, LEN, or RENAMING_EXPR
4296 may be NULL, in which case they are not assigned.
4297
4298 [Currently, however, GCC does not generate subprogram renamings.] */
4299
4302 const char **renamed_entity, int *len,
4303 const char **renaming_expr)
4304{
4305 enum ada_renaming_category kind;
4306 const char *info;
4307 const char *suffix;
4308
4309 if (sym == NULL)
4310 return ADA_NOT_RENAMING;
4311 switch (sym->aclass ())
4312 {
4313 default:
4314 return ADA_NOT_RENAMING;
4315 case LOC_LOCAL:
4316 case LOC_STATIC:
4317 case LOC_COMPUTED:
4318 case LOC_OPTIMIZED_OUT:
4319 info = strstr (sym->linkage_name (), "___XR");
4320 if (info == NULL)
4321 return ADA_NOT_RENAMING;
4322 switch (info[5])
4323 {
4324 case '_':
4325 kind = ADA_OBJECT_RENAMING;
4326 info += 6;
4327 break;
4328 case 'E':
4330 info += 7;
4331 break;
4332 case 'P':
4333 kind = ADA_PACKAGE_RENAMING;
4334 info += 7;
4335 break;
4336 case 'S':
4338 info += 7;
4339 break;
4340 default:
4341 return ADA_NOT_RENAMING;
4342 }
4343 }
4344
4345 if (renamed_entity != NULL)
4346 *renamed_entity = info;
4347 suffix = strstr (info, "___XE");
4348 if (suffix == NULL || suffix == info)
4349 return ADA_NOT_RENAMING;
4350 if (len != NULL)
4351 *len = strlen (info) - strlen (suffix);
4352 suffix += 5;
4353 if (renaming_expr != NULL)
4354 *renaming_expr = suffix;
4355 return kind;
4356}
4357
4358/* Compute the value of the given RENAMING_SYM, which is expected to
4359 be a symbol encoding a renaming expression. BLOCK is the block
4360 used to evaluate the renaming. */
4361
4362static struct value *
4364 const struct block *block)
4365{
4366 const char *sym_name;
4367
4368 sym_name = renaming_sym->linkage_name ();
4369 expression_up expr = parse_exp_1 (&sym_name, 0, block, 0);
4370 return expr->evaluate ();
4371}
4372
4373
4374 /* Evaluation: Function Calls */
4375
4376/* Return an lvalue containing the value VAL. This is the identity on
4377 lvalues, and otherwise has the side-effect of allocating memory
4378 in the inferior where a copy of the value contents is copied. */
4379
4380static struct value *
4381ensure_lval (struct value *val)
4382{
4383 if (val->lval () == not_lval
4384 || val->lval () == lval_internalvar)
4385 {
4386 int len = ada_check_typedef (val->type ())->length ();
4387 const CORE_ADDR addr =
4389
4390 val->set_lval (lval_memory);
4391 val->set_address (addr);
4392 write_memory (addr, val->contents ().data (), len);
4393 }
4394
4395 return val;
4396}
4397
4398/* Given ARG, a value of type (pointer or reference to a)*
4399 structure/union, extract the component named NAME from the ultimate
4400 target structure/union and return it as a value with its
4401 appropriate type.
4402
4403 The routine searches for NAME among all members of the structure itself
4404 and (recursively) among all members of any wrapper members
4405 (e.g., '_parent').
4406
4407 If NO_ERR, then simply return NULL in case of error, rather than
4408 calling error. */
4409
4410static struct value *
4411ada_value_struct_elt (struct value *arg, const char *name, int no_err)
4412{
4413 struct type *t, *t1;
4414 struct value *v;
4415 int check_tag;
4416
4417 v = NULL;
4418 t1 = t = ada_check_typedef (arg->type ());
4419 if (t->code () == TYPE_CODE_REF)
4420 {
4421 t1 = t->target_type ();
4422 if (t1 == NULL)
4423 goto BadValue;
4424 t1 = ada_check_typedef (t1);
4425 if (t1->code () == TYPE_CODE_PTR)
4426 {
4427 arg = coerce_ref (arg);
4428 t = t1;
4429 }
4430 }
4431
4432 while (t->code () == TYPE_CODE_PTR)
4433 {
4434 t1 = t->target_type ();
4435 if (t1 == NULL)
4436 goto BadValue;
4437 t1 = ada_check_typedef (t1);
4438 if (t1->code () == TYPE_CODE_PTR)
4439 {
4440 arg = value_ind (arg);
4441 t = t1;
4442 }
4443 else
4444 break;
4445 }
4446
4447 if (t1->code () != TYPE_CODE_STRUCT && t1->code () != TYPE_CODE_UNION)
4448 goto BadValue;
4449
4450 if (t1 == t)
4451 v = ada_search_struct_field (name, arg, 0, t);
4452 else
4453 {
4454 int bit_offset, bit_size, byte_offset;
4455 struct type *field_type;
4456 CORE_ADDR address;
4457
4458 if (t->code () == TYPE_CODE_PTR)
4459 address = ada_value_ind (arg)->address ();
4460 else
4461 address = ada_coerce_ref (arg)->address ();
4462
4463 /* Check to see if this is a tagged type. We also need to handle
4464 the case where the type is a reference to a tagged type, but
4465 we have to be careful to exclude pointers to tagged types.
4466 The latter should be shown as usual (as a pointer), whereas
4467 a reference should mostly be transparent to the user. */
4468
4469 if (ada_is_tagged_type (t1, 0)
4470 || (t1->code () == TYPE_CODE_REF
4471 && ada_is_tagged_type (t1->target_type (), 0)))
4472 {
4473 /* We first try to find the searched field in the current type.
4474 If not found then let's look in the fixed type. */
4475
4476 if (!find_struct_field (name, t1, 0,
4477 nullptr, nullptr, nullptr,
4478 nullptr, nullptr))
4479 check_tag = 1;
4480 else
4481 check_tag = 0;
4482 }
4483 else
4484 check_tag = 0;
4485
4486 /* Convert to fixed type in all cases, so that we have proper
4487 offsets to each field in unconstrained record types. */
4488 t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
4489 address, NULL, check_tag);
4490
4491 /* Resolve the dynamic type as well. */
4492 arg = value_from_contents_and_address (t1, nullptr, address);
4493 t1 = arg->type ();
4494
4495 if (find_struct_field (name, t1, 0,
4496 &field_type, &byte_offset, &bit_offset,
4497 &bit_size, NULL))
4498 {
4499 if (bit_size != 0)
4500 {
4501 if (t->code () == TYPE_CODE_REF)
4502 arg = ada_coerce_ref (arg);
4503 else
4504 arg = ada_value_ind (arg);
4505 v = ada_value_primitive_packed_val (arg, NULL, byte_offset,
4507 field_type);
4508 }
4509 else
4510 v = value_at_lazy (field_type, address + byte_offset);
4511 }
4512 }
4513
4514 if (v != NULL || no_err)
4515 return v;
4516 else
4517 error (_("There is no member named %s."), name);
4518
4519 BadValue:
4520 if (no_err)
4521 return NULL;
4522 else
4523 error (_("Attempt to extract a component of "
4524 "a value that is not a record."));
4525}
4526
4527/* Return the value ACTUAL, converted to be an appropriate value for a
4528 formal of type FORMAL_TYPE. Use *SP as a stack pointer for
4529 allocating any necessary descriptors (fat pointers), or copies of
4530 values not residing in memory, updating it as needed. */
4531
4532struct value *
4533ada_convert_actual (struct value *actual, struct type *formal_type0)
4534{
4535 struct type *actual_type = ada_check_typedef (actual->type ());
4536 struct type *formal_type = ada_check_typedef (formal_type0);
4537 struct type *formal_target =
4538 formal_type->code () == TYPE_CODE_PTR
4539 ? ada_check_typedef (formal_type->target_type ()) : formal_type;
4540 struct type *actual_target =
4541 actual_type->code () == TYPE_CODE_PTR
4542 ? ada_check_typedef (actual_type->target_type ()) : actual_type;
4543
4544 if (ada_is_array_descriptor_type (formal_target)
4545 && actual_target->code () == TYPE_CODE_ARRAY)
4546 return make_array_descriptor (formal_type, actual);
4547 else if (formal_type->code () == TYPE_CODE_PTR
4548 || formal_type->code () == TYPE_CODE_REF)
4549 {
4550 struct value *result;
4551
4552 if (formal_target->code () == TYPE_CODE_ARRAY
4553 && ada_is_array_descriptor_type (actual_target))
4554 result = desc_data (actual);
4555 else if (formal_type->code () != TYPE_CODE_PTR)
4556 {
4557 if (actual->lval () != lval_memory)
4558 {
4559 struct value *val;
4560
4561 actual_type = ada_check_typedef (actual->type ());
4562 val = value::allocate (actual_type);
4563 copy (actual->contents (), val->contents_raw ());
4564 actual = ensure_lval (val);
4565 }
4566 result = value_addr (actual);
4567 }
4568 else
4569 return actual;
4570 return value_cast_pointers (formal_type, result, 0);
4571 }
4572 else if (actual_type->code () == TYPE_CODE_PTR)
4573 return ada_value_ind (actual);
4574 else if (ada_is_aligner_type (formal_type))
4575 {
4576 /* We need to turn this parameter into an aligner type
4577 as well. */
4578 struct value *aligner = value::allocate (formal_type);
4579 struct value *component = ada_value_struct_elt (aligner, "F", 0);
4580
4581 value_assign_to_component (aligner, component, actual);
4582 return aligner;
4583 }
4584
4585 return actual;
4586}
4587
4588/* Convert VALUE (which must be an address) to a CORE_ADDR that is a pointer of
4589 type TYPE. This is usually an inefficient no-op except on some targets
4590 (such as AVR) where the representation of a pointer and an address
4591 differs. */
4592
4593static CORE_ADDR
4595{
4596 unsigned len = type->length ();
4597 gdb_byte *buf = (gdb_byte *) alloca (len);
4598 CORE_ADDR addr;
4599
4600 addr = value->address ();
4601 gdbarch_address_to_pointer (type->arch (), type, buf, addr);
4602 addr = extract_unsigned_integer (buf, len, type_byte_order (type));
4603 return addr;
4604}
4605
4606
4607/* Push a descriptor of type TYPE for array value ARR on the stack at
4608 *SP, updating *SP to reflect the new descriptor. Return either
4609 an lvalue representing the new descriptor, or (if TYPE is a pointer-
4610 to-descriptor type rather than a descriptor type), a struct value *
4611 representing a pointer to this descriptor. */
4612
4613static struct value *
4614make_array_descriptor (struct type *type, struct value *arr)
4615{
4616 struct type *bounds_type = desc_bounds_type (type);
4617 struct type *desc_type = desc_base_type (type);
4618 struct value *descriptor = value::allocate (desc_type);
4619 struct value *bounds = value::allocate (bounds_type);
4620 int i;
4621
4622 for (i = ada_array_arity (ada_check_typedef (arr->type ()));
4623 i > 0; i -= 1)
4624 {
4625 modify_field (bounds->type (),
4626 bounds->contents_writeable ().data (),
4627 ada_array_bound (arr, i, 0),
4628 desc_bound_bitpos (bounds_type, i, 0),
4629 desc_bound_bitsize (bounds_type, i, 0));
4630 modify_field (bounds->type (),
4631 bounds->contents_writeable ().data (),
4632 ada_array_bound (arr, i, 1),
4633 desc_bound_bitpos (bounds_type, i, 1),
4634 desc_bound_bitsize (bounds_type, i, 1));
4635 }
4636
4637 bounds = ensure_lval (bounds);
4638
4639 modify_field (descriptor->type (),
4640 descriptor->contents_writeable ().data (),
4642 desc_type->field (0).type ()),
4643 fat_pntr_data_bitpos (desc_type),
4644 fat_pntr_data_bitsize (desc_type));
4645
4646 modify_field (descriptor->type (),
4647 descriptor->contents_writeable ().data (),
4648 value_pointer (bounds,
4649 desc_type->field (1).type ()),
4650 fat_pntr_bounds_bitpos (desc_type),
4651 fat_pntr_bounds_bitsize (desc_type));
4652
4653 descriptor = ensure_lval (descriptor);
4654
4655 if (type->code () == TYPE_CODE_PTR)
4656 return value_addr (descriptor);
4657 else
4658 return descriptor;
4659}
4660
4661 /* Symbol Cache Module */
4662
4663/* Performance measurements made as of 2010-01-15 indicate that
4664 this cache does bring some noticeable improvements. Depending
4665 on the type of entity being printed, the cache can make it as much
4666 as an order of magnitude faster than without it.
4667
4668 The descriptive type DWARF extension has significantly reduced
4669 the need for this cache, at least when DWARF is being used. However,
4670 even in this case, some expensive name-based symbol searches are still
4671 sometimes necessary - to find an XVZ variable, mostly. */
4672
4673/* Clear all entries from the symbol cache. */
4674
4675static void
4677{
4678 ada_pspace_data_handle.clear (pspace);
4679}
4680
4681/* Search the symbol cache for an entry matching NAME and DOMAIN.
4682 Return 1 if found, 0 otherwise.
4683
4684 If an entry was found and SYM is not NULL, set *SYM to the entry's
4685 SYM. Same principle for BLOCK if not NULL. */
4686
4687static int
4689 struct symbol **sym, const struct block **block)
4690{
4692 cache_entry_search search;
4693 search.name = name;
4694 search.domain = domain;
4695
4696 cache_entry *e = (cache_entry *) htab_find_with_hash (tab, &search,
4697 search.hash ());
4698 if (e == nullptr)
4699 return 0;
4700 if (sym != nullptr)
4701 *sym = e->sym;
4702 if (block != nullptr)
4703 *block = e->block;
4704 return 1;
4705}
4706
4707/* Assuming that (SYM, BLOCK) is the result of the lookup of NAME
4708 in domain DOMAIN, save this result in our symbol cache. */
4709
4710static void
4711cache_symbol (const char *name, domain_enum domain, struct symbol *sym,
4712 const struct block *block)
4713{
4714 /* Symbols for builtin types don't have a block.
4715 For now don't cache such symbols. */
4716 if (sym != NULL && !sym->is_objfile_owned ())
4717 return;
4718
4719 /* If the symbol is a local symbol, then do not cache it, as a search
4720 for that symbol depends on the context. To determine whether
4721 the symbol is local or not, we check the block where we found it
4722 against the global and static blocks of its associated symtab. */
4723 if (sym != nullptr)
4724 {
4725 const blockvector &bv = *sym->symtab ()->compunit ()->blockvector ();
4726
4727 if (bv.global_block () != block && bv.static_block () != block)
4728 return;
4729 }
4730
4732 cache_entry_search search;
4733 search.name = name;
4734 search.domain = domain;
4735
4736 void **slot = htab_find_slot_with_hash (tab, &search,
4737 search.hash (), INSERT);
4738
4739 cache_entry *e = new cache_entry;
4740 e->name = name;
4741 e->domain = domain;
4742 e->sym = sym;
4743 e->block = block;
4744
4745 *slot = e;
4746}
4747
4748 /* Symbol Lookup */
4749
4750/* Return the symbol name match type that should be used used when
4751 searching for all symbols matching LOOKUP_NAME.
4752
4753 LOOKUP_NAME is expected to be a symbol name after transformation
4754 for Ada lookups. */
4755
4757name_match_type_from_name (const char *lookup_name)
4758{
4759 return (strstr (lookup_name, "__") == NULL
4762}
4763
4764/* Return the result of a standard (literal, C-like) lookup of NAME in
4765 given DOMAIN, visible from lexical block BLOCK. */
4766
4767static struct symbol *
4768standard_lookup (const char *name, const struct block *block,
4770{
4771 /* Initialize it just to avoid a GCC false warning. */
4772 struct block_symbol sym = {};
4773
4774 if (lookup_cached_symbol (name, domain, &sym.symbol, NULL))
4775 return sym.symbol;
4776 ada_lookup_encoded_symbol (name, block, domain, &sym);
4777 cache_symbol (name, domain, sym.symbol, sym.block);
4778 return sym.symbol;
4779}
4780
4781
4782/* Non-zero iff there is at least one non-function/non-enumeral symbol
4783 in the symbol fields of SYMS. We treat enumerals as functions,
4784 since they contend in overloading in the same way. */
4785static int
4786is_nonfunction (const std::vector<struct block_symbol> &syms)
4787{
4788 for (const block_symbol &sym : syms)
4789 if (sym.symbol->type ()->code () != TYPE_CODE_FUNC
4790 && (sym.symbol->type ()->code () != TYPE_CODE_ENUM
4791 || sym.symbol->aclass () != LOC_CONST))
4792 return 1;
4793
4794 return 0;
4795}
4796
4797/* If true (non-zero), then TYPE0 and TYPE1 represent equivalent
4798 struct types. Otherwise, they may not. */
4799
4800static int
4801equiv_types (struct type *type0, struct type *type1)
4802{
4803 if (type0 == type1)
4804 return 1;
4805 if (type0 == NULL || type1 == NULL
4806 || type0->code () != type1->code ())
4807 return 0;
4808 if ((type0->code () == TYPE_CODE_STRUCT
4809 || type0->code () == TYPE_CODE_ENUM)
4810 && ada_type_name (type0) != NULL && ada_type_name (type1) != NULL
4811 && strcmp (ada_type_name (type0), ada_type_name (type1)) == 0)
4812 return 1;
4813
4814 return 0;
4815}
4816
4817/* True iff SYM0 represents the same entity as SYM1, or one that is
4818 no more defined than that of SYM1. */
4819
4820static int
4821lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
4822{
4823 if (sym0 == sym1)
4824 return 1;
4825 if (sym0->domain () != sym1->domain ()
4826 || sym0->aclass () != sym1->aclass ())
4827 return 0;
4828
4829 switch (sym0->aclass ())
4830 {
4831 case LOC_UNDEF:
4832 return 1;
4833 case LOC_TYPEDEF:
4834 {
4835 struct type *type0 = sym0->type ();
4836 struct type *type1 = sym1->type ();
4837 const char *name0 = sym0->linkage_name ();
4838 const char *name1 = sym1->linkage_name ();
4839 int len0 = strlen (name0);
4840
4841 return
4842 type0->code () == type1->code ()
4843 && (equiv_types (type0, type1)
4844 || (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
4845 && startswith (name1 + len0, "___XV")));
4846 }
4847 case LOC_CONST:
4848 return sym0->value_longest () == sym1->value_longest ()
4849 && equiv_types (sym0->type (), sym1->type ());
4850
4851 case LOC_STATIC:
4852 {
4853 const char *name0 = sym0->linkage_name ();
4854 const char *name1 = sym1->linkage_name ();
4855 return (strcmp (name0, name1) == 0
4856 && sym0->value_address () == sym1->value_address ());
4857 }
4858
4859 default:
4860 return 0;
4861 }
4862}
4863
4864/* Append (SYM,BLOCK) to the end of the array of struct block_symbol
4865 records in RESULT. Do nothing if SYM is a duplicate. */
4866
4867static void
4868add_defn_to_vec (std::vector<struct block_symbol> &result,
4869 struct symbol *sym,
4870 const struct block *block)
4871{
4872 /* Do not try to complete stub types, as the debugger is probably
4873 already scanning all symbols matching a certain name at the
4874 time when this function is called. Trying to replace the stub
4875 type by its associated full type will cause us to restart a scan
4876 which may lead to an infinite recursion. Instead, the client
4877 collecting the matching symbols will end up collecting several
4878 matches, with at least one of them complete. It can then filter
4879 out the stub ones if needed. */
4880
4881 for (int i = result.size () - 1; i >= 0; i -= 1)
4882 {
4883 if (lesseq_defined_than (sym, result[i].symbol))
4884 return;
4885 else if (lesseq_defined_than (result[i].symbol, sym))
4886 {
4887 result[i].symbol = sym;
4888 result[i].block = block;
4889 return;
4890 }
4891 }
4892
4893 struct block_symbol info;
4894 info.symbol = sym;
4895 info.block = block;
4896 result.push_back (info);
4897}
4898
4899/* Return a bound minimal symbol matching NAME according to Ada
4900 decoding rules. Returns an invalid symbol if there is no such
4901 minimal symbol. Names prefixed with "standard__" are handled
4902 specially: "standard__" is first stripped off, and only static and
4903 global symbols are searched. */
4904
4907{
4908 struct bound_minimal_symbol result;
4909
4911 lookup_name_info lookup_name (name, match_type);
4912
4913 symbol_name_matcher_ftype *match_name
4914 = ada_get_symbol_name_matcher (lookup_name);
4915
4917 (objfile != NULL ? objfile->arch () : target_gdbarch (),
4918 [&result, lookup_name, match_name] (struct objfile *obj)
4919 {
4920 for (minimal_symbol *msymbol : obj->msymbols ())
4921 {
4922 if (match_name (msymbol->linkage_name (), lookup_name, nullptr)
4923 && msymbol->type () != mst_solib_trampoline)
4924 {
4925 result.minsym = msymbol;
4926 result.objfile = obj;
4927 return 1;
4928 }
4929 }
4930
4931 return 0;
4932 }, objfile);
4933
4934 return result;
4935}
4936
4937/* True if TYPE is definitely an artificial type supplied to a symbol
4938 for which no debugging information was given in the symbol file. */
4939
4940static int
4942{
4943 const char *name = ada_type_name (type);
4944
4945 return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
4946}
4947
4948/* Return nonzero if TYPE1 and TYPE2 are two enumeration types
4949 that are deemed "identical" for practical purposes.
4950
4951 This function assumes that TYPE1 and TYPE2 are both TYPE_CODE_ENUM
4952 types and that their number of enumerals is identical (in other
4953 words, type1->num_fields () == type2->num_fields ()). */
4954
4955static int
4956ada_identical_enum_types_p (struct type *type1, struct type *type2)
4957{
4958 int i;
4959
4960 /* The heuristic we use here is fairly conservative. We consider
4961 that 2 enumerate types are identical if they have the same
4962 number of enumerals and that all enumerals have the same
4963 underlying value and name. */
4964
4965 /* All enums in the type should have an identical underlying value. */
4966 for (i = 0; i < type1->num_fields (); i++)
4967 if (type1->field (i).loc_enumval () != type2->field (i).loc_enumval ())
4968 return 0;
4969
4970 /* All enumerals should also have the same name (modulo any numerical
4971 suffix). */
4972 for (i = 0; i < type1->num_fields (); i++)
4973 {
4974 const char *name_1 = type1->field (i).name ();
4975 const char *name_2 = type2->field (i).name ();
4976 int len_1 = strlen (name_1);
4977 int len_2 = strlen (name_2);
4978
4979 ada_remove_trailing_digits (type1->field (i).name (), &len_1);
4980 ada_remove_trailing_digits (type2->field (i).name (), &len_2);
4981 if (len_1 != len_2
4982 || strncmp (type1->field (i).name (),
4983 type2->field (i).name (),
4984 len_1) != 0)
4985 return 0;
4986 }
4987
4988 return 1;
4989}
4990
4991/* Return nonzero if all the symbols in SYMS are all enumeral symbols
4992 that are deemed "identical" for practical purposes. Sometimes,
4993 enumerals are not strictly identical, but their types are so similar
4994 that they can be considered identical.
4995
4996 For instance, consider the following code:
4997
4998 type Color is (Black, Red, Green, Blue, White);
4999 type RGB_Color is new Color range Red .. Blue;
5000
5001 Type RGB_Color is a subrange of an implicit type which is a copy
5002 of type Color. If we call that implicit type RGB_ColorB ("B" is
5003 for "Base Type"), then type RGB_ColorB is a copy of type Color.
5004 As a result, when an expression references any of the enumeral
5005 by name (Eg. "print green"), the expression is technically
5006 ambiguous and the user should be asked to disambiguate. But
5007 doing so would only hinder the user, since it wouldn't matter
5008 what choice he makes, the outcome would always be the same.
5009 So, for practical purposes, we consider them as the same. */
5010
5011static int
5012symbols_are_identical_enums (const std::vector<struct block_symbol> &syms)
5013{
5014 int i;
5015
5016 /* Before performing a thorough comparison check of each type,
5017 we perform a series of inexpensive checks. We expect that these
5018 checks will quickly fail in the vast majority of cases, and thus
5019 help prevent the unnecessary use of a more expensive comparison.
5020 Said comparison also expects us to make some of these checks
5021 (see ada_identical_enum_types_p). */
5022
5023 /* Quick check: All symbols should have an enum type. */
5024 for (i = 0; i < syms.size (); i++)
5025 if (syms[i].symbol->type ()->code () != TYPE_CODE_ENUM)
5026 return 0;
5027
5028 /* Quick check: They should all have the same value. */
5029 for (i = 1; i < syms.size (); i++)
5030 if (syms[i].symbol->value_longest () != syms[0].symbol->value_longest ())
5031 return 0;
5032
5033 /* Quick check: They should all have the same number of enumerals. */
5034 for (i = 1; i < syms.size (); i++)
5035 if (syms[i].symbol->type ()->num_fields ()
5036 != syms[0].symbol->type ()->num_fields ())
5037 return 0;
5038
5039 /* All the sanity checks passed, so we might have a set of
5040 identical enumeration types. Perform a more complete
5041 comparison of the type of each symbol. */
5042 for (i = 1; i < syms.size (); i++)
5043 if (!ada_identical_enum_types_p (syms[i].symbol->type (),
5044 syms[0].symbol->type ()))
5045 return 0;
5046
5047 return 1;
5048}
5049
5050/* Remove any non-debugging symbols in SYMS that definitely
5051 duplicate other symbols in the list (The only case I know of where
5052 this happens is when object files containing stabs-in-ecoff are
5053 linked with files containing ordinary ecoff debugging symbols (or no
5054 debugging symbols)). Modifies SYMS to squeeze out deleted entries. */
5055
5056static void
5057remove_extra_symbols (std::vector<struct block_symbol> &syms)
5058{
5059 int i, j;
5060
5061 /* We should never be called with less than 2 symbols, as there
5062 cannot be any extra symbol in that case. But it's easy to
5063 handle, since we have nothing to do in that case. */
5064 if (syms.size () < 2)
5065 return;
5066
5067 i = 0;
5068 while (i < syms.size ())
5069 {
5070 bool remove_p = false;
5071
5072 /* If two symbols have the same name and one of them is a stub type,
5073 the get rid of the stub. */
5074
5075 if (syms[i].symbol->type ()->is_stub ()
5076 && syms[i].symbol->linkage_name () != NULL)
5077 {
5078 for (j = 0; !remove_p && j < syms.size (); j++)
5079 {
5080 if (j != i
5081 && !syms[j].symbol->type ()->is_stub ()
5082 && syms[j].symbol->linkage_name () != NULL
5083 && strcmp (syms[i].symbol->linkage_name (),
5084 syms[j].symbol->linkage_name ()) == 0)
5085 remove_p = true;
5086 }
5087 }
5088
5089 /* Two symbols with the same name, same class and same address
5090 should be identical. */
5091
5092 else if (syms[i].symbol->linkage_name () != NULL
5093 && syms[i].symbol->aclass () == LOC_STATIC
5094 && is_nondebugging_type (syms[i].symbol->type ()))
5095 {
5096 for (j = 0; !remove_p && j < syms.size (); j += 1)
5097 {
5098 if (i != j
5099 && syms[j].symbol->linkage_name () != NULL
5100 && strcmp (syms[i].symbol->linkage_name (),
5101 syms[j].symbol->linkage_name ()) == 0
5102 && (syms[i].symbol->aclass ()
5103 == syms[j].symbol->aclass ())
5104 && syms[i].symbol->value_address ()
5105 == syms[j].symbol->value_address ())
5106 remove_p = true;
5107 }
5108 }
5109
5110 /* Two functions with the same block are identical. */
5111
5112 else if (syms[i].symbol->aclass () == LOC_BLOCK)
5113 {
5114 for (j = 0; !remove_p && j < syms.size (); j += 1)
5115 {
5116 if (i != j
5117 && syms[j].symbol->aclass () == LOC_BLOCK
5118 && (syms[i].symbol->value_block ()
5119 == syms[j].symbol->value_block ()))
5120 remove_p = true;
5121 }
5122 }
5123
5124 if (remove_p)
5125 syms.erase (syms.begin () + i);
5126 else
5127 i += 1;
5128 }
5129}
5130
5131/* Given a type that corresponds to a renaming entity, use the type name
5132 to extract the scope (package name or function name, fully qualified,
5133 and following the GNAT encoding convention) where this renaming has been
5134 defined. */
5135
5136static std::string
5137xget_renaming_scope (struct type *renaming_type)
5138{
5139 /* The renaming types adhere to the following convention:
5140 <scope>__<rename>___<XR extension>.
5141 So, to extract the scope, we search for the "___XR" extension,
5142 and then backtrack until we find the first "__". */
5143
5144 const char *name = renaming_type->name ();
5145 const char *suffix = strstr (name, "___XR");
5146 const char *last;
5147
5148 /* Now, backtrack a bit until we find the first "__". Start looking
5149 at suffix - 3, as the <rename> part is at least one character long. */
5150
5151 for (last = suffix - 3; last > name; last--)
5152 if (last[0] == '_' && last[1] == '_')
5153 break;
5154
5155 /* Make a copy of scope and return it. */
5156 return std::string (name, last);
5157}
5158
5159/* Return nonzero if NAME corresponds to a package name. */
5160
5161static int
5163{
5164 /* Here, We take advantage of the fact that no symbols are generated
5165 for packages, while symbols are generated for each function.
5166 So the condition for NAME represent a package becomes equivalent
5167 to NAME not existing in our list of symbols. There is only one
5168 small complication with library-level functions (see below). */
5169
5170 /* If it is a function that has not been defined at library level,
5171 then we should be able to look it up in the symbols. */
5172 if (standard_lookup (name, NULL, VAR_DOMAIN) != NULL)
5173 return 0;
5174
5175 /* Library-level function names start with "_ada_". See if function
5176 "_ada_" followed by NAME can be found. */
5177
5178 /* Do a quick check that NAME does not contain "__", since library-level
5179 functions names cannot contain "__" in them. */
5180 if (strstr (name, "__") != NULL)
5181 return 0;
5182
5183 std::string fun_name = string_printf ("_ada_%s", name);
5184
5185 return (standard_lookup (fun_name.c_str (), NULL, VAR_DOMAIN) == NULL);
5186}
5187
5188/* Return nonzero if SYM corresponds to a renaming entity that is
5189 not visible from FUNCTION_NAME. */
5190
5191static int
5192old_renaming_is_invisible (const struct symbol *sym, const char *function_name)
5193{
5194 if (sym->aclass () != LOC_TYPEDEF)
5195 return 0;
5196
5197 std::string scope = xget_renaming_scope (sym->type ());
5198
5199 /* If the rename has been defined in a package, then it is visible. */
5200 if (is_package_name (scope.c_str ()))
5201 return 0;
5202
5203 /* Check that the rename is in the current function scope by checking
5204 that its name starts with SCOPE. */
5205
5206 /* If the function name starts with "_ada_", it means that it is
5207 a library-level function. Strip this prefix before doing the
5208 comparison, as the encoding for the renaming does not contain
5209 this prefix. */
5210 if (startswith (function_name, "_ada_"))
5211 function_name += 5;
5212
5213 return !startswith (function_name, scope.c_str ());
5214}
5215
5216/* Remove entries from SYMS that corresponds to a renaming entity that
5217 is not visible from the function associated with CURRENT_BLOCK or
5218 that is superfluous due to the presence of more specific renaming
5219 information. Places surviving symbols in the initial entries of
5220 SYMS.
5221
5222 Rationale:
5223 First, in cases where an object renaming is implemented as a
5224 reference variable, GNAT may produce both the actual reference
5225 variable and the renaming encoding. In this case, we discard the
5226 latter.
5227
5228 Second, GNAT emits a type following a specified encoding for each renaming
5229 entity. Unfortunately, STABS currently does not support the definition
5230 of types that are local to a given lexical block, so all renamings types
5231 are emitted at library level. As a consequence, if an application
5232 contains two renaming entities using the same name, and a user tries to
5233 print the value of one of these entities, the result of the ada symbol
5234 lookup will also contain the wrong renaming type.
5235
5236 This function partially covers for this limitation by attempting to
5237 remove from the SYMS list renaming symbols that should be visible
5238 from CURRENT_BLOCK. However, there does not seem be a 100% reliable
5239 method with the current information available. The implementation
5240 below has a couple of limitations (FIXME: brobecker-2003-05-12):
5241
5242 - When the user tries to print a rename in a function while there
5243 is another rename entity defined in a package: Normally, the
5244 rename in the function has precedence over the rename in the
5245 package, so the latter should be removed from the list. This is
5246 currently not the case.
5247
5248 - This function will incorrectly remove valid renames if
5249 the CURRENT_BLOCK corresponds to a function which symbol name
5250 has been changed by an "Export" pragma. As a consequence,
5251 the user will be unable to print such rename entities. */
5252
5253static void
5254remove_irrelevant_renamings (std::vector<struct block_symbol> *syms,
5255 const struct block *current_block)
5256{
5257 struct symbol *current_function;
5258 const char *current_function_name;
5259 int i;
5260 int is_new_style_renaming;
5261
5262 /* If there is both a renaming foo___XR... encoded as a variable and
5263 a simple variable foo in the same block, discard the latter.
5264 First, zero out such symbols, then compress. */
5265 is_new_style_renaming = 0;
5266 for (i = 0; i < syms->size (); i += 1)
5267 {
5268 struct symbol *sym = (*syms)[i].symbol;
5269 const struct block *block = (*syms)[i].block;
5270 const char *name;
5271 const char *suffix;
5272
5273 if (sym == NULL || sym->aclass () == LOC_TYPEDEF)
5274 continue;
5275 name = sym->linkage_name ();
5276 suffix = strstr (name, "___XR");
5277
5278 if (suffix != NULL)
5279 {
5280 int name_len = suffix - name;
5281 int j;
5282
5283 is_new_style_renaming = 1;
5284 for (j = 0; j < syms->size (); j += 1)
5285 if (i != j && (*syms)[j].symbol != NULL
5286 && strncmp (name, (*syms)[j].symbol->linkage_name (),
5287 name_len) == 0
5288 && block == (*syms)[j].block)
5289 (*syms)[j].symbol = NULL;
5290 }
5291 }
5292 if (is_new_style_renaming)
5293 {
5294 int j, k;
5295
5296 for (j = k = 0; j < syms->size (); j += 1)
5297 if ((*syms)[j].symbol != NULL)
5298 {
5299 (*syms)[k] = (*syms)[j];
5300 k += 1;
5301 }
5302 syms->resize (k);
5303 return;
5304 }
5305
5306 /* Extract the function name associated to CURRENT_BLOCK.
5307 Abort if unable to do so. */
5308
5309 if (current_block == NULL)
5310 return;
5311
5312 current_function = current_block->linkage_function ();
5313 if (current_function == NULL)
5314 return;
5315
5316 current_function_name = current_function->linkage_name ();
5317 if (current_function_name == NULL)
5318 return;
5319
5320 /* Check each of the symbols, and remove it from the list if it is
5321 a type corresponding to a renaming that is out of the scope of
5322 the current block. */
5323
5324 i = 0;
5325 while (i < syms->size ())
5326 {
5327 if (ada_parse_renaming ((*syms)[i].symbol, NULL, NULL, NULL)
5329 && old_renaming_is_invisible ((*syms)[i].symbol,
5330 current_function_name))
5331 syms->erase (syms->begin () + i);
5332 else
5333 i += 1;
5334 }
5335}
5336
5337/* Add to RESULT all symbols from BLOCK (and its super-blocks)
5338 whose name and domain match LOOKUP_NAME and DOMAIN respectively.
5339
5340 Note: This function assumes that RESULT is empty. */
5341
5342static void
5343ada_add_local_symbols (std::vector<struct block_symbol> &result,
5344 const lookup_name_info &lookup_name,
5345 const struct block *block, domain_enum domain)
5346{
5347 while (block != NULL)
5348 {
5349 ada_add_block_symbols (result, block, lookup_name, domain, NULL);
5350
5351 /* If we found a non-function match, assume that's the one. We
5352 only check this when finding a function boundary, so that we
5353 can accumulate all results from intervening blocks first. */
5354 if (block->function () != nullptr && is_nonfunction (result))
5355 return;
5356
5357 block = block->superblock ();
5358 }
5359}
5360
5361/* An object of this type is used as the callback argument when
5362 calling the map_matching_symbols method. */
5363
5365{
5366 explicit match_data (std::vector<struct block_symbol> *rp)
5367 : resultp (rp)
5368 {
5369 }
5371
5372 bool operator() (struct block_symbol *bsym);
5373
5374 struct objfile *objfile = nullptr;
5375 std::vector<struct block_symbol> *resultp;
5376 struct symbol *arg_sym = nullptr;
5377 bool found_sym = false;
5378};
5379
5380/* A callback for add_nonlocal_symbols that adds symbol, found in
5381 BSYM, to a list of symbols. */
5382
5383bool
5385{
5386 const struct block *block = bsym->block;
5387 struct symbol *sym = bsym->symbol;
5388
5389 if (sym == NULL)
5390 {
5391 if (!found_sym && arg_sym != NULL)
5393 found_sym = false;
5394 arg_sym = NULL;
5395 }
5396 else
5397 {
5398 if (sym->aclass () == LOC_UNRESOLVED)
5399 return true;
5400 else if (sym->is_argument ())
5401 arg_sym = sym;
5402 else
5403 {
5404 found_sym = true;
5405 add_defn_to_vec (*resultp, sym, block);
5406 }
5407 }
5408 return true;
5409}
5410
5411/* Helper for add_nonlocal_symbols. Find symbols in DOMAIN which are
5412 targeted by renamings matching LOOKUP_NAME in BLOCK. Add these
5413 symbols to RESULT. Return whether we found such symbols. */
5414
5415static int
5416ada_add_block_renamings (std::vector<struct block_symbol> &result,
5417 const struct block *block,
5418 const lookup_name_info &lookup_name,
5420{
5421 struct using_direct *renaming;
5422 int defns_mark = result.size ();
5423
5424 symbol_name_matcher_ftype *name_match
5425 = ada_get_symbol_name_matcher (lookup_name);
5426
5427 for (renaming = block->get_using ();
5428 renaming != NULL;
5429 renaming = renaming->next)
5430 {
5431 const char *r_name;
5432
5433 /* Avoid infinite recursions: skip this renaming if we are actually
5434 already traversing it.
5435
5436 Currently, symbol lookup in Ada don't use the namespace machinery from
5437 C++/Fortran support: skip namespace imports that use them. */
5438 if (renaming->searched
5439 || (renaming->import_src != NULL
5440 && renaming->import_src[0] != '\0')
5441 || (renaming->import_dest != NULL
5442 && renaming->import_dest[0] != '\0'))
5443 continue;
5444 renaming->searched = 1;
5445
5446 /* TODO: here, we perform another name-based symbol lookup, which can
5447 pull its own multiple overloads. In theory, we should be able to do
5448 better in this case since, in DWARF, DW_AT_import is a DIE reference,
5449 not a simple name. But in order to do this, we would need to enhance
5450 the DWARF reader to associate a symbol to this renaming, instead of a
5451 name. So, for now, we do something simpler: re-use the C++/Fortran
5452 namespace machinery. */
5453 r_name = (renaming->alias != NULL
5454 ? renaming->alias
5455 : renaming->declaration);
5456 if (name_match (r_name, lookup_name, NULL))
5457 {
5458 lookup_name_info decl_lookup_name (renaming->declaration,
5459 lookup_name.match_type ());
5460 ada_add_all_symbols (result, block, decl_lookup_name, domain,
5461 1, NULL);
5462 }
5463 renaming->searched = 0;
5464 }
5465 return result.size () != defns_mark;
5466}
5467
5468/* Implements compare_names, but only applying the comparision using
5469 the given CASING. */
5470
5471static int
5472compare_names_with_case (const char *string1, const char *string2,
5473 enum case_sensitivity casing)
5474{
5475 while (*string1 != '\0' && *string2 != '\0')
5476 {
5477 char c1, c2;
5478
5479 if (isspace (*string1) || isspace (*string2))
5480 return strcmp_iw_ordered (string1, string2);
5481
5482 if (casing == case_sensitive_off)
5483 {
5484 c1 = tolower (*string1);
5485 c2 = tolower (*string2);
5486 }
5487 else
5488 {
5489 c1 = *string1;
5490 c2 = *string2;
5491 }
5492 if (c1 != c2)
5493 break;
5494
5495 string1 += 1;
5496 string2 += 1;
5497 }
5498
5499 switch (*string1)
5500 {
5501 case '(':
5502 return strcmp_iw_ordered (string1, string2);
5503 case '_':
5504 if (*string2 == '\0')
5505 {
5506 if (is_name_suffix (string1))
5507 return 0;
5508 else
5509 return 1;
5510 }
5511 /* FALLTHROUGH */
5512 default:
5513 if (*string2 == '(')
5514 return strcmp_iw_ordered (string1, string2);
5515 else
5516 {
5517 if (casing == case_sensitive_off)
5518 return tolower (*string1) - tolower (*string2);
5519 else
5520 return *string1 - *string2;
5521 }
5522 }
5523}
5524
5525/* Compare STRING1 to STRING2, with results as for strcmp.
5526 Compatible with strcmp_iw_ordered in that...
5527
5528 strcmp_iw_ordered (STRING1, STRING2) <= 0
5529
5530 ... implies...
5531
5532 compare_names (STRING1, STRING2) <= 0
5533
5534 (they may differ as to what symbols compare equal). */
5535
5536static int
5537compare_names (const char *string1, const char *string2)
5538{
5539 int result;
5540
5541 /* Similar to what strcmp_iw_ordered does, we need to perform
5542 a case-insensitive comparison first, and only resort to
5543 a second, case-sensitive, comparison if the first one was
5544 not sufficient to differentiate the two strings. */
5545
5546 result = compare_names_with_case (string1, string2, case_sensitive_off);
5547 if (result == 0)
5548 result = compare_names_with_case (string1, string2, case_sensitive_on);
5549
5550 return result;
5551}
5552
5553/* Convenience function to get at the Ada encoded lookup name for
5554 LOOKUP_NAME, as a C string. */
5555
5556static const char *
5558{
5559 return lookup_name.ada ().lookup_name ().c_str ();
5560}
5561
5562/* A helper for add_nonlocal_symbols. Call expand_matching_symbols
5563 for OBJFILE, then walk the objfile's symtabs and update the
5564 results. */
5565
5566static void
5568 const lookup_name_info &lookup_name,
5569 bool is_wild_match,
5570 domain_enum domain,
5571 int global,
5572 match_data &data)
5573{
5574 data.objfile = objfile;
5575 objfile->expand_matching_symbols (lookup_name, domain, global,
5576 is_wild_match ? nullptr : compare_names);
5577
5578 const int block_kind = global ? GLOBAL_BLOCK : STATIC_BLOCK;
5580 {
5581 const struct block *block
5582 = symtab->blockvector ()->block (block_kind);
5583 if (!iterate_over_symbols_terminated (block, lookup_name,
5584 domain, data))
5585 break;
5586 }
5587}
5588
5589/* Add to RESULT all non-local symbols whose name and domain match
5590 LOOKUP_NAME and DOMAIN respectively. The search is performed on
5591 GLOBAL_BLOCK symbols if GLOBAL is non-zero, or on STATIC_BLOCK
5592 symbols otherwise. */
5593
5594static void
5595add_nonlocal_symbols (std::vector<struct block_symbol> &result,
5596 const lookup_name_info &lookup_name,
5597 domain_enum domain, int global)
5598{
5599 struct match_data data (&result);
5600
5601 bool is_wild_match = lookup_name.ada ().wild_match_p ();
5602
5604 {
5605 map_matching_symbols (objfile, lookup_name, is_wild_match, domain,
5606 global, data);
5607
5608 for (compunit_symtab *cu : objfile->compunits ())
5609 {
5610 const struct block *global_block
5611 = cu->blockvector ()->global_block ();
5612
5613 if (ada_add_block_renamings (result, global_block, lookup_name,
5614 domain))
5615 data.found_sym = true;
5616 }
5617 }
5618
5619 if (result.empty () && global && !is_wild_match)
5620 {
5621 const char *name = ada_lookup_name (lookup_name);
5622 std::string bracket_name = std::string ("<_ada_") + name + '>';
5623 lookup_name_info name1 (bracket_name, symbol_name_match_type::FULL);
5624
5626 map_matching_symbols (objfile, name1, false, domain, global, data);
5627 }
5628}
5629
5630/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if
5631 FULL_SEARCH is non-zero, enclosing scope and in global scopes,
5632 returning the number of matches. Add these to RESULT.
5633
5634 When FULL_SEARCH is non-zero, any non-function/non-enumeral
5635 symbol match within the nest of blocks whose innermost member is BLOCK,
5636 is the one match returned (no other matches in that or
5637 enclosing blocks is returned). If there are any matches in or
5638 surrounding BLOCK, then these alone are returned.
5639
5640 Names prefixed with "standard__" are handled specially:
5641 "standard__" is first stripped off (by the lookup_name
5642 constructor), and only static and global symbols are searched.
5643
5644 If MADE_GLOBAL_LOOKUP_P is non-null, set it before return to whether we had
5645 to lookup global symbols. */
5646
5647static void
5648ada_add_all_symbols (std::vector<struct block_symbol> &result,
5649 const struct block *block,
5650 const lookup_name_info &lookup_name,
5651 domain_enum domain,
5652 int full_search,
5653 int *made_global_lookup_p)
5654{
5655 struct symbol *sym;
5656
5657 if (made_global_lookup_p)
5658 *made_global_lookup_p = 0;
5659
5660 /* Special case: If the user specifies a symbol name inside package
5661 Standard, do a non-wild matching of the symbol name without
5662 the "standard__" prefix. This was primarily introduced in order
5663 to allow the user to specifically access the standard exceptions
5664 using, for instance, Standard.Constraint_Error when Constraint_Error
5665 is ambiguous (due to the user defining its own Constraint_Error
5666 entity inside its program). */
5667 if (lookup_name.ada ().standard_p ())
5668 block = NULL;
5669
5670 /* Check the non-global symbols. If we have ANY match, then we're done. */
5671
5672 if (block != NULL)
5673 {
5674 if (full_search)
5675 ada_add_local_symbols (result, lookup_name, block, domain);
5676 else
5677 {
5678 /* In the !full_search case we're are being called by
5679 iterate_over_symbols, and we don't want to search
5680 superblocks. */
5681 ada_add_block_symbols (result, block, lookup_name, domain, NULL);
5682 }
5683 if (!result.empty () || !full_search)
5684 return;
5685 }
5686
5687 /* No non-global symbols found. Check our cache to see if we have
5688 already performed this search before. If we have, then return
5689 the same result. */
5690
5691 if (lookup_cached_symbol (ada_lookup_name (lookup_name),
5692 domain, &sym, &block))
5693 {
5694 if (sym != NULL)
5695 add_defn_to_vec (result, sym, block);
5696 return;
5697 }
5698
5699 if (made_global_lookup_p)
5700 *made_global_lookup_p = 1;
5701
5702 /* Search symbols from all global blocks. */
5703
5704 add_nonlocal_symbols (result, lookup_name, domain, 1);
5705
5706 /* Now add symbols from all per-file blocks if we've gotten no hits
5707 (not strictly correct, but perhaps better than an error). */
5708
5709 if (result.empty ())
5710 add_nonlocal_symbols (result, lookup_name, domain, 0);
5711}
5712
5713/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if FULL_SEARCH
5714 is non-zero, enclosing scope and in global scopes.
5715
5716 Returns (SYM,BLOCK) tuples, indicating the symbols found and the
5717 blocks and symbol tables (if any) in which they were found.
5718
5719 When full_search is non-zero, any non-function/non-enumeral
5720 symbol match within the nest of blocks whose innermost member is BLOCK,
5721 is the one match returned (no other matches in that or
5722 enclosing blocks is returned). If there are any matches in or
5723 surrounding BLOCK, then these alone are returned.
5724
5725 Names prefixed with "standard__" are handled specially: "standard__"
5726 is first stripped off, and only static and global symbols are searched. */
5727
5728static std::vector<struct block_symbol>
5730 const struct block *block,
5732 int full_search)
5733{
5734 int syms_from_global_search;
5735 std::vector<struct block_symbol> results;
5736
5737 ada_add_all_symbols (results, block, lookup_name,
5738 domain, full_search, &syms_from_global_search);
5739
5740 remove_extra_symbols (results);
5741
5742 if (results.empty () && full_search && syms_from_global_search)
5743 cache_symbol (ada_lookup_name (lookup_name), domain, NULL, NULL);
5744
5745 if (results.size () == 1 && full_search && syms_from_global_search)
5746 cache_symbol (ada_lookup_name (lookup_name), domain,
5747 results[0].symbol, results[0].block);
5748
5750 return results;
5751}
5752
5753/* Find symbols in DOMAIN matching NAME, in BLOCK and enclosing scope and
5754 in global scopes, returning (SYM,BLOCK) tuples.
5755
5756 See ada_lookup_symbol_list_worker for further details. */
5757
5758std::vector<struct block_symbol>
5759ada_lookup_symbol_list (const char *name, const struct block *block,
5761{
5763 lookup_name_info lookup_name (name, name_match_type);
5764
5765 return ada_lookup_symbol_list_worker (lookup_name, block, domain, 1);
5766}
5767
5768/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
5769 to 1, but choosing the first symbol found if there are multiple
5770 choices.
5771
5772 The result is stored in *INFO, which must be non-NULL.
5773 If no match is found, INFO->SYM is set to NULL. */
5774
5775void
5776ada_lookup_encoded_symbol (const char *name, const struct block *block,
5778 struct block_symbol *info)
5779{
5780 /* Since we already have an encoded name, wrap it in '<>' to force a
5781 verbatim match. Otherwise, if the name happens to not look like
5782 an encoded name (because it doesn't include a "__"),
5783 ada_lookup_name_info would re-encode/fold it again, and that
5784 would e.g., incorrectly lowercase object renaming names like
5785 "R28b" -> "r28b". */
5786 std::string verbatim = add_angle_brackets (name);
5787
5788 gdb_assert (info != NULL);
5789 *info = ada_lookup_symbol (verbatim.c_str (), block, domain);
5790}
5791
5792/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
5793 scope and in global scopes, or NULL if none. NAME is folded and
5794 encoded first. Otherwise, the result is as for ada_lookup_symbol_list,
5795 choosing the first symbol if there are multiple choices. */
5796
5797struct block_symbol
5798ada_lookup_symbol (const char *name, const struct block *block0,
5799 domain_enum domain)
5800{
5801 std::vector<struct block_symbol> candidates
5802 = ada_lookup_symbol_list (name, block0, domain);
5803
5804 if (candidates.empty ())
5805 return {};
5806
5807 return candidates[0];
5808}
5809
5810
5811/* True iff STR is a possible encoded suffix of a normal Ada name
5812 that is to be ignored for matching purposes. Suffixes of parallel
5813 names (e.g., XVE) are not included here. Currently, the possible suffixes
5814 are given by any of the regular expressions:
5815
5816 [.$][0-9]+ [nested subprogram suffix, on platforms such as GNU/Linux]
5817 ___[0-9]+ [nested subprogram suffix, on platforms such as HP/UX]
5818 TKB [subprogram suffix for task bodies]
5819 _E[0-9]+[bs]$ [protected object entry suffixes]
5820 (X[nb]*)?((\$|__)[0-9](_?[0-9]+)|___(JM|LJM|X([FDBUP].*|R[^T]?)))?$
5821
5822 Also, any leading "__[0-9]+" sequence is skipped before the suffix
5823 match is performed. This sequence is used to differentiate homonyms,
5824 is an optional part of a valid name suffix. */
5825
5826static int
5827is_name_suffix (const char *str)
5828{
5829 int k;
5830 const char *matching;
5831 const int len = strlen (str);
5832
5833 /* Skip optional leading __[0-9]+. */
5834
5835 if (len > 3 && str[0] == '_' && str[1] == '_' && isdigit (str[2]))
5836 {
5837 str += 3;
5838 while (isdigit (str[0]))
5839 str += 1;
5840 }
5841
5842 /* [.$][0-9]+ */
5843
5844 if (str[0] == '.' || str[0] == '$')
5845 {
5846 matching = str + 1;
5847 while (isdigit (matching[0]))
5848 matching += 1;
5849 if (matching[0] == '\0')
5850 return 1;
5851 }
5852
5853 /* ___[0-9]+ */
5854
5855 if (len > 3 && str[0] == '_' && str[1] == '_' && str[2] == '_')
5856 {
5857 matching = str + 3;
5858 while (isdigit (matching[0]))
5859 matching += 1;
5860 if (matching[0] == '\0')
5861 return 1;
5862 }
5863
5864 /* "TKB" suffixes are used for subprograms implementing task bodies. */
5865
5866 if (strcmp (str, "TKB") == 0)
5867 return 1;
5868
5869#if 0
5870 /* FIXME: brobecker/2005-09-23: Protected Object subprograms end
5871 with a N at the end. Unfortunately, the compiler uses the same
5872 convention for other internal types it creates. So treating
5873 all entity names that end with an "N" as a name suffix causes
5874 some regressions. For instance, consider the case of an enumerated
5875 type. To support the 'Image attribute, it creates an array whose
5876 name ends with N.
5877 Having a single character like this as a suffix carrying some
5878 information is a bit risky. Perhaps we should change the encoding
5879 to be something like "_N" instead. In the meantime, do not do
5880 the following check. */
5881 /* Protected Object Subprograms */
5882 if (len == 1 && str [0] == 'N')
5883 return 1;
5884#endif
5885
5886 /* _E[0-9]+[bs]$ */
5887 if (len > 3 && str[0] == '_' && str [1] == 'E' && isdigit (str[2]))
5888 {
5889 matching = str + 3;
5890 while (isdigit (matching[0]))
5891 matching += 1;
5892 if ((matching[0] == 'b' || matching[0] == 's')
5893 && matching [1] == '\0')
5894 return 1;
5895 }
5896
5897 /* ??? We should not modify STR directly, as we are doing below. This
5898 is fine in this case, but may become problematic later if we find
5899 that this alternative did not work, and want to try matching
5900 another one from the begining of STR. Since we modified it, we
5901 won't be able to find the begining of the string anymore! */
5902 if (str[0] == 'X')
5903 {
5904 str += 1;
5905 while (str[0] != '_' && str[0] != '\0')
5906 {
5907 if (str[0] != 'n' && str[0] != 'b')
5908 return 0;
5909 str += 1;
5910 }
5911 }
5912
5913 if (str[0] == '\000')
5914 return 1;
5915
5916 if (str[0] == '_')
5917 {
5918 if (str[1] != '_' || str[2] == '\000')
5919 return 0;
5920 if (str[2] == '_')
5921 {
5922 if (strcmp (str + 3, "JM") == 0)
5923 return 1;
5924 /* FIXME: brobecker/2004-09-30: GNAT will soon stop using
5925 the LJM suffix in favor of the JM one. But we will
5926 still accept LJM as a valid suffix for a reasonable
5927 amount of time, just to allow ourselves to debug programs
5928 compiled using an older version of GNAT. */
5929 if (strcmp (str + 3, "LJM") == 0)
5930 return 1;
5931 if (str[3] != 'X')
5932 return 0;
5933 if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B'
5934 || str[4] == 'U' || str[4] == 'P')
5935 return 1;
5936 if (str[4] == 'R' && str[5] != 'T')
5937 return 1;
5938 return 0;
5939 }
5940 if (!isdigit (str[2]))
5941 return 0;
5942 for (k = 3; str[k] != '\0'; k += 1)
5943 if (!isdigit (str[k]) && str[k] != '_')
5944 return 0;
5945 return 1;
5946 }
5947 if (str[0] == '$' && isdigit (str[1]))
5948 {
5949 for (k = 2; str[k] != '\0'; k += 1)
5950 if (!isdigit (str[k]) && str[k] != '_')
5951 return 0;
5952 return 1;
5953 }
5954 return 0;
5955}
5956
5957/* Return non-zero if the string starting at NAME and ending before
5958 NAME_END contains no capital letters. */
5959
5960static int
5962{
5963 std::string decoded_name = ada_decode (name0);
5964 int i;
5965
5966 /* If the decoded name starts with an angle bracket, it means that
5967 NAME0 does not follow the GNAT encoding format. It should then
5968 not be allowed as a possible wild match. */
5969 if (decoded_name[0] == '<')
5970 return 0;
5971
5972 for (i=0; decoded_name[i] != '\0'; i++)
5973 if (isalpha (decoded_name[i]) && !islower (decoded_name[i]))
5974 return 0;
5975
5976 return 1;
5977}
5978
5979/* Advance *NAMEP to next occurrence in the string NAME0 of the TARGET0
5980 character which could start a simple name. Assumes that *NAMEP points
5981 somewhere inside the string beginning at NAME0. */
5982
5983static int
5984advance_wild_match (const char **namep, const char *name0, char target0)
5985{
5986 const char *name = *namep;
5987
5988 while (1)
5989 {
5990 char t0, t1;
5991
5992 t0 = *name;
5993 if (t0 == '_')
5994 {
5995 t1 = name[1];
5996 if ((t1 >= 'a' && t1 <= 'z') || (t1 >= '0' && t1 <= '9'))
5997 {
5998 name += 1;
5999 if (name == name0 + 5 && startswith (name0, "_ada"))
6000 break;
6001 else
6002 name += 1;
6003 }
6004 else if (t1 == '_' && ((name[2] >= 'a' && name[2] <= 'z')
6005 || name[2] == target0))
6006 {
6007 name += 2;
6008 break;
6009 }
6010 else if (t1 == '_' && name[2] == 'B' && name[3] == '_')
6011 {
6012 /* Names like "pkg__B_N__name", where N is a number, are
6013 block-local. We can handle these by simply skipping
6014 the "B_" here. */
6015 name += 4;
6016 }
6017 else
6018 return 0;
6019 }
6020 else if ((t0 >= 'a' && t0 <= 'z') || (t0 >= '0' && t0 <= '9'))
6021 name += 1;
6022 else
6023 return 0;
6024 }
6025
6026 *namep = name;
6027 return 1;
6028}
6029
6030/* Return true iff NAME encodes a name of the form prefix.PATN.
6031 Ignores any informational suffixes of NAME (i.e., for which
6032 is_name_suffix is true). Assumes that PATN is a lower-cased Ada
6033 simple name. */
6034
6035static bool
6036wild_match (const char *name, const char *patn)
6037{
6038 const char *p;
6039 const char *name0 = name;
6040
6041 if (startswith (name, "___ghost_"))
6042 name += 9;
6043
6044 while (1)
6045 {
6046 const char *match = name;
6047
6048 if (*name == *patn)
6049 {
6050 for (name += 1, p = patn + 1; *p != '\0'; name += 1, p += 1)
6051 if (*p != *name)
6052 break;
6053 if (*p == '\0' && is_name_suffix (name))
6054 return match == name0 || is_valid_name_for_wild_match (name0);
6055
6056 if (name[-1] == '_')
6057 name -= 1;
6058 }
6059 if (!advance_wild_match (&name, name0, *patn))
6060 return false;
6061 }
6062}
6063
6064/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to RESULT (if
6065 necessary). OBJFILE is the section containing BLOCK. */
6066
6067static void
6068ada_add_block_symbols (std::vector<struct block_symbol> &result,
6069 const struct block *block,
6070 const lookup_name_info &lookup_name,
6071 domain_enum domain, struct objfile *objfile)
6072{
6073 /* A matching argument symbol, if any. */
6074 struct symbol *arg_sym;
6075 /* Set true when we find a matching non-argument symbol. */
6076 bool found_sym;
6077
6078 arg_sym = NULL;
6079 found_sym = false;
6080 for (struct symbol *sym : block_iterator_range (block, &lookup_name))
6081 {
6082 if (sym->matches (domain))
6083 {
6084 if (sym->aclass () != LOC_UNRESOLVED)
6085 {
6086 if (sym->is_argument ())
6087 arg_sym = sym;
6088 else
6089 {
6090 found_sym = true;
6091 add_defn_to_vec (result, sym, block);
6092 }
6093 }
6094 }
6095 }
6096
6097 /* Handle renamings. */
6098
6099 if (ada_add_block_renamings (result, block, lookup_name, domain))
6100 found_sym = true;
6101
6102 if (!found_sym && arg_sym != NULL)
6103 {
6104 add_defn_to_vec (result, arg_sym, block);
6105 }
6106
6107 if (!lookup_name.ada ().wild_match_p ())
6108 {
6109 arg_sym = NULL;
6110 found_sym = false;
6111 const std::string &ada_lookup_name = lookup_name.ada ().lookup_name ();
6112 const char *name = ada_lookup_name.c_str ();
6113 size_t name_len = ada_lookup_name.size ();
6114
6115 for (struct symbol *sym : block_iterator_range (block))
6116 {
6117 if (sym->matches (domain))
6118 {
6119 int cmp;
6120
6121 cmp = (int) '_' - (int) sym->linkage_name ()[0];
6122 if (cmp == 0)
6123 {
6124 cmp = !startswith (sym->linkage_name (), "_ada_");
6125 if (cmp == 0)
6126 cmp = strncmp (name, sym->linkage_name () + 5,
6127 name_len);
6128 }
6129
6130 if (cmp == 0
6131 && is_name_suffix (sym->linkage_name () + name_len + 5))
6132 {
6133 if (sym->aclass () != LOC_UNRESOLVED)
6134 {
6135 if (sym->is_argument ())
6136 arg_sym = sym;
6137 else
6138 {
6139 found_sym = true;
6140 add_defn_to_vec (result, sym, block);
6141 }
6142 }
6143 }
6144 }
6145 }
6146
6147 /* NOTE: This really shouldn't be needed for _ada_ symbols.
6148 They aren't parameters, right? */
6149 if (!found_sym && arg_sym != NULL)
6150 {
6151 add_defn_to_vec (result, arg_sym, block);
6152 }
6153 }
6154}
6155
6156
6157 /* Symbol Completion */
6158
6159/* See symtab.h. */
6160
6161bool
6163 (const char *sym_name,
6164 symbol_name_match_type match_type,
6165 completion_match_result *comp_match_res) const
6166{
6167 bool match = false;
6168 const char *text = m_encoded_name.c_str ();
6169 size_t text_len = m_encoded_name.size ();
6170
6171 /* First, test against the fully qualified name of the symbol. */
6172
6173 if (strncmp (sym_name, text, text_len) == 0)
6174 match = true;
6175
6176 std::string decoded_name = ada_decode (sym_name);
6177 if (match && !m_encoded_p)
6178 {
6179 /* One needed check before declaring a positive match is to verify
6180 that iff we are doing a verbatim match, the decoded version
6181 of the symbol name starts with '<'. Otherwise, this symbol name
6182 is not a suitable completion. */
6183
6184 bool has_angle_bracket = (decoded_name[0] == '<');
6185 match = (has_angle_bracket == m_verbatim_p);
6186 }
6187
6188 if (match && !m_verbatim_p)
6189 {
6190 /* When doing non-verbatim match, another check that needs to
6191 be done is to verify that the potentially matching symbol name
6192 does not include capital letters, because the ada-mode would
6193 not be able to understand these symbol names without the
6194 angle bracket notation. */
6195 const char *tmp;
6196
6197 for (tmp = sym_name; *tmp != '\0' && !isupper (*tmp); tmp++);
6198 if (*tmp != '\0')
6199 match = false;
6200 }
6201
6202 /* Second: Try wild matching... */
6203
6204 if (!match && m_wild_match_p)
6205 {
6206 /* Since we are doing wild matching, this means that TEXT
6207 may represent an unqualified symbol name. We therefore must
6208 also compare TEXT against the unqualified name of the symbol. */
6209 sym_name = ada_unqualified_name (decoded_name.c_str ());
6210
6211 if (strncmp (sym_name, text, text_len) == 0)
6212 match = true;
6213 }
6214
6215 /* Finally: If we found a match, prepare the result to return. */
6216
6217 if (!match)
6218 return false;
6219
6220 if (comp_match_res != NULL)
6221 {
6222 std::string &match_str = comp_match_res->match.storage ();
6223
6224 if (!m_encoded_p)
6225 match_str = ada_decode (sym_name);
6226 else
6227 {
6228 if (m_verbatim_p)
6229 match_str = add_angle_brackets (sym_name);
6230 else
6231 match_str = sym_name;
6232
6233 }
6234
6235 comp_match_res->set_match (match_str.c_str ());
6236 }
6237
6238 return true;
6239}
6240
6241 /* Field Access */
6242
6243/* Return non-zero if TYPE is a pointer to the GNAT dispatch table used
6244 for tagged types. */
6245
6246static int
6248{
6249 const char *name;
6250
6251 if (type->code () != TYPE_CODE_PTR)
6252 return 0;
6253
6254 name = type->target_type ()->name ();
6255 if (name == NULL)
6256 return 0;
6257
6258 return (strcmp (name, "ada__tags__dispatch_table") == 0);
6259}
6260
6261/* Return non-zero if TYPE is an interface tag. */
6262
6263static int
6265{
6266 const char *name = type->name ();
6267
6268 if (name == NULL)
6269 return 0;
6270
6271 return (strcmp (name, "ada__tags__interface_tag") == 0);
6272}
6273
6274/* True if field number FIELD_NUM in struct or union type TYPE is supposed
6275 to be invisible to users. */
6276
6277int
6278ada_is_ignored_field (struct type *type, int field_num)
6279{
6280 if (field_num < 0 || field_num > type->num_fields ())
6281 return 1;
6282
6283 /* Check the name of that field. */
6284 {
6285 const char *name = type->field (field_num).name ();
6286
6287 /* Anonymous field names should not be printed.
6288 brobecker/2007-02-20: I don't think this can actually happen
6289 but we don't want to print the value of anonymous fields anyway. */
6290 if (name == NULL)
6291 return 1;
6292
6293 /* Normally, fields whose name start with an underscore ("_")
6294 are fields that have been internally generated by the compiler,
6295 and thus should not be printed. The "_parent" field is special,
6296 however: This is a field internally generated by the compiler
6297 for tagged types, and it contains the components inherited from
6298 the parent type. This field should not be printed as is, but
6299 should not be ignored either. */
6300 if (name[0] == '_' && !startswith (name, "_parent"))
6301 return 1;
6302
6303 /* The compiler doesn't document this, but sometimes it emits
6304 a field whose name starts with a capital letter, like 'V148s'.
6305 These aren't marked as artificial in any way, but we know they
6306 should be ignored. However, wrapper fields should not be
6307 ignored. */
6308 if (name[0] == 'S' || name[0] == 'R' || name[0] == 'O')
6309 {
6310 /* Wrapper field. */
6311 }
6312 else if (isupper (name[0]))
6313 return 1;
6314 }
6315
6316 /* If this is the dispatch table of a tagged type or an interface tag,
6317 then ignore. */
6318 if (ada_is_tagged_type (type, 1)
6319 && (ada_is_dispatch_table_ptr_type (type->field (field_num).type ())
6320 || ada_is_interface_tag (type->field (field_num).type ())))
6321 return 1;
6322
6323 /* Not a special field, so it should not be ignored. */
6324 return 0;
6325}
6326
6327/* True iff TYPE has a tag field. If REFOK, then TYPE may also be a
6328 pointer or reference type whose ultimate target has a tag field. */
6329
6330int
6331ada_is_tagged_type (struct type *type, int refok)
6332{
6333 return (ada_lookup_struct_elt_type (type, "_tag", refok, 1) != NULL);
6334}
6335
6336/* True iff TYPE represents the type of X'Tag */
6337
6338int
6340{
6342
6343 if (type == NULL || type->code () != TYPE_CODE_PTR)
6344 return 0;
6345 else
6346 {
6347 const char *name = ada_type_name (type->target_type ());
6348
6349 return (name != NULL
6350 && strcmp (name, "ada__tags__dispatch_table") == 0);
6351 }
6352}
6353
6354/* The type of the tag on VAL. */
6355
6356static struct type *
6357ada_tag_type (struct value *val)
6358{
6359 return ada_lookup_struct_elt_type (val->type (), "_tag", 1, 0);
6360}
6361
6362/* Return 1 if TAG follows the old scheme for Ada tags (used for Ada 95,
6363 retired at Ada 05). */
6364
6365static int
6366is_ada95_tag (struct value *tag)
6367{
6368 return ada_value_struct_elt (tag, "tsd", 1) != NULL;
6369}
6370
6371/* The value of the tag on VAL. */
6372
6373static struct value *
6375{
6376 return ada_value_struct_elt (val, "_tag", 0);
6377}
6378
6379/* The value of the tag on the object of type TYPE whose contents are
6380 saved at VALADDR, if it is non-null, or is at memory address
6381 ADDRESS. */
6382
6383static struct value *
6385 const gdb_byte *valaddr,
6386 CORE_ADDR address)
6387{
6388 int tag_byte_offset;
6389 struct type *tag_type;
6390
6391 gdb::array_view<const gdb_byte> contents;
6392 if (valaddr != nullptr)
6393 contents = gdb::make_array_view (valaddr, type->length ());
6394 struct type *resolved_type = resolve_dynamic_type (type, contents, address);
6395 if (find_struct_field ("_tag", resolved_type, 0, &tag_type, &tag_byte_offset,
6396 NULL, NULL, NULL))
6397 {
6398 const gdb_byte *valaddr1 = ((valaddr == NULL)
6399 ? NULL
6400 : valaddr + tag_byte_offset);
6401 CORE_ADDR address1 = (address == 0) ? 0 : address + tag_byte_offset;
6402
6403 return value_from_contents_and_address (tag_type, valaddr1, address1);
6404 }
6405 return NULL;
6406}
6407
6408static struct type *
6410{
6411 gdb::unique_xmalloc_ptr<char> type_name = ada_tag_name (tag);
6412
6413 if (type_name != NULL)
6414 return ada_find_any_type (ada_encode (type_name.get ()).c_str ());
6415 return NULL;
6416}
6417
6418/* Given a value OBJ of a tagged type, return a value of this
6419 type at the base address of the object. The base address, as
6420 defined in Ada.Tags, it is the address of the primary tag of
6421 the object, and therefore where the field values of its full
6422 view can be fetched. */
6423
6424struct value *
6426{
6427 struct value *val;
6428 LONGEST offset_to_top = 0;
6429 struct type *ptr_type, *obj_type;
6430 struct value *tag;
6431 CORE_ADDR base_address;
6432
6433 obj_type = obj->type ();
6434
6435 /* It is the responsibility of the caller to deref pointers. */
6436
6437 if (obj_type->code () == TYPE_CODE_PTR || obj_type->code () == TYPE_CODE_REF)
6438 return obj;
6439
6440 tag = ada_value_tag (obj);
6441 if (!tag)
6442 return obj;
6443
6444 /* Base addresses only appeared with Ada 05 and multiple inheritance. */
6445
6446 if (is_ada95_tag (tag))
6447 return obj;
6448
6449 struct type *offset_type
6451 target_gdbarch(), "storage_offset");
6452 ptr_type = lookup_pointer_type (offset_type);
6453 val = value_cast (ptr_type, tag);
6454 if (!val)
6455 return obj;
6456
6457 /* It is perfectly possible that an exception be raised while
6458 trying to determine the base address, just like for the tag;
6459 see ada_tag_name for more details. We do not print the error
6460 message for the same reason. */
6461
6462 try
6463 {
6464 offset_to_top = value_as_long (value_ind (value_ptradd (val, -2)));
6465 }
6466
6467 catch (const gdb_exception_error &e)
6468 {
6469 return obj;
6470 }
6471
6472 /* If offset is null, nothing to do. */
6473
6474 if (offset_to_top == 0)
6475 return obj;
6476
6477 /* -1 is a special case in Ada.Tags; however, what should be done
6478 is not quite clear from the documentation. So do nothing for
6479 now. */
6480
6481 if (offset_to_top == -1)
6482 return obj;
6483
6484 /* Storage_Offset'Last is used to indicate that a dynamic offset to
6485 top is used. In this situation the offset is stored just after
6486 the tag, in the object itself. */
6487 ULONGEST last = (((ULONGEST) 1) << (8 * offset_type->length () - 1)) - 1;
6488 if (offset_to_top == last)
6489 {
6490 struct value *tem = value_addr (tag);
6491 tem = value_ptradd (tem, 1);
6492 tem = value_cast (ptr_type, tem);
6493 offset_to_top = value_as_long (value_ind (tem));
6494 }
6495
6496 if (offset_to_top > 0)
6497 {
6498 /* OFFSET_TO_TOP used to be a positive value to be subtracted
6499 from the base address. This was however incompatible with
6500 C++ dispatch table: C++ uses a *negative* value to *add*
6501 to the base address. Ada's convention has therefore been
6502 changed in GNAT 19.0w 20171023: since then, C++ and Ada
6503 use the same convention. Here, we support both cases by
6504 checking the sign of OFFSET_TO_TOP. */
6505 offset_to_top = -offset_to_top;
6506 }
6507
6508 base_address = obj->address () + offset_to_top;
6509 tag = value_tag_from_contents_and_address (obj_type, NULL, base_address);
6510
6511 /* Make sure that we have a proper tag at the new address.
6512 Otherwise, offset_to_top is bogus (which can happen when
6513 the object is not initialized yet). */
6514
6515 if (!tag)
6516 return obj;
6517
6518 obj_type = type_from_tag (tag);
6519
6520 if (!obj_type)
6521 return obj;
6522
6523 return value_from_contents_and_address (obj_type, NULL, base_address);
6524}
6525
6526/* Return the "ada__tags__type_specific_data" type. */
6527
6528static struct type *
6530{
6532
6533 if (data->tsd_type == 0)
6534 data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
6535 return data->tsd_type;
6536}
6537
6538/* Return the TSD (type-specific data) associated to the given TAG.
6539 TAG is assumed to be the tag of a tagged-type entity.
6540
6541 May return NULL if we are unable to get the TSD. */
6542
6543static struct value *
6545{
6546 struct value *val;
6547 struct type *type;
6548
6549 /* First option: The TSD is simply stored as a field of our TAG.
6550 Only older versions of GNAT would use this format, but we have
6551 to test it first, because there are no visible markers for
6552 the current approach except the absence of that field. */
6553
6554 val = ada_value_struct_elt (tag, "tsd", 1);
6555 if (val)
6556 return val;
6557
6558 /* Try the second representation for the dispatch table (in which
6559 there is no explicit 'tsd' field in the referent of the tag pointer,
6560 and instead the tsd pointer is stored just before the dispatch
6561 table. */
6562
6564 if (type == NULL)
6565 return NULL;
6567 val = value_cast (type, tag);
6568 if (val == NULL)
6569 return NULL;
6570 return value_ind (value_ptradd (val, -1));
6571}
6572
6573/* Given the TSD of a tag (type-specific data), return a string
6574 containing the name of the associated type.
6575
6576 May return NULL if we are unable to determine the tag name. */
6577
6578static gdb::unique_xmalloc_ptr<char>
6580{
6581 struct value *val;
6582
6583 val = ada_value_struct_elt (tsd, "expanded_name", 1);
6584 if (val == NULL)
6585 return NULL;
6586 gdb::unique_xmalloc_ptr<char> buffer
6587 = target_read_string (value_as_address (val), INT_MAX);
6588 if (buffer == nullptr)
6589 return nullptr;
6590
6591 try
6592 {
6593 /* Let this throw an exception on error. If the data is
6594 uninitialized, we'd rather not have the user see a
6595 warning. */
6596 const char *folded = ada_fold_name (buffer.get (), true);
6597 return make_unique_xstrdup (folded);
6598 }
6599 catch (const gdb_exception &)
6600 {
6601 return nullptr;
6602 }
6603}
6604
6605/* The type name of the dynamic type denoted by the 'tag value TAG, as
6606 a C string.
6607
6608 Return NULL if the TAG is not an Ada tag, or if we were unable to
6609 determine the name of that tag. */
6610
6611gdb::unique_xmalloc_ptr<char>
6612ada_tag_name (struct value *tag)
6613{
6614 gdb::unique_xmalloc_ptr<char> name;
6615
6616 if (!ada_is_tag_type (tag->type ()))
6617 return NULL;
6618
6619 /* It is perfectly possible that an exception be raised while trying
6620 to determine the TAG's name, even under normal circumstances:
6621 The associated variable may be uninitialized or corrupted, for
6622 instance. We do not let any exception propagate past this point.
6623 instead we return NULL.
6624
6625 We also do not print the error message either (which often is very
6626 low-level (Eg: "Cannot read memory at 0x[...]"), but instead let
6627 the caller print a more meaningful message if necessary. */
6628 try
6629 {
6630 struct value *tsd = ada_get_tsd_from_tag (tag);
6631
6632 if (tsd != NULL)
6634 }
6635 catch (const gdb_exception_error &e)
6636 {
6637 }
6638
6639 return name;
6640}
6641
6642/* The parent type of TYPE, or NULL if none. */
6643
6644struct type *
6646{
6647 int i;
6648
6650
6651 if (type == NULL || type->code () != TYPE_CODE_STRUCT)
6652 return NULL;
6653
6654 for (i = 0; i < type->num_fields (); i += 1)
6655 if (ada_is_parent_field (type, i))
6656 {
6657 struct type *parent_type = type->field (i).type ();
6658
6659 /* If the _parent field is a pointer, then dereference it. */
6660 if (parent_type->code () == TYPE_CODE_PTR)
6661 parent_type = parent_type->target_type ();
6662 /* If there is a parallel XVS type, get the actual base type. */
6663 parent_type = ada_get_base_type (parent_type);
6664
6665 return ada_check_typedef (parent_type);
6666 }
6667
6668 return NULL;
6669}
6670
6671/* True iff field number FIELD_NUM of structure type TYPE contains the
6672 parent-type (inherited) fields of a derived type. Assumes TYPE is
6673 a structure type with at least FIELD_NUM+1 fields. */
6674
6675int
6676ada_is_parent_field (struct type *type, int field_num)
6677{
6678 const char *name = ada_check_typedef (type)->field (field_num).name ();
6679
6680 return (name != NULL
6681 && (startswith (name, "PARENT")
6682 || startswith (name, "_parent")));
6683}
6684
6685/* True iff field number FIELD_NUM of structure type TYPE is a
6686 transparent wrapper field (which should be silently traversed when doing
6687 field selection and flattened when printing). Assumes TYPE is a
6688 structure type with at least FIELD_NUM+1 fields. Such fields are always
6689 structures. */
6690
6691int
6692ada_is_wrapper_field (struct type *type, int field_num)
6693{
6694 const char *name = type->field (field_num).name ();
6695
6696 if (name != NULL && strcmp (name, "RETVAL") == 0)
6697 {
6698 /* This happens in functions with "out" or "in out" parameters
6699 which are passed by copy. For such functions, GNAT describes
6700 the function's return type as being a struct where the return
6701 value is in a field called RETVAL, and where the other "out"
6702 or "in out" parameters are fields of that struct. This is not
6703 a wrapper. */
6704 return 0;
6705 }
6706
6707 return (name != NULL
6708 && (startswith (name, "PARENT")
6709 || strcmp (name, "REP") == 0
6710 || startswith (name, "_parent")
6711 || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
6712}
6713
6714/* True iff field number FIELD_NUM of structure or union type TYPE
6715 is a variant wrapper. Assumes TYPE is a structure type with at least
6716 FIELD_NUM+1 fields. */
6717
6718int
6719ada_is_variant_part (struct type *type, int field_num)
6720{
6721 /* Only Ada types are eligible. */
6722 if (!ADA_TYPE_P (type))
6723 return 0;
6724
6725 struct type *field_type = type->field (field_num).type ();
6726
6727 return (field_type->code () == TYPE_CODE_UNION
6728 || (is_dynamic_field (type, field_num)
6729 && (field_type->target_type ()->code ()
6730 == TYPE_CODE_UNION)));
6731}
6732
6733/* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
6734 whose discriminants are contained in the record type OUTER_TYPE,
6735 returns the type of the controlling discriminant for the variant.
6736 May return NULL if the type could not be found. */
6737
6738struct type *
6739ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
6740{
6741 const char *name = ada_variant_discrim_name (var_type);
6742
6743 return ada_lookup_struct_elt_type (outer_type, name, 1, 1);
6744}
6745
6746/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
6747 valid field number within it, returns 1 iff field FIELD_NUM of TYPE
6748 represents a 'when others' clause; otherwise 0. */
6749
6750static int
6751ada_is_others_clause (struct type *type, int field_num)
6752{
6753 const char *name = type->field (field_num).name ();
6754
6755 return (name != NULL && name[0] == 'O');
6756}
6757
6758/* Assuming that TYPE0 is the type of the variant part of a record,
6759 returns the name of the discriminant controlling the variant.
6760 The value is valid until the next call to ada_variant_discrim_name. */
6761
6762const char *
6764{
6765 static std::string result;
6766 struct type *type;
6767 const char *name;
6768 const char *discrim_end;
6769 const char *discrim_start;
6770
6771 if (type0->code () == TYPE_CODE_PTR)
6772 type = type0->target_type ();
6773 else
6774 type = type0;
6775
6777
6778 if (name == NULL || name[0] == '\000')
6779 return "";
6780
6781 for (discrim_end = name + strlen (name) - 6; discrim_end != name;
6782 discrim_end -= 1)
6783 {
6784 if (startswith (discrim_end, "___XVN"))
6785 break;
6786 }
6787 if (discrim_end == name)
6788 return "";
6789
6790 for (discrim_start = discrim_end; discrim_start != name + 3;
6791 discrim_start -= 1)
6792 {
6793 if (discrim_start == name + 1)
6794 return "";
6795 if ((discrim_start > name + 3
6796 && startswith (discrim_start - 3, "___"))
6797 || discrim_start[-1] == '.')
6798 break;
6799 }
6800
6801 result = std::string (discrim_start, discrim_end - discrim_start);
6802 return result.c_str ();
6803}
6804
6805/* Scan STR for a subtype-encoded number, beginning at position K.
6806 Put the position of the character just past the number scanned in
6807 *NEW_K, if NEW_K!=NULL. Put the scanned number in *R, if R!=NULL.
6808 Return 1 if there was a valid number at the given position, and 0
6809 otherwise. A "subtype-encoded" number consists of the absolute value
6810 in decimal, followed by the letter 'm' to indicate a negative number.
6811 Assumes 0m does not occur. */
6812
6813int
6814ada_scan_number (const char str[], int k, LONGEST * R, int *new_k)
6815{
6816 ULONGEST RU;
6817
6818 if (!isdigit (str[k]))
6819 return 0;
6820
6821 /* Do it the hard way so as not to make any assumption about
6822 the relationship of unsigned long (%lu scan format code) and
6823 LONGEST. */
6824 RU = 0;
6825 while (isdigit (str[k]))
6826 {
6827 RU = RU * 10 + (str[k] - '0');
6828 k += 1;
6829 }
6830
6831 if (str[k] == 'm')
6832 {
6833 if (R != NULL)
6834 *R = (-(LONGEST) (RU - 1)) - 1;
6835 k += 1;
6836 }
6837 else if (R != NULL)
6838 *R = (LONGEST) RU;
6839
6840 /* NOTE on the above: Technically, C does not say what the results of
6841 - (LONGEST) RU or (LONGEST) -RU are for RU == largest positive
6842 number representable as a LONGEST (although either would probably work
6843 in most implementations). When RU>0, the locution in the then branch
6844 above is always equivalent to the negative of RU. */
6845
6846 if (new_k != NULL)
6847 *new_k = k;
6848 return 1;
6849}
6850
6851/* Assuming that TYPE is a variant part wrapper type (a VARIANTS field),
6852 and FIELD_NUM is a valid field number within it, returns 1 iff VAL is
6853 in the range encoded by field FIELD_NUM of TYPE; otherwise 0. */
6854
6855static int
6856ada_in_variant (LONGEST val, struct type *type, int field_num)
6857{
6858 const char *name = type->field (field_num).name ();
6859 int p;
6860
6861 p = 0;
6862 while (1)
6863 {
6864 switch (name[p])
6865 {
6866 case '\0':
6867 return 0;
6868 case 'S':
6869 {
6870 LONGEST W;
6871
6872 if (!ada_scan_number (name, p + 1, &W, &p))
6873 return 0;
6874 if (val == W)
6875 return 1;
6876 break;
6877 }
6878 case 'R':
6879 {
6880 LONGEST L, U;
6881
6882 if (!ada_scan_number (name, p + 1, &L, &p)
6883 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
6884 return 0;
6885 if (val >= L && val <= U)
6886 return 1;
6887 break;
6888 }
6889 case 'O':
6890 return 1;
6891 default:
6892 return 0;
6893 }
6894 }
6895}
6896
6897/* FIXME: Lots of redundancy below. Try to consolidate. */
6898
6899/* Given a value ARG1 (offset by OFFSET bytes) of a struct or union type
6900 ARG_TYPE, extract and return the value of one of its (non-static)
6901 fields. FIELDNO says which field. Differs from value_primitive_field
6902 only in that it can handle packed values of arbitrary type. */
6903
6904struct value *
6905ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
6906 struct type *arg_type)
6907{
6908 struct type *type;
6909
6910 arg_type = ada_check_typedef (arg_type);
6911 type = arg_type->field (fieldno).type ();
6912
6913 /* Handle packed fields. It might be that the field is not packed
6914 relative to its containing structure, but the structure itself is
6915 packed; in this case we must take the bit-field path. */
6916 if (arg_type->field (fieldno).bitsize () != 0 || arg1->bitpos () != 0)
6917 {
6918 int bit_pos = arg_type->field (fieldno).loc_bitpos ();
6919 int bit_size = arg_type->field (fieldno).bitsize ();
6920
6921 return ada_value_primitive_packed_val (arg1,
6922 arg1->contents ().data (),
6923 offset + bit_pos / 8,
6924 bit_pos % 8, bit_size, type);
6925 }
6926 else
6927 return arg1->primitive_field (offset, fieldno, arg_type);
6928}
6929
6930/* Find field with name NAME in object of type TYPE. If found,
6931 set the following for each argument that is non-null:
6932 - *FIELD_TYPE_P to the field's type;
6933 - *BYTE_OFFSET_P to OFFSET + the byte offset of the field within
6934 an object of that type;
6935 - *BIT_OFFSET_P to the bit offset modulo byte size of the field;
6936 - *BIT_SIZE_P to its size in bits if the field is packed, and
6937 0 otherwise;
6938 If INDEX_P is non-null, increment *INDEX_P by the number of source-visible
6939 fields up to but not including the desired field, or by the total
6940 number of fields if not found. A NULL value of NAME never
6941 matches; the function just counts visible fields in this case.
6942
6943 Notice that we need to handle when a tagged record hierarchy
6944 has some components with the same name, like in this scenario:
6945
6946 type Top_T is tagged record
6947 N : Integer := 1;
6948 U : Integer := 974;
6949 A : Integer := 48;
6950 end record;
6951
6952 type Middle_T is new Top.Top_T with record
6953 N : Character := 'a';
6954 C : Integer := 3;
6955 end record;
6956
6957 type Bottom_T is new Middle.Middle_T with record
6958 N : Float := 4.0;
6959 C : Character := '5';
6960 X : Integer := 6;
6961 A : Character := 'J';
6962 end record;
6963
6964 Let's say we now have a variable declared and initialized as follow:
6965
6966 TC : Top_A := new Bottom_T;
6967
6968 And then we use this variable to call this function
6969
6970 procedure Assign (Obj: in out Top_T; TV : Integer);
6971
6972 as follow:
6973
6974 Assign (Top_T (B), 12);
6975
6976 Now, we're in the debugger, and we're inside that procedure
6977 then and we want to print the value of obj.c:
6978
6979 Usually, the tagged record or one of the parent type owns the
6980 component to print and there's no issue but in this particular
6981 case, what does it mean to ask for Obj.C? Since the actual
6982 type for object is type Bottom_T, it could mean two things: type
6983 component C from the Middle_T view, but also component C from
6984 Bottom_T. So in that "undefined" case, when the component is
6985 not found in the non-resolved type (which includes all the
6986 components of the parent type), then resolve it and see if we
6987 get better luck once expanded.
6988
6989 In the case of homonyms in the derived tagged type, we don't
6990 guaranty anything, and pick the one that's easiest for us
6991 to program.
6992
6993 Returns 1 if found, 0 otherwise. */
6994
6995static int
6996find_struct_field (const char *name, struct type *type, int offset,
6997 struct type **field_type_p,
6998 int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
6999 int *index_p)
7000{
7001 int i;
7002 int parent_offset = -1;
7003
7005
7006 if (field_type_p != NULL)
7007 *field_type_p = NULL;
7008 if (byte_offset_p != NULL)
7009 *byte_offset_p = 0;
7010 if (bit_offset_p != NULL)
7011 *bit_offset_p = 0;
7012 if (bit_size_p != NULL)
7013 *bit_size_p = 0;
7014
7015 for (i = 0; i < type->num_fields (); i += 1)
7016 {
7017 /* These can't be computed using TYPE_FIELD_BITPOS for a dynamic
7018 type. However, we only need the values to be correct when
7019 the caller asks for them. */
7020 int bit_pos = 0, fld_offset = 0;
7021 if (byte_offset_p != nullptr || bit_offset_p != nullptr)
7022 {
7023 bit_pos = type->field (i).loc_bitpos ();
7024 fld_offset = offset + bit_pos / 8;
7025 }
7026
7027 const char *t_field_name = type->field (i).name ();
7028
7029 if (t_field_name == NULL)
7030 continue;
7031
7032 else if (ada_is_parent_field (type, i))
7033 {
7034 /* This is a field pointing us to the parent type of a tagged
7035 type. As hinted in this function's documentation, we give
7036 preference to fields in the current record first, so what
7037 we do here is just record the index of this field before
7038 we skip it. If it turns out we couldn't find our field
7039 in the current record, then we'll get back to it and search
7040 inside it whether the field might exist in the parent. */
7041
7042 parent_offset = i;
7043 continue;
7044 }
7045
7046 else if (name != NULL && field_name_match (t_field_name, name))
7047 {
7048 int bit_size = type->field (i).bitsize ();
7049
7050 if (field_type_p != NULL)
7051 *field_type_p = type->field (i).type ();
7052 if (byte_offset_p != NULL)
7053 *byte_offset_p = fld_offset;
7054 if (bit_offset_p != NULL)
7055 *bit_offset_p = bit_pos % 8;
7056 if (bit_size_p != NULL)
7057 *bit_size_p = bit_size;
7058 return 1;
7059 }
7060 else if (ada_is_wrapper_field (type, i))
7061 {
7062 if (find_struct_field (name, type->field (i).type (), fld_offset,
7063 field_type_p, byte_offset_p, bit_offset_p,
7064 bit_size_p, index_p))
7065 return 1;
7066 }
7067 else if (ada_is_variant_part (type, i))
7068 {
7069 /* PNH: Wait. Do we ever execute this section, or is ARG always of
7070 fixed type?? */
7071 int j;
7072 struct type *field_type
7073 = ada_check_typedef (type->field (i).type ());
7074
7075 for (j = 0; j < field_type->num_fields (); j += 1)
7076 {
7077 if (find_struct_field (name, field_type->field (j).type (),
7078 fld_offset
7079 + field_type->field (j).loc_bitpos () / 8,
7080 field_type_p, byte_offset_p,
7081 bit_offset_p, bit_size_p, index_p))
7082 return 1;
7083 }
7084 }
7085 else if (index_p != NULL)
7086 *index_p += 1;
7087 }
7088
7089 /* Field not found so far. If this is a tagged type which
7090 has a parent, try finding that field in the parent now. */
7091
7092 if (parent_offset != -1)
7093 {
7094 /* As above, only compute the offset when truly needed. */
7095 int fld_offset = offset;
7096 if (byte_offset_p != nullptr || bit_offset_p != nullptr)
7097 {
7098 int bit_pos = type->field (parent_offset).loc_bitpos ();
7099 fld_offset += bit_pos / 8;
7100 }
7101
7102 if (find_struct_field (name, type->field (parent_offset).type (),
7103 fld_offset, field_type_p, byte_offset_p,
7104 bit_offset_p, bit_size_p, index_p))
7105 return 1;
7106 }
7107
7108 return 0;
7109}
7110
7111/* Number of user-visible fields in record type TYPE. */
7112
7113static int
7115{
7116 int n;
7117
7118 n = 0;
7119 find_struct_field (NULL, type, 0, NULL, NULL, NULL, NULL, &n);
7120 return n;
7121}
7122
7123/* Look for a field NAME in ARG. Adjust the address of ARG by OFFSET bytes,
7124 and search in it assuming it has (class) type TYPE.
7125 If found, return value, else return NULL.
7126
7127 Searches recursively through wrapper fields (e.g., '_parent').
7128
7129 In the case of homonyms in the tagged types, please refer to the
7130 long explanation in find_struct_field's function documentation. */
7131
7132static struct value *
7133ada_search_struct_field (const char *name, struct value *arg, int offset,
7134 struct type *type)
7135{
7136 int i;
7137 int parent_offset = -1;
7138
7140 for (i = 0; i < type->num_fields (); i += 1)
7141 {
7142 const char *t_field_name = type->field (i).name ();
7143
7144 if (t_field_name == NULL)
7145 continue;
7146
7147 else if (ada_is_parent_field (type, i))
7148 {
7149 /* This is a field pointing us to the parent type of a tagged
7150 type. As hinted in this function's documentation, we give
7151 preference to fields in the current record first, so what
7152 we do here is just record the index of this field before
7153 we skip it. If it turns out we couldn't find our field
7154 in the current record, then we'll get back to it and search
7155 inside it whether the field might exist in the parent. */
7156
7157 parent_offset = i;
7158 continue;
7159 }
7160
7161 else if (field_name_match (t_field_name, name))
7162 return ada_value_primitive_field (arg, offset, i, type);
7163
7164 else if (ada_is_wrapper_field (type, i))
7165 {
7166 struct value *v = /* Do not let indent join lines here. */
7168 offset + type->field (i).loc_bitpos () / 8,
7169 type->field (i).type ());
7170
7171 if (v != NULL)
7172 return v;
7173 }
7174
7175 else if (ada_is_variant_part (type, i))
7176 {
7177 /* PNH: Do we ever get here? See find_struct_field. */
7178 int j;
7179 struct type *field_type = ada_check_typedef (type->field (i).type ());
7180 int var_offset = offset + type->field (i).loc_bitpos () / 8;
7181
7182 for (j = 0; j < field_type->num_fields (); j += 1)
7183 {
7184 struct value *v = ada_search_struct_field /* Force line
7185 break. */
7186 (name, arg,
7187 var_offset + field_type->field (j).loc_bitpos () / 8,
7188 field_type->field (j).type ());
7189
7190 if (v != NULL)
7191 return v;
7192 }
7193 }
7194 }
7195
7196 /* Field not found so far. If this is a tagged type which
7197 has a parent, try finding that field in the parent now. */
7198
7199 if (parent_offset != -1)
7200 {
7201 struct value *v = ada_search_struct_field (
7202 name, arg, offset + type->field (parent_offset).loc_bitpos () / 8,
7203 type->field (parent_offset).type ());
7204
7205 if (v != NULL)
7206 return v;
7207 }
7208
7209 return NULL;
7210}
7211
7212static struct value *ada_index_struct_field_1 (int *, struct value *,
7213 int, struct type *);
7214
7215
7216/* Return field #INDEX in ARG, where the index is that returned by
7217 * find_struct_field through its INDEX_P argument. Adjust the address
7218 * of ARG by OFFSET bytes, and search in it assuming it has (class) type TYPE.
7219 * If found, return value, else return NULL. */
7220
7221static struct value *
7222ada_index_struct_field (int index, struct value *arg, int offset,
7223 struct type *type)
7224{
7225 return ada_index_struct_field_1 (&index, arg, offset, type);
7226}
7227
7228
7229/* Auxiliary function for ada_index_struct_field. Like
7230 * ada_index_struct_field, but takes index from *INDEX_P and modifies
7231 * *INDEX_P. */
7232
7233static struct value *
7234ada_index_struct_field_1 (int *index_p, struct value *arg, int offset,
7235 struct type *type)
7236{
7237 int i;
7239
7240 for (i = 0; i < type->num_fields (); i += 1)
7241 {
7242 if (type->field (i).name () == NULL)
7243 continue;
7244 else if (ada_is_wrapper_field (type, i))
7245 {
7246 struct value *v = /* Do not let indent join lines here. */
7247 ada_index_struct_field_1 (index_p, arg,
7248 offset + type->field (i).loc_bitpos () / 8,
7249 type->field (i).type ());
7250
7251 if (v != NULL)
7252 return v;
7253 }
7254
7255 else if (ada_is_variant_part (type, i))
7256 {
7257 /* PNH: Do we ever get here? See ada_search_struct_field,
7258 find_struct_field. */
7259 error (_("Cannot assign this kind of variant record"));
7260 }
7261 else if (*index_p == 0)
7262 return ada_value_primitive_field (arg, offset, i, type);
7263 else
7264 *index_p -= 1;
7265 }
7266 return NULL;
7267}
7268
7269/* Return a string representation of type TYPE. */
7270
7271static std::string
7273{
7274 string_file tmp_stream;
7275
7276 type_print (type, "", &tmp_stream, -1);
7277
7278 return tmp_stream.release ();
7279}
7280
7281/* Given a type TYPE, look up the type of the component of type named NAME.
7282
7283 Matches any field whose name has NAME as a prefix, possibly
7284 followed by "___".
7285
7286 TYPE can be either a struct or union. If REFOK, TYPE may also
7287 be a (pointer or reference)+ to a struct or union, and the
7288 ultimate target type will be searched.
7289
7290 Looks recursively into variant clauses and parent types.
7291
7292 In the case of homonyms in the tagged types, please refer to the
7293 long explanation in find_struct_field's function documentation.
7294
7295 If NOERR is nonzero, return NULL if NAME is not suitably defined or
7296 TYPE is not a type of the right kind. */
7297
7298static struct type *
7299ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
7300 int noerr)
7301{
7302 if (name == NULL)
7303 goto BadName;
7304
7305 if (refok && type != NULL)
7306 while (1)
7307 {
7309 if (type->code () != TYPE_CODE_PTR && type->code () != TYPE_CODE_REF)
7310 break;
7311 type = type->target_type ();
7312 }
7313
7314 if (type == NULL
7315 || (type->code () != TYPE_CODE_STRUCT
7316 && type->code () != TYPE_CODE_UNION))
7317 {
7318 if (noerr)
7319 return NULL;
7320
7321 error (_("Type %s is not a structure or union type"),
7322 type != NULL ? type_as_string (type).c_str () : _("(null)"));
7323 }
7324
7326
7327 struct type *result;
7328 find_struct_field (name, type, 0, &result, nullptr, nullptr, nullptr,
7329 nullptr);
7330 if (result != nullptr)
7331 return result;
7332
7333BadName:
7334 if (!noerr)
7335 {
7336 const char *name_str = name != NULL ? name : _("<null>");
7337
7338 error (_("Type %s has no component named %s"),
7339 type_as_string (type).c_str (), name_str);
7340 }
7341
7342 return NULL;
7343}
7344
7345/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
7346 within a value of type OUTER_TYPE, return true iff VAR_TYPE
7347 represents an unchecked union (that is, the variant part of a
7348 record that is named in an Unchecked_Union pragma). */
7349
7350static int
7351is_unchecked_variant (struct type *var_type, struct type *outer_type)
7352{
7353 const char *discrim_name = ada_variant_discrim_name (var_type);
7354
7355 return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1) == NULL);
7356}
7357
7358
7359/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
7360 within OUTER, determine which variant clause (field number in VAR_TYPE,
7361 numbering from 0) is applicable. Returns -1 if none are. */
7362
7363int
7364ada_which_variant_applies (struct type *var_type, struct value *outer)
7365{
7366 int others_clause;
7367 int i;
7368 const char *discrim_name = ada_variant_discrim_name (var_type);
7369 struct value *discrim;
7370 LONGEST discrim_val;
7371
7372 /* Using plain value_from_contents_and_address here causes problems
7373 because we will end up trying to resolve a type that is currently
7374 being constructed. */
7375 discrim = ada_value_struct_elt (outer, discrim_name, 1);
7376 if (discrim == NULL)
7377 return -1;
7378 discrim_val = value_as_long (discrim);
7379
7380 others_clause = -1;
7381 for (i = 0; i < var_type->num_fields (); i += 1)
7382 {
7383 if (ada_is_others_clause (var_type, i))
7384 others_clause = i;
7385 else if (ada_in_variant (discrim_val, var_type, i))
7386 return i;
7387 }
7388
7389 return others_clause;
7390}
7391
7392
7393
7394 /* Dynamic-Sized Records */
7395
7396/* Strategy: The type ostensibly attached to a value with dynamic size
7397 (i.e., a size that is not statically recorded in the debugging
7398 data) does not accurately reflect the size or layout of the value.
7399 Our strategy is to convert these values to values with accurate,
7400 conventional types that are constructed on the fly. */
7401
7402/* There is a subtle and tricky problem here. In general, we cannot
7403 determine the size of dynamic records without its data. However,
7404 the 'struct value' data structure, which GDB uses to represent
7405 quantities in the inferior process (the target), requires the size
7406 of the type at the time of its allocation in order to reserve space
7407 for GDB's internal copy of the data. That's why the
7408 'to_fixed_xxx_type' routines take (target) addresses as parameters,
7409 rather than struct value*s.
7410
7411 However, GDB's internal history variables ($1, $2, etc.) are
7412 struct value*s containing internal copies of the data that are not, in
7413 general, the same as the data at their corresponding addresses in
7414 the target. Fortunately, the types we give to these values are all
7415 conventional, fixed-size types (as per the strategy described
7416 above), so that we don't usually have to perform the
7417 'to_fixed_xxx_type' conversions to look at their values.
7418 Unfortunately, there is one exception: if one of the internal
7419 history variables is an array whose elements are unconstrained
7420 records, then we will need to create distinct fixed types for each
7421 element selected. */
7422
7423/* The upshot of all of this is that many routines take a (type, host
7424 address, target address) triple as arguments to represent a value.
7425 The host address, if non-null, is supposed to contain an internal
7426 copy of the relevant data; otherwise, the program is to consult the
7427 target at the target address. */
7428
7429/* Assuming that VAL0 represents a pointer value, the result of
7430 dereferencing it. Differs from value_ind in its treatment of
7431 dynamic-sized types. */
7432
7433struct value *
7434ada_value_ind (struct value *val0)
7435{
7436 struct value *val = value_ind (val0);
7437
7438 if (ada_is_tagged_type (val->type (), 0))
7440
7441 return ada_to_fixed_value (val);
7442}
7443
7444/* The value resulting from dereferencing any "reference to"
7445 qualifiers on VAL0. */
7446
7447static struct value *
7448ada_coerce_ref (struct value *val0)
7449{
7450 if (val0->type ()->code () == TYPE_CODE_REF)
7451 {
7452 struct value *val = val0;
7453
7454 val = coerce_ref (val);
7455
7456 if (ada_is_tagged_type (val->type (), 0))
7458
7459 return ada_to_fixed_value (val);
7460 }
7461 else
7462 return val0;
7463}
7464
7465/* Return the bit alignment required for field #F of template type TYPE. */
7466
7467static unsigned int
7469{
7470 const char *name = type->field (f).name ();
7471 int len;
7472 int align_offset;
7473
7474 /* The field name should never be null, unless the debugging information
7475 is somehow malformed. In this case, we assume the field does not
7476 require any alignment. */
7477 if (name == NULL)
7478 return 1;
7479
7480 len = strlen (name);
7481
7482 if (!isdigit (name[len - 1]))
7483 return 1;
7484
7485 if (isdigit (name[len - 2]))
7486 align_offset = len - 2;
7487 else
7488 align_offset = len - 1;
7489
7490 if (align_offset < 7 || !startswith (name + align_offset - 6, "___XV"))
7491 return TARGET_CHAR_BIT;
7492
7493 return atoi (name + align_offset) * TARGET_CHAR_BIT;
7494}
7495
7496/* Find a typedef or tag symbol named NAME. Ignores ambiguity. */
7497
7498static struct symbol *
7500{
7501 struct symbol *sym;
7502
7504 if (sym != NULL && sym->aclass () == LOC_TYPEDEF)
7505 return sym;
7506
7507 sym = standard_lookup (name, NULL, STRUCT_DOMAIN);
7508 return sym;
7509}
7510
7511/* Find a type named NAME. Ignores ambiguity. This routine will look
7512 solely for types defined by debug info, it will not search the GDB
7513 primitive types. */
7514
7515static struct type *
7517{
7518 struct symbol *sym = ada_find_any_type_symbol (name);
7519
7520 if (sym != NULL)
7521 return sym->type ();
7522
7523 return NULL;
7524}
7525
7526/* Given NAME_SYM and an associated BLOCK, find a "renaming" symbol
7527 associated with NAME_SYM's name. NAME_SYM may itself be a renaming
7528 symbol, in which case it is returned. Otherwise, this looks for
7529 symbols whose name is that of NAME_SYM suffixed with "___XR".
7530 Return symbol if found, and NULL otherwise. */
7531
7532static bool
7534{
7535 const char *name = name_sym->linkage_name ();
7536 return strstr (name, "___XR") != NULL;
7537}
7538
7539/* Because of GNAT encoding conventions, several GDB symbols may match a
7540 given type name. If the type denoted by TYPE0 is to be preferred to
7541 that of TYPE1 for purposes of type printing, return non-zero;
7542 otherwise return 0. */
7543
7544int
7545ada_prefer_type (struct type *type0, struct type *type1)
7546{
7547 if (type1 == NULL)
7548 return 1;
7549 else if (type0 == NULL)
7550 return 0;
7551 else if (type1->code () == TYPE_CODE_VOID)
7552 return 1;
7553 else if (type0->code () == TYPE_CODE_VOID)
7554 return 0;
7555 else if (type1->name () == NULL && type0->name () != NULL)
7556 return 1;
7557 else if (ada_is_constrained_packed_array_type (type0))
7558 return 1;
7559 else if (ada_is_array_descriptor_type (type0)
7560 && !ada_is_array_descriptor_type (type1))
7561 return 1;
7562 else
7563 {
7564 const char *type0_name = type0->name ();
7565 const char *type1_name = type1->name ();
7566
7567 if (type0_name != NULL && strstr (type0_name, "___XR") != NULL
7568 && (type1_name == NULL || strstr (type1_name, "___XR") == NULL))
7569 return 1;
7570 }
7571 return 0;
7572}
7573
7574/* The name of TYPE, which is its TYPE_NAME. Null if TYPE is
7575 null. */
7576
7577const char *
7579{
7580 if (type == NULL)
7581 return NULL;
7582 return type->name ();
7583}
7584
7585/* Search the list of "descriptive" types associated to TYPE for a type
7586 whose name is NAME. */
7587
7588static struct type *
7590{
7591 struct type *result, *tmp;
7592
7594 return NULL;
7595
7596 /* If there no descriptive-type info, then there is no parallel type
7597 to be found. */
7598 if (!HAVE_GNAT_AUX_INFO (type))
7599 return NULL;
7600
7601 result = TYPE_DESCRIPTIVE_TYPE (type);
7602 while (result != NULL)
7603 {
7604 const char *result_name = ada_type_name (result);
7605
7606 if (result_name == NULL)
7607 {
7608 warning (_("unexpected null name on descriptive type"));
7609 return NULL;
7610 }
7611
7612 /* If the names match, stop. */
7613 if (strcmp (result_name, name) == 0)
7614 break;
7615
7616 /* Otherwise, look at the next item on the list, if any. */
7617 if (HAVE_GNAT_AUX_INFO (result))
7618 tmp = TYPE_DESCRIPTIVE_TYPE (result);
7619 else
7620 tmp = NULL;
7621
7622 /* If not found either, try after having resolved the typedef. */
7623 if (tmp != NULL)
7624 result = tmp;
7625 else
7626 {
7627 result = check_typedef (result);
7628 if (HAVE_GNAT_AUX_INFO (result))
7629 result = TYPE_DESCRIPTIVE_TYPE (result);
7630 else
7631 result = NULL;
7632 }
7633 }
7634
7635 /* If we didn't find a match, see whether this is a packed array. With
7636 older compilers, the descriptive type information is either absent or
7637 irrelevant when it comes to packed arrays so the above lookup fails.
7638 Fall back to using a parallel lookup by name in this case. */
7639 if (result == NULL && ada_is_constrained_packed_array_type (type))
7640 return ada_find_any_type (name);
7641
7642 return result;
7643}
7644
7645/* Find a parallel type to TYPE with the specified NAME, using the
7646 descriptive type taken from the debugging information, if available,
7647 and otherwise using the (slower) name-based method. */
7648
7649static struct type *
7651{
7652 struct type *result = NULL;
7653
7656 else
7657 result = ada_find_any_type (name);
7658
7659 return result;
7660}
7661
7662/* Same as above, but specify the name of the parallel type by appending
7663 SUFFIX to the name of TYPE. */
7664
7665struct type *
7666ada_find_parallel_type (struct type *type, const char *suffix)
7667{
7668 char *name;
7669 const char *type_name = ada_type_name (type);
7670 int len;
7671
7672 if (type_name == NULL)
7673 return NULL;
7674
7675 len = strlen (type_name);
7676
7677 name = (char *) alloca (len + strlen (suffix) + 1);
7678
7679 strcpy (name, type_name);
7680 strcpy (name + len, suffix);
7681
7683}
7684
7685/* If TYPE is a variable-size record type, return the corresponding template
7686 type describing its fields. Otherwise, return NULL. */
7687
7688static struct type *
7690{
7692
7693 if (type == NULL || type->code () != TYPE_CODE_STRUCT
7694 || ada_type_name (type) == NULL)
7695 return NULL;
7696 else
7697 {
7698 int len = strlen (ada_type_name (type));
7699
7700 if (len > 6 && strcmp (ada_type_name (type) + len - 6, "___XVE") == 0)
7701 return type;
7702 else
7703 return ada_find_parallel_type (type, "___XVE");
7704 }
7705}
7706
7707/* Assuming that TEMPL_TYPE is a union or struct type, returns
7708 non-zero iff field FIELD_NUM of TEMPL_TYPE has dynamic size. */
7709
7710static int
7711is_dynamic_field (struct type *templ_type, int field_num)
7712{
7713 const char *name = templ_type->field (field_num).name ();
7714
7715 return name != NULL
7716 && templ_type->field (field_num).type ()->code () == TYPE_CODE_PTR
7717 && strstr (name, "___XVL") != NULL;
7718}
7719
7720/* The index of the variant field of TYPE, or -1 if TYPE does not
7721 represent a variant record type. */
7722
7723static int
7725{
7726 int f;
7727
7728 if (type == NULL || type->code () != TYPE_CODE_STRUCT)
7729 return -1;
7730
7731 for (f = 0; f < type->num_fields (); f += 1)
7732 {
7733 if (ada_is_variant_part (type, f))
7734 return f;
7735 }
7736 return -1;
7737}
7738
7739/* A record type with no fields. */
7740
7741static struct type *
7742empty_record (struct type *templ)
7743{
7744 struct type *type = type_allocator (templ).new_type ();
7745
7746 type->set_code (TYPE_CODE_STRUCT);
7748 type->set_name ("<empty>");
7749 type->set_length (0);
7750 return type;
7751}
7752
7753/* An ordinary record type (with fixed-length fields) that describes
7754 the value of type TYPE at VALADDR or ADDRESS (see comments at
7755 the beginning of this section) VAL according to GNAT conventions.
7756 DVAL0 should describe the (portion of a) record that contains any
7757 necessary discriminants. It should be NULL if VAL->type () is
7758 an outer-level type (i.e., as opposed to a branch of a variant.) A
7759 variant field (unless unchecked) is replaced by a particular branch
7760 of the variant.
7761
7762 If not KEEP_DYNAMIC_FIELDS, then all fields whose position or
7763 length are not statically known are discarded. As a consequence,
7764 VALADDR, ADDRESS and DVAL0 are ignored.
7765
7766 NOTE: Limitations: For now, we assume that dynamic fields and
7767 variants occupy whole numbers of bytes. However, they need not be
7768 byte-aligned. */
7769
7770struct type *
7772 const gdb_byte *valaddr,
7773 CORE_ADDR address, struct value *dval0,
7774 int keep_dynamic_fields)
7775{
7776 struct value *dval;
7777 struct type *rtype;
7778 int nfields, bit_len;
7779 int variant_field;
7780 long off;
7781 int fld_bit_len;
7782 int f;
7783
7784 scoped_value_mark mark;
7785
7786 /* Compute the number of fields in this record type that are going
7787 to be processed: unless keep_dynamic_fields, this includes only
7788 fields whose position and length are static will be processed. */
7789 if (keep_dynamic_fields)
7790 nfields = type->num_fields ();
7791 else
7792 {
7793 nfields = 0;
7794 while (nfields < type->num_fields ()
7795 && !ada_is_variant_part (type, nfields)
7796 && !is_dynamic_field (type, nfields))
7797 nfields++;
7798 }
7799
7800 rtype = type_allocator (type).new_type ();
7801 rtype->set_code (TYPE_CODE_STRUCT);
7802 INIT_NONE_SPECIFIC (rtype);
7803 rtype->alloc_fields (nfields);
7804 rtype->set_name (ada_type_name (type));
7805 rtype->set_is_fixed_instance (true);
7806
7807 off = 0;
7808 bit_len = 0;
7809 variant_field = -1;
7810
7811 for (f = 0; f < nfields; f += 1)
7812 {
7813 off = align_up (off, field_alignment (type, f))
7814 + type->field (f).loc_bitpos ();
7815 rtype->field (f).set_loc_bitpos (off);
7816 rtype->field (f).set_bitsize (0);
7817
7818 if (ada_is_variant_part (type, f))
7819 {
7820 variant_field = f;
7821 fld_bit_len = 0;
7822 }
7823 else if (is_dynamic_field (type, f))
7824 {
7825 const gdb_byte *field_valaddr = valaddr;
7826 CORE_ADDR field_address = address;
7827 struct type *field_type = type->field (f).type ()->target_type ();
7828
7829 if (dval0 == NULL)
7830 {
7831 /* Using plain value_from_contents_and_address here
7832 causes problems because we will end up trying to
7833 resolve a type that is currently being
7834 constructed. */
7836 valaddr,
7837 address);
7838 rtype = dval->type ();
7839 }
7840 else
7841 dval = dval0;
7842
7843 /* If the type referenced by this field is an aligner type, we need
7844 to unwrap that aligner type, because its size might not be set.
7845 Keeping the aligner type would cause us to compute the wrong
7846 size for this field, impacting the offset of the all the fields
7847 that follow this one. */
7848 if (ada_is_aligner_type (field_type))
7849 {
7850 long field_offset = type->field (f).loc_bitpos ();
7851
7852 field_valaddr = cond_offset_host (field_valaddr, field_offset);
7853 field_address = cond_offset_target (field_address, field_offset);
7854 field_type = ada_aligned_type (field_type);
7855 }
7856
7857 field_valaddr = cond_offset_host (field_valaddr,
7858 off / TARGET_CHAR_BIT);
7859 field_address = cond_offset_target (field_address,
7860 off / TARGET_CHAR_BIT);
7861
7862 /* Get the fixed type of the field. Note that, in this case,
7863 we do not want to get the real type out of the tag: if
7864 the current field is the parent part of a tagged record,
7865 we will get the tag of the object. Clearly wrong: the real
7866 type of the parent is not the real type of the child. We
7867 would end up in an infinite loop. */
7868 field_type = ada_get_base_type (field_type);
7869 field_type = ada_to_fixed_type (field_type, field_valaddr,
7870 field_address, dval, 0);
7871
7872 rtype->field (f).set_type (field_type);
7873 rtype->field (f).set_name (type->field (f).name ());
7874 /* The multiplication can potentially overflow. But because
7875 the field length has been size-checked just above, and
7876 assuming that the maximum size is a reasonable value,
7877 an overflow should not happen in practice. So rather than
7878 adding overflow recovery code to this already complex code,
7879 we just assume that it's not going to happen. */
7880 fld_bit_len = rtype->field (f).type ()->length () * TARGET_CHAR_BIT;
7881 }
7882 else
7883 {
7884 /* Note: If this field's type is a typedef, it is important
7885 to preserve the typedef layer.
7886
7887 Otherwise, we might be transforming a typedef to a fat
7888 pointer (encoding a pointer to an unconstrained array),
7889 into a basic fat pointer (encoding an unconstrained
7890 array). As both types are implemented using the same
7891 structure, the typedef is the only clue which allows us
7892 to distinguish between the two options. Stripping it
7893 would prevent us from printing this field appropriately. */
7894 rtype->field (f).set_type (type->field (f).type ());
7895 rtype->field (f).set_name (type->field (f).name ());
7896 if (type->field (f).bitsize () > 0)
7897 {
7898 fld_bit_len = type->field (f).bitsize ();
7899 rtype->field (f).set_bitsize (fld_bit_len);
7900 }
7901 else
7902 {
7903 struct type *field_type = type->field (f).type ();
7904
7905 /* We need to be careful of typedefs when computing
7906 the length of our field. If this is a typedef,
7907 get the length of the target type, not the length
7908 of the typedef. */
7909 if (field_type->code () == TYPE_CODE_TYPEDEF)
7910 field_type = ada_typedef_target_type (field_type);
7911
7912 fld_bit_len =
7913 ada_check_typedef (field_type)->length () * TARGET_CHAR_BIT;
7914 }
7915 }
7916 if (off + fld_bit_len > bit_len)
7917 bit_len = off + fld_bit_len;
7918 off += fld_bit_len;
7919 rtype->set_length (align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT);
7920 }
7921
7922 /* We handle the variant part, if any, at the end because of certain
7923 odd cases in which it is re-ordered so as NOT to be the last field of
7924 the record. This can happen in the presence of representation
7925 clauses. */
7926 if (variant_field >= 0)
7927 {
7928 struct type *branch_type;
7929
7930 off = rtype->field (variant_field).loc_bitpos ();
7931
7932 if (dval0 == NULL)
7933 {
7934 /* Using plain value_from_contents_and_address here causes
7935 problems because we will end up trying to resolve a type
7936 that is currently being constructed. */
7937 dval = value_from_contents_and_address_unresolved (rtype, valaddr,
7938 address);
7939 rtype = dval->type ();
7940 }
7941 else
7942 dval = dval0;
7943
7944 branch_type =
7947 cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
7948 cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
7949 if (branch_type == NULL)
7950 {
7951 for (f = variant_field + 1; f < rtype->num_fields (); f += 1)
7952 rtype->field (f - 1) = rtype->field (f);
7953 rtype->set_num_fields (rtype->num_fields () - 1);
7954 }
7955 else
7956 {
7957 rtype->field (variant_field).set_type (branch_type);
7958 rtype->field (variant_field).set_name ("S");
7959 fld_bit_len =
7960 rtype->field (variant_field).type ()->length () * TARGET_CHAR_BIT;
7961 if (off + fld_bit_len > bit_len)
7962 bit_len = off + fld_bit_len;
7963
7964 rtype->set_length
7965 (align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT);
7966 }
7967 }
7968
7969 /* According to exp_dbug.ads, the size of TYPE for variable-size records
7970 should contain the alignment of that record, which should be a strictly
7971 positive value. If null or negative, then something is wrong, most
7972 probably in the debug info. In that case, we don't round up the size
7973 of the resulting type. If this record is not part of another structure,
7974 the current RTYPE length might be good enough for our purposes. */
7975 if (type->length () <= 0)
7976 {
7977 if (rtype->name ())
7978 warning (_("Invalid type size for `%s' detected: %s."),
7979 rtype->name (), pulongest (type->length ()));
7980 else
7981 warning (_("Invalid type size for <unnamed> detected: %s."),
7982 pulongest (type->length ()));
7983 }
7984 else
7985 rtype->set_length (align_up (rtype->length (), type->length ()));
7986
7987 return rtype;
7988}
7989
7990/* As for ada_template_to_fixed_record_type_1 with KEEP_DYNAMIC_FIELDS
7991 of 1. */
7992
7993static struct type *
7994template_to_fixed_record_type (struct type *type, const gdb_byte *valaddr,
7995 CORE_ADDR address, struct value *dval0)
7996{
7998 address, dval0, 1);
7999}
8000
8001/* An ordinary record type in which ___XVL-convention fields and
8002 ___XVU- and ___XVN-convention field types in TYPE0 are replaced with
8003 static approximations, containing all possible fields. Uses
8004 no runtime values. Useless for use in values, but that's OK,
8005 since the results are used only for type determinations. Works on both
8006 structs and unions. Representation note: to save space, we memorize
8007 the result of this function in the type::target_type of the
8008 template type. */
8009
8010static struct type *
8012{
8013 struct type *type;
8014 int nfields;
8015 int f;
8016
8017 /* No need no do anything if the input type is already fixed. */
8018 if (type0->is_fixed_instance ())
8019 return type0;
8020
8021 /* Likewise if we already have computed the static approximation. */
8022 if (type0->target_type () != NULL)
8023 return type0->target_type ();
8024
8025 /* Don't clone TYPE0 until we are sure we are going to need a copy. */
8026 type = type0;
8027 nfields = type0->num_fields ();
8028
8029 /* Whether or not we cloned TYPE0, cache the result so that we don't do
8030 recompute all over next time. */
8031 type0->set_target_type (type);
8032
8033 for (f = 0; f < nfields; f += 1)
8034 {
8035 struct type *field_type = type0->field (f).type ();
8036 struct type *new_type;
8037
8038 if (is_dynamic_field (type0, f))
8039 {
8040 field_type = ada_check_typedef (field_type);
8041 new_type = to_static_fixed_type (field_type->target_type ());
8042 }
8043 else
8044 new_type = static_unwrap_type (field_type);
8045
8046 if (new_type != field_type)
8047 {
8048 /* Clone TYPE0 only the first time we get a new field type. */
8049 if (type == type0)
8050 {
8051 type = type_allocator (type0).new_type ();
8052 type0->set_target_type (type);
8053 type->set_code (type0->code ());
8055
8056 type->copy_fields (type0);
8057
8058 type->set_name (ada_type_name (type0));
8060 type->set_length (0);
8061 }
8063 type->field (f).set_name (type0->field (f).name ());
8064 }
8065 }
8066
8067 return type;
8068}
8069
8070/* Given an object of type TYPE whose contents are at VALADDR and
8071 whose address in memory is ADDRESS, returns a revision of TYPE,
8072 which should be a non-dynamic-sized record, in which the variant
8073 part, if any, is replaced with the appropriate branch. Looks
8074 for discriminant values in DVAL0, which can be NULL if the record
8075 contains the necessary discriminant values. */
8076
8077static struct type *
8078to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
8079 CORE_ADDR address, struct value *dval0)
8080{
8081 struct value *dval;
8082 struct type *rtype;
8083 struct type *branch_type;
8084 int nfields = type->num_fields ();
8086
8087 if (variant_field == -1)
8088 return type;
8089
8090 scoped_value_mark mark;
8091 if (dval0 == NULL)
8092 {
8093 dval = value_from_contents_and_address (type, valaddr, address);
8094 type = dval->type ();
8095 }
8096 else
8097 dval = dval0;
8098
8099 rtype = type_allocator (type).new_type ();
8100 rtype->set_code (TYPE_CODE_STRUCT);
8101 INIT_NONE_SPECIFIC (rtype);
8102 rtype->copy_fields (type);
8103
8104 rtype->set_name (ada_type_name (type));
8105 rtype->set_is_fixed_instance (true);
8106 rtype->set_length (type->length ());
8107
8108 branch_type = to_fixed_variant_branch_type
8110 cond_offset_host (valaddr,
8112 / TARGET_CHAR_BIT),
8113 cond_offset_target (address,
8115 / TARGET_CHAR_BIT), dval);
8116 if (branch_type == NULL)
8117 {
8118 int f;
8119
8120 for (f = variant_field + 1; f < nfields; f += 1)
8121 rtype->field (f - 1) = rtype->field (f);
8122 rtype->set_num_fields (rtype->num_fields () - 1);
8123 }
8124 else
8125 {
8126 rtype->field (variant_field).set_type (branch_type);
8127 rtype->field (variant_field).set_name ("S");
8128 rtype->field (variant_field).set_bitsize (0);
8129 rtype->set_length (rtype->length () + branch_type->length ());
8130 }
8131
8132 rtype->set_length (rtype->length ()
8133 - type->field (variant_field).type ()->length ());
8134
8135 return rtype;
8136}
8137
8138/* An ordinary record type (with fixed-length fields) that describes
8139 the value at (TYPE0, VALADDR, ADDRESS) [see explanation at
8140 beginning of this section]. Any necessary discriminants' values
8141 should be in DVAL, a record value; it may be NULL if the object
8142 at ADDR itself contains any necessary discriminant values.
8143 Additionally, VALADDR and ADDRESS may also be NULL if no discriminant
8144 values from the record are needed. Except in the case that DVAL,
8145 VALADDR, and ADDRESS are all 0 or NULL, a variant field (unless
8146 unchecked) is replaced by a particular branch of the variant.
8147
8148 NOTE: the case in which DVAL and VALADDR are NULL and ADDRESS is 0
8149 is questionable and may be removed. It can arise during the
8150 processing of an unconstrained-array-of-record type where all the
8151 variant branches have exactly the same size. This is because in
8152 such cases, the compiler does not bother to use the XVS convention
8153 when encoding the record. I am currently dubious of this
8154 shortcut and suspect the compiler should be altered. FIXME. */
8155
8156static struct type *
8157to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
8158 CORE_ADDR address, struct value *dval)
8159{
8160 struct type *templ_type;
8161
8162 if (type0->is_fixed_instance ())
8163 return type0;
8164
8165 templ_type = dynamic_template_type (type0);
8166
8167 if (templ_type != NULL)
8168 return template_to_fixed_record_type (templ_type, valaddr, address, dval);
8169 else if (variant_field_index (type0) >= 0)
8170 {
8171 if (dval == NULL && valaddr == NULL && address == 0)
8172 return type0;
8173 return to_record_with_fixed_variant_part (type0, valaddr, address,
8174 dval);
8175 }
8176 else
8177 {
8178 type0->set_is_fixed_instance (true);
8179 return type0;
8180 }
8181
8182}
8183
8184/* An ordinary record type (with fixed-length fields) that describes
8185 the value at (VAR_TYPE0, VALADDR, ADDRESS), where VAR_TYPE0 is a
8186 union type. Any necessary discriminants' values should be in DVAL,
8187 a record value. That is, this routine selects the appropriate
8188 branch of the union at ADDR according to the discriminant value
8189 indicated in the union's type name. Returns VAR_TYPE0 itself if
8190 it represents a variant subject to a pragma Unchecked_Union. */
8191
8192static struct type *
8193to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
8194 CORE_ADDR address, struct value *dval)
8195{
8196 int which;
8197 struct type *templ_type;
8198 struct type *var_type;
8199
8200 if (var_type0->code () == TYPE_CODE_PTR)
8201 var_type = var_type0->target_type ();
8202 else
8203 var_type = var_type0;
8204
8205 templ_type = ada_find_parallel_type (var_type, "___XVU");
8206
8207 if (templ_type != NULL)
8208 var_type = templ_type;
8209
8210 if (is_unchecked_variant (var_type, dval->type ()))
8211 return var_type0;
8212 which = ada_which_variant_applies (var_type, dval);
8213
8214 if (which < 0)
8215 return empty_record (var_type);
8216 else if (is_dynamic_field (var_type, which))
8218 (var_type->field (which).type ()->target_type(), valaddr, address, dval);
8219 else if (variant_field_index (var_type->field (which).type ()) >= 0)
8220 return
8222 (var_type->field (which).type (), valaddr, address, dval);
8223 else
8224 return var_type->field (which).type ();
8225}
8226
8227/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
8228 ENCODING_TYPE, a type following the GNAT conventions for discrete
8229 type encodings, only carries redundant information. */
8230
8231static int
8233 struct type *encoding_type)
8234{
8235 const char *bounds_str;
8236 int n;
8237 LONGEST lo, hi;
8238
8239 gdb_assert (range_type->code () == TYPE_CODE_RANGE);
8240
8241 if (get_base_type (range_type)->code ()
8242 != get_base_type (encoding_type)->code ())
8243 {
8244 /* The compiler probably used a simple base type to describe
8245 the range type instead of the range's actual base type,
8246 expecting us to get the real base type from the encoding
8247 anyway. In this situation, the encoding cannot be ignored
8248 as redundant. */
8249 return 0;
8250 }
8251
8252 if (is_dynamic_type (range_type))
8253 return 0;
8254
8255 if (encoding_type->name () == NULL)
8256 return 0;
8257
8258 bounds_str = strstr (encoding_type->name (), "___XDLU_");
8259 if (bounds_str == NULL)
8260 return 0;
8261
8262 n = 8; /* Skip "___XDLU_". */
8263 if (!ada_scan_number (bounds_str, n, &lo, &n))
8264 return 0;
8265 if (range_type->bounds ()->low.const_val () != lo)
8266 return 0;
8267
8268 n += 2; /* Skip the "__" separator between the two bounds. */
8269 if (!ada_scan_number (bounds_str, n, &hi, &n))
8270 return 0;
8271 if (range_type->bounds ()->high.const_val () != hi)
8272 return 0;
8273
8274 return 1;
8275}
8276
8277/* Given the array type ARRAY_TYPE, return nonzero if DESC_TYPE,
8278 a type following the GNAT encoding for describing array type
8279 indices, only carries redundant information. */
8280
8281static int
8283 struct type *desc_type)
8284{
8285 struct type *this_layer = check_typedef (array_type);
8286 int i;
8287
8288 for (i = 0; i < desc_type->num_fields (); i++)
8289 {
8290 if (!ada_is_redundant_range_encoding (this_layer->index_type (),
8291 desc_type->field (i).type ()))
8292 return 0;
8293 this_layer = check_typedef (this_layer->target_type ());
8294 }
8295
8296 return 1;
8297}
8298
8299/* Assuming that TYPE0 is an array type describing the type of a value
8300 at ADDR, and that DVAL describes a record containing any
8301 discriminants used in TYPE0, returns a type for the value that
8302 contains no dynamic components (that is, no components whose sizes
8303 are determined by run-time quantities). Unless IGNORE_TOO_BIG is
8304 true, gives an error message if the resulting type's size is over
8305 varsize_limit. */
8306
8307static struct type *
8308to_fixed_array_type (struct type *type0, struct value *dval,
8309 int ignore_too_big)
8310{
8311 struct type *index_type_desc;
8312 struct type *result;
8313 int constrained_packed_array_p;
8314 static const char *xa_suffix = "___XA";
8315
8316 type0 = ada_check_typedef (type0);
8317 if (type0->is_fixed_instance ())
8318 return type0;
8319
8320 constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
8321 if (constrained_packed_array_p)
8322 {
8324 if (type0 == nullptr)
8325 error (_("could not decode constrained packed array type"));
8326 }
8327
8328 index_type_desc = ada_find_parallel_type (type0, xa_suffix);
8329
8330 /* As mentioned in exp_dbug.ads, for non bit-packed arrays an
8331 encoding suffixed with 'P' may still be generated. If so,
8332 it should be used to find the XA type. */
8333
8334 if (index_type_desc == NULL)
8335 {
8336 const char *type_name = ada_type_name (type0);
8337
8338 if (type_name != NULL)
8339 {
8340 const int len = strlen (type_name);
8341 char *name = (char *) alloca (len + strlen (xa_suffix));
8342
8343 if (type_name[len - 1] == 'P')
8344 {
8345 strcpy (name, type_name);
8346 strcpy (name + len - 1, xa_suffix);
8347 index_type_desc = ada_find_parallel_type_with_name (type0, name);
8348 }
8349 }
8350 }
8351
8352 ada_fixup_array_indexes_type (index_type_desc);
8353 if (index_type_desc != NULL
8354 && ada_is_redundant_index_type_desc (type0, index_type_desc))
8355 {
8356 /* Ignore this ___XA parallel type, as it does not bring any
8357 useful information. This allows us to avoid creating fixed
8358 versions of the array's index types, which would be identical
8359 to the original ones. This, in turn, can also help avoid
8360 the creation of fixed versions of the array itself. */
8361 index_type_desc = NULL;
8362 }
8363
8364 if (index_type_desc == NULL)
8365 {
8366 struct type *elt_type0 = ada_check_typedef (type0->target_type ());
8367
8368 /* NOTE: elt_type---the fixed version of elt_type0---should never
8369 depend on the contents of the array in properly constructed
8370 debugging data. */
8371 /* Create a fixed version of the array element type.
8372 We're not providing the address of an element here,
8373 and thus the actual object value cannot be inspected to do
8374 the conversion. This should not be a problem, since arrays of
8375 unconstrained objects are not allowed. In particular, all
8376 the elements of an array of a tagged type should all be of
8377 the same type specified in the debugging info. No need to
8378 consult the object tag. */
8379 struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval, 1);
8380
8381 /* Make sure we always create a new array type when dealing with
8382 packed array types, since we're going to fix-up the array
8383 type length and element bitsize a little further down. */
8384 if (elt_type0 == elt_type && !constrained_packed_array_p)
8385 result = type0;
8386 else
8387 {
8388 type_allocator alloc (type0);
8389 result = create_array_type (alloc, elt_type, type0->index_type ());
8390 }
8391 }
8392 else
8393 {
8394 int i;
8395 struct type *elt_type0;
8396
8397 elt_type0 = type0;
8398 for (i = index_type_desc->num_fields (); i > 0; i -= 1)
8399 elt_type0 = elt_type0->target_type ();
8400
8401 /* NOTE: result---the fixed version of elt_type0---should never
8402 depend on the contents of the array in properly constructed
8403 debugging data. */
8404 /* Create a fixed version of the array element type.
8405 We're not providing the address of an element here,
8406 and thus the actual object value cannot be inspected to do
8407 the conversion. This should not be a problem, since arrays of
8408 unconstrained objects are not allowed. In particular, all
8409 the elements of an array of a tagged type should all be of
8410 the same type specified in the debugging info. No need to
8411 consult the object tag. */
8412 result =
8413 ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
8414
8415 elt_type0 = type0;
8416 for (i = index_type_desc->num_fields () - 1; i >= 0; i -= 1)
8417 {
8418 struct type *range_type =
8419 to_fixed_range_type (index_type_desc->field (i).type (), dval);
8420
8421 type_allocator alloc (elt_type0);
8422 result = create_array_type (alloc, result, range_type);
8423 elt_type0 = elt_type0->target_type ();
8424 }
8425 }
8426
8427 /* We want to preserve the type name. This can be useful when
8428 trying to get the type name of a value that has already been
8429 printed (for instance, if the user did "print VAR; whatis $". */
8430 result->set_name (type0->name ());
8431
8432 if (constrained_packed_array_p)
8433 {
8434 /* So far, the resulting type has been created as if the original
8435 type was a regular (non-packed) array type. As a result, the
8436 bitsize of the array elements needs to be set again, and the array
8437 length needs to be recomputed based on that bitsize. */
8438 int len = result->length () / result->target_type ()->length ();
8439 int elt_bitsize = type0->field (0).bitsize ();
8440
8441 result->field (0).set_bitsize (elt_bitsize);
8442 result->set_length (len * elt_bitsize / HOST_CHAR_BIT);
8443 if (result->length () * HOST_CHAR_BIT < len * elt_bitsize)
8444 result->set_length (result->length () + 1);
8445 }
8446
8447 result->set_is_fixed_instance (true);
8448 return result;
8449}
8450
8451
8452/* A standard type (containing no dynamically sized components)
8453 corresponding to TYPE for the value (TYPE, VALADDR, ADDRESS)
8454 DVAL describes a record containing any discriminants used in TYPE0,
8455 and may be NULL if there are none, or if the object of type TYPE at
8456 ADDRESS or in VALADDR contains these discriminants.
8457
8458 If CHECK_TAG is not null, in the case of tagged types, this function
8459 attempts to locate the object's tag and use it to compute the actual
8460 type. However, when ADDRESS is null, we cannot use it to determine the
8461 location of the tag, and therefore compute the tagged type's actual type.
8462 So we return the tagged type without consulting the tag. */
8463
8464static struct type *
8465ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
8466 CORE_ADDR address, struct value *dval, int check_tag)
8467{
8469
8470 /* Only un-fixed types need to be handled here. */
8471 if (!HAVE_GNAT_AUX_INFO (type))
8472 return type;
8473
8474 switch (type->code ())
8475 {
8476 default:
8477 return type;
8478 case TYPE_CODE_STRUCT:
8479 {
8480 struct type *static_type = to_static_fixed_type (type);
8481 struct type *fixed_record_type =
8482 to_fixed_record_type (type, valaddr, address, NULL);
8483
8484 /* If STATIC_TYPE is a tagged type and we know the object's address,
8485 then we can determine its tag, and compute the object's actual
8486 type from there. Note that we have to use the fixed record
8487 type (the parent part of the record may have dynamic fields
8488 and the way the location of _tag is expressed may depend on
8489 them). */
8490
8491 if (check_tag && address != 0 && ada_is_tagged_type (static_type, 0))
8492 {
8493 struct value *tag =
8495 (fixed_record_type,
8496 valaddr,
8497 address);
8498 struct type *real_type = type_from_tag (tag);
8499 struct value *obj =
8500 value_from_contents_and_address (fixed_record_type,
8501 valaddr,
8502 address);
8503 fixed_record_type = obj->type ();
8504 if (real_type != NULL)
8506 (real_type, NULL,
8507 ada_tag_value_at_base_address (obj)->address (), NULL);
8508 }
8509
8510 /* Check to see if there is a parallel ___XVZ variable.
8511 If there is, then it provides the actual size of our type. */
8512 else if (ada_type_name (fixed_record_type) != NULL)
8513 {
8514 const char *name = ada_type_name (fixed_record_type);
8515 char *xvz_name
8516 = (char *) alloca (strlen (name) + 7 /* "___XVZ\0" */);
8517 bool xvz_found = false;
8518 LONGEST size;
8519
8520 xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
8521 try
8522 {
8523 xvz_found = get_int_var_value (xvz_name, size);
8524 }
8525 catch (const gdb_exception_error &except)
8526 {
8527 /* We found the variable, but somehow failed to read
8528 its value. Rethrow the same error, but with a little
8529 bit more information, to help the user understand
8530 what went wrong (Eg: the variable might have been
8531 optimized out). */
8532 throw_error (except.error,
8533 _("unable to read value of %s (%s)"),
8534 xvz_name, except.what ());
8535 }
8536
8537 if (xvz_found && fixed_record_type->length () != size)
8538 {
8539 fixed_record_type = copy_type (fixed_record_type);
8540 fixed_record_type->set_length (size);
8541
8542 /* The FIXED_RECORD_TYPE may have be a stub. We have
8543 observed this when the debugging info is STABS, and
8544 apparently it is something that is hard to fix.
8545
8546 In practice, we don't need the actual type definition
8547 at all, because the presence of the XVZ variable allows us
8548 to assume that there must be a XVS type as well, which we
8549 should be able to use later, when we need the actual type
8550 definition.
8551
8552 In the meantime, pretend that the "fixed" type we are
8553 returning is NOT a stub, because this can cause trouble
8554 when using this type to create new types targeting it.
8555 Indeed, the associated creation routines often check
8556 whether the target type is a stub and will try to replace
8557 it, thus using a type with the wrong size. This, in turn,
8558 might cause the new type to have the wrong size too.
8559 Consider the case of an array, for instance, where the size
8560 of the array is computed from the number of elements in
8561 our array multiplied by the size of its element. */
8562 fixed_record_type->set_is_stub (false);
8563 }
8564 }
8565 return fixed_record_type;
8566 }
8567 case TYPE_CODE_ARRAY:
8568 return to_fixed_array_type (type, dval, 1);
8569 case TYPE_CODE_UNION:
8570 if (dval == NULL)
8571 return type;
8572 else
8573 return to_fixed_variant_branch_type (type, valaddr, address, dval);
8574 }
8575}
8576
8577/* The same as ada_to_fixed_type_1, except that it preserves the type
8578 if it is a TYPE_CODE_TYPEDEF of a type that is already fixed.
8579
8580 The typedef layer needs be preserved in order to differentiate between
8581 arrays and array pointers when both types are implemented using the same
8582 fat pointer. In the array pointer case, the pointer is encoded as
8583 a typedef of the pointer type. For instance, considering:
8584
8585 type String_Access is access String;
8586 S1 : String_Access := null;
8587
8588 To the debugger, S1 is defined as a typedef of type String. But
8589 to the user, it is a pointer. So if the user tries to print S1,
8590 we should not dereference the array, but print the array address
8591 instead.
8592
8593 If we didn't preserve the typedef layer, we would lose the fact that
8594 the type is to be presented as a pointer (needs de-reference before
8595 being printed). And we would also use the source-level type name. */
8596
8597struct type *
8598ada_to_fixed_type (struct type *type, const gdb_byte *valaddr,
8599 CORE_ADDR address, struct value *dval, int check_tag)
8600
8601{
8602 struct type *fixed_type =
8603 ada_to_fixed_type_1 (type, valaddr, address, dval, check_tag);
8604
8605 /* If TYPE is a typedef and its target type is the same as the FIXED_TYPE,
8606 then preserve the typedef layer.
8607
8608 Implementation note: We can only check the main-type portion of
8609 the TYPE and FIXED_TYPE, because eliminating the typedef layer
8610 from TYPE now returns a type that has the same instance flags
8611 as TYPE. For instance, if TYPE is a "typedef const", and its
8612 target type is a "struct", then the typedef elimination will return
8613 a "const" version of the target type. See check_typedef for more
8614 details about how the typedef layer elimination is done.
8615
8616 brobecker/2010-11-19: It seems to me that the only case where it is
8617 useful to preserve the typedef layer is when dealing with fat pointers.
8618 Perhaps, we could add a check for that and preserve the typedef layer
8619 only in that situation. But this seems unnecessary so far, probably
8620 because we call check_typedef/ada_check_typedef pretty much everywhere.
8621 */
8622 if (type->code () == TYPE_CODE_TYPEDEF
8624 == TYPE_MAIN_TYPE (fixed_type)))
8625 return type;
8626
8627 return fixed_type;
8628}
8629
8630/* A standard (static-sized) type corresponding as well as possible to
8631 TYPE0, but based on no runtime data. */
8632
8633static struct type *
8635{
8636 struct type *type;
8637
8638 if (type0 == NULL)
8639 return NULL;
8640
8641 if (type0->is_fixed_instance ())
8642 return type0;
8643
8644 type0 = ada_check_typedef (type0);
8645
8646 switch (type0->code ())
8647 {
8648 default:
8649 return type0;
8650 case TYPE_CODE_STRUCT:
8651 type = dynamic_template_type (type0);
8652 if (type != NULL)
8654 else
8655 return template_to_static_fixed_type (type0);
8656 case TYPE_CODE_UNION:
8657 type = ada_find_parallel_type (type0, "___XVU");
8658 if (type != NULL)
8660 else
8661 return template_to_static_fixed_type (type0);
8662 }
8663}
8664
8665/* A static approximation of TYPE with all type wrappers removed. */
8666
8667static struct type *
8669{
8671 {
8672 struct type *type1 = ada_check_typedef (type)->field (0).type ();
8673 if (ada_type_name (type1) == NULL)
8674 type1->set_name (ada_type_name (type));
8675
8676 return static_unwrap_type (type1);
8677 }
8678 else
8679 {
8680 struct type *raw_real_type = ada_get_base_type (type);
8681
8682 if (raw_real_type == type)
8683 return type;
8684 else
8685 return to_static_fixed_type (raw_real_type);
8686 }
8687}
8688
8689/* In some cases, incomplete and private types require
8690 cross-references that are not resolved as records (for example,
8691 type Foo;
8692 type FooP is access Foo;
8693 V: FooP;
8694 type Foo is array ...;
8695 ). In these cases, since there is no mechanism for producing
8696 cross-references to such types, we instead substitute for FooP a
8697 stub enumeration type that is nowhere resolved, and whose tag is
8698 the name of the actual type. Call these types "non-record stubs". */
8699
8700/* A type equivalent to TYPE that is not a non-record stub, if one
8701 exists, otherwise TYPE. */
8702
8703struct type *
8705{
8706 if (type == NULL)
8707 return NULL;
8708
8709 /* If our type is an access to an unconstrained array, which is encoded
8710 as a TYPE_CODE_TYPEDEF of a fat pointer, then we're done.
8711 We don't want to strip the TYPE_CODE_TYPDEF layer, because this is
8712 what allows us to distinguish between fat pointers that represent
8713 array types, and fat pointers that represent array access types
8714 (in both cases, the compiler implements them as fat pointers). */
8716 return type;
8717
8719 if (type == NULL || type->code () != TYPE_CODE_ENUM
8720 || !type->is_stub ()
8721 || type->name () == NULL)
8722 return type;
8723 else
8724 {
8725 const char *name = type->name ();
8726 struct type *type1 = ada_find_any_type (name);
8727
8728 if (type1 == NULL)
8729 return type;
8730
8731 /* TYPE1 might itself be a TYPE_CODE_TYPEDEF (this can happen with
8732 stubs pointing to arrays, as we don't create symbols for array
8733 types, only for the typedef-to-array types). If that's the case,
8734 strip the typedef layer. */
8735 if (type1->code () == TYPE_CODE_TYPEDEF)
8736 type1 = ada_check_typedef (type1);
8737
8738 return type1;
8739 }
8740}
8741
8742/* A value representing the data at VALADDR/ADDRESS as described by
8743 type TYPE0, but with a standard (static-sized) type that correctly
8744 describes it. If VAL0 is not NULL and TYPE0 already is a standard
8745 type, then return VAL0 [this feature is simply to avoid redundant
8746 creation of struct values]. */
8747
8748static struct value *
8749ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
8750 struct value *val0)
8751{
8752 struct type *type = ada_to_fixed_type (type0, 0, address, NULL, 1);
8753
8754 if (type == type0 && val0 != NULL)
8755 return val0;
8756
8757 if (val0->lval () != lval_memory)
8758 {
8759 /* Our value does not live in memory; it could be a convenience
8760 variable, for instance. Create a not_lval value using val0's
8761 contents. */
8762 return value_from_contents (type, val0->contents ().data ());
8763 }
8764
8765 return value_from_contents_and_address (type, 0, address);
8766}
8767
8768/* A value representing VAL, but with a standard (static-sized) type
8769 that correctly describes it. Does not necessarily create a new
8770 value. */
8771
8772struct value *
8774{
8775 val = unwrap_value (val);
8776 val = ada_to_fixed_value_create (val->type (), val->address (), val);
8777 return val;
8778}
8779
8780
8781/* Attributes */
8782
8783/* Evaluate the 'POS attribute applied to ARG. */
8784
8785static LONGEST
8786pos_atr (struct value *arg)
8787{
8788 struct value *val = coerce_ref (arg);
8789 struct type *type = val->type ();
8790
8791 if (!discrete_type_p (type))
8792 error (_("'POS only defined on discrete types"));
8793
8794 gdb::optional<LONGEST> result = discrete_position (type, value_as_long (val));
8795 if (!result.has_value ())
8796 error (_("enumeration value is invalid: can't find 'POS"));
8797
8798 return *result;
8799}
8800
8801struct value *
8802ada_pos_atr (struct type *expect_type,
8803 struct expression *exp,
8804 enum noside noside, enum exp_opcode op,
8805 struct value *arg)
8806{
8807 struct type *type = builtin_type (exp->gdbarch)->builtin_int;
8809 return value::zero (type, not_lval);
8810 return value_from_longest (type, pos_atr (arg));
8811}
8812
8813/* Evaluate the TYPE'VAL attribute applied to ARG. */
8814
8815static struct value *
8816val_atr (struct type *type, LONGEST val)
8817{
8818 gdb_assert (discrete_type_p (type));
8819 if (type->code () == TYPE_CODE_RANGE)
8820 type = type->target_type ();
8821 if (type->code () == TYPE_CODE_ENUM)
8822 {
8823 if (val < 0 || val >= type->num_fields ())
8824 error (_("argument to 'VAL out of range"));
8825 val = type->field (val).loc_enumval ();
8826 }
8827 return value_from_longest (type, val);
8828}
8829
8830struct value *
8831ada_val_atr (struct expression *exp, enum noside noside, struct type *type,
8832 struct value *arg)
8833{
8835 return value::zero (type, not_lval);
8836
8837 if (!discrete_type_p (type))
8838 error (_("'VAL only defined on discrete types"));
8839 if (!integer_type_p (arg->type ()))
8840 error (_("'VAL requires integral argument"));
8841
8842 return val_atr (type, value_as_long (arg));
8843}
8844
8845/* Implementation of the enum_rep attribute. */
8846struct value *
8847ada_atr_enum_rep (struct expression *exp, enum noside noside, struct type *type,
8848 struct value *arg)
8849{
8850 struct type *inttype = builtin_type (exp->gdbarch)->builtin_int;
8852 return value::zero (inttype, not_lval);
8853
8854 if (type->code () == TYPE_CODE_RANGE)
8855 type = type->target_type ();
8856 if (type->code () != TYPE_CODE_ENUM)
8857 error (_("'Enum_Rep only defined on enum types"));
8858 if (!types_equal (type, arg->type ()))
8859 error (_("'Enum_Rep requires argument to have same type as enum"));
8860
8861 return value_cast (inttype, arg);
8862}
8863
8864/* Implementation of the enum_val attribute. */
8865struct value *
8866ada_atr_enum_val (struct expression *exp, enum noside noside, struct type *type,
8867 struct value *arg)
8868{
8869 struct type *original_type = type;
8871 return value::zero (original_type, not_lval);
8872
8873 if (type->code () == TYPE_CODE_RANGE)
8874 type = type->target_type ();
8875 if (type->code () != TYPE_CODE_ENUM)
8876 error (_("'Enum_Val only defined on enum types"));
8877 if (!integer_type_p (arg->type ()))
8878 error (_("'Enum_Val requires integral argument"));
8879
8880 LONGEST value = value_as_long (arg);
8881 for (int i = 0; i < type->num_fields (); ++i)
8882 {
8883 if (type->field (i).loc_enumval () == value)
8884 return value_from_longest (original_type, value);
8885 }
8886
8887 error (_("value %s not found in enum"), plongest (value));
8888}
8889
8890
8891
8892 /* Evaluation */
8893
8894/* True if TYPE appears to be an Ada character type.
8895 [At the moment, this is true only for Character and Wide_Character;
8896 It is a heuristic test that could stand improvement]. */
8897
8898bool
8900{
8901 const char *name;
8902
8903 /* If the type code says it's a character, then assume it really is,
8904 and don't check any further. */
8905 if (type->code () == TYPE_CODE_CHAR)
8906 return true;
8907
8908 /* Otherwise, assume it's a character type iff it is a discrete type
8909 with a known character type name. */
8911 return (name != NULL
8912 && (type->code () == TYPE_CODE_INT
8913 || type->code () == TYPE_CODE_RANGE)
8914 && (strcmp (name, "character") == 0
8915 || strcmp (name, "wide_character") == 0
8916 || strcmp (name, "wide_wide_character") == 0
8917 || strcmp (name, "unsigned char") == 0));
8918}
8919
8920/* True if TYPE appears to be an Ada string type. */
8921
8922bool
8924{
8926 if (type != NULL
8927 && type->code () != TYPE_CODE_PTR
8930 && ada_array_arity (type) == 1)
8931 {
8932 struct type *elttype = ada_array_element_type (type, 1);
8933
8934 return ada_is_character_type (elttype);
8935 }
8936 else
8937 return false;
8938}
8939
8940/* The compiler sometimes provides a parallel XVS type for a given
8941 PAD type. Normally, it is safe to follow the PAD type directly,
8942 but older versions of the compiler have a bug that causes the offset
8943 of its "F" field to be wrong. Following that field in that case
8944 would lead to incorrect results, but this can be worked around
8945 by ignoring the PAD type and using the associated XVS type instead.
8946
8947 Set to True if the debugger should trust the contents of PAD types.
8948 Otherwise, ignore the PAD type if there is a parallel XVS type. */
8949static bool trust_pad_over_xvs = true;
8950
8951/* True if TYPE is a struct type introduced by the compiler to force the
8952 alignment of a value. Such types have a single field with a
8953 distinctive name. */
8954
8955int
8957{
8959
8960 if (!trust_pad_over_xvs && ada_find_parallel_type (type, "___XVS") != NULL)
8961 return 0;
8962
8963 return (type->code () == TYPE_CODE_STRUCT
8964 && type->num_fields () == 1
8965 && strcmp (type->field (0).name (), "F") == 0);
8966}
8967
8968/* If there is an ___XVS-convention type parallel to SUBTYPE, return
8969 the parallel type. */
8970
8971struct type *
8972ada_get_base_type (struct type *raw_type)
8973{
8974 struct type *real_type_namer;
8975 struct type *raw_real_type;
8976
8977 if (raw_type == NULL || raw_type->code () != TYPE_CODE_STRUCT)
8978 return raw_type;
8979
8980 if (ada_is_aligner_type (raw_type))
8981 /* The encoding specifies that we should always use the aligner type.
8982 So, even if this aligner type has an associated XVS type, we should
8983 simply ignore it.
8984
8985 According to the compiler gurus, an XVS type parallel to an aligner
8986 type may exist because of a stabs limitation. In stabs, aligner
8987 types are empty because the field has a variable-sized type, and
8988 thus cannot actually be used as an aligner type. As a result,
8989 we need the associated parallel XVS type to decode the type.
8990 Since the policy in the compiler is to not change the internal
8991 representation based on the debugging info format, we sometimes
8992 end up having a redundant XVS type parallel to the aligner type. */
8993 return raw_type;
8994
8995 real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
8996 if (real_type_namer == NULL
8997 || real_type_namer->code () != TYPE_CODE_STRUCT
8998 || real_type_namer->num_fields () != 1)
8999 return raw_type;
9000
9001 if (real_type_namer->field (0).type ()->code () != TYPE_CODE_REF)
9002 {
9003 /* This is an older encoding form where the base type needs to be
9004 looked up by name. We prefer the newer encoding because it is
9005 more efficient. */
9006 raw_real_type = ada_find_any_type (real_type_namer->field (0).name ());
9007 if (raw_real_type == NULL)
9008 return raw_type;
9009 else
9010 return raw_real_type;
9011 }
9012
9013 /* The field in our XVS type is a reference to the base type. */
9014 return real_type_namer->field (0).type ()->target_type ();
9015}
9016
9017/* The type of value designated by TYPE, with all aligners removed. */
9018
9019struct type *
9021{
9023 return ada_aligned_type (type->field (0).type ());
9024 else
9025 return ada_get_base_type (type);
9026}
9027
9028
9029/* The address of the aligned value in an object at address VALADDR
9030 having type TYPE. Assumes ada_is_aligner_type (TYPE). */
9031
9032const gdb_byte *
9033ada_aligned_value_addr (struct type *type, const gdb_byte *valaddr)
9034{
9037 (type->field (0).type (),
9038 valaddr + type->field (0).loc_bitpos () / TARGET_CHAR_BIT);
9039 else
9040 return valaddr;
9041}
9042
9043
9044
9045/* The printed representation of an enumeration literal with encoded
9046 name NAME. The value is good to the next call of ada_enum_name. */
9047const char *
9048ada_enum_name (const char *name)
9049{
9050 static std::string storage;
9051 const char *tmp;
9052
9053 /* First, unqualify the enumeration name:
9054 1. Search for the last '.' character. If we find one, then skip
9055 all the preceding characters, the unqualified name starts
9056 right after that dot.
9057 2. Otherwise, we may be debugging on a target where the compiler
9058 translates dots into "__". Search forward for double underscores,
9059 but stop searching when we hit an overloading suffix, which is
9060 of the form "__" followed by digits. */
9061
9062 tmp = strrchr (name, '.');
9063 if (tmp != NULL)
9064 name = tmp + 1;
9065 else
9066 {
9067 while ((tmp = strstr (name, "__")) != NULL)
9068 {
9069 if (isdigit (tmp[2]))
9070 break;
9071 else
9072 name = tmp + 2;
9073 }
9074 }
9075
9076 if (name[0] == 'Q')
9077 {
9078 int v;
9079
9080 if (name[1] == 'U' || name[1] == 'W')
9081 {
9082 int offset = 2;
9083 if (name[1] == 'W' && name[2] == 'W')
9084 {
9085 /* Also handle the QWW case. */
9086 ++offset;
9087 }
9088 if (sscanf (name + offset, "%x", &v) != 1)
9089 return name;
9090 }
9091 else if (((name[1] >= '0' && name[1] <= '9')
9092 || (name[1] >= 'a' && name[1] <= 'z'))
9093 && name[2] == '\0')
9094 {
9095 storage = string_printf ("'%c'", name[1]);
9096 return storage.c_str ();
9097 }
9098 else
9099 return name;
9100
9101 if (isascii (v) && isprint (v))
9102 storage = string_printf ("'%c'", v);
9103 else if (name[1] == 'U')
9104 storage = string_printf ("'[\"%02x\"]'", v);
9105 else if (name[2] != 'W')
9106 storage = string_printf ("'[\"%04x\"]'", v);
9107 else
9108 storage = string_printf ("'[\"%06x\"]'", v);
9109
9110 return storage.c_str ();
9111 }
9112 else
9113 {
9114 tmp = strstr (name, "__");
9115 if (tmp == NULL)
9116 tmp = strstr (name, "$");
9117 if (tmp != NULL)
9118 {
9119 storage = std::string (name, tmp - name);
9120 return storage.c_str ();
9121 }
9122
9123 return name;
9124 }
9125}
9126
9127/* If TYPE is a dynamic type, return the base type. Otherwise, if
9128 there is no parallel type, return nullptr. */
9129
9130static struct type *
9132{
9133 struct type *raw_real_type
9135
9136 /* No parallel XVS or XVE type. */
9137 if (type == raw_real_type
9138 && ada_find_parallel_type (type, "___XVE") == nullptr)
9139 return nullptr;
9140
9141 return raw_real_type;
9142}
9143
9144/* If VAL is wrapped in an aligner or subtype wrapper, return the
9145 value it wraps. */
9146
9147static struct value *
9148unwrap_value (struct value *val)
9149{
9150 struct type *type = ada_check_typedef (val->type ());
9151
9153 {
9154 struct value *v = ada_value_struct_elt (val, "F", 0);
9155 struct type *val_type = ada_check_typedef (v->type ());
9156
9157 if (ada_type_name (val_type) == NULL)
9158 val_type->set_name (ada_type_name (type));
9159
9160 return unwrap_value (v);
9161 }
9162 else
9163 {
9164 struct type *raw_real_type = find_base_type (type);
9165 if (raw_real_type == nullptr)
9166 return val;
9167
9168 return
9170 (val, ada_to_fixed_type (raw_real_type, 0,
9171 val->address (),
9172 NULL, 1));
9173 }
9174}
9175
9176/* Given two array types T1 and T2, return nonzero iff both arrays
9177 contain the same number of elements. */
9178
9179static int
9180ada_same_array_size_p (struct type *t1, struct type *t2)
9181{
9182 LONGEST lo1, hi1, lo2, hi2;
9183
9184 /* Get the array bounds in order to verify that the size of
9185 the two arrays match. */
9186 if (!get_array_bounds (t1, &lo1, &hi1)
9187 || !get_array_bounds (t2, &lo2, &hi2))
9188 error (_("unable to determine array bounds"));
9189
9190 /* To make things easier for size comparison, normalize a bit
9191 the case of empty arrays by making sure that the difference
9192 between upper bound and lower bound is always -1. */
9193 if (lo1 > hi1)
9194 hi1 = lo1 - 1;
9195 if (lo2 > hi2)
9196 hi2 = lo2 - 1;
9197
9198 return (hi1 - lo1 == hi2 - lo2);
9199}
9200
9201/* Assuming that VAL is an array of integrals, and TYPE represents
9202 an array with the same number of elements, but with wider integral
9203 elements, return an array "casted" to TYPE. In practice, this
9204 means that the returned array is built by casting each element
9205 of the original array into TYPE's (wider) element type. */
9206
9207static struct value *
9209{
9210 struct type *elt_type = type->target_type ();
9211 LONGEST lo, hi;
9212 LONGEST i;
9213
9214 /* Verify that both val and type are arrays of scalars, and
9215 that the size of val's elements is smaller than the size
9216 of type's element. */
9217 gdb_assert (type->code () == TYPE_CODE_ARRAY);
9218 gdb_assert (is_integral_type (type->target_type ()));
9219 gdb_assert (val->type ()->code () == TYPE_CODE_ARRAY);
9220 gdb_assert (is_integral_type (val->type ()->target_type ()));
9221 gdb_assert (type->target_type ()->length ()
9222 > val->type ()->target_type ()->length ());
9223
9224 if (!get_array_bounds (type, &lo, &hi))
9225 error (_("unable to determine array bounds"));
9226
9227 value *res = value::allocate (type);
9228 gdb::array_view<gdb_byte> res_contents = res->contents_writeable ();
9229
9230 /* Promote each array element. */
9231 for (i = 0; i < hi - lo + 1; i++)
9232 {
9233 struct value *elt = value_cast (elt_type, value_subscript (val, lo + i));
9234 int elt_len = elt_type->length ();
9235
9236 copy (elt->contents_all (), res_contents.slice (elt_len * i, elt_len));
9237 }
9238
9239 return res;
9240}
9241
9242/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
9243 return the converted value. */
9244
9245static struct value *
9246coerce_for_assign (struct type *type, struct value *val)
9247{
9248 struct type *type2 = val->type ();
9249
9250 if (type == type2)
9251 return val;
9252
9253 type2 = ada_check_typedef (type2);
9255
9256 if (type2->code () == TYPE_CODE_PTR
9257 && type->code () == TYPE_CODE_ARRAY)
9258 {
9259 val = ada_value_ind (val);
9260 type2 = val->type ();
9261 }
9262
9263 if (type2->code () == TYPE_CODE_ARRAY
9264 && type->code () == TYPE_CODE_ARRAY)
9265 {
9266 if (!ada_same_array_size_p (type, type2))
9267 error (_("cannot assign arrays of different length"));
9268
9270 && is_integral_type (type2->target_type ())
9271 && type2->target_type ()->length () < type->target_type ()->length ())
9272 {
9273 /* Allow implicit promotion of the array elements to
9274 a wider type. */
9276 }
9277
9278 if (type2->target_type ()->length () != type->target_type ()->length ())
9279 error (_("Incompatible types in assignment"));
9281 }
9282 return val;
9283}
9284
9285static struct value *
9286ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
9287{
9288 struct type *type1, *type2;
9289
9290 arg1 = coerce_ref (arg1);
9291 arg2 = coerce_ref (arg2);
9292 type1 = get_base_type (ada_check_typedef (arg1->type ()));
9293 type2 = get_base_type (ada_check_typedef (arg2->type ()));
9294
9295 if (type1->code () != TYPE_CODE_INT
9296 || type2->code () != TYPE_CODE_INT)
9297 return value_binop (arg1, arg2, op);
9298
9299 switch (op)
9300 {
9301 case BINOP_MOD:
9302 case BINOP_DIV:
9303 case BINOP_REM:
9304 break;
9305 default:
9306 return value_binop (arg1, arg2, op);
9307 }
9308
9309 gdb_mpz v2 = value_as_mpz (arg2);
9310 if (v2.sgn () == 0)
9311 {
9312 const char *name;
9313 if (op == BINOP_MOD)
9314 name = "mod";
9315 else if (op == BINOP_DIV)
9316 name = "/";
9317 else
9318 {
9319 gdb_assert (op == BINOP_REM);
9320 name = "rem";
9321 }
9322
9323 error (_("second operand of %s must not be zero."), name);
9324 }
9325
9326 if (type1->is_unsigned () || op == BINOP_MOD)
9327 return value_binop (arg1, arg2, op);
9328
9329 gdb_mpz v1 = value_as_mpz (arg1);
9330 gdb_mpz v;
9331 switch (op)
9332 {
9333 case BINOP_DIV:
9334 v = v1 / v2;
9335 break;
9336 case BINOP_REM:
9337 v = v1 % v2;
9338 if (v * v1 < 0)
9339 v -= v2;
9340 break;
9341 default:
9342 /* Should not reach this point. */
9343 gdb_assert_not_reached ("invalid operator");
9344 }
9345
9346 return value_from_mpz (type1, v);
9347}
9348
9349static int
9350ada_value_equal (struct value *arg1, struct value *arg2)
9351{
9352 if (ada_is_direct_array_type (arg1->type ())
9353 || ada_is_direct_array_type (arg2->type ()))
9354 {
9355 struct type *arg1_type, *arg2_type;
9356
9357 /* Automatically dereference any array reference before
9358 we attempt to perform the comparison. */
9359 arg1 = ada_coerce_ref (arg1);
9360 arg2 = ada_coerce_ref (arg2);
9361
9362 arg1 = ada_coerce_to_simple_array (arg1);
9363 arg2 = ada_coerce_to_simple_array (arg2);
9364
9365 arg1_type = ada_check_typedef (arg1->type ());
9366 arg2_type = ada_check_typedef (arg2->type ());
9367
9368 if (arg1_type->code () != TYPE_CODE_ARRAY
9369 || arg2_type->code () != TYPE_CODE_ARRAY)
9370 error (_("Attempt to compare array with non-array"));
9371 /* FIXME: The following works only for types whose
9372 representations use all bits (no padding or undefined bits)
9373 and do not have user-defined equality. */
9374 return (arg1_type->length () == arg2_type->length ()
9375 && memcmp (arg1->contents ().data (),
9376 arg2->contents ().data (),
9377 arg1_type->length ()) == 0);
9378 }
9379 return value_equal (arg1, arg2);
9380}
9381
9382namespace expr
9383{
9384
9385bool
9386check_objfile (const std::unique_ptr<ada_component> &comp,
9387 struct objfile *objfile)
9388{
9389 return comp->uses_objfile (objfile);
9390}
9391
9392/* Assign the result of evaluating ARG starting at *POS to the INDEXth
9393 component of LHS (a simple array or a record). Does not modify the
9394 inferior's memory, nor does it modify LHS (unless LHS ==
9395 CONTAINER). */
9396
9397static void
9398assign_component (struct value *container, struct value *lhs, LONGEST index,
9399 struct expression *exp, operation_up &arg)
9400{
9401 scoped_value_mark mark;
9402
9403 struct value *elt;
9404 struct type *lhs_type = check_typedef (lhs->type ());
9405
9406 if (lhs_type->code () == TYPE_CODE_ARRAY)
9407 {
9408 struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
9409 struct value *index_val = value_from_longest (index_type, index);
9410
9411 elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
9412 }
9413 else
9414 {
9415 elt = ada_index_struct_field (index, lhs, 0, lhs->type ());
9416 elt = ada_to_fixed_value (elt);
9417 }
9418
9420 = dynamic_cast<ada_aggregate_operation *> (arg.get ());
9421 if (ag_op != nullptr)
9422 ag_op->assign_aggregate (container, elt, exp);
9423 else
9424 value_assign_to_component (container, elt,
9425 arg->evaluate (nullptr, exp,
9426 EVAL_NORMAL));
9427}
9428
9429bool
9431{
9432 for (const auto &item : m_components)
9433 if (item->uses_objfile (objfile))
9434 return true;
9435 return false;
9436}
9437
9438void
9440{
9441 gdb_printf (stream, _("%*sAggregate\n"), depth, "");
9442 for (const auto &item : m_components)
9443 item->dump (stream, depth + 1);
9444}
9445
9446void
9448 struct value *lhs, struct expression *exp,
9449 std::vector<LONGEST> &indices,
9450 LONGEST low, LONGEST high)
9451{
9452 for (auto &item : m_components)
9453 item->assign (container, lhs, exp, indices, low, high);
9454}
9455
9456/* See ada-exp.h. */
9457
9458value *
9460 struct value *lhs,
9461 struct expression *exp)
9462{
9463 struct type *lhs_type;
9464 LONGEST low_index, high_index;
9465
9466 container = ada_coerce_ref (container);
9467 if (ada_is_direct_array_type (container->type ()))
9468 container = ada_coerce_to_simple_array (container);
9469 lhs = ada_coerce_ref (lhs);
9470 if (!lhs->deprecated_modifiable ())
9471 error (_("Left operand of assignment is not a modifiable lvalue."));
9472
9473 lhs_type = check_typedef (lhs->type ());
9474 if (ada_is_direct_array_type (lhs_type))
9475 {
9476 lhs = ada_coerce_to_simple_array (lhs);
9477 lhs_type = check_typedef (lhs->type ());
9478 low_index = lhs_type->bounds ()->low.const_val ();
9479 high_index = lhs_type->bounds ()->high.const_val ();
9480 }
9481 else if (lhs_type->code () == TYPE_CODE_STRUCT)
9482 {
9483 low_index = 0;
9484 high_index = num_visible_fields (lhs_type) - 1;
9485 }
9486 else
9487 error (_("Left-hand side must be array or record."));
9488
9489 std::vector<LONGEST> indices (4);
9490 indices[0] = indices[1] = low_index - 1;
9491 indices[2] = indices[3] = high_index + 1;
9492
9493 std::get<0> (m_storage)->assign (container, lhs, exp, indices,
9494 low_index, high_index);
9495
9496 return container;
9497}
9498
9499bool
9501{
9502 return m_op->uses_objfile (objfile);
9503}
9504
9505void
9507{
9508 gdb_printf (stream, _("%*sPositional, index = %d\n"),
9509 depth, "", m_index);
9510 m_op->dump (stream, depth + 1);
9511}
9512
9513/* Assign into the component of LHS indexed by the OP_POSITIONAL
9514 construct, given that the positions are relative to lower bound
9515 LOW, where HIGH is the upper bound. Record the position in
9516 INDICES. CONTAINER is as for assign_aggregate. */
9517void
9519 struct value *lhs, struct expression *exp,
9520 std::vector<LONGEST> &indices,
9521 LONGEST low, LONGEST high)
9522{
9523 LONGEST ind = m_index + low;
9524
9525 if (ind - 1 == high)
9526 warning (_("Extra components in aggregate ignored."));
9527 if (ind <= high)
9528 {
9529 add_component_interval (ind, ind, indices);
9530 assign_component (container, lhs, ind, exp, m_op);
9531 }
9532}
9533
9534bool
9536{
9537 return m_low->uses_objfile (objfile) || m_high->uses_objfile (objfile);
9538}
9539
9540void
9542{
9543 gdb_printf (stream, _("%*sDiscrete range:\n"), depth, "");
9544 m_low->dump (stream, depth + 1);
9545 m_high->dump (stream, depth + 1);
9546}
9547
9548void
9550 struct value *lhs,
9551 struct expression *exp,
9552 std::vector<LONGEST> &indices,
9553 LONGEST low, LONGEST high,
9554 operation_up &op)
9555{
9556 LONGEST lower = value_as_long (m_low->evaluate (nullptr, exp, EVAL_NORMAL));
9557 LONGEST upper = value_as_long (m_high->evaluate (nullptr, exp, EVAL_NORMAL));
9558
9559 if (lower <= upper && (lower < low || upper > high))
9560 error (_("Index in component association out of bounds."));
9561
9562 add_component_interval (lower, upper, indices);
9563 while (lower <= upper)
9564 {
9565 assign_component (container, lhs, lower, exp, op);
9566 lower += 1;
9567 }
9568}
9569
9570bool
9572{
9573 return m_val->uses_objfile (objfile);
9574}
9575
9576void
9578{
9579 gdb_printf (stream, _("%*sName:\n"), depth, "");
9580 m_val->dump (stream, depth + 1);
9581}
9582
9583void
9585 struct value *lhs,
9586 struct expression *exp,
9587 std::vector<LONGEST> &indices,
9588 LONGEST low, LONGEST high,
9589 operation_up &op)
9590{
9591 int index;
9592
9593 if (ada_is_direct_array_type (lhs->type ()))
9594 index = longest_to_int (value_as_long (m_val->evaluate (nullptr, exp,
9595 EVAL_NORMAL)));
9596 else
9597 {
9599 = dynamic_cast<ada_string_operation *> (m_val.get ());
9600
9601 const char *name;
9602 if (strop != nullptr)
9603 name = strop->get_name ();
9604 else
9605 {
9607 = dynamic_cast<ada_var_value_operation *> (m_val.get ());
9608 if (vvo == nullptr)
9609 error (_("Invalid record component association."));
9610 name = vvo->get_symbol ()->natural_name ();
9611 /* In this scenario, the user wrote (name => expr), but
9612 write_name_assoc found some fully-qualified name and
9613 substituted it. This happens because, at parse time, the
9614 meaning of the expression isn't known; but here we know
9615 that just the base name was supplied and it refers to the
9616 name of a field. */
9618 }
9619
9620 index = 0;
9621 if (! find_struct_field (name, lhs->type (), 0,
9622 NULL, NULL, NULL, NULL, &index))
9623 error (_("Unknown component name: %s."), name);
9624 }
9625
9626 add_component_interval (index, index, indices);
9627 assign_component (container, lhs, index, exp, op);
9628}
9629
9630bool
9632{
9633 if (m_op->uses_objfile (objfile))
9634 return true;
9635 for (const auto &item : m_assocs)
9636 if (item->uses_objfile (objfile))
9637 return true;
9638 return false;
9639}
9640
9641void
9643{
9644 gdb_printf (stream, _("%*sChoices:\n"), depth, "");
9645 m_op->dump (stream, depth + 1);
9646 for (const auto &item : m_assocs)
9647 item->dump (stream, depth + 1);
9648}
9649
9650/* Assign into the components of LHS indexed by the OP_CHOICES
9651 construct at *POS, updating *POS past the construct, given that
9652 the allowable indices are LOW..HIGH. Record the indices assigned
9653 to in INDICES. CONTAINER is as for assign_aggregate. */
9654void
9656 struct value *lhs, struct expression *exp,
9657 std::vector<LONGEST> &indices,
9658 LONGEST low, LONGEST high)
9659{
9660 for (auto &item : m_assocs)
9661 item->assign (container, lhs, exp, indices, low, high, m_op);
9662}
9663
9664bool
9666{
9667 return m_op->uses_objfile (objfile);
9668}
9669
9670void
9672{
9673 gdb_printf (stream, _("%*sOthers:\n"), depth, "");
9674 m_op->dump (stream, depth + 1);
9675}
9676
9677/* Assign the value of the expression in the OP_OTHERS construct in
9678 EXP at *POS into the components of LHS indexed from LOW .. HIGH that
9679 have not been previously assigned. The index intervals already assigned
9680 are in INDICES. CONTAINER is as for assign_aggregate. */
9681void
9683 struct value *lhs, struct expression *exp,
9684 std::vector<LONGEST> &indices,
9685 LONGEST low, LONGEST high)
9686{
9687 int num_indices = indices.size ();
9688 for (int i = 0; i < num_indices - 2; i += 2)
9689 {
9690 for (LONGEST ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
9691 assign_component (container, lhs, ind, exp, m_op);
9692 }
9693}
9694
9695struct value *
9697 struct expression *exp,
9698 enum noside noside)
9699{
9700 value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
9701 scoped_restore save_lhs = make_scoped_restore (&m_current, arg1);
9702
9704 = dynamic_cast<ada_aggregate_operation *> (std::get<1> (m_storage).get ());
9705 if (ag_op != nullptr)
9706 {
9707 if (noside != EVAL_NORMAL)
9708 return arg1;
9709
9710 arg1 = ag_op->assign_aggregate (arg1, arg1, exp);
9711 return ada_value_assign (arg1, arg1);
9712 }
9713 /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
9714 except if the lhs of our assignment is a convenience variable.
9715 In the case of assigning to a convenience variable, the lhs
9716 should be exactly the result of the evaluation of the rhs. */
9717 struct type *type = arg1->type ();
9718 if (arg1->lval () == lval_internalvar)
9719 type = NULL;
9720 value *arg2 = std::get<1> (m_storage)->evaluate (type, exp, noside);
9722 return arg1;
9723 if (arg1->lval () == lval_internalvar)
9724 {
9725 /* Nothing. */
9726 }
9727 else
9728 arg2 = coerce_for_assign (arg1->type (), arg2);
9729 return ada_value_assign (arg1, arg2);
9730}
9731
9732} /* namespace expr */
9733
9734/* Add the interval [LOW .. HIGH] to the sorted set of intervals
9735 [ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
9736 overlap. */
9737static void
9738add_component_interval (LONGEST low, LONGEST high,
9739 std::vector<LONGEST> &indices)
9740{
9741 int i, j;
9742
9743 int size = indices.size ();
9744 for (i = 0; i < size; i += 2) {
9745 if (high >= indices[i] && low <= indices[i + 1])
9746 {
9747 int kh;
9748
9749 for (kh = i + 2; kh < size; kh += 2)
9750 if (high < indices[kh])
9751 break;
9752 if (low < indices[i])
9753 indices[i] = low;
9754 indices[i + 1] = indices[kh - 1];
9755 if (high > indices[i + 1])
9756 indices[i + 1] = high;
9757 memcpy (indices.data () + i + 2, indices.data () + kh, size - kh);
9758 indices.resize (kh - i - 2);
9759 return;
9760 }
9761 else if (high < indices[i])
9762 break;
9763 }
9764
9765 indices.resize (indices.size () + 2);
9766 for (j = indices.size () - 1; j >= i + 2; j -= 1)
9767 indices[j] = indices[j - 2];
9768 indices[i] = low;
9769 indices[i + 1] = high;
9770}
9771
9772/* Perform and Ada cast of ARG2 to type TYPE if the type of ARG2
9773 is different. */
9774
9775static struct value *
9776ada_value_cast (struct type *type, struct value *arg2)
9777{
9778 if (type == ada_check_typedef (arg2->type ()))
9779 return arg2;
9780
9781 return value_cast (type, arg2);
9782}
9783
9784/* Evaluating Ada expressions, and printing their result.
9785 ------------------------------------------------------
9786
9787 1. Introduction:
9788 ----------------
9789
9790 We usually evaluate an Ada expression in order to print its value.
9791 We also evaluate an expression in order to print its type, which
9792 happens during the EVAL_AVOID_SIDE_EFFECTS phase of the evaluation,
9793 but we'll focus mostly on the EVAL_NORMAL phase. In practice, the
9794 EVAL_AVOID_SIDE_EFFECTS phase allows us to simplify certain aspects of
9795 the evaluation compared to the EVAL_NORMAL, but is otherwise very
9796 similar.
9797
9798 Evaluating expressions is a little more complicated for Ada entities
9799 than it is for entities in languages such as C. The main reason for
9800 this is that Ada provides types whose definition might be dynamic.
9801 One example of such types is variant records. Or another example
9802 would be an array whose bounds can only be known at run time.
9803
9804 The following description is a general guide as to what should be
9805 done (and what should NOT be done) in order to evaluate an expression
9806 involving such types, and when. This does not cover how the semantic
9807 information is encoded by GNAT as this is covered separatly. For the
9808 document used as the reference for the GNAT encoding, see exp_dbug.ads
9809 in the GNAT sources.
9810
9811 Ideally, we should embed each part of this description next to its
9812 associated code. Unfortunately, the amount of code is so vast right
9813 now that it's hard to see whether the code handling a particular
9814 situation might be duplicated or not. One day, when the code is
9815 cleaned up, this guide might become redundant with the comments
9816 inserted in the code, and we might want to remove it.
9817
9818 2. ``Fixing'' an Entity, the Simple Case:
9819 -----------------------------------------
9820
9821 When evaluating Ada expressions, the tricky issue is that they may
9822 reference entities whose type contents and size are not statically
9823 known. Consider for instance a variant record:
9824
9825 type Rec (Empty : Boolean := True) is record
9826 case Empty is
9827 when True => null;
9828 when False => Value : Integer;
9829 end case;
9830 end record;
9831 Yes : Rec := (Empty => False, Value => 1);
9832 No : Rec := (empty => True);
9833
9834 The size and contents of that record depends on the value of the
9835 discriminant (Rec.Empty). At this point, neither the debugging
9836 information nor the associated type structure in GDB are able to
9837 express such dynamic types. So what the debugger does is to create
9838 "fixed" versions of the type that applies to the specific object.
9839 We also informally refer to this operation as "fixing" an object,
9840 which means creating its associated fixed type.
9841
9842 Example: when printing the value of variable "Yes" above, its fixed
9843 type would look like this:
9844
9845 type Rec is record
9846 Empty : Boolean;
9847 Value : Integer;
9848 end record;
9849
9850 On the other hand, if we printed the value of "No", its fixed type
9851 would become:
9852
9853 type Rec is record
9854 Empty : Boolean;
9855 end record;
9856
9857 Things become a little more complicated when trying to fix an entity
9858 with a dynamic type that directly contains another dynamic type,
9859 such as an array of variant records, for instance. There are
9860 two possible cases: Arrays, and records.
9861
9862 3. ``Fixing'' Arrays:
9863 ---------------------
9864
9865 The type structure in GDB describes an array in terms of its bounds,
9866 and the type of its elements. By design, all elements in the array
9867 have the same type and we cannot represent an array of variant elements
9868 using the current type structure in GDB. When fixing an array,
9869 we cannot fix the array element, as we would potentially need one
9870 fixed type per element of the array. As a result, the best we can do
9871 when fixing an array is to produce an array whose bounds and size
9872 are correct (allowing us to read it from memory), but without having
9873 touched its element type. Fixing each element will be done later,
9874 when (if) necessary.
9875
9876 Arrays are a little simpler to handle than records, because the same
9877 amount of memory is allocated for each element of the array, even if
9878 the amount of space actually used by each element differs from element
9879 to element. Consider for instance the following array of type Rec:
9880
9881 type Rec_Array is array (1 .. 2) of Rec;
9882
9883 The actual amount of memory occupied by each element might be different
9884 from element to element, depending on the value of their discriminant.
9885 But the amount of space reserved for each element in the array remains
9886 fixed regardless. So we simply need to compute that size using
9887 the debugging information available, from which we can then determine
9888 the array size (we multiply the number of elements of the array by
9889 the size of each element).
9890
9891 The simplest case is when we have an array of a constrained element
9892 type. For instance, consider the following type declarations:
9893
9894 type Bounded_String (Max_Size : Integer) is
9895 Length : Integer;
9896 Buffer : String (1 .. Max_Size);
9897 end record;
9898 type Bounded_String_Array is array (1 ..2) of Bounded_String (80);
9899
9900 In this case, the compiler describes the array as an array of
9901 variable-size elements (identified by its XVS suffix) for which
9902 the size can be read in the parallel XVZ variable.
9903
9904 In the case of an array of an unconstrained element type, the compiler
9905 wraps the array element inside a private PAD type. This type should not
9906 be shown to the user, and must be "unwrap"'ed before printing. Note
9907 that we also use the adjective "aligner" in our code to designate
9908 these wrapper types.
9909
9910 In some cases, the size allocated for each element is statically
9911 known. In that case, the PAD type already has the correct size,
9912 and the array element should remain unfixed.
9913
9914 But there are cases when this size is not statically known.
9915 For instance, assuming that "Five" is an integer variable:
9916
9917 type Dynamic is array (1 .. Five) of Integer;
9918 type Wrapper (Has_Length : Boolean := False) is record
9919 Data : Dynamic;
9920 case Has_Length is
9921 when True => Length : Integer;
9922 when False => null;
9923 end case;
9924 end record;
9925 type Wrapper_Array is array (1 .. 2) of Wrapper;
9926
9927 Hello : Wrapper_Array := (others => (Has_Length => True,
9928 Data => (others => 17),
9929 Length => 1));
9930
9931
9932 The debugging info would describe variable Hello as being an
9933 array of a PAD type. The size of that PAD type is not statically
9934 known, but can be determined using a parallel XVZ variable.
9935 In that case, a copy of the PAD type with the correct size should
9936 be used for the fixed array.
9937
9938 3. ``Fixing'' record type objects:
9939 ----------------------------------
9940
9941 Things are slightly different from arrays in the case of dynamic
9942 record types. In this case, in order to compute the associated
9943 fixed type, we need to determine the size and offset of each of
9944 its components. This, in turn, requires us to compute the fixed
9945 type of each of these components.
9946
9947 Consider for instance the example:
9948
9949 type Bounded_String (Max_Size : Natural) is record
9950 Str : String (1 .. Max_Size);
9951 Length : Natural;
9952 end record;
9953 My_String : Bounded_String (Max_Size => 10);
9954
9955 In that case, the position of field "Length" depends on the size
9956 of field Str, which itself depends on the value of the Max_Size
9957 discriminant. In order to fix the type of variable My_String,
9958 we need to fix the type of field Str. Therefore, fixing a variant
9959 record requires us to fix each of its components.
9960
9961 However, if a component does not have a dynamic size, the component
9962 should not be fixed. In particular, fields that use a PAD type
9963 should not fixed. Here is an example where this might happen
9964 (assuming type Rec above):
9965
9966 type Container (Big : Boolean) is record
9967 First : Rec;
9968 After : Integer;
9969 case Big is
9970 when True => Another : Integer;
9971 when False => null;
9972 end case;
9973 end record;
9974 My_Container : Container := (Big => False,
9975 First => (Empty => True),
9976 After => 42);
9977
9978 In that example, the compiler creates a PAD type for component First,
9979 whose size is constant, and then positions the component After just
9980 right after it. The offset of component After is therefore constant
9981 in this case.
9982
9983 The debugger computes the position of each field based on an algorithm
9984 that uses, among other things, the actual position and size of the field
9985 preceding it. Let's now imagine that the user is trying to print
9986 the value of My_Container. If the type fixing was recursive, we would
9987 end up computing the offset of field After based on the size of the
9988 fixed version of field First. And since in our example First has
9989 only one actual field, the size of the fixed type is actually smaller
9990 than the amount of space allocated to that field, and thus we would
9991 compute the wrong offset of field After.
9992
9993 To make things more complicated, we need to watch out for dynamic
9994 components of variant records (identified by the ___XVL suffix in
9995 the component name). Even if the target type is a PAD type, the size
9996 of that type might not be statically known. So the PAD type needs
9997 to be unwrapped and the resulting type needs to be fixed. Otherwise,
9998 we might end up with the wrong size for our component. This can be
9999 observed with the following type declarations:
10000
10001 type Octal is new Integer range 0 .. 7;
10002 type Octal_Array is array (Positive range <>) of Octal;
10003 pragma Pack (Octal_Array);
10004
10005 type Octal_Buffer (Size : Positive) is record
10006 Buffer : Octal_Array (1 .. Size);
10007 Length : Integer;
10008 end record;
10009
10010 In that case, Buffer is a PAD type whose size is unset and needs
10011 to be computed by fixing the unwrapped type.
10012
10013 4. When to ``Fix'' un-``Fixed'' sub-elements of an entity:
10014 ----------------------------------------------------------
10015
10016 Lastly, when should the sub-elements of an entity that remained unfixed
10017 thus far, be actually fixed?
10018
10019 The answer is: Only when referencing that element. For instance
10020 when selecting one component of a record, this specific component
10021 should be fixed at that point in time. Or when printing the value
10022 of a record, each component should be fixed before its value gets
10023 printed. Similarly for arrays, the element of the array should be
10024 fixed when printing each element of the array, or when extracting
10025 one element out of that array. On the other hand, fixing should
10026 not be performed on the elements when taking a slice of an array!
10027
10028 Note that one of the side effects of miscomputing the offset and
10029 size of each field is that we end up also miscomputing the size
10030 of the containing type. This can have adverse results when computing
10031 the value of an entity. GDB fetches the value of an entity based
10032 on the size of its type, and thus a wrong size causes GDB to fetch
10033 the wrong amount of memory. In the case where the computed size is
10034 too small, GDB fetches too little data to print the value of our
10035 entity. Results in this case are unpredictable, as we usually read
10036 past the buffer containing the data =:-o. */
10037
10038/* A helper function for TERNOP_IN_RANGE. */
10039
10040static value *
10041eval_ternop_in_range (struct type *expect_type, struct expression *exp,
10042 enum noside noside,
10043 value *arg1, value *arg2, value *arg3)
10044{
10045 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10046 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
10047 struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
10048 return
10050 (value_less (arg1, arg3)
10051 || value_equal (arg1, arg3))
10052 && (value_less (arg2, arg1)
10053 || value_equal (arg2, arg1)));
10054}
10055
10056/* A helper function for UNOP_NEG. */
10057
10058value *
10059ada_unop_neg (struct type *expect_type,
10060 struct expression *exp,
10061 enum noside noside, enum exp_opcode op,
10062 struct value *arg1)
10063{
10064 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
10065 return value_neg (arg1);
10066}
10067
10068/* A helper function for UNOP_IN_RANGE. */
10069
10070value *
10071ada_unop_in_range (struct type *expect_type,
10072 struct expression *exp,
10073 enum noside noside, enum exp_opcode op,
10074 struct value *arg1, struct type *type)
10075{
10076 struct value *arg2, *arg3;
10077 switch (type->code ())
10078 {
10079 default:
10080 lim_warning (_("Membership test incompletely implemented; "
10081 "always returns true"));
10083 return value_from_longest (type, 1);
10084
10085 case TYPE_CODE_RANGE:
10086 arg2 = value_from_longest (type,
10087 type->bounds ()->low.const_val ());
10088 arg3 = value_from_longest (type,
10089 type->bounds ()->high.const_val ());
10090 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10091 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
10093 return
10095 (value_less (arg1, arg3)
10096 || value_equal (arg1, arg3))
10097 && (value_less (arg2, arg1)
10098 || value_equal (arg2, arg1)));
10099 }
10100}
10101
10102/* A helper function for OP_ATR_TAG. */
10103
10104value *
10105ada_atr_tag (struct type *expect_type,
10106 struct expression *exp,
10107 enum noside noside, enum exp_opcode op,
10108 struct value *arg1)
10109{
10111 return value::zero (ada_tag_type (arg1), not_lval);
10112
10113 return ada_value_tag (arg1);
10114}
10115
10116/* A helper function for OP_ATR_SIZE. */
10117
10118value *
10119ada_atr_size (struct type *expect_type,
10120 struct expression *exp,
10121 enum noside noside, enum exp_opcode op,
10122 struct value *arg1)
10123{
10124 struct type *type = arg1->type ();
10125
10126 /* If the argument is a reference, then dereference its type, since
10127 the user is really asking for the size of the actual object,
10128 not the size of the pointer. */
10129 if (type->code () == TYPE_CODE_REF)
10130 type = type->target_type ();
10131
10134 else
10136 TARGET_CHAR_BIT * type->length ());
10137}
10138
10139/* A helper function for UNOP_ABS. */
10140
10141value *
10142ada_abs (struct type *expect_type,
10143 struct expression *exp,
10144 enum noside noside, enum exp_opcode op,
10145 struct value *arg1)
10146{
10147 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
10148 if (value_less (arg1, value::zero (arg1->type (), not_lval)))
10149 return value_neg (arg1);
10150 else
10151 return arg1;
10152}
10153
10154/* A helper function for BINOP_MUL. */
10155
10156value *
10157ada_mult_binop (struct type *expect_type,
10158 struct expression *exp,
10159 enum noside noside, enum exp_opcode op,
10160 struct value *arg1, struct value *arg2)
10161{
10163 {
10164 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10165 return value::zero (arg1->type (), not_lval);
10166 }
10167 else
10168 {
10169 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10170 return ada_value_binop (arg1, arg2, op);
10171 }
10172}
10173
10174/* A helper function for BINOP_EQUAL and BINOP_NOTEQUAL. */
10175
10176value *
10177ada_equal_binop (struct type *expect_type,
10178 struct expression *exp,
10179 enum noside noside, enum exp_opcode op,
10180 struct value *arg1, struct value *arg2)
10181{
10182 int tem;
10184 tem = 0;
10185 else
10186 {
10187 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10188 tem = ada_value_equal (arg1, arg2);
10189 }
10190 if (op == BINOP_NOTEQUAL)
10191 tem = !tem;
10192 struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
10193 return value_from_longest (type, tem);
10194}
10195
10196/* A helper function for TERNOP_SLICE. */
10197
10198value *
10200 enum noside noside,
10201 struct value *array, struct value *low_bound_val,
10202 struct value *high_bound_val)
10203{
10204 LONGEST low_bound;
10205 LONGEST high_bound;
10206
10207 low_bound_val = coerce_ref (low_bound_val);
10208 high_bound_val = coerce_ref (high_bound_val);
10209 low_bound = value_as_long (low_bound_val);
10210 high_bound = value_as_long (high_bound_val);
10211
10212 /* If this is a reference to an aligner type, then remove all
10213 the aligners. */
10214 if (array->type ()->code () == TYPE_CODE_REF
10215 && ada_is_aligner_type (array->type ()->target_type ()))
10216 array->type ()->set_target_type
10217 (ada_aligned_type (array->type ()->target_type ()));
10218
10219 if (ada_is_any_packed_array_type (array->type ()))
10220 error (_("cannot slice a packed array"));
10221
10222 /* If this is a reference to an array or an array lvalue,
10223 convert to a pointer. */
10224 if (array->type ()->code () == TYPE_CODE_REF
10225 || (array->type ()->code () == TYPE_CODE_ARRAY
10226 && array->lval () == lval_memory))
10227 array = value_addr (array);
10228
10231 (array->type ())))
10232 return empty_array (ada_type_of_array (array, 0), low_bound,
10233 high_bound);
10234
10235 array = ada_coerce_to_simple_array_ptr (array);
10236
10237 /* If we have more than one level of pointer indirection,
10238 dereference the value until we get only one level. */
10239 while (array->type ()->code () == TYPE_CODE_PTR
10240 && (array->type ()->target_type ()->code ()
10241 == TYPE_CODE_PTR))
10242 array = value_ind (array);
10243
10244 /* Make sure we really do have an array type before going further,
10245 to avoid a SEGV when trying to get the index type or the target
10246 type later down the road if the debug info generated by
10247 the compiler is incorrect or incomplete. */
10248 if (!ada_is_simple_array_type (array->type ()))
10249 error (_("cannot take slice of non-array"));
10250
10251 if (ada_check_typedef (array->type ())->code ()
10252 == TYPE_CODE_PTR)
10253 {
10254 struct type *type0 = ada_check_typedef (array->type ());
10255
10256 if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
10257 return empty_array (type0->target_type (), low_bound, high_bound);
10258 else
10259 {
10260 struct type *arr_type0 =
10261 to_fixed_array_type (type0->target_type (), NULL, 1);
10262
10263 return ada_value_slice_from_ptr (array, arr_type0,
10264 longest_to_int (low_bound),
10265 longest_to_int (high_bound));
10266 }
10267 }
10268 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
10269 return array;
10270 else if (high_bound < low_bound)
10271 return empty_array (array->type (), low_bound, high_bound);
10272 else
10273 return ada_value_slice (array, longest_to_int (low_bound),
10274 longest_to_int (high_bound));
10275}
10276
10277/* A helper function for BINOP_IN_BOUNDS. */
10278
10279value *
10281 struct value *arg1, struct value *arg2, int n)
10282{
10284 {
10285 struct type *type = language_bool_type (exp->language_defn,
10286 exp->gdbarch);
10287 return value::zero (type, not_lval);
10288 }
10289
10290 struct type *type = ada_index_type (arg2->type (), n, "range");
10291 if (!type)
10292 type = arg1->type ();
10293
10294 value *arg3 = value_from_longest (type, ada_array_bound (arg2, n, 1));
10295 arg2 = value_from_longest (type, ada_array_bound (arg2, n, 0));
10296
10297 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10298 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
10300 return value_from_longest (type,
10301 (value_less (arg1, arg3)
10302 || value_equal (arg1, arg3))
10303 && (value_less (arg2, arg1)
10304 || value_equal (arg2, arg1)));
10305}
10306
10307/* A helper function for some attribute operations. */
10308
10309static value *
10310ada_unop_atr (struct expression *exp, enum noside noside, enum exp_opcode op,
10311 struct value *arg1, struct type *type_arg, int tem)
10312{
10313 const char *attr_name = nullptr;
10314 if (op == OP_ATR_FIRST)
10315 attr_name = "first";
10316 else if (op == OP_ATR_LAST)
10317 attr_name = "last";
10318
10320 {
10321 if (type_arg == NULL)
10322 type_arg = arg1->type ();
10323
10325 type_arg = decode_constrained_packed_array_type (type_arg);
10326
10327 if (!discrete_type_p (type_arg))
10328 {
10329 switch (op)
10330 {
10331 default: /* Should never happen. */
10332 error (_("unexpected attribute encountered"));
10333 case OP_ATR_FIRST:
10334 case OP_ATR_LAST:
10335 type_arg = ada_index_type (type_arg, tem,
10336 attr_name);
10337 break;
10338 case OP_ATR_LENGTH:
10339 type_arg = builtin_type (exp->gdbarch)->builtin_int;
10340 break;
10341 }
10342 }
10343
10344 return value::zero (type_arg, not_lval);
10345 }
10346 else if (type_arg == NULL)
10347 {
10348 arg1 = ada_coerce_ref (arg1);
10349
10351 arg1 = ada_coerce_to_simple_array (arg1);
10352
10353 struct type *type;
10354 if (op == OP_ATR_LENGTH)
10356 else
10357 {
10358 type = ada_index_type (arg1->type (), tem,
10359 attr_name);
10360 if (type == NULL)
10362 }
10363
10364 switch (op)
10365 {
10366 default: /* Should never happen. */
10367 error (_("unexpected attribute encountered"));
10368 case OP_ATR_FIRST:
10369 return value_from_longest
10370 (type, ada_array_bound (arg1, tem, 0));
10371 case OP_ATR_LAST:
10372 return value_from_longest
10373 (type, ada_array_bound (arg1, tem, 1));
10374 case OP_ATR_LENGTH:
10375 return value_from_longest
10376 (type, ada_array_length (arg1, tem));
10377 }
10378 }
10379 else if (discrete_type_p (type_arg))
10380 {
10381 struct type *range_type;
10382 const char *name = ada_type_name (type_arg);
10383
10384 range_type = NULL;
10385 if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
10386 range_type = to_fixed_range_type (type_arg, NULL);
10387 if (range_type == NULL)
10388 range_type = type_arg;
10389 switch (op)
10390 {
10391 default:
10392 error (_("unexpected attribute encountered"));
10393 case OP_ATR_FIRST:
10394 return value_from_longest
10395 (range_type, ada_discrete_type_low_bound (range_type));
10396 case OP_ATR_LAST:
10397 return value_from_longest
10398 (range_type, ada_discrete_type_high_bound (range_type));
10399 case OP_ATR_LENGTH:
10400 error (_("the 'length attribute applies only to array types"));
10401 }
10402 }
10403 else if (type_arg->code () == TYPE_CODE_FLT)
10404 error (_("unimplemented type attribute"));
10405 else
10406 {
10407 LONGEST low, high;
10408
10410 type_arg = decode_constrained_packed_array_type (type_arg);
10411
10412 struct type *type;
10413 if (op == OP_ATR_LENGTH)
10415 else
10416 {
10417 type = ada_index_type (type_arg, tem, attr_name);
10418 if (type == NULL)
10420 }
10421
10422 switch (op)
10423 {
10424 default:
10425 error (_("unexpected attribute encountered"));
10426 case OP_ATR_FIRST:
10427 low = ada_array_bound_from_type (type_arg, tem, 0);
10428 return value_from_longest (type, low);
10429 case OP_ATR_LAST:
10430 high = ada_array_bound_from_type (type_arg, tem, 1);
10431 return value_from_longest (type, high);
10432 case OP_ATR_LENGTH:
10433 low = ada_array_bound_from_type (type_arg, tem, 0);
10434 high = ada_array_bound_from_type (type_arg, tem, 1);
10435 return value_from_longest (type, high - low + 1);
10436 }
10437 }
10438}
10439
10440/* A helper function for OP_ATR_MIN and OP_ATR_MAX. */
10441
10442struct value *
10443ada_binop_minmax (struct type *expect_type,
10444 struct expression *exp,
10445 enum noside noside, enum exp_opcode op,
10446 struct value *arg1, struct value *arg2)
10447{
10449 return value::zero (arg1->type (), not_lval);
10450 else
10451 {
10452 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10453 return value_binop (arg1, arg2, op);
10454 }
10455}
10456
10457/* A helper function for BINOP_EXP. */
10458
10459struct value *
10460ada_binop_exp (struct type *expect_type,
10461 struct expression *exp,
10462 enum noside noside, enum exp_opcode op,
10463 struct value *arg1, struct value *arg2)
10464{
10466 return value::zero (arg1->type (), not_lval);
10467 else
10468 {
10469 /* For integer exponentiation operations,
10470 only promote the first argument. */
10471 if (is_integral_type (arg2->type ()))
10472 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
10473 else
10474 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10475
10476 return value_binop (arg1, arg2, op);
10477 }
10478}
10479
10480namespace expr
10481{
10482
10483/* See ada-exp.h. */
10484
10487 struct expression *exp,
10488 bool deprocedure_p,
10489 bool parse_completion,
10490 innermost_block_tracker *tracker,
10491 struct type *context_type)
10492{
10493 if (resolve (exp, deprocedure_p, parse_completion, tracker, context_type))
10494 return (make_operation<ada_funcall_operation>
10495 (std::move (owner),
10496 std::vector<operation_up> ()));
10497 return std::move (owner);
10498}
10499
10500/* Convert the character literal whose value would be VAL to the
10501 appropriate value of type TYPE, if there is a translation.
10502 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
10503 the literal 'A' (VAL == 65), returns 0. */
10504
10505static LONGEST
10506convert_char_literal (struct type *type, LONGEST val)
10507{
10508 char name[12];
10509 int f;
10510
10511 if (type == NULL)
10512 return val;
10514 if (type->code () != TYPE_CODE_ENUM)
10515 return val;
10516
10517 if ((val >= 'a' && val <= 'z') || (val >= '0' && val <= '9'))
10518 xsnprintf (name, sizeof (name), "Q%c", (int) val);
10519 else if (val >= 0 && val < 256)
10520 xsnprintf (name, sizeof (name), "QU%02x", (unsigned) val);
10521 else if (val >= 0 && val < 0x10000)
10522 xsnprintf (name, sizeof (name), "QW%04x", (unsigned) val);
10523 else
10524 xsnprintf (name, sizeof (name), "QWW%08lx", (unsigned long) val);
10525 size_t len = strlen (name);
10526 for (f = 0; f < type->num_fields (); f += 1)
10527 {
10528 /* Check the suffix because an enum constant in a package will
10529 have a name like "pkg__QUxx". This is safe enough because we
10530 already have the correct type, and because mangling means
10531 there can't be clashes. */
10532 const char *ename = type->field (f).name ();
10533 size_t elen = strlen (ename);
10534
10535 if (elen >= len && strcmp (name, ename + elen - len) == 0)
10536 return type->field (f).loc_enumval ();
10537 }
10538 return val;
10539}
10540
10541value *
10543 struct expression *exp,
10544 enum noside noside)
10545{
10546 value *result = long_const_operation::evaluate (expect_type, exp, noside);
10547 if (expect_type != nullptr)
10548 result = ada_value_cast (expect_type, result);
10549 return result;
10550}
10551
10552/* See ada-exp.h. */
10553
10556 struct expression *exp,
10557 bool deprocedure_p,
10558 bool parse_completion,
10559 innermost_block_tracker *tracker,
10560 struct type *context_type)
10561{
10562 operation_up result = std::move (owner);
10563
10564 if (context_type != nullptr && context_type->code () == TYPE_CODE_ENUM)
10565 {
10566 LONGEST val = as_longest ();
10567 gdb_assert (result.get () == this);
10568 std::get<0> (m_storage) = context_type;
10569 std::get<1> (m_storage) = convert_char_literal (context_type, val);
10570 }
10571
10572 return result;
10573}
10574
10575value *
10577 struct expression *exp,
10578 enum noside noside)
10579{
10580 value *result = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
10581 if (noside == EVAL_NORMAL)
10582 result = unwrap_value (result);
10583
10584 /* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
10585 then we need to perform the conversion manually, because
10586 evaluate_subexp_standard doesn't do it. This conversion is
10587 necessary in Ada because the different kinds of float/fixed
10588 types in Ada have different representations.
10589
10590 Similarly, we need to perform the conversion from OP_LONG
10591 ourselves. */
10592 if ((opcode () == OP_FLOAT || opcode () == OP_LONG) && expect_type != NULL)
10593 result = ada_value_cast (expect_type, result);
10594
10595 return result;
10596}
10597
10598void
10600 struct agent_expr *ax,
10601 struct axs_value *value,
10602 struct type *cast_type)
10603{
10604 std::get<0> (m_storage)->generate_ax (exp, ax, value, cast_type);
10605
10606 struct type *type = value->type;
10608 error (_("Aligner types cannot be handled in agent expressions"));
10609 else if (find_base_type (type) != nullptr)
10610 error (_("Dynamic types cannot be handled in agent expressions"));
10611}
10612
10613value *
10615 struct expression *exp,
10616 enum noside noside)
10617{
10618 struct type *char_type;
10619 if (expect_type != nullptr && ada_is_string_type (expect_type))
10620 char_type = ada_array_element_type (expect_type, 1);
10621 else
10622 char_type = language_string_char_type (exp->language_defn, exp->gdbarch);
10623
10624 const std::string &str = std::get<0> (m_storage);
10625 const char *encoding;
10626 switch (char_type->length ())
10627 {
10628 case 1:
10629 {
10630 /* Simply copy over the data -- this isn't perhaps strictly
10631 correct according to the encodings, but it is gdb's
10632 historical behavior. */
10633 struct type *stringtype
10634 = lookup_array_range_type (char_type, 1, str.length ());
10635 struct value *val = value::allocate (stringtype);
10636 memcpy (val->contents_raw ().data (), str.c_str (),
10637 str.length ());
10638 return val;
10639 }
10640
10641 case 2:
10642 if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
10643 encoding = "UTF-16BE";
10644 else
10645 encoding = "UTF-16LE";
10646 break;
10647
10648 case 4:
10649 if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
10650 encoding = "UTF-32BE";
10651 else
10652 encoding = "UTF-32LE";
10653 break;
10654
10655 default:
10656 error (_("unexpected character type size %s"),
10657 pulongest (char_type->length ()));
10658 }
10659
10660 auto_obstack converted;
10662 (const gdb_byte *) str.c_str (),
10663 str.length (), 1,
10664 &converted, translit_none);
10665
10666 struct type *stringtype
10667 = lookup_array_range_type (char_type, 1,
10668 obstack_object_size (&converted)
10669 / char_type->length ());
10670 struct value *val = value::allocate (stringtype);
10671 memcpy (val->contents_raw ().data (),
10672 obstack_base (&converted),
10673 obstack_object_size (&converted));
10674 return val;
10675}
10676
10677value *
10679 struct expression *exp,
10680 enum noside noside)
10681{
10682 /* If one side is a literal, evaluate the other side first so that
10683 the expected type can be set properly. */
10684 const operation_up &lhs_expr = std::get<0> (m_storage);
10685 const operation_up &rhs_expr = std::get<1> (m_storage);
10686
10687 value *lhs, *rhs;
10688 if (dynamic_cast<ada_string_operation *> (lhs_expr.get ()) != nullptr)
10689 {
10690 rhs = rhs_expr->evaluate (nullptr, exp, noside);
10691 lhs = lhs_expr->evaluate (rhs->type (), exp, noside);
10692 }
10693 else if (dynamic_cast<ada_char_operation *> (lhs_expr.get ()) != nullptr)
10694 {
10695 rhs = rhs_expr->evaluate (nullptr, exp, noside);
10696 struct type *rhs_type = check_typedef (rhs->type ());
10697 struct type *elt_type = nullptr;
10698 if (rhs_type->code () == TYPE_CODE_ARRAY)
10699 elt_type = rhs_type->target_type ();
10700 lhs = lhs_expr->evaluate (elt_type, exp, noside);
10701 }
10702 else if (dynamic_cast<ada_string_operation *> (rhs_expr.get ()) != nullptr)
10703 {
10704 lhs = lhs_expr->evaluate (nullptr, exp, noside);
10705 rhs = rhs_expr->evaluate (lhs->type (), exp, noside);
10706 }
10707 else if (dynamic_cast<ada_char_operation *> (rhs_expr.get ()) != nullptr)
10708 {
10709 lhs = lhs_expr->evaluate (nullptr, exp, noside);
10710 struct type *lhs_type = check_typedef (lhs->type ());
10711 struct type *elt_type = nullptr;
10712 if (lhs_type->code () == TYPE_CODE_ARRAY)
10713 elt_type = lhs_type->target_type ();
10714 rhs = rhs_expr->evaluate (elt_type, exp, noside);
10715 }
10716 else
10717 return concat_operation::evaluate (expect_type, exp, noside);
10718
10719 return value_concat (lhs, rhs);
10720}
10721
10722value *
10724 struct expression *exp,
10725 enum noside noside)
10726{
10727 struct type *type = std::get<1> (m_storage);
10728 return std::get<0> (m_storage)->evaluate (type, exp, noside);
10729}
10730
10731value *
10733 struct expression *exp,
10734 enum noside noside)
10735{
10736 value *arg0 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
10737 value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
10738 value *arg2 = std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
10739 return eval_ternop_in_range (expect_type, exp, noside, arg0, arg1, arg2);
10740}
10741
10742value *
10744 struct expression *exp,
10745 enum noside noside)
10746{
10747 value *arg1 = std::get<1> (m_storage)->evaluate_with_coercion (exp, noside);
10748 value *arg2 = std::get<2> (m_storage)->evaluate_with_coercion (exp, noside);
10749
10750 auto do_op = [this] (LONGEST x, LONGEST y)
10751 {
10752 if (std::get<0> (m_storage) == BINOP_ADD)
10753 return x + y;
10754 return x - y;
10755 };
10756
10757 if (arg1->type ()->code () == TYPE_CODE_PTR)
10758 return (value_from_longest
10759 (arg1->type (),
10760 do_op (value_as_long (arg1), value_as_long (arg2))));
10761 if (arg2->type ()->code () == TYPE_CODE_PTR)
10762 return (value_from_longest
10763 (arg2->type (),
10764 do_op (value_as_long (arg1), value_as_long (arg2))));
10765 /* Preserve the original type for use by the range case below.
10766 We cannot cast the result to a reference type, so if ARG1 is
10767 a reference type, find its underlying type. */
10768 struct type *type = arg1->type ();
10769 while (type->code () == TYPE_CODE_REF)
10770 type = type->target_type ();
10771 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10772 arg1 = value_binop (arg1, arg2, std::get<0> (m_storage));
10773 /* We need to special-case the result with a range.
10774 This is done for the benefit of "ptype". gdb's Ada support
10775 historically used the LHS to set the result type here, so
10776 preserve this behavior. */
10777 if (type->code () == TYPE_CODE_RANGE)
10778 arg1 = value_cast (type, arg1);
10779 return arg1;
10780}
10781
10782value *
10784 struct expression *exp,
10785 enum noside noside)
10786{
10787 struct type *type_arg = nullptr;
10788 value *val = nullptr;
10789
10790 if (std::get<0> (m_storage)->opcode () == OP_TYPE)
10791 {
10792 value *tem = std::get<0> (m_storage)->evaluate (nullptr, exp,
10794 type_arg = tem->type ();
10795 }
10796 else
10797 val = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
10798
10799 return ada_unop_atr (exp, noside, std::get<1> (m_storage),
10800 val, type_arg, std::get<2> (m_storage));
10801}
10802
10803value *
10805 struct expression *exp,
10806 enum noside noside)
10807{
10809 return value::zero (expect_type, not_lval);
10810
10811 const bound_minimal_symbol &b = std::get<0> (m_storage);
10813
10814 val = ada_value_cast (expect_type, val);
10815
10816 /* Follow the Ada language semantics that do not allow taking
10817 an address of the result of a cast (view conversion in Ada). */
10818 if (val->lval () == lval_memory)
10819 {
10820 if (val->lazy ())
10821 val->fetch_lazy ();
10822 val->set_lval (not_lval);
10823 }
10824 return val;
10825}
10826
10827value *
10829 struct expression *exp,
10830 enum noside noside)
10831{
10833 std::get<0> (m_storage).block,
10834 std::get<0> (m_storage).symbol);
10835
10836 val = ada_value_cast (expect_type, val);
10837
10838 /* Follow the Ada language semantics that do not allow taking
10839 an address of the result of a cast (view conversion in Ada). */
10840 if (val->lval () == lval_memory)
10841 {
10842 if (val->lazy ())
10843 val->fetch_lazy ();
10844 val->set_lval (not_lval);
10845 }
10846 return val;
10847}
10848
10849value *
10851 struct expression *exp,
10852 enum noside noside)
10853{
10854 symbol *sym = std::get<0> (m_storage).symbol;
10855
10856 if (sym->domain () == UNDEF_DOMAIN)
10857 /* Only encountered when an unresolved symbol occurs in a
10858 context other than a function call, in which case, it is
10859 invalid. */
10860 error (_("Unexpected unresolved symbol, %s, during evaluation"),
10861 sym->print_name ());
10862
10864 {
10865 struct type *type = static_unwrap_type (sym->type ());
10866 /* Check to see if this is a tagged type. We also need to handle
10867 the case where the type is a reference to a tagged type, but
10868 we have to be careful to exclude pointers to tagged types.
10869 The latter should be shown as usual (as a pointer), whereas
10870 a reference should mostly be transparent to the user. */
10871 if (ada_is_tagged_type (type, 0)
10872 || (type->code () == TYPE_CODE_REF
10873 && ada_is_tagged_type (type->target_type (), 0)))
10874 {
10875 /* Tagged types are a little special in the fact that the real
10876 type is dynamic and can only be determined by inspecting the
10877 object's tag. This means that we need to get the object's
10878 value first (EVAL_NORMAL) and then extract the actual object
10879 type from its tag.
10880
10881 Note that we cannot skip the final step where we extract
10882 the object type from its tag, because the EVAL_NORMAL phase
10883 results in dynamic components being resolved into fixed ones.
10884 This can cause problems when trying to print the type
10885 description of tagged types whose parent has a dynamic size:
10886 We use the type name of the "_parent" component in order
10887 to print the name of the ancestor type in the type description.
10888 If that component had a dynamic size, the resolution into
10889 a fixed type would result in the loss of that type name,
10890 thus preventing us from printing the name of the ancestor
10891 type in the type description. */
10892 value *arg1 = evaluate (nullptr, exp, EVAL_NORMAL);
10893
10894 if (type->code () != TYPE_CODE_REF)
10895 {
10896 struct type *actual_type;
10897
10898 actual_type = type_from_tag (ada_value_tag (arg1));
10899 if (actual_type == NULL)
10900 /* If, for some reason, we were unable to determine
10901 the actual type from the tag, then use the static
10902 approximation that we just computed as a fallback.
10903 This can happen if the debugging information is
10904 incomplete, for instance. */
10905 actual_type = type;
10906 return value::zero (actual_type, not_lval);
10907 }
10908 else
10909 {
10910 /* In the case of a ref, ada_coerce_ref takes care
10911 of determining the actual type. But the evaluation
10912 should return a ref as it should be valid to ask
10913 for its address; so rebuild a ref after coerce. */
10914 arg1 = ada_coerce_ref (arg1);
10915 return value_ref (arg1, TYPE_CODE_REF);
10916 }
10917 }
10918
10919 /* Records and unions for which GNAT encodings have been
10920 generated need to be statically fixed as well.
10921 Otherwise, non-static fixing produces a type where
10922 all dynamic properties are removed, which prevents "ptype"
10923 from being able to completely describe the type.
10924 For instance, a case statement in a variant record would be
10925 replaced by the relevant components based on the actual
10926 value of the discriminants. */
10927 if ((type->code () == TYPE_CODE_STRUCT
10928 && dynamic_template_type (type) != NULL)
10929 || (type->code () == TYPE_CODE_UNION
10930 && ada_find_parallel_type (type, "___XVU") != NULL))
10932 }
10933
10934 value *arg1 = var_value_operation::evaluate (expect_type, exp, noside);
10935 return ada_to_fixed_value (arg1);
10936}
10937
10938bool
10940 bool deprocedure_p,
10941 bool parse_completion,
10942 innermost_block_tracker *tracker,
10943 struct type *context_type)
10944{
10945 symbol *sym = std::get<0> (m_storage).symbol;
10946 if (sym->domain () == UNDEF_DOMAIN)
10947 {
10948 block_symbol resolved
10949 = ada_resolve_variable (sym, std::get<0> (m_storage).block,
10950 context_type, parse_completion,
10951 deprocedure_p, tracker);
10952 std::get<0> (m_storage) = resolved;
10953 }
10954
10955 if (deprocedure_p
10956 && (std::get<0> (m_storage).symbol->type ()->code ()
10957 == TYPE_CODE_FUNC))
10958 return true;
10959
10960 return false;
10961}
10962
10963void
10965 struct agent_expr *ax,
10966 struct axs_value *value,
10967 struct type *cast_type)
10968{
10969 symbol *sym = std::get<0> (m_storage).symbol;
10970
10971 if (sym->domain () == UNDEF_DOMAIN)
10972 error (_("Unexpected unresolved symbol, %s, during evaluation"),
10973 sym->print_name ());
10974
10975 struct type *type = static_unwrap_type (sym->type ());
10976 if (ada_is_tagged_type (type, 0)
10977 || (type->code () == TYPE_CODE_REF
10978 && ada_is_tagged_type (type->target_type (), 0)))
10979 error (_("Tagged types cannot be handled in agent expressions"));
10980
10981 if ((type->code () == TYPE_CODE_STRUCT
10982 && dynamic_template_type (type) != NULL)
10983 || (type->code () == TYPE_CODE_UNION
10984 && ada_find_parallel_type (type, "___XVU") != NULL))
10985 error (_("Dynamic types cannot be handled in agent expressions"));
10986
10987 var_value_operation::do_generate_ax (exp, ax, value, cast_type);
10988}
10989
10990value *
10992 struct expression *exp,
10993 enum noside noside)
10994{
10995 value *arg1 = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
10996
10997 struct type *type = ada_check_typedef (arg1->type ());
10999 {
11001 /* GDB allows dereferencing GNAT array descriptors. */
11002 {
11003 struct type *arrType = ada_type_of_array (arg1, 0);
11004
11005 if (arrType == NULL)
11006 error (_("Attempt to dereference null array pointer."));
11007 return value_at_lazy (arrType, 0);
11008 }
11009 else if (type->code () == TYPE_CODE_PTR
11010 || type->code () == TYPE_CODE_REF
11011 /* In C you can dereference an array to get the 1st elt. */
11012 || type->code () == TYPE_CODE_ARRAY)
11013 {
11014 /* As mentioned in the OP_VAR_VALUE case, tagged types can
11015 only be determined by inspecting the object's tag.
11016 This means that we need to evaluate completely the
11017 expression in order to get its type. */
11018
11019 if ((type->code () == TYPE_CODE_REF
11020 || type->code () == TYPE_CODE_PTR)
11022 {
11023 arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp,
11024 EVAL_NORMAL);
11025 type = ada_value_ind (arg1)->type ();
11026 }
11027 else
11028 {
11032 }
11033 return value::zero (type, lval_memory);
11034 }
11035 else if (type->code () == TYPE_CODE_INT)
11036 {
11037 /* GDB allows dereferencing an int. */
11038 if (expect_type == NULL)
11040 lval_memory);
11041 else
11042 {
11043 expect_type =
11044 to_static_fixed_type (ada_aligned_type (expect_type));
11045 return value::zero (expect_type, lval_memory);
11046 }
11047 }
11048 else
11049 error (_("Attempt to take contents of a non-pointer value."));
11050 }
11051 arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
11052 type = ada_check_typedef (arg1->type ());
11053
11054 if (type->code () == TYPE_CODE_INT)
11055 /* GDB allows dereferencing an int. If we were given
11056 the expect_type, then use that as the target type.
11057 Otherwise, assume that the target type is an int. */
11058 {
11059 if (expect_type != NULL)
11060 return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
11061 arg1));
11062 else
11064 (CORE_ADDR) value_as_address (arg1));
11065 }
11066
11068 /* GDB allows dereferencing GNAT array descriptors. */
11069 return ada_coerce_to_simple_array (arg1);
11070 else
11071 return ada_value_ind (arg1);
11072}
11073
11074value *
11076 struct expression *exp,
11077 enum noside noside)
11078{
11079 value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
11080 const char *str = std::get<1> (m_storage).c_str ();
11082 {
11083 struct type *type;
11084 struct type *type1 = arg1->type ();
11085
11086 if (ada_is_tagged_type (type1, 1))
11087 {
11088 type = ada_lookup_struct_elt_type (type1, str, 1, 1);
11089
11090 /* If the field is not found, check if it exists in the
11091 extension of this object's type. This means that we
11092 need to evaluate completely the expression. */
11093
11094 if (type == NULL)
11095 {
11096 arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp,
11097 EVAL_NORMAL);
11098 arg1 = ada_value_struct_elt (arg1, str, 0);
11099 arg1 = unwrap_value (arg1);
11100 type = ada_to_fixed_value (arg1)->type ();
11101 }
11102 }
11103 else
11104 type = ada_lookup_struct_elt_type (type1, str, 1, 0);
11105
11107 }
11108 else
11109 {
11110 arg1 = ada_value_struct_elt (arg1, str, 0);
11111 arg1 = unwrap_value (arg1);
11112 return ada_to_fixed_value (arg1);
11113 }
11114}
11115
11116value *
11118 struct expression *exp,
11119 enum noside noside)
11120{
11121 const std::vector<operation_up> &args_up = std::get<1> (m_storage);
11122 int nargs = args_up.size ();
11123 std::vector<value *> argvec (nargs);
11124 operation_up &callee_op = std::get<0> (m_storage);
11125
11127 = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
11128 if (avv != nullptr
11129 && avv->get_symbol ()->domain () == UNDEF_DOMAIN)
11130 error (_("Unexpected unresolved symbol, %s, during evaluation"),
11131 avv->get_symbol ()->print_name ());
11132
11133 value *callee = callee_op->evaluate (nullptr, exp, noside);
11134 for (int i = 0; i < args_up.size (); ++i)
11135 argvec[i] = args_up[i]->evaluate (nullptr, exp, noside);
11136
11138 (desc_base_type (callee->type ())))
11139 callee = ada_coerce_to_simple_array (callee);
11140 else if (callee->type ()->code () == TYPE_CODE_ARRAY
11141 && callee->type ()->field (0).bitsize () != 0)
11142 /* This is a packed array that has already been fixed, and
11143 therefore already coerced to a simple array. Nothing further
11144 to do. */
11145 ;
11146 else if (callee->type ()->code () == TYPE_CODE_REF)
11147 {
11148 /* Make sure we dereference references so that all the code below
11149 feels like it's really handling the referenced value. Wrapping
11150 types (for alignment) may be there, so make sure we strip them as
11151 well. */
11152 callee = ada_to_fixed_value (coerce_ref (callee));
11153 }
11154 else if (callee->type ()->code () == TYPE_CODE_ARRAY
11155 && callee->lval () == lval_memory)
11156 callee = value_addr (callee);
11157
11158 struct type *type = ada_check_typedef (callee->type ());
11159
11160 /* Ada allows us to implicitly dereference arrays when subscripting
11161 them. So, if this is an array typedef (encoding use for array
11162 access types encoded as fat pointers), strip it now. */
11163 if (type->code () == TYPE_CODE_TYPEDEF)
11165
11166 if (type->code () == TYPE_CODE_PTR)
11167 {
11168 switch (ada_check_typedef (type->target_type ())->code ())
11169 {
11170 case TYPE_CODE_FUNC:
11172 break;
11173 case TYPE_CODE_ARRAY:
11174 break;
11175 case TYPE_CODE_STRUCT:
11177 callee = ada_value_ind (callee);
11179 break;
11180 default:
11181 error (_("cannot subscript or call something of type `%s'"),
11182 ada_type_name (callee->type ()));
11183 break;
11184 }
11185 }
11186
11187 switch (type->code ())
11188 {
11189 case TYPE_CODE_FUNC:
11191 {
11192 if (type->target_type () == NULL)
11194 return value::allocate (type->target_type ());
11195 }
11196 return call_function_by_hand (callee, expect_type, argvec);
11197 case TYPE_CODE_INTERNAL_FUNCTION:
11199 /* We don't know anything about what the internal
11200 function might return, but we have to return
11201 something. */
11203 not_lval);
11204 else
11205 return call_internal_function (exp->gdbarch, exp->language_defn,
11206 callee, nargs,
11207 argvec.data ());
11208
11209 case TYPE_CODE_STRUCT:
11210 {
11211 int arity;
11212
11213 arity = ada_array_arity (type);
11214 type = ada_array_element_type (type, nargs);
11215 if (type == NULL)
11216 error (_("cannot subscript or call a record"));
11217 if (arity != nargs)
11218 error (_("wrong number of subscripts; expecting %d"), arity);
11221 return
11223 (callee, nargs, argvec.data ()));
11224 }
11225 case TYPE_CODE_ARRAY:
11227 {
11228 type = ada_array_element_type (type, nargs);
11229 if (type == NULL)
11230 error (_("element type of array unknown"));
11231 else
11233 }
11234 return
11237 nargs, argvec.data ()));
11238 case TYPE_CODE_PTR: /* Pointer to array */
11240 {
11241 type = to_fixed_array_type (type->target_type (), NULL, 1);
11242 type = ada_array_element_type (type, nargs);
11243 if (type == NULL)
11244 error (_("element type of array unknown"));
11245 else
11247 }
11248 return
11249 unwrap_value (ada_value_ptr_subscript (callee, nargs,
11250 argvec.data ()));
11251
11252 default:
11253 error (_("Attempt to index or call something other than an "
11254 "array or function"));
11255 }
11256}
11257
11258bool
11260 bool deprocedure_p,
11261 bool parse_completion,
11262 innermost_block_tracker *tracker,
11263 struct type *context_type)
11264{
11265 operation_up &callee_op = std::get<0> (m_storage);
11266
11268 = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
11269 if (avv == nullptr)
11270 return false;
11271
11272 symbol *sym = avv->get_symbol ();
11273 if (sym->domain () != UNDEF_DOMAIN)
11274 return false;
11275
11276 const std::vector<operation_up> &args_up = std::get<1> (m_storage);
11277 int nargs = args_up.size ();
11278 std::vector<value *> argvec (nargs);
11279
11280 for (int i = 0; i < args_up.size (); ++i)
11281 argvec[i] = args_up[i]->evaluate (nullptr, exp, EVAL_AVOID_SIDE_EFFECTS);
11282
11283 const block *block = avv->get_block ();
11284 block_symbol resolved
11285 = ada_resolve_funcall (sym, block,
11286 context_type, parse_completion,
11287 nargs, argvec.data (),
11288 tracker);
11289
11290 std::get<0> (m_storage)
11291 = make_operation<ada_var_value_operation> (resolved);
11292 return false;
11293}
11294
11295bool
11297 bool deprocedure_p,
11298 bool parse_completion,
11299 innermost_block_tracker *tracker,
11300 struct type *context_type)
11301{
11302 /* Historically this check was done during resolution, so we
11303 continue that here. */
11304 value *v = std::get<0> (m_storage)->evaluate (context_type, exp,
11307 error (_("cannot slice a packed array"));
11308 return false;
11309}
11310
11311}
11312
11313
11314
11315/* Return non-zero iff TYPE represents a System.Address type. */
11316
11317int
11319{
11320 return (type->name () && strcmp (type->name (), "system__address") == 0);
11321}
11322
11323
11324
11325 /* Range types */
11326
11327/* Scan STR beginning at position K for a discriminant name, and
11328 return the value of that discriminant field of DVAL in *PX. If
11329 PNEW_K is not null, put the position of the character beyond the
11330 name scanned in *PNEW_K. Return 1 if successful; return 0 and do
11331 not alter *PX and *PNEW_K if unsuccessful. */
11332
11333static int
11334scan_discrim_bound (const char *str, int k, struct value *dval, LONGEST * px,
11335 int *pnew_k)
11336{
11337 static std::string storage;
11338 const char *pstart, *pend, *bound;
11339 struct value *bound_val;
11340
11341 if (dval == NULL || str == NULL || str[k] == '\0')
11342 return 0;
11343
11344 pstart = str + k;
11345 pend = strstr (pstart, "__");
11346 if (pend == NULL)
11347 {
11348 bound = pstart;
11349 k += strlen (bound);
11350 }
11351 else
11352 {
11353 int len = pend - pstart;
11354
11355 /* Strip __ and beyond. */
11356 storage = std::string (pstart, len);
11357 bound = storage.c_str ();
11358 k = pend - str;
11359 }
11360
11361 bound_val = ada_search_struct_field (bound, dval, 0, dval->type ());
11362 if (bound_val == NULL)
11363 return 0;
11364
11365 *px = value_as_long (bound_val);
11366 if (pnew_k != NULL)
11367 *pnew_k = k;
11368 return 1;
11369}
11370
11371/* Value of variable named NAME. Only exact matches are considered.
11372 If no such variable found, then if ERR_MSG is null, returns 0, and
11373 otherwise causes an error with message ERR_MSG. */
11374
11375static struct value *
11376get_var_value (const char *name, const char *err_msg)
11377{
11378 std::string quoted_name = add_angle_brackets (name);
11379
11380 lookup_name_info lookup_name (quoted_name, symbol_name_match_type::FULL);
11381
11382 std::vector<struct block_symbol> syms
11383 = ada_lookup_symbol_list_worker (lookup_name,
11385 VAR_DOMAIN, 1);
11386
11387 if (syms.size () != 1)
11388 {
11389 if (err_msg == NULL)
11390 return 0;
11391 else
11392 error (("%s"), err_msg);
11393 }
11394
11395 return value_of_variable (syms[0].symbol, syms[0].block);
11396}
11397
11398/* Value of integer variable named NAME in the current environment.
11399 If no such variable is found, returns false. Otherwise, sets VALUE
11400 to the variable's value and returns true. */
11401
11402bool
11403get_int_var_value (const char *name, LONGEST &value)
11404{
11405 struct value *var_val = get_var_value (name, 0);
11406
11407 if (var_val == 0)
11408 return false;
11409
11410 value = value_as_long (var_val);
11411 return true;
11412}
11413
11414
11415/* Return a range type whose base type is that of the range type named
11416 NAME in the current environment, and whose bounds are calculated
11417 from NAME according to the GNAT range encoding conventions.
11418 Extract discriminant values, if needed, from DVAL. ORIG_TYPE is the
11419 corresponding range type from debug information; fall back to using it
11420 if symbol lookup fails. If a new type must be created, allocate it
11421 like ORIG_TYPE was. The bounds information, in general, is encoded
11422 in NAME, the base type given in the named range type. */
11423
11424static struct type *
11425to_fixed_range_type (struct type *raw_type, struct value *dval)
11426{
11427 const char *name;
11428 struct type *base_type;
11429 const char *subtype_info;
11430
11431 gdb_assert (raw_type != NULL);
11432 gdb_assert (raw_type->name () != NULL);
11433
11434 if (raw_type->code () == TYPE_CODE_RANGE)
11435 base_type = raw_type->target_type ();
11436 else
11437 base_type = raw_type;
11438
11439 name = raw_type->name ();
11440 subtype_info = strstr (name, "___XD");
11441 if (subtype_info == NULL)
11442 {
11443 LONGEST L = ada_discrete_type_low_bound (raw_type);
11444 LONGEST U = ada_discrete_type_high_bound (raw_type);
11445
11446 if (L < INT_MIN || U > INT_MAX)
11447 return raw_type;
11448 else
11449 {
11450 type_allocator alloc (raw_type);
11451 return create_static_range_type (alloc, raw_type, L, U);
11452 }
11453 }
11454 else
11455 {
11456 int prefix_len = subtype_info - name;
11457 LONGEST L, U;
11458 struct type *type;
11459 const char *bounds_str;
11460 int n;
11461
11462 subtype_info += 5;
11463 bounds_str = strchr (subtype_info, '_');
11464 n = 1;
11465
11466 if (*subtype_info == 'L')
11467 {
11468 if (!ada_scan_number (bounds_str, n, &L, &n)
11469 && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
11470 return raw_type;
11471 if (bounds_str[n] == '_')
11472 n += 2;
11473 else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
11474 n += 1;
11475 subtype_info += 1;
11476 }
11477 else
11478 {
11479 std::string name_buf = std::string (name, prefix_len) + "___L";
11480 if (!get_int_var_value (name_buf.c_str (), L))
11481 {
11482 lim_warning (_("Unknown lower bound, using 1."));
11483 L = 1;
11484 }
11485 }
11486
11487 if (*subtype_info == 'U')
11488 {
11489 if (!ada_scan_number (bounds_str, n, &U, &n)
11490 && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
11491 return raw_type;
11492 }
11493 else
11494 {
11495 std::string name_buf = std::string (name, prefix_len) + "___U";
11496 if (!get_int_var_value (name_buf.c_str (), U))
11497 {
11498 lim_warning (_("Unknown upper bound, using %ld."), (long) L);
11499 U = L;
11500 }
11501 }
11502
11503 type_allocator alloc (raw_type);
11504 type = create_static_range_type (alloc, base_type, L, U);
11505 /* create_static_range_type alters the resulting type's length
11506 to match the size of the base_type, which is not what we want.
11507 Set it back to the original range type's length. */
11508 type->set_length (raw_type->length ());
11509 type->set_name (name);
11510 return type;
11511 }
11512}
11513
11514/* True iff NAME is the name of a range type. */
11515
11516int
11518{
11519 return (name != NULL && strstr (name, "___XD"));
11520}
11521
11522
11523 /* Modular types */
11524
11525/* True iff TYPE is an Ada modular type. */
11526
11527int
11529{
11530 struct type *subranged_type = get_base_type (type);
11531
11532 return (subranged_type != NULL && type->code () == TYPE_CODE_RANGE
11533 && subranged_type->code () == TYPE_CODE_INT
11534 && subranged_type->is_unsigned ());
11535}
11536
11537/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
11538
11539ULONGEST
11541{
11542 const dynamic_prop &high = type->bounds ()->high;
11543
11544 if (high.is_constant ())
11545 return (ULONGEST) high.const_val () + 1;
11546
11547 /* If TYPE is unresolved, the high bound might be a location list. Return
11548 0, for lack of a better value to return. */
11549 return 0;
11550}
11551
11552
11553/* Ada exception catchpoint support:
11554 ---------------------------------
11555
11556 We support 3 kinds of exception catchpoints:
11557 . catchpoints on Ada exceptions
11558 . catchpoints on unhandled Ada exceptions
11559 . catchpoints on failed assertions
11560
11561 Exceptions raised during failed assertions, or unhandled exceptions
11562 could perfectly be caught with the general catchpoint on Ada exceptions.
11563 However, we can easily differentiate these two special cases, and having
11564 the option to distinguish these two cases from the rest can be useful
11565 to zero-in on certain situations.
11566
11567 Exception catchpoints are a specialized form of breakpoint,
11568 since they rely on inserting breakpoints inside known routines
11569 of the GNAT runtime. The implementation therefore uses a standard
11570 breakpoint structure of the BP_BREAKPOINT type, but with its own set
11571 of breakpoint_ops.
11572
11573 Support in the runtime for exception catchpoints have been changed
11574 a few times already, and these changes affect the implementation
11575 of these catchpoints. In order to be able to support several
11576 variants of the runtime, we use a sniffer that will determine
11577 the runtime variant used by the program being debugged. */
11578
11579/* Ada's standard exceptions.
11580
11581 The Ada 83 standard also defined Numeric_Error. But there so many
11582 situations where it was unclear from the Ada 83 Reference Manual
11583 (RM) whether Constraint_Error or Numeric_Error should be raised,
11584 that the ARG (Ada Rapporteur Group) eventually issued a Binding
11585 Interpretation saying that anytime the RM says that Numeric_Error
11586 should be raised, the implementation may raise Constraint_Error.
11587 Ada 95 went one step further and pretty much removed Numeric_Error
11588 from the list of standard exceptions (it made it a renaming of
11589 Constraint_Error, to help preserve compatibility when compiling
11590 an Ada83 compiler). As such, we do not include Numeric_Error from
11591 this list of standard exceptions. */
11592
11593static const char * const standard_exc[] = {
11594 "constraint_error",
11595 "program_error",
11596 "storage_error",
11597 "tasking_error"
11598};
11599
11601
11602/* A structure that describes how to support exception catchpoints
11603 for a given executable. */
11604
11606{
11607 /* The name of the symbol to break on in order to insert
11608 a catchpoint on exceptions. */
11610
11611 /* The name of the symbol to break on in order to insert
11612 a catchpoint on unhandled exceptions. */
11614
11615 /* The name of the symbol to break on in order to insert
11616 a catchpoint on failed assertions. */
11617 const char *catch_assert_sym;
11618
11619 /* The name of the symbol to break on in order to insert
11620 a catchpoint on exception handling. */
11622
11623 /* Assuming that the inferior just triggered an unhandled exception
11624 catchpoint, this function is responsible for returning the address
11625 in inferior memory where the name of that exception is stored.
11626 Return zero if the address could not be computed. */
11628};
11629
11630static CORE_ADDR ada_unhandled_exception_name_addr (void);
11631static CORE_ADDR ada_unhandled_exception_name_addr_from_raise (void);
11632
11633/* The following exception support info structure describes how to
11634 implement exception catchpoints with the latest version of the
11635 Ada runtime (as of 2019-08-??). */
11636
11638{
11639 "__gnat_debug_raise_exception", /* catch_exception_sym */
11640 "__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
11641 "__gnat_debug_raise_assert_failure", /* catch_assert_sym */
11642 "__gnat_begin_handler_v1", /* catch_handlers_sym */
11644};
11645
11646/* The following exception support info structure describes how to
11647 implement exception catchpoints with an earlier version of the
11648 Ada runtime (as of 2007-03-06) using v0 of the EH ABI. */
11649
11651{
11652 "__gnat_debug_raise_exception", /* catch_exception_sym */
11653 "__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
11654 "__gnat_debug_raise_assert_failure", /* catch_assert_sym */
11655 "__gnat_begin_handler", /* catch_handlers_sym */
11657};
11658
11659/* The following exception support info structure describes how to
11660 implement exception catchpoints with a slightly older version
11661 of the Ada runtime. */
11662
11664{
11665 "__gnat_raise_nodefer_with_msg", /* catch_exception_sym */
11666 "__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
11667 "system__assertions__raise_assert_failure", /* catch_assert_sym */
11668 "__gnat_begin_handler", /* catch_handlers_sym */
11670};
11671
11672/* Return nonzero if we can detect the exception support routines
11673 described in EINFO.
11674
11675 This function errors out if an abnormal situation is detected
11676 (for instance, if we find the exception support routines, but
11677 that support is found to be incomplete). */
11678
11679static int
11681{
11682 struct symbol *sym;
11683
11684 /* The symbol we're looking up is provided by a unit in the GNAT runtime
11685 that should be compiled with debugging information. As a result, we
11686 expect to find that symbol in the symtabs. */
11687
11688 sym = standard_lookup (einfo->catch_exception_sym, NULL, VAR_DOMAIN);
11689 if (sym == NULL)
11690 {
11691 /* Perhaps we did not find our symbol because the Ada runtime was
11692 compiled without debugging info, or simply stripped of it.
11693 It happens on some GNU/Linux distributions for instance, where
11694 users have to install a separate debug package in order to get
11695 the runtime's debugging info. In that situation, let the user
11696 know why we cannot insert an Ada exception catchpoint.
11697
11698 Note: Just for the purpose of inserting our Ada exception
11699 catchpoint, we could rely purely on the associated minimal symbol.
11700 But we would be operating in degraded mode anyway, since we are
11701 still lacking the debugging info needed later on to extract
11702 the name of the exception being raised (this name is printed in
11703 the catchpoint message, and is also used when trying to catch
11704 a specific exception). We do not handle this case for now. */
11705 struct bound_minimal_symbol msym
11706 = lookup_minimal_symbol (einfo->catch_exception_sym, NULL, NULL);
11707
11708 if (msym.minsym && msym.minsym->type () != mst_solib_trampoline)
11709 error (_("Your Ada runtime appears to be missing some debugging "
11710 "information.\nCannot insert Ada exception catchpoint "
11711 "in this configuration."));
11712
11713 return 0;
11714 }
11715
11716 /* Make sure that the symbol we found corresponds to a function. */
11717
11718 if (sym->aclass () != LOC_BLOCK)
11719 error (_("Symbol \"%s\" is not a function (class = %d)"),
11720 sym->linkage_name (), sym->aclass ());
11721
11722 sym = standard_lookup (einfo->catch_handlers_sym, NULL, VAR_DOMAIN);
11723 if (sym == NULL)
11724 {
11725 struct bound_minimal_symbol msym
11726 = lookup_minimal_symbol (einfo->catch_handlers_sym, NULL, NULL);
11727
11728 if (msym.minsym && msym.minsym->type () != mst_solib_trampoline)
11729 error (_("Your Ada runtime appears to be missing some debugging "
11730 "information.\nCannot insert Ada exception catchpoint "
11731 "in this configuration."));
11732
11733 return 0;
11734 }
11735
11736 /* Make sure that the symbol we found corresponds to a function. */
11737
11738 if (sym->aclass () != LOC_BLOCK)
11739 error (_("Symbol \"%s\" is not a function (class = %d)"),
11740 sym->linkage_name (), sym->aclass ());
11741
11742 return 1;
11743}
11744
11745/* Inspect the Ada runtime and determine which exception info structure
11746 should be used to provide support for exception catchpoints.
11747
11748 This function will always set the per-inferior exception_info,
11749 or raise an error. */
11750
11751static void
11753{
11755
11756 /* If the exception info is already known, then no need to recompute it. */
11757 if (data->exception_info != NULL)
11758 return;
11759
11760 /* Check the latest (default) exception support info. */
11762 {
11763 data->exception_info = &default_exception_support_info;
11764 return;
11765 }
11766
11767 /* Try the v0 exception suport info. */
11769 {
11770 data->exception_info = &exception_support_info_v0;
11771 return;
11772 }
11773
11774 /* Try our fallback exception suport info. */
11776 {
11777 data->exception_info = &exception_support_info_fallback;
11778 return;
11779 }
11780
11781 throw_error (NOT_FOUND_ERROR,
11782 _("Could not find Ada runtime exception support"));
11783}
11784
11785/* True iff FRAME is very likely to be that of a function that is
11786 part of the runtime system. This is all very heuristic, but is
11787 intended to be used as advice as to what frames are uninteresting
11788 to most users. */
11789
11790static int
11792{
11793 enum language func_lang;
11794 int i;
11795 const char *fullname;
11796
11797 /* If this code does not have any debugging information (no symtab),
11798 This cannot be any user code. */
11799
11800 symtab_and_line sal = find_frame_sal (frame);
11801 if (sal.symtab == NULL)
11802 return 1;
11803
11804 /* If there is a symtab, but the associated source file cannot be
11805 located, then assume this is not user code: Selecting a frame
11806 for which we cannot display the code would not be very helpful
11807 for the user. This should also take care of case such as VxWorks
11808 where the kernel has some debugging info provided for a few units. */
11809
11810 fullname = symtab_to_fullname (sal.symtab);
11811 if (access (fullname, R_OK) != 0)
11812 return 1;
11813
11814 /* Check the unit filename against the Ada runtime file naming.
11815 We also check the name of the objfile against the name of some
11816 known system libraries that sometimes come with debugging info
11817 too. */
11818
11819 for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
11820 {
11822 if (re_exec (lbasename (sal.symtab->filename)))
11823 return 1;
11824 if (sal.symtab->compunit ()->objfile () != NULL
11825 && re_exec (objfile_name (sal.symtab->compunit ()->objfile ())))
11826 return 1;
11827 }
11828
11829 /* Check whether the function is a GNAT-generated entity. */
11830
11831 gdb::unique_xmalloc_ptr<char> func_name
11832 = find_frame_funname (frame, &func_lang, NULL);
11833 if (func_name == NULL)
11834 return 1;
11835
11836 for (i = 0; known_auxiliary_function_name_patterns[i] != NULL; i += 1)
11837 {
11839 if (re_exec (func_name.get ()))
11840 return 1;
11841 }
11842
11843 return 0;
11844}
11845
11846/* Find the first frame that contains debugging information and that is not
11847 part of the Ada run-time, starting from FI and moving upward. */
11848
11849void
11851{
11852 for (; fi != NULL; fi = get_prev_frame (fi))
11853 {
11854 if (!is_known_support_routine (fi))
11855 {
11856 select_frame (fi);
11857 break;
11858 }
11859 }
11860
11861}
11862
11863/* Assuming that the inferior just triggered an unhandled exception
11864 catchpoint, return the address in inferior memory where the name
11865 of the exception is stored.
11866
11867 Return zero if the address could not be computed. */
11868
11869static CORE_ADDR
11871{
11872 return parse_and_eval_address ("e.full_name");
11873}
11874
11875/* Same as ada_unhandled_exception_name_addr, except that this function
11876 should be used when the inferior uses an older version of the runtime,
11877 where the exception name needs to be extracted from a specific frame
11878 several frames up in the callstack. */
11879
11880static CORE_ADDR
11882{
11883 int frame_level;
11884 frame_info_ptr fi;
11886
11887 /* To determine the name of this exception, we need to select
11888 the frame corresponding to RAISE_SYM_NAME. This frame is
11889 at least 3 levels up, so we simply skip the first 3 frames
11890 without checking the name of their associated function. */
11891 fi = get_current_frame ();
11892 for (frame_level = 0; frame_level < 3; frame_level += 1)
11893 if (fi != NULL)
11894 fi = get_prev_frame (fi);
11895
11896 while (fi != NULL)
11897 {
11898 enum language func_lang;
11899
11900 gdb::unique_xmalloc_ptr<char> func_name
11901 = find_frame_funname (fi, &func_lang, NULL);
11902 if (func_name != NULL)
11903 {
11904 if (strcmp (func_name.get (),
11905 data->exception_info->catch_exception_sym) == 0)
11906 break; /* We found the frame we were looking for... */
11907 }
11908 fi = get_prev_frame (fi);
11909 }
11910
11911 if (fi == NULL)
11912 return 0;
11913
11914 select_frame (fi);
11915 return parse_and_eval_address ("id.full_name");
11916}
11917
11918/* Assuming the inferior just triggered an Ada exception catchpoint
11919 (of any type), return the address in inferior memory where the name
11920 of the exception is stored, if applicable.
11921
11922 Assumes the selected frame is the current frame.
11923
11924 Return zero if the address could not be computed, or if not relevant. */
11925
11926static CORE_ADDR
11928{
11930
11931 switch (ex)
11932 {
11934 return (parse_and_eval_address ("e.full_name"));
11935 break;
11936
11938 return data->exception_info->unhandled_exception_name_addr ();
11939 break;
11940
11941 case ada_catch_handlers:
11942 return 0; /* The runtimes does not provide access to the exception
11943 name. */
11944 break;
11945
11946 case ada_catch_assert:
11947 return 0; /* Exception name is not relevant in this case. */
11948 break;
11949
11950 default:
11951 internal_error (_("unexpected catchpoint type"));
11952 break;
11953 }
11954
11955 return 0; /* Should never be reached. */
11956}
11957
11958/* Assuming the inferior is stopped at an exception catchpoint,
11959 return the message which was associated to the exception, if
11960 available. Return NULL if the message could not be retrieved.
11961
11962 Note: The exception message can be associated to an exception
11963 either through the use of the Raise_Exception function, or
11964 more simply (Ada 2005 and later), via:
11965
11966 raise Exception_Name with "exception message";
11967
11968 */
11969
11970static gdb::unique_xmalloc_ptr<char>
11972{
11973 struct value *e_msg_val;
11974 int e_msg_len;
11975
11976 /* For runtimes that support this feature, the exception message
11977 is passed as an unbounded string argument called "message". */
11978 e_msg_val = parse_and_eval ("message");
11979 if (e_msg_val == NULL)
11980 return NULL; /* Exception message not supported. */
11981
11982 e_msg_val = ada_coerce_to_simple_array (e_msg_val);
11983 gdb_assert (e_msg_val != NULL);
11984 e_msg_len = e_msg_val->type ()->length ();
11985
11986 /* If the message string is empty, then treat it as if there was
11987 no exception message. */
11988 if (e_msg_len <= 0)
11989 return NULL;
11990
11991 gdb::unique_xmalloc_ptr<char> e_msg ((char *) xmalloc (e_msg_len + 1));
11992 read_memory (e_msg_val->address (), (gdb_byte *) e_msg.get (),
11993 e_msg_len);
11994 e_msg.get ()[e_msg_len] = '\0';
11995
11996 return e_msg;
11997}
11998
11999/* Same as ada_exception_message_1, except that all exceptions are
12000 contained here (returning NULL instead). */
12001
12002static gdb::unique_xmalloc_ptr<char>
12004{
12005 gdb::unique_xmalloc_ptr<char> e_msg;
12006
12007 try
12008 {
12009 e_msg = ada_exception_message_1 ();
12010 }
12011 catch (const gdb_exception_error &e)
12012 {
12013 e_msg.reset (nullptr);
12014 }
12015
12016 return e_msg;
12017}
12018
12019/* Same as ada_exception_name_addr_1, except that it intercepts and contains
12020 any error that ada_exception_name_addr_1 might cause to be thrown.
12021 When an error is intercepted, a warning with the error message is printed,
12022 and zero is returned. */
12023
12024static CORE_ADDR
12026{
12027 CORE_ADDR result = 0;
12028
12029 try
12030 {
12031 result = ada_exception_name_addr_1 (ex);
12032 }
12033
12034 catch (const gdb_exception_error &e)
12035 {
12036 warning (_("failed to get exception name: %s"), e.what ());
12037 return 0;
12038 }
12039
12040 return result;
12041}
12042
12043static std::string ada_exception_catchpoint_cond_string
12044 (const char *excep_string,
12046
12047/* Ada catchpoints.
12048
12049 In the case of catchpoints on Ada exceptions, the catchpoint will
12050 stop the target on every exception the program throws. When a user
12051 specifies the name of a specific exception, we translate this
12052 request into a condition expression (in text form), and then parse
12053 it into an expression stored in each of the catchpoint's locations.
12054 We then use this condition to check whether the exception that was
12055 raised is the one the user is interested in. If not, then the
12056 target is resumed again. We store the name of the requested
12057 exception, in order to be able to re-set the condition expression
12058 when symbols change. */
12059
12060/* An instance of this type is used to represent an Ada catchpoint. */
12061
12063{
12064 ada_catchpoint (struct gdbarch *gdbarch_,
12066 const char *cond_string,
12067 bool tempflag,
12068 bool enabled,
12069 bool from_tty,
12070 std::string &&excep_string_)
12071 : code_breakpoint (gdbarch_, bp_catchpoint, tempflag, cond_string),
12072 m_excep_string (std::move (excep_string_)),
12073 m_kind (kind)
12074 {
12075 /* Unlike most code_breakpoint types, Ada catchpoints are
12076 pspace-specific. */
12078 enable_state = enabled ? bp_enabled : bp_disabled;
12080
12081 re_set ();
12082 }
12083
12084 struct bp_location *allocate_location () override;
12085 void re_set () override;
12086 void check_status (struct bpstat *bs) override;
12087 enum print_stop_action print_it (const bpstat *bs) const override;
12088 bool print_one (const bp_location **) const override;
12089 void print_mention () const override;
12090 void print_recreate (struct ui_file *fp) const override;
12091
12092private:
12093
12094 /* A helper function for check_status. Returns true if we should
12095 stop for this breakpoint hit. If the user specified a specific
12096 exception, we only want to cause a stop if the program thrown
12097 that exception. */
12098 bool should_stop_exception (const struct bp_location *bl) const;
12099
12100 /* The name of the specific exception the user specified. */
12101 std::string m_excep_string;
12102
12103 /* What kind of catchpoint this is. */
12105};
12106
12107/* An instance of this type is used to represent an Ada catchpoint
12108 breakpoint location. */
12109
12111{
12112public:
12116
12117 /* The condition that checks whether the exception that was raised
12118 is the specific exception the user specified on catchpoint
12119 creation. */
12121};
12122
12125
12126/* Implement the RE_SET method in the structure for all exception
12127 catchpoint kinds. */
12128
12129void
12131{
12132 std::vector<symtab_and_line> sals;
12133 try
12134 {
12136 sals.push_back (sal);
12137 }
12138 catch (const gdb_exception_error &ex)
12139 {
12140 /* For NOT_FOUND_ERROR, the breakpoint will be pending. */
12141 if (ex.error != NOT_FOUND_ERROR)
12142 throw;
12143 }
12144
12145 update_breakpoint_locations (this, pspace, sals, {});
12146
12147 /* Reparse the exception conditional expressions. One for each
12148 location. */
12149
12150 /* Nothing to do if there's no specific exception to catch. */
12151 if (m_excep_string.empty ())
12152 return;
12153
12154 /* Same if there are no locations... */
12155 if (!has_locations ())
12156 return;
12157
12158 /* Compute the condition expression in text form, from the specific
12159 exception we want to catch. */
12160 std::string cond_string
12162
12163 /* Iterate over all the catchpoint's locations, and parse an
12164 expression for each. */
12165 for (bp_location &bl : locations ())
12166 {
12168 = static_cast<ada_catchpoint_location &> (bl);
12169 expression_up exp;
12170
12171 if (!bl.shlib_disabled)
12172 {
12173 const char *s;
12174
12175 s = cond_string.c_str ();
12176 try
12177 {
12178 exp = parse_exp_1 (&s, bl.address, block_for_pc (bl.address), 0);
12179 }
12180 catch (const gdb_exception_error &e)
12181 {
12182 warning (_("failed to reevaluate internal exception condition "
12183 "for catchpoint %d: %s"),
12184 number, e.what ());
12185 }
12186 }
12187
12188 ada_loc.excep_cond_expr = std::move (exp);
12189 }
12190}
12191
12192/* Implement the ALLOCATE_LOCATION method in the structure for all
12193 exception catchpoint kinds. */
12194
12195struct bp_location *
12197{
12198 return new ada_catchpoint_location (this);
12199}
12200
12201/* See declaration. */
12202
12203bool
12205{
12206 ada_catchpoint *c = gdb::checked_static_cast<ada_catchpoint *> (bl->owner);
12207 const struct ada_catchpoint_location *ada_loc
12208 = (const struct ada_catchpoint_location *) bl;
12209 bool stop;
12210
12211 struct internalvar *var = lookup_internalvar ("_ada_exception");
12212 if (c->m_kind == ada_catch_assert)
12213 clear_internalvar (var);
12214 else
12215 {
12216 try
12217 {
12218 const char *expr;
12219
12220 if (c->m_kind == ada_catch_handlers)
12221 expr = ("GNAT_GCC_exception_Access(gcc_exception)"
12222 ".all.occurrence.id");
12223 else
12224 expr = "e";
12225
12226 struct value *exc = parse_and_eval (expr);
12227 set_internalvar (var, exc);
12228 }
12229 catch (const gdb_exception_error &ex)
12230 {
12231 clear_internalvar (var);
12232 }
12233 }
12234
12235 /* With no specific exception, should always stop. */
12236 if (c->m_excep_string.empty ())
12237 return true;
12238
12239 if (ada_loc->excep_cond_expr == NULL)
12240 {
12241 /* We will have a NULL expression if back when we were creating
12242 the expressions, this location's had failed to parse. */
12243 return true;
12244 }
12245
12246 stop = true;
12247 try
12248 {
12249 scoped_value_mark mark;
12250 stop = value_true (ada_loc->excep_cond_expr->evaluate ());
12251 }
12252 catch (const gdb_exception_error &ex)
12253 {
12255 _("Error in testing exception condition:\n"));
12256 }
12257
12258 return stop;
12259}
12260
12261/* Implement the CHECK_STATUS method in the structure for all
12262 exception catchpoint kinds. */
12263
12264void
12266{
12267 bs->stop = should_stop_exception (bs->bp_location_at.get ());
12268}
12269
12270/* Implement the PRINT_IT method in the structure for all exception
12271 catchpoint kinds. */
12272
12275{
12276 struct ui_out *uiout = current_uiout;
12277
12279
12280 if (uiout->is_mi_like_p ())
12281 {
12282 uiout->field_string ("reason",
12284 uiout->field_string ("disp", bpdisp_text (disposition));
12285 }
12286
12287 uiout->text (disposition == disp_del
12288 ? "\nTemporary catchpoint " : "\nCatchpoint ");
12289 print_num_locno (bs, uiout);
12290 uiout->text (", ");
12291
12292 /* ada_exception_name_addr relies on the selected frame being the
12293 current frame. Need to do this here because this function may be
12294 called more than once when printing a stop, and below, we'll
12295 select the first frame past the Ada run-time (see
12296 ada_find_printable_frame). */
12298
12299 switch (m_kind)
12300 {
12303 case ada_catch_handlers:
12304 {
12305 const CORE_ADDR addr = ada_exception_name_addr (m_kind);
12306 char exception_name[256];
12307
12308 if (addr != 0)
12309 {
12310 read_memory (addr, (gdb_byte *) exception_name,
12311 sizeof (exception_name) - 1);
12312 exception_name [sizeof (exception_name) - 1] = '\0';
12313 }
12314 else
12315 {
12316 /* For some reason, we were unable to read the exception
12317 name. This could happen if the Runtime was compiled
12318 without debugging info, for instance. In that case,
12319 just replace the exception name by the generic string
12320 "exception" - it will read as "an exception" in the
12321 notification we are about to print. */
12322 memcpy (exception_name, "exception", sizeof ("exception"));
12323 }
12324 /* In the case of unhandled exception breakpoints, we print
12325 the exception name as "unhandled EXCEPTION_NAME", to make
12326 it clearer to the user which kind of catchpoint just got
12327 hit. We used ui_out_text to make sure that this extra
12328 info does not pollute the exception name in the MI case. */
12330 uiout->text ("unhandled ");
12331 uiout->field_string ("exception-name", exception_name);
12332 }
12333 break;
12334 case ada_catch_assert:
12335 /* In this case, the name of the exception is not really
12336 important. Just print "failed assertion" to make it clearer
12337 that his program just hit an assertion-failure catchpoint.
12338 We used ui_out_text because this info does not belong in
12339 the MI output. */
12340 uiout->text ("failed assertion");
12341 break;
12342 }
12343
12344 gdb::unique_xmalloc_ptr<char> exception_message = ada_exception_message ();
12345 if (exception_message != NULL)
12346 {
12347 uiout->text (" (");
12348 uiout->field_string ("exception-message", exception_message.get ());
12349 uiout->text (")");
12350 }
12351
12352 uiout->text (" at ");
12354
12355 return PRINT_SRC_AND_LOC;
12356}
12357
12358/* Implement the PRINT_ONE method in the structure for all exception
12359 catchpoint kinds. */
12360
12361bool
12363{
12364 struct ui_out *uiout = current_uiout;
12365 struct value_print_options opts;
12366
12367 get_user_print_options (&opts);
12368
12369 if (opts.addressprint)
12370 uiout->field_skip ("addr");
12371
12372 annotate_field (5);
12373 switch (m_kind)
12374 {
12376 if (!m_excep_string.empty ())
12377 {
12378 std::string msg = string_printf (_("`%s' Ada exception"),
12379 m_excep_string.c_str ());
12380
12381 uiout->field_string ("what", msg);
12382 }
12383 else
12384 uiout->field_string ("what", "all Ada exceptions");
12385
12386 break;
12387
12389 uiout->field_string ("what", "unhandled Ada exceptions");
12390 break;
12391
12392 case ada_catch_handlers:
12393 if (!m_excep_string.empty ())
12394 {
12395 uiout->field_fmt ("what",
12396 _("`%s' Ada exception handlers"),
12397 m_excep_string.c_str ());
12398 }
12399 else
12400 uiout->field_string ("what", "all Ada exceptions handlers");
12401 break;
12402
12403 case ada_catch_assert:
12404 uiout->field_string ("what", "failed Ada assertions");
12405 break;
12406
12407 default:
12408 internal_error (_("unexpected catchpoint type"));
12409 break;
12410 }
12411
12412 return true;
12413}
12414
12415/* Implement the PRINT_MENTION method in the breakpoint_ops structure
12416 for all exception catchpoint kinds. */
12417
12418void
12420{
12421 struct ui_out *uiout = current_uiout;
12422
12423 uiout->text (disposition == disp_del ? _("Temporary catchpoint ")
12424 : _("Catchpoint "));
12425 uiout->field_signed ("bkptno", number);
12426 uiout->text (": ");
12427
12428 switch (m_kind)
12429 {
12431 if (!m_excep_string.empty ())
12432 {
12433 std::string info = string_printf (_("`%s' Ada exception"),
12434 m_excep_string.c_str ());
12435 uiout->text (info);
12436 }
12437 else
12438 uiout->text (_("all Ada exceptions"));
12439 break;
12440
12442 uiout->text (_("unhandled Ada exceptions"));
12443 break;
12444
12445 case ada_catch_handlers:
12446 if (!m_excep_string.empty ())
12447 {
12448 std::string info
12449 = string_printf (_("`%s' Ada exception handlers"),
12450 m_excep_string.c_str ());
12451 uiout->text (info);
12452 }
12453 else
12454 uiout->text (_("all Ada exceptions handlers"));
12455 break;
12456
12457 case ada_catch_assert:
12458 uiout->text (_("failed Ada assertions"));
12459 break;
12460
12461 default:
12462 internal_error (_("unexpected catchpoint type"));
12463 break;
12464 }
12465}
12466
12467/* Implement the PRINT_RECREATE method in the structure for all
12468 exception catchpoint kinds. */
12469
12470void
12472{
12473 switch (m_kind)
12474 {
12476 gdb_printf (fp, "catch exception");
12477 if (!m_excep_string.empty ())
12478 gdb_printf (fp, " %s", m_excep_string.c_str ());
12479 break;
12480
12482 gdb_printf (fp, "catch exception unhandled");
12483 break;
12484
12485 case ada_catch_handlers:
12486 gdb_printf (fp, "catch handlers");
12487 break;
12488
12489 case ada_catch_assert:
12490 gdb_printf (fp, "catch assert");
12491 break;
12492
12493 default:
12494 internal_error (_("unexpected catchpoint type"));
12495 }
12497}
12498
12499/* See ada-lang.h. */
12500
12501bool
12503{
12504 return dynamic_cast<ada_catchpoint *> (bp) != nullptr;
12505}
12506
12507/* Split the arguments specified in a "catch exception" command.
12508 Set EX to the appropriate catchpoint type.
12509 Set EXCEP_STRING to the name of the specific exception if
12510 specified by the user.
12511 IS_CATCH_HANDLERS_CMD: True if the arguments are for a
12512 "catch handlers" command. False otherwise.
12513 If a condition is found at the end of the arguments, the condition
12514 expression is stored in COND_STRING (memory must be deallocated
12515 after use). Otherwise COND_STRING is set to NULL. */
12516
12517static void
12519 bool is_catch_handlers_cmd,
12521 std::string *excep_string,
12522 std::string *cond_string)
12523{
12524 std::string exception_name;
12525
12526 exception_name = extract_arg (&args);
12527 if (exception_name == "if")
12528 {
12529 /* This is not an exception name; this is the start of a condition
12530 expression for a catchpoint on all exceptions. So, "un-get"
12531 this token, and set exception_name to NULL. */
12532 exception_name.clear ();
12533 args -= 2;
12534 }
12535
12536 /* Check to see if we have a condition. */
12537
12538 args = skip_spaces (args);
12539 if (startswith (args, "if")
12540 && (isspace (args[2]) || args[2] == '\0'))
12541 {
12542 args += 2;
12543 args = skip_spaces (args);
12544
12545 if (args[0] == '\0')
12546 error (_("Condition missing after `if' keyword"));
12547 *cond_string = args;
12548
12549 args += strlen (args);
12550 }
12551
12552 /* Check that we do not have any more arguments. Anything else
12553 is unexpected. */
12554
12555 if (args[0] != '\0')
12556 error (_("Junk at end of expression"));
12557
12558 if (is_catch_handlers_cmd)
12559 {
12560 /* Catch handling of exceptions. */
12561 *ex = ada_catch_handlers;
12562 *excep_string = exception_name;
12563 }
12564 else if (exception_name.empty ())
12565 {
12566 /* Catch all exceptions. */
12567 *ex = ada_catch_exception;
12568 excep_string->clear ();
12569 }
12570 else if (exception_name == "unhandled")
12571 {
12572 /* Catch unhandled exceptions. */
12574 excep_string->clear ();
12575 }
12576 else
12577 {
12578 /* Catch a specific exception. */
12579 *ex = ada_catch_exception;
12580 *excep_string = exception_name;
12581 }
12582}
12583
12584/* Return the name of the symbol on which we should break in order to
12585 implement a catchpoint of the EX kind. */
12586
12587static const char *
12589{
12591
12592 gdb_assert (data->exception_info != NULL);
12593
12594 switch (ex)
12595 {
12597 return (data->exception_info->catch_exception_sym);
12598 break;
12600 return (data->exception_info->catch_exception_unhandled_sym);
12601 break;
12602 case ada_catch_assert:
12603 return (data->exception_info->catch_assert_sym);
12604 break;
12605 case ada_catch_handlers:
12606 return (data->exception_info->catch_handlers_sym);
12607 break;
12608 default:
12609 internal_error (_("unexpected catchpoint kind (%d)"), ex);
12610 }
12611}
12612
12613/* Return the condition that will be used to match the current exception
12614 being raised with the exception that the user wants to catch. This
12615 assumes that this condition is used when the inferior just triggered
12616 an exception catchpoint.
12617 EX: the type of catchpoints used for catching Ada exceptions. */
12618
12619static std::string
12622{
12623 bool is_standard_exc = false;
12624 std::string result;
12625
12626 if (ex == ada_catch_handlers)
12627 {
12628 /* For exception handlers catchpoints, the condition string does
12629 not use the same parameter as for the other exceptions. */
12630 result = ("long_integer (GNAT_GCC_exception_Access"
12631 "(gcc_exception).all.occurrence.id)");
12632 }
12633 else
12634 result = "long_integer (e)";
12635
12636 /* The standard exceptions are a special case. They are defined in
12637 runtime units that have been compiled without debugging info; if
12638 EXCEP_STRING is the not-fully-qualified name of a standard
12639 exception (e.g. "constraint_error") then, during the evaluation
12640 of the condition expression, the symbol lookup on this name would
12641 *not* return this standard exception. The catchpoint condition
12642 may then be set only on user-defined exceptions which have the
12643 same not-fully-qualified name (e.g. my_package.constraint_error).
12644
12645 To avoid this unexcepted behavior, these standard exceptions are
12646 systematically prefixed by "standard". This means that "catch
12647 exception constraint_error" is rewritten into "catch exception
12648 standard.constraint_error".
12649
12650 If an exception named constraint_error is defined in another package of
12651 the inferior program, then the only way to specify this exception as a
12652 breakpoint condition is to use its fully-qualified named:
12653 e.g. my_package.constraint_error. */
12654
12655 for (const char *name : standard_exc)
12656 {
12657 if (strcmp (name, excep_string) == 0)
12658 {
12659 is_standard_exc = true;
12660 break;
12661 }
12662 }
12663
12664 result += " = ";
12665
12666 if (is_standard_exc)
12667 string_appendf (result, "long_integer (&standard.%s)", excep_string);
12668 else
12669 string_appendf (result, "long_integer (&%s)", excep_string);
12670
12671 return result;
12672}
12673
12674/* Return the symtab_and_line that should be used to insert an
12675 exception catchpoint of the TYPE kind. */
12676
12677static struct symtab_and_line
12679{
12680 const char *sym_name;
12681 struct symbol *sym;
12682
12683 /* First, find out which exception support info to use. */
12685
12686 /* Then lookup the function on which we will break in order to catch
12687 the Ada exceptions requested by the user. */
12688 sym_name = ada_exception_sym_name (ex);
12689 sym = standard_lookup (sym_name, NULL, VAR_DOMAIN);
12690
12691 if (sym == NULL)
12692 throw_error (NOT_FOUND_ERROR, _("Catchpoint symbol not found: %s"),
12693 sym_name);
12694
12695 if (sym->aclass () != LOC_BLOCK)
12696 error (_("Unable to insert catchpoint. %s is not a function."), sym_name);
12697
12698 return find_function_start_sal (sym, 1);
12699}
12700
12701/* Create an Ada exception catchpoint.
12702
12703 EX_KIND is the kind of exception catchpoint to be created.
12704
12705 If EXCEPT_STRING is empty, this catchpoint is expected to trigger
12706 for all exceptions. Otherwise, EXCEPT_STRING indicates the name
12707 of the exception to which this catchpoint applies.
12708
12709 COND_STRING, if not empty, is the catchpoint condition.
12710
12711 TEMPFLAG, if nonzero, means that the underlying breakpoint
12712 should be temporary.
12713
12714 FROM_TTY is the usual argument passed to all commands implementations. */
12715
12716void
12718 enum ada_exception_catchpoint_kind ex_kind,
12719 std::string &&excep_string,
12720 const std::string &cond_string,
12721 int tempflag,
12722 int enabled,
12723 int from_tty)
12724{
12725 std::unique_ptr<ada_catchpoint> c
12726 (new ada_catchpoint (gdbarch, ex_kind,
12727 cond_string.empty () ? nullptr : cond_string.c_str (),
12728 tempflag, enabled, from_tty,
12729 std::move (excep_string)));
12730 install_breakpoint (0, std::move (c), 1);
12731}
12732
12733/* Implement the "catch exception" command. */
12734
12735static void
12736catch_ada_exception_command (const char *arg_entry, int from_tty,
12737 struct cmd_list_element *command)
12738{
12739 const char *arg = arg_entry;
12740 struct gdbarch *gdbarch = get_current_arch ();
12741 int tempflag;
12742 enum ada_exception_catchpoint_kind ex_kind;
12743 std::string excep_string;
12744 std::string cond_string;
12745
12746 tempflag = command->context () == CATCH_TEMPORARY;
12747
12748 if (!arg)
12749 arg = "";
12750 catch_ada_exception_command_split (arg, false, &ex_kind, &excep_string,
12751 &cond_string);
12753 std::move (excep_string), cond_string,
12754 tempflag, 1 /* enabled */,
12755 from_tty);
12756}
12757
12758/* Implement the "catch handlers" command. */
12759
12760static void
12761catch_ada_handlers_command (const char *arg_entry, int from_tty,
12762 struct cmd_list_element *command)
12763{
12764 const char *arg = arg_entry;
12765 struct gdbarch *gdbarch = get_current_arch ();
12766 int tempflag;
12767 enum ada_exception_catchpoint_kind ex_kind;
12768 std::string excep_string;
12769 std::string cond_string;
12770
12771 tempflag = command->context () == CATCH_TEMPORARY;
12772
12773 if (!arg)
12774 arg = "";
12775 catch_ada_exception_command_split (arg, true, &ex_kind, &excep_string,
12776 &cond_string);
12778 std::move (excep_string), cond_string,
12779 tempflag, 1 /* enabled */,
12780 from_tty);
12781}
12782
12783/* Completion function for the Ada "catch" commands. */
12784
12785static void
12787 const char *text, const char *word)
12788{
12789 std::vector<ada_exc_info> exceptions = ada_exceptions_list (NULL);
12790
12791 for (const ada_exc_info &info : exceptions)
12792 {
12793 if (startswith (info.name, word))
12794 tracker.add_completion (make_unique_xstrdup (info.name));
12795 }
12796}
12797
12798/* Split the arguments specified in a "catch assert" command.
12799
12800 ARGS contains the command's arguments (or the empty string if
12801 no arguments were passed).
12802
12803 If ARGS contains a condition, set COND_STRING to that condition
12804 (the memory needs to be deallocated after use). */
12805
12806static void
12807catch_ada_assert_command_split (const char *args, std::string &cond_string)
12808{
12809 args = skip_spaces (args);
12810
12811 /* Check whether a condition was provided. */
12812 if (startswith (args, "if")
12813 && (isspace (args[2]) || args[2] == '\0'))
12814 {
12815 args += 2;
12816 args = skip_spaces (args);
12817 if (args[0] == '\0')
12818 error (_("condition missing after `if' keyword"));
12819 cond_string.assign (args);
12820 }
12821
12822 /* Otherwise, there should be no other argument at the end of
12823 the command. */
12824 else if (args[0] != '\0')
12825 error (_("Junk at end of arguments."));
12826}
12827
12828/* Implement the "catch assert" command. */
12829
12830static void
12831catch_assert_command (const char *arg_entry, int from_tty,
12832 struct cmd_list_element *command)
12833{
12834 const char *arg = arg_entry;
12835 struct gdbarch *gdbarch = get_current_arch ();
12836 int tempflag;
12837 std::string cond_string;
12838
12839 tempflag = command->context () == CATCH_TEMPORARY;
12840
12841 if (!arg)
12842 arg = "";
12843 catch_ada_assert_command_split (arg, cond_string);
12845 {}, cond_string,
12846 tempflag, 1 /* enabled */,
12847 from_tty);
12848}
12849
12850/* Return non-zero if the symbol SYM is an Ada exception object. */
12851
12852static int
12854{
12855 const char *type_name = sym->type ()->name ();
12856
12857 return (sym->aclass () != LOC_TYPEDEF
12858 && sym->aclass () != LOC_BLOCK
12859 && sym->aclass () != LOC_CONST
12860 && sym->aclass () != LOC_UNRESOLVED
12861 && type_name != NULL && strcmp (type_name, "exception") == 0);
12862}
12863
12864/* Given a global symbol SYM, return non-zero iff SYM is a non-standard
12865 Ada exception object. This matches all exceptions except the ones
12866 defined by the Ada language. */
12867
12868static int
12870{
12871 if (!ada_is_exception_sym (sym))
12872 return 0;
12873
12874 for (const char *name : standard_exc)
12875 if (strcmp (sym->linkage_name (), name) == 0)
12876 return 0; /* A standard exception. */
12877
12878 /* Numeric_Error is also a standard exception, so exclude it.
12879 See the STANDARD_EXC description for more details as to why
12880 this exception is not listed in that array. */
12881 if (strcmp (sym->linkage_name (), "numeric_error") == 0)
12882 return 0;
12883
12884 return 1;
12885}
12886
12887/* A helper function for std::sort, comparing two struct ada_exc_info
12888 objects.
12889
12890 The comparison is determined first by exception name, and then
12891 by exception address. */
12892
12893bool
12894ada_exc_info::operator< (const ada_exc_info &other) const
12895{
12896 int result;
12897
12898 result = strcmp (name, other.name);
12899 if (result < 0)
12900 return true;
12901 if (result == 0 && addr < other.addr)
12902 return true;
12903 return false;
12904}
12905
12906bool
12908{
12909 return addr == other.addr && strcmp (name, other.name) == 0;
12910}
12911
12912/* Sort EXCEPTIONS using compare_ada_exception_info as the comparison
12913 routine, but keeping the first SKIP elements untouched.
12914
12915 All duplicates are also removed. */
12916
12917static void
12918sort_remove_dups_ada_exceptions_list (std::vector<ada_exc_info> *exceptions,
12919 int skip)
12920{
12921 std::sort (exceptions->begin () + skip, exceptions->end ());
12922 exceptions->erase (std::unique (exceptions->begin () + skip, exceptions->end ()),
12923 exceptions->end ());
12924}
12925
12926/* Add all exceptions defined by the Ada standard whose name match
12927 a regular expression.
12928
12929 If PREG is not NULL, then this regexp_t object is used to
12930 perform the symbol name matching. Otherwise, no name-based
12931 filtering is performed.
12932
12933 EXCEPTIONS is a vector of exceptions to which matching exceptions
12934 gets pushed. */
12935
12936static void
12937ada_add_standard_exceptions (compiled_regex *preg,
12938 std::vector<ada_exc_info> *exceptions)
12939{
12940 for (const char *name : standard_exc)
12941 {
12942 if (preg == NULL || preg->exec (name, 0, NULL, 0) == 0)
12943 {
12945 lookup_name_info lookup_name (name, match_type);
12946
12947 symbol_name_matcher_ftype *match_name
12948 = ada_get_symbol_name_matcher (lookup_name);
12949
12950 /* Iterate over all objfiles irrespective of scope or linker
12951 namespaces so we get all exceptions anywhere in the
12952 progspace. */
12954 {
12955 for (minimal_symbol *msymbol : objfile->msymbols ())
12956 {
12957 if (match_name (msymbol->linkage_name (), lookup_name,
12958 nullptr)
12959 && msymbol->type () != mst_solib_trampoline)
12960 {
12962 = {name, msymbol->value_address (objfile)};
12963
12964 exceptions->push_back (info);
12965 }
12966 }
12967 }
12968 }
12969 }
12970}
12971
12972/* Add all Ada exceptions defined locally and accessible from the given
12973 FRAME.
12974
12975 If PREG is not NULL, then this regexp_t object is used to
12976 perform the symbol name matching. Otherwise, no name-based
12977 filtering is performed.
12978
12979 EXCEPTIONS is a vector of exceptions to which matching exceptions
12980 gets pushed. */
12981
12982static void
12983ada_add_exceptions_from_frame (compiled_regex *preg,
12984 frame_info_ptr frame,
12985 std::vector<ada_exc_info> *exceptions)
12986{
12987 const struct block *block = get_frame_block (frame, 0);
12988
12989 while (block != 0)
12990 {
12991 for (struct symbol *sym : block_iterator_range (block))
12992 {
12993 switch (sym->aclass ())
12994 {
12995 case LOC_TYPEDEF:
12996 case LOC_BLOCK:
12997 case LOC_CONST:
12998 break;
12999 default:
13000 if (ada_is_exception_sym (sym))
13001 {
13002 struct ada_exc_info info = {sym->print_name (),
13003 sym->value_address ()};
13004
13005 exceptions->push_back (info);
13006 }
13007 }
13008 }
13009 if (block->function () != NULL)
13010 break;
13011 block = block->superblock ();
13012 }
13013}
13014
13015/* Return true if NAME matches PREG or if PREG is NULL. */
13016
13017static bool
13018name_matches_regex (const char *name, compiled_regex *preg)
13019{
13020 return (preg == NULL
13021 || preg->exec (ada_decode (name).c_str (), 0, NULL, 0) == 0);
13022}
13023
13024/* Add all exceptions defined globally whose name name match
13025 a regular expression, excluding standard exceptions.
13026
13027 The reason we exclude standard exceptions is that they need
13028 to be handled separately: Standard exceptions are defined inside
13029 a runtime unit which is normally not compiled with debugging info,
13030 and thus usually do not show up in our symbol search. However,
13031 if the unit was in fact built with debugging info, we need to
13032 exclude them because they would duplicate the entry we found
13033 during the special loop that specifically searches for those
13034 standard exceptions.
13035
13036 If PREG is not NULL, then this regexp_t object is used to
13037 perform the symbol name matching. Otherwise, no name-based
13038 filtering is performed.
13039
13040 EXCEPTIONS is a vector of exceptions to which matching exceptions
13041 gets pushed. */
13042
13043static void
13044ada_add_global_exceptions (compiled_regex *preg,
13045 std::vector<ada_exc_info> *exceptions)
13046{
13047 /* In Ada, the symbol "search name" is a linkage name, whereas the
13048 regular expression used to do the matching refers to the natural
13049 name. So match against the decoded name. */
13052 [&] (const char *search_name)
13053 {
13054 std::string decoded = ada_decode (search_name);
13055 return name_matches_regex (decoded.c_str (), preg);
13056 },
13057 NULL,
13060
13061 /* Iterate over all objfiles irrespective of scope or linker namespaces
13062 so we get all exceptions anywhere in the progspace. */
13064 {
13065 for (compunit_symtab *s : objfile->compunits ())
13066 {
13067 const struct blockvector *bv = s->blockvector ();
13068 int i;
13069
13070 for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
13071 {
13072 const struct block *b = bv->block (i);
13073
13074 for (struct symbol *sym : block_iterator_range (b))
13076 && name_matches_regex (sym->natural_name (), preg))
13077 {
13078 struct ada_exc_info info
13079 = {sym->print_name (), sym->value_address ()};
13080
13081 exceptions->push_back (info);
13082 }
13083 }
13084 }
13085 }
13086}
13087
13088/* Implements ada_exceptions_list with the regular expression passed
13089 as a regex_t, rather than a string.
13090
13091 If not NULL, PREG is used to filter out exceptions whose names
13092 do not match. Otherwise, all exceptions are listed. */
13093
13094static std::vector<ada_exc_info>
13095ada_exceptions_list_1 (compiled_regex *preg)
13096{
13097 std::vector<ada_exc_info> result;
13098 int prev_len;
13099
13100 /* First, list the known standard exceptions. These exceptions
13101 need to be handled separately, as they are usually defined in
13102 runtime units that have been compiled without debugging info. */
13103
13104 ada_add_standard_exceptions (preg, &result);
13105
13106 /* Next, find all exceptions whose scope is local and accessible
13107 from the currently selected frame. */
13108
13109 if (has_stack_frames ())
13110 {
13111 prev_len = result.size ();
13113 &result);
13114 if (result.size () > prev_len)
13115 sort_remove_dups_ada_exceptions_list (&result, prev_len);
13116 }
13117
13118 /* Add all exceptions whose scope is global. */
13119
13120 prev_len = result.size ();
13121 ada_add_global_exceptions (preg, &result);
13122 if (result.size () > prev_len)
13123 sort_remove_dups_ada_exceptions_list (&result, prev_len);
13124
13125 return result;
13126}
13127
13128/* Return a vector of ada_exc_info.
13129
13130 If REGEXP is NULL, all exceptions are included in the result.
13131 Otherwise, it should contain a valid regular expression,
13132 and only the exceptions whose names match that regular expression
13133 are included in the result.
13134
13135 The exceptions are sorted in the following order:
13136 - Standard exceptions (defined by the Ada language), in
13137 alphabetical order;
13138 - Exceptions only visible from the current frame, in
13139 alphabetical order;
13140 - Exceptions whose scope is global, in alphabetical order. */
13141
13142std::vector<ada_exc_info>
13143ada_exceptions_list (const char *regexp)
13144{
13145 if (regexp == NULL)
13146 return ada_exceptions_list_1 (NULL);
13147
13148 compiled_regex reg (regexp, REG_NOSUB, _("invalid regular expression"));
13149 return ada_exceptions_list_1 (&reg);
13150}
13151
13152/* Implement the "info exceptions" command. */
13153
13154static void
13155info_exceptions_command (const char *regexp, int from_tty)
13156{
13157 struct gdbarch *gdbarch = get_current_arch ();
13158
13159 std::vector<ada_exc_info> exceptions = ada_exceptions_list (regexp);
13160
13161 if (regexp != NULL)
13163 (_("All Ada exceptions matching regular expression \"%s\":\n"), regexp);
13164 else
13165 gdb_printf (_("All defined Ada exceptions:\n"));
13166
13167 for (const ada_exc_info &info : exceptions)
13168 gdb_printf ("%s: %s\n", info.name, paddress (gdbarch, info.addr));
13169}
13170
13171
13172 /* Language vector */
13173
13174/* symbol_name_matcher_ftype adapter for wild_match. */
13175
13176static bool
13177do_wild_match (const char *symbol_search_name,
13178 const lookup_name_info &lookup_name,
13179 completion_match_result *comp_match_res)
13180{
13181 return wild_match (symbol_search_name, ada_lookup_name (lookup_name));
13182}
13183
13184/* symbol_name_matcher_ftype adapter for full_match. */
13185
13186static bool
13187do_full_match (const char *symbol_search_name,
13188 const lookup_name_info &lookup_name,
13189 completion_match_result *comp_match_res)
13190{
13191 const char *lname = lookup_name.ada ().lookup_name ().c_str ();
13192
13193 /* If both symbols start with "_ada_", just let the loop below
13194 handle the comparison. However, if only the symbol name starts
13195 with "_ada_", skip the prefix and let the match proceed as
13196 usual. */
13197 if (startswith (symbol_search_name, "_ada_")
13198 && !startswith (lname, "_ada"))
13199 symbol_search_name += 5;
13200 /* Likewise for ghost entities. */
13201 if (startswith (symbol_search_name, "___ghost_")
13202 && !startswith (lname, "___ghost_"))
13203 symbol_search_name += 9;
13204
13205 int uscore_count = 0;
13206 while (*lname != '\0')
13207 {
13208 if (*symbol_search_name != *lname)
13209 {
13210 if (*symbol_search_name == 'B' && uscore_count == 2
13211 && symbol_search_name[1] == '_')
13212 {
13213 symbol_search_name += 2;
13214 while (isdigit (*symbol_search_name))
13215 ++symbol_search_name;
13216 if (symbol_search_name[0] == '_'
13217 && symbol_search_name[1] == '_')
13218 {
13219 symbol_search_name += 2;
13220 continue;
13221 }
13222 }
13223 return false;
13224 }
13225
13226 if (*symbol_search_name == '_')
13227 ++uscore_count;
13228 else
13229 uscore_count = 0;
13230
13231 ++symbol_search_name;
13232 ++lname;
13233 }
13234
13235 return is_name_suffix (symbol_search_name);
13236}
13237
13238/* symbol_name_matcher_ftype for exact (verbatim) matches. */
13239
13240static bool
13241do_exact_match (const char *symbol_search_name,
13242 const lookup_name_info &lookup_name,
13243 completion_match_result *comp_match_res)
13244{
13245 return strcmp (symbol_search_name, ada_lookup_name (lookup_name)) == 0;
13246}
13247
13248/* Build the Ada lookup name for LOOKUP_NAME. */
13249
13251{
13252 gdb::string_view user_name = lookup_name.name ();
13253
13254 if (!user_name.empty () && user_name[0] == '<')
13255 {
13256 if (user_name.back () == '>')
13258 = gdb::to_string (user_name.substr (1, user_name.size () - 2));
13259 else
13261 = gdb::to_string (user_name.substr (1, user_name.size () - 1));
13262 m_encoded_p = true;
13263 m_verbatim_p = true;
13264 m_wild_match_p = false;
13265 m_standard_p = false;
13266 }
13267 else
13268 {
13269 m_verbatim_p = false;
13270
13271 m_encoded_p = user_name.find ("__") != gdb::string_view::npos;
13272
13273 if (!m_encoded_p)
13274 {
13275 const char *folded = ada_fold_name (user_name);
13276 m_encoded_name = ada_encode_1 (folded, false);
13277 if (m_encoded_name.empty ())
13278 m_encoded_name = gdb::to_string (user_name);
13279 }
13280 else
13281 m_encoded_name = gdb::to_string (user_name);
13282
13283 /* Handle the 'package Standard' special case. See description
13284 of m_standard_p. */
13285 if (startswith (m_encoded_name.c_str (), "standard__"))
13286 {
13287 m_encoded_name = m_encoded_name.substr (sizeof ("standard__") - 1);
13288 m_standard_p = true;
13289 }
13290 else
13291 m_standard_p = false;
13292
13293 /* If the name contains a ".", then the user is entering a fully
13294 qualified entity name, and the match must not be done in wild
13295 mode. Similarly, if the user wants to complete what looks
13296 like an encoded name, the match must not be done in wild
13297 mode. Also, in the standard__ special case always do
13298 non-wild matching. */
13300 = (lookup_name.match_type () != symbol_name_match_type::FULL
13301 && !m_encoded_p
13302 && !m_standard_p
13303 && user_name.find ('.') == std::string::npos);
13304 }
13305}
13306
13307/* symbol_name_matcher_ftype method for Ada. This only handles
13308 completion mode. */
13309
13310static bool
13311ada_symbol_name_matches (const char *symbol_search_name,
13312 const lookup_name_info &lookup_name,
13313 completion_match_result *comp_match_res)
13314{
13315 return lookup_name.ada ().matches (symbol_search_name,
13316 lookup_name.match_type (),
13317 comp_match_res);
13318}
13319
13320/* A name matcher that matches the symbol name exactly, with
13321 strcmp. */
13322
13323static bool
13324literal_symbol_name_matcher (const char *symbol_search_name,
13325 const lookup_name_info &lookup_name,
13326 completion_match_result *comp_match_res)
13327{
13328 gdb::string_view name_view = lookup_name.name ();
13329
13330 if (lookup_name.completion_mode ()
13331 ? (strncmp (symbol_search_name, name_view.data (),
13332 name_view.size ()) == 0)
13333 : symbol_search_name == name_view)
13334 {
13335 if (comp_match_res != NULL)
13336 comp_match_res->set_match (symbol_search_name);
13337 return true;
13338 }
13339 else
13340 return false;
13341}
13342
13343/* Implement the "get_symbol_name_matcher" language_defn method for
13344 Ada. */
13345
13348{
13349 if (lookup_name.match_type () == symbol_name_match_type::SEARCH_NAME)
13351
13352 if (lookup_name.completion_mode ())
13354 else
13355 {
13356 if (lookup_name.ada ().wild_match_p ())
13357 return do_wild_match;
13358 else if (lookup_name.ada ().verbatim_p ())
13359 return do_exact_match;
13360 else
13361 return do_full_match;
13362 }
13363}
13364
13365/* Class representing the Ada language. */
13366
13368{
13369public:
13372 { /* Nothing. */ }
13373
13374 /* See language.h. */
13375
13376 const char *name () const override
13377 { return "ada"; }
13378
13379 /* See language.h. */
13380
13381 const char *natural_name () const override
13382 { return "Ada"; }
13383
13384 /* See language.h. */
13385
13386 const std::vector<const char *> &filename_extensions () const override
13387 {
13388 static const std::vector<const char *> extensions
13389 = { ".adb", ".ads", ".a", ".ada", ".dg" };
13390 return extensions;
13391 }
13392
13393 /* Print an array element index using the Ada syntax. */
13394
13395 void print_array_index (struct type *index_type,
13396 LONGEST index,
13397 struct ui_file *stream,
13398 const value_print_options *options) const override
13399 {
13400 struct value *index_value = val_atr (index_type, index);
13401
13402 value_print (index_value, stream, options);
13403 gdb_printf (stream, " => ");
13404 }
13405
13406 /* Implement the "read_var_value" language_defn method for Ada. */
13407
13408 struct value *read_var_value (struct symbol *var,
13409 const struct block *var_block,
13410 frame_info_ptr frame) const override
13411 {
13412 /* The only case where default_read_var_value is not sufficient
13413 is when VAR is a renaming... */
13414 if (frame != nullptr)
13415 {
13416 const struct block *frame_block = get_frame_block (frame, NULL);
13417 if (frame_block != nullptr && ada_is_renaming_symbol (var))
13418 return ada_read_renaming_var_value (var, frame_block);
13419 }
13420
13421 /* This is a typical case where we expect the default_read_var_value
13422 function to work. */
13423 return language_defn::read_var_value (var, var_block, frame);
13424 }
13425
13426 /* See language.h. */
13427 bool symbol_printing_suppressed (struct symbol *symbol) const override
13428 {
13429 return symbol->is_artificial ();
13430 }
13431
13432 /* See language.h. */
13434 const char *ptr, ssize_t len) const override
13435 {
13436 struct type *type = language_string_char_type (this, gdbarch);
13437 value *val = ::value_string (ptr, len, type);
13438 /* VAL will be a TYPE_CODE_STRING, but Ada only knows how to print
13439 strings that are arrays of characters, so fix the type now. */
13440 gdb_assert (val->type ()->code () == TYPE_CODE_STRING);
13441 val->type ()->set_code (TYPE_CODE_ARRAY);
13442 return val;
13443 }
13444
13445 /* See language.h. */
13447 struct language_arch_info *lai) const override
13448 {
13449 const struct builtin_type *builtin = builtin_type (gdbarch);
13450
13451 /* Helper function to allow shorter lines below. */
13452 auto add = [&] (struct type *t)
13453 {
13454 lai->add_primitive_type (t);
13455 };
13456
13457 type_allocator alloc (gdbarch);
13459 0, "integer"));
13461 0, "long_integer"));
13463 0, "short_integer"));
13464 struct type *char_type = init_character_type (alloc, TARGET_CHAR_BIT,
13465 1, "character");
13466 lai->set_string_char_type (char_type);
13467 add (char_type);
13468 add (init_character_type (alloc, 16, 1, "wide_character"));
13469 add (init_character_type (alloc, 32, 1, "wide_wide_character"));
13471 "float", gdbarch_float_format (gdbarch)));
13473 "long_float", gdbarch_double_format (gdbarch)));
13475 0, "long_long_integer"));
13476 add (init_integer_type (alloc, 128, 0, "long_long_long_integer"));
13477 add (init_integer_type (alloc, 128, 1, "unsigned_long_long_long_integer"));
13479 "long_long_float",
13482 0, "natural"));
13484 0, "positive"));
13485 add (builtin->builtin_void);
13486
13487 struct type *system_addr_ptr
13488 = lookup_pointer_type (alloc.new_type (TYPE_CODE_VOID, TARGET_CHAR_BIT,
13489 "void"));
13490 system_addr_ptr->set_name ("system__address");
13491 add (system_addr_ptr);
13492
13493 /* Create the equivalent of the System.Storage_Elements.Storage_Offset
13494 type. This is a signed integral type whose size is the same as
13495 the size of addresses. */
13496 unsigned int addr_length = system_addr_ptr->length ();
13497 add (init_integer_type (alloc, addr_length * HOST_CHAR_BIT, 0,
13498 "storage_offset"));
13499
13500 lai->set_bool_type (builtin->builtin_bool);
13501 }
13502
13503 /* See language.h. */
13504
13506 (const struct block *block, const lookup_name_info &name,
13507 domain_enum domain,
13508 gdb::function_view<symbol_found_callback_ftype> callback) const override
13509 {
13510 std::vector<struct block_symbol> results
13512 for (block_symbol &sym : results)
13513 {
13514 if (!callback (&sym))
13515 return false;
13516 }
13517
13518 return true;
13519 }
13520
13521 /* See language.h. */
13523 (const char *mangled,
13524 gdb::unique_xmalloc_ptr<char> *out) const override
13525 {
13526 std::string demangled = ada_decode (mangled);
13527
13528 *out = NULL;
13529
13530 if (demangled != mangled && demangled[0] != '<')
13531 {
13532 /* Set the gsymbol language to Ada, but still return 0.
13533 Two reasons for that:
13534
13535 1. For Ada, we prefer computing the symbol's decoded name
13536 on the fly rather than pre-compute it, in order to save
13537 memory (Ada projects are typically very large).
13538
13539 2. There are some areas in the definition of the GNAT
13540 encoding where, with a bit of bad luck, we might be able
13541 to decode a non-Ada symbol, generating an incorrect
13542 demangled name (Eg: names ending with "TB" for instance
13543 are identified as task bodies and so stripped from
13544 the decoded name returned).
13545
13546 Returning true, here, but not setting *DEMANGLED, helps us get
13547 a little bit of the best of both worlds. Because we're last,
13548 we should not affect any of the other languages that were
13549 able to demangle the symbol before us; we get to correctly
13550 tag Ada symbols as such; and even if we incorrectly tagged a
13551 non-Ada symbol, which should be rare, any routing through the
13552 Ada language should be transparent (Ada tries to behave much
13553 like C/C++ with non-Ada symbols). */
13554 return true;
13555 }
13556
13557 return false;
13558 }
13559
13560 /* See language.h. */
13561
13562 gdb::unique_xmalloc_ptr<char> demangle_symbol (const char *mangled,
13563 int options) const override
13564 {
13565 return make_unique_xstrdup (ada_decode (mangled).c_str ());
13566 }
13567
13568 /* See language.h. */
13569
13570 void print_type (struct type *type, const char *varstring,
13571 struct ui_file *stream, int show, int level,
13572 const struct type_print_options *flags) const override
13573 {
13574 ada_print_type (type, varstring, stream, show, level, flags);
13575 }
13576
13577 /* See language.h. */
13578
13579 const char *word_break_characters (void) const override
13580 {
13582 }
13583
13584 /* See language.h. */
13585
13588 symbol_name_match_type name_match_type,
13589 const char *text, const char *word,
13590 enum type_code code) const override
13591 {
13592 const struct block *b, *surrounding_static_block = 0;
13593
13594 gdb_assert (code == TYPE_CODE_UNDEF);
13595
13596 lookup_name_info lookup_name (text, name_match_type, true);
13597
13598 /* First, look at the partial symtab symbols. */
13600 lookup_name,
13601 NULL,
13602 NULL,
13604 ALL_DOMAIN);
13605
13606 /* At this point scan through the misc symbol vectors and add each
13607 symbol you find to the list. Eventually we want to ignore
13608 anything that isn't a text symbol (everything else will be
13609 handled by the psymtab code above). */
13610
13612 {
13613 for (minimal_symbol *msymbol : objfile->msymbols ())
13614 {
13615 QUIT;
13616
13617 if (completion_skip_symbol (mode, msymbol))
13618 continue;
13619
13620 language symbol_language = msymbol->language ();
13621
13622 /* Ada minimal symbols won't have their language set to Ada. If
13623 we let completion_list_add_name compare using the
13624 default/C-like matcher, then when completing e.g., symbols in a
13625 package named "pck", we'd match internal Ada symbols like
13626 "pckS", which are invalid in an Ada expression, unless you wrap
13627 them in '<' '>' to request a verbatim match.
13628
13629 Unfortunately, some Ada encoded names successfully demangle as
13630 C++ symbols (using an old mangling scheme), such as "name__2Xn"
13631 -> "Xn::name(void)" and thus some Ada minimal symbols end up
13632 with the wrong language set. Paper over that issue here. */
13633 if (symbol_language == language_unknown
13634 || symbol_language == language_cplus)
13635 symbol_language = language_ada;
13636
13637 completion_list_add_name (tracker,
13638 symbol_language,
13639 msymbol->linkage_name (),
13640 lookup_name, text, word);
13641 }
13642 }
13643
13644 /* Search upwards from currently selected frame (so that we can
13645 complete on local vars. */
13646
13647 for (b = get_selected_block (0); b != NULL; b = b->superblock ())
13648 {
13649 if (!b->superblock ())
13650 surrounding_static_block = b; /* For elmin of dups */
13651
13652 for (struct symbol *sym : block_iterator_range (b))
13653 {
13654 if (completion_skip_symbol (mode, sym))
13655 continue;
13656
13657 completion_list_add_name (tracker,
13658 sym->language (),
13659 sym->linkage_name (),
13660 lookup_name, text, word);
13661 }
13662 }
13663
13664 /* Go through the symtabs and check the externs and statics for
13665 symbols which match. */
13666
13668 {
13669 for (compunit_symtab *s : objfile->compunits ())
13670 {
13671 QUIT;
13672 b = s->blockvector ()->global_block ();
13673 for (struct symbol *sym : block_iterator_range (b))
13674 {
13675 if (completion_skip_symbol (mode, sym))
13676 continue;
13677
13678 completion_list_add_name (tracker,
13679 sym->language (),
13680 sym->linkage_name (),
13681 lookup_name, text, word);
13682 }
13683 }
13684 }
13685
13687 {
13688 for (compunit_symtab *s : objfile->compunits ())
13689 {
13690 QUIT;
13691 b = s->blockvector ()->static_block ();
13692 /* Don't do this block twice. */
13693 if (b == surrounding_static_block)
13694 continue;
13695 for (struct symbol *sym : block_iterator_range (b))
13696 {
13697 if (completion_skip_symbol (mode, sym))
13698 continue;
13699
13700 completion_list_add_name (tracker,
13701 sym->language (),
13702 sym->linkage_name (),
13703 lookup_name, text, word);
13704 }
13705 }
13706 }
13707 }
13708
13709 /* See language.h. */
13710
13711 gdb::unique_xmalloc_ptr<char> watch_location_expression
13712 (struct type *type, CORE_ADDR addr) const override
13713 {
13714 type = check_typedef (check_typedef (type)->target_type ());
13715 std::string name = type_to_string (type);
13716 return xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr));
13717 }
13718
13719 /* See language.h. */
13720
13721 void value_print (struct value *val, struct ui_file *stream,
13722 const struct value_print_options *options) const override
13723 {
13724 return ada_value_print (val, stream, options);
13725 }
13726
13727 /* See language.h. */
13728
13730 (struct value *val, struct ui_file *stream, int recurse,
13731 const struct value_print_options *options) const override
13732 {
13733 return ada_value_print_inner (val, stream, recurse, options);
13734 }
13735
13736 /* See language.h. */
13737
13739 (const char *name, const struct block *block,
13740 const domain_enum domain) const override
13741 {
13742 struct block_symbol sym;
13743
13744 sym = ada_lookup_symbol (name,
13745 (block == nullptr
13746 ? nullptr
13747 : block->static_block ()),
13748 domain);
13749 if (sym.symbol != NULL)
13750 return sym;
13751
13752 /* If we haven't found a match at this point, try the primitive
13753 types. In other languages, this search is performed before
13754 searching for global symbols in order to short-circuit that
13755 global-symbol search if it happens that the name corresponds
13756 to a primitive type. But we cannot do the same in Ada, because
13757 it is perfectly legitimate for a program to declare a type which
13758 has the same name as a standard type. If looking up a type in
13759 that situation, we have traditionally ignored the primitive type
13760 in favor of user-defined types. This is why, unlike most other
13761 languages, we search the primitive types this late and only after
13762 having searched the global symbols without success. */
13763
13764 if (domain == VAR_DOMAIN)
13765 {
13766 struct gdbarch *gdbarch;
13767
13768 if (block == NULL)
13770 else
13771 gdbarch = block->gdbarch ();
13772 sym.symbol
13774 if (sym.symbol != NULL)
13775 return sym;
13776 }
13777
13778 return {};
13779 }
13780
13781 /* See language.h. */
13782
13783 int parser (struct parser_state *ps) const override
13784 {
13785 warnings_issued = 0;
13786 return ada_parse (ps);
13787 }
13788
13789 /* See language.h. */
13790
13791 void emitchar (int ch, struct type *chtype,
13792 struct ui_file *stream, int quoter) const override
13793 {
13794 ada_emit_char (ch, chtype, stream, quoter, 1);
13795 }
13796
13797 /* See language.h. */
13798
13799 void printchar (int ch, struct type *chtype,
13800 struct ui_file *stream) const override
13801 {
13802 ada_printchar (ch, chtype, stream);
13803 }
13804
13805 /* See language.h. */
13806
13807 void printstr (struct ui_file *stream, struct type *elttype,
13808 const gdb_byte *string, unsigned int length,
13809 const char *encoding, int force_ellipses,
13810 const struct value_print_options *options) const override
13811 {
13812 ada_printstr (stream, elttype, string, length, encoding,
13813 force_ellipses, options);
13814 }
13815
13816 /* See language.h. */
13817
13818 void print_typedef (struct type *type, struct symbol *new_symbol,
13819 struct ui_file *stream) const override
13820 {
13822 }
13823
13824 /* See language.h. */
13825
13826 bool is_string_type_p (struct type *type) const override
13827 {
13828 return ada_is_string_type (type);
13829 }
13830
13831 /* See language.h. */
13832
13833 bool is_array_like (struct type *type) const override
13834 {
13837 }
13838
13839 /* See language.h. */
13840
13841 struct value *to_array (struct value *val) const override
13842 { return ada_coerce_to_simple_array (val); }
13843
13844 /* See language.h. */
13845
13846 const char *struct_too_deep_ellipsis () const override
13847 { return "(...)"; }
13848
13849 /* See language.h. */
13850
13851 bool c_style_arrays_p () const override
13852 { return false; }
13853
13854 /* See language.h. */
13855
13857 { return true; }
13858
13859 /* See language.h. */
13860
13861 const struct lang_varobj_ops *varobj_ops () const override
13862 { return &ada_varobj_ops; }
13863
13864protected:
13865 /* See language.h. */
13866
13868 (const lookup_name_info &lookup_name) const override
13869 {
13870 return ada_get_symbol_name_matcher (lookup_name);
13871 }
13872};
13873
13874/* Single instance of the Ada language class. */
13875
13877
13878/* Command-list for the "set/show ada" prefix command. */
13881
13882/* This module's 'new_objfile' observer. */
13883
13884static void
13889
13890/* This module's 'free_objfile' observer. */
13891
13892static void
13897
13898/* Charsets known to GNAT. */
13899static const char * const gnat_source_charsets[] =
13900{
13901 /* Note that code below assumes that the default comes first.
13902 Latin-1 is the default here, because that is also GNAT's
13903 default. */
13904 "ISO-8859-1",
13905 "ISO-8859-2",
13906 "ISO-8859-3",
13907 "ISO-8859-4",
13908 "ISO-8859-5",
13909 "ISO-8859-15",
13910 "CP437",
13911 "CP850",
13912 /* Note that this value is special-cased in the encoder and
13913 decoder. */
13914 ada_utf8,
13915 nullptr
13916};
13917
13919void
13921{
13923 ("ada", no_class,
13924 _("Prefix command for changing Ada-specific settings."),
13925 _("Generic command for showing Ada-specific settings."),
13927 &setlist, &showlist);
13928
13929 add_setshow_boolean_cmd ("trust-PAD-over-XVS", class_obscure,
13930 &trust_pad_over_xvs, _("\
13931Enable or disable an optimization trusting PAD types over XVS types."), _("\
13932Show whether an optimization trusting PAD types over XVS types is activated."),
13933 _("\
13934This is related to the encoding used by the GNAT compiler. The debugger\n\
13935should normally trust the contents of PAD types, but certain older versions\n\
13936of GNAT have a bug that sometimes causes the information in the PAD type\n\
13937to be incorrect. Turning this setting \"off\" allows the debugger to\n\
13938work around this bug. It is always safe to turn this option \"off\", but\n\
13939this incurs a slight performance penalty, so it is recommended to NOT change\n\
13940this option to \"off\" unless necessary."),
13941 NULL, NULL, &set_ada_list, &show_ada_list);
13942
13943 add_setshow_boolean_cmd ("print-signatures", class_vars,
13944 &print_signatures, _("\
13945Enable or disable the output of formal and return types for functions in the \
13946overloads selection menu."), _("\
13947Show whether the output of formal and return types for functions in the \
13948overloads selection menu is activated."),
13949 NULL, NULL, NULL, &set_ada_list, &show_ada_list);
13950
13952 add_setshow_enum_cmd ("source-charset", class_files,
13954 &ada_source_charset, _("\
13955Set the Ada source character set."), _("\
13956Show the Ada source character set."), _("\
13957The character set used for Ada source files.\n\
13958This must correspond to the '-gnati' or '-gnatW' option passed to GNAT."),
13959 nullptr, nullptr,
13961
13962 add_catch_command ("exception", _("\
13963Catch Ada exceptions, when raised.\n\
13964Usage: catch exception [ARG] [if CONDITION]\n\
13965Without any argument, stop when any Ada exception is raised.\n\
13966If ARG is \"unhandled\" (without the quotes), only stop when the exception\n\
13967being raised does not have a handler (and will therefore lead to the task's\n\
13968termination).\n\
13969Otherwise, the catchpoint only stops when the name of the exception being\n\
13970raised is the same as ARG.\n\
13971CONDITION is a boolean expression that is evaluated to see whether the\n\
13972exception should cause a stop."),
13977
13978 add_catch_command ("handlers", _("\
13979Catch Ada exceptions, when handled.\n\
13980Usage: catch handlers [ARG] [if CONDITION]\n\
13981Without any argument, stop when any Ada exception is handled.\n\
13982With an argument, catch only exceptions with the given name.\n\
13983CONDITION is a boolean expression that is evaluated to see whether the\n\
13984exception should cause a stop."),
13989 add_catch_command ("assert", _("\
13990Catch failed Ada assertions, when raised.\n\
13991Usage: catch assert [if CONDITION]\n\
13992CONDITION is a boolean expression that is evaluated to see whether the\n\
13993exception should cause a stop."),
13995 NULL,
13998
13999 add_info ("exceptions", info_exceptions_command,
14000 _("\
14001List all Ada exception names.\n\
14002Usage: info exceptions [REGEXP]\n\
14003If a regular expression is passed as an argument, only those matching\n\
14004the regular expression are listed."));
14005
14007 _("Set Ada maintenance-related variables."),
14008 _("Show Ada maintenance-related variables."),
14011
14013 ("ignore-descriptive-types", class_maintenance,
14015 _("Set whether descriptive types generated by GNAT should be ignored."),
14016 _("Show whether descriptive types generated by GNAT should be ignored."),
14017 _("\
14018When enabled, the debugger will stop using the DW_AT_GNAT_descriptive_type\n\
14019DWARF attribute."),
14021
14022 decoded_names_store = htab_create_alloc (256, htab_hash_string,
14023 htab_eq_string,
14024 NULL, xcalloc, xfree);
14025
14026 /* The ada-lang observers. */
14029 "ada-lang");
14032
14033#ifdef GDB_SELF_TEST
14034 selftests::register_test ("ada-decode", ada_decode_tests);
14035#endif
14036}
#define bits(obj, st, fn)
const char *const name
void * xmalloc(YYSIZE_T)
int ada_parse(struct parser_state *par_state)
Definition ada-exp.c:3133
void xfree(void *)
std::string ada_decode(const char *encoded, bool wrap, bool operators)
Definition ada-lang.c:1311
static struct value * ensure_lval(struct value *val)
Definition ada-lang.c:4381
bool is_ada_exception_catchpoint(breakpoint *bp)
Definition ada-lang.c:12502
static struct type * to_fixed_array_type(struct type *, struct value *, int)
Definition ada-lang.c:8308
static struct type * template_to_static_fixed_type(struct type *type0)
Definition ada-lang.c:8011
static int remove_compiler_suffix(const char *encoded, int *len)
Definition ada-lang.c:1229
static value * ada_unop_atr(struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1, struct type *type_arg, int tem)
Definition ada-lang.c:10310
static struct type * ada_typedef_target_type(struct type *type)
Definition ada-lang.c:435
struct value * ada_pos_atr(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg)
Definition ada-lang.c:8802
struct value * ada_value_primitive_packed_val(struct value *obj, const gdb_byte *valaddr, long offset, int bit_offset, int bit_size, struct type *type)
Definition ada-lang.c:2758
static void ada_add_global_exceptions(compiled_regex *preg, std::vector< ada_exc_info > *exceptions)
Definition ada-lang.c:13044
value * ada_unop_in_range(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1, struct type *type)
Definition ada-lang.c:10071
static struct value * ada_value_assign(struct value *toval, struct value *fromval)
Definition ada-lang.c:2876
static int lesseq_defined_than(struct symbol *, struct symbol *)
Definition ada-lang.c:4821
static void ada_clear_symbol_cache(program_space *pspace)
Definition ada-lang.c:4676
static int ada_is_gnat_encoded_packed_array_type(struct type *type)
Definition ada-lang.c:2239
static void ada_free_objfile_observer(struct objfile *objfile)
Definition ada-lang.c:13893
static const utf8_entry ada_case_fold[]
Definition ada-lang.c:236
static std::string ada_exception_catchpoint_cond_string(const char *excep_string, enum ada_exception_catchpoint_kind ex)
Definition ada-lang.c:12620
static struct type * ada_lookup_struct_elt_type(struct type *, const char *, int, int)
Definition ada-lang.c:7299
static struct value * ada_coerce_ref(struct value *)
Definition ada-lang.c:7448
static value * eval_ternop_in_range(struct type *expect_type, struct expression *exp, enum noside noside, value *arg1, value *arg2, value *arg3)
Definition ada-lang.c:10041
struct type * ada_index_type(struct type *type, int n, const char *name)
Definition ada-lang.c:3233
const gdb_byte * ada_aligned_value_addr(struct type *type, const gdb_byte *valaddr)
Definition ada-lang.c:9033
struct type * ada_array_element_type(struct type *type, int nindices)
Definition ada-lang.c:3186
struct bound_minimal_symbol ada_lookup_simple_minsym(const char *name, struct objfile *objfile)
Definition ada-lang.c:4906
static bool trust_pad_over_xvs
Definition ada-lang.c:8949
static CORE_ADDR value_pointer(struct value *value, struct type *type)
Definition ada-lang.c:4594
static void ada_add_all_symbols(std::vector< struct block_symbol > &, const struct block *, const lookup_name_info &lookup_name, domain_enum, int, int *)
Definition ada-lang.c:5648
static struct value * desc_bounds(struct value *)
Definition ada-lang.c:1827
static const char *const gnat_source_charsets[]
Definition ada-lang.c:13899
value * ada_atr_size(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1)
Definition ada-lang.c:10119
static struct type * desc_data_target_type(struct type *)
Definition ada-lang.c:1907
static int ada_same_array_size_p(struct type *t1, struct type *t2)
Definition ada-lang.c:9180
int ada_prefer_type(struct type *type0, struct type *type1)
Definition ada-lang.c:7545
static struct type * thin_descriptor_type(struct type *type)
Definition ada-lang.c:1748
struct value * ada_get_decoded_value(struct value *value)
Definition ada-lang.c:761
struct value * ada_coerce_to_simple_array(struct value *arr)
Definition ada-lang.c:2204
static int ada_is_redundant_index_type_desc(struct type *array_type, struct type *desc_type)
Definition ada-lang.c:8282
static std::string ada_encode_1(const char *decoded, bool throw_errors)
Definition ada-lang.c:932
block_symbol ada_resolve_funcall(struct symbol *sym, const struct block *block, struct type *context_type, bool parse_completion, int nargs, value *argvec[], innermost_block_tracker *tracker)
Definition ada-lang.c:3768
std::string ada_encode(const char *decoded, bool fold)
Definition ada-lang.c:1155
static int ada_is_direct_array_type(struct type *)
Definition ada-lang.c:2042
static int compare_names(const char *string1, const char *string2)
Definition ada-lang.c:5537
static int ada_is_non_standard_exception_sym(struct symbol *sym)
Definition ada-lang.c:12869
static int desc_bound_bitsize(struct type *, int, int)
Definition ada-lang.c:1996
static int is_thin_pntr(struct type *type)
Definition ada-lang.c:1738
static int discrete_type_p(struct type *)
Definition ada-lang.c:4191
static struct type * desc_index_type(struct type *, int)
Definition ada-lang.c:2010
static symbol_name_match_type name_match_type_from_name(const char *lookup_name)
Definition ada-lang.c:4757
static int ada_in_variant(LONGEST val, struct type *type, int field_num)
Definition ada-lang.c:6856
static const char ada_completer_word_break_characters[]
Definition ada-lang.c:243
static int ada_is_interface_tag(struct type *type)
Definition ada-lang.c:6264
static struct type * ada_find_any_type(const char *name)
Definition ada-lang.c:7516
static LONGEST recursively_update_array_bitsize(struct type *type)
Definition ada-lang.c:2459
static struct type * decode_constrained_packed_array_type(struct type *)
Definition ada-lang.c:2413
static void add_nonlocal_symbols(std::vector< struct block_symbol > &result, const lookup_name_info &lookup_name, domain_enum domain, int global)
Definition ada-lang.c:5595
static int return_match(struct type *func_type, struct type *context_type)
Definition ada-lang.c:4033
static struct type * find_parallel_type_by_descriptive_type(struct type *type, const char *name)
Definition ada-lang.c:7589
static const char * ada_lookup_name(const lookup_name_info &lookup_name)
Definition ada-lang.c:5557
static struct value * ada_read_renaming_var_value(struct symbol *renaming_sym, const struct block *block)
Definition ada-lang.c:4363
static void ada_remove_po_subprogram_suffix(const char *encoded, int *len)
Definition ada-lang.c:1206
static int scalar_type_p(struct type *)
Definition ada-lang.c:4166
static bool ada_ignore_descriptive_types_p
Definition ada-lang.c:276
struct value * ada_atr_enum_val(struct expression *exp, enum noside noside, struct type *type, struct value *arg)
Definition ada-lang.c:8866
static struct symbol * ada_find_any_type_symbol(const char *name)
Definition ada-lang.c:7499
static std::string xget_renaming_scope(struct type *renaming_type)
Definition ada-lang.c:5137
ULONGEST ada_modulus(struct type *type)
Definition ada-lang.c:11540
static void append_hex_encoded(std::string &result, uint32_t one_char)
Definition ada-lang.c:883
static struct value * ada_promote_array_of_integrals(struct type *type, struct value *val)
Definition ada-lang.c:9208
static const struct exception_support_info exception_support_info_v0
Definition ada-lang.c:11650
int ada_is_variant_part(struct type *type, int field_num)
Definition ada-lang.c:6719
static struct value * ada_value_slice(struct value *array, int low, int high)
Definition ada-lang.c:3124
static LONGEST ada_array_bound_from_type(struct type *arr_type, int n, int which)
Definition ada-lang.c:3275
static struct value * value_tag_from_contents_and_address(struct type *type, const gdb_byte *valaddr, CORE_ADDR address)
Definition ada-lang.c:6384
static struct value * coerce_unspec_val_to_type(struct value *, struct type *)
Definition ada-lang.c:555
static bool ada_symbol_name_matches(const char *symbol_search_name, const lookup_name_info &lookup_name, completion_match_result *comp_match_res)
Definition ada-lang.c:13311
static void lim_warning(const char *format,...) ATTRIBUTE_PRINTF(1
Definition ada-lang.c:613
value * ada_abs(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1)
Definition ada-lang.c:10142
static struct value * unwrap_value(struct value *)
Definition ada-lang.c:9148
int ada_is_modular_type(struct type *type)
Definition ada-lang.c:11528
struct value * ada_binop_exp(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1, struct value *arg2)
Definition ada-lang.c:10460
static struct value * ada_index_struct_field_1(int *, struct value *, int, struct type *)
Definition ada-lang.c:7234
block_symbol ada_find_operator_symbol(enum exp_opcode op, bool parse_completion, int nargs, value *argvec[])
Definition ada-lang.c:3747
static struct type * to_fixed_range_type(struct type *, struct value *)
Definition ada-lang.c:11425
static struct type * static_unwrap_type(struct type *type)
Definition ada-lang.c:8668
struct type * ada_coerce_to_simple_array_type(struct type *type)
Definition ada-lang.c:2225
bool get_int_var_value(const char *name, LONGEST &value)
Definition ada-lang.c:11403
static const char ada_utf8[]
Definition ada-lang.c:216
static int eq_cache_entry(const void *a, const void *b)
Definition ada-lang.c:373
value * ada_unop_neg(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1)
Definition ada-lang.c:10059
static struct type * ada_get_tsd_type(struct inferior *inf)
Definition ada-lang.c:6529
static struct value * make_array_descriptor(struct type *, struct value *)
Definition ada-lang.c:4614
static std::string add_angle_brackets(const char *str)
Definition ada-lang.c:470
static const char * ada_source_charset
Definition ada-lang.c:212
static gdb::unique_xmalloc_ptr< char > ada_exception_message_1(void)
Definition ada-lang.c:11971
static int ada_resolve_function(std::vector< struct block_symbol > &, struct value **, int, const char *, struct type *, bool)
Definition ada-lang.c:4071
static void remove_extra_symbols(std::vector< struct block_symbol > &syms)
Definition ada-lang.c:5057
static const registry< inferior >::key< ada_inferior_data > ada_inferior_data
Definition ada-lang.c:297
static const char *const known_runtime_file_name_patterns[]
Definition ada-lang.c:261
static int ada_is_redundant_range_encoding(struct type *range_type, struct type *encoding_type)
Definition ada-lang.c:8232
static int fat_pntr_bounds_bitsize(struct type *)
Definition ada-lang.c:1891
std::string copy_and_hex_encode(struct obstack *storage)
Definition ada-lang.c:908
static const struct exception_support_info default_exception_support_info
Definition ada-lang.c:11637
static int ada_has_this_exception_support(const struct exception_support_info *einfo)
Definition ada-lang.c:11680
static htab_t get_ada_pspace_data(struct program_space *pspace)
Definition ada-lang.c:391
static const char *const known_auxiliary_function_name_patterns[]
Definition ada-lang.c:265
static void catch_ada_assert_command_split(const char *args, std::string &cond_string)
Definition ada-lang.c:12807
bool ada_is_access_to_unconstrained_array(struct type *type)
Definition ada-lang.c:2986
static int warnings_issued
Definition ada-lang.c:259
static void catch_ada_exception_command_split(const char *args, bool is_catch_handlers_cmd, enum ada_exception_catchpoint_kind *ex, std::string *excep_string, std::string *cond_string)
Definition ada-lang.c:12518
static struct value * val_atr(struct type *, LONGEST)
Definition ada-lang.c:8816
int ada_which_variant_applies(struct type *var_type, struct value *outer)
Definition ada-lang.c:7364
static struct cmd_list_element * maint_set_ada_cmdlist
Definition ada-lang.c:271
static struct cmd_list_element * maint_show_ada_cmdlist
Definition ada-lang.c:272
static void ada_add_block_symbols(std::vector< struct block_symbol > &, const struct block *, const lookup_name_info &lookup_name, domain_enum, struct objfile *)
Definition ada-lang.c:6068
static int is_dynamic_field(struct type *, int)
Definition ada-lang.c:7711
static int lookup_cached_symbol(const char *name, domain_enum domain, struct symbol **sym, const struct block **block)
Definition ada-lang.c:4688
struct value * ada_atr_enum_rep(struct expression *exp, enum noside noside, struct type *type, struct value *arg)
Definition ada-lang.c:8847
static int symbols_are_identical_enums(const std::vector< struct block_symbol > &syms)
Definition ada-lang.c:5012
static void value_assign_to_component(struct value *container, struct value *component, struct value *val)
Definition ada-lang.c:2946
static struct value * desc_one_bound(struct value *, int, int)
Definition ada-lang.c:1972
static struct value * thin_data_pntr(struct value *val)
Definition ada-lang.c:1770
static LONGEST ada_array_bound(struct value *arr, int n, int which)
Definition ada-lang.c:3330
static long decode_packed_array_bitsize(struct type *)
Definition ada-lang.c:2305
static struct value * coerce_for_assign(struct type *type, struct value *val)
Definition ada-lang.c:9246
static struct cmd_list_element * set_ada_list
Definition ada-lang.c:13879
static const char * ada_unqualified_name(const char *decoded_name)
Definition ada-lang.c:447
static const struct exception_support_info exception_support_info_fallback
Definition ada-lang.c:11663
static int numeric_type_p(struct type *)
Definition ada-lang.c:4120
static std::string type_as_string(struct type *type)
Definition ada-lang.c:7272
static bool ada_is_any_packed_array_type(struct type *type)
Definition ada-lang.c:2294
static struct value * ada_index_struct_field(int, struct value *, int, struct type *)
Definition ada-lang.c:7222
static struct type * desc_bounds_type(struct type *)
Definition ada-lang.c:1797
struct value * ada_value_subscript(struct value *arr, int arity, struct value **ind)
Definition ada-lang.c:2997
static struct type * type_from_tag(struct value *tag)
Definition ada-lang.c:6409
bool ada_is_string_type(struct type *type)
Definition ada-lang.c:8923
static void map_matching_symbols(struct objfile *objfile, const lookup_name_info &lookup_name, bool is_wild_match, domain_enum domain, int global, match_data &data)
Definition ada-lang.c:5567
value * ada_ternop_slice(struct expression *exp, enum noside noside, struct value *array, struct value *low_bound_val, struct value *high_bound_val)
Definition ada-lang.c:10199
static struct value * ada_value_tag(struct value *val)
Definition ada-lang.c:6374
static struct value * ada_value_cast(struct type *type, struct value *arg2)
Definition ada-lang.c:9776
static CORE_ADDR ada_exception_name_addr_1(enum ada_exception_catchpoint_kind ex)
Definition ada-lang.c:11927
struct value * ada_val_atr(struct expression *exp, enum noside noside, struct type *type, struct value *arg)
Definition ada-lang.c:8831
static void catch_ada_exception_command(const char *arg_entry, int from_tty, struct cmd_list_element *command)
Definition ada-lang.c:12736
static struct type * ada_tag_type(struct value *val)
Definition ada-lang.c:6357
static void add_defn_to_vec(std::vector< struct block_symbol > &, struct symbol *, const struct block *)
Definition ada-lang.c:4868
static int ada_resolve_enum(std::vector< struct block_symbol > &syms, const char *name, struct type *context_type, bool parse_completion)
Definition ada-lang.c:3799
struct value * ada_coerce_to_simple_array_ptr(struct value *arr)
Definition ada-lang.c:2183
static int ada_identical_enum_types_p(struct type *type1, struct type *type2)
Definition ada-lang.c:4956
static struct type * find_base_type(struct type *type)
Definition ada-lang.c:9131
int ada_is_array_descriptor_type(struct type *type)
Definition ada-lang.c:2081
static int advance_wild_match(const char **, const char *, char)
Definition ada-lang.c:5984
static void ada_add_exceptions_from_frame(compiled_regex *preg, frame_info_ptr frame, std::vector< ada_exc_info > *exceptions)
Definition ada-lang.c:12983
static void ada_print_symbol_signature(struct ui_file *stream, struct symbol *sym, const struct type_print_options *flags)
Definition ada-lang.c:3502
static void catch_ada_completer(struct cmd_list_element *cmd, completion_tracker &tracker, const char *text, const char *word)
Definition ada-lang.c:12786
static int has_negatives(struct type *type)
Definition ada-lang.c:2607
static gdb::unique_xmalloc_ptr< char > ada_tag_name_from_tsd(struct value *tsd)
Definition ada-lang.c:6579
static CORE_ADDR ada_unhandled_exception_name_addr_from_raise(void)
Definition ada-lang.c:11881
static int fat_pntr_data_bitpos(struct type *)
Definition ada-lang.c:1948
static int is_unchecked_variant(struct type *var_type, struct type *outer_type)
Definition ada-lang.c:7351
static void ada_exception_support_info_sniffer(void)
Definition ada-lang.c:11752
static bool convert_from_hex_encoded(std::string &out, const char *str, int n)
Definition ada-lang.c:1269
static int ada_is_others_clause(struct type *type, int field_num)
Definition ada-lang.c:6751
static int is_thick_pntr(struct type *type)
Definition ada-lang.c:1786
static int integer_type_p(struct type *)
Definition ada-lang.c:4144
static std::vector< struct block_symbol > ada_lookup_symbol_list_worker(const lookup_name_info &lookup_name, const struct block *block, domain_enum domain, int full_search)
Definition ada-lang.c:5729
static struct type * empty_record(struct type *templ)
Definition ada-lang.c:7742
static CORE_ADDR cond_offset_target(CORE_ADDR address, long offset)
Definition ada-lang.c:595
static int is_valid_name_for_wild_match(const char *name0)
Definition ada-lang.c:5961
enum ada_renaming_category ada_parse_renaming(struct symbol *sym, const char **renamed_entity, int *len, const char **renaming_expr)
Definition ada-lang.c:4301
const char * ada_type_name(struct type *type)
Definition ada-lang.c:7578
static void catch_ada_handlers_command(const char *arg_entry, int from_tty, struct cmd_list_element *command)
Definition ada-lang.c:12761
static CORE_ADDR ada_unhandled_exception_name_addr(void)
Definition ada-lang.c:11870
void ada_lookup_encoded_symbol(const char *name, const struct block *block, domain_enum domain, struct block_symbol *info)
Definition ada-lang.c:5776
static void ada_unpack_from_contents(const gdb_byte *src, int bit_offset, int bit_size, gdb_byte *unpacked, int unpacked_len, int is_big_endian, int is_signed_type, int is_scalar)
Definition ada-lang.c:2635
static int warning_limit
Definition ada-lang.c:255
static bool do_full_match(const char *symbol_search_name, const lookup_name_info &lookup_name, completion_match_result *comp_match_res)
Definition ada-lang.c:13187
void ada_find_printable_frame(frame_info_ptr fi)
Definition ada-lang.c:11850
static bool name_matches_regex(const char *name, compiled_regex *preg)
Definition ada-lang.c:13018
static int desc_bound_bitpos(struct type *, int, int)
Definition ada-lang.c:1986
static bool do_wild_match(const char *symbol_search_name, const lookup_name_info &lookup_name, completion_match_result *comp_match_res)
Definition ada-lang.c:13177
static int is_lower_alphanum(const char c)
Definition ada-lang.c:1165
static int ada_is_exception_sym(struct symbol *sym)
Definition ada-lang.c:12853
struct type * ada_find_parallel_type(struct type *type, const char *suffix)
Definition ada-lang.c:7666
static struct type * to_record_with_fixed_variant_part(struct type *type, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval0)
Definition ada-lang.c:8078
static bool convert_hex(const char *str, int n, uint32_t *out)
Definition ada-lang.c:1246
struct type * ada_get_base_type(struct type *raw_type)
Definition ada-lang.c:8972
void create_ada_exception_catchpoint(struct gdbarch *gdbarch, enum ada_exception_catchpoint_kind ex_kind, std::string &&excep_string, const std::string &cond_string, int tempflag, int enabled, int from_tty)
Definition ada-lang.c:12717
static struct value * desc_data(struct value *)
Definition ada-lang.c:1930
static symbol_name_matcher_ftype * ada_get_symbol_name_matcher(const lookup_name_info &lookup_name)
Definition ada-lang.c:13347
static void remove_irrelevant_renamings(std::vector< struct block_symbol > *syms, const struct block *current_block)
Definition ada-lang.c:5254
static const char * ada_decoded_op_name(enum exp_opcode)
Definition ada-lang.c:3417
value * ada_binop_in_bounds(struct expression *exp, enum noside noside, struct value *arg1, struct value *arg2, int n)
Definition ada-lang.c:10280
static struct type * to_fixed_record_type(struct type *type0, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval)
Definition ada-lang.c:8157
value * ada_equal_binop(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1, struct value *arg2)
Definition ada-lang.c:10177
static int ada_is_dispatch_table_ptr_type(struct type *type)
Definition ada-lang.c:6247
std::vector< ada_exc_info > ada_exceptions_list(const char *regexp)
Definition ada-lang.c:13143
static struct value * decode_constrained_packed_array(struct value *)
Definition ada-lang.c:2490
static LONGEST ada_array_length(struct value *arr, int n)
Definition ada-lang.c:3353
static struct type * ada_find_parallel_type_with_name(struct type *, const char *)
Definition ada-lang.c:7650
CORE_ADDR ada_unhandled_exception_name_addr_ftype(void)
Definition ada-lang.c:11600
static ada_language ada_language_defn
Definition ada-lang.c:13876
static struct value * ada_value_binop(struct value *arg1, struct value *arg2, enum exp_opcode op)
Definition ada-lang.c:9286
static struct type * dynamic_template_type(struct type *type)
Definition ada-lang.c:7689
static int get_selections(int *choices, int n_choices, int max_results, int is_all_choice, const char *annotation_suffix)
Definition ada-lang.c:3552
static struct type * ada_type_of_array(struct value *arr, int bounds)
Definition ada-lang.c:2102
static LONGEST max_of_size(int size)
Definition ada-lang.c:627
static void add_component_interval(LONGEST, LONGEST, std::vector< LONGEST > &)
Definition ada-lang.c:9738
static void ada_new_objfile_observer(struct objfile *objfile)
Definition ada-lang.c:13885
bool ada_is_character_type(struct type *type)
Definition ada-lang.c:8899
static void sort_remove_dups_ada_exceptions_list(std::vector< ada_exc_info > *exceptions, int skip)
Definition ada-lang.c:12918
struct type * ada_parent_type(struct type *type)
Definition ada-lang.c:6645
int ada_is_simple_array_type(struct type *type)
Definition ada-lang.c:2067
static LONGEST min_of_size(int size)
Definition ada-lang.c:636
int ada_is_system_address_type(struct type *type)
Definition ada-lang.c:11318
static struct type * to_static_fixed_type(struct type *)
Definition ada-lang.c:8634
LONGEST ada_discrete_type_high_bound(struct type *type)
Definition ada-lang.c:672
static void ada_inferior_exit(struct inferior *inf)
Definition ada-lang.c:323
int ada_is_parent_field(struct type *type, int field_num)
Definition ada-lang.c:6676
static LONGEST pos_atr(struct value *)
Definition ada-lang.c:8786
struct type * ada_get_decoded_type(struct type *type)
Definition ada-lang.c:786
int ada_is_constrained_packed_array_type(struct type *type)
Definition ada-lang.c:2254
const char * ada_main_name()
Definition ada-lang.c:803
value * ada_mult_binop(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1, struct value *arg2)
Definition ada-lang.c:10157
static struct value * get_var_value(const char *name, const char *err_msg)
Definition ada-lang.c:11376
static int num_visible_fields(struct type *type)
Definition ada-lang.c:7114
int ada_name_prefix_len(const char *name)
Definition ada-lang.c:521
static struct type * desc_base_type(struct type *)
Definition ada-lang.c:1719
static const char * ada_exception_sym_name(enum ada_exception_catchpoint_kind ex)
Definition ada-lang.c:12588
static int ada_is_unconstrained_packed_array_type(struct type *)
Definition ada-lang.c:2264
std::vector< struct block_symbol > ada_lookup_symbol_list(const char *name, const struct block *block, domain_enum domain)
Definition ada-lang.c:5759
static hashval_t hash_cache_entry(const void *v)
Definition ada-lang.c:364
struct type * ada_aligned_type(struct type *type)
Definition ada-lang.c:9020
static const registry< program_space >::key< htab, htab_deleter > ada_pspace_data_handle
Definition ada-lang.c:383
struct value * ada_tag_value_at_base_address(struct value *obj)
Definition ada-lang.c:6425
static int ada_value_equal(struct value *arg1, struct value *arg2)
Definition ada-lang.c:9350
static bool ada_is_renaming_symbol(struct symbol *name_sym)
Definition ada-lang.c:7533
struct type * ada_check_typedef(struct type *type)
Definition ada-lang.c:8704
struct value * ada_convert_actual(struct value *actual, struct type *formal_type0)
Definition ada-lang.c:4533
static struct value * ada_value_slice_from_ptr(struct value *array_ptr, struct type *type, int low, int high)
Definition ada-lang.c:3088
static struct cmd_list_element * show_ada_list
Definition ada-lang.c:13880
int ada_is_range_type_name(const char *name)
Definition ada-lang.c:11517
block_symbol ada_resolve_variable(struct symbol *sym, const struct block *block, struct type *context_type, bool parse_completion, int deprocedure_p, innermost_block_tracker *tracker)
Definition ada-lang.c:3834
int ada_is_wrapper_field(struct type *type, int field_num)
Definition ada-lang.c:6692
static struct type * constrained_packed_array_type(struct type *, long *)
Definition ada-lang.c:2363
static void info_exceptions_command(const char *regexp, int from_tty)
Definition ada-lang.c:13155
static struct value * ada_get_tsd_from_tag(struct value *tag)
Definition ada-lang.c:6544
static unsigned int field_alignment(struct type *type, int f)
Definition ada-lang.c:7468
int ada_is_tagged_type(struct type *type, int refok)
Definition ada-lang.c:6331
static struct value * value_subscript_packed(struct value *, int, struct value **)
Definition ada-lang.c:2557
struct block_symbol ada_lookup_symbol(const char *name, const struct block *block0, domain_enum domain)
Definition ada-lang.c:5798
static struct value * ada_value_ptr_subscript(struct value *arr, int arity, struct value **ind)
Definition ada-lang.c:3056
static int fat_pntr_data_bitsize(struct type *)
Definition ada-lang.c:1957
value * ada_atr_tag(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1)
Definition ada-lang.c:10105
static const char *const standard_exc[]
Definition ada-lang.c:11593
struct type * ada_to_fixed_type(struct type *type, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval, int check_tag)
Definition ada-lang.c:8598
static struct htab * decoded_names_store
Definition ada-lang.c:1606
static struct ada_inferior_data * get_ada_inferior_data(struct inferior *inf)
Definition ada-lang.c:308
static void ada_add_standard_exceptions(compiled_regex *preg, std::vector< ada_exc_info > *exceptions)
Definition ada-lang.c:12937
static int ada_type_match(struct type *ftype, struct type *atype)
Definition ada-lang.c:3938
struct type * ada_template_to_fixed_record_type_1(struct type *type, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval0, int keep_dynamic_fields)
Definition ada-lang.c:7771
const char * ada_decode_symbol(const struct general_symbol_info *arg)
Definition ada-lang.c:1619
static int equiv_types(struct type *, struct type *)
Definition ada-lang.c:4801
int ada_is_tag_type(struct type *type)
Definition ada-lang.c:6339
static int is_name_suffix(const char *)
Definition ada-lang.c:5827
static gdb::unique_xmalloc_ptr< char > ada_exception_message(void)
Definition ada-lang.c:12003
int ada_is_aligner_type(struct type *type)
Definition ada-lang.c:8956
static void catch_assert_command(const char *arg_entry, int from_tty, struct cmd_list_element *command)
Definition ada-lang.c:12831
static bool literal_symbol_name_matcher(const char *symbol_search_name, const lookup_name_info &lookup_name, completion_match_result *comp_match_res)
Definition ada-lang.c:13324
static ULONGEST umax_of_size(int size)
Definition ada-lang.c:643
static struct type * ada_to_fixed_type_1(struct type *type, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval, int check_tag)
Definition ada-lang.c:8465
int ada_scan_number(const char str[], int k, LONGEST *R, int *new_k)
Definition ada-lang.c:6814
static struct value * ada_value_struct_elt(struct value *arg, const char *name, int no_err)
Definition ada-lang.c:4411
static const utf8_entry * find_case_fold_entry(uint32_t c)
Definition ada-lang.c:1020
static struct value * ada_to_fixed_value_create(struct type *type0, CORE_ADDR address, struct value *val0)
Definition ada-lang.c:8749
int ada_get_field_index(const struct type *type, const char *field_name, int maybe_missing)
Definition ada-lang.c:501
const struct ada_opname_map ada_opname_table[]
Definition ada-lang.c:841
static int desc_arity(struct type *)
Definition ada-lang.c:2028
static struct type * template_to_fixed_record_type(struct type *type, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval0)
Definition ada-lang.c:7994
struct value * ada_value_ind(struct value *val0)
Definition ada-lang.c:7434
LONGEST ada_discrete_type_low_bound(struct type *type)
Definition ada-lang.c:707
const char * ada_enum_name(const char *name)
Definition ada-lang.c:9048
static int variant_field_index(struct type *type)
Definition ada-lang.c:7724
static int fat_pntr_bounds_bitpos(struct type *)
Definition ada-lang.c:1882
struct value * ada_value_primitive_field(struct value *arg1, int offset, int fieldno, struct type *arg_type)
Definition ada-lang.c:6905
static struct symbol * standard_lookup(const char *, const struct block *, domain_enum)
Definition ada-lang.c:4768
void ada_fixup_array_indexes_type(struct type *index_desc_type)
Definition ada-lang.c:1681
static void cache_symbol(const char *name, domain_enum domain, struct symbol *sym, const struct block *block)
Definition ada-lang.c:4711
int ada_is_ignored_field(struct type *type, int field_num)
Definition ada-lang.c:6278
static LONGEST max_of_type(struct type *t)
Definition ada-lang.c:652
static int possible_user_operator_p(enum exp_opcode, struct value **)
static int is_known_support_routine(frame_info_ptr frame)
Definition ada-lang.c:11791
static const gdb_byte * cond_offset_host(const gdb_byte *valaddr, long offset)
Definition ada-lang.c:586
static struct symtab_and_line ada_exception_sal(enum ada_exception_catchpoint_kind ex)
Definition ada-lang.c:12678
static int user_select_syms(struct block_symbol *syms, int nsyms, int max_results)
Definition ada-lang.c:3633
static int ada_add_block_renamings(std::vector< struct block_symbol > &result, const struct block *block, const lookup_name_info &lookup_name, domain_enum domain)
Definition ada-lang.c:5416
static void ada_add_local_symbols(std::vector< struct block_symbol > &result, const lookup_name_info &lookup_name, const struct block *block, domain_enum domain)
Definition ada-lang.c:5343
static int find_struct_field(const char *, struct type *, int, struct type **, int *, int *, int *, int *)
Definition ada-lang.c:6996
static std::vector< ada_exc_info > ada_exceptions_list_1(compiled_regex *preg)
Definition ada-lang.c:13095
static int ada_args_match(struct symbol *, struct value **, int)
Definition ada-lang.c:3997
static struct value * ada_search_struct_field(const char *, struct value *, int, struct type *)
Definition ada-lang.c:7133
static bool wild_match(const char *name, const char *patn)
Definition ada-lang.c:6036
static int is_nondebugging_type(struct type *type)
Definition ada-lang.c:4941
static LONGEST min_of_type(struct type *t)
Definition ada-lang.c:662
static void ada_remove_trailing_digits(const char *encoded, int *len)
Definition ada-lang.c:1183
int ada_array_arity(struct type *type)
Definition ada-lang.c:3158
static int compare_names_with_case(const char *string1, const char *string2, enum case_sensitivity casing)
Definition ada-lang.c:5472
gdb::unique_xmalloc_ptr< char > ada_tag_name(struct value *tag)
Definition ada-lang.c:6612
static int is_nonfunction(const std::vector< struct block_symbol > &)
Definition ada-lang.c:4786
static void sort_choices(struct block_symbol syms[], int nsyms)
Definition ada-lang.c:3472
struct type * ada_variant_discrim_type(struct type *var_type, struct type *outer_type)
Definition ada-lang.c:6739
static bool print_signatures
Definition ada-lang.c:3494
static struct type * get_base_type(struct type *type)
Definition ada-lang.c:744
static int ada_is_array_type(struct type *type)
Definition ada-lang.c:2055
struct value * ada_binop_minmax(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1, struct value *arg2)
Definition ada-lang.c:10443
static CORE_ADDR ada_exception_name_addr(enum ada_exception_catchpoint_kind ex)
Definition ada-lang.c:12025
const char * ada_variant_discrim_name(struct type *type0)
Definition ada-lang.c:6763
static struct type * to_fixed_variant_branch_type(struct type *, const gdb_byte *, CORE_ADDR, struct value *)
Definition ada-lang.c:8193
static int old_renaming_is_invisible(const struct symbol *sym, const char *function_name)
Definition ada-lang.c:5192
static bool is_compiler_suffix(const char *str)
Definition ada-lang.c:871
void _initialize_ada_language()
Definition ada-lang.c:13920
static const char * ada_fold_name(gdb::string_view name, bool throw_on_error=false)
Definition ada-lang.c:1038
static const char ADA_MAIN_PROGRAM_SYMBOL_NAME[]
Definition ada-lang.c:252
struct value * ada_to_fixed_value(struct value *val)
Definition ada-lang.c:8773
static int is_suffix(const char *str, const char *suffix)
Definition ada-lang.c:540
static int encoded_ordered_before(const char *N0, const char *N1)
Definition ada-lang.c:3436
static struct value * empty_array(struct type *arr_type, int low, int high)
Definition ada-lang.c:3397
static int field_name_match(const char *field_name, const char *target)
Definition ada-lang.c:479
static int is_package_name(const char *name)
Definition ada-lang.c:5162
static int scan_discrim_bound(const char *str, int k, struct value *dval, LONGEST *px, int *pnew_k)
Definition ada-lang.c:11334
static bool do_exact_match(const char *symbol_search_name, const lookup_name_info &lookup_name, completion_match_result *comp_match_res)
Definition ada-lang.c:13241
static int is_ada95_tag(struct value *tag)
Definition ada-lang.c:6366
#define ADA_KNOWN_RUNTIME_FILE_NAME_PATTERNS
Definition ada-lang.h:44
void ada_value_print(struct value *, struct ui_file *, const struct value_print_options *)
void ada_print_type(struct type *, const char *, struct ui_file *, int, int, const struct type_print_options *)
void ada_printchar(int, struct type *, struct ui_file *)
void ada_emit_char(int, struct type *, struct ui_file *, int, int)
void ada_print_typedef(struct type *type, struct symbol *new_symbol, struct ui_file *stream)
ada_renaming_category
Definition ada-lang.h:83
@ ADA_EXCEPTION_RENAMING
Definition ada-lang.h:93
@ ADA_OBJECT_RENAMING
Definition ada-lang.h:89
@ ADA_NOT_RENAMING
Definition ada-lang.h:85
@ ADA_PACKAGE_RENAMING
Definition ada-lang.h:96
@ ADA_SUBPROGRAM_RENAMING
Definition ada-lang.h:100
void ada_value_print_inner(struct value *, struct ui_file *, int, const struct value_print_options *)
void ada_printstr(struct ui_file *, struct type *, const gdb_byte *, unsigned int, const char *, int, const struct value_print_options *)
#define ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS
Definition ada-lang.h:52
ada_exception_catchpoint_kind
Definition ada-lang.h:107
@ ada_catch_exception
Definition ada-lang.h:108
@ ada_catch_exception_unhandled
Definition ada-lang.h:109
@ ada_catch_handlers
Definition ada-lang.h:111
@ ada_catch_assert
Definition ada-lang.h:110
int code
Definition ada-lex.l:670
const struct lang_varobj_ops ada_varobj_ops
void * xcalloc(size_t number, size_t size)
Definition alloc.c:85
void annotate_field(int num)
Definition annotate.c:172
void annotate_catchpoint(int num)
Definition annotate.c:82
struct gdbarch * get_current_arch(void)
Definition arch-utils.c:846
struct gdbarch * target_gdbarch(void)
constexpr int n1
Definition 2.cc:29
constexpr char c2[]
Definition 2.cc:24
constexpr char c1[]
Definition 2.cc:23
void f()
Definition 1.cc:36
const struct block * block_for_pc(CORE_ADDR pc)
Definition block.c:276
iterator_range< block_iterator_wrapper > block_iterator_range
Definition block.h:553
const struct block * get_frame_block(frame_info_ptr frame, CORE_ADDR *addr_in_block)
Definition blockframe.c:55
void add_catch_command(const char *name, const char *docstring, cmd_func_ftype *func, completer_ftype *completer, void *user_data_catch, void *user_data_tcatch)
const char * bpdisp_text(enum bpdisp disp)
Definition breakpoint.c:505
breakpoint * install_breakpoint(int internal, std::unique_ptr< breakpoint > &&arg, int update_gll)
void print_num_locno(const bpstat *bs, struct ui_out *uiout)
void update_breakpoint_locations(code_breakpoint *b, struct program_space *filter_pspace, gdb::array_view< const symtab_and_line > sals, gdb::array_view< const symtab_and_line > sals_end)
#define CATCH_PERMANENT
@ disp_del
Definition breakpoint.h:237
@ bp_catchpoint
Definition breakpoint.h:182
#define CATCH_TEMPORARY
print_stop_action
Definition breakpoint.h:542
@ PRINT_SRC_AND_LOC
Definition breakpoint.h:548
enable_state
Definition breakpoint.h:217
@ bp_disabled
Definition breakpoint.h:218
@ bp_enabled
Definition breakpoint.h:220
@ bp_loc_software_breakpoint
Definition breakpoint.h:316
const char * host_charset(void)
Definition charset.c:416
void convert_between_encodings(const char *from, const char *to, const gdb_byte *bytes, unsigned int num_bytes, int width, struct obstack *output, enum transliterations translit)
Definition charset.c:497
@ translit_none
Definition charset.h:46
#define HOST_UTF32
Definition charset.h:165
expression_up excep_cond_expr
Definition ada-lang.c:12120
ada_catchpoint_location(ada_catchpoint *owner)
Definition ada-lang.c:12113
bool is_array_like(struct type *type) const override
Definition ada-lang.c:13833
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
Definition ada-lang.c:13807
void print_array_index(struct type *index_type, LONGEST index, struct ui_file *stream, const value_print_options *options) const override
Definition ada-lang.c:13395
bool c_style_arrays_p() const override
Definition ada-lang.c:13851
void emitchar(int ch, struct type *chtype, struct ui_file *stream, int quoter) const override
Definition ada-lang.c:13791
const char * struct_too_deep_ellipsis() const override
Definition ada-lang.c:13846
bool symbol_printing_suppressed(struct symbol *symbol) const override
Definition ada-lang.c:13427
const char * word_break_characters(void) const override
Definition ada-lang.c:13579
gdb::unique_xmalloc_ptr< char > demangle_symbol(const char *mangled, int options) const override
Definition ada-lang.c:13562
bool store_sym_names_in_linkage_form_p() const override
Definition ada-lang.c:13856
bool is_string_type_p(struct type *type) const override
Definition ada-lang.c:13826
struct value * read_var_value(struct symbol *var, const struct block *var_block, frame_info_ptr frame) const override
Definition ada-lang.c:13408
int parser(struct parser_state *ps) const override
Definition ada-lang.c:13783
symbol_name_matcher_ftype * get_symbol_name_matcher_inner(const lookup_name_info &lookup_name) const override
Definition ada-lang.c:13868
const char * name() const override
Definition ada-lang.c:13376
const std::vector< const char * > & filename_extensions() const override
Definition ada-lang.c:13386
void print_typedef(struct type *type, struct symbol *new_symbol, struct ui_file *stream) const override
Definition ada-lang.c:13818
struct value * to_array(struct value *val) const override
Definition ada-lang.c:13841
struct value * value_string(struct gdbarch *gdbarch, const char *ptr, ssize_t len) const override
Definition ada-lang.c:13433
void language_arch_info(struct gdbarch *gdbarch, struct language_arch_info *lai) const override
Definition ada-lang.c:13446
void value_print(struct value *val, struct ui_file *stream, const struct value_print_options *options) const override
Definition ada-lang.c:13721
void value_print_inner(struct value *val, struct ui_file *stream, int recurse, const struct value_print_options *options) const override
Definition ada-lang.c:13730
gdb::unique_xmalloc_ptr< char > watch_location_expression(struct type *type, CORE_ADDR addr) const override
Definition ada-lang.c:13712
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
Definition ada-lang.c:13506
void printchar(int ch, struct type *chtype, struct ui_file *stream) const override
Definition ada-lang.c:13799
const struct lang_varobj_ops * varobj_ops() const override
Definition ada-lang.c:13861
bool sniff_from_mangled_name(const char *mangled, gdb::unique_xmalloc_ptr< char > *out) const override
Definition ada-lang.c:13523
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
Definition ada-lang.c:13586
const char * natural_name() const override
Definition ada-lang.c:13381
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
Definition ada-lang.c:13570
struct block_symbol lookup_symbol_nonlocal(const char *name, const struct block *block, const domain_enum domain) const override
Definition ada-lang.c:13739
bool verbatim_p() const
Definition symtab.h:124
bool matches(const char *symbol_search_name, symbol_name_match_type match_type, completion_match_result *comp_match_res) const
Definition ada-lang.c:6163
const std::string & lookup_name() const
Definition symtab.h:110
bool standard_p() const
Definition symtab.h:120
bool wild_match_p() const
Definition symtab.h:115
ada_lookup_name_info(const lookup_name_info &lookup_name)
Definition ada-lang.c:13250
std::string m_encoded_name
Definition symtab.h:144
breakpoint * owner
Definition breakpoint.h:345
ui_file_style style() const
Definition cli-style.c:169
std::string & storage()
Definition completer.h:96
void add_completion(gdb::unique_xmalloc_ptr< char > name, completion_match_for_lcd *match_for_lcd=NULL, const char *text=NULL, const char *word=NULL)
Definition completer.c:1579
std::vector< ada_component_up > m_components
Definition ada-exp.h:701
bool uses_objfile(struct objfile *objfile) override
Definition ada-lang.c:9430
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition ada-lang.c:9447
void dump(ui_file *stream, int depth) override
Definition ada-lang.c:9439
value * assign_aggregate(struct value *container, struct value *lhs, struct expression *exp)
Definition ada-lang.c:9459
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:9696
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10743
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10542
operation_up replace(operation_up &&owner, struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition ada-lang.c:10555
void dump(ui_file *stream, int depth) override
Definition ada-lang.c:9642
std::vector< ada_association_up > m_assocs
Definition ada-exp.h:818
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition ada-lang.c:9655
bool uses_objfile(struct objfile *objfile) override
Definition ada-lang.c:9631
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10678
bool uses_objfile(struct objfile *objfile) override
Definition ada-lang.c:9535
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high, operation_up &op) override
Definition ada-lang.c:9549
void dump(ui_file *stream, int depth) override
Definition ada-lang.c:9541
bool resolve(struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition ada-lang.c:11259
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:11117
void dump(ui_file *stream, int depth) override
Definition ada-lang.c:9577
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high, operation_up &op) override
Definition ada-lang.c:9584
bool uses_objfile(struct objfile *objfile) override
Definition ada-lang.c:9571
bool uses_objfile(struct objfile *objfile) override
Definition ada-lang.c:9665
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition ada-lang.c:9682
void dump(ui_file *stream, int depth) override
Definition ada-lang.c:9671
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition ada-lang.c:9518
bool uses_objfile(struct objfile *objfile) override
Definition ada-lang.c:9500
void dump(ui_file *stream, int depth) override
Definition ada-lang.c:9506
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10723
const char * get_name() const
Definition ada-exp.h:159
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10614
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:11075
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10732
bool resolve(struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition ada-lang.c:11296
enum exp_opcode opcode() const override
Definition ada-exp.h:379
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10783
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10991
value * evaluate_for_cast(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10804
bool resolve(struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition ada-lang.c:10939
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10850
void do_generate_ax(struct expression *exp, struct agent_expr *ax, struct axs_value *value, struct type *cast_type) override
Definition ada-lang.c:10964
const block * get_block() const
Definition ada-exp.h:399
value * evaluate_for_cast(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10828
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition ada-lang.c:10576
void do_generate_ax(struct expression *exp, struct agent_expr *ax, struct axs_value *value, struct type *cast_type) override
Definition ada-lang.c:10599
enum exp_opcode opcode() const override
Definition ada-exp.h:138
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition expop.h:1161
LONGEST as_longest() const
Definition expop.h:705
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition expop.h:690
symbol * get_symbol() const
Definition expop.h:665
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition eval.c:554
void do_generate_ax(struct expression *exp, struct agent_expr *ax, struct axs_value *value, struct type *cast_type) override
Definition ax-gdb.c:2001
void update(const struct block *b, innermost_block_tracker_types t)
Definition parse.c:78
static const lookup_name_info & match_any()
Definition symtab.c:1861
const ada_lookup_name_info & ada() const
Definition symtab.h:315
symbol_name_match_type match_type() const
Definition symtab.h:239
gdb::string_view name() const
Definition symtab.h:241
bool completion_mode() const
Definition symtab.h:240
void set(unsigned key, void *datum)
Definition registry.h:204
void * get(unsigned key)
Definition registry.h:211
std::string release()
Definition ui-file.h:204
type * new_type()
Definition gdbtypes.c:208
void field_string(const char *fldname, const char *string, const ui_file_style &style=ui_file_style())
Definition ui-out.c:511
void field_fmt(const char *fldname, const char *format,...) ATTRIBUTE_PRINTF(3
Definition ui-out.c:525
void field_signed(const char *fldname, LONGEST value)
Definition ui-out.c:437
void field_skip(const char *fldname)
Definition ui-out.c:499
void text(const char *string)
Definition ui-out.c:566
bool is_mi_like_p() const
Definition ui-out.c:810
struct cmd_list_element * showlist
Definition cli-cmds.c:127
void error_no_arg(const char *why)
Definition cli-cmds.c:206
struct cmd_list_element * setlist
Definition cli-cmds.c:119
struct cmd_list_element * maintenance_show_cmdlist
Definition maint.c:752
struct cmd_list_element * maintenance_set_cmdlist
Definition maint.c:751
set_show_commands add_setshow_enum_cmd(const char *name, enum command_class theclass, const char *const *enumlist, const char **var, const char *set_doc, const char *show_doc, const char *help_doc, cmd_func_ftype *set_func, show_value_ftype *show_func, struct cmd_list_element **set_list, struct cmd_list_element **show_list)
Definition cli-decode.c:688
set_show_commands add_setshow_prefix_cmd(const char *name, command_class theclass, const char *set_doc, const char *show_doc, cmd_list_element **set_subcommands_list, cmd_list_element **show_subcommands_list, cmd_list_element **set_list, cmd_list_element **show_list)
Definition cli-decode.c:428
set_show_commands add_setshow_boolean_cmd(const char *name, enum command_class theclass, bool *var, const char *set_doc, const char *show_doc, const char *help_doc, cmd_func_ftype *set_func, show_value_ftype *show_func, struct cmd_list_element **set_list, struct cmd_list_element **show_list)
Definition cli-decode.c:809
struct cmd_list_element * add_info(const char *name, cmd_simple_func_ftype *fun, const char *doc)
cli_style_option file_name_style
cli_style_option metadata_style
std::string extract_arg(const char **arg)
Definition cli-utils.c:383
@ class_obscure
Definition command.h:64
@ class_maintenance
Definition command.h:65
@ class_vars
Definition command.h:55
@ class_files
Definition command.h:57
@ no_class
Definition command.h:53
void write_memory(CORE_ADDR memaddr, const bfd_byte *myaddr, ssize_t len)
Definition corefile.c:347
void read_memory(CORE_ADDR memaddr, gdb_byte *myaddr, ssize_t len)
Definition corefile.c:238
void write_memory_with_notification(CORE_ADDR memaddr, const bfd_byte *myaddr, ssize_t len)
Definition corefile.c:370
EXTERN_C char * re_comp(const char *)
int longest_to_int(LONGEST)
Definition valprint.c:1372
@ STATIC_BLOCK
Definition defs.h:586
@ GLOBAL_BLOCK
Definition defs.h:585
language
Definition defs.h:211
@ language_ada
Definition defs.h:225
@ language_unknown
Definition defs.h:212
@ language_cplus
Definition defs.h:216
@ lval_memory
Definition defs.h:363
@ not_lval
Definition defs.h:361
@ lval_internalvar
Definition defs.h:367
const char * command_line_input(std::string &cmd_line_buffer, const char *, const char *)
Definition top.c:1226
static ULONGEST extract_unsigned_integer(gdb::array_view< const gdb_byte > buf, enum bfd_endian byte_order)
Definition defs.h:480
#define QUIT
Definition defs.h:187
value * evaluate_var_value(enum noside noside, const block *blk, symbol *var)
Definition eval.c:520
struct value * parse_and_eval(const char *exp, parser_flags flags)
Definition eval.c:70
value * evaluate_var_msym_value(enum noside noside, struct objfile *objfile, minimal_symbol *msymbol)
Definition eval.c:569
void binop_promote(const struct language_defn *language, struct gdbarch *gdbarch, struct value **arg1, struct value **arg2)
Definition eval.c:255
void unop_promote(const struct language_defn *language, struct gdbarch *gdbarch, struct value **arg1)
Definition eval.c:222
CORE_ADDR parse_and_eval_address(const char *exp)
Definition eval.c:52
void exception_fprintf(struct ui_file *file, const struct gdb_exception &e, const char *prefix,...)
Definition exceptions.c:116
std::unique_ptr< expression > expression_up
Definition expression.h:241
exp_opcode
Definition expression.h:45
expression_up parse_exp_1(const char **, CORE_ADDR pc, const struct block *, parser_flags flags, innermost_block_tracker *=nullptr)
Definition parse.c:446
noside
Definition expression.h:56
@ EVAL_NORMAL
Definition expression.h:57
@ EVAL_AVOID_SIDE_EFFECTS
Definition expression.h:58
void select_frame(frame_info_ptr fi)
Definition frame.c:1927
bool has_stack_frames()
Definition frame.c:1859
frame_info_ptr get_selected_frame(const char *message)
Definition frame.c:1888
frame_info_ptr get_current_frame(void)
Definition frame.c:1670
frame_info_ptr get_prev_frame(frame_info_ptr this_frame)
Definition frame.c:2614
symtab_and_line find_frame_sal(frame_info_ptr frame)
Definition frame.c:2821
const struct block * get_selected_block(CORE_ADDR *addr_in_block)
Definition stack.c:2570
static void ATTRIBUTE_PRINTF(1, 0)
Definition gdb_bfd.c:1154
void gdbarch_iterate_over_objfiles_in_search_order(struct gdbarch *gdbarch, iterate_over_objfiles_in_search_order_cb_ftype cb, struct objfile *current_objfile)
Definition gdbarch.c:5072
enum bfd_endian gdbarch_byte_order(struct gdbarch *gdbarch)
Definition gdbarch.c:1396
int gdbarch_long_long_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1483
int gdbarch_short_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1432
int gdbarch_int_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1449
int gdbarch_float_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1568
const struct floatformat ** gdbarch_double_format(struct gdbarch *gdbarch)
Definition gdbarch.c:1619
void gdbarch_address_to_pointer(struct gdbarch *gdbarch, struct type *type, gdb_byte *buf, CORE_ADDR addr)
Definition gdbarch.c:2562
int gdbarch_long_double_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1636
const struct floatformat ** gdbarch_float_format(struct gdbarch *gdbarch)
Definition gdbarch.c:1585
const struct floatformat ** gdbarch_long_double_format(struct gdbarch *gdbarch)
Definition gdbarch.c:1653
int gdbarch_long_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1466
int gdbarch_double_bit(struct gdbarch *gdbarch)
Definition gdbarch.c:1602
enum bfd_endian type_byte_order(const struct type *type)
Definition gdbtypes.c:3900
struct type * lookup_pointer_type(struct type *type)
Definition gdbtypes.c:430
struct type * init_character_type(type_allocator &alloc, int bit, int unsigned_p, const char *name)
Definition gdbtypes.c:3374
struct type * init_integer_type(type_allocator &alloc, int bit, int unsigned_p, const char *name)
Definition gdbtypes.c:3355
struct type * create_static_range_type(type_allocator &alloc, struct type *index_type, LONGEST low_bound, LONGEST high_bound)
Definition gdbtypes.c:1019
int is_integral_type(struct type *t)
Definition gdbtypes.c:3654
struct type * lookup_struct_elt_type(struct type *type, const char *name, int noerr)
Definition gdbtypes.c:1850
int is_scalar_type(struct type *type)
Definition gdbtypes.c:3681
int is_dynamic_type(struct type *type)
Definition gdbtypes.c:2140
struct type * lookup_array_range_type(struct type *element_type, LONGEST low_bound, LONGEST high_bound)
Definition gdbtypes.c:1397
bool get_discrete_bounds(struct type *type, LONGEST *lowp, LONGEST *highp)
Definition gdbtypes.c:1192
struct type * resolve_dynamic_type(struct type *type, gdb::array_view< const gdb_byte > valaddr, CORE_ADDR addr, const frame_info_ptr *in_frame)
Definition gdbtypes.c:2857
struct type * init_float_type(type_allocator &alloc, int bit, const char *name, const struct floatformat **floatformats, enum bfd_endian byte_order)
Definition gdbtypes.c:3408
gdb::optional< LONGEST > discrete_position(struct type *type, LONGEST val)
Definition gdbtypes.c:1247
bool get_array_bounds(struct type *type, LONGEST *low_bound, LONGEST *high_bound)
Definition gdbtypes.c:1211
const struct builtin_type * builtin_type(struct gdbarch *gdbarch)
Definition gdbtypes.c:6168
struct type * create_array_type(type_allocator &alloc, struct type *element_type, struct type *range_type)
Definition gdbtypes.c:1388
bool types_equal(struct type *a, struct type *b)
Definition gdbtypes.c:4114
struct type * create_array_type_with_stride(type_allocator &alloc, struct type *element_type, struct type *range_type, struct dynamic_prop *byte_stride_prop, unsigned int bit_stride)
Definition gdbtypes.c:1339
struct type * copy_type(const struct type *type)
Definition gdbtypes.c:5656
struct type * check_typedef(struct type *type)
Definition gdbtypes.c:2966
#define TYPE_DESCRIPTIVE_TYPE(thistype)
Definition gdbtypes.h:1942
@ PROP_UNDEFINED
Definition gdbtypes.h:275
#define INIT_NONE_SPECIFIC(type)
Definition gdbtypes.h:1830
#define TYPE_MAIN_TYPE(thistype)
Definition gdbtypes.h:1866
#define ADA_TYPE_P(type)
Definition gdbtypes.h:1848
type_code
Definition gdbtypes.h:82
@ TYPE_CODE_UNDEF
Definition gdbtypes.h:83
#define INIT_GNAT_SPECIFIC(type)
Definition gdbtypes.h:1838
@ DYN_PROP_BYTE_STRIDE
Definition gdbtypes.h:450
#define HAVE_GNAT_AUX_INFO(type)
Definition gdbtypes.h:1844
mach_port_t kern_return_t mach_port_t mach_msg_type_name_t msgportsPoly mach_port_t kern_return_t pid_t pid mach_port_t kern_return_t mach_port_t task mach_port_t kern_return_t int flags
Definition gnu-nat.c:1861
size_t size
Definition go32-nat.c:239
@ L
Definition ia64-tdep.c:85
uint32_t offset_type
void error_call_unknown_return_type(const char *func_name)
Definition infcall.c:395
struct value * call_function_by_hand(struct value *function, type *default_return_type, gdb::array_view< value * > args)
Definition infcall.c:824
struct inferior * current_inferior(void)
Definition inferior.c:55
const struct language_defn * language_def(enum language lang)
Definition language.c:439
struct type * language_lookup_primitive_type(const struct language_defn *la, struct gdbarch *gdbarch, const char *name)
Definition language.c:1006
struct type * language_bool_type(const struct language_defn *la, struct gdbarch *gdbarch)
Definition language.c:888
struct type * language_string_char_type(const struct language_defn *la, struct gdbarch *gdbarch)
Definition language.c:868
struct symbol * language_lookup_primitive_type_as_symbol(const struct language_defn *la, struct gdbarch *gdbarch, const char *name)
Definition language.c:1026
case_sensitivity
Definition language.h:72
@ case_sensitive_on
Definition language.h:73
@ case_sensitive_off
Definition language.h:73
#define R(name, type, sim_num)
Definition m32c-tdep.c:731
static struct type * new_type(char *)
const char * async_reason_lookup(enum async_reply_reason reason)
Definition mi-common.c:50
@ EXEC_ASYNC_BREAKPOINT_HIT
Definition mi-common.h:27
struct bound_minimal_symbol lookup_minimal_symbol(const char *name, const char *sfile, struct objfile *objf)
Definition minsyms.c:363
Definition ada-exp.h:87
static LONGEST convert_char_literal(struct type *type, LONGEST val)
Definition ada-lang.c:10506
static void assign_component(struct value *container, struct value *lhs, LONGEST index, struct expression *exp, operation_up &arg)
Definition ada-lang.c:9398
std::unique_ptr< operation > operation_up
Definition expression.h:82
bool check_objfile(const std::unique_ptr< ada_component > &comp, struct objfile *objfile)
Definition ada-lang.c:9386
observable< struct inferior * > inferior_exit
observable< struct objfile * > free_objfile
observable< struct objfile * > new_objfile
observable< program_space * > all_objfiles_removed
info(Component c)
Definition gdbarch.py:41
Definition aarch64.h:67
const char * objfile_name(const struct objfile *objfile)
Definition objfiles.c:1259
struct program_space * current_program_space
Definition progspace.c:40
int value
Definition py-param.c:79
static gdbpy_ref field_name(struct type *type, int field)
Definition py-type.c:234
@ SEARCH_GLOBAL_BLOCK
@ SEARCH_STATIC_BLOCK
static struct symbol * new_symbol(struct die_info *, struct type *, struct dwarf2_cu *, struct symbol *=NULL)
Definition read.c:18978
void(* func)(remote_target *remote, char *)
enum var_types type
Definition scm-param.c:142
#define resolve(X)
const char * symtab_to_fullname(struct symtab *s)
Definition source.c:1234
const char * symtab_to_filename_for_display(struct symtab *symtab)
Definition source.c:1269
gdb::unique_xmalloc_ptr< char > find_frame_funname(frame_info_ptr frame, enum language *funlang, struct symbol **funcp)
Definition stack.c:1256
Definition 1.cc:26
bool print_one(const bp_location **) const override
Definition ada-lang.c:12362
enum ada_exception_catchpoint_kind m_kind
Definition ada-lang.c:12104
ada_catchpoint(struct gdbarch *gdbarch_, enum ada_exception_catchpoint_kind kind, const char *cond_string, bool tempflag, bool enabled, bool from_tty, std::string &&excep_string_)
Definition ada-lang.c:12064
std::string m_excep_string
Definition ada-lang.c:12101
void print_recreate(struct ui_file *fp) const override
Definition ada-lang.c:12471
bool should_stop_exception(const struct bp_location *bl) const
Definition ada-lang.c:12204
struct bp_location * allocate_location() override
Definition ada-lang.c:12196
void print_mention() const override
Definition ada-lang.c:12419
void check_status(struct bpstat *bs) override
Definition ada-lang.c:12265
void re_set() override
Definition ada-lang.c:12130
enum print_stop_action print_it(const bpstat *bs) const override
Definition ada-lang.c:12274
CORE_ADDR addr
Definition ada-lang.h:357
bool operator<(const ada_exc_info &) const
Definition ada-lang.c:12894
const char * name
Definition ada-lang.h:354
bool operator==(const ada_exc_info &) const
Definition ada-lang.c:12907
const struct exception_support_info * exception_info
Definition ada-lang.c:293
struct type * tsd_type
Definition ada-lang.c:288
const char * decoded
Definition ada-lang.h:73
const char * encoded
Definition ada-lang.h:72
const struct block * block
Definition symtab.h:1537
struct symbol * symbol
Definition symtab.h:1533
Definition block.h:109
const block * superblock() const
Definition block.h:135
const struct block * global_block() const
Definition block.c:369
struct gdbarch * gdbarch() const
Definition block.c:57
const struct block * static_block() const
Definition block.c:354
symbol * function() const
Definition block.h:127
struct symbol * linkage_function() const
Definition block.c:91
struct using_direct * get_using() const
Definition block.c:328
struct block * block(size_t i)
Definition block.h:374
struct block * static_block()
Definition block.h:405
struct block * global_block()
Definition block.h:397
struct objfile * objfile
Definition minsyms.h:54
CORE_ADDR value_address() const
Definition minsyms.h:41
struct minimal_symbol * minsym
Definition minsyms.h:49
bp_location_ref_ptr bp_location_at
bool stop
bp_location_range locations() const
gdb::unique_xmalloc_ptr< char > cond_string
Definition breakpoint.h:850
void print_recreate_thread(struct ui_file *fp) const
bool has_locations() const
Definition breakpoint.h:661
program_space * pspace
Definition breakpoint.h:829
bpdisp disposition
Definition breakpoint.h:802
struct type * builtin_bool
Definition gdbtypes.h:2095
struct type * builtin_int
Definition gdbtypes.h:2080
struct type * builtin_void
Definition gdbtypes.h:2077
Definition ada-lang.c:350
hashval_t hash() const
Definition ada-lang.c:354
const char * name
Definition ada-lang.c:351
domain_enum domain
Definition ada-lang.c:352
Definition ada-lang.c:334
struct symbol * sym
Definition ada-lang.c:341
domain_enum domain
Definition ada-lang.c:338
std::string name
Definition ada-lang.c:336
const struct block * block
Definition ada-lang.c:344
void * context() const
Definition cli-decode.h:109
void set_match(const char *m, const char *m_for_lcd=NULL)
Definition completer.h:233
completion_match match
Definition completer.h:226
struct blockvector * blockvector()
Definition symtab.h:1847
struct objfile * objfile() const
Definition symtab.h:1788
LONGEST const_val() const
Definition gdbtypes.h:330
dynamic_prop_kind kind() const
Definition gdbtypes.h:320
bool is_constant() const
Definition gdbtypes.h:345
ada_unhandled_exception_name_addr_ftype * unhandled_exception_name_addr
Definition ada-lang.c:11627
const char * catch_handlers_sym
Definition ada-lang.c:11621
const char * catch_assert_sym
Definition ada-lang.c:11617
const char * catch_exception_unhandled_sym
Definition ada-lang.c:11613
const char * catch_exception_sym
Definition ada-lang.c:11609
virtual operation_up replace(operation_up &&owner, struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type)
Definition ada-lang.c:10486
const struct language_defn * language_defn
Definition expression.h:235
struct gdbarch * gdbarch
Definition expression.h:237
void set_type(struct type *type)
Definition gdbtypes.h:552
void set_loc_bitpos(LONGEST bitpos)
Definition gdbtypes.h:617
LONGEST loc_bitpos() const
Definition gdbtypes.h:611
void set_bitsize(unsigned int bitsize)
Definition gdbtypes.h:582
LONGEST loc_enumval() const
Definition gdbtypes.h:623
void set_name(const char *name)
Definition gdbtypes.h:562
const char * name() const
Definition gdbtypes.h:557
unsigned int bitsize() const
Definition gdbtypes.h:577
struct type * type() const
Definition gdbtypes.h:547
int sgn() const
Definition gmp-utils.h:183
struct obstack * obstack
Definition symtab.h:585
const char * natural_name() const
Definition symtab.c:1056
union general_symbol_info::@183 language_specific
const char * demangled_name
Definition symtab.h:589
const char * print_name() const
Definition symtab.h:475
unsigned int ada_mangled
Definition symtab.h:602
const char * linkage_name() const
Definition symtab.h:460
Definition gnu-nat.c:153
void set_string_char_type(struct type *type)
Definition language.h:114
void add_primitive_type(struct type *type)
Definition language.h:130
void set_bool_type(struct type *type, const char *name=nullptr)
Definition language.h:102
virtual struct value * read_var_value(struct symbol *var, const struct block *var_block, frame_info_ptr frame) const
Definition findvar.c:504
struct symbol * arg_sym
Definition ada-lang.c:5376
match_data(std::vector< struct block_symbol > *rp)
Definition ada-lang.c:5366
bool operator()(struct block_symbol *bsym)
Definition ada-lang.c:5384
bool found_sym
Definition ada-lang.c:5377
DISABLE_COPY_AND_ASSIGN(match_data)
std::vector< struct block_symbol > * resultp
Definition ada-lang.c:5375
minimal_symbol_type type() const
Definition symtab.h:770
struct program_space * pspace
Definition objfiles.h:728
struct gdbarch * arch() const
Definition objfiles.h:507
objfile(gdb_bfd_ref_ptr, const char *, objfile_flags)
Definition objfiles.c:313
compunit_symtab_range compunits()
Definition objfiles.h:451
void expand_matching_symbols(const lookup_name_info &name, domain_enum domain, int global, symbol_compare_ftype *ordered_compare)
msymbols_range msymbols()
Definition objfiles.h:464
objfiles_range objfiles()
Definition progspace.h:209
struct dynamic_prop high
Definition gdbtypes.h:721
struct dynamic_prop low
Definition gdbtypes.h:717
LONGEST bias
Definition gdbtypes.h:733
address_class aclass() const
Definition symtab.h:1274
struct type * type() const
Definition symtab.h:1331
domain_enum domain() const
Definition symtab.h:1286
LONGEST value_longest() const
Definition symtab.h:1351
bool is_objfile_owned() const
Definition symtab.h:1296
bool is_argument() const
Definition symtab.h:1306
unsigned int line() const
Definition symtab.h:1341
CORE_ADDR value_address() const
Definition symtab.h:1361
symbol()
Definition symtab.h:1237
struct symtab * symtab
Definition symtab.h:1457
bool is_artificial() const
Definition symtab.h:1412
struct symtab * symtab
Definition symtab.h:2328
struct compunit_symtab * compunit() const
Definition symtab.h:1677
const char * filename
Definition symtab.h:1725
struct type * target_type() const
Definition gdbtypes.h:1037
dynamic_prop * dyn_prop(dynamic_prop_node_kind kind) const
Definition gdbtypes.c:2875
type_code code() const
Definition gdbtypes.h:956
void copy_fields(struct type *src)
Definition gdbtypes.c:5920
void set_code(type_code code)
Definition gdbtypes.h:962
ULONGEST length() const
Definition gdbtypes.h:983
bool is_fixed_instance() const
Definition gdbtypes.h:1236
struct field & field(int idx) const
Definition gdbtypes.h:1012
void set_target_type(struct type *target_type)
Definition gdbtypes.h:1042
bool is_unsigned() const
Definition gdbtypes.h:1100
void set_is_stub(bool is_stub)
Definition gdbtypes.h:1133
bool is_stub() const
Definition gdbtypes.h:1128
void set_num_fields(unsigned int num_fields)
Definition gdbtypes.h:1000
unsigned int num_fields() const
Definition gdbtypes.h:994
void set_name(const char *name)
Definition gdbtypes.h:974
gdbarch * arch() const
Definition gdbtypes.c:273
void alloc_fields(unsigned int nfields, bool init=true)
Definition gdbtypes.c:5898
void set_length(ULONGEST length)
Definition gdbtypes.h:988
range_bounds * bounds() const
Definition gdbtypes.h:1065
void set_is_fixed_instance(bool is_fixed_instance)
Definition gdbtypes.h:1241
const char * name() const
Definition gdbtypes.h:968
type * index_type() const
Definition gdbtypes.h:1032
unsigned short bit_offset() const
Definition gdbtypes.h:1424
unsigned short bit_size() const
Definition gdbtypes.h:1416
const ui_file_style * ptr() const
Definition ui-style.h:233
struct using_direct * next
Definition namespace.h:98
const char * import_src
Definition namespace.h:92
const char * import_dest
Definition namespace.h:93
const char * declaration
Definition namespace.h:96
const char * alias
Definition namespace.h:95
Definition ada-lang.c:220
int upper_delta
Definition ada-lang.c:225
int lower_delta
Definition ada-lang.c:228
uint32_t start
Definition ada-lang.c:222
uint32_t end
Definition ada-lang.c:222
bool operator<(uint32_t val) const
Definition ada-lang.c:230
Definition value.h:130
static struct value * zero(struct type *type, enum lval_type lv)
Definition value.c:3426
void set_parent(struct value *parent)
Definition value.h:214
struct value * primitive_field(LONGEST offset, int fieldno, struct type *arg_type)
Definition value.c:2932
static struct value * allocate_optimized_out(struct type *type)
Definition value.c:997
gdb::array_view< const gdb_byte > contents_all()
Definition value.c:1119
void contents_copy(struct value *dst, LONGEST dst_offset, LONGEST src_offset, LONGEST length)
Definition value.c:1252
void set_bitpos(LONGEST bit)
Definition value.h:205
LONGEST bitsize() const
Definition value.h:193
bool deprecated_modifiable() const
Definition value.h:231
struct value * copy() const
Definition value.c:1494
bool lazy() const
Definition value.h:265
gdb::array_view< gdb_byte > contents_writeable()
Definition value.c:1271
static struct value * allocate(struct type *type)
Definition value.c:957
LONGEST bitpos() const
Definition value.h:202
struct type * enclosing_type() const
Definition value.h:312
void set_lval(lval_type val)
Definition value.h:336
void set_bitsize(LONGEST bit)
Definition value.h:196
gdb::array_view< const gdb_byte > contents()
Definition value.c:1262
void set_address(CORE_ADDR)
Definition value.c:1389
void set_component_location(const struct value *whole)
Definition value.c:1599
gdb::array_view< gdb_byte > contents_raw()
Definition value.c:1009
struct type * type() const
Definition value.h:180
void set_offset(LONGEST offset)
Definition value.h:225
LONGEST offset() const
Definition value.h:222
enum lval_type lval() const
Definition value.h:332
void fetch_lazy()
Definition value.c:4001
CORE_ADDR address
Definition value.h:658
void deprecated_set_type(struct type *type)
Definition value.h:186
static struct value * allocate_lazy(struct type *type)
Definition value.c:729
bool optimized_out()
Definition value.c:1279
gdb::array_view< const gdb_byte > contents_for_printing()
Definition value.c:1100
bool expand_symtabs_matching(gdb::function_view< expand_symtabs_file_matcher_ftype > file_matcher, const lookup_name_info &lookup_name, gdb::function_view< expand_symtabs_symbol_matcher_ftype > symbol_matcher, gdb::function_view< expand_symtabs_exp_notify_ftype > expansion_notify, block_search_flags search_flags, enum search_domain kind)
Definition symfile.c:3760
const char multiple_symbols_all[]
Definition symtab.c:277
const char multiple_symbols_cancel[]
Definition symtab.c:278
bool iterate_over_symbols_terminated(const struct block *block, const lookup_name_info &name, const domain_enum domain, gdb::function_view< symbol_found_callback_ftype > callback)
Definition symtab.c:2812
symtab_and_line find_function_start_sal(CORE_ADDR func_addr, obj_section *section, bool funfirstline)
Definition symtab.c:3639
const char * multiple_symbols_select_mode(void)
Definition symtab.c:295
bool completion_list_add_name(completion_tracker &tracker, language symbol_language, const char *symname, const lookup_name_info &lookup_name, const char *text, const char *word)
Definition symtab.c:5413
@ VARIABLES_DOMAIN
Definition symtab.h:948
@ ALL_DOMAIN
Definition symtab.h:960
symbol_name_match_type
Definition symtab.h:63
@ LOC_STATIC
Definition symtab.h:979
@ LOC_BLOCK
Definition symtab.h:1028
@ LOC_UNRESOLVED
Definition symtab.h:1057
@ LOC_LOCAL
Definition symtab.h:1013
@ LOC_CONST
Definition symtab.h:975
@ LOC_UNDEF
Definition symtab.h:971
@ LOC_OPTIMIZED_OUT
Definition symtab.h:1062
@ LOC_TYPEDEF
Definition symtab.h:1018
@ LOC_COMPUTED
Definition symtab.h:1066
bool symbol_name_matcher_ftype(const char *symbol_search_name, const lookup_name_info &lookup_name, completion_match_result *comp_match_res)
Definition symtab.h:399
@ mst_solib_trampoline
Definition symtab.h:705
domain_enum
Definition symtab.h:900
@ VAR_DOMAIN
Definition symtab.h:910
@ STRUCT_DOMAIN
Definition symtab.h:916
@ UNDEF_DOMAIN
Definition symtab.h:905
static bool completion_skip_symbol(complete_symbol_mode mode, Symbol *sym)
Definition symtab.h:2431
complete_symbol_mode
Definition symtab.h:2385
symtab_and_line find_function_start_sal(symbol *sym, bool funfirstline)
Definition symtab.c:3656
int target_read_string(CORE_ADDR addr, int len, int width, unsigned int fetchlimit, gdb::unique_xmalloc_ptr< gdb_byte > *buffer, int *bytes_read)
Definition target.c:65
bool trust_readonly
const struct type_print_options type_print_raw_options
Definition typeprint.c:41
std::string type_to_string(struct type *type)
Definition typeprint.c:399
void type_print(struct type *type, const char *varstring, struct ui_file *stream, int show)
Definition typeprint.c:388
static styled_string_s * styled_string(const ui_file_style &style, const char *str, styled_string_s &&tmp={})
Definition ui-out.h:151
#define current_uiout
Definition ui-out.h:40
const char * paddress(struct gdbarch *gdbarch, CORE_ADDR addr)
Definition utils.c:3166
int strcmp_iw_ordered(const char *string1, const char *string2)
Definition utils.c:3077
void copy_bitwise(gdb_byte *dest, ULONGEST dest_offset, const gdb_byte *source, ULONGEST source_offset, ULONGEST nbits, int bits_big_endian)
Definition utils.c:3588
void gdb_printf(struct ui_file *stream, const char *format,...)
Definition utils.c:1886
void vwarning(const char *string, va_list args)
Definition utils.c:140
#define gdb_stderr
Definition utils.h:187
#define gdb_stdout
Definition utils.h:182
struct value * value_subscript(struct value *array, LONGEST index)
Definition valarith.c:141
struct value * value_neg(struct value *arg1)
Definition valarith.c:1722
int value_equal(struct value *arg1, struct value *arg2)
Definition valarith.c:1559
int value_less(struct value *arg1, struct value *arg2)
Definition valarith.c:1648
struct value * value_concat(struct value *arg1, struct value *arg2)
Definition valarith.c:684
struct value * value_ptradd(struct value *arg1, LONGEST arg2)
Definition valarith.c:79
struct value * value_binop(struct value *arg1, struct value *arg2, enum exp_opcode op)
Definition valarith.c:1464
struct value * value_cast_pointers(struct type *type, struct value *arg2, int subclass_check)
Definition valops.c:296
struct value * value_at_lazy(struct type *type, CORE_ADDR addr, frame_info_ptr frame)
Definition valops.c:1036
struct value * value_at(struct type *type, CORE_ADDR addr)
Definition valops.c:1015
struct value * value_slice(struct value *array, int lowbound, int length)
Definition valops.c:4030
struct value * value_allocate_space_in_inferior(int len)
Definition valops.c:175
struct value * value_struct_elt(struct value **argp, gdb::optional< gdb::array_view< value * > > args, const char *name, int *static_memfuncp, const char *err)
Definition valops.c:2334
struct value * value_of_variable(struct symbol *var, const struct block *b)
Definition valops.c:1386
struct value * value_addr(struct value *arg1)
Definition valops.c:1551
struct value * value_cast(struct type *type, struct value *arg2)
Definition valops.c:403
struct value * value_assign(struct value *toval, struct value *fromval)
Definition valops.c:1085
struct value * value_ind(struct value *arg1)
Definition valops.c:1630
struct value * value_ref(struct value *arg1, enum type_code refcode)
Definition valops.c:1609
void get_user_print_options(struct value_print_options *opts)
Definition valprint.c:135
struct value * call_internal_function(struct gdbarch *gdbarch, const struct language_defn *language, struct value *func, int argc, struct value **argv)
Definition value.c:2318
void clear_internalvar(struct internalvar *var)
Definition value.c:2265
CORE_ADDR value_as_address(struct value *val)
Definition value.c:2636
struct value * value_from_contents_and_address_unresolved(struct type *type, const gdb_byte *valaddr, CORE_ADDR address)
Definition value.c:3531
struct value * value_from_longest(struct type *type, LONGEST num)
Definition value.c:3438
struct value * coerce_ref(struct value *arg)
Definition value.c:3752
struct value * value_from_contents(struct type *type, const gdb_byte *contents)
Definition value.c:3581
void set_internalvar(struct internalvar *var, struct value *val)
Definition value.c:2171
struct internalvar * lookup_internalvar(const char *name)
Definition value.c:2001
LONGEST value_as_long(struct value *val)
Definition value.c:2554
void modify_field(struct type *type, gdb_byte *addr, LONGEST fieldval, LONGEST bitpos, LONGEST bitsize)
Definition value.c:3280
gdb_mpz value_as_mpz(struct value *val)
Definition value.c:2566
struct value * value_from_mpz(struct type *type, const gdb_mpz &v)
Definition value.c:3462
struct value * value_from_contents_and_address(struct type *type, const gdb_byte *valaddr, CORE_ADDR address, frame_info_ptr frame)
Definition value.c:3552
static bool value_true(struct value *val)
Definition value.h:1461