GDB (xrefs)
Loading...
Searching...
No Matches
/tmp/gdb-13.1/gdb/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 <algorithm>
61#include "ada-exp.h"
62#include "charset.h"
63
64/* Define whether or not the C operator '/' truncates towards zero for
65 differently signed operands (truncation direction is undefined in C).
66 Copied from valarith.c. */
67
68#ifndef TRUNCATION_TOWARDS_ZERO
69#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
70#endif
71
72static struct type *desc_base_type (struct type *);
73
74static struct type *desc_bounds_type (struct type *);
75
76static struct value *desc_bounds (struct value *);
77
78static int fat_pntr_bounds_bitpos (struct type *);
79
80static int fat_pntr_bounds_bitsize (struct type *);
81
82static struct type *desc_data_target_type (struct type *);
83
84static struct value *desc_data (struct value *);
85
86static int fat_pntr_data_bitpos (struct type *);
87
88static int fat_pntr_data_bitsize (struct type *);
89
90static struct value *desc_one_bound (struct value *, int, int);
91
92static int desc_bound_bitpos (struct type *, int, int);
93
94static int desc_bound_bitsize (struct type *, int, int);
95
96static struct type *desc_index_type (struct type *, int);
97
98static int desc_arity (struct type *);
99
100static int ada_args_match (struct symbol *, struct value **, int);
101
102static struct value *make_array_descriptor (struct type *, struct value *);
103
104static void ada_add_block_symbols (std::vector<struct block_symbol> &,
105 const struct block *,
106 const lookup_name_info &lookup_name,
107 domain_enum, struct objfile *);
108
109static void ada_add_all_symbols (std::vector<struct block_symbol> &,
110 const struct block *,
111 const lookup_name_info &lookup_name,
112 domain_enum, int, int *);
113
114static int is_nonfunction (const std::vector<struct block_symbol> &);
115
116static void add_defn_to_vec (std::vector<struct block_symbol> &,
117 struct symbol *,
118 const struct block *);
119
120static int possible_user_operator_p (enum exp_opcode, struct value **);
121
122static const char *ada_decoded_op_name (enum exp_opcode);
123
124static int numeric_type_p (struct type *);
125
126static int integer_type_p (struct type *);
127
128static int scalar_type_p (struct type *);
129
130static int discrete_type_p (struct type *);
131
132static struct type *ada_lookup_struct_elt_type (struct type *, const char *,
133 int, int);
134
135static struct type *ada_find_parallel_type_with_name (struct type *,
136 const char *);
137
138static int is_dynamic_field (struct type *, int);
139
140static struct type *to_fixed_variant_branch_type (struct type *,
141 const gdb_byte *,
142 CORE_ADDR, struct value *);
143
144static struct type *to_fixed_array_type (struct type *, struct value *, int);
145
146static struct type *to_fixed_range_type (struct type *, struct value *);
147
148static struct type *to_static_fixed_type (struct type *);
149static struct type *static_unwrap_type (struct type *type);
150
151static struct value *unwrap_value (struct value *);
152
153static struct type *constrained_packed_array_type (struct type *, long *);
154
155static struct type *decode_constrained_packed_array_type (struct type *);
156
157static long decode_packed_array_bitsize (struct type *);
158
159static struct value *decode_constrained_packed_array (struct value *);
160
161static int ada_is_unconstrained_packed_array_type (struct type *);
162
163static struct value *value_subscript_packed (struct value *, int,
164 struct value **);
165
166static struct value *coerce_unspec_val_to_type (struct value *,
167 struct type *);
168
169static int lesseq_defined_than (struct symbol *, struct symbol *);
170
171static int equiv_types (struct type *, struct type *);
172
173static int is_name_suffix (const char *);
174
175static int advance_wild_match (const char **, const char *, char);
176
177static bool wild_match (const char *name, const char *patn);
178
179static struct value *ada_coerce_ref (struct value *);
180
181static LONGEST pos_atr (struct value *);
182
183static struct value *val_atr (struct type *, LONGEST);
184
185static struct symbol *standard_lookup (const char *, const struct block *,
187
188static struct value *ada_search_struct_field (const char *, struct value *, int,
189 struct type *);
190
191static int find_struct_field (const char *, struct type *, int,
192 struct type **, int *, int *, int *, int *);
193
194static int ada_resolve_function (std::vector<struct block_symbol> &,
195 struct value **, int, const char *,
196 struct type *, bool);
197
198static int ada_is_direct_array_type (struct type *);
199
200static struct value *ada_index_struct_field (int, struct value *, int,
201 struct type *);
202
203static void add_component_interval (LONGEST, LONGEST, std::vector<LONGEST> &);
204
205
206static struct type *ada_find_any_type (const char *name);
207
209 (const lookup_name_info &lookup_name);
210
211
212
213/* The character set used for source files. */
214static const char *ada_source_charset;
215
216/* The string "UTF-8". This is here so we can check for the UTF-8
217 charset using == rather than strcmp. */
218static const char ada_utf8[] = "UTF-8";
219
220/* Each entry in the UTF-32 case-folding table is of this form. */
222{
223 /* The start and end, inclusive, of this range of codepoints. */
224 uint32_t start, end;
225 /* The delta to apply to get the upper-case form. 0 if this is
226 already upper-case. */
228 /* The delta to apply to get the lower-case form. 0 if this is
229 already lower-case. */
231
232 bool operator< (uint32_t val) const
233 {
234 return end < val;
235 }
236};
237
238static const utf8_entry ada_case_fold[] =
239{
240#include "ada-casefold.h"
241};
242
243
244
245/* The result of a symbol lookup to be stored in our symbol cache. */
246
248{
249 /* The name used to perform the lookup. */
250 const char *name;
251 /* The namespace used during the lookup. */
253 /* The symbol returned by the lookup, or NULL if no matching symbol
254 was found. */
255 struct symbol *sym;
256 /* The block where the symbol was found, or NULL if no matching
257 symbol was found. */
258 const struct block *block;
259 /* A pointer to the next entry with the same hash. */
261};
262
263/* The Ada symbol cache, used to store the result of Ada-mode symbol
264 lookups in the course of executing the user's commands.
265
266 The cache is implemented using a simple, fixed-sized hash.
267 The size is fixed on the grounds that there are not likely to be
268 all that many symbols looked up during any given session, regardless
269 of the size of the symbol table. If we decide to go to a resizable
270 table, let's just use the stuff from libiberty instead. */
271
272#define HASH_SIZE 1009
273
275{
276 /* An obstack used to store the entries in our cache. */
277 struct auto_obstack cache_space;
278
279 /* The root of the hash table used to implement our symbol cache. */
281};
282
284#ifdef VMS
285 " \t\n!@#%^&*()+=|~`}{[]\";:?/,-";
286#else
287 " \t\n!@#$%^&*()+=|~`}{[]\";:?/,-";
288#endif
289
290/* The name of the symbol to use to get the name of the main subprogram. */
292 = "__gnat_ada_main_program_name";
293
294/* Limit on the number of warnings to raise per expression evaluation. */
295static int warning_limit = 2;
296
297/* Number of warning messages issued; reset to 0 by cleanups after
298 expression evaluation. */
299static int warnings_issued = 0;
300
301static const char * const known_runtime_file_name_patterns[] = {
303};
304
305static const char * const known_auxiliary_function_name_patterns[] = {
307};
308
309/* Maintenance-related settings for this module. */
310
313
314/* The "maintenance ada set/show ignore-descriptive-type" value. */
315
317
318 /* Inferior-specific data. */
319
320/* Per-inferior data for this module. */
321
323{
324 /* The ada__tags__type_specific_data type, which is used when decoding
325 tagged types. With older versions of GNAT, this type was directly
326 accessible through a component ("tsd") in the object tag. But this
327 is no longer the case, so we cache it for each inferior. */
328 struct type *tsd_type = nullptr;
329
330 /* The exception_support_info data. This data is used to determine
331 how to implement support for Ada exception catchpoints in a given
332 inferior. */
333 const struct exception_support_info *exception_info = nullptr;
334};
335
336/* Our key to this module's inferior data. */
338
339/* Return our inferior data for the given inferior (INF).
340
341 This function always returns a valid pointer to an allocated
342 ada_inferior_data structure. If INF's inferior data has not
343 been previously set, this functions creates a new one with all
344 fields set to zero, sets INF's inferior to it, and then returns
345 a pointer to that newly allocated ada_inferior_data. */
346
347static struct ada_inferior_data *
349{
350 struct ada_inferior_data *data;
351
352 data = ada_inferior_data.get (inf);
353 if (data == NULL)
354 data = ada_inferior_data.emplace (inf);
355
356 return data;
357}
358
359/* Perform all necessary cleanups regarding our module's inferior data
360 that is required after the inferior INF just exited. */
361
362static void
364{
365 ada_inferior_data.clear (inf);
366}
367
368
369 /* program-space-specific data. */
370
371/* This module's per-program-space data. */
373{
374 /* The Ada symbol cache. */
375 std::unique_ptr<ada_symbol_cache> sym_cache;
376};
377
378/* Key to our per-program-space data. */
381
382/* Return this module's data for the given program space (PSPACE).
383 If not is found, add a zero'ed one now.
384
385 This function always returns a valid object. */
386
387static struct ada_pspace_data *
389{
390 struct ada_pspace_data *data;
391
392 data = ada_pspace_data_handle.get (pspace);
393 if (data == NULL)
394 data = ada_pspace_data_handle.emplace (pspace);
395
396 return data;
397}
398
399 /* Utilities */
400
401/* If TYPE is a TYPE_CODE_TYPEDEF type, return the target type after
402 all typedef layers have been peeled. Otherwise, return TYPE.
403
404 Normally, we really expect a typedef type to only have 1 typedef layer.
405 In other words, we really expect the target type of a typedef type to be
406 a non-typedef type. This is particularly true for Ada units, because
407 the language does not have a typedef vs not-typedef distinction.
408 In that respect, the Ada compiler has been trying to eliminate as many
409 typedef definitions in the debugging information, since they generally
410 do not bring any extra information (we still use typedef under certain
411 circumstances related mostly to the GNAT encoding).
412
413 Unfortunately, we have seen situations where the debugging information
414 generated by the compiler leads to such multiple typedef layers. For
415 instance, consider the following example with stabs:
416
417 .stabs "pck__float_array___XUP:Tt(0,46)=s16P_ARRAY:(0,47)=[...]"[...]
418 .stabs "pck__float_array___XUP:t(0,36)=(0,46)",128,0,6,0
419
420 This is an error in the debugging information which causes type
421 pck__float_array___XUP to be defined twice, and the second time,
422 it is defined as a typedef of a typedef.
423
424 This is on the fringe of legality as far as debugging information is
425 concerned, and certainly unexpected. But it is easy to handle these
426 situations correctly, so we can afford to be lenient in this case. */
427
428static struct type *
430{
431 while (type->code () == TYPE_CODE_TYPEDEF)
432 type = type->target_type ();
433 return type;
434}
435
436/* Given DECODED_NAME a string holding a symbol name in its
437 decoded form (ie using the Ada dotted notation), returns
438 its unqualified name. */
439
440static const char *
441ada_unqualified_name (const char *decoded_name)
442{
443 const char *result;
444
445 /* If the decoded name starts with '<', it means that the encoded
446 name does not follow standard naming conventions, and thus that
447 it is not your typical Ada symbol name. Trying to unqualify it
448 is therefore pointless and possibly erroneous. */
449 if (decoded_name[0] == '<')
450 return decoded_name;
451
452 result = strrchr (decoded_name, '.');
453 if (result != NULL)
454 result++; /* Skip the dot... */
455 else
456 result = decoded_name;
457
458 return result;
459}
460
461/* Return a string starting with '<', followed by STR, and '>'. */
462
463static std::string
464add_angle_brackets (const char *str)
465{
466 return string_printf ("<%s>", str);
467}
468
469/* True (non-zero) iff TARGET matches FIELD_NAME up to any trailing
470 suffix of FIELD_NAME beginning "___". */
471
472static int
473field_name_match (const char *field_name, const char *target)
474{
475 int len = strlen (target);
476
477 return
478 (strncmp (field_name, target, len) == 0
479 && (field_name[len] == '\0'
480 || (startswith (field_name + len, "___")
481 && strcmp (field_name + strlen (field_name) - 6,
482 "___XVN") != 0)));
483}
484
485
486/* Assuming TYPE is a TYPE_CODE_STRUCT or a TYPE_CODE_TYPDEF to
487 a TYPE_CODE_STRUCT, find the field whose name matches FIELD_NAME,
488 and return its index. This function also handles fields whose name
489 have ___ suffixes because the compiler sometimes alters their name
490 by adding such a suffix to represent fields with certain constraints.
491 If the field could not be found, return a negative number if
492 MAYBE_MISSING is set. Otherwise raise an error. */
493
494int
495ada_get_field_index (const struct type *type, const char *field_name,
496 int maybe_missing)
497{
498 int fieldno;
499 struct type *struct_type = check_typedef ((struct type *) type);
500
501 for (fieldno = 0; fieldno < struct_type->num_fields (); fieldno++)
502 if (field_name_match (struct_type->field (fieldno).name (), field_name))
503 return fieldno;
504
505 if (!maybe_missing)
506 error (_("Unable to find field %s in struct %s. Aborting"),
507 field_name, struct_type->name ());
508
509 return -1;
510}
511
512/* The length of the prefix of NAME prior to any "___" suffix. */
513
514int
516{
517 if (name == NULL)
518 return 0;
519 else
520 {
521 const char *p = strstr (name, "___");
522
523 if (p == NULL)
524 return strlen (name);
525 else
526 return p - name;
527 }
528}
529
530/* Return non-zero if SUFFIX is a suffix of STR.
531 Return zero if STR is null. */
532
533static int
534is_suffix (const char *str, const char *suffix)
535{
536 int len1, len2;
537
538 if (str == NULL)
539 return 0;
540 len1 = strlen (str);
541 len2 = strlen (suffix);
542 return (len1 >= len2 && strcmp (str + len1 - len2, suffix) == 0);
543}
544
545/* The contents of value VAL, treated as a value of type TYPE. The
546 result is an lval in memory if VAL is. */
547
548static struct value *
550{
552 if (value_type (val) == type)
553 return val;
554 else
555 {
556 struct value *result;
557
558 if (value_optimized_out (val))
560 else if (value_lazy (val)
561 /* Be careful not to make a lazy not_lval value. */
562 || (VALUE_LVAL (val) != not_lval
563 && type->length () > value_type (val)->length ()))
564 result = allocate_value_lazy (type);
565 else
566 {
567 result = allocate_value (type);
568 value_contents_copy (result, 0, val, 0, type->length ());
569 }
570 set_value_component_location (result, val);
571 set_value_bitsize (result, value_bitsize (val));
572 set_value_bitpos (result, value_bitpos (val));
573 if (VALUE_LVAL (result) == lval_memory)
574 set_value_address (result, value_address (val));
575 return result;
576 }
577}
578
579static const gdb_byte *
580cond_offset_host (const gdb_byte *valaddr, long offset)
581{
582 if (valaddr == NULL)
583 return NULL;
584 else
585 return valaddr + offset;
586}
587
588static CORE_ADDR
590{
591 if (address == 0)
592 return 0;
593 else
594 return address + offset;
595}
596
597/* Issue a warning (as for the definition of warning in utils.c, but
598 with exactly one argument rather than ...), unless the limit on the
599 number of warnings has passed during the evaluation of the current
600 expression. */
601
602/* FIXME: cagney/2004-10-10: This function is mimicking the behavior
603 provided by "complaint". */
604static void lim_warning (const char *format, ...) ATTRIBUTE_PRINTF (1, 2);
605
606static void
607lim_warning (const char *format, ...)
608{
609 va_list args;
610
611 va_start (args, format);
612 warnings_issued += 1;
614 vwarning (format, args);
615
616 va_end (args);
617}
618
619/* Maximum value of a SIZE-byte signed integer type. */
620static LONGEST
622{
623 LONGEST top_bit = (LONGEST) 1 << (size * 8 - 2);
624
625 return top_bit | (top_bit - 1);
626}
627
628/* Minimum value of a SIZE-byte signed integer type. */
629static LONGEST
631{
632 return -max_of_size (size) - 1;
633}
634
635/* Maximum value of a SIZE-byte unsigned integer type. */
636static ULONGEST
638{
639 ULONGEST top_bit = (ULONGEST) 1 << (size * 8 - 1);
640
641 return top_bit | (top_bit - 1);
642}
643
644/* Maximum value of integral type T, as a signed quantity. */
645static LONGEST
646max_of_type (struct type *t)
647{
648 if (t->is_unsigned ())
649 return (LONGEST) umax_of_size (t->length ());
650 else
651 return max_of_size (t->length ());
652}
653
654/* Minimum value of integral type T, as a signed quantity. */
655static LONGEST
656min_of_type (struct type *t)
657{
658 if (t->is_unsigned ())
659 return 0;
660 else
661 return min_of_size (t->length ());
662}
663
664/* The largest value in the domain of TYPE, a discrete type, as an integer. */
665LONGEST
667{
668 type = resolve_dynamic_type (type, {}, 0);
669 switch (type->code ())
670 {
671 case TYPE_CODE_RANGE:
672 {
673 const dynamic_prop &high = type->bounds ()->high;
674
675 if (high.kind () == PROP_CONST)
676 return high.const_val ();
677 else
678 {
679 gdb_assert (high.kind () == PROP_UNDEFINED);
680
681 /* This happens when trying to evaluate a type's dynamic bound
682 without a live target. There is nothing relevant for us to
683 return here, so return 0. */
684 return 0;
685 }
686 }
687 case TYPE_CODE_ENUM:
688 return type->field (type->num_fields () - 1).loc_enumval ();
689 case TYPE_CODE_BOOL:
690 return 1;
691 case TYPE_CODE_CHAR:
692 case TYPE_CODE_INT:
693 return max_of_type (type);
694 default:
695 error (_("Unexpected type in ada_discrete_type_high_bound."));
696 }
697}
698
699/* The smallest value in the domain of TYPE, a discrete type, as an integer. */
700LONGEST
702{
703 type = resolve_dynamic_type (type, {}, 0);
704 switch (type->code ())
705 {
706 case TYPE_CODE_RANGE:
707 {
708 const dynamic_prop &low = type->bounds ()->low;
709
710 if (low.kind () == PROP_CONST)
711 return low.const_val ();
712 else
713 {
714 gdb_assert (low.kind () == PROP_UNDEFINED);
715
716 /* This happens when trying to evaluate a type's dynamic bound
717 without a live target. There is nothing relevant for us to
718 return here, so return 0. */
719 return 0;
720 }
721 }
722 case TYPE_CODE_ENUM:
723 return type->field (0).loc_enumval ();
724 case TYPE_CODE_BOOL:
725 return 0;
726 case TYPE_CODE_CHAR:
727 case TYPE_CODE_INT:
728 return min_of_type (type);
729 default:
730 error (_("Unexpected type in ada_discrete_type_low_bound."));
731 }
732}
733
734/* The identity on non-range types. For range types, the underlying
735 non-range scalar type. */
736
737static struct type *
739{
740 while (type != NULL && type->code () == TYPE_CODE_RANGE)
741 {
742 if (type == type->target_type () || type->target_type () == NULL)
743 return type;
744 type = type->target_type ();
745 }
746 return type;
747}
748
749/* Return a decoded version of the given VALUE. This means returning
750 a value whose type is obtained by applying all the GNAT-specific
751 encodings, making the resulting type a static but standard description
752 of the initial type. */
753
754struct value *
756{
758
761 && type->code () != TYPE_CODE_PTR))
762 {
763 if (type->code () == TYPE_CODE_TYPEDEF) /* array access type. */
765 else
767 }
768 else
770
771 return value;
772}
773
774/* Same as ada_get_decoded_value, but with the given TYPE.
775 Because there is no associated actual value for this type,
776 the resulting type might be a best-effort approximation in
777 the case of dynamic types. */
778
779struct type *
781{
785 return type;
786}
787
788
789
790 /* Language Selection */
791
792/* If the main program is in Ada, return language_ada, otherwise return LANG
793 (the main program is in Ada iif the adainit symbol is found). */
794
795static enum language
797{
798 if (lookup_minimal_symbol ("adainit", NULL, NULL).minsym != NULL)
799 return language_ada;
800
801 return lang;
802}
803
804/* If the main procedure is written in Ada, then return its name.
805 The result is good until the next call. Return NULL if the main
806 procedure doesn't appear to be in Ada. */
807
808char *
810{
811 struct bound_minimal_symbol msym;
812 static gdb::unique_xmalloc_ptr<char> main_program_name;
813
814 /* For Ada, the name of the main procedure is stored in a specific
815 string constant, generated by the binder. Look for that symbol,
816 extract its address, and then read that string. If we didn't find
817 that string, then most probably the main procedure is not written
818 in Ada. */
820
821 if (msym.minsym != NULL)
822 {
823 CORE_ADDR main_program_name_addr = msym.value_address ();
824 if (main_program_name_addr == 0)
825 error (_("Invalid address for Ada main program name."));
826
827 main_program_name = target_read_string (main_program_name_addr, 1024);
828 return main_program_name.get ();
829 }
830
831 /* The main procedure doesn't seem to be in Ada. */
832 return NULL;
833}
834
835 /* Symbols */
836
837/* Table of Ada operators and their GNAT-encoded names. Last entry is pair
838 of NULLs. */
839
841 {"Oadd", "\"+\"", BINOP_ADD},
842 {"Osubtract", "\"-\"", BINOP_SUB},
843 {"Omultiply", "\"*\"", BINOP_MUL},
844 {"Odivide", "\"/\"", BINOP_DIV},
845 {"Omod", "\"mod\"", BINOP_MOD},
846 {"Orem", "\"rem\"", BINOP_REM},
847 {"Oexpon", "\"**\"", BINOP_EXP},
848 {"Olt", "\"<\"", BINOP_LESS},
849 {"Ole", "\"<=\"", BINOP_LEQ},
850 {"Ogt", "\">\"", BINOP_GTR},
851 {"Oge", "\">=\"", BINOP_GEQ},
852 {"Oeq", "\"=\"", BINOP_EQUAL},
853 {"One", "\"/=\"", BINOP_NOTEQUAL},
854 {"Oand", "\"and\"", BINOP_BITWISE_AND},
855 {"Oor", "\"or\"", BINOP_BITWISE_IOR},
856 {"Oxor", "\"xor\"", BINOP_BITWISE_XOR},
857 {"Oconcat", "\"&\"", BINOP_CONCAT},
858 {"Oabs", "\"abs\"", UNOP_ABS},
859 {"Onot", "\"not\"", UNOP_LOGICAL_NOT},
860 {"Oadd", "\"+\"", UNOP_PLUS},
861 {"Osubtract", "\"-\"", UNOP_NEG},
862 {NULL, NULL}
863};
864
865/* If STR is a decoded version of a compiler-provided suffix (like the
866 "[cold]" in "symbol[cold]"), return true. Otherwise, return
867 false. */
868
869static bool
870is_compiler_suffix (const char *str)
871{
872 gdb_assert (*str == '[');
873 ++str;
874 while (*str != '\0' && isalpha (*str))
875 ++str;
876 /* We accept a missing "]" in order to support completion. */
877 return *str == '\0' || (str[0] == ']' && str[1] == '\0');
878}
879
880/* Append a non-ASCII character to RESULT. */
881static void
882append_hex_encoded (std::string &result, uint32_t one_char)
883{
884 if (one_char <= 0xff)
885 {
886 result.append ("U");
887 result.append (phex (one_char, 1));
888 }
889 else if (one_char <= 0xffff)
890 {
891 result.append ("W");
892 result.append (phex (one_char, 2));
893 }
894 else
895 {
896 result.append ("WW");
897 result.append (phex (one_char, 4));
898 }
899}
900
901/* Return a string that is a copy of the data in STORAGE, with
902 non-ASCII characters replaced by the appropriate hex encoding. A
903 template is used because, for UTF-8, we actually want to work with
904 UTF-32 codepoints. */
905template<typename T>
906std::string
907copy_and_hex_encode (struct obstack *storage)
908{
909 const T *chars = (T *) obstack_base (storage);
910 int num_chars = obstack_object_size (storage) / sizeof (T);
911 std::string result;
912 for (int i = 0; i < num_chars; ++i)
913 {
914 if (chars[i] <= 0x7f)
915 {
916 /* The host character set has to be a superset of ASCII, as
917 are all the other character sets we can use. */
918 result.push_back (chars[i]);
919 }
920 else
921 append_hex_encoded (result, chars[i]);
922 }
923 return result;
924}
925
926/* The "encoded" form of DECODED, according to GNAT conventions. If
927 THROW_ERRORS, throw an error if invalid operator name is found.
928 Otherwise, return the empty string in that case. */
929
930static std::string
931ada_encode_1 (const char *decoded, bool throw_errors)
932{
933 if (decoded == NULL)
934 return {};
935
936 std::string encoding_buffer;
937 bool saw_non_ascii = false;
938 for (const char *p = decoded; *p != '\0'; p += 1)
939 {
940 if ((*p & 0x80) != 0)
941 saw_non_ascii = true;
942
943 if (*p == '.')
944 encoding_buffer.append ("__");
945 else if (*p == '[' && is_compiler_suffix (p))
946 {
947 encoding_buffer = encoding_buffer + "." + (p + 1);
948 if (encoding_buffer.back () == ']')
949 encoding_buffer.pop_back ();
950 break;
951 }
952 else if (*p == '"')
953 {
954 const struct ada_opname_map *mapping;
955
957 mapping->encoded != NULL
958 && !startswith (p, mapping->decoded); mapping += 1)
959 ;
960 if (mapping->encoded == NULL)
961 {
962 if (throw_errors)
963 error (_("invalid Ada operator name: %s"), p);
964 else
965 return {};
966 }
967 encoding_buffer.append (mapping->encoded);
968 break;
969 }
970 else
971 encoding_buffer.push_back (*p);
972 }
973
974 /* If a non-ASCII character is seen, we must convert it to the
975 appropriate hex form. As this is more expensive, we keep track
976 of whether it is even necessary. */
977 if (saw_non_ascii)
978 {
979 auto_obstack storage;
980 bool is_utf8 = ada_source_charset == ada_utf8;
981 try
982 {
984 (host_charset (),
985 is_utf8 ? HOST_UTF32 : ada_source_charset,
986 (const gdb_byte *) encoding_buffer.c_str (),
987 encoding_buffer.length (), 1,
988 &storage, translit_none);
989 }
990 catch (const gdb_exception &)
991 {
992 static bool warned = false;
993
994 /* Converting to UTF-32 shouldn't fail, so if it doesn't, we
995 might like to know why. */
996 if (!warned)
997 {
998 warned = true;
999 warning (_("charset conversion failure for '%s'.\n"
1000 "You may have the wrong value for 'set ada source-charset'."),
1001 encoding_buffer.c_str ());
1002 }
1003
1004 /* We don't try to recover from errors. */
1005 return encoding_buffer;
1006 }
1007
1008 if (is_utf8)
1009 return copy_and_hex_encode<uint32_t> (&storage);
1010 return copy_and_hex_encode<gdb_byte> (&storage);
1011 }
1012
1013 return encoding_buffer;
1014}
1015
1016/* Find the entry for C in the case-folding table. Return nullptr if
1017 the entry does not cover C. */
1018static const utf8_entry *
1020{
1021 auto iter = std::lower_bound (std::begin (ada_case_fold),
1022 std::end (ada_case_fold),
1023 c);
1024 if (iter == std::end (ada_case_fold)
1025 || c < iter->start
1026 || c > iter->end)
1027 return nullptr;
1028 return &*iter;
1029}
1030
1031/* Return NAME folded to lower case, or, if surrounded by single
1032 quotes, unfolded, but with the quotes stripped away. If
1033 THROW_ON_ERROR is true, encoding failures will throw an exception
1034 rather than emitting a warning. Result good to next call. */
1035
1036static const char *
1037ada_fold_name (gdb::string_view name, bool throw_on_error = false)
1038{
1039 static std::string fold_storage;
1040
1041 if (!name.empty () && name[0] == '\'')
1042 fold_storage = gdb::to_string (name.substr (1, name.size () - 2));
1043 else
1044 {
1045 /* Why convert to UTF-32 and implement our own case-folding,
1046 rather than convert to wchar_t and use the platform's
1047 functions? I'm glad you asked.
1048
1049 The main problem is that GNAT implements an unusual rule for
1050 case folding. For ASCII letters, letters in single-byte
1051 encodings (such as ISO-8859-*), and Unicode letters that fit
1052 in a single byte (i.e., code point is <= 0xff), the letter is
1053 folded to lower case. Other Unicode letters are folded to
1054 upper case.
1055
1056 This rule means that the code must be able to examine the
1057 value of the character. And, some hosts do not use Unicode
1058 for wchar_t, so examining the value of such characters is
1059 forbidden. */
1060 auto_obstack storage;
1061 try
1062 {
1065 (const gdb_byte *) name.data (),
1066 name.length (), 1,
1067 &storage, translit_none);
1068 }
1069 catch (const gdb_exception &)
1070 {
1071 if (throw_on_error)
1072 throw;
1073
1074 static bool warned = false;
1075
1076 /* Converting to UTF-32 shouldn't fail, so if it doesn't, we
1077 might like to know why. */
1078 if (!warned)
1079 {
1080 warned = true;
1081 warning (_("could not convert '%s' from the host encoding (%s) to UTF-32.\n"
1082 "This normally should not happen, please file a bug report."),
1083 gdb::to_string (name).c_str (), host_charset ());
1084 }
1085
1086 /* We don't try to recover from errors; just return the
1087 original string. */
1088 fold_storage = gdb::to_string (name);
1089 return fold_storage.c_str ();
1090 }
1091
1092 bool is_utf8 = ada_source_charset == ada_utf8;
1093 uint32_t *chars = (uint32_t *) obstack_base (&storage);
1094 int num_chars = obstack_object_size (&storage) / sizeof (uint32_t);
1095 for (int i = 0; i < num_chars; ++i)
1096 {
1097 const struct utf8_entry *entry = find_case_fold_entry (chars[i]);
1098 if (entry != nullptr)
1099 {
1100 uint32_t low = chars[i] + entry->lower_delta;
1101 if (!is_utf8 || low <= 0xff)
1102 chars[i] = low;
1103 else
1104 chars[i] = chars[i] + entry->upper_delta;
1105 }
1106 }
1107
1108 /* Now convert back to ordinary characters. */
1109 auto_obstack reconverted;
1110 try
1111 {
1113 host_charset (),
1114 (const gdb_byte *) chars,
1115 num_chars * sizeof (uint32_t),
1116 sizeof (uint32_t),
1117 &reconverted,
1119 obstack_1grow (&reconverted, '\0');
1120 fold_storage = std::string ((const char *) obstack_base (&reconverted));
1121 }
1122 catch (const gdb_exception &)
1123 {
1124 if (throw_on_error)
1125 throw;
1126
1127 static bool warned = false;
1128
1129 /* Converting back from UTF-32 shouldn't normally fail, but
1130 there are some host encodings without upper/lower
1131 equivalence. */
1132 if (!warned)
1133 {
1134 warned = true;
1135 warning (_("could not convert the lower-cased variant of '%s'\n"
1136 "from UTF-32 to the host encoding (%s)."),
1137 gdb::to_string (name).c_str (), host_charset ());
1138 }
1139
1140 /* We don't try to recover from errors; just return the
1141 original string. */
1142 fold_storage = gdb::to_string (name);
1143 }
1144 }
1145
1146 return fold_storage.c_str ();
1147}
1148
1149/* The "encoded" form of DECODED, according to GNAT conventions. If
1150 FOLD is true (the default), case-fold any ordinary symbol. Symbols
1151 with <...> quoting are not folded in any case. */
1152
1153std::string
1154ada_encode (const char *decoded, bool fold)
1155{
1156 if (fold && decoded[0] != '<')
1157 decoded = ada_fold_name (decoded);
1158 return ada_encode_1 (decoded, true);
1159}
1160
1161/* Return nonzero if C is either a digit or a lowercase alphabet character. */
1162
1163static int
1164is_lower_alphanum (const char c)
1165{
1166 return (isdigit (c) || (isalpha (c) && islower (c)));
1167}
1168
1169/* ENCODED is the linkage name of a symbol and LEN contains its length.
1170 This function saves in LEN the length of that same symbol name but
1171 without either of these suffixes:
1172 . .{DIGIT}+
1173 . ${DIGIT}+
1174 . ___{DIGIT}+
1175 . __{DIGIT}+.
1176
1177 These are suffixes introduced by the compiler for entities such as
1178 nested subprogram for instance, in order to avoid name clashes.
1179 They do not serve any purpose for the debugger. */
1180
1181static void
1182ada_remove_trailing_digits (const char *encoded, int *len)
1183{
1184 if (*len > 1 && isdigit (encoded[*len - 1]))
1185 {
1186 int i = *len - 2;
1187
1188 while (i > 0 && isdigit (encoded[i]))
1189 i--;
1190 if (i >= 0 && encoded[i] == '.')
1191 *len = i;
1192 else if (i >= 0 && encoded[i] == '$')
1193 *len = i;
1194 else if (i >= 2 && startswith (encoded + i - 2, "___"))
1195 *len = i - 2;
1196 else if (i >= 1 && startswith (encoded + i - 1, "__"))
1197 *len = i - 1;
1198 }
1199}
1200
1201/* Remove the suffix introduced by the compiler for protected object
1202 subprograms. */
1203
1204static void
1205ada_remove_po_subprogram_suffix (const char *encoded, int *len)
1206{
1207 /* Remove trailing N. */
1208
1209 /* Protected entry subprograms are broken into two
1210 separate subprograms: The first one is unprotected, and has
1211 a 'N' suffix; the second is the protected version, and has
1212 the 'P' suffix. The second calls the first one after handling
1213 the protection. Since the P subprograms are internally generated,
1214 we leave these names undecoded, giving the user a clue that this
1215 entity is internal. */
1216
1217 if (*len > 1
1218 && encoded[*len - 1] == 'N'
1219 && (isdigit (encoded[*len - 2]) || islower (encoded[*len - 2])))
1220 *len = *len - 1;
1221}
1222
1223/* If ENCODED ends with a compiler-provided suffix (like ".cold"),
1224 then update *LEN to remove the suffix and return the offset of the
1225 character just past the ".". Otherwise, return -1. */
1226
1227static int
1228remove_compiler_suffix (const char *encoded, int *len)
1229{
1230 int offset = *len - 1;
1231 while (offset > 0 && isalpha (encoded[offset]))
1232 --offset;
1233 if (offset > 0 && encoded[offset] == '.')
1234 {
1235 *len = offset;
1236 return offset + 1;
1237 }
1238 return -1;
1239}
1240
1241/* Convert an ASCII hex string to a number. Reads exactly N
1242 characters from STR. Returns true on success, false if one of the
1243 digits was not a hex digit. */
1244static bool
1245convert_hex (const char *str, int n, uint32_t *out)
1246{
1247 uint32_t result = 0;
1248
1249 for (int i = 0; i < n; ++i)
1250 {
1251 if (!isxdigit (str[i]))
1252 return false;
1253 result <<= 4;
1254 result |= fromhex (str[i]);
1255 }
1256
1257 *out = result;
1258 return true;
1259}
1260
1261/* Convert a wide character from its ASCII hex representation in STR
1262 (consisting of exactly N characters) to the host encoding,
1263 appending the resulting bytes to OUT. If N==2 and the Ada source
1264 charset is not UTF-8, then hex refers to an encoding in the
1265 ADA_SOURCE_CHARSET; otherwise, use UTF-32. Return true on success.
1266 Return false and do not modify OUT on conversion failure. */
1267static bool
1268convert_from_hex_encoded (std::string &out, const char *str, int n)
1269{
1270 uint32_t value;
1271
1272 if (!convert_hex (str, n, &value))
1273 return false;
1274 try
1275 {
1276 auto_obstack bytes;
1277 /* In the 'U' case, the hex digits encode the character in the
1278 Ada source charset. However, if the source charset is UTF-8,
1279 this really means it is a single-byte UTF-32 character. */
1280 if (n == 2 && ada_source_charset != ada_utf8)
1281 {
1282 gdb_byte one_char = (gdb_byte) value;
1283
1285 &one_char,
1286 sizeof (one_char), sizeof (one_char),
1287 &bytes, translit_none);
1288 }
1289 else
1291 (const gdb_byte *) &value,
1292 sizeof (value), sizeof (value),
1293 &bytes, translit_none);
1294 obstack_1grow (&bytes, '\0');
1295 out.append ((const char *) obstack_base (&bytes));
1296 }
1297 catch (const gdb_exception &)
1298 {
1299 /* On failure, the caller will just let the encoded form
1300 through, which seems basically reasonable. */
1301 return false;
1302 }
1303
1304 return true;
1305}
1306
1307/* See ada-lang.h. */
1308
1309std::string
1310ada_decode (const char *encoded, bool wrap, bool operators)
1311{
1312 int i;
1313 int len0;
1314 const char *p;
1315 int at_start_name;
1316 std::string decoded;
1317 int suffix = -1;
1318
1319 /* With function descriptors on PPC64, the value of a symbol named
1320 ".FN", if it exists, is the entry point of the function "FN". */
1321 if (encoded[0] == '.')
1322 encoded += 1;
1323
1324 /* The name of the Ada main procedure starts with "_ada_".
1325 This prefix is not part of the decoded name, so skip this part
1326 if we see this prefix. */
1327 if (startswith (encoded, "_ada_"))
1328 encoded += 5;
1329 /* The "___ghost_" prefix is used for ghost entities. Normally
1330 these aren't preserved but when they are, it's useful to see
1331 them. */
1332 if (startswith (encoded, "___ghost_"))
1333 encoded += 9;
1334
1335 /* If the name starts with '_', then it is not a properly encoded
1336 name, so do not attempt to decode it. Similarly, if the name
1337 starts with '<', the name should not be decoded. */
1338 if (encoded[0] == '_' || encoded[0] == '<')
1339 goto Suppress;
1340
1341 len0 = strlen (encoded);
1342
1343 suffix = remove_compiler_suffix (encoded, &len0);
1344
1345 ada_remove_trailing_digits (encoded, &len0);
1346 ada_remove_po_subprogram_suffix (encoded, &len0);
1347
1348 /* Remove the ___X.* suffix if present. Do not forget to verify that
1349 the suffix is located before the current "end" of ENCODED. We want
1350 to avoid re-matching parts of ENCODED that have previously been
1351 marked as discarded (by decrementing LEN0). */
1352 p = strstr (encoded, "___");
1353 if (p != NULL && p - encoded < len0 - 3)
1354 {
1355 if (p[3] == 'X')
1356 len0 = p - encoded;
1357 else
1358 goto Suppress;
1359 }
1360
1361 /* Remove any trailing TKB suffix. It tells us that this symbol
1362 is for the body of a task, but that information does not actually
1363 appear in the decoded name. */
1364
1365 if (len0 > 3 && startswith (encoded + len0 - 3, "TKB"))
1366 len0 -= 3;
1367
1368 /* Remove any trailing TB suffix. The TB suffix is slightly different
1369 from the TKB suffix because it is used for non-anonymous task
1370 bodies. */
1371
1372 if (len0 > 2 && startswith (encoded + len0 - 2, "TB"))
1373 len0 -= 2;
1374
1375 /* Remove trailing "B" suffixes. */
1376 /* FIXME: brobecker/2006-04-19: Not sure what this are used for... */
1377
1378 if (len0 > 1 && startswith (encoded + len0 - 1, "B"))
1379 len0 -= 1;
1380
1381 /* Remove trailing __{digit}+ or trailing ${digit}+. */
1382
1383 if (len0 > 1 && isdigit (encoded[len0 - 1]))
1384 {
1385 i = len0 - 2;
1386 while ((i >= 0 && isdigit (encoded[i]))
1387 || (i >= 1 && encoded[i] == '_' && isdigit (encoded[i - 1])))
1388 i -= 1;
1389 if (i > 1 && encoded[i] == '_' && encoded[i - 1] == '_')
1390 len0 = i - 1;
1391 else if (encoded[i] == '$')
1392 len0 = i;
1393 }
1394
1395 /* The first few characters that are not alphabetic are not part
1396 of any encoding we use, so we can copy them over verbatim. */
1397
1398 for (i = 0; i < len0 && !isalpha (encoded[i]); i += 1)
1399 decoded.push_back (encoded[i]);
1400
1401 at_start_name = 1;
1402 while (i < len0)
1403 {
1404 /* Is this a symbol function? */
1405 if (operators && at_start_name && encoded[i] == 'O')
1406 {
1407 int k;
1408
1409 for (k = 0; ada_opname_table[k].encoded != NULL; k += 1)
1410 {
1411 int op_len = strlen (ada_opname_table[k].encoded);
1412 if ((strncmp (ada_opname_table[k].encoded + 1, encoded + i + 1,
1413 op_len - 1) == 0)
1414 && !isalnum (encoded[i + op_len]))
1415 {
1416 decoded.append (ada_opname_table[k].decoded);
1417 at_start_name = 0;
1418 i += op_len;
1419 break;
1420 }
1421 }
1422 if (ada_opname_table[k].encoded != NULL)
1423 continue;
1424 }
1425 at_start_name = 0;
1426
1427 /* Replace "TK__" with "__", which will eventually be translated
1428 into "." (just below). */
1429
1430 if (i < len0 - 4 && startswith (encoded + i, "TK__"))
1431 i += 2;
1432
1433 /* Replace "__B_{DIGITS}+__" sequences by "__", which will eventually
1434 be translated into "." (just below). These are internal names
1435 generated for anonymous blocks inside which our symbol is nested. */
1436
1437 if (len0 - i > 5 && encoded [i] == '_' && encoded [i+1] == '_'
1438 && encoded [i+2] == 'B' && encoded [i+3] == '_'
1439 && isdigit (encoded [i+4]))
1440 {
1441 int k = i + 5;
1442
1443 while (k < len0 && isdigit (encoded[k]))
1444 k++; /* Skip any extra digit. */
1445
1446 /* Double-check that the "__B_{DIGITS}+" sequence we found
1447 is indeed followed by "__". */
1448 if (len0 - k > 2 && encoded [k] == '_' && encoded [k+1] == '_')
1449 i = k;
1450 }
1451
1452 /* Remove _E{DIGITS}+[sb] */
1453
1454 /* Just as for protected object subprograms, there are 2 categories
1455 of subprograms created by the compiler for each entry. The first
1456 one implements the actual entry code, and has a suffix following
1457 the convention above; the second one implements the barrier and
1458 uses the same convention as above, except that the 'E' is replaced
1459 by a 'B'.
1460
1461 Just as above, we do not decode the name of barrier functions
1462 to give the user a clue that the code he is debugging has been
1463 internally generated. */
1464
1465 if (len0 - i > 3 && encoded [i] == '_' && encoded[i+1] == 'E'
1466 && isdigit (encoded[i+2]))
1467 {
1468 int k = i + 3;
1469
1470 while (k < len0 && isdigit (encoded[k]))
1471 k++;
1472
1473 if (k < len0
1474 && (encoded[k] == 'b' || encoded[k] == 's'))
1475 {
1476 k++;
1477 /* Just as an extra precaution, make sure that if this
1478 suffix is followed by anything else, it is a '_'.
1479 Otherwise, we matched this sequence by accident. */
1480 if (k == len0
1481 || (k < len0 && encoded[k] == '_'))
1482 i = k;
1483 }
1484 }
1485
1486 /* Remove trailing "N" in [a-z0-9]+N__. The N is added by
1487 the GNAT front-end in protected object subprograms. */
1488
1489 if (i < len0 + 3
1490 && encoded[i] == 'N' && encoded[i+1] == '_' && encoded[i+2] == '_')
1491 {
1492 /* Backtrack a bit up until we reach either the begining of
1493 the encoded name, or "__". Make sure that we only find
1494 digits or lowercase characters. */
1495 const char *ptr = encoded + i - 1;
1496
1497 while (ptr >= encoded && is_lower_alphanum (ptr[0]))
1498 ptr--;
1499 if (ptr < encoded
1500 || (ptr > encoded && ptr[0] == '_' && ptr[-1] == '_'))
1501 i++;
1502 }
1503
1504 if (i < len0 + 3 && encoded[i] == 'U' && isxdigit (encoded[i + 1]))
1505 {
1506 if (convert_from_hex_encoded (decoded, &encoded[i + 1], 2))
1507 {
1508 i += 3;
1509 continue;
1510 }
1511 }
1512 else if (i < len0 + 5 && encoded[i] == 'W' && isxdigit (encoded[i + 1]))
1513 {
1514 if (convert_from_hex_encoded (decoded, &encoded[i + 1], 4))
1515 {
1516 i += 5;
1517 continue;
1518 }
1519 }
1520 else if (i < len0 + 10 && encoded[i] == 'W' && encoded[i + 1] == 'W'
1521 && isxdigit (encoded[i + 2]))
1522 {
1523 if (convert_from_hex_encoded (decoded, &encoded[i + 2], 8))
1524 {
1525 i += 10;
1526 continue;
1527 }
1528 }
1529
1530 if (encoded[i] == 'X' && i != 0 && isalnum (encoded[i - 1]))
1531 {
1532 /* This is a X[bn]* sequence not separated from the previous
1533 part of the name with a non-alpha-numeric character (in other
1534 words, immediately following an alpha-numeric character), then
1535 verify that it is placed at the end of the encoded name. If
1536 not, then the encoding is not valid and we should abort the
1537 decoding. Otherwise, just skip it, it is used in body-nested
1538 package names. */
1539 do
1540 i += 1;
1541 while (i < len0 && (encoded[i] == 'b' || encoded[i] == 'n'));
1542 if (i < len0)
1543 goto Suppress;
1544 }
1545 else if (i < len0 - 2 && encoded[i] == '_' && encoded[i + 1] == '_')
1546 {
1547 /* Replace '__' by '.'. */
1548 decoded.push_back ('.');
1549 at_start_name = 1;
1550 i += 2;
1551 }
1552 else
1553 {
1554 /* It's a character part of the decoded name, so just copy it
1555 over. */
1556 decoded.push_back (encoded[i]);
1557 i += 1;
1558 }
1559 }
1560
1561 /* Decoded names should never contain any uppercase character.
1562 Double-check this, and abort the decoding if we find one. */
1563
1564 if (operators)
1565 {
1566 for (i = 0; i < decoded.length(); ++i)
1567 if (isupper (decoded[i]) || decoded[i] == ' ')
1568 goto Suppress;
1569 }
1570
1571 /* If the compiler added a suffix, append it now. */
1572 if (suffix >= 0)
1573 decoded = decoded + "[" + &encoded[suffix] + "]";
1574
1575 return decoded;
1576
1577Suppress:
1578 if (!wrap)
1579 return {};
1580
1581 if (encoded[0] == '<')
1582 decoded = encoded;
1583 else
1584 decoded = '<' + std::string(encoded) + '>';
1585 return decoded;
1586}
1587
1588/* Table for keeping permanent unique copies of decoded names. Once
1589 allocated, names in this table are never released. While this is a
1590 storage leak, it should not be significant unless there are massive
1591 changes in the set of decoded names in successive versions of a
1592 symbol table loaded during a single session. */
1593static struct htab *decoded_names_store;
1594
1595/* Returns the decoded name of GSYMBOL, as for ada_decode, caching it
1596 in the language-specific part of GSYMBOL, if it has not been
1597 previously computed. Tries to save the decoded name in the same
1598 obstack as GSYMBOL, if possible, and otherwise on the heap (so that,
1599 in any case, the decoded symbol has a lifetime at least that of
1600 GSYMBOL).
1601 The GSYMBOL parameter is "mutable" in the C++ sense: logically
1602 const, but nevertheless modified to a semantically equivalent form
1603 when a decoded name is cached in it. */
1604
1605const char *
1607{
1608 struct general_symbol_info *gsymbol = (struct general_symbol_info *) arg;
1609 const char **resultp =
1611
1612 if (!gsymbol->ada_mangled)
1613 {
1614 std::string decoded = ada_decode (gsymbol->linkage_name ());
1615 struct obstack *obstack = gsymbol->language_specific.obstack;
1616
1617 gsymbol->ada_mangled = 1;
1618
1619 if (obstack != NULL)
1620 *resultp = obstack_strdup (obstack, decoded.c_str ());
1621 else
1622 {
1623 /* Sometimes, we can't find a corresponding objfile, in
1624 which case, we put the result on the heap. Since we only
1625 decode when needed, we hope this usually does not cause a
1626 significant memory leak (FIXME). */
1627
1628 char **slot = (char **) htab_find_slot (decoded_names_store,
1629 decoded.c_str (), INSERT);
1630
1631 if (*slot == NULL)
1632 *slot = xstrdup (decoded.c_str ());
1633 *resultp = *slot;
1634 }
1635 }
1636
1637 return *resultp;
1638}
1639
1640
1641
1642 /* Arrays */
1643
1644/* Assuming that INDEX_DESC_TYPE is an ___XA structure, a structure
1645 generated by the GNAT compiler to describe the index type used
1646 for each dimension of an array, check whether it follows the latest
1647 known encoding. If not, fix it up to conform to the latest encoding.
1648 Otherwise, do nothing. This function also does nothing if
1649 INDEX_DESC_TYPE is NULL.
1650
1651 The GNAT encoding used to describe the array index type evolved a bit.
1652 Initially, the information would be provided through the name of each
1653 field of the structure type only, while the type of these fields was
1654 described as unspecified and irrelevant. The debugger was then expected
1655 to perform a global type lookup using the name of that field in order
1656 to get access to the full index type description. Because these global
1657 lookups can be very expensive, the encoding was later enhanced to make
1658 the global lookup unnecessary by defining the field type as being
1659 the full index type description.
1660
1661 The purpose of this routine is to allow us to support older versions
1662 of the compiler by detecting the use of the older encoding, and by
1663 fixing up the INDEX_DESC_TYPE to follow the new one (at this point,
1664 we essentially replace each field's meaningless type by the associated
1665 index subtype). */
1666
1667void
1668ada_fixup_array_indexes_type (struct type *index_desc_type)
1669{
1670 int i;
1671
1672 if (index_desc_type == NULL)
1673 return;
1674 gdb_assert (index_desc_type->num_fields () > 0);
1675
1676 /* Check if INDEX_DESC_TYPE follows the older encoding (it is sufficient
1677 to check one field only, no need to check them all). If not, return
1678 now.
1679
1680 If our INDEX_DESC_TYPE was generated using the older encoding,
1681 the field type should be a meaningless integer type whose name
1682 is not equal to the field name. */
1683 if (index_desc_type->field (0).type ()->name () != NULL
1684 && strcmp (index_desc_type->field (0).type ()->name (),
1685 index_desc_type->field (0).name ()) == 0)
1686 return;
1687
1688 /* Fixup each field of INDEX_DESC_TYPE. */
1689 for (i = 0; i < index_desc_type->num_fields (); i++)
1690 {
1691 const char *name = index_desc_type->field (i).name ();
1692 struct type *raw_type = ada_check_typedef (ada_find_any_type (name));
1693
1694 if (raw_type)
1695 index_desc_type->field (i).set_type (raw_type);
1696 }
1697}
1698
1699/* The desc_* routines return primitive portions of array descriptors
1700 (fat pointers). */
1701
1702/* The descriptor or array type, if any, indicated by TYPE; removes
1703 level of indirection, if needed. */
1704
1705static struct type *
1707{
1708 if (type == NULL)
1709 return NULL;
1711 if (type->code () == TYPE_CODE_TYPEDEF)
1713
1714 if (type != NULL
1715 && (type->code () == TYPE_CODE_PTR
1716 || type->code () == TYPE_CODE_REF))
1717 return ada_check_typedef (type->target_type ());
1718 else
1719 return type;
1720}
1721
1722/* True iff TYPE indicates a "thin" array pointer type. */
1723
1724static int
1726{
1727 return
1729 || is_suffix (ada_type_name (desc_base_type (type)), "___XUT___XVE");
1730}
1731
1732/* The descriptor type for thin pointer type TYPE. */
1733
1734static struct type *
1736{
1737 struct type *base_type = desc_base_type (type);
1738
1739 if (base_type == NULL)
1740 return NULL;
1741 if (is_suffix (ada_type_name (base_type), "___XVE"))
1742 return base_type;
1743 else
1744 {
1745 struct type *alt_type = ada_find_parallel_type (base_type, "___XVE");
1746
1747 if (alt_type == NULL)
1748 return base_type;
1749 else
1750 return alt_type;
1751 }
1752}
1753
1754/* A pointer to the array data for thin-pointer value VAL. */
1755
1756static struct value *
1758{
1759 struct type *type = ada_check_typedef (value_type (val));
1760 struct type *data_type = desc_data_target_type (thin_descriptor_type (type));
1761
1762 data_type = lookup_pointer_type (data_type);
1763
1764 if (type->code () == TYPE_CODE_PTR)
1765 return value_cast (data_type, value_copy (val));
1766 else
1767 return value_from_longest (data_type, value_address (val));
1768}
1769
1770/* True iff TYPE indicates a "thick" array pointer type. */
1771
1772static int
1774{
1776 return (type != NULL && type->code () == TYPE_CODE_STRUCT
1777 && lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL);
1778}
1779
1780/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
1781 pointer to one, the type of its bounds data; otherwise, NULL. */
1782
1783static struct type *
1785{
1786 struct type *r;
1787
1789
1790 if (type == NULL)
1791 return NULL;
1792 else if (is_thin_pntr (type))
1793 {
1795 if (type == NULL)
1796 return NULL;
1797 r = lookup_struct_elt_type (type, "BOUNDS", 1);
1798 if (r != NULL)
1799 return ada_check_typedef (r);
1800 }
1801 else if (type->code () == TYPE_CODE_STRUCT)
1802 {
1803 r = lookup_struct_elt_type (type, "P_BOUNDS", 1);
1804 if (r != NULL)
1806 }
1807 return NULL;
1808}
1809
1810/* If ARR is an array descriptor (fat or thin pointer), or pointer to
1811 one, a pointer to its bounds data. Otherwise NULL. */
1812
1813static struct value *
1814desc_bounds (struct value *arr)
1815{
1816 struct type *type = ada_check_typedef (value_type (arr));
1817
1818 if (is_thin_pntr (type))
1819 {
1820 struct type *bounds_type =
1822 LONGEST addr;
1823
1824 if (bounds_type == NULL)
1825 error (_("Bad GNAT array descriptor"));
1826
1827 /* NOTE: The following calculation is not really kosher, but
1828 since desc_type is an XVE-encoded type (and shouldn't be),
1829 the correct calculation is a real pain. FIXME (and fix GCC). */
1830 if (type->code () == TYPE_CODE_PTR)
1831 addr = value_as_long (arr);
1832 else
1833 addr = value_address (arr);
1834
1835 return
1837 addr - bounds_type->length ());
1838 }
1839
1840 else if (is_thick_pntr (type))
1841 {
1842 struct value *p_bounds = value_struct_elt (&arr, {}, "P_BOUNDS", NULL,
1843 _("Bad GNAT array descriptor"));
1844 struct type *p_bounds_type = value_type (p_bounds);
1845
1846 if (p_bounds_type
1847 && p_bounds_type->code () == TYPE_CODE_PTR)
1848 {
1849 struct type *target_type = p_bounds_type->target_type ();
1850
1851 if (target_type->is_stub ())
1854 p_bounds);
1855 }
1856 else
1857 error (_("Bad GNAT array descriptor"));
1858
1859 return p_bounds;
1860 }
1861 else
1862 return NULL;
1863}
1864
1865/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1866 position of the field containing the address of the bounds data. */
1867
1868static int
1870{
1871 return desc_base_type (type)->field (1).loc_bitpos ();
1872}
1873
1874/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1875 size of the field containing the address of the bounds data. */
1876
1877static int
1879{
1881
1882 if (TYPE_FIELD_BITSIZE (type, 1) > 0)
1883 return TYPE_FIELD_BITSIZE (type, 1);
1884 else
1885 return 8 * ada_check_typedef (type->field (1).type ())->length ();
1886}
1887
1888/* If TYPE is the type of an array descriptor (fat or thin pointer) or a
1889 pointer to one, the type of its array data (a array-with-no-bounds type);
1890 otherwise, NULL. Use ada_type_of_array to get an array type with bounds
1891 data. */
1892
1893static struct type *
1895{
1897
1898 /* NOTE: The following is bogus; see comment in desc_bounds. */
1899 if (is_thin_pntr (type))
1901 else if (is_thick_pntr (type))
1902 {
1903 struct type *data_type = lookup_struct_elt_type (type, "P_ARRAY", 1);
1904
1905 if (data_type
1906 && ada_check_typedef (data_type)->code () == TYPE_CODE_PTR)
1907 return ada_check_typedef (data_type->target_type ());
1908 }
1909
1910 return NULL;
1911}
1912
1913/* If ARR is an array descriptor (fat or thin pointer), a pointer to
1914 its array data. */
1915
1916static struct value *
1917desc_data (struct value *arr)
1918{
1919 struct type *type = value_type (arr);
1920
1921 if (is_thin_pntr (type))
1922 return thin_data_pntr (arr);
1923 else if (is_thick_pntr (type))
1924 return value_struct_elt (&arr, {}, "P_ARRAY", NULL,
1925 _("Bad GNAT array descriptor"));
1926 else
1927 return NULL;
1928}
1929
1930
1931/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1932 position of the field containing the address of the data. */
1933
1934static int
1936{
1937 return desc_base_type (type)->field (0).loc_bitpos ();
1938}
1939
1940/* If TYPE is the type of an array-descriptor (fat pointer), the bit
1941 size of the field containing the address of the data. */
1942
1943static int
1945{
1947
1948 if (TYPE_FIELD_BITSIZE (type, 0) > 0)
1949 return TYPE_FIELD_BITSIZE (type, 0);
1950 else
1951 return TARGET_CHAR_BIT * type->field (0).type ()->length ();
1952}
1953
1954/* If BOUNDS is an array-bounds structure (or pointer to one), return
1955 the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
1956 bound, if WHICH is 1. The first bound is I=1. */
1957
1958static struct value *
1959desc_one_bound (struct value *bounds, int i, int which)
1960{
1961 char bound_name[20];
1962 xsnprintf (bound_name, sizeof (bound_name), "%cB%d",
1963 which ? 'U' : 'L', i - 1);
1964 return value_struct_elt (&bounds, {}, bound_name, NULL,
1965 _("Bad GNAT array descriptor bounds"));
1966}
1967
1968/* If BOUNDS is an array-bounds structure type, return the bit position
1969 of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
1970 bound, if WHICH is 1. The first bound is I=1. */
1971
1972static int
1973desc_bound_bitpos (struct type *type, int i, int which)
1974{
1975 return desc_base_type (type)->field (2 * i + which - 2).loc_bitpos ();
1976}
1977
1978/* If BOUNDS is an array-bounds structure type, return the bit field size
1979 of the Ith lower bound stored in it, if WHICH is 0, and the Ith upper
1980 bound, if WHICH is 1. The first bound is I=1. */
1981
1982static int
1983desc_bound_bitsize (struct type *type, int i, int which)
1984{
1986
1987 if (TYPE_FIELD_BITSIZE (type, 2 * i + which - 2) > 0)
1988 return TYPE_FIELD_BITSIZE (type, 2 * i + which - 2);
1989 else
1990 return 8 * type->field (2 * i + which - 2).type ()->length ();
1991}
1992
1993/* If TYPE is the type of an array-bounds structure, the type of its
1994 Ith bound (numbering from 1). Otherwise, NULL. */
1995
1996static struct type *
1997desc_index_type (struct type *type, int i)
1998{
2000
2001 if (type->code () == TYPE_CODE_STRUCT)
2002 {
2003 char bound_name[20];
2004 xsnprintf (bound_name, sizeof (bound_name), "LB%d", i - 1);
2005 return lookup_struct_elt_type (type, bound_name, 1);
2006 }
2007 else
2008 return NULL;
2009}
2010
2011/* The number of index positions in the array-bounds type TYPE.
2012 Return 0 if TYPE is NULL. */
2013
2014static int
2016{
2018
2019 if (type != NULL)
2020 return type->num_fields () / 2;
2021 return 0;
2022}
2023
2024/* Non-zero iff TYPE is a simple array type (not a pointer to one) or
2025 an array descriptor type (representing an unconstrained array
2026 type). */
2027
2028static int
2030{
2031 if (type == NULL)
2032 return 0;
2034 return (type->code () == TYPE_CODE_ARRAY
2036}
2037
2038/* Non-zero iff TYPE represents any kind of array in Ada, or a pointer
2039 * to one. */
2040
2041static int
2043{
2044 while (type != NULL
2045 && (type->code () == TYPE_CODE_PTR
2046 || type->code () == TYPE_CODE_REF))
2047 type = type->target_type ();
2049}
2050
2051/* Non-zero iff TYPE is a simple array type or pointer to one. */
2052
2053int
2055{
2056 if (type == NULL)
2057 return 0;
2059 return (type->code () == TYPE_CODE_ARRAY
2060 || (type->code () == TYPE_CODE_PTR
2062 == TYPE_CODE_ARRAY)));
2063}
2064
2065/* Non-zero iff TYPE belongs to a GNAT array descriptor. */
2066
2067int
2069{
2070 struct type *data_type = desc_data_target_type (type);
2071
2072 if (type == NULL)
2073 return 0;
2075 return (data_type != NULL
2076 && data_type->code () == TYPE_CODE_ARRAY
2077 && desc_arity (desc_bounds_type (type)) > 0);
2078}
2079
2080/* Non-zero iff type is a partially mal-formed GNAT array
2081 descriptor. FIXME: This is to compensate for some problems with
2082 debugging output from GNAT. Re-examine periodically to see if it
2083 is still needed. */
2084
2085int
2087{
2088 return
2089 type != NULL
2090 && type->code () == TYPE_CODE_STRUCT
2091 && (lookup_struct_elt_type (type, "P_BOUNDS", 1) != NULL
2092 || lookup_struct_elt_type (type, "P_ARRAY", 1) != NULL)
2094}
2095
2096
2097/* If ARR has a record type in the form of a standard GNAT array descriptor,
2098 (fat pointer) returns the type of the array data described---specifically,
2099 a pointer-to-array type. If BOUNDS is non-zero, the bounds data are filled
2100 in from the descriptor; otherwise, they are left unspecified. If
2101 the ARR denotes a null array descriptor and BOUNDS is non-zero,
2102 returns NULL. The result is simply the type of ARR if ARR is not
2103 a descriptor. */
2104
2105static struct type *
2107{
2110
2112 return value_type (arr);
2113
2114 if (!bounds)
2115 {
2116 struct type *array_type =
2118
2120 TYPE_FIELD_BITSIZE (array_type, 0) =
2122
2123 return array_type;
2124 }
2125 else
2126 {
2127 struct type *elt_type;
2128 int arity;
2129 struct value *descriptor;
2130
2131 elt_type = ada_array_element_type (value_type (arr), -1);
2132 arity = ada_array_arity (value_type (arr));
2133
2134 if (elt_type == NULL || arity == 0)
2135 return ada_check_typedef (value_type (arr));
2136
2137 descriptor = desc_bounds (arr);
2138 if (value_as_long (descriptor) == 0)
2139 return NULL;
2140 while (arity > 0)
2141 {
2142 struct type *range_type = alloc_type_copy (value_type (arr));
2143 struct type *array_type = alloc_type_copy (value_type (arr));
2144 struct value *low = desc_one_bound (descriptor, arity, 0);
2145 struct value *high = desc_one_bound (descriptor, arity, 1);
2146
2147 arity -= 1;
2148 create_static_range_type (range_type, value_type (low),
2150 longest_to_int (value_as_long (high)));
2151 elt_type = create_array_type (array_type, elt_type, range_type);
2152
2154 {
2155 /* We need to store the element packed bitsize, as well as
2156 recompute the array size, because it was previously
2157 computed based on the unpacked element size. */
2158 LONGEST lo = value_as_long (low);
2159 LONGEST hi = value_as_long (high);
2160
2161 TYPE_FIELD_BITSIZE (elt_type, 0) =
2163 /* If the array has no element, then the size is already
2164 zero, and does not need to be recomputed. */
2165 if (lo < hi)
2166 {
2167 int array_bitsize =
2168 (hi - lo + 1) * TYPE_FIELD_BITSIZE (elt_type, 0);
2169
2170 array_type->set_length ((array_bitsize + 7) / 8);
2171 }
2172 }
2173 }
2174
2175 return lookup_pointer_type (elt_type);
2176 }
2177}
2178
2179/* If ARR does not represent an array, returns ARR unchanged.
2180 Otherwise, returns either a standard GDB array with bounds set
2181 appropriately or, if ARR is a non-null fat pointer, a pointer to a standard
2182 GDB array. Returns NULL if ARR is a null fat pointer. */
2183
2184struct value *
2186{
2188 {
2189 struct type *arrType = ada_type_of_array (arr, 1);
2190
2191 if (arrType == NULL)
2192 return NULL;
2193 return value_cast (arrType, value_copy (desc_data (arr)));
2194 }
2197 else
2198 return arr;
2199}
2200
2201/* If ARR does not represent an array, returns ARR unchanged.
2202 Otherwise, returns a standard GDB array describing ARR (which may
2203 be ARR itself if it already is in the proper form). */
2204
2205struct value *
2207{
2209 {
2210 struct value *arrVal = ada_coerce_to_simple_array_ptr (arr);
2211
2212 if (arrVal == NULL)
2213 error (_("Bounds unavailable for null array pointer."));
2214 return value_ind (arrVal);
2215 }
2218 else
2219 return arr;
2220}
2221
2222/* If TYPE represents a GNAT array type, return it translated to an
2223 ordinary GDB array type (possibly with BITSIZE fields indicating
2224 packing). For other types, is the identity. */
2225
2226struct type *
2228{
2231
2234
2235 return type;
2236}
2237
2238/* Non-zero iff TYPE represents a standard GNAT packed-array type. */
2239
2240static int
2242{
2243 if (type == NULL)
2244 return 0;
2247 return
2248 ada_type_name (type) != NULL
2249 && strstr (ada_type_name (type), "___XP") != NULL;
2250}
2251
2252/* Non-zero iff TYPE represents a standard GNAT constrained
2253 packed-array type. */
2254
2255int
2257{
2260}
2261
2262/* Non-zero iff TYPE represents an array descriptor for a
2263 unconstrained packed-array type. */
2264
2265static int
2267{
2269 return 0;
2270
2272 return 1;
2273
2274 /* If we saw GNAT encodings, then the above code is sufficient.
2275 However, with minimal encodings, we will just have a thick
2276 pointer instead. */
2277 if (is_thick_pntr (type))
2278 {
2280 /* The structure's first field is a pointer to an array, so this
2281 fetches the array type. */
2282 type = type->field (0).type ()->target_type ();
2283 if (type->code () == TYPE_CODE_TYPEDEF)
2285 /* Now we can see if the array elements are packed. */
2286 return TYPE_FIELD_BITSIZE (type, 0) > 0;
2287 }
2288
2289 return 0;
2290}
2291
2292/* Return true if TYPE is a (Gnat-encoded) constrained packed array
2293 type, or if it is an ordinary (non-Gnat-encoded) packed array. */
2294
2295static bool
2297{
2299 || (type->code () == TYPE_CODE_ARRAY
2300 && TYPE_FIELD_BITSIZE (type, 0) % 8 != 0));
2301}
2302
2303/* Given that TYPE encodes a packed array type (constrained or unconstrained),
2304 return the size of its elements in bits. */
2305
2306static long
2308{
2309 const char *raw_name;
2310 const char *tail;
2311 long bits;
2312
2313 /* Access to arrays implemented as fat pointers are encoded as a typedef
2314 of the fat pointer type. We need the name of the fat pointer type
2315 to do the decoding, so strip the typedef layer. */
2316 if (type->code () == TYPE_CODE_TYPEDEF)
2318
2319 raw_name = ada_type_name (ada_check_typedef (type));
2320 if (!raw_name)
2321 raw_name = ada_type_name (desc_base_type (type));
2322
2323 if (!raw_name)
2324 return 0;
2325
2326 tail = strstr (raw_name, "___XP");
2327 if (tail == nullptr)
2328 {
2329 gdb_assert (is_thick_pntr (type));
2330 /* The structure's first field is a pointer to an array, so this
2331 fetches the array type. */
2332 type = type->field (0).type ()->target_type ();
2333 /* Now we can see if the array elements are packed. */
2334 return TYPE_FIELD_BITSIZE (type, 0);
2335 }
2336
2337 if (sscanf (tail + sizeof ("___XP") - 1, "%ld", &bits) != 1)
2338 {
2340 (_("could not understand bit size information on packed array"));
2341 return 0;
2342 }
2343
2344 return bits;
2345}
2346
2347/* Given that TYPE is a standard GDB array type with all bounds filled
2348 in, and that the element size of its ultimate scalar constituents
2349 (that is, either its elements, or, if it is an array of arrays, its
2350 elements' elements, etc.) is *ELT_BITS, return an identical type,
2351 but with the bit sizes of its elements (and those of any
2352 constituent arrays) recorded in the BITSIZE components of its
2353 TYPE_FIELD_BITSIZE values, and with *ELT_BITS set to its total size
2354 in bits.
2355
2356 Note that, for arrays whose index type has an XA encoding where
2357 a bound references a record discriminant, getting that discriminant,
2358 and therefore the actual value of that bound, is not possible
2359 because none of the given parameters gives us access to the record.
2360 This function assumes that it is OK in the context where it is being
2361 used to return an array whose bounds are still dynamic and where
2362 the length is arbitrary. */
2363
2364static struct type *
2365constrained_packed_array_type (struct type *type, long *elt_bits)
2366{
2367 struct type *new_elt_type;
2368 struct type *new_type;
2369 struct type *index_type_desc;
2370 struct type *index_type;
2371 LONGEST low_bound, high_bound;
2372
2374 if (type->code () != TYPE_CODE_ARRAY)
2375 return type;
2376
2377 index_type_desc = ada_find_parallel_type (type, "___XA");
2378 if (index_type_desc)
2379 index_type = to_fixed_range_type (index_type_desc->field (0).type (),
2380 NULL);
2381 else
2383
2385 new_elt_type =
2387 elt_bits);
2388 create_array_type (new_type, new_elt_type, index_type);
2389 TYPE_FIELD_BITSIZE (new_type, 0) = *elt_bits;
2391
2392 if ((check_typedef (index_type)->code () == TYPE_CODE_RANGE
2394 || !get_discrete_bounds (index_type, &low_bound, &high_bound))
2395 low_bound = high_bound = 0;
2396 if (high_bound < low_bound)
2397 {
2398 *elt_bits = 0;
2399 new_type->set_length (0);
2400 }
2401 else
2402 {
2403 *elt_bits *= (high_bound - low_bound + 1);
2404 new_type->set_length ((*elt_bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT);
2405 }
2406
2408 return new_type;
2409}
2410
2411/* The array type encoded by TYPE, where
2412 ada_is_constrained_packed_array_type (TYPE). */
2413
2414static struct type *
2416{
2417 const char *raw_name = ada_type_name (ada_check_typedef (type));
2418 char *name;
2419 const char *tail;
2420 struct type *shadow_type;
2421 long bits;
2422
2423 if (!raw_name)
2424 raw_name = ada_type_name (desc_base_type (type));
2425
2426 if (!raw_name)
2427 return NULL;
2428
2429 name = (char *) alloca (strlen (raw_name) + 1);
2430 tail = strstr (raw_name, "___XP");
2432
2433 memcpy (name, raw_name, tail - raw_name);
2434 name[tail - raw_name] = '\000';
2435
2437
2438 if (shadow_type == NULL)
2439 {
2440 lim_warning (_("could not find bounds information on packed array"));
2441 return NULL;
2442 }
2443 shadow_type = check_typedef (shadow_type);
2444
2445 if (shadow_type->code () != TYPE_CODE_ARRAY)
2446 {
2447 lim_warning (_("could not understand bounds "
2448 "information on packed array"));
2449 return NULL;
2450 }
2451
2453 return constrained_packed_array_type (shadow_type, &bits);
2454}
2455
2456/* Helper function for decode_constrained_packed_array. Set the field
2457 bitsize on a series of packed arrays. Returns the number of
2458 elements in TYPE. */
2459
2460static LONGEST
2462{
2463 gdb_assert (type->code () == TYPE_CODE_ARRAY);
2464
2465 LONGEST low, high;
2466 if (!get_discrete_bounds (type->index_type (), &low, &high)
2467 || low > high)
2468 return 0;
2469 LONGEST our_len = high - low + 1;
2470
2471 struct type *elt_type = type->target_type ();
2472 if (elt_type->code () == TYPE_CODE_ARRAY)
2473 {
2474 LONGEST elt_len = recursively_update_array_bitsize (elt_type);
2475 LONGEST elt_bitsize = elt_len * TYPE_FIELD_BITSIZE (elt_type, 0);
2476 TYPE_FIELD_BITSIZE (type, 0) = elt_bitsize;
2477
2478 type->set_length (((our_len * elt_bitsize + HOST_CHAR_BIT - 1)
2479 / HOST_CHAR_BIT));
2480 }
2481
2482 return our_len;
2483}
2484
2485/* Given that ARR is a struct value *indicating a GNAT constrained packed
2486 array, returns a simple array that denotes that array. Its type is a
2487 standard GDB array type except that the BITSIZEs of the array
2488 target types are set to the number of bits in each element, and the
2489 type length is set appropriately. */
2490
2491static struct value *
2493{
2494 struct type *type;
2495
2496 /* If our value is a pointer, then dereference it. Likewise if
2497 the value is a reference. Make sure that this operation does not
2498 cause the target type to be fixed, as this would indirectly cause
2499 this array to be decoded. The rest of the routine assumes that
2500 the array hasn't been decoded yet, so we use the basic "coerce_ref"
2501 and "value_ind" routines to perform the dereferencing, as opposed
2502 to using "ada_coerce_ref" or "ada_value_ind". */
2503 arr = coerce_ref (arr);
2504 if (ada_check_typedef (value_type (arr))->code () == TYPE_CODE_PTR)
2505 arr = value_ind (arr);
2506
2508 if (type == NULL)
2509 {
2510 error (_("can't unpack array"));
2511 return NULL;
2512 }
2513
2514 /* Decoding the packed array type could not correctly set the field
2515 bitsizes for any dimension except the innermost, because the
2516 bounds may be variable and were not passed to that function. So,
2517 we further resolve the array bounds here and then update the
2518 sizes. */
2519 const gdb_byte *valaddr = value_contents_for_printing (arr).data ();
2520 CORE_ADDR address = value_address (arr);
2521 gdb::array_view<const gdb_byte> view
2522 = gdb::make_array_view (valaddr, type->length ());
2523 type = resolve_dynamic_type (type, view, address);
2525
2526 if (type_byte_order (value_type (arr)) == BFD_ENDIAN_BIG
2528 {
2529 /* This is a (right-justified) modular type representing a packed
2530 array with no wrapper. In order to interpret the value through
2531 the (left-justified) packed array type we just built, we must
2532 first left-justify it. */
2533 int bit_size, bit_pos;
2534 ULONGEST mod;
2535
2536 mod = ada_modulus (value_type (arr)) - 1;
2537 bit_size = 0;
2538 while (mod > 0)
2539 {
2540 bit_size += 1;
2541 mod >>= 1;
2542 }
2543 bit_pos = HOST_CHAR_BIT * value_type (arr)->length () - bit_size;
2544 arr = ada_value_primitive_packed_val (arr, NULL,
2545 bit_pos / HOST_CHAR_BIT,
2546 bit_pos % HOST_CHAR_BIT,
2547 bit_size,
2548 type);
2549 }
2550
2551 return coerce_unspec_val_to_type (arr, type);
2552}
2553
2554
2555/* The value of the element of packed array ARR at the ARITY indices
2556 given in IND. ARR must be a simple array. */
2557
2558static struct value *
2559value_subscript_packed (struct value *arr, int arity, struct value **ind)
2560{
2561 int i;
2562 int bits, elt_off, bit_off;
2563 long elt_total_bit_offset;
2564 struct type *elt_type;
2565 struct value *v;
2566
2567 bits = 0;
2568 elt_total_bit_offset = 0;
2569 elt_type = ada_check_typedef (value_type (arr));
2570 for (i = 0; i < arity; i += 1)
2571 {
2572 if (elt_type->code () != TYPE_CODE_ARRAY
2573 || TYPE_FIELD_BITSIZE (elt_type, 0) == 0)
2574 error
2575 (_("attempt to do packed indexing of "
2576 "something other than a packed array"));
2577 else
2578 {
2579 struct type *range_type = elt_type->index_type ();
2580 LONGEST lowerbound, upperbound;
2581 LONGEST idx;
2582
2583 if (!get_discrete_bounds (range_type, &lowerbound, &upperbound))
2584 {
2585 lim_warning (_("don't know bounds of array"));
2586 lowerbound = upperbound = 0;
2587 }
2588
2589 idx = pos_atr (ind[i]);
2590 if (idx < lowerbound || idx > upperbound)
2591 lim_warning (_("packed array index %ld out of bounds"),
2592 (long) idx);
2593 bits = TYPE_FIELD_BITSIZE (elt_type, 0);
2594 elt_total_bit_offset += (idx - lowerbound) * bits;
2595 elt_type = ada_check_typedef (elt_type->target_type ());
2596 }
2597 }
2598 elt_off = elt_total_bit_offset / HOST_CHAR_BIT;
2599 bit_off = elt_total_bit_offset % HOST_CHAR_BIT;
2600
2601 v = ada_value_primitive_packed_val (arr, NULL, elt_off, bit_off,
2602 bits, elt_type);
2603 return v;
2604}
2605
2606/* Non-zero iff TYPE includes negative integer values. */
2607
2608static int
2610{
2611 switch (type->code ())
2612 {
2613 default:
2614 return 0;
2615 case TYPE_CODE_INT:
2616 return !type->is_unsigned ();
2617 case TYPE_CODE_RANGE:
2618 return type->bounds ()->low.const_val () - type->bounds ()->bias < 0;
2619 }
2620}
2621
2622/* With SRC being a buffer containing BIT_SIZE bits of data at BIT_OFFSET,
2623 unpack that data into UNPACKED. UNPACKED_LEN is the size in bytes of
2624 the unpacked buffer.
2625
2626 The size of the unpacked buffer (UNPACKED_LEN) is expected to be large
2627 enough to contain at least BIT_OFFSET bits. If not, an error is raised.
2628
2629 IS_BIG_ENDIAN is nonzero if the data is stored in big endian mode,
2630 zero otherwise.
2631
2632 IS_SIGNED_TYPE is nonzero if the data corresponds to a signed type.
2633
2634 IS_SCALAR is nonzero if the data corresponds to a signed type. */
2635
2636static void
2637ada_unpack_from_contents (const gdb_byte *src, int bit_offset, int bit_size,
2638 gdb_byte *unpacked, int unpacked_len,
2639 int is_big_endian, int is_signed_type,
2640 int is_scalar)
2641{
2642 int src_len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
2643 int src_idx; /* Index into the source area */
2644 int src_bytes_left; /* Number of source bytes left to process. */
2645 int srcBitsLeft; /* Number of source bits left to move */
2646 int unusedLS; /* Number of bits in next significant
2647 byte of source that are unused */
2648
2649 int unpacked_idx; /* Index into the unpacked buffer */
2650 int unpacked_bytes_left; /* Number of bytes left to set in unpacked. */
2651
2652 unsigned long accum; /* Staging area for bits being transferred */
2653 int accumSize; /* Number of meaningful bits in accum */
2654 unsigned char sign;
2655
2656 /* Transmit bytes from least to most significant; delta is the direction
2657 the indices move. */
2658 int delta = is_big_endian ? -1 : 1;
2659
2660 /* Make sure that unpacked is large enough to receive the BIT_SIZE
2661 bits from SRC. .*/
2662 if ((bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT > unpacked_len)
2663 error (_("Cannot unpack %d bits into buffer of %d bytes"),
2664 bit_size, unpacked_len);
2665
2666 srcBitsLeft = bit_size;
2667 src_bytes_left = src_len;
2668 unpacked_bytes_left = unpacked_len;
2669 sign = 0;
2670
2671 if (is_big_endian)
2672 {
2673 src_idx = src_len - 1;
2674 if (is_signed_type
2675 && ((src[0] << bit_offset) & (1 << (HOST_CHAR_BIT - 1))))
2676 sign = ~0;
2677
2678 unusedLS =
2679 (HOST_CHAR_BIT - (bit_size + bit_offset) % HOST_CHAR_BIT)
2680 % HOST_CHAR_BIT;
2681
2682 if (is_scalar)
2683 {
2684 accumSize = 0;
2685 unpacked_idx = unpacked_len - 1;
2686 }
2687 else
2688 {
2689 /* Non-scalar values must be aligned at a byte boundary... */
2690 accumSize =
2691 (HOST_CHAR_BIT - bit_size % HOST_CHAR_BIT) % HOST_CHAR_BIT;
2692 /* ... And are placed at the beginning (most-significant) bytes
2693 of the target. */
2694 unpacked_idx = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT - 1;
2695 unpacked_bytes_left = unpacked_idx + 1;
2696 }
2697 }
2698 else
2699 {
2700 int sign_bit_offset = (bit_size + bit_offset - 1) % 8;
2701
2702 src_idx = unpacked_idx = 0;
2703 unusedLS = bit_offset;
2704 accumSize = 0;
2705
2706 if (is_signed_type && (src[src_len - 1] & (1 << sign_bit_offset)))
2707 sign = ~0;
2708 }
2709
2710 accum = 0;
2711 while (src_bytes_left > 0)
2712 {
2713 /* Mask for removing bits of the next source byte that are not
2714 part of the value. */
2715 unsigned int unusedMSMask =
2716 (1 << (srcBitsLeft >= HOST_CHAR_BIT ? HOST_CHAR_BIT : srcBitsLeft)) -
2717 1;
2718 /* Sign-extend bits for this byte. */
2719 unsigned int signMask = sign & ~unusedMSMask;
2720
2721 accum |=
2722 (((src[src_idx] >> unusedLS) & unusedMSMask) | signMask) << accumSize;
2723 accumSize += HOST_CHAR_BIT - unusedLS;
2724 if (accumSize >= HOST_CHAR_BIT)
2725 {
2726 unpacked[unpacked_idx] = accum & ~(~0UL << HOST_CHAR_BIT);
2727 accumSize -= HOST_CHAR_BIT;
2728 accum >>= HOST_CHAR_BIT;
2729 unpacked_bytes_left -= 1;
2730 unpacked_idx += delta;
2731 }
2732 srcBitsLeft -= HOST_CHAR_BIT - unusedLS;
2733 unusedLS = 0;
2734 src_bytes_left -= 1;
2735 src_idx += delta;
2736 }
2737 while (unpacked_bytes_left > 0)
2738 {
2739 accum |= sign << accumSize;
2740 unpacked[unpacked_idx] = accum & ~(~0UL << HOST_CHAR_BIT);
2741 accumSize -= HOST_CHAR_BIT;
2742 if (accumSize < 0)
2743 accumSize = 0;
2744 accum >>= HOST_CHAR_BIT;
2745 unpacked_bytes_left -= 1;
2746 unpacked_idx += delta;
2747 }
2748}
2749
2750/* Create a new value of type TYPE from the contents of OBJ starting
2751 at byte OFFSET, and bit offset BIT_OFFSET within that byte,
2752 proceeding for BIT_SIZE bits. If OBJ is an lval in memory, then
2753 assigning through the result will set the field fetched from.
2754 VALADDR is ignored unless OBJ is NULL, in which case,
2755 VALADDR+OFFSET must address the start of storage containing the
2756 packed value. The value returned in this case is never an lval.
2757 Assumes 0 <= BIT_OFFSET < HOST_CHAR_BIT. */
2758
2759struct value *
2760ada_value_primitive_packed_val (struct value *obj, const gdb_byte *valaddr,
2761 long offset, int bit_offset, int bit_size,
2762 struct type *type)
2763{
2764 struct value *v;
2765 const gdb_byte *src; /* First byte containing data to unpack */
2766 gdb_byte *unpacked;
2767 const int is_scalar = is_scalar_type (type);
2768 const int is_big_endian = type_byte_order (type) == BFD_ENDIAN_BIG;
2769 gdb::byte_vector staging;
2770
2772
2773 if (obj == NULL)
2774 src = valaddr + offset;
2775 else
2776 src = value_contents (obj).data () + offset;
2777
2778 if (is_dynamic_type (type))
2779 {
2780 /* The length of TYPE might by dynamic, so we need to resolve
2781 TYPE in order to know its actual size, which we then use
2782 to create the contents buffer of the value we return.
2783 The difficulty is that the data containing our object is
2784 packed, and therefore maybe not at a byte boundary. So, what
2785 we do, is unpack the data into a byte-aligned buffer, and then
2786 use that buffer as our object's value for resolving the type. */
2787 int staging_len = (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
2788 staging.resize (staging_len);
2789
2790 ada_unpack_from_contents (src, bit_offset, bit_size,
2791 staging.data (), staging.size (),
2792 is_big_endian, has_negatives (type),
2793 is_scalar);
2794 type = resolve_dynamic_type (type, staging, 0);
2795 if (type->length () < (bit_size + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT)
2796 {
2797 /* This happens when the length of the object is dynamic,
2798 and is actually smaller than the space reserved for it.
2799 For instance, in an array of variant records, the bit_size
2800 we're given is the array stride, which is constant and
2801 normally equal to the maximum size of its element.
2802 But, in reality, each element only actually spans a portion
2803 of that stride. */
2804 bit_size = type->length () * HOST_CHAR_BIT;
2805 }
2806 }
2807
2808 if (obj == NULL)
2809 {
2810 v = allocate_value (type);
2811 src = valaddr + offset;
2812 }
2813 else if (VALUE_LVAL (obj) == lval_memory && value_lazy (obj))
2814 {
2815 int src_len = (bit_size + bit_offset + HOST_CHAR_BIT - 1) / 8;
2816 gdb_byte *buf;
2817
2818 v = value_at (type, value_address (obj) + offset);
2819 buf = (gdb_byte *) alloca (src_len);
2820 read_memory (value_address (v), buf, src_len);
2821 src = buf;
2822 }
2823 else
2824 {
2825 v = allocate_value (type);
2826 src = value_contents (obj).data () + offset;
2827 }
2828
2829 if (obj != NULL)
2830 {
2831 long new_offset = offset;
2832
2834 set_value_bitpos (v, bit_offset + value_bitpos (obj));
2835 set_value_bitsize (v, bit_size);
2836 if (value_bitpos (v) >= HOST_CHAR_BIT)
2837 {
2838 ++new_offset;
2839 set_value_bitpos (v, value_bitpos (v) - HOST_CHAR_BIT);
2840 }
2841 set_value_offset (v, new_offset);
2842
2843 /* Also set the parent value. This is needed when trying to
2844 assign a new value (in inferior memory). */
2845 set_value_parent (v, obj);
2846 }
2847 else
2848 set_value_bitsize (v, bit_size);
2849 unpacked = value_contents_writeable (v).data ();
2850
2851 if (bit_size == 0)
2852 {
2853 memset (unpacked, 0, type->length ());
2854 return v;
2855 }
2856
2857 if (staging.size () == type->length ())
2858 {
2859 /* Small short-cut: If we've unpacked the data into a buffer
2860 of the same size as TYPE's length, then we can reuse that,
2861 instead of doing the unpacking again. */
2862 memcpy (unpacked, staging.data (), staging.size ());
2863 }
2864 else
2865 ada_unpack_from_contents (src, bit_offset, bit_size,
2866 unpacked, type->length (),
2867 is_big_endian, has_negatives (type), is_scalar);
2868
2869 return v;
2870}
2871
2872/* Store the contents of FROMVAL into the location of TOVAL.
2873 Return a new value with the location of TOVAL and contents of
2874 FROMVAL. Handles assignment into packed fields that have
2875 floating-point or non-scalar types. */
2876
2877static struct value *
2878ada_value_assign (struct value *toval, struct value *fromval)
2879{
2880 struct type *type = value_type (toval);
2881 int bits = value_bitsize (toval);
2882
2883 toval = ada_coerce_ref (toval);
2884 fromval = ada_coerce_ref (fromval);
2885
2887 toval = ada_coerce_to_simple_array (toval);
2888 if (ada_is_direct_array_type (value_type (fromval)))
2889 fromval = ada_coerce_to_simple_array (fromval);
2890
2891 if (!deprecated_value_modifiable (toval))
2892 error (_("Left operand of assignment is not a modifiable lvalue."));
2893
2894 if (VALUE_LVAL (toval) == lval_memory
2895 && bits > 0
2896 && (type->code () == TYPE_CODE_FLT
2897 || type->code () == TYPE_CODE_STRUCT))
2898 {
2899 int len = (value_bitpos (toval)
2900 + bits + HOST_CHAR_BIT - 1) / HOST_CHAR_BIT;
2901 int from_size;
2902 gdb_byte *buffer = (gdb_byte *) alloca (len);
2903 struct value *val;
2904 CORE_ADDR to_addr = value_address (toval);
2905
2906 if (type->code () == TYPE_CODE_FLT)
2907 fromval = value_cast (type, fromval);
2908
2909 read_memory (to_addr, buffer, len);
2910 from_size = value_bitsize (fromval);
2911 if (from_size == 0)
2912 from_size = value_type (fromval)->length () * TARGET_CHAR_BIT;
2913
2914 const int is_big_endian = type_byte_order (type) == BFD_ENDIAN_BIG;
2915 ULONGEST from_offset = 0;
2916 if (is_big_endian && is_scalar_type (value_type (fromval)))
2917 from_offset = from_size - bits;
2918 copy_bitwise (buffer, value_bitpos (toval),
2919 value_contents (fromval).data (), from_offset,
2920 bits, is_big_endian);
2921 write_memory_with_notification (to_addr, buffer, len);
2922
2923 val = value_copy (toval);
2924 memcpy (value_contents_raw (val).data (),
2925 value_contents (fromval).data (),
2926 type->length ());
2928
2929 return val;
2930 }
2931
2932 return value_assign (toval, fromval);
2933}
2934
2935
2936/* Given that COMPONENT is a memory lvalue that is part of the lvalue
2937 CONTAINER, assign the contents of VAL to COMPONENTS's place in
2938 CONTAINER. Modifies the VALUE_CONTENTS of CONTAINER only, not
2939 COMPONENT, and not the inferior's memory. The current contents
2940 of COMPONENT are ignored.
2941
2942 Although not part of the initial design, this function also works
2943 when CONTAINER and COMPONENT are not_lval's: it works as if CONTAINER
2944 had a null address, and COMPONENT had an address which is equal to
2945 its offset inside CONTAINER. */
2946
2947static void
2948value_assign_to_component (struct value *container, struct value *component,
2949 struct value *val)
2950{
2951 LONGEST offset_in_container =
2952 (LONGEST) (value_address (component) - value_address (container));
2953 int bit_offset_in_container =
2954 value_bitpos (component) - value_bitpos (container);
2955 int bits;
2956
2957 val = value_cast (value_type (component), val);
2958
2959 if (value_bitsize (component) == 0)
2960 bits = TARGET_CHAR_BIT * value_type (component)->length ();
2961 else
2962 bits = value_bitsize (component);
2963
2964 if (type_byte_order (value_type (container)) == BFD_ENDIAN_BIG)
2965 {
2966 int src_offset;
2967
2968 if (is_scalar_type (check_typedef (value_type (component))))
2969 src_offset
2970 = value_type (component)->length () * TARGET_CHAR_BIT - bits;
2971 else
2972 src_offset = 0;
2973 copy_bitwise ((value_contents_writeable (container).data ()
2974 + offset_in_container),
2975 value_bitpos (container) + bit_offset_in_container,
2976 value_contents (val).data (), src_offset, bits, 1);
2977 }
2978 else
2979 copy_bitwise ((value_contents_writeable (container).data ()
2980 + offset_in_container),
2981 value_bitpos (container) + bit_offset_in_container,
2982 value_contents (val).data (), 0, bits, 0);
2983}
2984
2985/* Determine if TYPE is an access to an unconstrained array. */
2986
2987bool
2989{
2990 return (type->code () == TYPE_CODE_TYPEDEF
2992}
2993
2994/* The value of the element of array ARR at the ARITY indices given in IND.
2995 ARR may be either a simple array, GNAT array descriptor, or pointer
2996 thereto. */
2997
2998struct value *
2999ada_value_subscript (struct value *arr, int arity, struct value **ind)
3000{
3001 int k;
3002 struct value *elt;
3003 struct type *elt_type;
3004
3005 elt = ada_coerce_to_simple_array (arr);
3006
3007 elt_type = ada_check_typedef (value_type (elt));
3008 if (elt_type->code () == TYPE_CODE_ARRAY
3009 && TYPE_FIELD_BITSIZE (elt_type, 0) > 0)
3010 return value_subscript_packed (elt, arity, ind);
3011
3012 for (k = 0; k < arity; k += 1)
3013 {
3014 struct type *saved_elt_type = elt_type->target_type ();
3015
3016 if (elt_type->code () != TYPE_CODE_ARRAY)
3017 error (_("too many subscripts (%d expected)"), k);
3018
3019 elt = value_subscript (elt, pos_atr (ind[k]));
3020
3021 if (ada_is_access_to_unconstrained_array (saved_elt_type)
3022 && value_type (elt)->code () != TYPE_CODE_TYPEDEF)
3023 {
3024 /* The element is a typedef to an unconstrained array,
3025 except that the value_subscript call stripped the
3026 typedef layer. The typedef layer is GNAT's way to
3027 specify that the element is, at the source level, an
3028 access to the unconstrained array, rather than the
3029 unconstrained array. So, we need to restore that
3030 typedef layer, which we can do by forcing the element's
3031 type back to its original type. Otherwise, the returned
3032 value is going to be printed as the array, rather
3033 than as an access. Another symptom of the same issue
3034 would be that an expression trying to dereference the
3035 element would also be improperly rejected. */
3036 deprecated_set_value_type (elt, saved_elt_type);
3037 }
3038
3039 elt_type = ada_check_typedef (value_type (elt));
3040 }
3041
3042 return elt;
3043}
3044
3045/* Assuming ARR is a pointer to a GDB array, the value of the element
3046 of *ARR at the ARITY indices given in IND.
3047 Does not read the entire array into memory.
3048
3049 Note: Unlike what one would expect, this function is used instead of
3050 ada_value_subscript for basically all non-packed array types. The reason
3051 for this is that a side effect of doing our own pointer arithmetics instead
3052 of relying on value_subscript is that there is no implicit typedef peeling.
3053 This is important for arrays of array accesses, where it allows us to
3054 preserve the fact that the array's element is an array access, where the
3055 access part os encoded in a typedef layer. */
3056
3057static struct value *
3058ada_value_ptr_subscript (struct value *arr, int arity, struct value **ind)
3059{
3060 int k;
3061 struct value *array_ind = ada_value_ind (arr);
3062 struct type *type
3063 = check_typedef (value_enclosing_type (array_ind));
3064
3065 if (type->code () == TYPE_CODE_ARRAY
3066 && TYPE_FIELD_BITSIZE (type, 0) > 0)
3067 return value_subscript_packed (array_ind, arity, ind);
3068
3069 for (k = 0; k < arity; k += 1)
3070 {
3071 LONGEST lwb, upb;
3072
3073 if (type->code () != TYPE_CODE_ARRAY)
3074 error (_("too many subscripts (%d expected)"), k);
3076 value_copy (arr));
3077 get_discrete_bounds (type->index_type (), &lwb, &upb);
3078 arr = value_ptradd (arr, pos_atr (ind[k]) - lwb);
3079 type = type->target_type ();
3080 }
3081
3082 return value_ind (arr);
3083}
3084
3085/* Given that ARRAY_PTR is a pointer or reference to an array of type TYPE (the
3086 actual type of ARRAY_PTR is ignored), returns the Ada slice of
3087 HIGH'Pos-LOW'Pos+1 elements starting at index LOW. The lower bound of
3088 this array is LOW, as per Ada rules. */
3089static struct value *
3090ada_value_slice_from_ptr (struct value *array_ptr, struct type *type,
3091 int low, int high)
3092{
3093 struct type *type0 = ada_check_typedef (type);
3094 struct type *base_index_type = type0->index_type ()->target_type ();
3095 struct type *index_type
3096 = create_static_range_type (NULL, base_index_type, low, high);
3097 struct type *slice_type = create_array_type_with_stride
3098 (NULL, type0->target_type (), index_type,
3100 TYPE_FIELD_BITSIZE (type0, 0));
3101 int base_low = ada_discrete_type_low_bound (type0->index_type ());
3102 gdb::optional<LONGEST> base_low_pos, low_pos;
3103 CORE_ADDR base;
3104
3105 low_pos = discrete_position (base_index_type, low);
3106 base_low_pos = discrete_position (base_index_type, base_low);
3107
3108 if (!low_pos.has_value () || !base_low_pos.has_value ())
3109 {
3110 warning (_("unable to get positions in slice, use bounds instead"));
3111 low_pos = low;
3112 base_low_pos = base_low;
3113 }
3114
3115 ULONGEST stride = TYPE_FIELD_BITSIZE (slice_type, 0) / 8;
3116 if (stride == 0)
3117 stride = type0->target_type ()->length ();
3118
3119 base = value_as_address (array_ptr) + (*low_pos - *base_low_pos) * stride;
3120 return value_at_lazy (slice_type, base);
3121}
3122
3123
3124static struct value *
3125ada_value_slice (struct value *array, int low, int high)
3126{
3127 struct type *type = ada_check_typedef (value_type (array));
3128 struct type *base_index_type = type->index_type ()->target_type ();
3129 struct type *index_type
3130 = create_static_range_type (NULL, type->index_type (), low, high);
3131 struct type *slice_type = create_array_type_with_stride
3132 (NULL, type->target_type (), index_type,
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 (LONGEST) - 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
3320 (LONGEST) (which == 0
3323}
3324
3325/* Given that arr is an array value, returns the lower bound of the
3326 nth index (numbering from 1) if WHICH is 0, and the upper bound if
3327 WHICH is 1. This routine will also work for arrays with bounds
3328 supplied by run-time quantities other than discriminants. */
3329
3330static LONGEST
3331ada_array_bound (struct value *arr, int n, int which)
3332{
3333 struct type *arr_type;
3334
3335 if (check_typedef (value_type (arr))->code () == TYPE_CODE_PTR)
3336 arr = value_ind (arr);
3337 arr_type = value_enclosing_type (arr);
3338
3340 return ada_array_bound (decode_constrained_packed_array (arr), n, which);
3341 else if (ada_is_simple_array_type (arr_type))
3342 return ada_array_bound_from_type (arr_type, n, which);
3343 else
3344 return value_as_long (desc_one_bound (desc_bounds (arr), n, which));
3345}
3346
3347/* Given that arr is an array value, returns the length of the
3348 nth index. This routine will also work for arrays with bounds
3349 supplied by run-time quantities other than discriminants.
3350 Does not work for arrays indexed by enumeration types with representation
3351 clauses at the moment. */
3352
3353static LONGEST
3354ada_array_length (struct value *arr, int n)
3355{
3356 struct type *arr_type, *index_type;
3357 int low, high;
3358
3359 if (check_typedef (value_type (arr))->code () == TYPE_CODE_PTR)
3360 arr = value_ind (arr);
3361 arr_type = value_enclosing_type (arr);
3362
3365
3366 if (ada_is_simple_array_type (arr_type))
3367 {
3368 low = ada_array_bound_from_type (arr_type, n, 0);
3369 high = ada_array_bound_from_type (arr_type, n, 1);
3370 }
3371 else
3372 {
3373 low = value_as_long (desc_one_bound (desc_bounds (arr), n, 0));
3374 high = value_as_long (desc_one_bound (desc_bounds (arr), n, 1));
3375 }
3376
3377 arr_type = check_typedef (arr_type);
3378 index_type = ada_index_type (arr_type, n, "length");
3379 if (index_type != NULL)
3380 {
3381 struct type *base_type;
3382 if (index_type->code () == TYPE_CODE_RANGE)
3383 base_type = index_type->target_type ();
3384 else
3385 base_type = index_type;
3386
3387 low = pos_atr (value_from_longest (base_type, low));
3388 high = pos_atr (value_from_longest (base_type, high));
3389 }
3390 return high - low + 1;
3391}
3392
3393/* An array whose type is that of ARR_TYPE (an array type), with
3394 bounds LOW to HIGH, but whose contents are unimportant. If HIGH is
3395 less than LOW, then LOW-1 is used. */
3396
3397static struct value *
3398empty_array (struct type *arr_type, int low, int high)
3399{
3400 struct type *arr_type0 = ada_check_typedef (arr_type);
3401 struct type *index_type
3403 (NULL, 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 allocate_value (create_array_type (NULL, 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 for (int i = 0; i < syms.size (); ++i)
3807 {
3808 /* We already know the name matches, so we're just looking for
3809 an element of the correct enum type. */
3810 if (ada_check_typedef (syms[i].symbol->type ()) == context_type)
3811 return i;
3812 }
3813
3814 error (_("No name '%s' in enumeration type '%s'"), name,
3815 ada_type_name (context_type));
3816}
3817
3818/* See ada-lang.h. */
3819
3821ada_resolve_variable (struct symbol *sym, const struct block *block,
3822 struct type *context_type,
3823 bool parse_completion,
3824 int deprocedure_p,
3825 innermost_block_tracker *tracker)
3826{
3827 std::vector<struct block_symbol> candidates
3829
3830 if (std::any_of (candidates.begin (),
3831 candidates.end (),
3832 [] (block_symbol &bsym)
3833 {
3834 switch (bsym.symbol->aclass ())
3835 {
3836 case LOC_REGISTER:
3837 case LOC_ARG:
3838 case LOC_REF_ARG:
3839 case LOC_REGPARM_ADDR:
3840 case LOC_LOCAL:
3841 case LOC_COMPUTED:
3842 return true;
3843 default:
3844 return false;
3845 }
3846 }))
3847 {
3848 /* Types tend to get re-introduced locally, so if there
3849 are any local symbols that are not types, first filter
3850 out all types. */
3851 candidates.erase
3852 (std::remove_if
3853 (candidates.begin (),
3854 candidates.end (),
3855 [] (block_symbol &bsym)
3856 {
3857 return bsym.symbol->aclass () == LOC_TYPEDEF;
3858 }),
3859 candidates.end ());
3860 }
3861
3862 /* Filter out artificial symbols. */
3863 candidates.erase
3864 (std::remove_if
3865 (candidates.begin (),
3866 candidates.end (),
3867 [] (block_symbol &bsym)
3868 {
3869 return bsym.symbol->is_artificial ();
3870 }),
3871 candidates.end ());
3872
3873 int i;
3874 if (candidates.empty ())
3875 error (_("No definition found for %s"), sym->print_name ());
3876 else if (candidates.size () == 1)
3877 i = 0;
3878 else if (context_type != nullptr
3879 && context_type->code () == TYPE_CODE_ENUM)
3880 i = ada_resolve_enum (candidates, sym->linkage_name (), context_type,
3881 parse_completion);
3882 else if (deprocedure_p && !is_nonfunction (candidates))
3883 {
3885 (candidates, NULL, 0,
3886 sym->linkage_name (),
3887 context_type, parse_completion);
3888 if (i < 0)
3889 error (_("Could not find a match for %s"), sym->print_name ());
3890 }
3891 else
3892 {
3893 gdb_printf (_("Multiple matches for %s\n"), sym->print_name ());
3894 user_select_syms (candidates.data (), candidates.size (), 1);
3895 i = 0;
3896 }
3897
3898 tracker->update (candidates[i]);
3899 return candidates[i];
3900}
3901
3902/* Return non-zero if formal type FTYPE matches actual type ATYPE. */
3903/* The term "match" here is rather loose. The match is heuristic and
3904 liberal. */
3905
3906static int
3907ada_type_match (struct type *ftype, struct type *atype)
3908{
3909 ftype = ada_check_typedef (ftype);
3910 atype = ada_check_typedef (atype);
3911
3912 if (ftype->code () == TYPE_CODE_REF)
3913 ftype = ftype->target_type ();
3914 if (atype->code () == TYPE_CODE_REF)
3915 atype = atype->target_type ();
3916
3917 switch (ftype->code ())
3918 {
3919 default:
3920 return ftype->code () == atype->code ();
3921 case TYPE_CODE_PTR:
3922 if (atype->code () != TYPE_CODE_PTR)
3923 return 0;
3924 atype = atype->target_type ();
3925 /* This can only happen if the actual argument is 'null'. */
3926 if (atype->code () == TYPE_CODE_INT && atype->length () == 0)
3927 return 1;
3928 return ada_type_match (ftype->target_type (), atype);
3929 case TYPE_CODE_INT:
3930 case TYPE_CODE_ENUM:
3931 case TYPE_CODE_RANGE:
3932 switch (atype->code ())
3933 {
3934 case TYPE_CODE_INT:
3935 case TYPE_CODE_ENUM:
3936 case TYPE_CODE_RANGE:
3937 return 1;
3938 default:
3939 return 0;
3940 }
3941
3942 case TYPE_CODE_ARRAY:
3943 return (atype->code () == TYPE_CODE_ARRAY
3944 || ada_is_array_descriptor_type (atype));
3945
3946 case TYPE_CODE_STRUCT:
3947 if (ada_is_array_descriptor_type (ftype))
3948 return (atype->code () == TYPE_CODE_ARRAY
3949 || ada_is_array_descriptor_type (atype));
3950 else
3951 return (atype->code () == TYPE_CODE_STRUCT
3952 && !ada_is_array_descriptor_type (atype));
3953
3954 case TYPE_CODE_UNION:
3955 case TYPE_CODE_FLT:
3956 return (atype->code () == ftype->code ());
3957 }
3958}
3959
3960/* Return non-zero if the formals of FUNC "sufficiently match" the
3961 vector of actual argument types ACTUALS of size N_ACTUALS. FUNC
3962 may also be an enumeral, in which case it is treated as a 0-
3963 argument function. */
3964
3965static int
3966ada_args_match (struct symbol *func, struct value **actuals, int n_actuals)
3967{
3968 int i;
3969 struct type *func_type = func->type ();
3970
3971 if (func->aclass () == LOC_CONST
3972 && func_type->code () == TYPE_CODE_ENUM)
3973 return (n_actuals == 0);
3974 else if (func_type == NULL || func_type->code () != TYPE_CODE_FUNC)
3975 return 0;
3976
3977 if (func_type->num_fields () != n_actuals)
3978 return 0;
3979
3980 for (i = 0; i < n_actuals; i += 1)
3981 {
3982 if (actuals[i] == NULL)
3983 return 0;
3984 else
3985 {
3986 struct type *ftype = ada_check_typedef (func_type->field (i).type ());
3987 struct type *atype = ada_check_typedef (value_type (actuals[i]));
3988
3989 if (!ada_type_match (ftype, atype))
3990 return 0;
3991 }
3992 }
3993 return 1;
3994}
3995
3996/* False iff function type FUNC_TYPE definitely does not produce a value
3997 compatible with type CONTEXT_TYPE. Conservatively returns 1 if
3998 FUNC_TYPE is not a valid function type with a non-null return type
3999 or an enumerated type. A null CONTEXT_TYPE indicates any non-void type. */
4000
4001static int
4002return_match (struct type *func_type, struct type *context_type)
4003{
4004 struct type *return_type;
4005
4006 if (func_type == NULL)
4007 return 1;
4008
4009 if (func_type->code () == TYPE_CODE_FUNC)
4010 return_type = get_base_type (func_type->target_type ());
4011 else
4012 return_type = get_base_type (func_type);
4013 if (return_type == NULL)
4014 return 1;
4015
4016 context_type = get_base_type (context_type);
4017
4018 if (return_type->code () == TYPE_CODE_ENUM)
4019 return context_type == NULL || return_type == context_type;
4020 else if (context_type == NULL)
4021 return return_type->code () != TYPE_CODE_VOID;
4022 else
4023 return return_type->code () == context_type->code ();
4024}
4025
4026
4027/* Returns the index in SYMS that contains the symbol for the
4028 function (if any) that matches the types of the NARGS arguments in
4029 ARGS. If CONTEXT_TYPE is non-null and there is at least one match
4030 that returns that type, then eliminate matches that don't. If
4031 CONTEXT_TYPE is void and there is at least one match that does not
4032 return void, eliminate all matches that do.
4033
4034 Asks the user if there is more than one match remaining. Returns -1
4035 if there is no such symbol or none is selected. NAME is used
4036 solely for messages. May re-arrange and modify SYMS in
4037 the process; the index returned is for the modified vector. */
4038
4039static int
4040ada_resolve_function (std::vector<struct block_symbol> &syms,
4041 struct value **args, int nargs,
4042 const char *name, struct type *context_type,
4043 bool parse_completion)
4044{
4045 int fallback;
4046 int k;
4047 int m; /* Number of hits */
4048
4049 m = 0;
4050 /* In the first pass of the loop, we only accept functions matching
4051 context_type. If none are found, we add a second pass of the loop
4052 where every function is accepted. */
4053 for (fallback = 0; m == 0 && fallback < 2; fallback++)
4054 {
4055 for (k = 0; k < syms.size (); k += 1)
4056 {
4057 struct type *type = ada_check_typedef (syms[k].symbol->type ());
4058
4059 if (ada_args_match (syms[k].symbol, args, nargs)
4060 && (fallback || return_match (type, context_type)))
4061 {
4062 syms[m] = syms[k];
4063 m += 1;
4064 }
4065 }
4066 }
4067
4068 /* If we got multiple matches, ask the user which one to use. Don't do this
4069 interactive thing during completion, though, as the purpose of the
4070 completion is providing a list of all possible matches. Prompting the
4071 user to filter it down would be completely unexpected in this case. */
4072 if (m == 0)
4073 return -1;
4074 else if (m > 1 && !parse_completion)
4075 {
4076 gdb_printf (_("Multiple matches for %s\n"), name);
4077 user_select_syms (syms.data (), m, 1);
4078 return 0;
4079 }
4080 return 0;
4081}
4082
4083/* Type-class predicates */
4084
4085/* True iff TYPE is numeric (i.e., an INT, RANGE (of numeric type),
4086 or FLOAT). */
4087
4088static int
4090{
4091 if (type == NULL)
4092 return 0;
4093 else
4094 {
4095 switch (type->code ())
4096 {
4097 case TYPE_CODE_INT:
4098 case TYPE_CODE_FLT:
4099 case TYPE_CODE_FIXED_POINT:
4100 return 1;
4101 case TYPE_CODE_RANGE:
4102 return (type == type->target_type ()
4104 default:
4105 return 0;
4106 }
4107 }
4108}
4109
4110/* True iff TYPE is integral (an INT or RANGE of INTs). */
4111
4112static int
4114{
4115 if (type == NULL)
4116 return 0;
4117 else
4118 {
4119 switch (type->code ())
4120 {
4121 case TYPE_CODE_INT:
4122 return 1;
4123 case TYPE_CODE_RANGE:
4124 return (type == type->target_type ()
4126 default:
4127 return 0;
4128 }
4129 }
4130}
4131
4132/* True iff TYPE is scalar (INT, RANGE, FLOAT, ENUM). */
4133
4134static int
4136{
4137 if (type == NULL)
4138 return 0;
4139 else
4140 {
4141 switch (type->code ())
4142 {
4143 case TYPE_CODE_INT:
4144 case TYPE_CODE_RANGE:
4145 case TYPE_CODE_ENUM:
4146 case TYPE_CODE_FLT:
4147 case TYPE_CODE_FIXED_POINT:
4148 return 1;
4149 default:
4150 return 0;
4151 }
4152 }
4153}
4154
4155/* True iff TYPE is discrete, as defined in the Ada Reference Manual.
4156 This essentially means one of (INT, RANGE, ENUM) -- but note that
4157 "enum" includes character and boolean as well. */
4158
4159static int
4161{
4162 if (type == NULL)
4163 return 0;
4164 else
4165 {
4166 switch (type->code ())
4167 {
4168 case TYPE_CODE_INT:
4169 case TYPE_CODE_RANGE:
4170 case TYPE_CODE_ENUM:
4171 case TYPE_CODE_BOOL:
4172 case TYPE_CODE_CHAR:
4173 return 1;
4174 default:
4175 return 0;
4176 }
4177 }
4178}
4179
4180/* Returns non-zero if OP with operands in the vector ARGS could be
4181 a user-defined function. Errs on the side of pre-defined operators
4182 (i.e., result 0). */
4183
4184static int
4186{
4187 struct type *type0 =
4188 (args[0] == NULL) ? NULL : ada_check_typedef (value_type (args[0]));
4189 struct type *type1 =
4190 (args[1] == NULL) ? NULL : ada_check_typedef (value_type (args[1]));
4191
4192 if (type0 == NULL)
4193 return 0;
4194
4195 switch (op)
4196 {
4197 default:
4198 return 0;
4199
4200 case BINOP_ADD:
4201 case BINOP_SUB:
4202 case BINOP_MUL:
4203 case BINOP_DIV:
4204 return (!(numeric_type_p (type0) && numeric_type_p (type1)));
4205
4206 case BINOP_REM:
4207 case BINOP_MOD:
4208 case BINOP_BITWISE_AND:
4209 case BINOP_BITWISE_IOR:
4210 case BINOP_BITWISE_XOR:
4211 return (!(integer_type_p (type0) && integer_type_p (type1)));
4212
4213 case BINOP_EQUAL:
4214 case BINOP_NOTEQUAL:
4215 case BINOP_LESS:
4216 case BINOP_GTR:
4217 case BINOP_LEQ:
4218 case BINOP_GEQ:
4219 return (!(scalar_type_p (type0) && scalar_type_p (type1)));
4220
4221 case BINOP_CONCAT:
4222 return !ada_is_array_type (type0) || !ada_is_array_type (type1);
4223
4224 case BINOP_EXP:
4225 return (!(numeric_type_p (type0) && integer_type_p (type1)));
4226
4227 case UNOP_NEG:
4228 case UNOP_PLUS:
4229 case UNOP_LOGICAL_NOT:
4230 case UNOP_ABS:
4231 return (!numeric_type_p (type0));
4232
4233 }
4234}
4235
4236 /* Renaming */
4237
4238/* NOTES:
4239
4240 1. In the following, we assume that a renaming type's name may
4241 have an ___XD suffix. It would be nice if this went away at some
4242 point.
4243 2. We handle both the (old) purely type-based representation of
4244 renamings and the (new) variable-based encoding. At some point,
4245 it is devoutly to be hoped that the former goes away
4246 (FIXME: hilfinger-2007-07-09).
4247 3. Subprogram renamings are not implemented, although the XRS
4248 suffix is recognized (FIXME: hilfinger-2007-07-09). */
4249
4250/* If SYM encodes a renaming,
4251
4252 <renaming> renames <renamed entity>,
4253
4254 sets *LEN to the length of the renamed entity's name,
4255 *RENAMED_ENTITY to that name (not null-terminated), and *RENAMING_EXPR to
4256 the string describing the subcomponent selected from the renamed
4257 entity. Returns ADA_NOT_RENAMING if SYM does not encode a renaming
4258 (in which case, the values of *RENAMED_ENTITY, *LEN, and *RENAMING_EXPR
4259 are undefined). Otherwise, returns a value indicating the category
4260 of entity renamed: an object (ADA_OBJECT_RENAMING), exception
4261 (ADA_EXCEPTION_RENAMING), package (ADA_PACKAGE_RENAMING), or
4262 subprogram (ADA_SUBPROGRAM_RENAMING). Does no allocation; the
4263 strings returned in *RENAMED_ENTITY and *RENAMING_EXPR should not be
4264 deallocated. The values of RENAMED_ENTITY, LEN, or RENAMING_EXPR
4265 may be NULL, in which case they are not assigned.
4266
4267 [Currently, however, GCC does not generate subprogram renamings.] */
4268
4271 const char **renamed_entity, int *len,
4272 const char **renaming_expr)
4273{
4274 enum ada_renaming_category kind;
4275 const char *info;
4276 const char *suffix;
4277
4278 if (sym == NULL)
4279 return ADA_NOT_RENAMING;
4280 switch (sym->aclass ())
4281 {
4282 default:
4283 return ADA_NOT_RENAMING;
4284 case LOC_LOCAL:
4285 case LOC_STATIC:
4286 case LOC_COMPUTED:
4287 case LOC_OPTIMIZED_OUT:
4288 info = strstr (sym->linkage_name (), "___XR");
4289 if (info == NULL)
4290 return ADA_NOT_RENAMING;
4291 switch (info[5])
4292 {
4293 case '_':
4294 kind = ADA_OBJECT_RENAMING;
4295 info += 6;
4296 break;
4297 case 'E':
4299 info += 7;
4300 break;
4301 case 'P':
4302 kind = ADA_PACKAGE_RENAMING;
4303 info += 7;
4304 break;
4305 case 'S':
4307 info += 7;
4308 break;
4309 default:
4310 return ADA_NOT_RENAMING;
4311 }
4312 }
4313
4314 if (renamed_entity != NULL)
4315 *renamed_entity = info;
4316 suffix = strstr (info, "___XE");
4317 if (suffix == NULL || suffix == info)
4318 return ADA_NOT_RENAMING;
4319 if (len != NULL)
4320 *len = strlen (info) - strlen (suffix);
4321 suffix += 5;
4322 if (renaming_expr != NULL)
4323 *renaming_expr = suffix;
4324 return kind;
4325}
4326
4327/* Compute the value of the given RENAMING_SYM, which is expected to
4328 be a symbol encoding a renaming expression. BLOCK is the block
4329 used to evaluate the renaming. */
4330
4331static struct value *
4333 const struct block *block)
4334{
4335 const char *sym_name;
4336
4337 sym_name = renaming_sym->linkage_name ();
4338 expression_up expr = parse_exp_1 (&sym_name, 0, block, 0);
4339 return evaluate_expression (expr.get ());
4340}
4341
4342
4343 /* Evaluation: Function Calls */
4344
4345/* Return an lvalue containing the value VAL. This is the identity on
4346 lvalues, and otherwise has the side-effect of allocating memory
4347 in the inferior where a copy of the value contents is copied. */
4348
4349static struct value *
4350ensure_lval (struct value *val)
4351{
4352 if (VALUE_LVAL (val) == not_lval
4353 || VALUE_LVAL (val) == lval_internalvar)
4354 {
4355 int len = ada_check_typedef (value_type (val))->length ();
4356 const CORE_ADDR addr =
4358
4359 VALUE_LVAL (val) = lval_memory;
4360 set_value_address (val, addr);
4361 write_memory (addr, value_contents (val).data (), len);
4362 }
4363
4364 return val;
4365}
4366
4367/* Given ARG, a value of type (pointer or reference to a)*
4368 structure/union, extract the component named NAME from the ultimate
4369 target structure/union and return it as a value with its
4370 appropriate type.
4371
4372 The routine searches for NAME among all members of the structure itself
4373 and (recursively) among all members of any wrapper members
4374 (e.g., '_parent').
4375
4376 If NO_ERR, then simply return NULL in case of error, rather than
4377 calling error. */
4378
4379static struct value *
4380ada_value_struct_elt (struct value *arg, const char *name, int no_err)
4381{
4382 struct type *t, *t1;
4383 struct value *v;
4384 int check_tag;
4385
4386 v = NULL;
4387 t1 = t = ada_check_typedef (value_type (arg));
4388 if (t->code () == TYPE_CODE_REF)
4389 {
4390 t1 = t->target_type ();
4391 if (t1 == NULL)
4392 goto BadValue;
4393 t1 = ada_check_typedef (t1);
4394 if (t1->code () == TYPE_CODE_PTR)
4395 {
4396 arg = coerce_ref (arg);
4397 t = t1;
4398 }
4399 }
4400
4401 while (t->code () == TYPE_CODE_PTR)
4402 {
4403 t1 = t->target_type ();
4404 if (t1 == NULL)
4405 goto BadValue;
4406 t1 = ada_check_typedef (t1);
4407 if (t1->code () == TYPE_CODE_PTR)
4408 {
4409 arg = value_ind (arg);
4410 t = t1;
4411 }
4412 else
4413 break;
4414 }
4415
4416 if (t1->code () != TYPE_CODE_STRUCT && t1->code () != TYPE_CODE_UNION)
4417 goto BadValue;
4418
4419 if (t1 == t)
4420 v = ada_search_struct_field (name, arg, 0, t);
4421 else
4422 {
4423 int bit_offset, bit_size, byte_offset;
4424 struct type *field_type;
4425 CORE_ADDR address;
4426
4427 if (t->code () == TYPE_CODE_PTR)
4428 address = value_address (ada_value_ind (arg));
4429 else
4430 address = value_address (ada_coerce_ref (arg));
4431
4432 /* Check to see if this is a tagged type. We also need to handle
4433 the case where the type is a reference to a tagged type, but
4434 we have to be careful to exclude pointers to tagged types.
4435 The latter should be shown as usual (as a pointer), whereas
4436 a reference should mostly be transparent to the user. */
4437
4438 if (ada_is_tagged_type (t1, 0)
4439 || (t1->code () == TYPE_CODE_REF
4440 && ada_is_tagged_type (t1->target_type (), 0)))
4441 {
4442 /* We first try to find the searched field in the current type.
4443 If not found then let's look in the fixed type. */
4444
4445 if (!find_struct_field (name, t1, 0,
4446 nullptr, nullptr, nullptr,
4447 nullptr, nullptr))
4448 check_tag = 1;
4449 else
4450 check_tag = 0;
4451 }
4452 else
4453 check_tag = 0;
4454
4455 /* Convert to fixed type in all cases, so that we have proper
4456 offsets to each field in unconstrained record types. */
4457 t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
4458 address, NULL, check_tag);
4459
4460 /* Resolve the dynamic type as well. */
4461 arg = value_from_contents_and_address (t1, nullptr, address);
4462 t1 = value_type (arg);
4463
4464 if (find_struct_field (name, t1, 0,
4465 &field_type, &byte_offset, &bit_offset,
4466 &bit_size, NULL))
4467 {
4468 if (bit_size != 0)
4469 {
4470 if (t->code () == TYPE_CODE_REF)
4471 arg = ada_coerce_ref (arg);
4472 else
4473 arg = ada_value_ind (arg);
4474 v = ada_value_primitive_packed_val (arg, NULL, byte_offset,
4476 field_type);
4477 }
4478 else
4479 v = value_at_lazy (field_type, address + byte_offset);
4480 }
4481 }
4482
4483 if (v != NULL || no_err)
4484 return v;
4485 else
4486 error (_("There is no member named %s."), name);
4487
4488 BadValue:
4489 if (no_err)
4490 return NULL;
4491 else
4492 error (_("Attempt to extract a component of "
4493 "a value that is not a record."));
4494}
4495
4496/* Return the value ACTUAL, converted to be an appropriate value for a
4497 formal of type FORMAL_TYPE. Use *SP as a stack pointer for
4498 allocating any necessary descriptors (fat pointers), or copies of
4499 values not residing in memory, updating it as needed. */
4500
4501struct value *
4502ada_convert_actual (struct value *actual, struct type *formal_type0)
4503{
4504 struct type *actual_type = ada_check_typedef (value_type (actual));
4505 struct type *formal_type = ada_check_typedef (formal_type0);
4506 struct type *formal_target =
4507 formal_type->code () == TYPE_CODE_PTR
4508 ? ada_check_typedef (formal_type->target_type ()) : formal_type;
4509 struct type *actual_target =
4510 actual_type->code () == TYPE_CODE_PTR
4511 ? ada_check_typedef (actual_type->target_type ()) : actual_type;
4512
4513 if (ada_is_array_descriptor_type (formal_target)
4514 && actual_target->code () == TYPE_CODE_ARRAY)
4515 return make_array_descriptor (formal_type, actual);
4516 else if (formal_type->code () == TYPE_CODE_PTR
4517 || formal_type->code () == TYPE_CODE_REF)
4518 {
4519 struct value *result;
4520
4521 if (formal_target->code () == TYPE_CODE_ARRAY
4522 && ada_is_array_descriptor_type (actual_target))
4523 result = desc_data (actual);
4524 else if (formal_type->code () != TYPE_CODE_PTR)
4525 {
4526 if (VALUE_LVAL (actual) != lval_memory)
4527 {
4528 struct value *val;
4529
4530 actual_type = ada_check_typedef (value_type (actual));
4531 val = allocate_value (actual_type);
4532 copy (value_contents (actual), value_contents_raw (val));
4533 actual = ensure_lval (val);
4534 }
4535 result = value_addr (actual);
4536 }
4537 else
4538 return actual;
4539 return value_cast_pointers (formal_type, result, 0);
4540 }
4541 else if (actual_type->code () == TYPE_CODE_PTR)
4542 return ada_value_ind (actual);
4543 else if (ada_is_aligner_type (formal_type))
4544 {
4545 /* We need to turn this parameter into an aligner type
4546 as well. */
4547 struct value *aligner = allocate_value (formal_type);
4548 struct value *component = ada_value_struct_elt (aligner, "F", 0);
4549
4550 value_assign_to_component (aligner, component, actual);
4551 return aligner;
4552 }
4553
4554 return actual;
4555}
4556
4557/* Convert VALUE (which must be an address) to a CORE_ADDR that is a pointer of
4558 type TYPE. This is usually an inefficient no-op except on some targets
4559 (such as AVR) where the representation of a pointer and an address
4560 differs. */
4561
4562static CORE_ADDR
4564{
4565 unsigned len = type->length ();
4566 gdb_byte *buf = (gdb_byte *) alloca (len);
4567 CORE_ADDR addr;
4568
4569 addr = value_address (value);
4570 gdbarch_address_to_pointer (type->arch (), type, buf, addr);
4571 addr = extract_unsigned_integer (buf, len, type_byte_order (type));
4572 return addr;
4573}
4574
4575
4576/* Push a descriptor of type TYPE for array value ARR on the stack at
4577 *SP, updating *SP to reflect the new descriptor. Return either
4578 an lvalue representing the new descriptor, or (if TYPE is a pointer-
4579 to-descriptor type rather than a descriptor type), a struct value *
4580 representing a pointer to this descriptor. */
4581
4582static struct value *
4583make_array_descriptor (struct type *type, struct value *arr)
4584{
4585 struct type *bounds_type = desc_bounds_type (type);
4586 struct type *desc_type = desc_base_type (type);
4587 struct value *descriptor = allocate_value (desc_type);
4588 struct value *bounds = allocate_value (bounds_type);
4589 int i;
4590
4591 for (i = ada_array_arity (ada_check_typedef (value_type (arr)));
4592 i > 0; i -= 1)
4593 {
4594 modify_field (value_type (bounds),
4595 value_contents_writeable (bounds).data (),
4596 ada_array_bound (arr, i, 0),
4597 desc_bound_bitpos (bounds_type, i, 0),
4598 desc_bound_bitsize (bounds_type, i, 0));
4599 modify_field (value_type (bounds),
4600 value_contents_writeable (bounds).data (),
4601 ada_array_bound (arr, i, 1),
4602 desc_bound_bitpos (bounds_type, i, 1),
4603 desc_bound_bitsize (bounds_type, i, 1));
4604 }
4605
4606 bounds = ensure_lval (bounds);
4607
4608 modify_field (value_type (descriptor),
4609 value_contents_writeable (descriptor).data (),
4611 desc_type->field (0).type ()),
4612 fat_pntr_data_bitpos (desc_type),
4613 fat_pntr_data_bitsize (desc_type));
4614
4615 modify_field (value_type (descriptor),
4616 value_contents_writeable (descriptor).data (),
4617 value_pointer (bounds,
4618 desc_type->field (1).type ()),
4619 fat_pntr_bounds_bitpos (desc_type),
4620 fat_pntr_bounds_bitsize (desc_type));
4621
4622 descriptor = ensure_lval (descriptor);
4623
4624 if (type->code () == TYPE_CODE_PTR)
4625 return value_addr (descriptor);
4626 else
4627 return descriptor;
4628}
4629
4630 /* Symbol Cache Module */
4631
4632/* Performance measurements made as of 2010-01-15 indicate that
4633 this cache does bring some noticeable improvements. Depending
4634 on the type of entity being printed, the cache can make it as much
4635 as an order of magnitude faster than without it.
4636
4637 The descriptive type DWARF extension has significantly reduced
4638 the need for this cache, at least when DWARF is being used. However,
4639 even in this case, some expensive name-based symbol searches are still
4640 sometimes necessary - to find an XVZ variable, mostly. */
4641
4642/* Return the symbol cache associated to the given program space PSPACE.
4643 If not allocated for this PSPACE yet, allocate and initialize one. */
4644
4645static struct ada_symbol_cache *
4647{
4648 struct ada_pspace_data *pspace_data = get_ada_pspace_data (pspace);
4649
4650 if (pspace_data->sym_cache == nullptr)
4651 pspace_data->sym_cache.reset (new ada_symbol_cache);
4652
4653 return pspace_data->sym_cache.get ();
4654}
4655
4656/* Clear all entries from the symbol cache. */
4657
4658static void
4660{
4661 struct ada_pspace_data *pspace_data
4663
4664 if (pspace_data->sym_cache != nullptr)
4665 pspace_data->sym_cache.reset ();
4666}
4667
4668/* Search our cache for an entry matching NAME and DOMAIN.
4669 Return it if found, or NULL otherwise. */
4670
4671static struct cache_entry **
4673{
4674 struct ada_symbol_cache *sym_cache
4676 int h = msymbol_hash (name) % HASH_SIZE;
4677 struct cache_entry **e;
4678
4679 for (e = &sym_cache->root[h]; *e != NULL; e = &(*e)->next)
4680 {
4681 if (domain == (*e)->domain && strcmp (name, (*e)->name) == 0)
4682 return e;
4683 }
4684 return NULL;
4685}
4686
4687/* Search the symbol cache for an entry matching NAME and DOMAIN.
4688 Return 1 if found, 0 otherwise.
4689
4690 If an entry was found and SYM is not NULL, set *SYM to the entry's
4691 SYM. Same principle for BLOCK if not NULL. */
4692
4693static int
4695 struct symbol **sym, const struct block **block)
4696{
4697 struct cache_entry **e = find_entry (name, domain);
4698
4699 if (e == NULL)
4700 return 0;
4701 if (sym != NULL)
4702 *sym = (*e)->sym;
4703 if (block != NULL)
4704 *block = (*e)->block;
4705 return 1;
4706}
4707
4708/* Assuming that (SYM, BLOCK) is the result of the lookup of NAME
4709 in domain DOMAIN, save this result in our symbol cache. */
4710
4711static void
4713 const struct block *block)
4714{
4715 struct ada_symbol_cache *sym_cache
4717 int h;
4718 struct cache_entry *e;
4719
4720 /* Symbols for builtin types don't have a block.
4721 For now don't cache such symbols. */
4722 if (sym != NULL && !sym->is_objfile_owned ())
4723 return;
4724
4725 /* If the symbol is a local symbol, then do not cache it, as a search
4726 for that symbol depends on the context. To determine whether
4727 the symbol is local or not, we check the block where we found it
4728 against the global and static blocks of its associated symtab. */
4729 if (sym != nullptr)
4730 {
4731 const blockvector &bv = *sym->symtab ()->compunit ()->blockvector ();
4732
4733 if (bv.global_block () != block && bv.static_block () != block)
4734 return;
4735 }
4736
4737 h = msymbol_hash (name) % HASH_SIZE;
4738 e = XOBNEW (&sym_cache->cache_space, cache_entry);
4739 e->next = sym_cache->root[h];
4740 sym_cache->root[h] = e;
4741 e->name = obstack_strdup (&sym_cache->cache_space, name);
4742 e->sym = sym;
4743 e->domain = domain;
4744 e->block = block;
4745}
4746
4747 /* Symbol Lookup */
4748
4749/* Return the symbol name match type that should be used used when
4750 searching for all symbols matching LOOKUP_NAME.
4751
4752 LOOKUP_NAME is expected to be a symbol name after transformation
4753 for Ada lookups. */
4754
4756name_match_type_from_name (const char *lookup_name)
4757{
4758 return (strstr (lookup_name, "__") == NULL
4761}
4762
4763/* Return the result of a standard (literal, C-like) lookup of NAME in
4764 given DOMAIN, visible from lexical block BLOCK. */
4765
4766static struct symbol *
4767standard_lookup (const char *name, const struct block *block,
4769{
4770 /* Initialize it just to avoid a GCC false warning. */
4771 struct block_symbol sym = {};
4772
4773 if (lookup_cached_symbol (name, domain, &sym.symbol, NULL))
4774 return sym.symbol;
4775 ada_lookup_encoded_symbol (name, block, domain, &sym);
4776 cache_symbol (name, domain, sym.symbol, sym.block);
4777 return sym.symbol;
4778}
4779
4780
4781/* Non-zero iff there is at least one non-function/non-enumeral symbol
4782 in the symbol fields of SYMS. We treat enumerals as functions,
4783 since they contend in overloading in the same way. */
4784static int
4785is_nonfunction (const std::vector<struct block_symbol> &syms)
4786{
4787 for (const block_symbol &sym : syms)
4788 if (sym.symbol->type ()->code () != TYPE_CODE_FUNC
4789 && (sym.symbol->type ()->code () != TYPE_CODE_ENUM
4790 || sym.symbol->aclass () != LOC_CONST))
4791 return 1;
4792
4793 return 0;
4794}
4795
4796/* If true (non-zero), then TYPE0 and TYPE1 represent equivalent
4797 struct types. Otherwise, they may not. */
4798
4799static int
4800equiv_types (struct type *type0, struct type *type1)
4801{
4802 if (type0 == type1)
4803 return 1;
4804 if (type0 == NULL || type1 == NULL
4805 || type0->code () != type1->code ())
4806 return 0;
4807 if ((type0->code () == TYPE_CODE_STRUCT
4808 || type0->code () == TYPE_CODE_ENUM)
4809 && ada_type_name (type0) != NULL && ada_type_name (type1) != NULL
4810 && strcmp (ada_type_name (type0), ada_type_name (type1)) == 0)
4811 return 1;
4812
4813 return 0;
4814}
4815
4816/* True iff SYM0 represents the same entity as SYM1, or one that is
4817 no more defined than that of SYM1. */
4818
4819static int
4820lesseq_defined_than (struct symbol *sym0, struct symbol *sym1)
4821{
4822 if (sym0 == sym1)
4823 return 1;
4824 if (sym0->domain () != sym1->domain ()
4825 || sym0->aclass () != sym1->aclass ())
4826 return 0;
4827
4828 switch (sym0->aclass ())
4829 {
4830 case LOC_UNDEF:
4831 return 1;
4832 case LOC_TYPEDEF:
4833 {
4834 struct type *type0 = sym0->type ();
4835 struct type *type1 = sym1->type ();
4836 const char *name0 = sym0->linkage_name ();
4837 const char *name1 = sym1->linkage_name ();
4838 int len0 = strlen (name0);
4839
4840 return
4841 type0->code () == type1->code ()
4842 && (equiv_types (type0, type1)
4843 || (len0 < strlen (name1) && strncmp (name0, name1, len0) == 0
4844 && startswith (name1 + len0, "___XV")));
4845 }
4846 case LOC_CONST:
4847 return sym0->value_longest () == sym1->value_longest ()
4848 && equiv_types (sym0->type (), sym1->type ());
4849
4850 case LOC_STATIC:
4851 {
4852 const char *name0 = sym0->linkage_name ();
4853 const char *name1 = sym1->linkage_name ();
4854 return (strcmp (name0, name1) == 0
4855 && sym0->value_address () == sym1->value_address ());
4856 }
4857
4858 default:
4859 return 0;
4860 }
4861}
4862
4863/* Append (SYM,BLOCK) to the end of the array of struct block_symbol
4864 records in RESULT. Do nothing if SYM is a duplicate. */
4865
4866static void
4867add_defn_to_vec (std::vector<struct block_symbol> &result,
4868 struct symbol *sym,
4869 const struct block *block)
4870{
4871 /* Do not try to complete stub types, as the debugger is probably
4872 already scanning all symbols matching a certain name at the
4873 time when this function is called. Trying to replace the stub
4874 type by its associated full type will cause us to restart a scan
4875 which may lead to an infinite recursion. Instead, the client
4876 collecting the matching symbols will end up collecting several
4877 matches, with at least one of them complete. It can then filter
4878 out the stub ones if needed. */
4879
4880 for (int i = result.size () - 1; i >= 0; i -= 1)
4881 {
4882 if (lesseq_defined_than (sym, result[i].symbol))
4883 return;
4884 else if (lesseq_defined_than (result[i].symbol, sym))
4885 {
4886 result[i].symbol = sym;
4887 result[i].block = block;
4888 return;
4889 }
4890 }
4891
4892 struct block_symbol info;
4893 info.symbol = sym;
4894 info.block = block;
4895 result.push_back (info);
4896}
4897
4898/* Return a bound minimal symbol matching NAME according to Ada
4899 decoding rules. Returns an invalid symbol if there is no such
4900 minimal symbol. Names prefixed with "standard__" are handled
4901 specially: "standard__" is first stripped off, and only static and
4902 global symbols are searched. */
4903
4906{
4907 struct bound_minimal_symbol result;
4908
4910 lookup_name_info lookup_name (name, match_type);
4911
4912 symbol_name_matcher_ftype *match_name
4913 = ada_get_symbol_name_matcher (lookup_name);
4914
4916 (objfile != NULL ? objfile->arch () : target_gdbarch (),
4917 [&result, lookup_name, match_name] (struct objfile *obj)
4918 {
4919 for (minimal_symbol *msymbol : obj->msymbols ())
4920 {
4921 if (match_name (msymbol->linkage_name (), lookup_name, nullptr)
4922 && msymbol->type () != mst_solib_trampoline)
4923 {
4924 result.minsym = msymbol;
4925 result.objfile = obj;
4926 return 1;
4927 }
4928 }
4929
4930 return 0;
4931 }, objfile);
4932
4933 return result;
4934}
4935
4936/* True if TYPE is definitely an artificial type supplied to a symbol
4937 for which no debugging information was given in the symbol file. */
4938
4939static int
4941{
4942 const char *name = ada_type_name (type);
4943
4944 return (name != NULL && strcmp (name, "<variable, no debug info>") == 0);
4945}
4946
4947/* Return nonzero if TYPE1 and TYPE2 are two enumeration types
4948 that are deemed "identical" for practical purposes.
4949
4950 This function assumes that TYPE1 and TYPE2 are both TYPE_CODE_ENUM
4951 types and that their number of enumerals is identical (in other
4952 words, type1->num_fields () == type2->num_fields ()). */
4953
4954static int
4955ada_identical_enum_types_p (struct type *type1, struct type *type2)
4956{
4957 int i;
4958
4959 /* The heuristic we use here is fairly conservative. We consider
4960 that 2 enumerate types are identical if they have the same
4961 number of enumerals and that all enumerals have the same
4962 underlying value and name. */
4963
4964 /* All enums in the type should have an identical underlying value. */
4965 for (i = 0; i < type1->num_fields (); i++)
4966 if (type1->field (i).loc_enumval () != type2->field (i).loc_enumval ())
4967 return 0;
4968
4969 /* All enumerals should also have the same name (modulo any numerical
4970 suffix). */
4971 for (i = 0; i < type1->num_fields (); i++)
4972 {
4973 const char *name_1 = type1->field (i).name ();
4974 const char *name_2 = type2->field (i).name ();
4975 int len_1 = strlen (name_1);
4976 int len_2 = strlen (name_2);
4977
4978 ada_remove_trailing_digits (type1->field (i).name (), &len_1);
4979 ada_remove_trailing_digits (type2->field (i).name (), &len_2);
4980 if (len_1 != len_2
4981 || strncmp (type1->field (i).name (),
4982 type2->field (i).name (),
4983 len_1) != 0)
4984 return 0;
4985 }
4986
4987 return 1;
4988}
4989
4990/* Return nonzero if all the symbols in SYMS are all enumeral symbols
4991 that are deemed "identical" for practical purposes. Sometimes,
4992 enumerals are not strictly identical, but their types are so similar
4993 that they can be considered identical.
4994
4995 For instance, consider the following code:
4996
4997 type Color is (Black, Red, Green, Blue, White);
4998 type RGB_Color is new Color range Red .. Blue;
4999
5000 Type RGB_Color is a subrange of an implicit type which is a copy
5001 of type Color. If we call that implicit type RGB_ColorB ("B" is
5002 for "Base Type"), then type RGB_ColorB is a copy of type Color.
5003 As a result, when an expression references any of the enumeral
5004 by name (Eg. "print green"), the expression is technically
5005 ambiguous and the user should be asked to disambiguate. But
5006 doing so would only hinder the user, since it wouldn't matter
5007 what choice he makes, the outcome would always be the same.
5008 So, for practical purposes, we consider them as the same. */
5009
5010static int
5011symbols_are_identical_enums (const std::vector<struct block_symbol> &syms)
5012{
5013 int i;
5014
5015 /* Before performing a thorough comparison check of each type,
5016 we perform a series of inexpensive checks. We expect that these
5017 checks will quickly fail in the vast majority of cases, and thus
5018 help prevent the unnecessary use of a more expensive comparison.
5019 Said comparison also expects us to make some of these checks
5020 (see ada_identical_enum_types_p). */
5021
5022 /* Quick check: All symbols should have an enum type. */
5023 for (i = 0; i < syms.size (); i++)
5024 if (syms[i].symbol->type ()->code () != TYPE_CODE_ENUM)
5025 return 0;
5026
5027 /* Quick check: They should all have the same value. */
5028 for (i = 1; i < syms.size (); i++)
5029 if (syms[i].symbol->value_longest () != syms[0].symbol->value_longest ())
5030 return 0;
5031
5032 /* Quick check: They should all have the same number of enumerals. */
5033 for (i = 1; i < syms.size (); i++)
5034 if (syms[i].symbol->type ()->num_fields ()
5035 != syms[0].symbol->type ()->num_fields ())
5036 return 0;
5037
5038 /* All the sanity checks passed, so we might have a set of
5039 identical enumeration types. Perform a more complete
5040 comparison of the type of each symbol. */
5041 for (i = 1; i < syms.size (); i++)
5042 if (!ada_identical_enum_types_p (syms[i].symbol->type (),
5043 syms[0].symbol->type ()))
5044 return 0;
5045
5046 return 1;
5047}
5048
5049/* Remove any non-debugging symbols in SYMS that definitely
5050 duplicate other symbols in the list (The only case I know of where
5051 this happens is when object files containing stabs-in-ecoff are
5052 linked with files containing ordinary ecoff debugging symbols (or no
5053 debugging symbols)). Modifies SYMS to squeeze out deleted entries. */
5054
5055static void
5056remove_extra_symbols (std::vector<struct block_symbol> *syms)
5057{
5058 int i, j;
5059
5060 /* We should never be called with less than 2 symbols, as there
5061 cannot be any extra symbol in that case. But it's easy to
5062 handle, since we have nothing to do in that case. */
5063 if (syms->size () < 2)
5064 return;
5065
5066 i = 0;
5067 while (i < syms->size ())
5068 {
5069 int remove_p = 0;
5070
5071 /* If two symbols have the same name and one of them is a stub type,
5072 the get rid of the stub. */
5073
5074 if ((*syms)[i].symbol->type ()->is_stub ()
5075 && (*syms)[i].symbol->linkage_name () != NULL)
5076 {
5077 for (j = 0; j < syms->size (); j++)
5078 {
5079 if (j != i
5080 && !(*syms)[j].symbol->type ()->is_stub ()
5081 && (*syms)[j].symbol->linkage_name () != NULL
5082 && strcmp ((*syms)[i].symbol->linkage_name (),
5083 (*syms)[j].symbol->linkage_name ()) == 0)
5084 remove_p = 1;
5085 }
5086 }
5087
5088 /* Two symbols with the same name, same class and same address
5089 should be identical. */
5090
5091 else if ((*syms)[i].symbol->linkage_name () != NULL
5092 && (*syms)[i].symbol->aclass () == LOC_STATIC
5093 && is_nondebugging_type ((*syms)[i].symbol->type ()))
5094 {
5095 for (j = 0; j < syms->size (); j += 1)
5096 {
5097 if (i != j
5098 && (*syms)[j].symbol->linkage_name () != NULL
5099 && strcmp ((*syms)[i].symbol->linkage_name (),
5100 (*syms)[j].symbol->linkage_name ()) == 0
5101 && ((*syms)[i].symbol->aclass ()
5102 == (*syms)[j].symbol->aclass ())
5103 && (*syms)[i].symbol->value_address ()
5104 == (*syms)[j].symbol->value_address ())
5105 remove_p = 1;
5106 }
5107 }
5108
5109 if (remove_p)
5110 syms->erase (syms->begin () + i);
5111 else
5112 i += 1;
5113 }
5114
5115 /* If all the remaining symbols are identical enumerals, then
5116 just keep the first one and discard the rest.
5117
5118 Unlike what we did previously, we do not discard any entry
5119 unless they are ALL identical. This is because the symbol
5120 comparison is not a strict comparison, but rather a practical
5121 comparison. If all symbols are considered identical, then
5122 we can just go ahead and use the first one and discard the rest.
5123 But if we cannot reduce the list to a single element, we have
5124 to ask the user to disambiguate anyways. And if we have to
5125 present a multiple-choice menu, it's less confusing if the list
5126 isn't missing some choices that were identical and yet distinct. */
5127 if (symbols_are_identical_enums (*syms))
5128 syms->resize (1);
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 = block_linkage_function (current_block);
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)
5394 block);
5395 found_sym = false;
5396 arg_sym = NULL;
5397 }
5398 else
5399 {
5400 if (sym->aclass () == LOC_UNRESOLVED)
5401 return true;
5402 else if (sym->is_argument ())
5403 arg_sym = sym;
5404 else
5405 {
5406 found_sym = true;
5409 block);
5410 }
5411 }
5412 return true;
5413}
5414
5415/* Helper for add_nonlocal_symbols. Find symbols in DOMAIN which are
5416 targeted by renamings matching LOOKUP_NAME in BLOCK. Add these
5417 symbols to RESULT. Return whether we found such symbols. */
5418
5419static int
5420ada_add_block_renamings (std::vector<struct block_symbol> &result,
5421 const struct block *block,
5422 const lookup_name_info &lookup_name,
5424{
5425 struct using_direct *renaming;
5426 int defns_mark = result.size ();
5427
5428 symbol_name_matcher_ftype *name_match
5429 = ada_get_symbol_name_matcher (lookup_name);
5430
5431 for (renaming = block_using (block);
5432 renaming != NULL;
5433 renaming = renaming->next)
5434 {
5435 const char *r_name;
5436
5437 /* Avoid infinite recursions: skip this renaming if we are actually
5438 already traversing it.
5439
5440 Currently, symbol lookup in Ada don't use the namespace machinery from
5441 C++/Fortran support: skip namespace imports that use them. */
5442 if (renaming->searched
5443 || (renaming->import_src != NULL
5444 && renaming->import_src[0] != '\0')
5445 || (renaming->import_dest != NULL
5446 && renaming->import_dest[0] != '\0'))
5447 continue;
5448 renaming->searched = 1;
5449
5450 /* TODO: here, we perform another name-based symbol lookup, which can
5451 pull its own multiple overloads. In theory, we should be able to do
5452 better in this case since, in DWARF, DW_AT_import is a DIE reference,
5453 not a simple name. But in order to do this, we would need to enhance
5454 the DWARF reader to associate a symbol to this renaming, instead of a
5455 name. So, for now, we do something simpler: re-use the C++/Fortran
5456 namespace machinery. */
5457 r_name = (renaming->alias != NULL
5458 ? renaming->alias
5459 : renaming->declaration);
5460 if (name_match (r_name, lookup_name, NULL))
5461 {
5462 lookup_name_info decl_lookup_name (renaming->declaration,
5463 lookup_name.match_type ());
5464 ada_add_all_symbols (result, block, decl_lookup_name, domain,
5465 1, NULL);
5466 }
5467 renaming->searched = 0;
5468 }
5469 return result.size () != defns_mark;
5470}
5471
5472/* Implements compare_names, but only applying the comparision using
5473 the given CASING. */
5474
5475static int
5476compare_names_with_case (const char *string1, const char *string2,
5477 enum case_sensitivity casing)
5478{
5479 while (*string1 != '\0' && *string2 != '\0')
5480 {
5481 char c1, c2;
5482
5483 if (isspace (*string1) || isspace (*string2))
5484 return strcmp_iw_ordered (string1, string2);
5485
5486 if (casing == case_sensitive_off)
5487 {
5488 c1 = tolower (*string1);
5489 c2 = tolower (*string2);
5490 }
5491 else
5492 {
5493 c1 = *string1;
5494 c2 = *string2;
5495 }
5496 if (c1 != c2)
5497 break;
5498
5499 string1 += 1;
5500 string2 += 1;
5501 }
5502
5503 switch (*string1)
5504 {
5505 case '(':
5506 return strcmp_iw_ordered (string1, string2);
5507 case '_':
5508 if (*string2 == '\0')
5509 {
5510 if (is_name_suffix (string1))
5511 return 0;
5512 else
5513 return 1;
5514 }
5515 /* FALLTHROUGH */
5516 default:
5517 if (*string2 == '(')
5518 return strcmp_iw_ordered (string1, string2);
5519 else
5520 {
5521 if (casing == case_sensitive_off)
5522 return tolower (*string1) - tolower (*string2);
5523 else
5524 return *string1 - *string2;
5525 }
5526 }
5527}
5528
5529/* Compare STRING1 to STRING2, with results as for strcmp.
5530 Compatible with strcmp_iw_ordered in that...
5531
5532 strcmp_iw_ordered (STRING1, STRING2) <= 0
5533
5534 ... implies...
5535
5536 compare_names (STRING1, STRING2) <= 0
5537
5538 (they may differ as to what symbols compare equal). */
5539
5540static int
5541compare_names (const char *string1, const char *string2)
5542{
5543 int result;
5544
5545 /* Similar to what strcmp_iw_ordered does, we need to perform
5546 a case-insensitive comparison first, and only resort to
5547 a second, case-sensitive, comparison if the first one was
5548 not sufficient to differentiate the two strings. */
5549
5550 result = compare_names_with_case (string1, string2, case_sensitive_off);
5551 if (result == 0)
5552 result = compare_names_with_case (string1, string2, case_sensitive_on);
5553
5554 return result;
5555}
5556
5557/* Convenience function to get at the Ada encoded lookup name for
5558 LOOKUP_NAME, as a C string. */
5559
5560static const char *
5562{
5563 return lookup_name.ada ().lookup_name ().c_str ();
5564}
5565
5566/* A helper for add_nonlocal_symbols. Call expand_matching_symbols
5567 for OBJFILE, then walk the objfile's symtabs and update the
5568 results. */
5569
5570static void
5572 const lookup_name_info &lookup_name,
5573 bool is_wild_match,
5574 domain_enum domain,
5575 int global,
5576 match_data &data)
5577{
5578 data.objfile = objfile;
5579 objfile->expand_matching_symbols (lookup_name, domain, global,
5580 is_wild_match ? nullptr : compare_names);
5581
5582 const int block_kind = global ? GLOBAL_BLOCK : STATIC_BLOCK;
5584 {
5585 const struct block *block
5586 = symtab->blockvector ()->block (block_kind);
5587 if (!iterate_over_symbols_terminated (block, lookup_name,
5588 domain, data))
5589 break;
5590 }
5591}
5592
5593/* Add to RESULT all non-local symbols whose name and domain match
5594 LOOKUP_NAME and DOMAIN respectively. The search is performed on
5595 GLOBAL_BLOCK symbols if GLOBAL is non-zero, or on STATIC_BLOCK
5596 symbols otherwise. */
5597
5598static void
5599add_nonlocal_symbols (std::vector<struct block_symbol> &result,
5600 const lookup_name_info &lookup_name,
5601 domain_enum domain, int global)
5602{
5603 struct match_data data (&result);
5604
5605 bool is_wild_match = lookup_name.ada ().wild_match_p ();
5606
5608 {
5609 map_matching_symbols (objfile, lookup_name, is_wild_match, domain,
5610 global, data);
5611
5612 for (compunit_symtab *cu : objfile->compunits ())
5613 {
5614 const struct block *global_block
5615 = cu->blockvector ()->global_block ();
5616
5617 if (ada_add_block_renamings (result, global_block, lookup_name,
5618 domain))
5619 data.found_sym = true;
5620 }
5621 }
5622
5623 if (result.empty () && global && !is_wild_match)
5624 {
5625 const char *name = ada_lookup_name (lookup_name);
5626 std::string bracket_name = std::string ("<_ada_") + name + '>';
5627 lookup_name_info name1 (bracket_name, symbol_name_match_type::FULL);
5628
5630 map_matching_symbols (objfile, name1, false, domain, global, data);
5631 }
5632}
5633
5634/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if
5635 FULL_SEARCH is non-zero, enclosing scope and in global scopes,
5636 returning the number of matches. Add these to RESULT.
5637
5638 When FULL_SEARCH is non-zero, any non-function/non-enumeral
5639 symbol match within the nest of blocks whose innermost member is BLOCK,
5640 is the one match returned (no other matches in that or
5641 enclosing blocks is returned). If there are any matches in or
5642 surrounding BLOCK, then these alone are returned.
5643
5644 Names prefixed with "standard__" are handled specially:
5645 "standard__" is first stripped off (by the lookup_name
5646 constructor), and only static and global symbols are searched.
5647
5648 If MADE_GLOBAL_LOOKUP_P is non-null, set it before return to whether we had
5649 to lookup global symbols. */
5650
5651static void
5652ada_add_all_symbols (std::vector<struct block_symbol> &result,
5653 const struct block *block,
5654 const lookup_name_info &lookup_name,
5655 domain_enum domain,
5656 int full_search,
5657 int *made_global_lookup_p)
5658{
5659 struct symbol *sym;
5660
5661 if (made_global_lookup_p)
5662 *made_global_lookup_p = 0;
5663
5664 /* Special case: If the user specifies a symbol name inside package
5665 Standard, do a non-wild matching of the symbol name without
5666 the "standard__" prefix. This was primarily introduced in order
5667 to allow the user to specifically access the standard exceptions
5668 using, for instance, Standard.Constraint_Error when Constraint_Error
5669 is ambiguous (due to the user defining its own Constraint_Error
5670 entity inside its program). */
5671 if (lookup_name.ada ().standard_p ())
5672 block = NULL;
5673
5674 /* Check the non-global symbols. If we have ANY match, then we're done. */
5675
5676 if (block != NULL)
5677 {
5678 if (full_search)
5679 ada_add_local_symbols (result, lookup_name, block, domain);
5680 else
5681 {
5682 /* In the !full_search case we're are being called by
5683 iterate_over_symbols, and we don't want to search
5684 superblocks. */
5685 ada_add_block_symbols (result, block, lookup_name, domain, NULL);
5686 }
5687 if (!result.empty () || !full_search)
5688 return;
5689 }
5690
5691 /* No non-global symbols found. Check our cache to see if we have
5692 already performed this search before. If we have, then return
5693 the same result. */
5694
5695 if (lookup_cached_symbol (ada_lookup_name (lookup_name),
5696 domain, &sym, &block))
5697 {
5698 if (sym != NULL)
5699 add_defn_to_vec (result, sym, block);
5700 return;
5701 }
5702
5703 if (made_global_lookup_p)
5704 *made_global_lookup_p = 1;
5705
5706 /* Search symbols from all global blocks. */
5707
5708 add_nonlocal_symbols (result, lookup_name, domain, 1);
5709
5710 /* Now add symbols from all per-file blocks if we've gotten no hits
5711 (not strictly correct, but perhaps better than an error). */
5712
5713 if (result.empty ())
5714 add_nonlocal_symbols (result, lookup_name, domain, 0);
5715}
5716
5717/* Find symbols in DOMAIN matching LOOKUP_NAME, in BLOCK and, if FULL_SEARCH
5718 is non-zero, enclosing scope and in global scopes.
5719
5720 Returns (SYM,BLOCK) tuples, indicating the symbols found and the
5721 blocks and symbol tables (if any) in which they were found.
5722
5723 When full_search is non-zero, any non-function/non-enumeral
5724 symbol match within the nest of blocks whose innermost member is BLOCK,
5725 is the one match returned (no other matches in that or
5726 enclosing blocks is returned). If there are any matches in or
5727 surrounding BLOCK, then these alone are returned.
5728
5729 Names prefixed with "standard__" are handled specially: "standard__"
5730 is first stripped off, and only static and global symbols are searched. */
5731
5732static std::vector<struct block_symbol>
5734 const struct block *block,
5736 int full_search)
5737{
5738 int syms_from_global_search;
5739 std::vector<struct block_symbol> results;
5740
5741 ada_add_all_symbols (results, block, lookup_name,
5742 domain, full_search, &syms_from_global_search);
5743
5744 remove_extra_symbols (&results);
5745
5746 if (results.empty () && full_search && syms_from_global_search)
5747 cache_symbol (ada_lookup_name (lookup_name), domain, NULL, NULL);
5748
5749 if (results.size () == 1 && full_search && syms_from_global_search)
5750 cache_symbol (ada_lookup_name (lookup_name), domain,
5751 results[0].symbol, results[0].block);
5752
5754 return results;
5755}
5756
5757/* Find symbols in DOMAIN matching NAME, in BLOCK and enclosing scope and
5758 in global scopes, returning (SYM,BLOCK) tuples.
5759
5760 See ada_lookup_symbol_list_worker for further details. */
5761
5762std::vector<struct block_symbol>
5763ada_lookup_symbol_list (const char *name, const struct block *block,
5765{
5767 lookup_name_info lookup_name (name, name_match_type);
5768
5769 return ada_lookup_symbol_list_worker (lookup_name, block, domain, 1);
5770}
5771
5772/* The result is as for ada_lookup_symbol_list with FULL_SEARCH set
5773 to 1, but choosing the first symbol found if there are multiple
5774 choices.
5775
5776 The result is stored in *INFO, which must be non-NULL.
5777 If no match is found, INFO->SYM is set to NULL. */
5778
5779void
5780ada_lookup_encoded_symbol (const char *name, const struct block *block,
5782 struct block_symbol *info)
5783{
5784 /* Since we already have an encoded name, wrap it in '<>' to force a
5785 verbatim match. Otherwise, if the name happens to not look like
5786 an encoded name (because it doesn't include a "__"),
5787 ada_lookup_name_info would re-encode/fold it again, and that
5788 would e.g., incorrectly lowercase object renaming names like
5789 "R28b" -> "r28b". */
5790 std::string verbatim = add_angle_brackets (name);
5791
5792 gdb_assert (info != NULL);
5793 *info = ada_lookup_symbol (verbatim.c_str (), block, domain);
5794}
5795
5796/* Return a symbol in DOMAIN matching NAME, in BLOCK0 and enclosing
5797 scope and in global scopes, or NULL if none. NAME is folded and
5798 encoded first. Otherwise, the result is as for ada_lookup_symbol_list,
5799 choosing the first symbol if there are multiple choices. */
5800
5801struct block_symbol
5802ada_lookup_symbol (const char *name, const struct block *block0,
5803 domain_enum domain)
5804{
5805 std::vector<struct block_symbol> candidates
5806 = ada_lookup_symbol_list (name, block0, domain);
5807
5808 if (candidates.empty ())
5809 return {};
5810
5811 block_symbol info = candidates[0];
5812 info.symbol = fixup_symbol_section (info.symbol, NULL);
5813 return info;
5814}
5815
5816
5817/* True iff STR is a possible encoded suffix of a normal Ada name
5818 that is to be ignored for matching purposes. Suffixes of parallel
5819 names (e.g., XVE) are not included here. Currently, the possible suffixes
5820 are given by any of the regular expressions:
5821
5822 [.$][0-9]+ [nested subprogram suffix, on platforms such as GNU/Linux]
5823 ___[0-9]+ [nested subprogram suffix, on platforms such as HP/UX]
5824 TKB [subprogram suffix for task bodies]
5825 _E[0-9]+[bs]$ [protected object entry suffixes]
5826 (X[nb]*)?((\$|__)[0-9](_?[0-9]+)|___(JM|LJM|X([FDBUP].*|R[^T]?)))?$
5827
5828 Also, any leading "__[0-9]+" sequence is skipped before the suffix
5829 match is performed. This sequence is used to differentiate homonyms,
5830 is an optional part of a valid name suffix. */
5831
5832static int
5833is_name_suffix (const char *str)
5834{
5835 int k;
5836 const char *matching;
5837 const int len = strlen (str);
5838
5839 /* Skip optional leading __[0-9]+. */
5840
5841 if (len > 3 && str[0] == '_' && str[1] == '_' && isdigit (str[2]))
5842 {
5843 str += 3;
5844 while (isdigit (str[0]))
5845 str += 1;
5846 }
5847
5848 /* [.$][0-9]+ */
5849
5850 if (str[0] == '.' || str[0] == '$')
5851 {
5852 matching = str + 1;
5853 while (isdigit (matching[0]))
5854 matching += 1;
5855 if (matching[0] == '\0')
5856 return 1;
5857 }
5858
5859 /* ___[0-9]+ */
5860
5861 if (len > 3 && str[0] == '_' && str[1] == '_' && str[2] == '_')
5862 {
5863 matching = str + 3;
5864 while (isdigit (matching[0]))
5865 matching += 1;
5866 if (matching[0] == '\0')
5867 return 1;
5868 }
5869
5870 /* "TKB" suffixes are used for subprograms implementing task bodies. */
5871
5872 if (strcmp (str, "TKB") == 0)
5873 return 1;
5874
5875#if 0
5876 /* FIXME: brobecker/2005-09-23: Protected Object subprograms end
5877 with a N at the end. Unfortunately, the compiler uses the same
5878 convention for other internal types it creates. So treating
5879 all entity names that end with an "N" as a name suffix causes
5880 some regressions. For instance, consider the case of an enumerated
5881 type. To support the 'Image attribute, it creates an array whose
5882 name ends with N.
5883 Having a single character like this as a suffix carrying some
5884 information is a bit risky. Perhaps we should change the encoding
5885 to be something like "_N" instead. In the meantime, do not do
5886 the following check. */
5887 /* Protected Object Subprograms */
5888 if (len == 1 && str [0] == 'N')
5889 return 1;
5890#endif
5891
5892 /* _E[0-9]+[bs]$ */
5893 if (len > 3 && str[0] == '_' && str [1] == 'E' && isdigit (str[2]))
5894 {
5895 matching = str + 3;
5896 while (isdigit (matching[0]))
5897 matching += 1;
5898 if ((matching[0] == 'b' || matching[0] == 's')
5899 && matching [1] == '\0')
5900 return 1;
5901 }
5902
5903 /* ??? We should not modify STR directly, as we are doing below. This
5904 is fine in this case, but may become problematic later if we find
5905 that this alternative did not work, and want to try matching
5906 another one from the begining of STR. Since we modified it, we
5907 won't be able to find the begining of the string anymore! */
5908 if (str[0] == 'X')
5909 {
5910 str += 1;
5911 while (str[0] != '_' && str[0] != '\0')
5912 {
5913 if (str[0] != 'n' && str[0] != 'b')
5914 return 0;
5915 str += 1;
5916 }
5917 }
5918
5919 if (str[0] == '\000')
5920 return 1;
5921
5922 if (str[0] == '_')
5923 {
5924 if (str[1] != '_' || str[2] == '\000')
5925 return 0;
5926 if (str[2] == '_')
5927 {
5928 if (strcmp (str + 3, "JM") == 0)
5929 return 1;
5930 /* FIXME: brobecker/2004-09-30: GNAT will soon stop using
5931 the LJM suffix in favor of the JM one. But we will
5932 still accept LJM as a valid suffix for a reasonable
5933 amount of time, just to allow ourselves to debug programs
5934 compiled using an older version of GNAT. */
5935 if (strcmp (str + 3, "LJM") == 0)
5936 return 1;
5937 if (str[3] != 'X')
5938 return 0;
5939 if (str[4] == 'F' || str[4] == 'D' || str[4] == 'B'
5940 || str[4] == 'U' || str[4] == 'P')
5941 return 1;
5942 if (str[4] == 'R' && str[5] != 'T')
5943 return 1;
5944 return 0;
5945 }
5946 if (!isdigit (str[2]))
5947 return 0;
5948 for (k = 3; str[k] != '\0'; k += 1)
5949 if (!isdigit (str[k]) && str[k] != '_')
5950 return 0;
5951 return 1;
5952 }
5953 if (str[0] == '$' && isdigit (str[1]))
5954 {
5955 for (k = 2; str[k] != '\0'; k += 1)
5956 if (!isdigit (str[k]) && str[k] != '_')
5957 return 0;
5958 return 1;
5959 }
5960 return 0;
5961}
5962
5963/* Return non-zero if the string starting at NAME and ending before
5964 NAME_END contains no capital letters. */
5965
5966static int
5968{
5969 std::string decoded_name = ada_decode (name0);
5970 int i;
5971
5972 /* If the decoded name starts with an angle bracket, it means that
5973 NAME0 does not follow the GNAT encoding format. It should then
5974 not be allowed as a possible wild match. */
5975 if (decoded_name[0] == '<')
5976 return 0;
5977
5978 for (i=0; decoded_name[i] != '\0'; i++)
5979 if (isalpha (decoded_name[i]) && !islower (decoded_name[i]))
5980 return 0;
5981
5982 return 1;
5983}
5984
5985/* Advance *NAMEP to next occurrence in the string NAME0 of the TARGET0
5986 character which could start a simple name. Assumes that *NAMEP points
5987 somewhere inside the string beginning at NAME0. */
5988
5989static int
5990advance_wild_match (const char **namep, const char *name0, char target0)
5991{
5992 const char *name = *namep;
5993
5994 while (1)
5995 {
5996 char t0, t1;
5997
5998 t0 = *name;
5999 if (t0 == '_')
6000 {
6001 t1 = name[1];
6002 if ((t1 >= 'a' && t1 <= 'z') || (t1 >= '0' && t1 <= '9'))
6003 {
6004 name += 1;
6005 if (name == name0 + 5 && startswith (name0, "_ada"))
6006 break;
6007 else
6008 name += 1;
6009 }
6010 else if (t1 == '_' && ((name[2] >= 'a' && name[2] <= 'z')
6011 || name[2] == target0))
6012 {
6013 name += 2;
6014 break;
6015 }
6016 else if (t1 == '_' && name[2] == 'B' && name[3] == '_')
6017 {
6018 /* Names like "pkg__B_N__name", where N is a number, are
6019 block-local. We can handle these by simply skipping
6020 the "B_" here. */
6021 name += 4;
6022 }
6023 else
6024 return 0;
6025 }
6026 else if ((t0 >= 'a' && t0 <= 'z') || (t0 >= '0' && t0 <= '9'))
6027 name += 1;
6028 else
6029 return 0;
6030 }
6031
6032 *namep = name;
6033 return 1;
6034}
6035
6036/* Return true iff NAME encodes a name of the form prefix.PATN.
6037 Ignores any informational suffixes of NAME (i.e., for which
6038 is_name_suffix is true). Assumes that PATN is a lower-cased Ada
6039 simple name. */
6040
6041static bool
6042wild_match (const char *name, const char *patn)
6043{
6044 const char *p;
6045 const char *name0 = name;
6046
6047 if (startswith (name, "___ghost_"))
6048 name += 9;
6049
6050 while (1)
6051 {
6052 const char *match = name;
6053
6054 if (*name == *patn)
6055 {
6056 for (name += 1, p = patn + 1; *p != '\0'; name += 1, p += 1)
6057 if (*p != *name)
6058 break;
6059 if (*p == '\0' && is_name_suffix (name))
6060 return match == name0 || is_valid_name_for_wild_match (name0);
6061
6062 if (name[-1] == '_')
6063 name -= 1;
6064 }
6065 if (!advance_wild_match (&name, name0, *patn))
6066 return false;
6067 }
6068}
6069
6070/* Add symbols from BLOCK matching LOOKUP_NAME in DOMAIN to RESULT (if
6071 necessary). OBJFILE is the section containing BLOCK. */
6072
6073static void
6074ada_add_block_symbols (std::vector<struct block_symbol> &result,
6075 const struct block *block,
6076 const lookup_name_info &lookup_name,
6077 domain_enum domain, struct objfile *objfile)
6078{
6079 struct block_iterator iter;
6080 /* A matching argument symbol, if any. */
6081 struct symbol *arg_sym;
6082 /* Set true when we find a matching non-argument symbol. */
6083 bool found_sym;
6084 struct symbol *sym;
6085
6086 arg_sym = NULL;
6087 found_sym = false;
6088 for (sym = block_iter_match_first (block, lookup_name, &iter);
6089 sym != NULL;
6090 sym = block_iter_match_next (lookup_name, &iter))
6091 {
6092 if (symbol_matches_domain (sym->language (), sym->domain (), domain))
6093 {
6094 if (sym->aclass () != LOC_UNRESOLVED)
6095 {
6096 if (sym->is_argument ())
6097 arg_sym = sym;
6098 else
6099 {
6100 found_sym = true;
6101 add_defn_to_vec (result,
6103 block);
6104 }
6105 }
6106 }
6107 }
6108
6109 /* Handle renamings. */
6110
6111 if (ada_add_block_renamings (result, block, lookup_name, domain))
6112 found_sym = true;
6113
6114 if (!found_sym && arg_sym != NULL)
6115 {
6116 add_defn_to_vec (result,
6117 fixup_symbol_section (arg_sym, objfile),
6118 block);
6119 }
6120
6121 if (!lookup_name.ada ().wild_match_p ())
6122 {
6123 arg_sym = NULL;
6124 found_sym = false;
6125 const std::string &ada_lookup_name = lookup_name.ada ().lookup_name ();
6126 const char *name = ada_lookup_name.c_str ();
6127 size_t name_len = ada_lookup_name.size ();
6128
6129 ALL_BLOCK_SYMBOLS (block, iter, sym)
6130 {
6131 if (symbol_matches_domain (sym->language (),
6132 sym->domain (), domain))
6133 {
6134 int cmp;
6135
6136 cmp = (int) '_' - (int) sym->linkage_name ()[0];
6137 if (cmp == 0)
6138 {
6139 cmp = !startswith (sym->linkage_name (), "_ada_");
6140 if (cmp == 0)
6141 cmp = strncmp (name, sym->linkage_name () + 5,
6142 name_len);
6143 }
6144
6145 if (cmp == 0
6146 && is_name_suffix (sym->linkage_name () + name_len + 5))
6147 {
6148 if (sym->aclass () != LOC_UNRESOLVED)
6149 {
6150 if (sym->is_argument ())
6151 arg_sym = sym;
6152 else
6153 {
6154 found_sym = true;
6155 add_defn_to_vec (result,
6157 block);
6158 }
6159 }
6160 }
6161 }
6162 }
6163
6164 /* NOTE: This really shouldn't be needed for _ada_ symbols.
6165 They aren't parameters, right? */
6166 if (!found_sym && arg_sym != NULL)
6167 {
6168 add_defn_to_vec (result,
6169 fixup_symbol_section (arg_sym, objfile),
6170 block);
6171 }
6172 }
6173}
6174
6175
6176 /* Symbol Completion */
6177
6178/* See symtab.h. */
6179
6180bool
6182 (const char *sym_name,
6183 symbol_name_match_type match_type,
6184 completion_match_result *comp_match_res) const
6185{
6186 bool match = false;
6187 const char *text = m_encoded_name.c_str ();
6188 size_t text_len = m_encoded_name.size ();
6189
6190 /* First, test against the fully qualified name of the symbol. */
6191
6192 if (strncmp (sym_name, text, text_len) == 0)
6193 match = true;
6194
6195 std::string decoded_name = ada_decode (sym_name);
6196 if (match && !m_encoded_p)
6197 {
6198 /* One needed check before declaring a positive match is to verify
6199 that iff we are doing a verbatim match, the decoded version
6200 of the symbol name starts with '<'. Otherwise, this symbol name
6201 is not a suitable completion. */
6202
6203 bool has_angle_bracket = (decoded_name[0] == '<');
6204 match = (has_angle_bracket == m_verbatim_p);
6205 }
6206
6207 if (match && !m_verbatim_p)
6208 {
6209 /* When doing non-verbatim match, another check that needs to
6210 be done is to verify that the potentially matching symbol name
6211 does not include capital letters, because the ada-mode would
6212 not be able to understand these symbol names without the
6213 angle bracket notation. */
6214 const char *tmp;
6215
6216 for (tmp = sym_name; *tmp != '\0' && !isupper (*tmp); tmp++);
6217 if (*tmp != '\0')
6218 match = false;
6219 }
6220
6221 /* Second: Try wild matching... */
6222
6223 if (!match && m_wild_match_p)
6224 {
6225 /* Since we are doing wild matching, this means that TEXT
6226 may represent an unqualified symbol name. We therefore must
6227 also compare TEXT against the unqualified name of the symbol. */
6228 sym_name = ada_unqualified_name (decoded_name.c_str ());
6229
6230 if (strncmp (sym_name, text, text_len) == 0)
6231 match = true;
6232 }
6233
6234 /* Finally: If we found a match, prepare the result to return. */
6235
6236 if (!match)
6237 return false;
6238
6239 if (comp_match_res != NULL)
6240 {
6241 std::string &match_str = comp_match_res->match.storage ();
6242
6243 if (!m_encoded_p)
6244 match_str = ada_decode (sym_name);
6245 else
6246 {
6247 if (m_verbatim_p)
6248 match_str = add_angle_brackets (sym_name);
6249 else
6250 match_str = sym_name;
6251
6252 }
6253
6254 comp_match_res->set_match (match_str.c_str ());
6255 }
6256
6257 return true;
6258}
6259
6260 /* Field Access */
6261
6262/* Return non-zero if TYPE is a pointer to the GNAT dispatch table used
6263 for tagged types. */
6264
6265static int
6267{
6268 const char *name;
6269
6270 if (type->code () != TYPE_CODE_PTR)
6271 return 0;
6272
6273 name = type->target_type ()->name ();
6274 if (name == NULL)
6275 return 0;
6276
6277 return (strcmp (name, "ada__tags__dispatch_table") == 0);
6278}
6279
6280/* Return non-zero if TYPE is an interface tag. */
6281
6282static int
6284{
6285 const char *name = type->name ();
6286
6287 if (name == NULL)
6288 return 0;
6289
6290 return (strcmp (name, "ada__tags__interface_tag") == 0);
6291}
6292
6293/* True if field number FIELD_NUM in struct or union type TYPE is supposed
6294 to be invisible to users. */
6295
6296int
6297ada_is_ignored_field (struct type *type, int field_num)
6298{
6299 if (field_num < 0 || field_num > type->num_fields ())
6300 return 1;
6301
6302 /* Check the name of that field. */
6303 {
6304 const char *name = type->field (field_num).name ();
6305
6306 /* Anonymous field names should not be printed.
6307 brobecker/2007-02-20: I don't think this can actually happen
6308 but we don't want to print the value of anonymous fields anyway. */
6309 if (name == NULL)
6310 return 1;
6311
6312 /* Normally, fields whose name start with an underscore ("_")
6313 are fields that have been internally generated by the compiler,
6314 and thus should not be printed. The "_parent" field is special,
6315 however: This is a field internally generated by the compiler
6316 for tagged types, and it contains the components inherited from
6317 the parent type. This field should not be printed as is, but
6318 should not be ignored either. */
6319 if (name[0] == '_' && !startswith (name, "_parent"))
6320 return 1;
6321
6322 /* The compiler doesn't document this, but sometimes it emits
6323 a field whose name starts with a capital letter, like 'V148s'.
6324 These aren't marked as artificial in any way, but we know they
6325 should be ignored. However, wrapper fields should not be
6326 ignored. */
6327 if (name[0] == 'S' || name[0] == 'R' || name[0] == 'O')
6328 {
6329 /* Wrapper field. */
6330 }
6331 else if (isupper (name[0]))
6332 return 1;
6333 }
6334
6335 /* If this is the dispatch table of a tagged type or an interface tag,
6336 then ignore. */
6337 if (ada_is_tagged_type (type, 1)
6338 && (ada_is_dispatch_table_ptr_type (type->field (field_num).type ())
6339 || ada_is_interface_tag (type->field (field_num).type ())))
6340 return 1;
6341
6342 /* Not a special field, so it should not be ignored. */
6343 return 0;
6344}
6345
6346/* True iff TYPE has a tag field. If REFOK, then TYPE may also be a
6347 pointer or reference type whose ultimate target has a tag field. */
6348
6349int
6350ada_is_tagged_type (struct type *type, int refok)
6351{
6352 return (ada_lookup_struct_elt_type (type, "_tag", refok, 1) != NULL);
6353}
6354
6355/* True iff TYPE represents the type of X'Tag */
6356
6357int
6359{
6361
6362 if (type == NULL || type->code () != TYPE_CODE_PTR)
6363 return 0;
6364 else
6365 {
6366 const char *name = ada_type_name (type->target_type ());
6367
6368 return (name != NULL
6369 && strcmp (name, "ada__tags__dispatch_table") == 0);
6370 }
6371}
6372
6373/* The type of the tag on VAL. */
6374
6375static struct type *
6376ada_tag_type (struct value *val)
6377{
6378 return ada_lookup_struct_elt_type (value_type (val), "_tag", 1, 0);
6379}
6380
6381/* Return 1 if TAG follows the old scheme for Ada tags (used for Ada 95,
6382 retired at Ada 05). */
6383
6384static int
6385is_ada95_tag (struct value *tag)
6386{
6387 return ada_value_struct_elt (tag, "tsd", 1) != NULL;
6388}
6389
6390/* The value of the tag on VAL. */
6391
6392static struct value *
6394{
6395 return ada_value_struct_elt (val, "_tag", 0);
6396}
6397
6398/* The value of the tag on the object of type TYPE whose contents are
6399 saved at VALADDR, if it is non-null, or is at memory address
6400 ADDRESS. */
6401
6402static struct value *
6404 const gdb_byte *valaddr,
6405 CORE_ADDR address)
6406{
6407 int tag_byte_offset;
6408 struct type *tag_type;
6409
6410 gdb::array_view<const gdb_byte> contents;
6411 if (valaddr != nullptr)
6412 contents = gdb::make_array_view (valaddr, type->length ());
6413 struct type *resolved_type = resolve_dynamic_type (type, contents, address);
6414 if (find_struct_field ("_tag", resolved_type, 0, &tag_type, &tag_byte_offset,
6415 NULL, NULL, NULL))
6416 {
6417 const gdb_byte *valaddr1 = ((valaddr == NULL)
6418 ? NULL
6419 : valaddr + tag_byte_offset);
6420 CORE_ADDR address1 = (address == 0) ? 0 : address + tag_byte_offset;
6421
6422 return value_from_contents_and_address (tag_type, valaddr1, address1);
6423 }
6424 return NULL;
6425}
6426
6427static struct type *
6429{
6430 gdb::unique_xmalloc_ptr<char> type_name = ada_tag_name (tag);
6431
6432 if (type_name != NULL)
6433 return ada_find_any_type (ada_encode (type_name.get ()).c_str ());
6434 return NULL;
6435}
6436
6437/* Given a value OBJ of a tagged type, return a value of this
6438 type at the base address of the object. The base address, as
6439 defined in Ada.Tags, it is the address of the primary tag of
6440 the object, and therefore where the field values of its full
6441 view can be fetched. */
6442
6443struct value *
6445{
6446 struct value *val;
6447 LONGEST offset_to_top = 0;
6448 struct type *ptr_type, *obj_type;
6449 struct value *tag;
6450 CORE_ADDR base_address;
6451
6452 obj_type = value_type (obj);
6453
6454 /* It is the responsability of the caller to deref pointers. */
6455
6456 if (obj_type->code () == TYPE_CODE_PTR || obj_type->code () == TYPE_CODE_REF)
6457 return obj;
6458
6459 tag = ada_value_tag (obj);
6460 if (!tag)
6461 return obj;
6462
6463 /* Base addresses only appeared with Ada 05 and multiple inheritance. */
6464
6465 if (is_ada95_tag (tag))
6466 return obj;
6467
6468 struct type *offset_type
6470 target_gdbarch(), "storage_offset");
6471 ptr_type = lookup_pointer_type (offset_type);
6472 val = value_cast (ptr_type, tag);
6473 if (!val)
6474 return obj;
6475
6476 /* It is perfectly possible that an exception be raised while
6477 trying to determine the base address, just like for the tag;
6478 see ada_tag_name for more details. We do not print the error
6479 message for the same reason. */
6480
6481 try
6482 {
6483 offset_to_top = value_as_long (value_ind (value_ptradd (val, -2)));
6484 }
6485
6486 catch (const gdb_exception_error &e)
6487 {
6488 return obj;
6489 }
6490
6491 /* If offset is null, nothing to do. */
6492
6493 if (offset_to_top == 0)
6494 return obj;
6495
6496 /* -1 is a special case in Ada.Tags; however, what should be done
6497 is not quite clear from the documentation. So do nothing for
6498 now. */
6499
6500 if (offset_to_top == -1)
6501 return obj;
6502
6503 /* Storage_Offset'Last is used to indicate that a dynamic offset to
6504 top is used. In this situation the offset is stored just after
6505 the tag, in the object itself. */
6506 ULONGEST last = (((ULONGEST) 1) << (8 * offset_type->length () - 1)) - 1;
6507 if (offset_to_top == last)
6508 {
6509 struct value *tem = value_addr (tag);
6510 tem = value_ptradd (tem, 1);
6511 tem = value_cast (ptr_type, tem);
6512 offset_to_top = value_as_long (value_ind (tem));
6513 }
6514
6515 if (offset_to_top > 0)
6516 {
6517 /* OFFSET_TO_TOP used to be a positive value to be subtracted
6518 from the base address. This was however incompatible with
6519 C++ dispatch table: C++ uses a *negative* value to *add*
6520 to the base address. Ada's convention has therefore been
6521 changed in GNAT 19.0w 20171023: since then, C++ and Ada
6522 use the same convention. Here, we support both cases by
6523 checking the sign of OFFSET_TO_TOP. */
6524 offset_to_top = -offset_to_top;
6525 }
6526
6527 base_address = value_address (obj) + offset_to_top;
6528 tag = value_tag_from_contents_and_address (obj_type, NULL, base_address);
6529
6530 /* Make sure that we have a proper tag at the new address.
6531 Otherwise, offset_to_top is bogus (which can happen when
6532 the object is not initialized yet). */
6533
6534 if (!tag)
6535 return obj;
6536
6537 obj_type = type_from_tag (tag);
6538
6539 if (!obj_type)
6540 return obj;
6541
6542 return value_from_contents_and_address (obj_type, NULL, base_address);
6543}
6544
6545/* Return the "ada__tags__type_specific_data" type. */
6546
6547static struct type *
6549{
6551
6552 if (data->tsd_type == 0)
6553 data->tsd_type = ada_find_any_type ("ada__tags__type_specific_data");
6554 return data->tsd_type;
6555}
6556
6557/* Return the TSD (type-specific data) associated to the given TAG.
6558 TAG is assumed to be the tag of a tagged-type entity.
6559
6560 May return NULL if we are unable to get the TSD. */
6561
6562static struct value *
6564{
6565 struct value *val;
6566 struct type *type;
6567
6568 /* First option: The TSD is simply stored as a field of our TAG.
6569 Only older versions of GNAT would use this format, but we have
6570 to test it first, because there are no visible markers for
6571 the current approach except the absence of that field. */
6572
6573 val = ada_value_struct_elt (tag, "tsd", 1);
6574 if (val)
6575 return val;
6576
6577 /* Try the second representation for the dispatch table (in which
6578 there is no explicit 'tsd' field in the referent of the tag pointer,
6579 and instead the tsd pointer is stored just before the dispatch
6580 table. */
6581
6583 if (type == NULL)
6584 return NULL;
6586 val = value_cast (type, tag);
6587 if (val == NULL)
6588 return NULL;
6589 return value_ind (value_ptradd (val, -1));
6590}
6591
6592/* Given the TSD of a tag (type-specific data), return a string
6593 containing the name of the associated type.
6594
6595 May return NULL if we are unable to determine the tag name. */
6596
6597static gdb::unique_xmalloc_ptr<char>
6599{
6600 struct value *val;
6601
6602 val = ada_value_struct_elt (tsd, "expanded_name", 1);
6603 if (val == NULL)
6604 return NULL;
6605 gdb::unique_xmalloc_ptr<char> buffer
6607 if (buffer == nullptr)
6608 return nullptr;
6609
6610 try
6611 {
6612 /* Let this throw an exception on error. If the data is
6613 uninitialized, we'd rather not have the user see a
6614 warning. */
6615 const char *folded = ada_fold_name (buffer.get (), true);
6616 return make_unique_xstrdup (folded);
6617 }
6618 catch (const gdb_exception &)
6619 {
6620 return nullptr;
6621 }
6622}
6623
6624/* The type name of the dynamic type denoted by the 'tag value TAG, as
6625 a C string.
6626
6627 Return NULL if the TAG is not an Ada tag, or if we were unable to
6628 determine the name of that tag. */
6629
6630gdb::unique_xmalloc_ptr<char>
6631ada_tag_name (struct value *tag)
6632{
6633 gdb::unique_xmalloc_ptr<char> name;
6634
6635 if (!ada_is_tag_type (value_type (tag)))
6636 return NULL;
6637
6638 /* It is perfectly possible that an exception be raised while trying
6639 to determine the TAG's name, even under normal circumstances:
6640 The associated variable may be uninitialized or corrupted, for
6641 instance. We do not let any exception propagate past this point.
6642 instead we return NULL.
6643
6644 We also do not print the error message either (which often is very
6645 low-level (Eg: "Cannot read memory at 0x[...]"), but instead let
6646 the caller print a more meaningful message if necessary. */
6647 try
6648 {
6649 struct value *tsd = ada_get_tsd_from_tag (tag);
6650
6651 if (tsd != NULL)
6653 }
6654 catch (const gdb_exception_error &e)
6655 {
6656 }
6657
6658 return name;
6659}
6660
6661/* The parent type of TYPE, or NULL if none. */
6662
6663struct type *
6665{
6666 int i;
6667
6669
6670 if (type == NULL || type->code () != TYPE_CODE_STRUCT)
6671 return NULL;
6672
6673 for (i = 0; i < type->num_fields (); i += 1)
6674 if (ada_is_parent_field (type, i))
6675 {
6676 struct type *parent_type = type->field (i).type ();
6677
6678 /* If the _parent field is a pointer, then dereference it. */
6679 if (parent_type->code () == TYPE_CODE_PTR)
6680 parent_type = parent_type->target_type ();
6681 /* If there is a parallel XVS type, get the actual base type. */
6682 parent_type = ada_get_base_type (parent_type);
6683
6684 return ada_check_typedef (parent_type);
6685 }
6686
6687 return NULL;
6688}
6689
6690/* True iff field number FIELD_NUM of structure type TYPE contains the
6691 parent-type (inherited) fields of a derived type. Assumes TYPE is
6692 a structure type with at least FIELD_NUM+1 fields. */
6693
6694int
6695ada_is_parent_field (struct type *type, int field_num)
6696{
6697 const char *name = ada_check_typedef (type)->field (field_num).name ();
6698
6699 return (name != NULL
6700 && (startswith (name, "PARENT")
6701 || startswith (name, "_parent")));
6702}
6703
6704/* True iff field number FIELD_NUM of structure type TYPE is a
6705 transparent wrapper field (which should be silently traversed when doing
6706 field selection and flattened when printing). Assumes TYPE is a
6707 structure type with at least FIELD_NUM+1 fields. Such fields are always
6708 structures. */
6709
6710int
6711ada_is_wrapper_field (struct type *type, int field_num)
6712{
6713 const char *name = type->field (field_num).name ();
6714
6715 if (name != NULL && strcmp (name, "RETVAL") == 0)
6716 {
6717 /* This happens in functions with "out" or "in out" parameters
6718 which are passed by copy. For such functions, GNAT describes
6719 the function's return type as being a struct where the return
6720 value is in a field called RETVAL, and where the other "out"
6721 or "in out" parameters are fields of that struct. This is not
6722 a wrapper. */
6723 return 0;
6724 }
6725
6726 return (name != NULL
6727 && (startswith (name, "PARENT")
6728 || strcmp (name, "REP") == 0
6729 || startswith (name, "_parent")
6730 || name[0] == 'S' || name[0] == 'R' || name[0] == 'O'));
6731}
6732
6733/* True iff field number FIELD_NUM of structure or union type TYPE
6734 is a variant wrapper. Assumes TYPE is a structure type with at least
6735 FIELD_NUM+1 fields. */
6736
6737int
6738ada_is_variant_part (struct type *type, int field_num)
6739{
6740 /* Only Ada types are eligible. */
6741 if (!ADA_TYPE_P (type))
6742 return 0;
6743
6744 struct type *field_type = type->field (field_num).type ();
6745
6746 return (field_type->code () == TYPE_CODE_UNION
6747 || (is_dynamic_field (type, field_num)
6748 && (field_type->target_type ()->code ()
6749 == TYPE_CODE_UNION)));
6750}
6751
6752/* Assuming that VAR_TYPE is a variant wrapper (type of the variant part)
6753 whose discriminants are contained in the record type OUTER_TYPE,
6754 returns the type of the controlling discriminant for the variant.
6755 May return NULL if the type could not be found. */
6756
6757struct type *
6758ada_variant_discrim_type (struct type *var_type, struct type *outer_type)
6759{
6760 const char *name = ada_variant_discrim_name (var_type);
6761
6762 return ada_lookup_struct_elt_type (outer_type, name, 1, 1);
6763}
6764
6765/* Assuming that TYPE is the type of a variant wrapper, and FIELD_NUM is a
6766 valid field number within it, returns 1 iff field FIELD_NUM of TYPE
6767 represents a 'when others' clause; otherwise 0. */
6768
6769static int
6770ada_is_others_clause (struct type *type, int field_num)
6771{
6772 const char *name = type->field (field_num).name ();
6773
6774 return (name != NULL && name[0] == 'O');
6775}
6776
6777/* Assuming that TYPE0 is the type of the variant part of a record,
6778 returns the name of the discriminant controlling the variant.
6779 The value is valid until the next call to ada_variant_discrim_name. */
6780
6781const char *
6783{
6784 static std::string result;
6785 struct type *type;
6786 const char *name;
6787 const char *discrim_end;
6788 const char *discrim_start;
6789
6790 if (type0->code () == TYPE_CODE_PTR)
6791 type = type0->target_type ();
6792 else
6793 type = type0;
6794
6796
6797 if (name == NULL || name[0] == '\000')
6798 return "";
6799
6800 for (discrim_end = name + strlen (name) - 6; discrim_end != name;
6801 discrim_end -= 1)
6802 {
6803 if (startswith (discrim_end, "___XVN"))
6804 break;
6805 }
6806 if (discrim_end == name)
6807 return "";
6808
6809 for (discrim_start = discrim_end; discrim_start != name + 3;
6810 discrim_start -= 1)
6811 {
6812 if (discrim_start == name + 1)
6813 return "";
6814 if ((discrim_start > name + 3
6815 && startswith (discrim_start - 3, "___"))
6816 || discrim_start[-1] == '.')
6817 break;
6818 }
6819
6820 result = std::string (discrim_start, discrim_end - discrim_start);
6821 return result.c_str ();
6822}
6823
6824/* Scan STR for a subtype-encoded number, beginning at position K.
6825 Put the position of the character just past the number scanned in
6826 *NEW_K, if NEW_K!=NULL. Put the scanned number in *R, if R!=NULL.
6827 Return 1 if there was a valid number at the given position, and 0
6828 otherwise. A "subtype-encoded" number consists of the absolute value
6829 in decimal, followed by the letter 'm' to indicate a negative number.
6830 Assumes 0m does not occur. */
6831
6832int
6833ada_scan_number (const char str[], int k, LONGEST * R, int *new_k)
6834{
6835 ULONGEST RU;
6836
6837 if (!isdigit (str[k]))
6838 return 0;
6839
6840 /* Do it the hard way so as not to make any assumption about
6841 the relationship of unsigned long (%lu scan format code) and
6842 LONGEST. */
6843 RU = 0;
6844 while (isdigit (str[k]))
6845 {
6846 RU = RU * 10 + (str[k] - '0');
6847 k += 1;
6848 }
6849
6850 if (str[k] == 'm')
6851 {
6852 if (R != NULL)
6853 *R = (-(LONGEST) (RU - 1)) - 1;
6854 k += 1;
6855 }
6856 else if (R != NULL)
6857 *R = (LONGEST) RU;
6858
6859 /* NOTE on the above: Technically, C does not say what the results of
6860 - (LONGEST) RU or (LONGEST) -RU are for RU == largest positive
6861 number representable as a LONGEST (although either would probably work
6862 in most implementations). When RU>0, the locution in the then branch
6863 above is always equivalent to the negative of RU. */
6864
6865 if (new_k != NULL)
6866 *new_k = k;
6867 return 1;
6868}
6869
6870/* Assuming that TYPE is a variant part wrapper type (a VARIANTS field),
6871 and FIELD_NUM is a valid field number within it, returns 1 iff VAL is
6872 in the range encoded by field FIELD_NUM of TYPE; otherwise 0. */
6873
6874static int
6875ada_in_variant (LONGEST val, struct type *type, int field_num)
6876{
6877 const char *name = type->field (field_num).name ();
6878 int p;
6879
6880 p = 0;
6881 while (1)
6882 {
6883 switch (name[p])
6884 {
6885 case '\0':
6886 return 0;
6887 case 'S':
6888 {
6889 LONGEST W;
6890
6891 if (!ada_scan_number (name, p + 1, &W, &p))
6892 return 0;
6893 if (val == W)
6894 return 1;
6895 break;
6896 }
6897 case 'R':
6898 {
6899 LONGEST L, U;
6900
6901 if (!ada_scan_number (name, p + 1, &L, &p)
6902 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
6903 return 0;
6904 if (val >= L && val <= U)
6905 return 1;
6906 break;
6907 }
6908 case 'O':
6909 return 1;
6910 default:
6911 return 0;
6912 }
6913 }
6914}
6915
6916/* FIXME: Lots of redundancy below. Try to consolidate. */
6917
6918/* Given a value ARG1 (offset by OFFSET bytes) of a struct or union type
6919 ARG_TYPE, extract and return the value of one of its (non-static)
6920 fields. FIELDNO says which field. Differs from value_primitive_field
6921 only in that it can handle packed values of arbitrary type. */
6922
6923struct value *
6924ada_value_primitive_field (struct value *arg1, int offset, int fieldno,
6925 struct type *arg_type)
6926{
6927 struct type *type;
6928
6929 arg_type = ada_check_typedef (arg_type);
6930 type = arg_type->field (fieldno).type ();
6931
6932 /* Handle packed fields. It might be that the field is not packed
6933 relative to its containing structure, but the structure itself is
6934 packed; in this case we must take the bit-field path. */
6935 if (TYPE_FIELD_BITSIZE (arg_type, fieldno) != 0 || value_bitpos (arg1) != 0)
6936 {
6937 int bit_pos = arg_type->field (fieldno).loc_bitpos ();
6938 int bit_size = TYPE_FIELD_BITSIZE (arg_type, fieldno);
6939
6940 return ada_value_primitive_packed_val (arg1,
6941 value_contents (arg1).data (),
6942 offset + bit_pos / 8,
6943 bit_pos % 8, bit_size, type);
6944 }
6945 else
6946 return value_primitive_field (arg1, offset, fieldno, arg_type);
6947}
6948
6949/* Find field with name NAME in object of type TYPE. If found,
6950 set the following for each argument that is non-null:
6951 - *FIELD_TYPE_P to the field's type;
6952 - *BYTE_OFFSET_P to OFFSET + the byte offset of the field within
6953 an object of that type;
6954 - *BIT_OFFSET_P to the bit offset modulo byte size of the field;
6955 - *BIT_SIZE_P to its size in bits if the field is packed, and
6956 0 otherwise;
6957 If INDEX_P is non-null, increment *INDEX_P by the number of source-visible
6958 fields up to but not including the desired field, or by the total
6959 number of fields if not found. A NULL value of NAME never
6960 matches; the function just counts visible fields in this case.
6961
6962 Notice that we need to handle when a tagged record hierarchy
6963 has some components with the same name, like in this scenario:
6964
6965 type Top_T is tagged record
6966 N : Integer := 1;
6967 U : Integer := 974;
6968 A : Integer := 48;
6969 end record;
6970
6971 type Middle_T is new Top.Top_T with record
6972 N : Character := 'a';
6973 C : Integer := 3;
6974 end record;
6975
6976 type Bottom_T is new Middle.Middle_T with record
6977 N : Float := 4.0;
6978 C : Character := '5';
6979 X : Integer := 6;
6980 A : Character := 'J';
6981 end record;
6982
6983 Let's say we now have a variable declared and initialized as follow:
6984
6985 TC : Top_A := new Bottom_T;
6986
6987 And then we use this variable to call this function
6988
6989 procedure Assign (Obj: in out Top_T; TV : Integer);
6990
6991 as follow:
6992
6993 Assign (Top_T (B), 12);
6994
6995 Now, we're in the debugger, and we're inside that procedure
6996 then and we want to print the value of obj.c:
6997
6998 Usually, the tagged record or one of the parent type owns the
6999 component to print and there's no issue but in this particular
7000 case, what does it mean to ask for Obj.C? Since the actual
7001 type for object is type Bottom_T, it could mean two things: type
7002 component C from the Middle_T view, but also component C from
7003 Bottom_T. So in that "undefined" case, when the component is
7004 not found in the non-resolved type (which includes all the
7005 components of the parent type), then resolve it and see if we
7006 get better luck once expanded.
7007
7008 In the case of homonyms in the derived tagged type, we don't
7009 guaranty anything, and pick the one that's easiest for us
7010 to program.
7011
7012 Returns 1 if found, 0 otherwise. */
7013
7014static int
7015find_struct_field (const char *name, struct type *type, int offset,
7016 struct type **field_type_p,
7017 int *byte_offset_p, int *bit_offset_p, int *bit_size_p,
7018 int *index_p)
7019{
7020 int i;
7021 int parent_offset = -1;
7022
7024
7025 if (field_type_p != NULL)
7026 *field_type_p = NULL;
7027 if (byte_offset_p != NULL)
7028 *byte_offset_p = 0;
7029 if (bit_offset_p != NULL)
7030 *bit_offset_p = 0;
7031 if (bit_size_p != NULL)
7032 *bit_size_p = 0;
7033
7034 for (i = 0; i < type->num_fields (); i += 1)
7035 {
7036 /* These can't be computed using TYPE_FIELD_BITPOS for a dynamic
7037 type. However, we only need the values to be correct when
7038 the caller asks for them. */
7039 int bit_pos = 0, fld_offset = 0;
7040 if (byte_offset_p != nullptr || bit_offset_p != nullptr)
7041 {
7042 bit_pos = type->field (i).loc_bitpos ();
7043 fld_offset = offset + bit_pos / 8;
7044 }
7045
7046 const char *t_field_name = type->field (i).name ();
7047
7048 if (t_field_name == NULL)
7049 continue;
7050
7051 else if (ada_is_parent_field (type, i))
7052 {
7053 /* This is a field pointing us to the parent type of a tagged
7054 type. As hinted in this function's documentation, we give
7055 preference to fields in the current record first, so what
7056 we do here is just record the index of this field before
7057 we skip it. If it turns out we couldn't find our field
7058 in the current record, then we'll get back to it and search
7059 inside it whether the field might exist in the parent. */
7060
7061 parent_offset = i;
7062 continue;
7063 }
7064
7065 else if (name != NULL && field_name_match (t_field_name, name))
7066 {
7067 int bit_size = TYPE_FIELD_BITSIZE (type, i);
7068
7069 if (field_type_p != NULL)
7070 *field_type_p = type->field (i).type ();
7071 if (byte_offset_p != NULL)
7072 *byte_offset_p = fld_offset;
7073 if (bit_offset_p != NULL)
7074 *bit_offset_p = bit_pos % 8;
7075 if (bit_size_p != NULL)
7076 *bit_size_p = bit_size;
7077 return 1;
7078 }
7079 else if (ada_is_wrapper_field (type, i))
7080 {
7081 if (find_struct_field (name, type->field (i).type (), fld_offset,
7082 field_type_p, byte_offset_p, bit_offset_p,
7083 bit_size_p, index_p))
7084 return 1;
7085 }
7086 else if (ada_is_variant_part (type, i))
7087 {
7088 /* PNH: Wait. Do we ever execute this section, or is ARG always of
7089 fixed type?? */
7090 int j;
7091 struct type *field_type
7092 = ada_check_typedef (type->field (i).type ());
7093
7094 for (j = 0; j < field_type->num_fields (); j += 1)
7095 {
7096 if (find_struct_field (name, field_type->field (j).type (),
7097 fld_offset
7098 + field_type->field (j).loc_bitpos () / 8,
7099 field_type_p, byte_offset_p,
7100 bit_offset_p, bit_size_p, index_p))
7101 return 1;
7102 }
7103 }
7104 else if (index_p != NULL)
7105 *index_p += 1;
7106 }
7107
7108 /* Field not found so far. If this is a tagged type which
7109 has a parent, try finding that field in the parent now. */
7110
7111 if (parent_offset != -1)
7112 {
7113 /* As above, only compute the offset when truly needed. */
7114 int fld_offset = offset;
7115 if (byte_offset_p != nullptr || bit_offset_p != nullptr)
7116 {
7117 int bit_pos = type->field (parent_offset).loc_bitpos ();
7118 fld_offset += bit_pos / 8;
7119 }
7120
7121 if (find_struct_field (name, type->field (parent_offset).type (),
7122 fld_offset, field_type_p, byte_offset_p,
7123 bit_offset_p, bit_size_p, index_p))
7124 return 1;
7125 }
7126
7127 return 0;
7128}
7129
7130/* Number of user-visible fields in record type TYPE. */
7131
7132static int
7134{
7135 int n;
7136
7137 n = 0;
7138 find_struct_field (NULL, type, 0, NULL, NULL, NULL, NULL, &n);
7139 return n;
7140}
7141
7142/* Look for a field NAME in ARG. Adjust the address of ARG by OFFSET bytes,
7143 and search in it assuming it has (class) type TYPE.
7144 If found, return value, else return NULL.
7145
7146 Searches recursively through wrapper fields (e.g., '_parent').
7147
7148 In the case of homonyms in the tagged types, please refer to the
7149 long explanation in find_struct_field's function documentation. */
7150
7151static struct value *
7152ada_search_struct_field (const char *name, struct value *arg, int offset,
7153 struct type *type)
7154{
7155 int i;
7156 int parent_offset = -1;
7157
7159 for (i = 0; i < type->num_fields (); i += 1)
7160 {
7161 const char *t_field_name = type->field (i).name ();
7162
7163 if (t_field_name == NULL)
7164 continue;
7165
7166 else if (ada_is_parent_field (type, i))
7167 {
7168 /* This is a field pointing us to the parent type of a tagged
7169 type. As hinted in this function's documentation, we give
7170 preference to fields in the current record first, so what
7171 we do here is just record the index of this field before
7172 we skip it. If it turns out we couldn't find our field
7173 in the current record, then we'll get back to it and search
7174 inside it whether the field might exist in the parent. */
7175
7176 parent_offset = i;
7177 continue;
7178 }
7179
7180 else if (field_name_match (t_field_name, name))
7181 return ada_value_primitive_field (arg, offset, i, type);
7182
7183 else if (ada_is_wrapper_field (type, i))
7184 {
7185 struct value *v = /* Do not let indent join lines here. */
7187 offset + type->field (i).loc_bitpos () / 8,
7188 type->field (i).type ());
7189
7190 if (v != NULL)
7191 return v;
7192 }
7193
7194 else if (ada_is_variant_part (type, i))
7195 {
7196 /* PNH: Do we ever get here? See find_struct_field. */
7197 int j;
7198 struct type *field_type = ada_check_typedef (type->field (i).type ());
7199 int var_offset = offset + type->field (i).loc_bitpos () / 8;
7200
7201 for (j = 0; j < field_type->num_fields (); j += 1)
7202 {
7203 struct value *v = ada_search_struct_field /* Force line
7204 break. */
7205 (name, arg,
7206 var_offset + field_type->field (j).loc_bitpos () / 8,
7207 field_type->field (j).type ());
7208
7209 if (v != NULL)
7210 return v;
7211 }
7212 }
7213 }
7214
7215 /* Field not found so far. If this is a tagged type which
7216 has a parent, try finding that field in the parent now. */
7217
7218 if (parent_offset != -1)
7219 {
7220 struct value *v = ada_search_struct_field (
7221 name, arg, offset + type->field (parent_offset).loc_bitpos () / 8,
7222 type->field (parent_offset).type ());
7223
7224 if (v != NULL)
7225 return v;
7226 }
7227
7228 return NULL;
7229}
7230
7231static struct value *ada_index_struct_field_1 (int *, struct value *,
7232 int, struct type *);
7233
7234
7235/* Return field #INDEX in ARG, where the index is that returned by
7236 * find_struct_field through its INDEX_P argument. Adjust the address
7237 * of ARG by OFFSET bytes, and search in it assuming it has (class) type TYPE.
7238 * If found, return value, else return NULL. */
7239
7240static struct value *
7241ada_index_struct_field (int index, struct value *arg, int offset,
7242 struct type *type)
7243{
7244 return ada_index_struct_field_1 (&index, arg, offset, type);
7245}
7246
7247
7248/* Auxiliary function for ada_index_struct_field. Like
7249 * ada_index_struct_field, but takes index from *INDEX_P and modifies
7250 * *INDEX_P. */
7251
7252static struct value *
7253ada_index_struct_field_1 (int *index_p, struct value *arg, int offset,
7254 struct type *type)
7255{
7256 int i;
7258
7259 for (i = 0; i < type->num_fields (); i += 1)
7260 {
7261 if (type->field (i).name () == NULL)
7262 continue;
7263 else if (ada_is_wrapper_field (type, i))
7264 {
7265 struct value *v = /* Do not let indent join lines here. */
7266 ada_index_struct_field_1 (index_p, arg,
7267 offset + type->field (i).loc_bitpos () / 8,
7268 type->field (i).type ());
7269
7270 if (v != NULL)
7271 return v;
7272 }
7273
7274 else if (ada_is_variant_part (type, i))
7275 {
7276 /* PNH: Do we ever get here? See ada_search_struct_field,
7277 find_struct_field. */
7278 error (_("Cannot assign this kind of variant record"));
7279 }
7280 else if (*index_p == 0)
7281 return ada_value_primitive_field (arg, offset, i, type);
7282 else
7283 *index_p -= 1;
7284 }
7285 return NULL;
7286}
7287
7288/* Return a string representation of type TYPE. */
7289
7290static std::string
7292{
7293 string_file tmp_stream;
7294
7295 type_print (type, "", &tmp_stream, -1);
7296
7297 return tmp_stream.release ();
7298}
7299
7300/* Given a type TYPE, look up the type of the component of type named NAME.
7301 If DISPP is non-null, add its byte displacement from the beginning of a
7302 structure (pointed to by a value) of type TYPE to *DISPP (does not
7303 work for packed fields).
7304
7305 Matches any field whose name has NAME as a prefix, possibly
7306 followed by "___".
7307
7308 TYPE can be either a struct or union. If REFOK, TYPE may also
7309 be a (pointer or reference)+ to a struct or union, and the
7310 ultimate target type will be searched.
7311
7312 Looks recursively into variant clauses and parent types.
7313
7314 In the case of homonyms in the tagged types, please refer to the
7315 long explanation in find_struct_field's function documentation.
7316
7317 If NOERR is nonzero, return NULL if NAME is not suitably defined or
7318 TYPE is not a type of the right kind. */
7319
7320static struct type *
7321ada_lookup_struct_elt_type (struct type *type, const char *name, int refok,
7322 int noerr)
7323{
7324 int i;
7325 int parent_offset = -1;
7326
7327 if (name == NULL)
7328 goto BadName;
7329
7330 if (refok && type != NULL)
7331 while (1)
7332 {
7334 if (type->code () != TYPE_CODE_PTR && type->code () != TYPE_CODE_REF)
7335 break;
7336 type = type->target_type ();
7337 }
7338
7339 if (type == NULL
7340 || (type->code () != TYPE_CODE_STRUCT
7341 && type->code () != TYPE_CODE_UNION))
7342 {
7343 if (noerr)
7344 return NULL;
7345
7346 error (_("Type %s is not a structure or union type"),
7347 type != NULL ? type_as_string (type).c_str () : _("(null)"));
7348 }
7349
7351
7352 for (i = 0; i < type->num_fields (); i += 1)
7353 {
7354 const char *t_field_name = type->field (i).name ();
7355 struct type *t;
7356
7357 if (t_field_name == NULL)
7358 continue;
7359
7360 else if (ada_is_parent_field (type, i))
7361 {
7362 /* This is a field pointing us to the parent type of a tagged
7363 type. As hinted in this function's documentation, we give
7364 preference to fields in the current record first, so what
7365 we do here is just record the index of this field before
7366 we skip it. If it turns out we couldn't find our field
7367 in the current record, then we'll get back to it and search
7368 inside it whether the field might exist in the parent. */
7369
7370 parent_offset = i;
7371 continue;
7372 }
7373
7374 else if (field_name_match (t_field_name, name))
7375 return type->field (i).type ();
7376
7377 else if (ada_is_wrapper_field (type, i))
7378 {
7380 0, 1);
7381 if (t != NULL)
7382 return t;
7383 }
7384
7385 else if (ada_is_variant_part (type, i))
7386 {
7387 int j;
7388 struct type *field_type = ada_check_typedef (type->field (i).type ());
7389
7390 for (j = field_type->num_fields () - 1; j >= 0; j -= 1)
7391 {
7392 /* FIXME pnh 2008/01/26: We check for a field that is
7393 NOT wrapped in a struct, since the compiler sometimes
7394 generates these for unchecked variant types. Revisit
7395 if the compiler changes this practice. */
7396 const char *v_field_name = field_type->field (j).name ();
7397
7398 if (v_field_name != NULL
7399 && field_name_match (v_field_name, name))
7400 t = field_type->field (j).type ();
7401 else
7402 t = ada_lookup_struct_elt_type (field_type->field (j).type (),
7403 name, 0, 1);
7404
7405 if (t != NULL)
7406 return t;
7407 }
7408 }
7409
7410 }
7411
7412 /* Field not found so far. If this is a tagged type which
7413 has a parent, try finding that field in the parent now. */
7414
7415 if (parent_offset != -1)
7416 {
7417 struct type *t;
7418
7419 t = ada_lookup_struct_elt_type (type->field (parent_offset).type (),
7420 name, 0, 1);
7421 if (t != NULL)
7422 return t;
7423 }
7424
7425BadName:
7426 if (!noerr)
7427 {
7428 const char *name_str = name != NULL ? name : _("<null>");
7429
7430 error (_("Type %s has no component named %s"),
7431 type_as_string (type).c_str (), name_str);
7432 }
7433
7434 return NULL;
7435}
7436
7437/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
7438 within a value of type OUTER_TYPE, return true iff VAR_TYPE
7439 represents an unchecked union (that is, the variant part of a
7440 record that is named in an Unchecked_Union pragma). */
7441
7442static int
7443is_unchecked_variant (struct type *var_type, struct type *outer_type)
7444{
7445 const char *discrim_name = ada_variant_discrim_name (var_type);
7446
7447 return (ada_lookup_struct_elt_type (outer_type, discrim_name, 0, 1) == NULL);
7448}
7449
7450
7451/* Assuming that VAR_TYPE is the type of a variant part of a record (a union),
7452 within OUTER, determine which variant clause (field number in VAR_TYPE,
7453 numbering from 0) is applicable. Returns -1 if none are. */
7454
7455int
7456ada_which_variant_applies (struct type *var_type, struct value *outer)
7457{
7458 int others_clause;
7459 int i;
7460 const char *discrim_name = ada_variant_discrim_name (var_type);
7461 struct value *discrim;
7462 LONGEST discrim_val;
7463
7464 /* Using plain value_from_contents_and_address here causes problems
7465 because we will end up trying to resolve a type that is currently
7466 being constructed. */
7467 discrim = ada_value_struct_elt (outer, discrim_name, 1);
7468 if (discrim == NULL)
7469 return -1;
7470 discrim_val = value_as_long (discrim);
7471
7472 others_clause = -1;
7473 for (i = 0; i < var_type->num_fields (); i += 1)
7474 {
7475 if (ada_is_others_clause (var_type, i))
7476 others_clause = i;
7477 else if (ada_in_variant (discrim_val, var_type, i))
7478 return i;
7479 }
7480
7481 return others_clause;
7482}
7483
7484
7485
7486 /* Dynamic-Sized Records */
7487
7488/* Strategy: The type ostensibly attached to a value with dynamic size
7489 (i.e., a size that is not statically recorded in the debugging
7490 data) does not accurately reflect the size or layout of the value.
7491 Our strategy is to convert these values to values with accurate,
7492 conventional types that are constructed on the fly. */
7493
7494/* There is a subtle and tricky problem here. In general, we cannot
7495 determine the size of dynamic records without its data. However,
7496 the 'struct value' data structure, which GDB uses to represent
7497 quantities in the inferior process (the target), requires the size
7498 of the type at the time of its allocation in order to reserve space
7499 for GDB's internal copy of the data. That's why the
7500 'to_fixed_xxx_type' routines take (target) addresses as parameters,
7501 rather than struct value*s.
7502
7503 However, GDB's internal history variables ($1, $2, etc.) are
7504 struct value*s containing internal copies of the data that are not, in
7505 general, the same as the data at their corresponding addresses in
7506 the target. Fortunately, the types we give to these values are all
7507 conventional, fixed-size types (as per the strategy described
7508 above), so that we don't usually have to perform the
7509 'to_fixed_xxx_type' conversions to look at their values.
7510 Unfortunately, there is one exception: if one of the internal
7511 history variables is an array whose elements are unconstrained
7512 records, then we will need to create distinct fixed types for each
7513 element selected. */
7514
7515/* The upshot of all of this is that many routines take a (type, host
7516 address, target address) triple as arguments to represent a value.
7517 The host address, if non-null, is supposed to contain an internal
7518 copy of the relevant data; otherwise, the program is to consult the
7519 target at the target address. */
7520
7521/* Assuming that VAL0 represents a pointer value, the result of
7522 dereferencing it. Differs from value_ind in its treatment of
7523 dynamic-sized types. */
7524
7525struct value *
7526ada_value_ind (struct value *val0)
7527{
7528 struct value *val = value_ind (val0);
7529
7530 if (ada_is_tagged_type (value_type (val), 0))
7532
7533 return ada_to_fixed_value (val);
7534}
7535
7536/* The value resulting from dereferencing any "reference to"
7537 qualifiers on VAL0. */
7538
7539static struct value *
7540ada_coerce_ref (struct value *val0)
7541{
7542 if (value_type (val0)->code () == TYPE_CODE_REF)
7543 {
7544 struct value *val = val0;
7545
7546 val = coerce_ref (val);
7547
7548 if (ada_is_tagged_type (value_type (val), 0))
7550
7551 return ada_to_fixed_value (val);
7552 }
7553 else
7554 return val0;
7555}
7556
7557/* Return the bit alignment required for field #F of template type TYPE. */
7558
7559static unsigned int
7561{
7562 const char *name = type->field (f).name ();
7563 int len;
7564 int align_offset;
7565
7566 /* The field name should never be null, unless the debugging information
7567 is somehow malformed. In this case, we assume the field does not
7568 require any alignment. */
7569 if (name == NULL)
7570 return 1;
7571
7572 len = strlen (name);
7573
7574 if (!isdigit (name[len - 1]))
7575 return 1;
7576
7577 if (isdigit (name[len - 2]))
7578 align_offset = len - 2;
7579 else
7580 align_offset = len - 1;
7581
7582 if (align_offset < 7 || !startswith (name + align_offset - 6, "___XV"))
7583 return TARGET_CHAR_BIT;
7584
7585 return atoi (name + align_offset) * TARGET_CHAR_BIT;
7586}
7587
7588/* Find a typedef or tag symbol named NAME. Ignores ambiguity. */
7589
7590static struct symbol *
7592{
7593 struct symbol *sym;
7594
7596 if (sym != NULL && sym->aclass () == LOC_TYPEDEF)
7597 return sym;
7598
7599 sym = standard_lookup (name, NULL, STRUCT_DOMAIN);
7600 return sym;
7601}
7602
7603/* Find a type named NAME. Ignores ambiguity. This routine will look
7604 solely for types defined by debug info, it will not search the GDB
7605 primitive types. */
7606
7607static struct type *
7609{
7610 struct symbol *sym = ada_find_any_type_symbol (name);
7611
7612 if (sym != NULL)
7613 return sym->type ();
7614
7615 return NULL;
7616}
7617
7618/* Given NAME_SYM and an associated BLOCK, find a "renaming" symbol
7619 associated with NAME_SYM's name. NAME_SYM may itself be a renaming
7620 symbol, in which case it is returned. Otherwise, this looks for
7621 symbols whose name is that of NAME_SYM suffixed with "___XR".
7622 Return symbol if found, and NULL otherwise. */
7623
7624static bool
7626{
7627 const char *name = name_sym->linkage_name ();
7628 return strstr (name, "___XR") != NULL;
7629}
7630
7631/* Because of GNAT encoding conventions, several GDB symbols may match a
7632 given type name. If the type denoted by TYPE0 is to be preferred to
7633 that of TYPE1 for purposes of type printing, return non-zero;
7634 otherwise return 0. */
7635
7636int
7637ada_prefer_type (struct type *type0, struct type *type1)
7638{
7639 if (type1 == NULL)
7640 return 1;
7641 else if (type0 == NULL)
7642 return 0;
7643 else if (type1->code () == TYPE_CODE_VOID)
7644 return 1;
7645 else if (type0->code () == TYPE_CODE_VOID)
7646 return 0;
7647 else if (type1->name () == NULL && type0->name () != NULL)
7648 return 1;
7649 else if (ada_is_constrained_packed_array_type (type0))
7650 return 1;
7651 else if (ada_is_array_descriptor_type (type0)
7652 && !ada_is_array_descriptor_type (type1))
7653 return 1;
7654 else
7655 {
7656 const char *type0_name = type0->name ();
7657 const char *type1_name = type1->name ();
7658
7659 if (type0_name != NULL && strstr (type0_name, "___XR") != NULL
7660 && (type1_name == NULL || strstr (type1_name, "___XR") == NULL))
7661 return 1;
7662 }
7663 return 0;
7664}
7665
7666/* The name of TYPE, which is its TYPE_NAME. Null if TYPE is
7667 null. */
7668
7669const char *
7671{
7672 if (type == NULL)
7673 return NULL;
7674 return type->name ();
7675}
7676
7677/* Search the list of "descriptive" types associated to TYPE for a type
7678 whose name is NAME. */
7679
7680static struct type *
7682{
7683 struct type *result, *tmp;
7684
7686 return NULL;
7687
7688 /* If there no descriptive-type info, then there is no parallel type
7689 to be found. */
7690 if (!HAVE_GNAT_AUX_INFO (type))
7691 return NULL;
7692
7693 result = TYPE_DESCRIPTIVE_TYPE (type);
7694 while (result != NULL)
7695 {
7696 const char *result_name = ada_type_name (result);
7697
7698 if (result_name == NULL)
7699 {
7700 warning (_("unexpected null name on descriptive type"));
7701 return NULL;
7702 }
7703
7704 /* If the names match, stop. */
7705 if (strcmp (result_name, name) == 0)
7706 break;
7707
7708 /* Otherwise, look at the next item on the list, if any. */
7709 if (HAVE_GNAT_AUX_INFO (result))
7710 tmp = TYPE_DESCRIPTIVE_TYPE (result);
7711 else
7712 tmp = NULL;
7713
7714 /* If not found either, try after having resolved the typedef. */
7715 if (tmp != NULL)
7716 result = tmp;
7717 else
7718 {
7719 result = check_typedef (result);
7720 if (HAVE_GNAT_AUX_INFO (result))
7721 result = TYPE_DESCRIPTIVE_TYPE (result);
7722 else
7723 result = NULL;
7724 }
7725 }
7726
7727 /* If we didn't find a match, see whether this is a packed array. With
7728 older compilers, the descriptive type information is either absent or
7729 irrelevant when it comes to packed arrays so the above lookup fails.
7730 Fall back to using a parallel lookup by name in this case. */
7731 if (result == NULL && ada_is_constrained_packed_array_type (type))
7732 return ada_find_any_type (name);
7733
7734 return result;
7735}
7736
7737/* Find a parallel type to TYPE with the specified NAME, using the
7738 descriptive type taken from the debugging information, if available,
7739 and otherwise using the (slower) name-based method. */
7740
7741static struct type *
7743{
7744 struct type *result = NULL;
7745
7748 else
7749 result = ada_find_any_type (name);
7750
7751 return result;
7752}
7753
7754/* Same as above, but specify the name of the parallel type by appending
7755 SUFFIX to the name of TYPE. */
7756
7757struct type *
7758ada_find_parallel_type (struct type *type, const char *suffix)
7759{
7760 char *name;
7761 const char *type_name = ada_type_name (type);
7762 int len;
7763
7764 if (type_name == NULL)
7765 return NULL;
7766
7767 len = strlen (type_name);
7768
7769 name = (char *) alloca (len + strlen (suffix) + 1);
7770
7771 strcpy (name, type_name);
7772 strcpy (name + len, suffix);
7773
7775}
7776
7777/* If TYPE is a variable-size record type, return the corresponding template
7778 type describing its fields. Otherwise, return NULL. */
7779
7780static struct type *
7782{
7784
7785 if (type == NULL || type->code () != TYPE_CODE_STRUCT
7786 || ada_type_name (type) == NULL)
7787 return NULL;
7788 else
7789 {
7790 int len = strlen (ada_type_name (type));
7791
7792 if (len > 6 && strcmp (ada_type_name (type) + len - 6, "___XVE") == 0)
7793 return type;
7794 else
7795 return ada_find_parallel_type (type, "___XVE");
7796 }
7797}
7798
7799/* Assuming that TEMPL_TYPE is a union or struct type, returns
7800 non-zero iff field FIELD_NUM of TEMPL_TYPE has dynamic size. */
7801
7802static int
7803is_dynamic_field (struct type *templ_type, int field_num)
7804{
7805 const char *name = templ_type->field (field_num).name ();
7806
7807 return name != NULL
7808 && templ_type->field (field_num).type ()->code () == TYPE_CODE_PTR
7809 && strstr (name, "___XVL") != NULL;
7810}
7811
7812/* The index of the variant field of TYPE, or -1 if TYPE does not
7813 represent a variant record type. */
7814
7815static int
7817{
7818 int f;
7819
7820 if (type == NULL || type->code () != TYPE_CODE_STRUCT)
7821 return -1;
7822
7823 for (f = 0; f < type->num_fields (); f += 1)
7824 {
7825 if (ada_is_variant_part (type, f))
7826 return f;
7827 }
7828 return -1;
7829}
7830
7831/* A record type with no fields. */
7832
7833static struct type *
7834empty_record (struct type *templ)
7835{
7836 struct type *type = alloc_type_copy (templ);
7837
7838 type->set_code (TYPE_CODE_STRUCT);
7840 type->set_name ("<empty>");
7841 type->set_length (0);
7842 return type;
7843}
7844
7845/* An ordinary record type (with fixed-length fields) that describes
7846 the value of type TYPE at VALADDR or ADDRESS (see comments at
7847 the beginning of this section) VAL according to GNAT conventions.
7848 DVAL0 should describe the (portion of a) record that contains any
7849 necessary discriminants. It should be NULL if value_type (VAL) is
7850 an outer-level type (i.e., as opposed to a branch of a variant.) A
7851 variant field (unless unchecked) is replaced by a particular branch
7852 of the variant.
7853
7854 If not KEEP_DYNAMIC_FIELDS, then all fields whose position or
7855 length are not statically known are discarded. As a consequence,
7856 VALADDR, ADDRESS and DVAL0 are ignored.
7857
7858 NOTE: Limitations: For now, we assume that dynamic fields and
7859 variants occupy whole numbers of bytes. However, they need not be
7860 byte-aligned. */
7861
7862struct type *
7864 const gdb_byte *valaddr,
7865 CORE_ADDR address, struct value *dval0,
7866 int keep_dynamic_fields)
7867{
7868 struct value *dval;
7869 struct type *rtype;
7870 int nfields, bit_len;
7871 int variant_field;
7872 long off;
7873 int fld_bit_len;
7874 int f;
7875
7876 scoped_value_mark mark;
7877
7878 /* Compute the number of fields in this record type that are going
7879 to be processed: unless keep_dynamic_fields, this includes only
7880 fields whose position and length are static will be processed. */
7881 if (keep_dynamic_fields)
7882 nfields = type->num_fields ();
7883 else
7884 {
7885 nfields = 0;
7886 while (nfields < type->num_fields ()
7887 && !ada_is_variant_part (type, nfields)
7888 && !is_dynamic_field (type, nfields))
7889 nfields++;
7890 }
7891
7892 rtype = alloc_type_copy (type);
7893 rtype->set_code (TYPE_CODE_STRUCT);
7894 INIT_NONE_SPECIFIC (rtype);
7895 rtype->set_num_fields (nfields);
7896 rtype->set_fields
7897 ((struct field *) TYPE_ZALLOC (rtype, nfields * sizeof (struct field)));
7898 rtype->set_name (ada_type_name (type));
7899 rtype->set_is_fixed_instance (true);
7900
7901 off = 0;
7902 bit_len = 0;
7903 variant_field = -1;
7904
7905 for (f = 0; f < nfields; f += 1)
7906 {
7907 off = align_up (off, field_alignment (type, f))
7908 + type->field (f).loc_bitpos ();
7909 rtype->field (f).set_loc_bitpos (off);
7910 TYPE_FIELD_BITSIZE (rtype, f) = 0;
7911
7912 if (ada_is_variant_part (type, f))
7913 {
7914 variant_field = f;
7915 fld_bit_len = 0;
7916 }
7917 else if (is_dynamic_field (type, f))
7918 {
7919 const gdb_byte *field_valaddr = valaddr;
7920 CORE_ADDR field_address = address;
7921 struct type *field_type = type->field (f).type ()->target_type ();
7922
7923 if (dval0 == NULL)
7924 {
7925 /* Using plain value_from_contents_and_address here
7926 causes problems because we will end up trying to
7927 resolve a type that is currently being
7928 constructed. */
7930 valaddr,
7931 address);
7932 rtype = value_type (dval);
7933 }
7934 else
7935 dval = dval0;
7936
7937 /* If the type referenced by this field is an aligner type, we need
7938 to unwrap that aligner type, because its size might not be set.
7939 Keeping the aligner type would cause us to compute the wrong
7940 size for this field, impacting the offset of the all the fields
7941 that follow this one. */
7942 if (ada_is_aligner_type (field_type))
7943 {
7944 long field_offset = type->field (f).loc_bitpos ();
7945
7946 field_valaddr = cond_offset_host (field_valaddr, field_offset);
7947 field_address = cond_offset_target (field_address, field_offset);
7948 field_type = ada_aligned_type (field_type);
7949 }
7950
7951 field_valaddr = cond_offset_host (field_valaddr,
7952 off / TARGET_CHAR_BIT);
7953 field_address = cond_offset_target (field_address,
7954 off / TARGET_CHAR_BIT);
7955
7956 /* Get the fixed type of the field. Note that, in this case,
7957 we do not want to get the real type out of the tag: if
7958 the current field is the parent part of a tagged record,
7959 we will get the tag of the object. Clearly wrong: the real
7960 type of the parent is not the real type of the child. We
7961 would end up in an infinite loop. */
7962 field_type = ada_get_base_type (field_type);
7963 field_type = ada_to_fixed_type (field_type, field_valaddr,
7964 field_address, dval, 0);
7965
7966 rtype->field (f).set_type (field_type);
7967 rtype->field (f).set_name (type->field (f).name ());
7968 /* The multiplication can potentially overflow. But because
7969 the field length has been size-checked just above, and
7970 assuming that the maximum size is a reasonable value,
7971 an overflow should not happen in practice. So rather than
7972 adding overflow recovery code to this already complex code,
7973 we just assume that it's not going to happen. */
7974 fld_bit_len = rtype->field (f).type ()->length () * TARGET_CHAR_BIT;
7975 }
7976 else
7977 {
7978 /* Note: If this field's type is a typedef, it is important
7979 to preserve the typedef layer.
7980
7981 Otherwise, we might be transforming a typedef to a fat
7982 pointer (encoding a pointer to an unconstrained array),
7983 into a basic fat pointer (encoding an unconstrained
7984 array). As both types are implemented using the same
7985 structure, the typedef is the only clue which allows us
7986 to distinguish between the two options. Stripping it
7987 would prevent us from printing this field appropriately. */
7988 rtype->field (f).set_type (type->field (f).type ());
7989 rtype->field (f).set_name (type->field (f).name ());
7990 if (TYPE_FIELD_BITSIZE (type, f) > 0)
7991 fld_bit_len =
7993 else
7994 {
7995 struct type *field_type = type->field (f).type ();
7996
7997 /* We need to be careful of typedefs when computing
7998 the length of our field. If this is a typedef,
7999 get the length of the target type, not the length
8000 of the typedef. */
8001 if (field_type->code () == TYPE_CODE_TYPEDEF)
8002 field_type = ada_typedef_target_type (field_type);
8003
8004 fld_bit_len =
8005 ada_check_typedef (field_type)->length () * TARGET_CHAR_BIT;
8006 }
8007 }
8008 if (off + fld_bit_len > bit_len)
8009 bit_len = off + fld_bit_len;
8010 off += fld_bit_len;
8011 rtype->set_length (align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT);
8012 }
8013
8014 /* We handle the variant part, if any, at the end because of certain
8015 odd cases in which it is re-ordered so as NOT to be the last field of
8016 the record. This can happen in the presence of representation
8017 clauses. */
8018 if (variant_field >= 0)
8019 {
8020 struct type *branch_type;
8021
8022 off = rtype->field (variant_field).loc_bitpos ();
8023
8024 if (dval0 == NULL)
8025 {
8026 /* Using plain value_from_contents_and_address here causes
8027 problems because we will end up trying to resolve a type
8028 that is currently being constructed. */
8029 dval = value_from_contents_and_address_unresolved (rtype, valaddr,
8030 address);
8031 rtype = value_type (dval);
8032 }
8033 else
8034 dval = dval0;
8035
8036 branch_type =
8039 cond_offset_host (valaddr, off / TARGET_CHAR_BIT),
8040 cond_offset_target (address, off / TARGET_CHAR_BIT), dval);
8041 if (branch_type == NULL)
8042 {
8043 for (f = variant_field + 1; f < rtype->num_fields (); f += 1)
8044 rtype->field (f - 1) = rtype->field (f);
8045 rtype->set_num_fields (rtype->num_fields () - 1);
8046 }
8047 else
8048 {
8049 rtype->field (variant_field).set_type (branch_type);
8050 rtype->field (variant_field).set_name ("S");
8051 fld_bit_len =
8052 rtype->field (variant_field).type ()->length () * TARGET_CHAR_BIT;
8053 if (off + fld_bit_len > bit_len)
8054 bit_len = off + fld_bit_len;
8055
8056 rtype->set_length
8057 (align_up (bit_len, TARGET_CHAR_BIT) / TARGET_CHAR_BIT);
8058 }
8059 }
8060
8061 /* According to exp_dbug.ads, the size of TYPE for variable-size records
8062 should contain the alignment of that record, which should be a strictly
8063 positive value. If null or negative, then something is wrong, most
8064 probably in the debug info. In that case, we don't round up the size
8065 of the resulting type. If this record is not part of another structure,
8066 the current RTYPE length might be good enough for our purposes. */
8067 if (type->length () <= 0)
8068 {
8069 if (rtype->name ())
8070 warning (_("Invalid type size for `%s' detected: %s."),
8071 rtype->name (), pulongest (type->length ()));
8072 else
8073 warning (_("Invalid type size for <unnamed> detected: %s."),
8074 pulongest (type->length ()));
8075 }
8076 else
8077 rtype->set_length (align_up (rtype->length (), type->length ()));
8078
8079 return rtype;
8080}
8081
8082/* As for ada_template_to_fixed_record_type_1 with KEEP_DYNAMIC_FIELDS
8083 of 1. */
8084
8085static struct type *
8086template_to_fixed_record_type (struct type *type, const gdb_byte *valaddr,
8087 CORE_ADDR address, struct value *dval0)
8088{
8090 address, dval0, 1);
8091}
8092
8093/* An ordinary record type in which ___XVL-convention fields and
8094 ___XVU- and ___XVN-convention field types in TYPE0 are replaced with
8095 static approximations, containing all possible fields. Uses
8096 no runtime values. Useless for use in values, but that's OK,
8097 since the results are used only for type determinations. Works on both
8098 structs and unions. Representation note: to save space, we memorize
8099 the result of this function in the type::target_type of the
8100 template type. */
8101
8102static struct type *
8104{
8105 struct type *type;
8106 int nfields;
8107 int f;
8108
8109 /* No need no do anything if the input type is already fixed. */
8110 if (type0->is_fixed_instance ())
8111 return type0;
8112
8113 /* Likewise if we already have computed the static approximation. */
8114 if (type0->target_type () != NULL)
8115 return type0->target_type ();
8116
8117 /* Don't clone TYPE0 until we are sure we are going to need a copy. */
8118 type = type0;
8119 nfields = type0->num_fields ();
8120
8121 /* Whether or not we cloned TYPE0, cache the result so that we don't do
8122 recompute all over next time. */
8123 type0->set_target_type (type);
8124
8125 for (f = 0; f < nfields; f += 1)
8126 {
8127 struct type *field_type = type0->field (f).type ();
8128 struct type *new_type;
8129
8130 if (is_dynamic_field (type0, f))
8131 {
8132 field_type = ada_check_typedef (field_type);
8133 new_type = to_static_fixed_type (field_type->target_type ());
8134 }
8135 else
8136 new_type = static_unwrap_type (field_type);
8137
8138 if (new_type != field_type)
8139 {
8140 /* Clone TYPE0 only the first time we get a new field type. */
8141 if (type == type0)
8142 {
8143 type = alloc_type_copy (type0);
8144 type0->set_target_type (type);
8145 type->set_code (type0->code ());
8147 type->set_num_fields (nfields);
8148
8149 field *fields =
8150 ((struct field *)
8151 TYPE_ALLOC (type, nfields * sizeof (struct field)));
8152 memcpy (fields, type0->fields (),
8153 sizeof (struct field) * nfields);
8154 type->set_fields (fields);
8155
8156 type->set_name (ada_type_name (type0));
8158 type->set_length (0);
8159 }
8161 type->field (f).set_name (type0->field (f).name ());
8162 }
8163 }
8164
8165 return type;
8166}
8167
8168/* Given an object of type TYPE whose contents are at VALADDR and
8169 whose address in memory is ADDRESS, returns a revision of TYPE,
8170 which should be a non-dynamic-sized record, in which the variant
8171 part, if any, is replaced with the appropriate branch. Looks
8172 for discriminant values in DVAL0, which can be NULL if the record
8173 contains the necessary discriminant values. */
8174
8175static struct type *
8176to_record_with_fixed_variant_part (struct type *type, const gdb_byte *valaddr,
8177 CORE_ADDR address, struct value *dval0)
8178{
8179 struct value *dval;
8180 struct type *rtype;
8181 struct type *branch_type;
8182 int nfields = type->num_fields ();
8184
8185 if (variant_field == -1)
8186 return type;
8187
8188 scoped_value_mark mark;
8189 if (dval0 == NULL)
8190 {
8191 dval = value_from_contents_and_address (type, valaddr, address);
8192 type = value_type (dval);
8193 }
8194 else
8195 dval = dval0;
8196
8197 rtype = alloc_type_copy (type);
8198 rtype->set_code (TYPE_CODE_STRUCT);
8199 INIT_NONE_SPECIFIC (rtype);
8200 rtype->set_num_fields (nfields);
8201
8202 field *fields =
8203 (struct field *) TYPE_ALLOC (rtype, nfields * sizeof (struct field));
8204 memcpy (fields, type->fields (), sizeof (struct field) * nfields);
8205 rtype->set_fields (fields);
8206
8207 rtype->set_name (ada_type_name (type));
8208 rtype->set_is_fixed_instance (true);
8209 rtype->set_length (type->length ());
8210
8211 branch_type = to_fixed_variant_branch_type
8213 cond_offset_host (valaddr,
8215 / TARGET_CHAR_BIT),
8216 cond_offset_target (address,
8218 / TARGET_CHAR_BIT), dval);
8219 if (branch_type == NULL)
8220 {
8221 int f;
8222
8223 for (f = variant_field + 1; f < nfields; f += 1)
8224 rtype->field (f - 1) = rtype->field (f);
8225 rtype->set_num_fields (rtype->num_fields () - 1);
8226 }
8227 else
8228 {
8229 rtype->field (variant_field).set_type (branch_type);
8230 rtype->field (variant_field).set_name ("S");
8231 TYPE_FIELD_BITSIZE (rtype, variant_field) = 0;
8232 rtype->set_length (rtype->length () + branch_type->length ());
8233 }
8234
8235 rtype->set_length (rtype->length ()
8236 - type->field (variant_field).type ()->length ());
8237
8238 return rtype;
8239}
8240
8241/* An ordinary record type (with fixed-length fields) that describes
8242 the value at (TYPE0, VALADDR, ADDRESS) [see explanation at
8243 beginning of this section]. Any necessary discriminants' values
8244 should be in DVAL, a record value; it may be NULL if the object
8245 at ADDR itself contains any necessary discriminant values.
8246 Additionally, VALADDR and ADDRESS may also be NULL if no discriminant
8247 values from the record are needed. Except in the case that DVAL,
8248 VALADDR, and ADDRESS are all 0 or NULL, a variant field (unless
8249 unchecked) is replaced by a particular branch of the variant.
8250
8251 NOTE: the case in which DVAL and VALADDR are NULL and ADDRESS is 0
8252 is questionable and may be removed. It can arise during the
8253 processing of an unconstrained-array-of-record type where all the
8254 variant branches have exactly the same size. This is because in
8255 such cases, the compiler does not bother to use the XVS convention
8256 when encoding the record. I am currently dubious of this
8257 shortcut and suspect the compiler should be altered. FIXME. */
8258
8259static struct type *
8260to_fixed_record_type (struct type *type0, const gdb_byte *valaddr,
8261 CORE_ADDR address, struct value *dval)
8262{
8263 struct type *templ_type;
8264
8265 if (type0->is_fixed_instance ())
8266 return type0;
8267
8268 templ_type = dynamic_template_type (type0);
8269
8270 if (templ_type != NULL)
8271 return template_to_fixed_record_type (templ_type, valaddr, address, dval);
8272 else if (variant_field_index (type0) >= 0)
8273 {
8274 if (dval == NULL && valaddr == NULL && address == 0)
8275 return type0;
8276 return to_record_with_fixed_variant_part (type0, valaddr, address,
8277 dval);
8278 }
8279 else
8280 {
8281 type0->set_is_fixed_instance (true);
8282 return type0;
8283 }
8284
8285}
8286
8287/* An ordinary record type (with fixed-length fields) that describes
8288 the value at (VAR_TYPE0, VALADDR, ADDRESS), where VAR_TYPE0 is a
8289 union type. Any necessary discriminants' values should be in DVAL,
8290 a record value. That is, this routine selects the appropriate
8291 branch of the union at ADDR according to the discriminant value
8292 indicated in the union's type name. Returns VAR_TYPE0 itself if
8293 it represents a variant subject to a pragma Unchecked_Union. */
8294
8295static struct type *
8296to_fixed_variant_branch_type (struct type *var_type0, const gdb_byte *valaddr,
8297 CORE_ADDR address, struct value *dval)
8298{
8299 int which;
8300 struct type *templ_type;
8301 struct type *var_type;
8302
8303 if (var_type0->code () == TYPE_CODE_PTR)
8304 var_type = var_type0->target_type ();
8305 else
8306 var_type = var_type0;
8307
8308 templ_type = ada_find_parallel_type (var_type, "___XVU");
8309
8310 if (templ_type != NULL)
8311 var_type = templ_type;
8312
8313 if (is_unchecked_variant (var_type, value_type (dval)))
8314 return var_type0;
8315 which = ada_which_variant_applies (var_type, dval);
8316
8317 if (which < 0)
8318 return empty_record (var_type);
8319 else if (is_dynamic_field (var_type, which))
8321 (var_type->field (which).type ()->target_type(), valaddr, address, dval);
8322 else if (variant_field_index (var_type->field (which).type ()) >= 0)
8323 return
8325 (var_type->field (which).type (), valaddr, address, dval);
8326 else
8327 return var_type->field (which).type ();
8328}
8329
8330/* Assuming RANGE_TYPE is a TYPE_CODE_RANGE, return nonzero if
8331 ENCODING_TYPE, a type following the GNAT conventions for discrete
8332 type encodings, only carries redundant information. */
8333
8334static int
8336 struct type *encoding_type)
8337{
8338 const char *bounds_str;
8339 int n;
8340 LONGEST lo, hi;
8341
8342 gdb_assert (range_type->code () == TYPE_CODE_RANGE);
8343
8344 if (get_base_type (range_type)->code ()
8345 != get_base_type (encoding_type)->code ())
8346 {
8347 /* The compiler probably used a simple base type to describe
8348 the range type instead of the range's actual base type,
8349 expecting us to get the real base type from the encoding
8350 anyway. In this situation, the encoding cannot be ignored
8351 as redundant. */
8352 return 0;
8353 }
8354
8355 if (is_dynamic_type (range_type))
8356 return 0;
8357
8358 if (encoding_type->name () == NULL)
8359 return 0;
8360
8361 bounds_str = strstr (encoding_type->name (), "___XDLU_");
8362 if (bounds_str == NULL)
8363 return 0;
8364
8365 n = 8; /* Skip "___XDLU_". */
8366 if (!ada_scan_number (bounds_str, n, &lo, &n))
8367 return 0;
8368 if (range_type->bounds ()->low.const_val () != lo)
8369 return 0;
8370
8371 n += 2; /* Skip the "__" separator between the two bounds. */
8372 if (!ada_scan_number (bounds_str, n, &hi, &n))
8373 return 0;
8374 if (range_type->bounds ()->high.const_val () != hi)
8375 return 0;
8376
8377 return 1;
8378}
8379
8380/* Given the array type ARRAY_TYPE, return nonzero if DESC_TYPE,
8381 a type following the GNAT encoding for describing array type
8382 indices, only carries redundant information. */
8383
8384static int
8386 struct type *desc_type)
8387{
8388 struct type *this_layer = check_typedef (array_type);
8389 int i;
8390
8391 for (i = 0; i < desc_type->num_fields (); i++)
8392 {
8393 if (!ada_is_redundant_range_encoding (this_layer->index_type (),
8394 desc_type->field (i).type ()))
8395 return 0;
8396 this_layer = check_typedef (this_layer->target_type ());
8397 }
8398
8399 return 1;
8400}
8401
8402/* Assuming that TYPE0 is an array type describing the type of a value
8403 at ADDR, and that DVAL describes a record containing any
8404 discriminants used in TYPE0, returns a type for the value that
8405 contains no dynamic components (that is, no components whose sizes
8406 are determined by run-time quantities). Unless IGNORE_TOO_BIG is
8407 true, gives an error message if the resulting type's size is over
8408 varsize_limit. */
8409
8410static struct type *
8411to_fixed_array_type (struct type *type0, struct value *dval,
8412 int ignore_too_big)
8413{
8414 struct type *index_type_desc;
8415 struct type *result;
8416 int constrained_packed_array_p;
8417 static const char *xa_suffix = "___XA";
8418
8419 type0 = ada_check_typedef (type0);
8420 if (type0->is_fixed_instance ())
8421 return type0;
8422
8423 constrained_packed_array_p = ada_is_constrained_packed_array_type (type0);
8424 if (constrained_packed_array_p)
8425 {
8427 if (type0 == nullptr)
8428 error (_("could not decode constrained packed array type"));
8429 }
8430
8431 index_type_desc = ada_find_parallel_type (type0, xa_suffix);
8432
8433 /* As mentioned in exp_dbug.ads, for non bit-packed arrays an
8434 encoding suffixed with 'P' may still be generated. If so,
8435 it should be used to find the XA type. */
8436
8437 if (index_type_desc == NULL)
8438 {
8439 const char *type_name = ada_type_name (type0);
8440
8441 if (type_name != NULL)
8442 {
8443 const int len = strlen (type_name);
8444 char *name = (char *) alloca (len + strlen (xa_suffix));
8445
8446 if (type_name[len - 1] == 'P')
8447 {
8448 strcpy (name, type_name);
8449 strcpy (name + len - 1, xa_suffix);
8450 index_type_desc = ada_find_parallel_type_with_name (type0, name);
8451 }
8452 }
8453 }
8454
8455 ada_fixup_array_indexes_type (index_type_desc);
8456 if (index_type_desc != NULL
8457 && ada_is_redundant_index_type_desc (type0, index_type_desc))
8458 {
8459 /* Ignore this ___XA parallel type, as it does not bring any
8460 useful information. This allows us to avoid creating fixed
8461 versions of the array's index types, which would be identical
8462 to the original ones. This, in turn, can also help avoid
8463 the creation of fixed versions of the array itself. */
8464 index_type_desc = NULL;
8465 }
8466
8467 if (index_type_desc == NULL)
8468 {
8469 struct type *elt_type0 = ada_check_typedef (type0->target_type ());
8470
8471 /* NOTE: elt_type---the fixed version of elt_type0---should never
8472 depend on the contents of the array in properly constructed
8473 debugging data. */
8474 /* Create a fixed version of the array element type.
8475 We're not providing the address of an element here,
8476 and thus the actual object value cannot be inspected to do
8477 the conversion. This should not be a problem, since arrays of
8478 unconstrained objects are not allowed. In particular, all
8479 the elements of an array of a tagged type should all be of
8480 the same type specified in the debugging info. No need to
8481 consult the object tag. */
8482 struct type *elt_type = ada_to_fixed_type (elt_type0, 0, 0, dval, 1);
8483
8484 /* Make sure we always create a new array type when dealing with
8485 packed array types, since we're going to fix-up the array
8486 type length and element bitsize a little further down. */
8487 if (elt_type0 == elt_type && !constrained_packed_array_p)
8488 result = type0;
8489 else
8490 result = create_array_type (alloc_type_copy (type0),
8491 elt_type, type0->index_type ());
8492 }
8493 else
8494 {
8495 int i;
8496 struct type *elt_type0;
8497
8498 elt_type0 = type0;
8499 for (i = index_type_desc->num_fields (); i > 0; i -= 1)
8500 elt_type0 = elt_type0->target_type ();
8501
8502 /* NOTE: result---the fixed version of elt_type0---should never
8503 depend on the contents of the array in properly constructed
8504 debugging data. */
8505 /* Create a fixed version of the array element type.
8506 We're not providing the address of an element here,
8507 and thus the actual object value cannot be inspected to do
8508 the conversion. This should not be a problem, since arrays of
8509 unconstrained objects are not allowed. In particular, all
8510 the elements of an array of a tagged type should all be of
8511 the same type specified in the debugging info. No need to
8512 consult the object tag. */
8513 result =
8514 ada_to_fixed_type (ada_check_typedef (elt_type0), 0, 0, dval, 1);
8515
8516 elt_type0 = type0;
8517 for (i = index_type_desc->num_fields () - 1; i >= 0; i -= 1)
8518 {
8519 struct type *range_type =
8520 to_fixed_range_type (index_type_desc->field (i).type (), dval);
8521
8522 result = create_array_type (alloc_type_copy (elt_type0),
8523 result, range_type);
8524 elt_type0 = elt_type0->target_type ();
8525 }
8526 }
8527
8528 /* We want to preserve the type name. This can be useful when
8529 trying to get the type name of a value that has already been
8530 printed (for instance, if the user did "print VAR; whatis $". */
8531 result->set_name (type0->name ());
8532
8533 if (constrained_packed_array_p)
8534 {
8535 /* So far, the resulting type has been created as if the original
8536 type was a regular (non-packed) array type. As a result, the
8537 bitsize of the array elements needs to be set again, and the array
8538 length needs to be recomputed based on that bitsize. */
8539 int len = result->length () / result->target_type ()->length ();
8540 int elt_bitsize = TYPE_FIELD_BITSIZE (type0, 0);
8541
8542 TYPE_FIELD_BITSIZE (result, 0) = TYPE_FIELD_BITSIZE (type0, 0);
8543 result->set_length (len * elt_bitsize / HOST_CHAR_BIT);
8544 if (result->length () * HOST_CHAR_BIT < len * elt_bitsize)
8545 result->set_length (result->length () + 1);
8546 }
8547
8548 result->set_is_fixed_instance (true);
8549 return result;
8550}
8551
8552
8553/* A standard type (containing no dynamically sized components)
8554 corresponding to TYPE for the value (TYPE, VALADDR, ADDRESS)
8555 DVAL describes a record containing any discriminants used in TYPE0,
8556 and may be NULL if there are none, or if the object of type TYPE at
8557 ADDRESS or in VALADDR contains these discriminants.
8558
8559 If CHECK_TAG is not null, in the case of tagged types, this function
8560 attempts to locate the object's tag and use it to compute the actual
8561 type. However, when ADDRESS is null, we cannot use it to determine the
8562 location of the tag, and therefore compute the tagged type's actual type.
8563 So we return the tagged type without consulting the tag. */
8564
8565static struct type *
8566ada_to_fixed_type_1 (struct type *type, const gdb_byte *valaddr,
8567 CORE_ADDR address, struct value *dval, int check_tag)
8568{
8570
8571 /* Only un-fixed types need to be handled here. */
8572 if (!HAVE_GNAT_AUX_INFO (type))
8573 return type;
8574
8575 switch (type->code ())
8576 {
8577 default:
8578 return type;
8579 case TYPE_CODE_STRUCT:
8580 {
8581 struct type *static_type = to_static_fixed_type (type);
8582 struct type *fixed_record_type =
8583 to_fixed_record_type (type, valaddr, address, NULL);
8584
8585 /* If STATIC_TYPE is a tagged type and we know the object's address,
8586 then we can determine its tag, and compute the object's actual
8587 type from there. Note that we have to use the fixed record
8588 type (the parent part of the record may have dynamic fields
8589 and the way the location of _tag is expressed may depend on
8590 them). */
8591
8592 if (check_tag && address != 0 && ada_is_tagged_type (static_type, 0))
8593 {
8594 struct value *tag =
8596 (fixed_record_type,
8597 valaddr,
8598 address);
8599 struct type *real_type = type_from_tag (tag);
8600 struct value *obj =
8601 value_from_contents_and_address (fixed_record_type,
8602 valaddr,
8603 address);
8604 fixed_record_type = value_type (obj);
8605 if (real_type != NULL)
8607 (real_type, NULL,
8609 }
8610
8611 /* Check to see if there is a parallel ___XVZ variable.
8612 If there is, then it provides the actual size of our type. */
8613 else if (ada_type_name (fixed_record_type) != NULL)
8614 {
8615 const char *name = ada_type_name (fixed_record_type);
8616 char *xvz_name
8617 = (char *) alloca (strlen (name) + 7 /* "___XVZ\0" */);
8618 bool xvz_found = false;
8619 LONGEST size;
8620
8621 xsnprintf (xvz_name, strlen (name) + 7, "%s___XVZ", name);
8622 try
8623 {
8624 xvz_found = get_int_var_value (xvz_name, size);
8625 }
8626 catch (const gdb_exception_error &except)
8627 {
8628 /* We found the variable, but somehow failed to read
8629 its value. Rethrow the same error, but with a little
8630 bit more information, to help the user understand
8631 what went wrong (Eg: the variable might have been
8632 optimized out). */
8633 throw_error (except.error,
8634 _("unable to read value of %s (%s)"),
8635 xvz_name, except.what ());
8636 }
8637
8638 if (xvz_found && fixed_record_type->length () != size)
8639 {
8640 fixed_record_type = copy_type (fixed_record_type);
8641 fixed_record_type->set_length (size);
8642
8643 /* The FIXED_RECORD_TYPE may have be a stub. We have
8644 observed this when the debugging info is STABS, and
8645 apparently it is something that is hard to fix.
8646
8647 In practice, we don't need the actual type definition
8648 at all, because the presence of the XVZ variable allows us
8649 to assume that there must be a XVS type as well, which we
8650 should be able to use later, when we need the actual type
8651 definition.
8652
8653 In the meantime, pretend that the "fixed" type we are
8654 returning is NOT a stub, because this can cause trouble
8655 when using this type to create new types targeting it.
8656 Indeed, the associated creation routines often check
8657 whether the target type is a stub and will try to replace
8658 it, thus using a type with the wrong size. This, in turn,
8659 might cause the new type to have the wrong size too.
8660 Consider the case of an array, for instance, where the size
8661 of the array is computed from the number of elements in
8662 our array multiplied by the size of its element. */
8663 fixed_record_type->set_is_stub (false);
8664 }
8665 }
8666 return fixed_record_type;
8667 }
8668 case TYPE_CODE_ARRAY:
8669 return to_fixed_array_type (type, dval, 1);
8670 case TYPE_CODE_UNION:
8671 if (dval == NULL)
8672 return type;
8673 else
8674 return to_fixed_variant_branch_type (type, valaddr, address, dval);
8675 }
8676}
8677
8678/* The same as ada_to_fixed_type_1, except that it preserves the type
8679 if it is a TYPE_CODE_TYPEDEF of a type that is already fixed.
8680
8681 The typedef layer needs be preserved in order to differentiate between
8682 arrays and array pointers when both types are implemented using the same
8683 fat pointer. In the array pointer case, the pointer is encoded as
8684 a typedef of the pointer type. For instance, considering:
8685
8686 type String_Access is access String;
8687 S1 : String_Access := null;
8688
8689 To the debugger, S1 is defined as a typedef of type String. But
8690 to the user, it is a pointer. So if the user tries to print S1,
8691 we should not dereference the array, but print the array address
8692 instead.
8693
8694 If we didn't preserve the typedef layer, we would lose the fact that
8695 the type is to be presented as a pointer (needs de-reference before
8696 being printed). And we would also use the source-level type name. */
8697
8698struct type *
8699ada_to_fixed_type (struct type *type, const gdb_byte *valaddr,
8700 CORE_ADDR address, struct value *dval, int check_tag)
8701
8702{
8703 struct type *fixed_type =
8704 ada_to_fixed_type_1 (type, valaddr, address, dval, check_tag);
8705
8706 /* If TYPE is a typedef and its target type is the same as the FIXED_TYPE,
8707 then preserve the typedef layer.
8708
8709 Implementation note: We can only check the main-type portion of
8710 the TYPE and FIXED_TYPE, because eliminating the typedef layer
8711 from TYPE now returns a type that has the same instance flags
8712 as TYPE. For instance, if TYPE is a "typedef const", and its
8713 target type is a "struct", then the typedef elimination will return
8714 a "const" version of the target type. See check_typedef for more
8715 details about how the typedef layer elimination is done.
8716
8717 brobecker/2010-11-19: It seems to me that the only case where it is
8718 useful to preserve the typedef layer is when dealing with fat pointers.
8719 Perhaps, we could add a check for that and preserve the typedef layer
8720 only in that situation. But this seems unnecessary so far, probably
8721 because we call check_typedef/ada_check_typedef pretty much everywhere.
8722 */
8723 if (type->code () == TYPE_CODE_TYPEDEF
8725 == TYPE_MAIN_TYPE (fixed_type)))
8726 return type;
8727
8728 return fixed_type;
8729}
8730
8731/* A standard (static-sized) type corresponding as well as possible to
8732 TYPE0, but based on no runtime data. */
8733
8734static struct type *
8736{
8737 struct type *type;
8738
8739 if (type0 == NULL)
8740 return NULL;
8741
8742 if (type0->is_fixed_instance ())
8743 return type0;
8744
8745 type0 = ada_check_typedef (type0);
8746
8747 switch (type0->code ())
8748 {
8749 default:
8750 return type0;
8751 case TYPE_CODE_STRUCT:
8752 type = dynamic_template_type (type0);
8753 if (type != NULL)
8755 else
8756 return template_to_static_fixed_type (type0);
8757 case TYPE_CODE_UNION:
8758 type = ada_find_parallel_type (type0, "___XVU");
8759 if (type != NULL)
8761 else
8762 return template_to_static_fixed_type (type0);
8763 }
8764}
8765
8766/* A static approximation of TYPE with all type wrappers removed. */
8767
8768static struct type *
8770{
8772 {
8773 struct type *type1 = ada_check_typedef (type)->field (0).type ();
8774 if (ada_type_name (type1) == NULL)
8775 type1->set_name (ada_type_name (type));
8776
8777 return static_unwrap_type (type1);
8778 }
8779 else
8780 {
8781 struct type *raw_real_type = ada_get_base_type (type);
8782
8783 if (raw_real_type == type)
8784 return type;
8785 else
8786 return to_static_fixed_type (raw_real_type);
8787 }
8788}
8789
8790/* In some cases, incomplete and private types require
8791 cross-references that are not resolved as records (for example,
8792 type Foo;
8793 type FooP is access Foo;
8794 V: FooP;
8795 type Foo is array ...;
8796 ). In these cases, since there is no mechanism for producing
8797 cross-references to such types, we instead substitute for FooP a
8798 stub enumeration type that is nowhere resolved, and whose tag is
8799 the name of the actual type. Call these types "non-record stubs". */
8800
8801/* A type equivalent to TYPE that is not a non-record stub, if one
8802 exists, otherwise TYPE. */
8803
8804struct type *
8806{
8807 if (type == NULL)
8808 return NULL;
8809
8810 /* If our type is an access to an unconstrained array, which is encoded
8811 as a TYPE_CODE_TYPEDEF of a fat pointer, then we're done.
8812 We don't want to strip the TYPE_CODE_TYPDEF layer, because this is
8813 what allows us to distinguish between fat pointers that represent
8814 array types, and fat pointers that represent array access types
8815 (in both cases, the compiler implements them as fat pointers). */
8817 return type;
8818
8820 if (type == NULL || type->code () != TYPE_CODE_ENUM
8821 || !type->is_stub ()
8822 || type->name () == NULL)
8823 return type;
8824 else
8825 {
8826 const char *name = type->name ();
8827 struct type *type1 = ada_find_any_type (name);
8828
8829 if (type1 == NULL)
8830 return type;
8831
8832 /* TYPE1 might itself be a TYPE_CODE_TYPEDEF (this can happen with
8833 stubs pointing to arrays, as we don't create symbols for array
8834 types, only for the typedef-to-array types). If that's the case,
8835 strip the typedef layer. */
8836 if (type1->code () == TYPE_CODE_TYPEDEF)
8837 type1 = ada_check_typedef (type1);
8838
8839 return type1;
8840 }
8841}
8842
8843/* A value representing the data at VALADDR/ADDRESS as described by
8844 type TYPE0, but with a standard (static-sized) type that correctly
8845 describes it. If VAL0 is not NULL and TYPE0 already is a standard
8846 type, then return VAL0 [this feature is simply to avoid redundant
8847 creation of struct values]. */
8848
8849static struct value *
8850ada_to_fixed_value_create (struct type *type0, CORE_ADDR address,
8851 struct value *val0)
8852{
8853 struct type *type = ada_to_fixed_type (type0, 0, address, NULL, 1);
8854
8855 if (type == type0 && val0 != NULL)
8856 return val0;
8857
8858 if (VALUE_LVAL (val0) != lval_memory)
8859 {
8860 /* Our value does not live in memory; it could be a convenience
8861 variable, for instance. Create a not_lval value using val0's
8862 contents. */
8863 return value_from_contents (type, value_contents (val0).data ());
8864 }
8865
8866 return value_from_contents_and_address (type, 0, address);
8867}
8868
8869/* A value representing VAL, but with a standard (static-sized) type
8870 that correctly describes it. Does not necessarily create a new
8871 value. */
8872
8873struct value *
8875{
8876 val = unwrap_value (val);
8877 val = ada_to_fixed_value_create (value_type (val), value_address (val), val);
8878 return val;
8879}
8880
8881
8882/* Attributes */
8883
8884/* Table mapping attribute numbers to names.
8885 NOTE: Keep up to date with enum ada_attribute definition in ada-lang.h. */
8886
8887static const char * const attribute_names[] = {
8888 "<?>",
8889
8890 "first",
8891 "last",
8892 "length",
8893 "image",
8894 "max",
8895 "min",
8896 "modulus",
8897 "pos",
8898 "size",
8899 "tag",
8900 "val",
8901 0
8902};
8903
8904static const char *
8906{
8907 if (n >= OP_ATR_FIRST && n <= (int) OP_ATR_VAL)
8908 return attribute_names[n - OP_ATR_FIRST + 1];
8909 else
8910 return attribute_names[0];
8911}
8912
8913/* Evaluate the 'POS attribute applied to ARG. */
8914
8915static LONGEST
8916pos_atr (struct value *arg)
8917{
8918 struct value *val = coerce_ref (arg);
8919 struct type *type = value_type (val);
8920
8921 if (!discrete_type_p (type))
8922 error (_("'POS only defined on discrete types"));
8923
8924 gdb::optional<LONGEST> result = discrete_position (type, value_as_long (val));
8925 if (!result.has_value ())
8926 error (_("enumeration value is invalid: can't find 'POS"));
8927
8928 return *result;
8929}
8930
8931struct value *
8932ada_pos_atr (struct type *expect_type,
8933 struct expression *exp,
8934 enum noside noside, enum exp_opcode op,
8935 struct value *arg)
8936{
8937 struct type *type = builtin_type (exp->gdbarch)->builtin_int;
8939 return value_zero (type, not_lval);
8940 return value_from_longest (type, pos_atr (arg));
8941}
8942
8943/* Evaluate the TYPE'VAL attribute applied to ARG. */
8944
8945static struct value *
8946val_atr (struct type *type, LONGEST val)
8947{
8948 gdb_assert (discrete_type_p (type));
8949 if (type->code () == TYPE_CODE_RANGE)
8950 type = type->target_type ();
8951 if (type->code () == TYPE_CODE_ENUM)
8952 {
8953 if (val < 0 || val >= type->num_fields ())
8954 error (_("argument to 'VAL out of range"));
8955 val = type->field (val).loc_enumval ();
8956 }
8957 return value_from_longest (type, val);
8958}
8959
8960struct value *
8961ada_val_atr (enum noside noside, struct type *type, struct value *arg)
8962{
8964 return value_zero (type, not_lval);
8965
8966 if (!discrete_type_p (type))
8967 error (_("'VAL only defined on discrete types"));
8968 if (!integer_type_p (value_type (arg)))
8969 error (_("'VAL requires integral argument"));
8970
8971 return val_atr (type, value_as_long (arg));
8972}
8973
8974
8975 /* Evaluation */
8976
8977/* True if TYPE appears to be an Ada character type.
8978 [At the moment, this is true only for Character and Wide_Character;
8979 It is a heuristic test that could stand improvement]. */
8980
8981bool
8983{
8984 const char *name;
8985
8986 /* If the type code says it's a character, then assume it really is,
8987 and don't check any further. */
8988 if (type->code () == TYPE_CODE_CHAR)
8989 return true;
8990
8991 /* Otherwise, assume it's a character type iff it is a discrete type
8992 with a known character type name. */
8994 return (name != NULL
8995 && (type->code () == TYPE_CODE_INT
8996 || type->code () == TYPE_CODE_RANGE)
8997 && (strcmp (name, "character") == 0
8998 || strcmp (name, "wide_character") == 0
8999 || strcmp (name, "wide_wide_character") == 0
9000 || strcmp (name, "unsigned char") == 0));
9001}
9002
9003/* True if TYPE appears to be an Ada string type. */
9004
9005bool
9007{
9009 if (type != NULL
9010 && type->code () != TYPE_CODE_PTR
9013 && ada_array_arity (type) == 1)
9014 {
9015 struct type *elttype = ada_array_element_type (type, 1);
9016
9017 return ada_is_character_type (elttype);
9018 }
9019 else
9020 return false;
9021}
9022
9023/* The compiler sometimes provides a parallel XVS type for a given
9024 PAD type. Normally, it is safe to follow the PAD type directly,
9025 but older versions of the compiler have a bug that causes the offset
9026 of its "F" field to be wrong. Following that field in that case
9027 would lead to incorrect results, but this can be worked around
9028 by ignoring the PAD type and using the associated XVS type instead.
9029
9030 Set to True if the debugger should trust the contents of PAD types.
9031 Otherwise, ignore the PAD type if there is a parallel XVS type. */
9032static bool trust_pad_over_xvs = true;
9033
9034/* True if TYPE is a struct type introduced by the compiler to force the
9035 alignment of a value. Such types have a single field with a
9036 distinctive name. */
9037
9038int
9040{
9042
9043 if (!trust_pad_over_xvs && ada_find_parallel_type (type, "___XVS") != NULL)
9044 return 0;
9045
9046 return (type->code () == TYPE_CODE_STRUCT
9047 && type->num_fields () == 1
9048 && strcmp (type->field (0).name (), "F") == 0);
9049}
9050
9051/* If there is an ___XVS-convention type parallel to SUBTYPE, return
9052 the parallel type. */
9053
9054struct type *
9055ada_get_base_type (struct type *raw_type)
9056{
9057 struct type *real_type_namer;
9058 struct type *raw_real_type;
9059
9060 if (raw_type == NULL || raw_type->code () != TYPE_CODE_STRUCT)
9061 return raw_type;
9062
9063 if (ada_is_aligner_type (raw_type))
9064 /* The encoding specifies that we should always use the aligner type.
9065 So, even if this aligner type has an associated XVS type, we should
9066 simply ignore it.
9067
9068 According to the compiler gurus, an XVS type parallel to an aligner
9069 type may exist because of a stabs limitation. In stabs, aligner
9070 types are empty because the field has a variable-sized type, and
9071 thus cannot actually be used as an aligner type. As a result,
9072 we need the associated parallel XVS type to decode the type.
9073 Since the policy in the compiler is to not change the internal
9074 representation based on the debugging info format, we sometimes
9075 end up having a redundant XVS type parallel to the aligner type. */
9076 return raw_type;
9077
9078 real_type_namer = ada_find_parallel_type (raw_type, "___XVS");
9079 if (real_type_namer == NULL
9080 || real_type_namer->code () != TYPE_CODE_STRUCT
9081 || real_type_namer->num_fields () != 1)
9082 return raw_type;
9083
9084 if (real_type_namer->field (0).type ()->code () != TYPE_CODE_REF)
9085 {
9086 /* This is an older encoding form where the base type needs to be
9087 looked up by name. We prefer the newer encoding because it is
9088 more efficient. */
9089 raw_real_type = ada_find_any_type (real_type_namer->field (0).name ());
9090 if (raw_real_type == NULL)
9091 return raw_type;
9092 else
9093 return raw_real_type;
9094 }
9095
9096 /* The field in our XVS type is a reference to the base type. */
9097 return real_type_namer->field (0).type ()->target_type ();
9098}
9099
9100/* The type of value designated by TYPE, with all aligners removed. */
9101
9102struct type *
9104{
9106 return ada_aligned_type (type->field (0).type ());
9107 else
9108 return ada_get_base_type (type);
9109}
9110
9111
9112/* The address of the aligned value in an object at address VALADDR
9113 having type TYPE. Assumes ada_is_aligner_type (TYPE). */
9114
9115const gdb_byte *
9116ada_aligned_value_addr (struct type *type, const gdb_byte *valaddr)
9117{
9120 (type->field (0).type (),
9121 valaddr + type->field (0).loc_bitpos () / TARGET_CHAR_BIT);
9122 else
9123 return valaddr;
9124}
9125
9126
9127
9128/* The printed representation of an enumeration literal with encoded
9129 name NAME. The value is good to the next call of ada_enum_name. */
9130const char *
9131ada_enum_name (const char *name)
9132{
9133 static std::string storage;
9134 const char *tmp;
9135
9136 /* First, unqualify the enumeration name:
9137 1. Search for the last '.' character. If we find one, then skip
9138 all the preceding characters, the unqualified name starts
9139 right after that dot.
9140 2. Otherwise, we may be debugging on a target where the compiler
9141 translates dots into "__". Search forward for double underscores,
9142 but stop searching when we hit an overloading suffix, which is
9143 of the form "__" followed by digits. */
9144
9145 tmp = strrchr (name, '.');
9146 if (tmp != NULL)
9147 name = tmp + 1;
9148 else
9149 {
9150 while ((tmp = strstr (name, "__")) != NULL)
9151 {
9152 if (isdigit (tmp[2]))
9153 break;
9154 else
9155 name = tmp + 2;
9156 }
9157 }
9158
9159 if (name[0] == 'Q')
9160 {
9161 int v;
9162
9163 if (name[1] == 'U' || name[1] == 'W')
9164 {
9165 int offset = 2;
9166 if (name[1] == 'W' && name[2] == 'W')
9167 {
9168 /* Also handle the QWW case. */
9169 ++offset;
9170 }
9171 if (sscanf (name + offset, "%x", &v) != 1)
9172 return name;
9173 }
9174 else if (((name[1] >= '0' && name[1] <= '9')
9175 || (name[1] >= 'a' && name[1] <= 'z'))
9176 && name[2] == '\0')
9177 {
9178 storage = string_printf ("'%c'", name[1]);
9179 return storage.c_str ();
9180 }
9181 else
9182 return name;
9183
9184 if (isascii (v) && isprint (v))
9185 storage = string_printf ("'%c'", v);
9186 else if (name[1] == 'U')
9187 storage = string_printf ("'[\"%02x\"]'", v);
9188 else if (name[2] != 'W')
9189 storage = string_printf ("'[\"%04x\"]'", v);
9190 else
9191 storage = string_printf ("'[\"%06x\"]'", v);
9192
9193 return storage.c_str ();
9194 }
9195 else
9196 {
9197 tmp = strstr (name, "__");
9198 if (tmp == NULL)
9199 tmp = strstr (name, "$");
9200 if (tmp != NULL)
9201 {
9202 storage = std::string (name, tmp - name);
9203 return storage.c_str ();
9204 }
9205
9206 return name;
9207 }
9208}
9209
9210/* If VAL is wrapped in an aligner or subtype wrapper, return the
9211 value it wraps. */
9212
9213static struct value *
9214unwrap_value (struct value *val)
9215{
9216 struct type *type = ada_check_typedef (value_type (val));
9217
9219 {
9220 struct value *v = ada_value_struct_elt (val, "F", 0);
9221 struct type *val_type = ada_check_typedef (value_type (v));
9222
9223 if (ada_type_name (val_type) == NULL)
9224 val_type->set_name (ada_type_name (type));
9225
9226 return unwrap_value (v);
9227 }
9228 else
9229 {
9230 struct type *raw_real_type =
9232
9233 /* If there is no parallel XVS or XVE type, then the value is
9234 already unwrapped. Return it without further modification. */
9235 if ((type == raw_real_type)
9236 && ada_find_parallel_type (type, "___XVE") == NULL)
9237 return val;
9238
9239 return
9241 (val, ada_to_fixed_type (raw_real_type, 0,
9242 value_address (val),
9243 NULL, 1));
9244 }
9245}
9246
9247/* Given two array types T1 and T2, return nonzero iff both arrays
9248 contain the same number of elements. */
9249
9250static int
9251ada_same_array_size_p (struct type *t1, struct type *t2)
9252{
9253 LONGEST lo1, hi1, lo2, hi2;
9254
9255 /* Get the array bounds in order to verify that the size of
9256 the two arrays match. */
9257 if (!get_array_bounds (t1, &lo1, &hi1)
9258 || !get_array_bounds (t2, &lo2, &hi2))
9259 error (_("unable to determine array bounds"));
9260
9261 /* To make things easier for size comparison, normalize a bit
9262 the case of empty arrays by making sure that the difference
9263 between upper bound and lower bound is always -1. */
9264 if (lo1 > hi1)
9265 hi1 = lo1 - 1;
9266 if (lo2 > hi2)
9267 hi2 = lo2 - 1;
9268
9269 return (hi1 - lo1 == hi2 - lo2);
9270}
9271
9272/* Assuming that VAL is an array of integrals, and TYPE represents
9273 an array with the same number of elements, but with wider integral
9274 elements, return an array "casted" to TYPE. In practice, this
9275 means that the returned array is built by casting each element
9276 of the original array into TYPE's (wider) element type. */
9277
9278static struct value *
9280{
9281 struct type *elt_type = type->target_type ();
9282 LONGEST lo, hi;
9283 LONGEST i;
9284
9285 /* Verify that both val and type are arrays of scalars, and
9286 that the size of val's elements is smaller than the size
9287 of type's element. */
9288 gdb_assert (type->code () == TYPE_CODE_ARRAY);
9289 gdb_assert (is_integral_type (type->target_type ()));
9290 gdb_assert (value_type (val)->code () == TYPE_CODE_ARRAY);
9291 gdb_assert (is_integral_type (value_type (val)->target_type ()));
9292 gdb_assert (type->target_type ()->length ()
9293 > value_type (val)->target_type ()->length ());
9294
9295 if (!get_array_bounds (type, &lo, &hi))
9296 error (_("unable to determine array bounds"));
9297
9298 value *res = allocate_value (type);
9299 gdb::array_view<gdb_byte> res_contents = value_contents_writeable (res);
9300
9301 /* Promote each array element. */
9302 for (i = 0; i < hi - lo + 1; i++)
9303 {
9304 struct value *elt = value_cast (elt_type, value_subscript (val, lo + i));
9305 int elt_len = elt_type->length ();
9306
9307 copy (value_contents_all (elt), res_contents.slice (elt_len * i, elt_len));
9308 }
9309
9310 return res;
9311}
9312
9313/* Coerce VAL as necessary for assignment to an lval of type TYPE, and
9314 return the converted value. */
9315
9316static struct value *
9317coerce_for_assign (struct type *type, struct value *val)
9318{
9319 struct type *type2 = value_type (val);
9320
9321 if (type == type2)
9322 return val;
9323
9324 type2 = ada_check_typedef (type2);
9326
9327 if (type2->code () == TYPE_CODE_PTR
9328 && type->code () == TYPE_CODE_ARRAY)
9329 {
9330 val = ada_value_ind (val);
9331 type2 = value_type (val);
9332 }
9333
9334 if (type2->code () == TYPE_CODE_ARRAY
9335 && type->code () == TYPE_CODE_ARRAY)
9336 {
9337 if (!ada_same_array_size_p (type, type2))
9338 error (_("cannot assign arrays of different length"));
9339
9341 && is_integral_type (type2->target_type ())
9342 && type2->target_type ()->length () < type->target_type ()->length ())
9343 {
9344 /* Allow implicit promotion of the array elements to
9345 a wider type. */
9347 }
9348
9349 if (type2->target_type ()->length () != type->target_type ()->length ())
9350 error (_("Incompatible types in assignment"));
9352 }
9353 return val;
9354}
9355
9356static struct value *
9357ada_value_binop (struct value *arg1, struct value *arg2, enum exp_opcode op)
9358{
9359 struct value *val;
9360 struct type *type1, *type2;
9361 LONGEST v, v1, v2;
9362
9363 arg1 = coerce_ref (arg1);
9364 arg2 = coerce_ref (arg2);
9365 type1 = get_base_type (ada_check_typedef (value_type (arg1)));
9366 type2 = get_base_type (ada_check_typedef (value_type (arg2)));
9367
9368 if (type1->code () != TYPE_CODE_INT
9369 || type2->code () != TYPE_CODE_INT)
9370 return value_binop (arg1, arg2, op);
9371
9372 switch (op)
9373 {
9374 case BINOP_MOD:
9375 case BINOP_DIV:
9376 case BINOP_REM:
9377 break;
9378 default:
9379 return value_binop (arg1, arg2, op);
9380 }
9381
9382 v2 = value_as_long (arg2);
9383 if (v2 == 0)
9384 {
9385 const char *name;
9386 if (op == BINOP_MOD)
9387 name = "mod";
9388 else if (op == BINOP_DIV)
9389 name = "/";
9390 else
9391 {
9392 gdb_assert (op == BINOP_REM);
9393 name = "rem";
9394 }
9395
9396 error (_("second operand of %s must not be zero."), name);
9397 }
9398
9399 if (type1->is_unsigned () || op == BINOP_MOD)
9400 return value_binop (arg1, arg2, op);
9401
9402 v1 = value_as_long (arg1);
9403 switch (op)
9404 {
9405 case BINOP_DIV:
9406 v = v1 / v2;
9407 if (!TRUNCATION_TOWARDS_ZERO && v1 * (v1 % v2) < 0)
9408 v += v > 0 ? -1 : 1;
9409 break;
9410 case BINOP_REM:
9411 v = v1 % v2;
9412 if (v * v1 < 0)
9413 v -= v2;
9414 break;
9415 default:
9416 /* Should not reach this point. */
9417 v = 0;
9418 }
9419
9420 val = allocate_value (type1);
9422 value_type (val)->length (),
9423 type_byte_order (type1), v);
9424 return val;
9425}
9426
9427static int
9428ada_value_equal (struct value *arg1, struct value *arg2)
9429{
9432 {
9433 struct type *arg1_type, *arg2_type;
9434
9435 /* Automatically dereference any array reference before
9436 we attempt to perform the comparison. */
9437 arg1 = ada_coerce_ref (arg1);
9438 arg2 = ada_coerce_ref (arg2);
9439
9440 arg1 = ada_coerce_to_simple_array (arg1);
9441 arg2 = ada_coerce_to_simple_array (arg2);
9442
9443 arg1_type = ada_check_typedef (value_type (arg1));
9444 arg2_type = ada_check_typedef (value_type (arg2));
9445
9446 if (arg1_type->code () != TYPE_CODE_ARRAY
9447 || arg2_type->code () != TYPE_CODE_ARRAY)
9448 error (_("Attempt to compare array with non-array"));
9449 /* FIXME: The following works only for types whose
9450 representations use all bits (no padding or undefined bits)
9451 and do not have user-defined equality. */
9452 return (arg1_type->length () == arg2_type->length ()
9453 && memcmp (value_contents (arg1).data (),
9454 value_contents (arg2).data (),
9455 arg1_type->length ()) == 0);
9456 }
9457 return value_equal (arg1, arg2);
9458}
9459
9460namespace expr
9461{
9462
9463bool
9464check_objfile (const std::unique_ptr<ada_component> &comp,
9465 struct objfile *objfile)
9466{
9467 return comp->uses_objfile (objfile);
9468}
9469
9470/* Assign the result of evaluating ARG starting at *POS to the INDEXth
9471 component of LHS (a simple array or a record). Does not modify the
9472 inferior's memory, nor does it modify LHS (unless LHS ==
9473 CONTAINER). */
9474
9475static void
9476assign_component (struct value *container, struct value *lhs, LONGEST index,
9477 struct expression *exp, operation_up &arg)
9478{
9479 scoped_value_mark mark;
9480
9481 struct value *elt;
9482 struct type *lhs_type = check_typedef (value_type (lhs));
9483
9484 if (lhs_type->code () == TYPE_CODE_ARRAY)
9485 {
9486 struct type *index_type = builtin_type (exp->gdbarch)->builtin_int;
9487 struct value *index_val = value_from_longest (index_type, index);
9488
9489 elt = unwrap_value (ada_value_subscript (lhs, 1, &index_val));
9490 }
9491 else
9492 {
9493 elt = ada_index_struct_field (index, lhs, 0, value_type (lhs));
9494 elt = ada_to_fixed_value (elt);
9495 }
9496
9498 = dynamic_cast<ada_aggregate_operation *> (arg.get ());
9499 if (ag_op != nullptr)
9500 ag_op->assign_aggregate (container, elt, exp);
9501 else
9502 value_assign_to_component (container, elt,
9503 arg->evaluate (nullptr, exp,
9504 EVAL_NORMAL));
9505}
9506
9507bool
9509{
9510 for (const auto &item : m_components)
9511 if (item->uses_objfile (objfile))
9512 return true;
9513 return false;
9514}
9515
9516void
9518{
9519 gdb_printf (stream, _("%*sAggregate\n"), depth, "");
9520 for (const auto &item : m_components)
9521 item->dump (stream, depth + 1);
9522}
9523
9524void
9526 struct value *lhs, struct expression *exp,
9527 std::vector<LONGEST> &indices,
9528 LONGEST low, LONGEST high)
9529{
9530 for (auto &item : m_components)
9531 item->assign (container, lhs, exp, indices, low, high);
9532}
9533
9534/* See ada-exp.h. */
9535
9536value *
9538 struct value *lhs,
9539 struct expression *exp)
9540{
9541 struct type *lhs_type;
9542 LONGEST low_index, high_index;
9543
9544 container = ada_coerce_ref (container);
9545 if (ada_is_direct_array_type (value_type (container)))
9546 container = ada_coerce_to_simple_array (container);
9547 lhs = ada_coerce_ref (lhs);
9548 if (!deprecated_value_modifiable (lhs))
9549 error (_("Left operand of assignment is not a modifiable lvalue."));
9550
9551 lhs_type = check_typedef (value_type (lhs));
9552 if (ada_is_direct_array_type (lhs_type))
9553 {
9554 lhs = ada_coerce_to_simple_array (lhs);
9555 lhs_type = check_typedef (value_type (lhs));
9556 low_index = lhs_type->bounds ()->low.const_val ();
9557 high_index = lhs_type->bounds ()->high.const_val ();
9558 }
9559 else if (lhs_type->code () == TYPE_CODE_STRUCT)
9560 {
9561 low_index = 0;
9562 high_index = num_visible_fields (lhs_type) - 1;
9563 }
9564 else
9565 error (_("Left-hand side must be array or record."));
9566
9567 std::vector<LONGEST> indices (4);
9568 indices[0] = indices[1] = low_index - 1;
9569 indices[2] = indices[3] = high_index + 1;
9570
9571 std::get<0> (m_storage)->assign (container, lhs, exp, indices,
9572 low_index, high_index);
9573
9574 return container;
9575}
9576
9577bool
9579{
9580 return m_op->uses_objfile (objfile);
9581}
9582
9583void
9585{
9586 gdb_printf (stream, _("%*sPositional, index = %d\n"),
9587 depth, "", m_index);
9588 m_op->dump (stream, depth + 1);
9589}
9590
9591/* Assign into the component of LHS indexed by the OP_POSITIONAL
9592 construct, given that the positions are relative to lower bound
9593 LOW, where HIGH is the upper bound. Record the position in
9594 INDICES. CONTAINER is as for assign_aggregate. */
9595void
9597 struct value *lhs, struct expression *exp,
9598 std::vector<LONGEST> &indices,
9599 LONGEST low, LONGEST high)
9600{
9601 LONGEST ind = m_index + low;
9602
9603 if (ind - 1 == high)
9604 warning (_("Extra components in aggregate ignored."));
9605 if (ind <= high)
9606 {
9607 add_component_interval (ind, ind, indices);
9608 assign_component (container, lhs, ind, exp, m_op);
9609 }
9610}
9611
9612bool
9614{
9615 return m_low->uses_objfile (objfile) || m_high->uses_objfile (objfile);
9616}
9617
9618void
9620{
9621 gdb_printf (stream, _("%*sDiscrete range:\n"), depth, "");
9622 m_low->dump (stream, depth + 1);
9623 m_high->dump (stream, depth + 1);
9624}
9625
9626void
9628 struct value *lhs,
9629 struct expression *exp,
9630 std::vector<LONGEST> &indices,
9631 LONGEST low, LONGEST high,
9632 operation_up &op)
9633{
9634 LONGEST lower = value_as_long (m_low->evaluate (nullptr, exp, EVAL_NORMAL));
9635 LONGEST upper = value_as_long (m_high->evaluate (nullptr, exp, EVAL_NORMAL));
9636
9637 if (lower <= upper && (lower < low || upper > high))
9638 error (_("Index in component association out of bounds."));
9639
9640 add_component_interval (lower, upper, indices);
9641 while (lower <= upper)
9642 {
9643 assign_component (container, lhs, lower, exp, op);
9644 lower += 1;
9645 }
9646}
9647
9648bool
9650{
9651 return m_val->uses_objfile (objfile);
9652}
9653
9654void
9656{
9657 gdb_printf (stream, _("%*sName:\n"), depth, "");
9658 m_val->dump (stream, depth + 1);
9659}
9660
9661void
9663 struct value *lhs,
9664 struct expression *exp,
9665 std::vector<LONGEST> &indices,
9666 LONGEST low, LONGEST high,
9667 operation_up &op)
9668{
9669 int index;
9670
9672 index = longest_to_int (value_as_long (m_val->evaluate (nullptr, exp,
9673 EVAL_NORMAL)));
9674 else
9675 {
9677 = dynamic_cast<ada_string_operation *> (m_val.get ());
9678
9679 const char *name;
9680 if (strop != nullptr)
9681 name = strop->get_name ();
9682 else
9683 {
9685 = dynamic_cast<ada_var_value_operation *> (m_val.get ());
9686 if (vvo != nullptr)
9687 error (_("Invalid record component association."));
9688 name = vvo->get_symbol ()->natural_name ();
9689 }
9690
9691 index = 0;
9692 if (! find_struct_field (name, value_type (lhs), 0,
9693 NULL, NULL, NULL, NULL, &index))
9694 error (_("Unknown component name: %s."), name);
9695 }
9696
9697 add_component_interval (index, index, indices);
9698 assign_component (container, lhs, index, exp, op);
9699}
9700
9701bool
9703{
9704 if (m_op->uses_objfile (objfile))
9705 return true;
9706 for (const auto &item : m_assocs)
9707 if (item->uses_objfile (objfile))
9708 return true;
9709 return false;
9710}
9711
9712void
9714{
9715 gdb_printf (stream, _("%*sChoices:\n"), depth, "");
9716 m_op->dump (stream, depth + 1);
9717 for (const auto &item : m_assocs)
9718 item->dump (stream, depth + 1);
9719}
9720
9721/* Assign into the components of LHS indexed by the OP_CHOICES
9722 construct at *POS, updating *POS past the construct, given that
9723 the allowable indices are LOW..HIGH. Record the indices assigned
9724 to in INDICES. CONTAINER is as for assign_aggregate. */
9725void
9727 struct value *lhs, struct expression *exp,
9728 std::vector<LONGEST> &indices,
9729 LONGEST low, LONGEST high)
9730{
9731 for (auto &item : m_assocs)
9732 item->assign (container, lhs, exp, indices, low, high, m_op);
9733}
9734
9735bool
9737{
9738 return m_op->uses_objfile (objfile);
9739}
9740
9741void
9743{
9744 gdb_printf (stream, _("%*sOthers:\n"), depth, "");
9745 m_op->dump (stream, depth + 1);
9746}
9747
9748/* Assign the value of the expression in the OP_OTHERS construct in
9749 EXP at *POS into the components of LHS indexed from LOW .. HIGH that
9750 have not been previously assigned. The index intervals already assigned
9751 are in INDICES. CONTAINER is as for assign_aggregate. */
9752void
9754 struct value *lhs, struct expression *exp,
9755 std::vector<LONGEST> &indices,
9756 LONGEST low, LONGEST high)
9757{
9758 int num_indices = indices.size ();
9759 for (int i = 0; i < num_indices - 2; i += 2)
9760 {
9761 for (LONGEST ind = indices[i + 1] + 1; ind < indices[i + 2]; ind += 1)
9762 assign_component (container, lhs, ind, exp, m_op);
9763 }
9764}
9765
9766struct value *
9768 struct expression *exp,
9769 enum noside noside)
9770{
9771 value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
9772
9774 = dynamic_cast<ada_aggregate_operation *> (std::get<1> (m_storage).get ());
9775 if (ag_op != nullptr)
9776 {
9777 if (noside != EVAL_NORMAL)
9778 return arg1;
9779
9780 arg1 = ag_op->assign_aggregate (arg1, arg1, exp);
9781 return ada_value_assign (arg1, arg1);
9782 }
9783 /* Force the evaluation of the rhs ARG2 to the type of the lhs ARG1,
9784 except if the lhs of our assignment is a convenience variable.
9785 In the case of assigning to a convenience variable, the lhs
9786 should be exactly the result of the evaluation of the rhs. */
9787 struct type *type = value_type (arg1);
9788 if (VALUE_LVAL (arg1) == lval_internalvar)
9789 type = NULL;
9790 value *arg2 = std::get<1> (m_storage)->evaluate (type, exp, noside);
9792 return arg1;
9793 if (VALUE_LVAL (arg1) == lval_internalvar)
9794 {
9795 /* Nothing. */
9796 }
9797 else
9798 arg2 = coerce_for_assign (value_type (arg1), arg2);
9799 return ada_value_assign (arg1, arg2);
9800}
9801
9802} /* namespace expr */
9803
9804/* Add the interval [LOW .. HIGH] to the sorted set of intervals
9805 [ INDICES[0] .. INDICES[1] ],... The resulting intervals do not
9806 overlap. */
9807static void
9808add_component_interval (LONGEST low, LONGEST high,
9809 std::vector<LONGEST> &indices)
9810{
9811 int i, j;
9812
9813 int size = indices.size ();
9814 for (i = 0; i < size; i += 2) {
9815 if (high >= indices[i] && low <= indices[i + 1])
9816 {
9817 int kh;
9818
9819 for (kh = i + 2; kh < size; kh += 2)
9820 if (high < indices[kh])
9821 break;
9822 if (low < indices[i])
9823 indices[i] = low;
9824 indices[i + 1] = indices[kh - 1];
9825 if (high > indices[i + 1])
9826 indices[i + 1] = high;
9827 memcpy (indices.data () + i + 2, indices.data () + kh, size - kh);
9828 indices.resize (kh - i - 2);
9829 return;
9830 }
9831 else if (high < indices[i])
9832 break;
9833 }
9834
9835 indices.resize (indices.size () + 2);
9836 for (j = indices.size () - 1; j >= i + 2; j -= 1)
9837 indices[j] = indices[j - 2];
9838 indices[i] = low;
9839 indices[i + 1] = high;
9840}
9841
9842/* Perform and Ada cast of ARG2 to type TYPE if the type of ARG2
9843 is different. */
9844
9845static struct value *
9846ada_value_cast (struct type *type, struct value *arg2)
9847{
9848 if (type == ada_check_typedef (value_type (arg2)))
9849 return arg2;
9850
9851 return value_cast (type, arg2);
9852}
9853
9854/* Evaluating Ada expressions, and printing their result.
9855 ------------------------------------------------------
9856
9857 1. Introduction:
9858 ----------------
9859
9860 We usually evaluate an Ada expression in order to print its value.
9861 We also evaluate an expression in order to print its type, which
9862 happens during the EVAL_AVOID_SIDE_EFFECTS phase of the evaluation,
9863 but we'll focus mostly on the EVAL_NORMAL phase. In practice, the
9864 EVAL_AVOID_SIDE_EFFECTS phase allows us to simplify certain aspects of
9865 the evaluation compared to the EVAL_NORMAL, but is otherwise very
9866 similar.
9867
9868 Evaluating expressions is a little more complicated for Ada entities
9869 than it is for entities in languages such as C. The main reason for
9870 this is that Ada provides types whose definition might be dynamic.
9871 One example of such types is variant records. Or another example
9872 would be an array whose bounds can only be known at run time.
9873
9874 The following description is a general guide as to what should be
9875 done (and what should NOT be done) in order to evaluate an expression
9876 involving such types, and when. This does not cover how the semantic
9877 information is encoded by GNAT as this is covered separatly. For the
9878 document used as the reference for the GNAT encoding, see exp_dbug.ads
9879 in the GNAT sources.
9880
9881 Ideally, we should embed each part of this description next to its
9882 associated code. Unfortunately, the amount of code is so vast right
9883 now that it's hard to see whether the code handling a particular
9884 situation might be duplicated or not. One day, when the code is
9885 cleaned up, this guide might become redundant with the comments
9886 inserted in the code, and we might want to remove it.
9887
9888 2. ``Fixing'' an Entity, the Simple Case:
9889 -----------------------------------------
9890
9891 When evaluating Ada expressions, the tricky issue is that they may
9892 reference entities whose type contents and size are not statically
9893 known. Consider for instance a variant record:
9894
9895 type Rec (Empty : Boolean := True) is record
9896 case Empty is
9897 when True => null;
9898 when False => Value : Integer;
9899 end case;
9900 end record;
9901 Yes : Rec := (Empty => False, Value => 1);
9902 No : Rec := (empty => True);
9903
9904 The size and contents of that record depends on the value of the
9905 descriminant (Rec.Empty). At this point, neither the debugging
9906 information nor the associated type structure in GDB are able to
9907 express such dynamic types. So what the debugger does is to create
9908 "fixed" versions of the type that applies to the specific object.
9909 We also informally refer to this operation as "fixing" an object,
9910 which means creating its associated fixed type.
9911
9912 Example: when printing the value of variable "Yes" above, its fixed
9913 type would look like this:
9914
9915 type Rec is record
9916 Empty : Boolean;
9917 Value : Integer;
9918 end record;
9919
9920 On the other hand, if we printed the value of "No", its fixed type
9921 would become:
9922
9923 type Rec is record
9924 Empty : Boolean;
9925 end record;
9926
9927 Things become a little more complicated when trying to fix an entity
9928 with a dynamic type that directly contains another dynamic type,
9929 such as an array of variant records, for instance. There are
9930 two possible cases: Arrays, and records.
9931
9932 3. ``Fixing'' Arrays:
9933 ---------------------
9934
9935 The type structure in GDB describes an array in terms of its bounds,
9936 and the type of its elements. By design, all elements in the array
9937 have the same type and we cannot represent an array of variant elements
9938 using the current type structure in GDB. When fixing an array,
9939 we cannot fix the array element, as we would potentially need one
9940 fixed type per element of the array. As a result, the best we can do
9941 when fixing an array is to produce an array whose bounds and size
9942 are correct (allowing us to read it from memory), but without having
9943 touched its element type. Fixing each element will be done later,
9944 when (if) necessary.
9945
9946 Arrays are a little simpler to handle than records, because the same
9947 amount of memory is allocated for each element of the array, even if
9948 the amount of space actually used by each element differs from element
9949 to element. Consider for instance the following array of type Rec:
9950
9951 type Rec_Array is array (1 .. 2) of Rec;
9952
9953 The actual amount of memory occupied by each element might be different
9954 from element to element, depending on the value of their discriminant.
9955 But the amount of space reserved for each element in the array remains
9956 fixed regardless. So we simply need to compute that size using
9957 the debugging information available, from which we can then determine
9958 the array size (we multiply the number of elements of the array by
9959 the size of each element).
9960
9961 The simplest case is when we have an array of a constrained element
9962 type. For instance, consider the following type declarations:
9963
9964 type Bounded_String (Max_Size : Integer) is
9965 Length : Integer;
9966 Buffer : String (1 .. Max_Size);
9967 end record;
9968 type Bounded_String_Array is array (1 ..2) of Bounded_String (80);
9969
9970 In this case, the compiler describes the array as an array of
9971 variable-size elements (identified by its XVS suffix) for which
9972 the size can be read in the parallel XVZ variable.
9973
9974 In the case of an array of an unconstrained element type, the compiler
9975 wraps the array element inside a private PAD type. This type should not
9976 be shown to the user, and must be "unwrap"'ed before printing. Note
9977 that we also use the adjective "aligner" in our code to designate
9978 these wrapper types.
9979
9980 In some cases, the size allocated for each element is statically
9981 known. In that case, the PAD type already has the correct size,
9982 and the array element should remain unfixed.
9983
9984 But there are cases when this size is not statically known.
9985 For instance, assuming that "Five" is an integer variable:
9986
9987 type Dynamic is array (1 .. Five) of Integer;
9988 type Wrapper (Has_Length : Boolean := False) is record
9989 Data : Dynamic;
9990 case Has_Length is
9991 when True => Length : Integer;
9992 when False => null;
9993 end case;
9994 end record;
9995 type Wrapper_Array is array (1 .. 2) of Wrapper;
9996
9997 Hello : Wrapper_Array := (others => (Has_Length => True,
9998 Data => (others => 17),
9999 Length => 1));
10000
10001
10002 The debugging info would describe variable Hello as being an
10003 array of a PAD type. The size of that PAD type is not statically
10004 known, but can be determined using a parallel XVZ variable.
10005 In that case, a copy of the PAD type with the correct size should
10006 be used for the fixed array.
10007
10008 3. ``Fixing'' record type objects:
10009 ----------------------------------
10010
10011 Things are slightly different from arrays in the case of dynamic
10012 record types. In this case, in order to compute the associated
10013 fixed type, we need to determine the size and offset of each of
10014 its components. This, in turn, requires us to compute the fixed
10015 type of each of these components.
10016
10017 Consider for instance the example:
10018
10019 type Bounded_String (Max_Size : Natural) is record
10020 Str : String (1 .. Max_Size);
10021 Length : Natural;
10022 end record;
10023 My_String : Bounded_String (Max_Size => 10);
10024
10025 In that case, the position of field "Length" depends on the size
10026 of field Str, which itself depends on the value of the Max_Size
10027 discriminant. In order to fix the type of variable My_String,
10028 we need to fix the type of field Str. Therefore, fixing a variant
10029 record requires us to fix each of its components.
10030
10031 However, if a component does not have a dynamic size, the component
10032 should not be fixed. In particular, fields that use a PAD type
10033 should not fixed. Here is an example where this might happen
10034 (assuming type Rec above):
10035
10036 type Container (Big : Boolean) is record
10037 First : Rec;
10038 After : Integer;
10039 case Big is
10040 when True => Another : Integer;
10041 when False => null;
10042 end case;
10043 end record;
10044 My_Container : Container := (Big => False,
10045 First => (Empty => True),
10046 After => 42);
10047
10048 In that example, the compiler creates a PAD type for component First,
10049 whose size is constant, and then positions the component After just
10050 right after it. The offset of component After is therefore constant
10051 in this case.
10052
10053 The debugger computes the position of each field based on an algorithm
10054 that uses, among other things, the actual position and size of the field
10055 preceding it. Let's now imagine that the user is trying to print
10056 the value of My_Container. If the type fixing was recursive, we would
10057 end up computing the offset of field After based on the size of the
10058 fixed version of field First. And since in our example First has
10059 only one actual field, the size of the fixed type is actually smaller
10060 than the amount of space allocated to that field, and thus we would
10061 compute the wrong offset of field After.
10062
10063 To make things more complicated, we need to watch out for dynamic
10064 components of variant records (identified by the ___XVL suffix in
10065 the component name). Even if the target type is a PAD type, the size
10066 of that type might not be statically known. So the PAD type needs
10067 to be unwrapped and the resulting type needs to be fixed. Otherwise,
10068 we might end up with the wrong size for our component. This can be
10069 observed with the following type declarations:
10070
10071 type Octal is new Integer range 0 .. 7;
10072 type Octal_Array is array (Positive range <>) of Octal;
10073 pragma Pack (Octal_Array);
10074
10075 type Octal_Buffer (Size : Positive) is record
10076 Buffer : Octal_Array (1 .. Size);
10077 Length : Integer;
10078 end record;
10079
10080 In that case, Buffer is a PAD type whose size is unset and needs
10081 to be computed by fixing the unwrapped type.
10082
10083 4. When to ``Fix'' un-``Fixed'' sub-elements of an entity:
10084 ----------------------------------------------------------
10085
10086 Lastly, when should the sub-elements of an entity that remained unfixed
10087 thus far, be actually fixed?
10088
10089 The answer is: Only when referencing that element. For instance
10090 when selecting one component of a record, this specific component
10091 should be fixed at that point in time. Or when printing the value
10092 of a record, each component should be fixed before its value gets
10093 printed. Similarly for arrays, the element of the array should be
10094 fixed when printing each element of the array, or when extracting
10095 one element out of that array. On the other hand, fixing should
10096 not be performed on the elements when taking a slice of an array!
10097
10098 Note that one of the side effects of miscomputing the offset and
10099 size of each field is that we end up also miscomputing the size
10100 of the containing type. This can have adverse results when computing
10101 the value of an entity. GDB fetches the value of an entity based
10102 on the size of its type, and thus a wrong size causes GDB to fetch
10103 the wrong amount of memory. In the case where the computed size is
10104 too small, GDB fetches too little data to print the value of our
10105 entity. Results in this case are unpredictable, as we usually read
10106 past the buffer containing the data =:-o. */
10107
10108/* A helper function for TERNOP_IN_RANGE. */
10109
10110static value *
10111eval_ternop_in_range (struct type *expect_type, struct expression *exp,
10112 enum noside noside,
10113 value *arg1, value *arg2, value *arg3)
10114{
10115 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10116 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
10117 struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
10118 return
10120 (value_less (arg1, arg3)
10121 || value_equal (arg1, arg3))
10122 && (value_less (arg2, arg1)
10123 || value_equal (arg2, arg1)));
10124}
10125
10126/* A helper function for UNOP_NEG. */
10127
10128value *
10129ada_unop_neg (struct type *expect_type,
10130 struct expression *exp,
10131 enum noside noside, enum exp_opcode op,
10132 struct value *arg1)
10133{
10134 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
10135 return value_neg (arg1);
10136}
10137
10138/* A helper function for UNOP_IN_RANGE. */
10139
10140value *
10141ada_unop_in_range (struct type *expect_type,
10142 struct expression *exp,
10143 enum noside noside, enum exp_opcode op,
10144 struct value *arg1, struct type *type)
10145{
10146 struct value *arg2, *arg3;
10147 switch (type->code ())
10148 {
10149 default:
10150 lim_warning (_("Membership test incompletely implemented; "
10151 "always returns true"));
10153 return value_from_longest (type, (LONGEST) 1);
10154
10155 case TYPE_CODE_RANGE:
10156 arg2 = value_from_longest (type,
10157 type->bounds ()->low.const_val ());
10158 arg3 = value_from_longest (type,
10159 type->bounds ()->high.const_val ());
10160 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10161 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
10163 return
10165 (value_less (arg1, arg3)
10166 || value_equal (arg1, arg3))
10167 && (value_less (arg2, arg1)
10168 || value_equal (arg2, arg1)));
10169 }
10170}
10171
10172/* A helper function for OP_ATR_TAG. */
10173
10174value *
10175ada_atr_tag (struct type *expect_type,
10176 struct expression *exp,
10177 enum noside noside, enum exp_opcode op,
10178 struct value *arg1)
10179{
10181 return value_zero (ada_tag_type (arg1), not_lval);
10182
10183 return ada_value_tag (arg1);
10184}
10185
10186/* A helper function for OP_ATR_SIZE. */
10187
10188value *
10189ada_atr_size (struct type *expect_type,
10190 struct expression *exp,
10191 enum noside noside, enum exp_opcode op,
10192 struct value *arg1)
10193{
10194 struct type *type = value_type (arg1);
10195
10196 /* If the argument is a reference, then dereference its type, since
10197 the user is really asking for the size of the actual object,
10198 not the size of the pointer. */
10199 if (type->code () == TYPE_CODE_REF)
10200 type = type->target_type ();
10201
10204 else
10206 TARGET_CHAR_BIT * type->length ());
10207}
10208
10209/* A helper function for UNOP_ABS. */
10210
10211value *
10212ada_abs (struct type *expect_type,
10213 struct expression *exp,
10214 enum noside noside, enum exp_opcode op,
10215 struct value *arg1)
10216{
10217 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
10218 if (value_less (arg1, value_zero (value_type (arg1), not_lval)))
10219 return value_neg (arg1);
10220 else
10221 return arg1;
10222}
10223
10224/* A helper function for BINOP_MUL. */
10225
10226value *
10227ada_mult_binop (struct type *expect_type,
10228 struct expression *exp,
10229 enum noside noside, enum exp_opcode op,
10230 struct value *arg1, struct value *arg2)
10231{
10233 {
10234 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10235 return value_zero (value_type (arg1), not_lval);
10236 }
10237 else
10238 {
10239 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10240 return ada_value_binop (arg1, arg2, op);
10241 }
10242}
10243
10244/* A helper function for BINOP_EQUAL and BINOP_NOTEQUAL. */
10245
10246value *
10247ada_equal_binop (struct type *expect_type,
10248 struct expression *exp,
10249 enum noside noside, enum exp_opcode op,
10250 struct value *arg1, struct value *arg2)
10251{
10252 int tem;
10254 tem = 0;
10255 else
10256 {
10257 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10258 tem = ada_value_equal (arg1, arg2);
10259 }
10260 if (op == BINOP_NOTEQUAL)
10261 tem = !tem;
10262 struct type *type = language_bool_type (exp->language_defn, exp->gdbarch);
10263 return value_from_longest (type, (LONGEST) tem);
10264}
10265
10266/* A helper function for TERNOP_SLICE. */
10267
10268value *
10270 enum noside noside,
10271 struct value *array, struct value *low_bound_val,
10272 struct value *high_bound_val)
10273{
10274 LONGEST low_bound;
10275 LONGEST high_bound;
10276
10277 low_bound_val = coerce_ref (low_bound_val);
10278 high_bound_val = coerce_ref (high_bound_val);
10279 low_bound = value_as_long (low_bound_val);
10280 high_bound = value_as_long (high_bound_val);
10281
10282 /* If this is a reference to an aligner type, then remove all
10283 the aligners. */
10284 if (value_type (array)->code () == TYPE_CODE_REF
10287 (ada_aligned_type (value_type (array)->target_type ()));
10288
10290 error (_("cannot slice a packed array"));
10291
10292 /* If this is a reference to an array or an array lvalue,
10293 convert to a pointer. */
10294 if (value_type (array)->code () == TYPE_CODE_REF
10295 || (value_type (array)->code () == TYPE_CODE_ARRAY
10296 && VALUE_LVAL (array) == lval_memory))
10297 array = value_addr (array);
10298
10301 (value_type (array))))
10302 return empty_array (ada_type_of_array (array, 0), low_bound,
10303 high_bound);
10304
10305 array = ada_coerce_to_simple_array_ptr (array);
10306
10307 /* If we have more than one level of pointer indirection,
10308 dereference the value until we get only one level. */
10309 while (value_type (array)->code () == TYPE_CODE_PTR
10310 && (value_type (array)->target_type ()->code ()
10311 == TYPE_CODE_PTR))
10312 array = value_ind (array);
10313
10314 /* Make sure we really do have an array type before going further,
10315 to avoid a SEGV when trying to get the index type or the target
10316 type later down the road if the debug info generated by
10317 the compiler is incorrect or incomplete. */
10318 if (!ada_is_simple_array_type (value_type (array)))
10319 error (_("cannot take slice of non-array"));
10320
10321 if (ada_check_typedef (value_type (array))->code ()
10322 == TYPE_CODE_PTR)
10323 {
10324 struct type *type0 = ada_check_typedef (value_type (array));
10325
10326 if (high_bound < low_bound || noside == EVAL_AVOID_SIDE_EFFECTS)
10327 return empty_array (type0->target_type (), low_bound, high_bound);
10328 else
10329 {
10330 struct type *arr_type0 =
10331 to_fixed_array_type (type0->target_type (), NULL, 1);
10332
10333 return ada_value_slice_from_ptr (array, arr_type0,
10334 longest_to_int (low_bound),
10335 longest_to_int (high_bound));
10336 }
10337 }
10338 else if (noside == EVAL_AVOID_SIDE_EFFECTS)
10339 return array;
10340 else if (high_bound < low_bound)
10341 return empty_array (value_type (array), low_bound, high_bound);
10342 else
10343 return ada_value_slice (array, longest_to_int (low_bound),
10344 longest_to_int (high_bound));
10345}
10346
10347/* A helper function for BINOP_IN_BOUNDS. */
10348
10349value *
10351 struct value *arg1, struct value *arg2, int n)
10352{
10354 {
10355 struct type *type = language_bool_type (exp->language_defn,
10356 exp->gdbarch);
10357 return value_zero (type, not_lval);
10358 }
10359
10360 struct type *type = ada_index_type (value_type (arg2), n, "range");
10361 if (!type)
10362 type = value_type (arg1);
10363
10364 value *arg3 = value_from_longest (type, ada_array_bound (arg2, n, 1));
10365 arg2 = value_from_longest (type, ada_array_bound (arg2, n, 0));
10366
10367 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10368 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg3);
10370 return value_from_longest (type,
10371 (value_less (arg1, arg3)
10372 || value_equal (arg1, arg3))
10373 && (value_less (arg2, arg1)
10374 || value_equal (arg2, arg1)));
10375}
10376
10377/* A helper function for some attribute operations. */
10378
10379static value *
10380ada_unop_atr (struct expression *exp, enum noside noside, enum exp_opcode op,
10381 struct value *arg1, struct type *type_arg, int tem)
10382{
10384 {
10385 if (type_arg == NULL)
10386 type_arg = value_type (arg1);
10387
10389 type_arg = decode_constrained_packed_array_type (type_arg);
10390
10391 if (!discrete_type_p (type_arg))
10392 {
10393 switch (op)
10394 {
10395 default: /* Should never happen. */
10396 error (_("unexpected attribute encountered"));
10397 case OP_ATR_FIRST:
10398 case OP_ATR_LAST:
10399 type_arg = ada_index_type (type_arg, tem,
10400 ada_attribute_name (op));
10401 break;
10402 case OP_ATR_LENGTH:
10403 type_arg = builtin_type (exp->gdbarch)->builtin_int;
10404 break;
10405 }
10406 }
10407
10408 return value_zero (type_arg, not_lval);
10409 }
10410 else if (type_arg == NULL)
10411 {
10412 arg1 = ada_coerce_ref (arg1);
10413
10415 arg1 = ada_coerce_to_simple_array (arg1);
10416
10417 struct type *type;
10418 if (op == OP_ATR_LENGTH)
10420 else
10421 {
10422 type = ada_index_type (value_type (arg1), tem,
10423 ada_attribute_name (op));
10424 if (type == NULL)
10426 }
10427
10428 switch (op)
10429 {
10430 default: /* Should never happen. */
10431 error (_("unexpected attribute encountered"));
10432 case OP_ATR_FIRST:
10433 return value_from_longest
10434 (type, ada_array_bound (arg1, tem, 0));
10435 case OP_ATR_LAST:
10436 return value_from_longest
10437 (type, ada_array_bound (arg1, tem, 1));
10438 case OP_ATR_LENGTH:
10439 return value_from_longest
10440 (type, ada_array_length (arg1, tem));
10441 }
10442 }
10443 else if (discrete_type_p (type_arg))
10444 {
10445 struct type *range_type;
10446 const char *name = ada_type_name (type_arg);
10447
10448 range_type = NULL;
10449 if (name != NULL && type_arg->code () != TYPE_CODE_ENUM)
10450 range_type = to_fixed_range_type (type_arg, NULL);
10451 if (range_type == NULL)
10452 range_type = type_arg;
10453 switch (op)
10454 {
10455 default:
10456 error (_("unexpected attribute encountered"));
10457 case OP_ATR_FIRST:
10458 return value_from_longest
10459 (range_type, ada_discrete_type_low_bound (range_type));
10460 case OP_ATR_LAST:
10461 return value_from_longest
10462 (range_type, ada_discrete_type_high_bound (range_type));
10463 case OP_ATR_LENGTH:
10464 error (_("the 'length attribute applies only to array types"));
10465 }
10466 }
10467 else if (type_arg->code () == TYPE_CODE_FLT)
10468 error (_("unimplemented type attribute"));
10469 else
10470 {
10471 LONGEST low, high;
10472
10474 type_arg = decode_constrained_packed_array_type (type_arg);
10475
10476 struct type *type;
10477 if (op == OP_ATR_LENGTH)
10479 else
10480 {
10481 type = ada_index_type (type_arg, tem, ada_attribute_name (op));
10482 if (type == NULL)
10484 }
10485
10486 switch (op)
10487 {
10488 default:
10489 error (_("unexpected attribute encountered"));
10490 case OP_ATR_FIRST:
10491 low = ada_array_bound_from_type (type_arg, tem, 0);
10492 return value_from_longest (type, low);
10493 case OP_ATR_LAST:
10494 high = ada_array_bound_from_type (type_arg, tem, 1);
10495 return value_from_longest (type, high);
10496 case OP_ATR_LENGTH:
10497 low = ada_array_bound_from_type (type_arg, tem, 0);
10498 high = ada_array_bound_from_type (type_arg, tem, 1);
10499 return value_from_longest (type, high - low + 1);
10500 }
10501 }
10502}
10503
10504/* A helper function for OP_ATR_MIN and OP_ATR_MAX. */
10505
10506struct value *
10507ada_binop_minmax (struct type *expect_type,
10508 struct expression *exp,
10509 enum noside noside, enum exp_opcode op,
10510 struct value *arg1, struct value *arg2)
10511{
10513 return value_zero (value_type (arg1), not_lval);
10514 else
10515 {
10516 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10517 return value_binop (arg1, arg2, op);
10518 }
10519}
10520
10521/* A helper function for BINOP_EXP. */
10522
10523struct value *
10524ada_binop_exp (struct type *expect_type,
10525 struct expression *exp,
10526 enum noside noside, enum exp_opcode op,
10527 struct value *arg1, struct value *arg2)
10528{
10530 return value_zero (value_type (arg1), not_lval);
10531 else
10532 {
10533 /* For integer exponentiation operations,
10534 only promote the first argument. */
10535 if (is_integral_type (value_type (arg2)))
10536 unop_promote (exp->language_defn, exp->gdbarch, &arg1);
10537 else
10538 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10539
10540 return value_binop (arg1, arg2, op);
10541 }
10542}
10543
10544namespace expr
10545{
10546
10547/* See ada-exp.h. */
10548
10551 struct expression *exp,
10552 bool deprocedure_p,
10553 bool parse_completion,
10554 innermost_block_tracker *tracker,
10555 struct type *context_type)
10556{
10557 if (resolve (exp, deprocedure_p, parse_completion, tracker, context_type))
10558 return (make_operation<ada_funcall_operation>
10559 (std::move (owner),
10560 std::vector<operation_up> ()));
10561 return std::move (owner);
10562}
10563
10564/* Convert the character literal whose value would be VAL to the
10565 appropriate value of type TYPE, if there is a translation.
10566 Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
10567 the literal 'A' (VAL == 65), returns 0. */
10568
10569static LONGEST
10570convert_char_literal (struct type *type, LONGEST val)
10571{
10572 char name[12];
10573 int f;
10574
10575 if (type == NULL)
10576 return val;
10578 if (type->code () != TYPE_CODE_ENUM)
10579 return val;
10580
10581 if ((val >= 'a' && val <= 'z') || (val >= '0' && val <= '9'))
10582 xsnprintf (name, sizeof (name), "Q%c", (int) val);
10583 else if (val >= 0 && val < 256)
10584 xsnprintf (name, sizeof (name), "QU%02x", (unsigned) val);
10585 else if (val >= 0 && val < 0x10000)
10586 xsnprintf (name, sizeof (name), "QW%04x", (unsigned) val);
10587 else
10588 xsnprintf (name, sizeof (name), "QWW%08lx", (unsigned long) val);
10589 size_t len = strlen (name);
10590 for (f = 0; f < type->num_fields (); f += 1)
10591 {
10592 /* Check the suffix because an enum constant in a package will
10593 have a name like "pkg__QUxx". This is safe enough because we
10594 already have the correct type, and because mangling means
10595 there can't be clashes. */
10596 const char *ename = type->field (f).name ();
10597 size_t elen = strlen (ename);
10598
10599 if (elen >= len && strcmp (name, ename + elen - len) == 0)
10600 return type->field (f).loc_enumval ();
10601 }
10602 return val;
10603}
10604
10605value *
10607 struct expression *exp,
10608 enum noside noside)
10609{
10610 value *result = long_const_operation::evaluate (expect_type, exp, noside);
10611 if (expect_type != nullptr)
10612 result = ada_value_cast (expect_type, result);
10613 return result;
10614}
10615
10616/* See ada-exp.h. */
10617
10620 struct expression *exp,
10621 bool deprocedure_p,
10622 bool parse_completion,
10623 innermost_block_tracker *tracker,
10624 struct type *context_type)
10625{
10626 operation_up result = std::move (owner);
10627
10628 if (context_type != nullptr && context_type->code () == TYPE_CODE_ENUM)
10629 {
10630 gdb_assert (result.get () == this);
10631 std::get<0> (m_storage) = context_type;
10632 std::get<1> (m_storage)
10633 = convert_char_literal (context_type, std::get<1> (m_storage));
10634 }
10635
10636 return result;
10637}
10638
10639value *
10641 struct expression *exp,
10642 enum noside noside)
10643{
10644 value *result = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
10645 if (noside == EVAL_NORMAL)
10646 result = unwrap_value (result);
10647
10648 /* If evaluating an OP_FLOAT and an EXPECT_TYPE was provided,
10649 then we need to perform the conversion manually, because
10650 evaluate_subexp_standard doesn't do it. This conversion is
10651 necessary in Ada because the different kinds of float/fixed
10652 types in Ada have different representations.
10653
10654 Similarly, we need to perform the conversion from OP_LONG
10655 ourselves. */
10656 if ((opcode () == OP_FLOAT || opcode () == OP_LONG) && expect_type != NULL)
10657 result = ada_value_cast (expect_type, result);
10658
10659 return result;
10660}
10661
10662value *
10664 struct expression *exp,
10665 enum noside noside)
10666{
10667 struct type *char_type;
10668 if (expect_type != nullptr && ada_is_string_type (expect_type))
10669 char_type = ada_array_element_type (expect_type, 1);
10670 else
10671 char_type = language_string_char_type (exp->language_defn, exp->gdbarch);
10672
10673 const std::string &str = std::get<0> (m_storage);
10674 const char *encoding;
10675 switch (char_type->length ())
10676 {
10677 case 1:
10678 {
10679 /* Simply copy over the data -- this isn't perhaps strictly
10680 correct according to the encodings, but it is gdb's
10681 historical behavior. */
10682 struct type *stringtype
10683 = lookup_array_range_type (char_type, 1, str.length ());
10684 struct value *val = allocate_value (stringtype);
10685 memcpy (value_contents_raw (val).data (), str.c_str (),
10686 str.length ());
10687 return val;
10688 }
10689
10690 case 2:
10691 if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
10692 encoding = "UTF-16BE";
10693 else
10694 encoding = "UTF-16LE";
10695 break;
10696
10697 case 4:
10698 if (gdbarch_byte_order (exp->gdbarch) == BFD_ENDIAN_BIG)
10699 encoding = "UTF-32BE";
10700 else
10701 encoding = "UTF-32LE";
10702 break;
10703
10704 default:
10705 error (_("unexpected character type size %s"),
10706 pulongest (char_type->length ()));
10707 }
10708
10709 auto_obstack converted;
10711 (const gdb_byte *) str.c_str (),
10712 str.length (), 1,
10713 &converted, translit_none);
10714
10715 struct type *stringtype
10716 = lookup_array_range_type (char_type, 1,
10717 obstack_object_size (&converted)
10718 / char_type->length ());
10719 struct value *val = allocate_value (stringtype);
10720 memcpy (value_contents_raw (val).data (),
10721 obstack_base (&converted),
10722 obstack_object_size (&converted));
10723 return val;
10724}
10725
10726value *
10728 struct expression *exp,
10729 enum noside noside)
10730{
10731 /* If one side is a literal, evaluate the other side first so that
10732 the expected type can be set properly. */
10733 const operation_up &lhs_expr = std::get<0> (m_storage);
10734 const operation_up &rhs_expr = std::get<1> (m_storage);
10735
10736 value *lhs, *rhs;
10737 if (dynamic_cast<ada_string_operation *> (lhs_expr.get ()) != nullptr)
10738 {
10739 rhs = rhs_expr->evaluate (nullptr, exp, noside);
10740 lhs = lhs_expr->evaluate (value_type (rhs), exp, noside);
10741 }
10742 else if (dynamic_cast<ada_char_operation *> (lhs_expr.get ()) != nullptr)
10743 {
10744 rhs = rhs_expr->evaluate (nullptr, exp, noside);
10745 struct type *rhs_type = check_typedef (value_type (rhs));
10746 struct type *elt_type = nullptr;
10747 if (rhs_type->code () == TYPE_CODE_ARRAY)
10748 elt_type = rhs_type->target_type ();
10749 lhs = lhs_expr->evaluate (elt_type, exp, noside);
10750 }
10751 else if (dynamic_cast<ada_string_operation *> (rhs_expr.get ()) != nullptr)
10752 {
10753 lhs = lhs_expr->evaluate (nullptr, exp, noside);
10754 rhs = rhs_expr->evaluate (value_type (lhs), exp, noside);
10755 }
10756 else if (dynamic_cast<ada_char_operation *> (rhs_expr.get ()) != nullptr)
10757 {
10758 lhs = lhs_expr->evaluate (nullptr, exp, noside);
10759 struct type *lhs_type = check_typedef (value_type (lhs));
10760 struct type *elt_type = nullptr;
10761 if (lhs_type->code () == TYPE_CODE_ARRAY)
10762 elt_type = lhs_type->target_type ();
10763 rhs = rhs_expr->evaluate (elt_type, exp, noside);
10764 }
10765 else
10766 return concat_operation::evaluate (expect_type, exp, noside);
10767
10768 return value_concat (lhs, rhs);
10769}
10770
10771value *
10773 struct expression *exp,
10774 enum noside noside)
10775{
10776 struct type *type = std::get<1> (m_storage);
10777 return std::get<0> (m_storage)->evaluate (type, exp, noside);
10778}
10779
10780value *
10782 struct expression *exp,
10783 enum noside noside)
10784{
10785 value *arg0 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
10786 value *arg1 = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
10787 value *arg2 = std::get<2> (m_storage)->evaluate (nullptr, exp, noside);
10788 return eval_ternop_in_range (expect_type, exp, noside, arg0, arg1, arg2);
10789}
10790
10791value *
10793 struct expression *exp,
10794 enum noside noside)
10795{
10796 value *arg1 = std::get<1> (m_storage)->evaluate_with_coercion (exp, noside);
10797 value *arg2 = std::get<2> (m_storage)->evaluate_with_coercion (exp, noside);
10798
10799 auto do_op = [=] (LONGEST x, LONGEST y)
10800 {
10801 if (std::get<0> (m_storage) == BINOP_ADD)
10802 return x + y;
10803 return x - y;
10804 };
10805
10806 if (value_type (arg1)->code () == TYPE_CODE_PTR)
10807 return (value_from_longest
10808 (value_type (arg1),
10809 do_op (value_as_long (arg1), value_as_long (arg2))));
10810 if (value_type (arg2)->code () == TYPE_CODE_PTR)
10811 return (value_from_longest
10812 (value_type (arg2),
10813 do_op (value_as_long (arg1), value_as_long (arg2))));
10814 /* Preserve the original type for use by the range case below.
10815 We cannot cast the result to a reference type, so if ARG1 is
10816 a reference type, find its underlying type. */
10817 struct type *type = value_type (arg1);
10818 while (type->code () == TYPE_CODE_REF)
10819 type = type->target_type ();
10820 binop_promote (exp->language_defn, exp->gdbarch, &arg1, &arg2);
10821 arg1 = value_binop (arg1, arg2, std::get<0> (m_storage));
10822 /* We need to special-case the result with a range.
10823 This is done for the benefit of "ptype". gdb's Ada support
10824 historically used the LHS to set the result type here, so
10825 preserve this behavior. */
10826 if (type->code () == TYPE_CODE_RANGE)
10827 arg1 = value_cast (type, arg1);
10828 return arg1;
10829}
10830
10831value *
10833 struct expression *exp,
10834 enum noside noside)
10835{
10836 struct type *type_arg = nullptr;
10837 value *val = nullptr;
10838
10839 if (std::get<0> (m_storage)->opcode () == OP_TYPE)
10840 {
10841 value *tem = std::get<0> (m_storage)->evaluate (nullptr, exp,
10843 type_arg = value_type (tem);
10844 }
10845 else
10846 val = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
10847
10848 return ada_unop_atr (exp, noside, std::get<1> (m_storage),
10849 val, type_arg, std::get<2> (m_storage));
10850}
10851
10852value *
10854 struct expression *exp,
10855 enum noside noside)
10856{
10858 return value_zero (expect_type, not_lval);
10859
10860 const bound_minimal_symbol &b = std::get<0> (m_storage);
10862
10863 val = ada_value_cast (expect_type, val);
10864
10865 /* Follow the Ada language semantics that do not allow taking
10866 an address of the result of a cast (view conversion in Ada). */
10867 if (VALUE_LVAL (val) == lval_memory)
10868 {
10869 if (value_lazy (val))
10870 value_fetch_lazy (val);
10871 VALUE_LVAL (val) = not_lval;
10872 }
10873 return val;
10874}
10875
10876value *
10878 struct expression *exp,
10879 enum noside noside)
10880{
10882 std::get<0> (m_storage).block,
10883 std::get<0> (m_storage).symbol);
10884
10885 val = ada_value_cast (expect_type, val);
10886
10887 /* Follow the Ada language semantics that do not allow taking
10888 an address of the result of a cast (view conversion in Ada). */
10889 if (VALUE_LVAL (val) == lval_memory)
10890 {
10891 if (value_lazy (val))
10892 value_fetch_lazy (val);
10893 VALUE_LVAL (val) = not_lval;
10894 }
10895 return val;
10896}
10897
10898value *
10900 struct expression *exp,
10901 enum noside noside)
10902{
10903 symbol *sym = std::get<0> (m_storage).symbol;
10904
10905 if (sym->domain () == UNDEF_DOMAIN)
10906 /* Only encountered when an unresolved symbol occurs in a
10907 context other than a function call, in which case, it is
10908 invalid. */
10909 error (_("Unexpected unresolved symbol, %s, during evaluation"),
10910 sym->print_name ());
10911
10913 {
10914 struct type *type = static_unwrap_type (sym->type ());
10915 /* Check to see if this is a tagged type. We also need to handle
10916 the case where the type is a reference to a tagged type, but
10917 we have to be careful to exclude pointers to tagged types.
10918 The latter should be shown as usual (as a pointer), whereas
10919 a reference should mostly be transparent to the user. */
10920 if (ada_is_tagged_type (type, 0)
10921 || (type->code () == TYPE_CODE_REF
10922 && ada_is_tagged_type (type->target_type (), 0)))
10923 {
10924 /* Tagged types are a little special in the fact that the real
10925 type is dynamic and can only be determined by inspecting the
10926 object's tag. This means that we need to get the object's
10927 value first (EVAL_NORMAL) and then extract the actual object
10928 type from its tag.
10929
10930 Note that we cannot skip the final step where we extract
10931 the object type from its tag, because the EVAL_NORMAL phase
10932 results in dynamic components being resolved into fixed ones.
10933 This can cause problems when trying to print the type
10934 description of tagged types whose parent has a dynamic size:
10935 We use the type name of the "_parent" component in order
10936 to print the name of the ancestor type in the type description.
10937 If that component had a dynamic size, the resolution into
10938 a fixed type would result in the loss of that type name,
10939 thus preventing us from printing the name of the ancestor
10940 type in the type description. */
10941 value *arg1 = evaluate (nullptr, exp, EVAL_NORMAL);
10942
10943 if (type->code () != TYPE_CODE_REF)
10944 {
10945 struct type *actual_type;
10946
10947 actual_type = type_from_tag (ada_value_tag (arg1));
10948 if (actual_type == NULL)
10949 /* If, for some reason, we were unable to determine
10950 the actual type from the tag, then use the static
10951 approximation that we just computed as a fallback.
10952 This can happen if the debugging information is
10953 incomplete, for instance. */
10954 actual_type = type;
10955 return value_zero (actual_type, not_lval);
10956 }
10957 else
10958 {
10959 /* In the case of a ref, ada_coerce_ref takes care
10960 of determining the actual type. But the evaluation
10961 should return a ref as it should be valid to ask
10962 for its address; so rebuild a ref after coerce. */
10963 arg1 = ada_coerce_ref (arg1);
10964 return value_ref (arg1, TYPE_CODE_REF);
10965 }
10966 }
10967
10968 /* Records and unions for which GNAT encodings have been
10969 generated need to be statically fixed as well.
10970 Otherwise, non-static fixing produces a type where
10971 all dynamic properties are removed, which prevents "ptype"
10972 from being able to completely describe the type.
10973 For instance, a case statement in a variant record would be
10974 replaced by the relevant components based on the actual
10975 value of the discriminants. */
10976 if ((type->code () == TYPE_CODE_STRUCT
10977 && dynamic_template_type (type) != NULL)
10978 || (type->code () == TYPE_CODE_UNION
10979 && ada_find_parallel_type (type, "___XVU") != NULL))
10981 }
10982
10983 value *arg1 = var_value_operation::evaluate (expect_type, exp, noside);
10984 return ada_to_fixed_value (arg1);
10985}
10986
10987bool
10989 bool deprocedure_p,
10990 bool parse_completion,
10991 innermost_block_tracker *tracker,
10992 struct type *context_type)
10993{
10994 symbol *sym = std::get<0> (m_storage).symbol;
10995 if (sym->domain () == UNDEF_DOMAIN)
10996 {
10997 block_symbol resolved
10998 = ada_resolve_variable (sym, std::get<0> (m_storage).block,
10999 context_type, parse_completion,
11000 deprocedure_p, tracker);
11001 std::get<0> (m_storage) = resolved;
11002 }
11003
11004 if (deprocedure_p
11005 && (std::get<0> (m_storage).symbol->type ()->code ()
11006 == TYPE_CODE_FUNC))
11007 return true;
11008
11009 return false;
11010}
11011
11012value *
11014 struct expression *exp,
11015 enum noside noside)
11016{
11017 value *arg = std::get<1> (m_storage)->evaluate (nullptr, exp, noside);
11018 return ada_val_atr (noside, std::get<0> (m_storage), arg);
11019}
11020
11021value *
11023 struct expression *exp,
11024 enum noside noside)
11025{
11026 value *arg1 = std::get<0> (m_storage)->evaluate (expect_type, exp, noside);
11027
11028 struct type *type = ada_check_typedef (value_type (arg1));
11030 {
11032 /* GDB allows dereferencing GNAT array descriptors. */
11033 {
11034 struct type *arrType = ada_type_of_array (arg1, 0);
11035
11036 if (arrType == NULL)
11037 error (_("Attempt to dereference null array pointer."));
11038 return value_at_lazy (arrType, 0);
11039 }
11040 else if (type->code () == TYPE_CODE_PTR
11041 || type->code () == TYPE_CODE_REF
11042 /* In C you can dereference an array to get the 1st elt. */
11043 || type->code () == TYPE_CODE_ARRAY)
11044 {
11045 /* As mentioned in the OP_VAR_VALUE case, tagged types can
11046 only be determined by inspecting the object's tag.
11047 This means that we need to evaluate completely the
11048 expression in order to get its type. */
11049
11050 if ((type->code () == TYPE_CODE_REF
11051 || type->code () == TYPE_CODE_PTR)
11053 {
11054 arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp,
11055 EVAL_NORMAL);
11056 type = value_type (ada_value_ind (arg1));
11057 }
11058 else
11059 {
11063 }
11064 return value_zero (type, lval_memory);
11065 }
11066 else if (type->code () == TYPE_CODE_INT)
11067 {
11068 /* GDB allows dereferencing an int. */
11069 if (expect_type == NULL)
11071 lval_memory);
11072 else
11073 {
11074 expect_type =
11075 to_static_fixed_type (ada_aligned_type (expect_type));
11076 return value_zero (expect_type, lval_memory);
11077 }
11078 }
11079 else
11080 error (_("Attempt to take contents of a non-pointer value."));
11081 }
11082 arg1 = ada_coerce_ref (arg1); /* FIXME: What is this for?? */
11084
11085 if (type->code () == TYPE_CODE_INT)
11086 /* GDB allows dereferencing an int. If we were given
11087 the expect_type, then use that as the target type.
11088 Otherwise, assume that the target type is an int. */
11089 {
11090 if (expect_type != NULL)
11091 return ada_value_ind (value_cast (lookup_pointer_type (expect_type),
11092 arg1));
11093 else
11095 (CORE_ADDR) value_as_address (arg1));
11096 }
11097
11099 /* GDB allows dereferencing GNAT array descriptors. */
11100 return ada_coerce_to_simple_array (arg1);
11101 else
11102 return ada_value_ind (arg1);
11103}
11104
11105value *
11107 struct expression *exp,
11108 enum noside noside)
11109{
11110 value *arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp, noside);
11111 const char *str = std::get<1> (m_storage).c_str ();
11113 {
11114 struct type *type;
11115 struct type *type1 = value_type (arg1);
11116
11117 if (ada_is_tagged_type (type1, 1))
11118 {
11119 type = ada_lookup_struct_elt_type (type1, str, 1, 1);
11120
11121 /* If the field is not found, check if it exists in the
11122 extension of this object's type. This means that we
11123 need to evaluate completely the expression. */
11124
11125 if (type == NULL)
11126 {
11127 arg1 = std::get<0> (m_storage)->evaluate (nullptr, exp,
11128 EVAL_NORMAL);
11129 arg1 = ada_value_struct_elt (arg1, str, 0);
11130 arg1 = unwrap_value (arg1);
11132 }
11133 }
11134 else
11135 type = ada_lookup_struct_elt_type (type1, str, 1, 0);
11136
11138 }
11139 else
11140 {
11141 arg1 = ada_value_struct_elt (arg1, str, 0);
11142 arg1 = unwrap_value (arg1);
11143 return ada_to_fixed_value (arg1);
11144 }
11145}
11146
11147value *
11149 struct expression *exp,
11150 enum noside noside)
11151{
11152 const std::vector<operation_up> &args_up = std::get<1> (m_storage);
11153 int nargs = args_up.size ();
11154 std::vector<value *> argvec (nargs);
11155 operation_up &callee_op = std::get<0> (m_storage);
11156
11158 = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
11159 if (avv != nullptr
11160 && avv->get_symbol ()->domain () == UNDEF_DOMAIN)
11161 error (_("Unexpected unresolved symbol, %s, during evaluation"),
11162 avv->get_symbol ()->print_name ());
11163
11164 value *callee = callee_op->evaluate (nullptr, exp, noside);
11165 for (int i = 0; i < args_up.size (); ++i)
11166 argvec[i] = args_up[i]->evaluate (nullptr, exp, noside);
11167
11169 (desc_base_type (value_type (callee))))
11170 callee = ada_coerce_to_simple_array (callee);
11171 else if (value_type (callee)->code () == TYPE_CODE_ARRAY
11172 && TYPE_FIELD_BITSIZE (value_type (callee), 0) != 0)
11173 /* This is a packed array that has already been fixed, and
11174 therefore already coerced to a simple array. Nothing further
11175 to do. */
11176 ;
11177 else if (value_type (callee)->code () == TYPE_CODE_REF)
11178 {
11179 /* Make sure we dereference references so that all the code below
11180 feels like it's really handling the referenced value. Wrapping
11181 types (for alignment) may be there, so make sure we strip them as
11182 well. */
11183 callee = ada_to_fixed_value (coerce_ref (callee));
11184 }
11185 else if (value_type (callee)->code () == TYPE_CODE_ARRAY
11186 && VALUE_LVAL (callee) == lval_memory)
11187 callee = value_addr (callee);
11188
11189 struct type *type = ada_check_typedef (value_type (callee));
11190
11191 /* Ada allows us to implicitly dereference arrays when subscripting
11192 them. So, if this is an array typedef (encoding use for array
11193 access types encoded as fat pointers), strip it now. */
11194 if (type->code () == TYPE_CODE_TYPEDEF)
11196
11197 if (type->code () == TYPE_CODE_PTR)
11198 {
11199 switch (ada_check_typedef (type->target_type ())->code ())
11200 {
11201 case TYPE_CODE_FUNC:
11203 break;
11204 case TYPE_CODE_ARRAY:
11205 break;
11206 case TYPE_CODE_STRUCT:
11208 callee = ada_value_ind (callee);
11210 break;
11211 default:
11212 error (_("cannot subscript or call something of type `%s'"),
11213 ada_type_name (value_type (callee)));
11214 break;
11215 }
11216 }
11217
11218 switch (type->code ())
11219 {
11220 case TYPE_CODE_FUNC:
11222 {
11223 if (type->target_type () == NULL)
11225 return allocate_value (type->target_type ());
11226 }
11227 return call_function_by_hand (callee, NULL, argvec);
11228 case TYPE_CODE_INTERNAL_FUNCTION:
11230 /* We don't know anything about what the internal
11231 function might return, but we have to return
11232 something. */
11234 not_lval);
11235 else
11236 return call_internal_function (exp->gdbarch, exp->language_defn,
11237 callee, nargs,
11238 argvec.data ());
11239
11240 case TYPE_CODE_STRUCT:
11241 {
11242 int arity;
11243
11244 arity = ada_array_arity (type);
11245 type = ada_array_element_type (type, nargs);
11246 if (type == NULL)
11247 error (_("cannot subscript or call a record"));
11248 if (arity != nargs)
11249 error (_("wrong number of subscripts; expecting %d"), arity);
11252 return
11254 (callee, nargs, argvec.data ()));
11255 }
11256 case TYPE_CODE_ARRAY:
11258 {
11259 type = ada_array_element_type (type, nargs);
11260 if (type == NULL)
11261 error (_("element type of array unknown"));
11262 else
11264 }
11265 return
11268 nargs, argvec.data ()));
11269 case TYPE_CODE_PTR: /* Pointer to array */
11271 {
11272 type = to_fixed_array_type (type->target_type (), NULL, 1);
11273 type = ada_array_element_type (type, nargs);
11274 if (type == NULL)
11275 error (_("element type of array unknown"));
11276 else
11278 }
11279 return
11280 unwrap_value (ada_value_ptr_subscript (callee, nargs,
11281 argvec.data ()));
11282
11283 default:
11284 error (_("Attempt to index or call something other than an "
11285 "array or function"));
11286 }
11287}
11288
11289bool
11291 bool deprocedure_p,
11292 bool parse_completion,
11293 innermost_block_tracker *tracker,
11294 struct type *context_type)
11295{
11296 operation_up &callee_op = std::get<0> (m_storage);
11297
11299 = dynamic_cast<ada_var_value_operation *> (callee_op.get ());
11300 if (avv == nullptr)
11301 return false;
11302
11303 symbol *sym = avv->get_symbol ();
11304 if (sym->domain () != UNDEF_DOMAIN)
11305 return false;
11306
11307 const std::vector<operation_up> &args_up = std::get<1> (m_storage);
11308 int nargs = args_up.size ();
11309 std::vector<value *> argvec (nargs);
11310
11311 for (int i = 0; i < args_up.size (); ++i)
11312 argvec[i] = args_up[i]->evaluate (nullptr, exp, EVAL_AVOID_SIDE_EFFECTS);
11313
11314 const block *block = avv->get_block ();
11315 block_symbol resolved
11316 = ada_resolve_funcall (sym, block,
11317 context_type, parse_completion,
11318 nargs, argvec.data (),
11319 tracker);
11320
11321 std::get<0> (m_storage)
11322 = make_operation<ada_var_value_operation> (resolved);
11323 return false;
11324}
11325
11326bool
11328 bool deprocedure_p,
11329 bool parse_completion,
11330 innermost_block_tracker *tracker,
11331 struct type *context_type)
11332{
11333 /* Historically this check was done during resolution, so we
11334 continue that here. */
11335 value *v = std::get<0> (m_storage)->evaluate (context_type, exp,
11338 error (_("cannot slice a packed array"));
11339 return false;
11340}
11341
11342}
11343
11344
11345
11346/* Return non-zero iff TYPE represents a System.Address type. */
11347
11348int
11350{
11351 return (type->name () && strcmp (type->name (), "system__address") == 0);
11352}
11353
11354
11355
11356 /* Range types */
11357
11358/* Scan STR beginning at position K for a discriminant name, and
11359 return the value of that discriminant field of DVAL in *PX. If
11360 PNEW_K is not null, put the position of the character beyond the
11361 name scanned in *PNEW_K. Return 1 if successful; return 0 and do
11362 not alter *PX and *PNEW_K if unsuccessful. */
11363
11364static int
11365scan_discrim_bound (const char *str, int k, struct value *dval, LONGEST * px,
11366 int *pnew_k)
11367{
11368 static std::string storage;
11369 const char *pstart, *pend, *bound;
11370 struct value *bound_val;
11371
11372 if (dval == NULL || str == NULL || str[k] == '\0')
11373 return 0;
11374
11375 pstart = str + k;
11376 pend = strstr (pstart, "__");
11377 if (pend == NULL)
11378 {
11379 bound = pstart;
11380 k += strlen (bound);
11381 }
11382 else
11383 {
11384 int len = pend - pstart;
11385
11386 /* Strip __ and beyond. */
11387 storage = std::string (pstart, len);
11388 bound = storage.c_str ();
11389 k = pend - str;
11390 }
11391
11392 bound_val = ada_search_struct_field (bound, dval, 0, value_type (dval));
11393 if (bound_val == NULL)
11394 return 0;
11395
11396 *px = value_as_long (bound_val);
11397 if (pnew_k != NULL)
11398 *pnew_k = k;
11399 return 1;
11400}
11401
11402/* Value of variable named NAME. Only exact matches are considered.
11403 If no such variable found, then if ERR_MSG is null, returns 0, and
11404 otherwise causes an error with message ERR_MSG. */
11405
11406static struct value *
11407get_var_value (const char *name, const char *err_msg)
11408{
11409 std::string quoted_name = add_angle_brackets (name);
11410
11411 lookup_name_info lookup_name (quoted_name, symbol_name_match_type::FULL);
11412
11413 std::vector<struct block_symbol> syms
11414 = ada_lookup_symbol_list_worker (lookup_name,
11416 VAR_DOMAIN, 1);
11417
11418 if (syms.size () != 1)
11419 {
11420 if (err_msg == NULL)
11421 return 0;
11422 else
11423 error (("%s"), err_msg);
11424 }
11425
11426 return value_of_variable (syms[0].symbol, syms[0].block);
11427}
11428
11429/* Value of integer variable named NAME in the current environment.
11430 If no such variable is found, returns false. Otherwise, sets VALUE
11431 to the variable's value and returns true. */
11432
11433bool
11434get_int_var_value (const char *name, LONGEST &value)
11435{
11436 struct value *var_val = get_var_value (name, 0);
11437
11438 if (var_val == 0)
11439 return false;
11440
11441 value = value_as_long (var_val);
11442 return true;
11443}
11444
11445
11446/* Return a range type whose base type is that of the range type named
11447 NAME in the current environment, and whose bounds are calculated
11448 from NAME according to the GNAT range encoding conventions.
11449 Extract discriminant values, if needed, from DVAL. ORIG_TYPE is the
11450 corresponding range type from debug information; fall back to using it
11451 if symbol lookup fails. If a new type must be created, allocate it
11452 like ORIG_TYPE was. The bounds information, in general, is encoded
11453 in NAME, the base type given in the named range type. */
11454
11455static struct type *
11456to_fixed_range_type (struct type *raw_type, struct value *dval)
11457{
11458 const char *name;
11459 struct type *base_type;
11460 const char *subtype_info;
11461
11462 gdb_assert (raw_type != NULL);
11463 gdb_assert (raw_type->name () != NULL);
11464
11465 if (raw_type->code () == TYPE_CODE_RANGE)
11466 base_type = raw_type->target_type ();
11467 else
11468 base_type = raw_type;
11469
11470 name = raw_type->name ();
11471 subtype_info = strstr (name, "___XD");
11472 if (subtype_info == NULL)
11473 {
11474 LONGEST L = ada_discrete_type_low_bound (raw_type);
11475 LONGEST U = ada_discrete_type_high_bound (raw_type);
11476
11477 if (L < INT_MIN || U > INT_MAX)
11478 return raw_type;
11479 else
11480 return create_static_range_type (alloc_type_copy (raw_type), raw_type,
11481 L, U);
11482 }
11483 else
11484 {
11485 int prefix_len = subtype_info - name;
11486 LONGEST L, U;
11487 struct type *type;
11488 const char *bounds_str;
11489 int n;
11490
11491 subtype_info += 5;
11492 bounds_str = strchr (subtype_info, '_');
11493 n = 1;
11494
11495 if (*subtype_info == 'L')
11496 {
11497 if (!ada_scan_number (bounds_str, n, &L, &n)
11498 && !scan_discrim_bound (bounds_str, n, dval, &L, &n))
11499 return raw_type;
11500 if (bounds_str[n] == '_')
11501 n += 2;
11502 else if (bounds_str[n] == '.') /* FIXME? SGI Workshop kludge. */
11503 n += 1;
11504 subtype_info += 1;
11505 }
11506 else
11507 {
11508 std::string name_buf = std::string (name, prefix_len) + "___L";
11509 if (!get_int_var_value (name_buf.c_str (), L))
11510 {
11511 lim_warning (_("Unknown lower bound, using 1."));
11512 L = 1;
11513 }
11514 }
11515
11516 if (*subtype_info == 'U')
11517 {
11518 if (!ada_scan_number (bounds_str, n, &U, &n)
11519 && !scan_discrim_bound (bounds_str, n, dval, &U, &n))
11520 return raw_type;
11521 }
11522 else
11523 {
11524 std::string name_buf = std::string (name, prefix_len) + "___U";
11525 if (!get_int_var_value (name_buf.c_str (), U))
11526 {
11527 lim_warning (_("Unknown upper bound, using %ld."), (long) L);
11528 U = L;
11529 }
11530 }
11531
11533 base_type, L, U);
11534 /* create_static_range_type alters the resulting type's length
11535 to match the size of the base_type, which is not what we want.
11536 Set it back to the original range type's length. */
11537 type->set_length (raw_type->length ());
11538 type->set_name (name);
11539 return type;
11540 }
11541}
11542
11543/* True iff NAME is the name of a range type. */
11544
11545int
11547{
11548 return (name != NULL && strstr (name, "___XD"));
11549}
11550
11551
11552 /* Modular types */
11553
11554/* True iff TYPE is an Ada modular type. */
11555
11556int
11558{
11559 struct type *subranged_type = get_base_type (type);
11560
11561 return (subranged_type != NULL && type->code () == TYPE_CODE_RANGE
11562 && subranged_type->code () == TYPE_CODE_INT
11563 && subranged_type->is_unsigned ());
11564}
11565
11566/* Assuming ada_is_modular_type (TYPE), the modulus of TYPE. */
11567
11568ULONGEST
11570{
11571 const dynamic_prop &high = type->bounds ()->high;
11572
11573 if (high.kind () == PROP_CONST)
11574 return (ULONGEST) high.const_val () + 1;
11575
11576 /* If TYPE is unresolved, the high bound might be a location list. Return
11577 0, for lack of a better value to return. */
11578 return 0;
11579}
11580
11581
11582/* Ada exception catchpoint support:
11583 ---------------------------------
11584
11585 We support 3 kinds of exception catchpoints:
11586 . catchpoints on Ada exceptions
11587 . catchpoints on unhandled Ada exceptions
11588 . catchpoints on failed assertions
11589
11590 Exceptions raised during failed assertions, or unhandled exceptions
11591 could perfectly be caught with the general catchpoint on Ada exceptions.
11592 However, we can easily differentiate these two special cases, and having
11593 the option to distinguish these two cases from the rest can be useful
11594 to zero-in on certain situations.
11595
11596 Exception catchpoints are a specialized form of breakpoint,
11597 since they rely on inserting breakpoints inside known routines
11598 of the GNAT runtime. The implementation therefore uses a standard
11599 breakpoint structure of the BP_BREAKPOINT type, but with its own set
11600 of breakpoint_ops.
11601
11602 Support in the runtime for exception catchpoints have been changed
11603 a few times already, and these changes affect the implementation
11604 of these catchpoints. In order to be able to support several
11605 variants of the runtime, we use a sniffer that will determine
11606 the runtime variant used by the program being debugged. */
11607
11608/* Ada's standard exceptions.
11609
11610 The Ada 83 standard also defined Numeric_Error. But there so many
11611 situations where it was unclear from the Ada 83 Reference Manual
11612 (RM) whether Constraint_Error or Numeric_Error should be raised,
11613 that the ARG (Ada Rapporteur Group) eventually issued a Binding
11614 Interpretation saying that anytime the RM says that Numeric_Error
11615 should be raised, the implementation may raise Constraint_Error.
11616 Ada 95 went one step further and pretty much removed Numeric_Error
11617 from the list of standard exceptions (it made it a renaming of
11618 Constraint_Error, to help preserve compatibility when compiling
11619 an Ada83 compiler). As such, we do not include Numeric_Error from
11620 this list of standard exceptions. */
11621
11622static const char * const standard_exc[] = {
11623 "constraint_error",
11624 "program_error",
11625 "storage_error",
11626 "tasking_error"
11627};
11628
11630
11631/* A structure that describes how to support exception catchpoints
11632 for a given executable. */
11633
11635{
11636 /* The name of the symbol to break on in order to insert
11637 a catchpoint on exceptions. */
11639
11640 /* The name of the symbol to break on in order to insert
11641 a catchpoint on unhandled exceptions. */
11643
11644 /* The name of the symbol to break on in order to insert
11645 a catchpoint on failed assertions. */
11646 const char *catch_assert_sym;
11647
11648 /* The name of the symbol to break on in order to insert
11649 a catchpoint on exception handling. */
11651
11652 /* Assuming that the inferior just triggered an unhandled exception
11653 catchpoint, this function is responsible for returning the address
11654 in inferior memory where the name of that exception is stored.
11655 Return zero if the address could not be computed. */
11657};
11658
11659static CORE_ADDR ada_unhandled_exception_name_addr (void);
11660static CORE_ADDR ada_unhandled_exception_name_addr_from_raise (void);
11661
11662/* The following exception support info structure describes how to
11663 implement exception catchpoints with the latest version of the
11664 Ada runtime (as of 2019-08-??). */
11665
11667{
11668 "__gnat_debug_raise_exception", /* catch_exception_sym */
11669 "__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
11670 "__gnat_debug_raise_assert_failure", /* catch_assert_sym */
11671 "__gnat_begin_handler_v1", /* catch_handlers_sym */
11673};
11674
11675/* The following exception support info structure describes how to
11676 implement exception catchpoints with an earlier version of the
11677 Ada runtime (as of 2007-03-06) using v0 of the EH ABI. */
11678
11680{
11681 "__gnat_debug_raise_exception", /* catch_exception_sym */
11682 "__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
11683 "__gnat_debug_raise_assert_failure", /* catch_assert_sym */
11684 "__gnat_begin_handler", /* catch_handlers_sym */
11686};
11687
11688/* The following exception support info structure describes how to
11689 implement exception catchpoints with a slightly older version
11690 of the Ada runtime. */
11691
11693{
11694 "__gnat_raise_nodefer_with_msg", /* catch_exception_sym */
11695 "__gnat_unhandled_exception", /* catch_exception_unhandled_sym */
11696 "system__assertions__raise_assert_failure", /* catch_assert_sym */
11697 "__gnat_begin_handler", /* catch_handlers_sym */
11699};
11700
11701/* Return nonzero if we can detect the exception support routines
11702 described in EINFO.
11703
11704 This function errors out if an abnormal situation is detected
11705 (for instance, if we find the exception support routines, but
11706 that support is found to be incomplete). */
11707
11708static int
11710{
11711 struct symbol *sym;
11712
11713 /* The symbol we're looking up is provided by a unit in the GNAT runtime
11714 that should be compiled with debugging information. As a result, we
11715 expect to find that symbol in the symtabs. */
11716
11717 sym = standard_lookup (einfo->catch_exception_sym, NULL, VAR_DOMAIN);
11718 if (sym == NULL)
11719 {
11720 /* Perhaps we did not find our symbol because the Ada runtime was
11721 compiled without debugging info, or simply stripped of it.
11722 It happens on some GNU/Linux distributions for instance, where
11723 users have to install a separate debug package in order to get
11724 the runtime's debugging info. In that situation, let the user
11725 know why we cannot insert an Ada exception catchpoint.
11726
11727 Note: Just for the purpose of inserting our Ada exception
11728 catchpoint, we could rely purely on the associated minimal symbol.
11729 But we would be operating in degraded mode anyway, since we are
11730 still lacking the debugging info needed later on to extract
11731 the name of the exception being raised (this name is printed in
11732 the catchpoint message, and is also used when trying to catch
11733 a specific exception). We do not handle this case for now. */
11734 struct bound_minimal_symbol msym
11735 = lookup_minimal_symbol (einfo->catch_exception_sym, NULL, NULL);
11736
11737 if (msym.minsym && msym.minsym->type () != mst_solib_trampoline)
11738 error (_("Your Ada runtime appears to be missing some debugging "
11739 "information.\nCannot insert Ada exception catchpoint "
11740 "in this configuration."));
11741
11742 return 0;
11743 }
11744
11745 /* Make sure that the symbol we found corresponds to a function. */
11746
11747 if (sym->aclass () != LOC_BLOCK)
11748 {
11749 error (_("Symbol \"%s\" is not a function (class = %d)"),
11750 sym->linkage_name (), sym->aclass ());
11751 return 0;
11752 }
11753
11754 sym = standard_lookup (einfo->catch_handlers_sym, NULL, VAR_DOMAIN);
11755 if (sym == NULL)
11756 {
11757 struct bound_minimal_symbol msym
11758 = lookup_minimal_symbol (einfo->catch_handlers_sym, NULL, NULL);
11759
11760 if (msym.minsym && msym.minsym->type () != mst_solib_trampoline)
11761 error (_("Your Ada runtime appears to be missing some debugging "
11762 "information.\nCannot insert Ada exception catchpoint "
11763 "in this configuration."));
11764
11765 return 0;
11766 }
11767
11768 /* Make sure that the symbol we found corresponds to a function. */
11769
11770 if (sym->aclass () != LOC_BLOCK)
11771 {
11772 error (_("Symbol \"%s\" is not a function (class = %d)"),
11773 sym->linkage_name (), sym->aclass ());
11774 return 0;
11775 }
11776
11777 return 1;
11778}
11779
11780/* Inspect the Ada runtime and determine which exception info structure
11781 should be used to provide support for exception catchpoints.
11782
11783 This function will always set the per-inferior exception_info,
11784 or raise an error. */
11785
11786static void
11788{
11790
11791 /* If the exception info is already known, then no need to recompute it. */
11792 if (data->exception_info != NULL)
11793 return;
11794
11795 /* Check the latest (default) exception support info. */
11797 {
11798 data->exception_info = &default_exception_support_info;
11799 return;
11800 }
11801
11802 /* Try the v0 exception suport info. */
11804 {
11805 data->exception_info = &exception_support_info_v0;
11806 return;
11807 }
11808
11809 /* Try our fallback exception suport info. */
11811 {
11812 data->exception_info = &exception_support_info_fallback;
11813 return;
11814 }
11815
11816 /* Sometimes, it is normal for us to not be able to find the routine
11817 we are looking for. This happens when the program is linked with
11818 the shared version of the GNAT runtime, and the program has not been
11819 started yet. Inform the user of these two possible causes if
11820 applicable. */
11821
11823 error (_("Unable to insert catchpoint. Is this an Ada main program?"));
11824
11825 /* If the symbol does not exist, then check that the program is
11826 already started, to make sure that shared libraries have been
11827 loaded. If it is not started, this may mean that the symbol is
11828 in a shared library. */
11829
11830 if (inferior_ptid.pid () == 0)
11831 error (_("Unable to insert catchpoint. Try to start the program first."));
11832
11833 /* At this point, we know that we are debugging an Ada program and
11834 that the inferior has been started, but we still are not able to
11835 find the run-time symbols. That can mean that we are in
11836 configurable run time mode, or that a-except as been optimized
11837 out by the linker... In any case, at this point it is not worth
11838 supporting this feature. */
11839
11840 error (_("Cannot insert Ada exception catchpoints in this configuration."));
11841}
11842
11843/* True iff FRAME is very likely to be that of a function that is
11844 part of the runtime system. This is all very heuristic, but is
11845 intended to be used as advice as to what frames are uninteresting
11846 to most users. */
11847
11848static int
11850{
11851 enum language func_lang;
11852 int i;
11853 const char *fullname;
11854
11855 /* If this code does not have any debugging information (no symtab),
11856 This cannot be any user code. */
11857
11858 symtab_and_line sal = find_frame_sal (frame);
11859 if (sal.symtab == NULL)
11860 return 1;
11861
11862 /* If there is a symtab, but the associated source file cannot be
11863 located, then assume this is not user code: Selecting a frame
11864 for which we cannot display the code would not be very helpful
11865 for the user. This should also take care of case such as VxWorks
11866 where the kernel has some debugging info provided for a few units. */
11867
11868 fullname = symtab_to_fullname (sal.symtab);
11869 if (access (fullname, R_OK) != 0)
11870 return 1;
11871
11872 /* Check the unit filename against the Ada runtime file naming.
11873 We also check the name of the objfile against the name of some
11874 known system libraries that sometimes come with debugging info
11875 too. */
11876
11877 for (i = 0; known_runtime_file_name_patterns[i] != NULL; i += 1)
11878 {
11880 if (re_exec (lbasename (sal.symtab->filename)))
11881 return 1;
11882 if (sal.symtab->compunit ()->objfile () != NULL
11883 && re_exec (objfile_name (sal.symtab->compunit ()->objfile ())))
11884 return 1;
11885 }
11886
11887 /* Check whether the function is a GNAT-generated entity. */
11888
11889 gdb::unique_xmalloc_ptr<char> func_name
11890 = find_frame_funname (frame, &func_lang, NULL);
11891 if (func_name == NULL)
11892 return 1;
11893
11894 for (i = 0; known_auxiliary_function_name_patterns[i] != NULL; i += 1)
11895 {
11897 if (re_exec (func_name.get ()))
11898 return 1;
11899 }
11900
11901 return 0;
11902}
11903
11904/* Find the first frame that contains debugging information and that is not
11905 part of the Ada run-time, starting from FI and moving upward. */
11906
11907void
11909{
11910 for (; fi != NULL; fi = get_prev_frame (fi))
11911 {
11912 if (!is_known_support_routine (fi))
11913 {
11914 select_frame (fi);
11915 break;
11916 }
11917 }
11918
11919}
11920
11921/* Assuming that the inferior just triggered an unhandled exception
11922 catchpoint, return the address in inferior memory where the name
11923 of the exception is stored.
11924
11925 Return zero if the address could not be computed. */
11926
11927static CORE_ADDR
11929{
11930 return parse_and_eval_address ("e.full_name");
11931}
11932
11933/* Same as ada_unhandled_exception_name_addr, except that this function
11934 should be used when the inferior uses an older version of the runtime,
11935 where the exception name needs to be extracted from a specific frame
11936 several frames up in the callstack. */
11937
11938static CORE_ADDR
11940{
11941 int frame_level;
11942 frame_info_ptr fi;
11944
11945 /* To determine the name of this exception, we need to select
11946 the frame corresponding to RAISE_SYM_NAME. This frame is
11947 at least 3 levels up, so we simply skip the first 3 frames
11948 without checking the name of their associated function. */
11949 fi = get_current_frame ();
11950 for (frame_level = 0; frame_level < 3; frame_level += 1)
11951 if (fi != NULL)
11952 fi = get_prev_frame (fi);
11953
11954 while (fi != NULL)
11955 {
11956 enum language func_lang;
11957
11958 gdb::unique_xmalloc_ptr<char> func_name
11959 = find_frame_funname (fi, &func_lang, NULL);
11960 if (func_name != NULL)
11961 {
11962 if (strcmp (func_name.get (),
11963 data->exception_info->catch_exception_sym) == 0)
11964 break; /* We found the frame we were looking for... */
11965 }
11966 fi = get_prev_frame (fi);
11967 }
11968
11969 if (fi == NULL)
11970 return 0;
11971
11972 select_frame (fi);
11973 return parse_and_eval_address ("id.full_name");
11974}
11975
11976/* Assuming the inferior just triggered an Ada exception catchpoint
11977 (of any type), return the address in inferior memory where the name
11978 of the exception is stored, if applicable.
11979
11980 Assumes the selected frame is the current frame.
11981
11982 Return zero if the address could not be computed, or if not relevant. */
11983
11984static CORE_ADDR
11986{
11988
11989 switch (ex)
11990 {
11992 return (parse_and_eval_address ("e.full_name"));
11993 break;
11994
11996 return data->exception_info->unhandled_exception_name_addr ();
11997 break;
11998
11999 case ada_catch_handlers:
12000 return 0; /* The runtimes does not provide access to the exception
12001 name. */
12002 break;
12003
12004 case ada_catch_assert:
12005 return 0; /* Exception name is not relevant in this case. */
12006 break;
12007
12008 default:
12009 internal_error (_("unexpected catchpoint type"));
12010 break;
12011 }
12012
12013 return 0; /* Should never be reached. */
12014}
12015
12016/* Assuming the inferior is stopped at an exception catchpoint,
12017 return the message which was associated to the exception, if
12018 available. Return NULL if the message could not be retrieved.
12019
12020 Note: The exception message can be associated to an exception
12021 either through the use of the Raise_Exception function, or
12022 more simply (Ada 2005 and later), via:
12023
12024 raise Exception_Name with "exception message";
12025
12026 */
12027
12028static gdb::unique_xmalloc_ptr<char>
12030{
12031 struct value *e_msg_val;
12032 int e_msg_len;
12033
12034 /* For runtimes that support this feature, the exception message
12035 is passed as an unbounded string argument called "message". */
12036 e_msg_val = parse_and_eval ("message");
12037 if (e_msg_val == NULL)
12038 return NULL; /* Exception message not supported. */
12039
12040 e_msg_val = ada_coerce_to_simple_array (e_msg_val);
12041 gdb_assert (e_msg_val != NULL);
12042 e_msg_len = value_type (e_msg_val)->length ();
12043
12044 /* If the message string is empty, then treat it as if there was
12045 no exception message. */
12046 if (e_msg_len <= 0)
12047 return NULL;
12048
12049 gdb::unique_xmalloc_ptr<char> e_msg ((char *) xmalloc (e_msg_len + 1));
12050 read_memory (value_address (e_msg_val), (gdb_byte *) e_msg.get (),
12051 e_msg_len);
12052 e_msg.get ()[e_msg_len] = '\0';
12053
12054 return e_msg;
12055}
12056
12057/* Same as ada_exception_message_1, except that all exceptions are
12058 contained here (returning NULL instead). */
12059
12060static gdb::unique_xmalloc_ptr<char>
12062{
12063 gdb::unique_xmalloc_ptr<char> e_msg;
12064
12065 try
12066 {
12067 e_msg = ada_exception_message_1 ();
12068 }
12069 catch (const gdb_exception_error &e)
12070 {
12071 e_msg.reset (nullptr);
12072 }
12073
12074 return e_msg;
12075}
12076
12077/* Same as ada_exception_name_addr_1, except that it intercepts and contains
12078 any error that ada_exception_name_addr_1 might cause to be thrown.
12079 When an error is intercepted, a warning with the error message is printed,
12080 and zero is returned. */
12081
12082static CORE_ADDR
12084{
12085 CORE_ADDR result = 0;
12086
12087 try
12088 {
12089 result = ada_exception_name_addr_1 (ex);
12090 }
12091
12092 catch (const gdb_exception_error &e)
12093 {
12094 warning (_("failed to get exception name: %s"), e.what ());
12095 return 0;
12096 }
12097
12098 return result;
12099}
12100
12101static std::string ada_exception_catchpoint_cond_string
12102 (const char *excep_string,
12104
12105/* Ada catchpoints.
12106
12107 In the case of catchpoints on Ada exceptions, the catchpoint will
12108 stop the target on every exception the program throws. When a user
12109 specifies the name of a specific exception, we translate this
12110 request into a condition expression (in text form), and then parse
12111 it into an expression stored in each of the catchpoint's locations.
12112 We then use this condition to check whether the exception that was
12113 raised is the one the user is interested in. If not, then the
12114 target is resumed again. We store the name of the requested
12115 exception, in order to be able to re-set the condition expression
12116 when symbols change. */
12117
12118/* An instance of this type is used to represent an Ada catchpoint. */
12119
12121{
12122 ada_catchpoint (struct gdbarch *gdbarch_,
12124 struct symtab_and_line sal,
12125 const char *addr_string_,
12126 bool tempflag,
12127 bool enabled,
12128 bool from_tty)
12129 : code_breakpoint (gdbarch_, bp_catchpoint),
12130 m_kind (kind)
12131 {
12132 add_location (sal);
12133
12134 /* Unlike most code_breakpoint types, Ada catchpoints are
12135 pspace-specific. */
12136 gdb_assert (sal.pspace != nullptr);
12137 this->pspace = sal.pspace;
12138
12139 if (from_tty)
12140 {
12141 struct gdbarch *loc_gdbarch = get_sal_arch (sal);
12142 if (!loc_gdbarch)
12143 loc_gdbarch = gdbarch;
12144
12145 describe_other_breakpoints (loc_gdbarch,
12146 sal.pspace, sal.pc, sal.section, -1);
12147 /* FIXME: brobecker/2006-12-28: Actually, re-implement a special
12148 version for exception catchpoints, because two catchpoints
12149 used for different exception names will use the same address.
12150 In this case, a "breakpoint ... also set at..." warning is
12151 unproductive. Besides, the warning phrasing is also a bit
12152 inappropriate, we should use the word catchpoint, and tell
12153 the user what type of catchpoint it is. The above is good
12154 enough for now, though. */
12155 }
12156
12157 enable_state = enabled ? bp_enabled : bp_disabled;
12158 disposition = tempflag ? disp_del : disp_donttouch;
12159 locspec = string_to_location_spec (&addr_string_,
12162 }
12163
12164 struct bp_location *allocate_location () override;
12165 void re_set () override;
12166 void check_status (struct bpstat *bs) override;
12167 enum print_stop_action print_it (const bpstat *bs) const override;
12168 bool print_one (bp_location **) const override;
12169 void print_mention () const override;
12170 void print_recreate (struct ui_file *fp) const override;
12171
12172 /* The name of the specific exception the user specified. */
12173 std::string excep_string;
12174
12175 /* What kind of catchpoint this is. */
12177};
12178
12179/* An instance of this type is used to represent an Ada catchpoint
12180 breakpoint location. */
12181
12183{
12184public:
12187 {}
12188
12189 /* The condition that checks whether the exception that was raised
12190 is the specific exception the user specified on catchpoint
12191 creation. */
12193};
12194
12195/* Parse the exception condition string in the context of each of the
12196 catchpoint's locations, and store them for later evaluation. */
12197
12198static void
12201{
12202 /* Nothing to do if there's no specific exception to catch. */
12203 if (c->excep_string.empty ())
12204 return;
12205
12206 /* Same if there are no locations... */
12207 if (c->loc == NULL)
12208 return;
12209
12210 /* Compute the condition expression in text form, from the specific
12211 expection we want to catch. */
12212 std::string cond_string
12214
12215 /* Iterate over all the catchpoint's locations, and parse an
12216 expression for each. */
12217 for (bp_location *bl : c->locations ())
12218 {
12219 struct ada_catchpoint_location *ada_loc
12220 = (struct ada_catchpoint_location *) bl;
12221 expression_up exp;
12222
12223 if (!bl->shlib_disabled)
12224 {
12225 const char *s;
12226
12227 s = cond_string.c_str ();
12228 try
12229 {
12230 exp = parse_exp_1 (&s, bl->address,
12231 block_for_pc (bl->address),
12232 0);
12233 }
12234 catch (const gdb_exception_error &e)
12235 {
12236 warning (_("failed to reevaluate internal exception condition "
12237 "for catchpoint %d: %s"),
12238 c->number, e.what ());
12239 }
12240 }
12241
12242 ada_loc->excep_cond_expr = std::move (exp);
12243 }
12244}
12245
12246/* Implement the ALLOCATE_LOCATION method in the structure for all
12247 exception catchpoint kinds. */
12248
12249struct bp_location *
12251{
12252 return new ada_catchpoint_location (this);
12253}
12254
12255/* Implement the RE_SET method in the structure for all exception
12256 catchpoint kinds. */
12257
12258void
12260{
12261 /* Call the base class's method. This updates the catchpoint's
12262 locations. */
12263 this->code_breakpoint::re_set ();
12264
12265 /* Reparse the exception conditional expressions. One for each
12266 location. */
12268}
12269
12270/* Returns true if we should stop for this breakpoint hit. If the
12271 user specified a specific exception, we only want to cause a stop
12272 if the program thrown that exception. */
12273
12274static bool
12276{
12277 struct ada_catchpoint *c = (struct ada_catchpoint *) bl->owner;
12278 const struct ada_catchpoint_location *ada_loc
12279 = (const struct ada_catchpoint_location *) bl;
12280 bool stop;
12281
12282 struct internalvar *var = lookup_internalvar ("_ada_exception");
12283 if (c->m_kind == ada_catch_assert)
12284 clear_internalvar (var);
12285 else
12286 {
12287 try
12288 {
12289 const char *expr;
12290
12291 if (c->m_kind == ada_catch_handlers)
12292 expr = ("GNAT_GCC_exception_Access(gcc_exception)"
12293 ".all.occurrence.id");
12294 else
12295 expr = "e";
12296
12297 struct value *exc = parse_and_eval (expr);
12298 set_internalvar (var, exc);
12299 }
12300 catch (const gdb_exception_error &ex)
12301 {
12302 clear_internalvar (var);
12303 }
12304 }
12305
12306 /* With no specific exception, should always stop. */
12307 if (c->excep_string.empty ())
12308 return true;
12309
12310 if (ada_loc->excep_cond_expr == NULL)
12311 {
12312 /* We will have a NULL expression if back when we were creating
12313 the expressions, this location's had failed to parse. */
12314 return true;
12315 }
12316
12317 stop = true;
12318 try
12319 {
12320 scoped_value_mark mark;
12321 stop = value_true (evaluate_expression (ada_loc->excep_cond_expr.get ()));
12322 }
12323 catch (const gdb_exception &ex)
12324 {
12326 _("Error in testing exception condition:\n"));
12327 }
12328
12329 return stop;
12330}
12331
12332/* Implement the CHECK_STATUS method in the structure for all
12333 exception catchpoint kinds. */
12334
12335void
12337{
12338 bs->stop = should_stop_exception (bs->bp_location_at.get ());
12339}
12340
12341/* Implement the PRINT_IT method in the structure for all exception
12342 catchpoint kinds. */
12343
12346{
12347 struct ui_out *uiout = current_uiout;
12348
12350
12351 if (uiout->is_mi_like_p ())
12352 {
12353 uiout->field_string ("reason",
12355 uiout->field_string ("disp", bpdisp_text (disposition));
12356 }
12357
12358 uiout->text (disposition == disp_del
12359 ? "\nTemporary catchpoint " : "\nCatchpoint ");
12360 print_num_locno (bs, uiout);
12361 uiout->text (", ");
12362
12363 /* ada_exception_name_addr relies on the selected frame being the
12364 current frame. Need to do this here because this function may be
12365 called more than once when printing a stop, and below, we'll
12366 select the first frame past the Ada run-time (see
12367 ada_find_printable_frame). */
12369
12370 switch (m_kind)
12371 {
12374 case ada_catch_handlers:
12375 {
12376 const CORE_ADDR addr = ada_exception_name_addr (m_kind);
12377 char exception_name[256];
12378
12379 if (addr != 0)
12380 {
12381 read_memory (addr, (gdb_byte *) exception_name,
12382 sizeof (exception_name) - 1);
12383 exception_name [sizeof (exception_name) - 1] = '\0';
12384 }
12385 else
12386 {
12387 /* For some reason, we were unable to read the exception
12388 name. This could happen if the Runtime was compiled
12389 without debugging info, for instance. In that case,
12390 just replace the exception name by the generic string
12391 "exception" - it will read as "an exception" in the
12392 notification we are about to print. */
12393 memcpy (exception_name, "exception", sizeof ("exception"));
12394 }
12395 /* In the case of unhandled exception breakpoints, we print
12396 the exception name as "unhandled EXCEPTION_NAME", to make
12397 it clearer to the user which kind of catchpoint just got
12398 hit. We used ui_out_text to make sure that this extra
12399 info does not pollute the exception name in the MI case. */
12401 uiout->text ("unhandled ");
12402 uiout->field_string ("exception-name", exception_name);
12403 }
12404 break;
12405 case ada_catch_assert:
12406 /* In this case, the name of the exception is not really
12407 important. Just print "failed assertion" to make it clearer
12408 that his program just hit an assertion-failure catchpoint.
12409 We used ui_out_text because this info does not belong in
12410 the MI output. */
12411 uiout->text ("failed assertion");
12412 break;
12413 }
12414
12415 gdb::unique_xmalloc_ptr<char> exception_message = ada_exception_message ();
12416 if (exception_message != NULL)
12417 {
12418 uiout->text (" (");
12419 uiout->field_string ("exception-message", exception_message.get ());
12420 uiout->text (")");
12421 }
12422
12423 uiout->text (" at ");
12425
12426 return PRINT_SRC_AND_LOC;
12427}
12428
12429/* Implement the PRINT_ONE method in the structure for all exception
12430 catchpoint kinds. */
12431
12432bool
12434{
12435 struct ui_out *uiout = current_uiout;
12436 struct value_print_options opts;
12437
12438 get_user_print_options (&opts);
12439
12440 if (opts.addressprint)
12441 uiout->field_skip ("addr");
12442
12443 annotate_field (5);
12444 switch (m_kind)
12445 {
12447 if (!excep_string.empty ())
12448 {
12449 std::string msg = string_printf (_("`%s' Ada exception"),
12450 excep_string.c_str ());
12451
12452 uiout->field_string ("what", msg);
12453 }
12454 else
12455 uiout->field_string ("what", "all Ada exceptions");
12456
12457 break;
12458
12460 uiout->field_string ("what", "unhandled Ada exceptions");
12461 break;
12462
12463 case ada_catch_handlers:
12464 if (!excep_string.empty ())
12465 {
12466 uiout->field_fmt ("what",
12467 _("`%s' Ada exception handlers"),
12468 excep_string.c_str ());
12469 }
12470 else
12471 uiout->field_string ("what", "all Ada exceptions handlers");
12472 break;
12473
12474 case ada_catch_assert:
12475 uiout->field_string ("what", "failed Ada assertions");
12476 break;
12477
12478 default:
12479 internal_error (_("unexpected catchpoint type"));
12480 break;
12481 }
12482
12483 return true;
12484}
12485
12486/* Implement the PRINT_MENTION method in the breakpoint_ops structure
12487 for all exception catchpoint kinds. */
12488
12489void
12491{
12492 struct ui_out *uiout = current_uiout;
12493
12494 uiout->text (disposition == disp_del ? _("Temporary catchpoint ")
12495 : _("Catchpoint "));
12496 uiout->field_signed ("bkptno", number);
12497 uiout->text (": ");
12498
12499 switch (m_kind)
12500 {
12502 if (!excep_string.empty ())
12503 {
12504 std::string info = string_printf (_("`%s' Ada exception"),
12505 excep_string.c_str ());
12506 uiout->text (info);
12507 }
12508 else
12509 uiout->text (_("all Ada exceptions"));
12510 break;
12511
12513 uiout->text (_("unhandled Ada exceptions"));
12514 break;
12515
12516 case ada_catch_handlers:
12517 if (!excep_string.empty ())
12518 {
12519 std::string info
12520 = string_printf (_("`%s' Ada exception handlers"),
12521 excep_string.c_str ());
12522 uiout->text (info);
12523 }
12524 else
12525 uiout->text (_("all Ada exceptions handlers"));
12526 break;
12527
12528 case ada_catch_assert:
12529 uiout->text (_("failed Ada assertions"));
12530 break;
12531
12532 default:
12533 internal_error (_("unexpected catchpoint type"));
12534 break;
12535 }
12536}
12537
12538/* Implement the PRINT_RECREATE method in the structure for all
12539 exception catchpoint kinds. */
12540
12541void
12543{
12544 switch (m_kind)
12545 {
12547 gdb_printf (fp, "catch exception");
12548 if (!excep_string.empty ())
12549 gdb_printf (fp, " %s", excep_string.c_str ());
12550 break;
12551
12553 gdb_printf (fp, "catch exception unhandled");
12554 break;
12555
12556 case ada_catch_handlers:
12557 gdb_printf (fp, "catch handlers");
12558 break;
12559
12560 case ada_catch_assert:
12561 gdb_printf (fp, "catch assert");
12562 break;
12563
12564 default:
12565 internal_error (_("unexpected catchpoint type"));
12566 }
12568}
12569
12570/* See ada-lang.h. */
12571
12572bool
12574{
12575 return dynamic_cast<ada_catchpoint *> (bp) != nullptr;
12576}
12577
12578/* Split the arguments specified in a "catch exception" command.
12579 Set EX to the appropriate catchpoint type.
12580 Set EXCEP_STRING to the name of the specific exception if
12581 specified by the user.
12582 IS_CATCH_HANDLERS_CMD: True if the arguments are for a
12583 "catch handlers" command. False otherwise.
12584 If a condition is found at the end of the arguments, the condition
12585 expression is stored in COND_STRING (memory must be deallocated
12586 after use). Otherwise COND_STRING is set to NULL. */
12587
12588static void
12590 bool is_catch_handlers_cmd,
12592 std::string *excep_string,
12593 std::string *cond_string)
12594{
12595 std::string exception_name;
12596
12597 exception_name = extract_arg (&args);
12598 if (exception_name == "if")
12599 {
12600 /* This is not an exception name; this is the start of a condition
12601 expression for a catchpoint on all exceptions. So, "un-get"
12602 this token, and set exception_name to NULL. */
12603 exception_name.clear ();
12604 args -= 2;
12605 }
12606
12607 /* Check to see if we have a condition. */
12608
12609 args = skip_spaces (args);
12610 if (startswith (args, "if")
12611 && (isspace (args[2]) || args[2] == '\0'))
12612 {
12613 args += 2;
12614 args = skip_spaces (args);
12615
12616 if (args[0] == '\0')
12617 error (_("Condition missing after `if' keyword"));
12618 *cond_string = args;
12619
12620 args += strlen (args);
12621 }
12622
12623 /* Check that we do not have any more arguments. Anything else
12624 is unexpected. */
12625
12626 if (args[0] != '\0')
12627 error (_("Junk at end of expression"));
12628
12629 if (is_catch_handlers_cmd)
12630 {
12631 /* Catch handling of exceptions. */
12632 *ex = ada_catch_handlers;
12633 *excep_string = exception_name;
12634 }
12635 else if (exception_name.empty ())
12636 {
12637 /* Catch all exceptions. */
12638 *ex = ada_catch_exception;
12639 excep_string->clear ();
12640 }
12641 else if (exception_name == "unhandled")
12642 {
12643 /* Catch unhandled exceptions. */
12645 excep_string->clear ();
12646 }
12647 else
12648 {
12649 /* Catch a specific exception. */
12650 *ex = ada_catch_exception;
12651 *excep_string = exception_name;
12652 }
12653}
12654
12655/* Return the name of the symbol on which we should break in order to
12656 implement a catchpoint of the EX kind. */
12657
12658static const char *
12660{
12662
12663 gdb_assert (data->exception_info != NULL);
12664
12665 switch (ex)
12666 {
12668 return (data->exception_info->catch_exception_sym);
12669 break;
12671 return (data->exception_info->catch_exception_unhandled_sym);
12672 break;
12673 case ada_catch_assert:
12674 return (data->exception_info->catch_assert_sym);
12675 break;
12676 case ada_catch_handlers:
12677 return (data->exception_info->catch_handlers_sym);
12678 break;
12679 default:
12680 internal_error (_("unexpected catchpoint kind (%d)"), ex);
12681 }
12682}
12683
12684/* Return the condition that will be used to match the current exception
12685 being raised with the exception that the user wants to catch. This
12686 assumes that this condition is used when the inferior just triggered
12687 an exception catchpoint.
12688 EX: the type of catchpoints used for catching Ada exceptions. */
12689
12690static std::string
12693{
12694 bool is_standard_exc = false;
12695 std::string result;
12696
12697 if (ex == ada_catch_handlers)
12698 {
12699 /* For exception handlers catchpoints, the condition string does
12700 not use the same parameter as for the other exceptions. */
12701 result = ("long_integer (GNAT_GCC_exception_Access"
12702 "(gcc_exception).all.occurrence.id)");
12703 }
12704 else
12705 result = "long_integer (e)";
12706
12707 /* The standard exceptions are a special case. They are defined in
12708 runtime units that have been compiled without debugging info; if
12709 EXCEP_STRING is the not-fully-qualified name of a standard
12710 exception (e.g. "constraint_error") then, during the evaluation
12711 of the condition expression, the symbol lookup on this name would
12712 *not* return this standard exception. The catchpoint condition
12713 may then be set only on user-defined exceptions which have the
12714 same not-fully-qualified name (e.g. my_package.constraint_error).
12715
12716 To avoid this unexcepted behavior, these standard exceptions are
12717 systematically prefixed by "standard". This means that "catch
12718 exception constraint_error" is rewritten into "catch exception
12719 standard.constraint_error".
12720
12721 If an exception named constraint_error is defined in another package of
12722 the inferior program, then the only way to specify this exception as a
12723 breakpoint condition is to use its fully-qualified named:
12724 e.g. my_package.constraint_error. */
12725
12726 for (const char *name : standard_exc)
12727 {
12728 if (strcmp (name, excep_string) == 0)
12729 {
12730 is_standard_exc = true;
12731 break;
12732 }
12733 }
12734
12735 result += " = ";
12736
12737 if (is_standard_exc)
12738 string_appendf (result, "long_integer (&standard.%s)", excep_string);
12739 else
12740 string_appendf (result, "long_integer (&%s)", excep_string);
12741
12742 return result;
12743}
12744
12745/* Return the symtab_and_line that should be used to insert an exception
12746 catchpoint of the TYPE kind.
12747
12748 ADDR_STRING returns the name of the function where the real
12749 breakpoint that implements the catchpoints is set, depending on the
12750 type of catchpoint we need to create. */
12751
12752static struct symtab_and_line
12754 std::string *addr_string)
12755{
12756 const char *sym_name;
12757 struct symbol *sym;
12758
12759 /* First, find out which exception support info to use. */
12761
12762 /* Then lookup the function on which we will break in order to catch
12763 the Ada exceptions requested by the user. */
12764 sym_name = ada_exception_sym_name (ex);
12765 sym = standard_lookup (sym_name, NULL, VAR_DOMAIN);
12766
12767 if (sym == NULL)
12768 error (_("Catchpoint symbol not found: %s"), sym_name);
12769
12770 if (sym->aclass () != LOC_BLOCK)
12771 error (_("Unable to insert catchpoint. %s is not a function."), sym_name);
12772
12773 /* Set ADDR_STRING. */
12774 *addr_string = sym_name;
12775
12776 return find_function_start_sal (sym, 1);
12777}
12778
12779/* Create an Ada exception catchpoint.
12780
12781 EX_KIND is the kind of exception catchpoint to be created.
12782
12783 If EXCEPT_STRING is empty, this catchpoint is expected to trigger
12784 for all exceptions. Otherwise, EXCEPT_STRING indicates the name
12785 of the exception to which this catchpoint applies.
12786
12787 COND_STRING, if not empty, is the catchpoint condition.
12788
12789 TEMPFLAG, if nonzero, means that the underlying breakpoint
12790 should be temporary.
12791
12792 FROM_TTY is the usual argument passed to all commands implementations. */
12793
12794void
12796 enum ada_exception_catchpoint_kind ex_kind,
12797 const std::string &excep_string,
12798 const std::string &cond_string,
12799 int tempflag,
12800 int disabled,
12801 int from_tty)
12802{
12803 std::string addr_string;
12804 struct symtab_and_line sal = ada_exception_sal (ex_kind, &addr_string);
12805
12806 std::unique_ptr<ada_catchpoint> c
12807 (new ada_catchpoint (gdbarch, ex_kind, sal, addr_string.c_str (),
12808 tempflag, disabled, from_tty));
12809 c->excep_string = excep_string;
12810 create_excep_cond_exprs (c.get (), ex_kind);
12811 if (!cond_string.empty ())
12812 set_breakpoint_condition (c.get (), cond_string.c_str (), from_tty, false);
12813 install_breakpoint (0, std::move (c), 1);
12814}
12815
12816/* Implement the "catch exception" command. */
12817
12818static void
12819catch_ada_exception_command (const char *arg_entry, int from_tty,
12820 struct cmd_list_element *command)
12821{
12822 const char *arg = arg_entry;
12823 struct gdbarch *gdbarch = get_current_arch ();
12824 int tempflag;
12825 enum ada_exception_catchpoint_kind ex_kind;
12826 std::string excep_string;
12827 std::string cond_string;
12828
12829 tempflag = command->context () == CATCH_TEMPORARY;
12830
12831 if (!arg)
12832 arg = "";
12833 catch_ada_exception_command_split (arg, false, &ex_kind, &excep_string,
12834 &cond_string);
12836 excep_string, cond_string,
12837 tempflag, 1 /* enabled */,
12838 from_tty);
12839}
12840
12841/* Implement the "catch handlers" command. */
12842
12843static void
12844catch_ada_handlers_command (const char *arg_entry, int from_tty,
12845 struct cmd_list_element *command)
12846{
12847 const char *arg = arg_entry;
12848 struct gdbarch *gdbarch = get_current_arch ();
12849 int tempflag;
12850 enum ada_exception_catchpoint_kind ex_kind;
12851 std::string excep_string;
12852 std::string cond_string;
12853
12854 tempflag = command->context () == CATCH_TEMPORARY;
12855
12856 if (!arg)
12857 arg = "";
12858 catch_ada_exception_command_split (arg, true, &ex_kind, &excep_string,
12859 &cond_string);
12861 excep_string, cond_string,
12862 tempflag, 1 /* enabled */,
12863 from_tty);
12864}
12865
12866/* Completion function for the Ada "catch" commands. */
12867
12868static void
12870 const char *text, const char *word)
12871{
12872 std::vector<ada_exc_info> exceptions = ada_exceptions_list (NULL);
12873
12874 for (const ada_exc_info &info : exceptions)
12875 {
12876 if (startswith (info.name, word))
12877 tracker.add_completion (make_unique_xstrdup (info.name));
12878 }
12879}
12880
12881/* Split the arguments specified in a "catch assert" command.
12882
12883 ARGS contains the command's arguments (or the empty string if
12884 no arguments were passed).
12885
12886 If ARGS contains a condition, set COND_STRING to that condition
12887 (the memory needs to be deallocated after use). */
12888
12889static void
12890catch_ada_assert_command_split (const char *args, std::string &cond_string)
12891{
12892 args = skip_spaces (args);
12893
12894 /* Check whether a condition was provided. */
12895 if (startswith (args, "if")
12896 && (isspace (args[2]) || args[2] == '\0'))
12897 {
12898 args += 2;
12899 args = skip_spaces (args);
12900 if (args[0] == '\0')
12901 error (_("condition missing after `if' keyword"));
12902 cond_string.assign (args);
12903 }
12904
12905 /* Otherwise, there should be no other argument at the end of
12906 the command. */
12907 else if (args[0] != '\0')
12908 error (_("Junk at end of arguments."));
12909}
12910
12911/* Implement the "catch assert" command. */
12912
12913static void
12914catch_assert_command (const char *arg_entry, int from_tty,
12915 struct cmd_list_element *command)
12916{
12917 const char *arg = arg_entry;
12918 struct gdbarch *gdbarch = get_current_arch ();
12919 int tempflag;
12920 std::string cond_string;
12921
12922 tempflag = command->context () == CATCH_TEMPORARY;
12923
12924 if (!arg)
12925 arg = "";
12926 catch_ada_assert_command_split (arg, cond_string);
12928 "", cond_string,
12929 tempflag, 1 /* enabled */,
12930 from_tty);
12931}
12932
12933/* Return non-zero if the symbol SYM is an Ada exception object. */
12934
12935static int
12937{
12938 const char *type_name = sym->type ()->name ();
12939
12940 return (sym->aclass () != LOC_TYPEDEF
12941 && sym->aclass () != LOC_BLOCK
12942 && sym->aclass () != LOC_CONST
12943 && sym->aclass () != LOC_UNRESOLVED
12944 && type_name != NULL && strcmp (type_name, "exception") == 0);
12945}
12946
12947/* Given a global symbol SYM, return non-zero iff SYM is a non-standard
12948 Ada exception object. This matches all exceptions except the ones
12949 defined by the Ada language. */
12950
12951static int
12953{
12954 if (!ada_is_exception_sym (sym))
12955 return 0;
12956
12957 for (const char *name : standard_exc)
12958 if (strcmp (sym->linkage_name (), name) == 0)
12959 return 0; /* A standard exception. */
12960
12961 /* Numeric_Error is also a standard exception, so exclude it.
12962 See the STANDARD_EXC description for more details as to why
12963 this exception is not listed in that array. */
12964 if (strcmp (sym->linkage_name (), "numeric_error") == 0)
12965 return 0;
12966
12967 return 1;
12968}
12969
12970/* A helper function for std::sort, comparing two struct ada_exc_info
12971 objects.
12972
12973 The comparison is determined first by exception name, and then
12974 by exception address. */
12975
12976bool
12977ada_exc_info::operator< (const ada_exc_info &other) const
12978{
12979 int result;
12980
12981 result = strcmp (name, other.name);
12982 if (result < 0)
12983 return true;
12984 if (result == 0 && addr < other.addr)
12985 return true;
12986 return false;
12987}
12988
12989bool
12991{
12992 return addr == other.addr && strcmp (name, other.name) == 0;
12993}
12994
12995/* Sort EXCEPTIONS using compare_ada_exception_info as the comparison
12996 routine, but keeping the first SKIP elements untouched.
12997
12998 All duplicates are also removed. */
12999
13000static void
13001sort_remove_dups_ada_exceptions_list (std::vector<ada_exc_info> *exceptions,
13002 int skip)
13003{
13004 std::sort (exceptions->begin () + skip, exceptions->end ());
13005 exceptions->erase (std::unique (exceptions->begin () + skip, exceptions->end ()),
13006 exceptions->end ());
13007}
13008
13009/* Add all exceptions defined by the Ada standard whose name match
13010 a regular expression.
13011
13012 If PREG is not NULL, then this regexp_t object is used to
13013 perform the symbol name matching. Otherwise, no name-based
13014 filtering is performed.
13015
13016 EXCEPTIONS is a vector of exceptions to which matching exceptions
13017 gets pushed. */
13018
13019static void
13020ada_add_standard_exceptions (compiled_regex *preg,
13021 std::vector<ada_exc_info> *exceptions)
13022{
13023 for (const char *name : standard_exc)
13024 {
13025 if (preg == NULL || preg->exec (name, 0, NULL, 0) == 0)
13026 {
13028 lookup_name_info lookup_name (name, match_type);
13029
13030 symbol_name_matcher_ftype *match_name
13031 = ada_get_symbol_name_matcher (lookup_name);
13032
13033 /* Iterate over all objfiles irrespective of scope or linker
13034 namespaces so we get all exceptions anywhere in the
13035 progspace. */
13037 {
13038 for (minimal_symbol *msymbol : objfile->msymbols ())
13039 {
13040 if (match_name (msymbol->linkage_name (), lookup_name,
13041 nullptr)
13042 && msymbol->type () != mst_solib_trampoline)
13043 {
13045 = {name, msymbol->value_address (objfile)};
13046
13047 exceptions->push_back (info);
13048 }
13049 }
13050 }
13051 }
13052 }
13053}
13054
13055/* Add all Ada exceptions defined locally and accessible from the given
13056 FRAME.
13057
13058 If PREG is not NULL, then this regexp_t object is used to
13059 perform the symbol name matching. Otherwise, no name-based
13060 filtering is performed.
13061
13062 EXCEPTIONS is a vector of exceptions to which matching exceptions
13063 gets pushed. */
13064
13065static void
13066ada_add_exceptions_from_frame (compiled_regex *preg,
13067 frame_info_ptr frame,
13068 std::vector<ada_exc_info> *exceptions)
13069{
13070 const struct block *block = get_frame_block (frame, 0);
13071
13072 while (block != 0)
13073 {
13074 struct block_iterator iter;
13075 struct symbol *sym;
13076
13077 ALL_BLOCK_SYMBOLS (block, iter, sym)
13078 {
13079 switch (sym->aclass ())
13080 {
13081 case LOC_TYPEDEF:
13082 case LOC_BLOCK:
13083 case LOC_CONST:
13084 break;
13085 default:
13086 if (ada_is_exception_sym (sym))
13087 {
13088 struct ada_exc_info info = {sym->print_name (),
13089 sym->value_address ()};
13090
13091 exceptions->push_back (info);
13092 }
13093 }
13094 }
13095 if (block->function () != NULL)
13096 break;
13097 block = block->superblock ();
13098 }
13099}
13100
13101/* Return true if NAME matches PREG or if PREG is NULL. */
13102
13103static bool
13104name_matches_regex (const char *name, compiled_regex *preg)
13105{
13106 return (preg == NULL
13107 || preg->exec (ada_decode (name).c_str (), 0, NULL, 0) == 0);
13108}
13109
13110/* Add all exceptions defined globally whose name name match
13111 a regular expression, excluding standard exceptions.
13112
13113 The reason we exclude standard exceptions is that they need
13114 to be handled separately: Standard exceptions are defined inside
13115 a runtime unit which is normally not compiled with debugging info,
13116 and thus usually do not show up in our symbol search. However,
13117 if the unit was in fact built with debugging info, we need to
13118 exclude them because they would duplicate the entry we found
13119 during the special loop that specifically searches for those
13120 standard exceptions.
13121
13122 If PREG is not NULL, then this regexp_t object is used to
13123 perform the symbol name matching. Otherwise, no name-based
13124 filtering is performed.
13125
13126 EXCEPTIONS is a vector of exceptions to which matching exceptions
13127 gets pushed. */
13128
13129static void
13130ada_add_global_exceptions (compiled_regex *preg,
13131 std::vector<ada_exc_info> *exceptions)
13132{
13133 /* In Ada, the symbol "search name" is a linkage name, whereas the
13134 regular expression used to do the matching refers to the natural
13135 name. So match against the decoded name. */
13138 [&] (const char *search_name)
13139 {
13140 std::string decoded = ada_decode (search_name);
13141 return name_matches_regex (decoded.c_str (), preg);
13142 },
13143 NULL,
13146
13147 /* Iterate over all objfiles irrespective of scope or linker namespaces
13148 so we get all exceptions anywhere in the progspace. */
13150 {
13151 for (compunit_symtab *s : objfile->compunits ())
13152 {
13153 const struct blockvector *bv = s->blockvector ();
13154 int i;
13155
13156 for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
13157 {
13158 const struct block *b = bv->block (i);
13159 struct block_iterator iter;
13160 struct symbol *sym;
13161
13162 ALL_BLOCK_SYMBOLS (b, iter, sym)
13164 && name_matches_regex (sym->natural_name (), preg))
13165 {
13166 struct ada_exc_info info
13167 = {sym->print_name (), sym->value_address ()};
13168
13169 exceptions->push_back (info);
13170 }
13171 }
13172 }
13173 }
13174}
13175
13176/* Implements ada_exceptions_list with the regular expression passed
13177 as a regex_t, rather than a string.
13178
13179 If not NULL, PREG is used to filter out exceptions whose names
13180 do not match. Otherwise, all exceptions are listed. */
13181
13182static std::vector<ada_exc_info>
13183ada_exceptions_list_1 (compiled_regex *preg)
13184{
13185 std::vector<ada_exc_info> result;
13186 int prev_len;
13187
13188 /* First, list the known standard exceptions. These exceptions
13189 need to be handled separately, as they are usually defined in
13190 runtime units that have been compiled without debugging info. */
13191
13192 ada_add_standard_exceptions (preg, &result);
13193
13194 /* Next, find all exceptions whose scope is local and accessible
13195 from the currently selected frame. */
13196
13197 if (has_stack_frames ())
13198 {
13199 prev_len = result.size ();
13201 &result);
13202 if (result.size () > prev_len)
13203 sort_remove_dups_ada_exceptions_list (&result, prev_len);
13204 }
13205
13206 /* Add all exceptions whose scope is global. */
13207
13208 prev_len = result.size ();
13209 ada_add_global_exceptions (preg, &result);
13210 if (result.size () > prev_len)
13211 sort_remove_dups_ada_exceptions_list (&result, prev_len);
13212
13213 return result;
13214}
13215
13216/* Return a vector of ada_exc_info.
13217
13218 If REGEXP is NULL, all exceptions are included in the result.
13219 Otherwise, it should contain a valid regular expression,
13220 and only the exceptions whose names match that regular expression
13221 are included in the result.
13222
13223 The exceptions are sorted in the following order:
13224 - Standard exceptions (defined by the Ada language), in
13225 alphabetical order;
13226 - Exceptions only visible from the current frame, in
13227 alphabetical order;
13228 - Exceptions whose scope is global, in alphabetical order. */
13229
13230std::vector<ada_exc_info>
13231ada_exceptions_list (const char *regexp)
13232{
13233 if (regexp == NULL)
13234 return ada_exceptions_list_1 (NULL);
13235
13236 compiled_regex reg (regexp, REG_NOSUB, _("invalid regular expression"));
13237 return ada_exceptions_list_1 (&reg);
13238}
13239
13240/* Implement the "info exceptions" command. */
13241
13242static void
13243info_exceptions_command (const char *regexp, int from_tty)
13244{
13245 struct gdbarch *gdbarch = get_current_arch ();
13246
13247 std::vector<ada_exc_info> exceptions = ada_exceptions_list (regexp);
13248
13249 if (regexp != NULL)
13251 (_("All Ada exceptions matching regular expression \"%s\":\n"), regexp);
13252 else
13253 gdb_printf (_("All defined Ada exceptions:\n"));
13254
13255 for (const ada_exc_info &info : exceptions)
13256 gdb_printf ("%s: %s\n", info.name, paddress (gdbarch, info.addr));
13257}
13258
13259
13260 /* Language vector */
13261
13262/* symbol_name_matcher_ftype adapter for wild_match. */
13263
13264static bool
13265do_wild_match (const char *symbol_search_name,
13266 const lookup_name_info &lookup_name,
13267 completion_match_result *comp_match_res)
13268{
13269 return wild_match (symbol_search_name, ada_lookup_name (lookup_name));
13270}
13271
13272/* symbol_name_matcher_ftype adapter for full_match. */
13273
13274static bool
13275do_full_match (const char *symbol_search_name,
13276 const lookup_name_info &lookup_name,
13277 completion_match_result *comp_match_res)
13278{
13279 const char *lname = lookup_name.ada ().lookup_name ().c_str ();
13280
13281 /* If both symbols start with "_ada_", just let the loop below
13282 handle the comparison. However, if only the symbol name starts
13283 with "_ada_", skip the prefix and let the match proceed as
13284 usual. */
13285 if (startswith (symbol_search_name, "_ada_")
13286 && !startswith (lname, "_ada"))
13287 symbol_search_name += 5;
13288 /* Likewise for ghost entities. */
13289 if (startswith (symbol_search_name, "___ghost_")
13290 && !startswith (lname, "___ghost_"))
13291 symbol_search_name += 9;
13292
13293 int uscore_count = 0;
13294 while (*lname != '\0')
13295 {
13296 if (*symbol_search_name != *lname)
13297 {
13298 if (*symbol_search_name == 'B' && uscore_count == 2
13299 && symbol_search_name[1] == '_')
13300 {
13301 symbol_search_name += 2;
13302 while (isdigit (*symbol_search_name))
13303 ++symbol_search_name;
13304 if (symbol_search_name[0] == '_'
13305 && symbol_search_name[1] == '_')
13306 {
13307 symbol_search_name += 2;
13308 continue;
13309 }
13310 }
13311 return false;
13312 }
13313
13314 if (*symbol_search_name == '_')
13315 ++uscore_count;
13316 else
13317 uscore_count = 0;
13318
13319 ++symbol_search_name;
13320 ++lname;
13321 }
13322
13323 return is_name_suffix (symbol_search_name);
13324}
13325
13326/* symbol_name_matcher_ftype for exact (verbatim) matches. */
13327
13328static bool
13329do_exact_match (const char *symbol_search_name,
13330 const lookup_name_info &lookup_name,
13331 completion_match_result *comp_match_res)
13332{
13333 return strcmp (symbol_search_name, ada_lookup_name (lookup_name)) == 0;
13334}
13335
13336/* Build the Ada lookup name for LOOKUP_NAME. */
13337
13339{
13340 gdb::string_view user_name = lookup_name.name ();
13341
13342 if (!user_name.empty () && user_name[0] == '<')
13343 {
13344 if (user_name.back () == '>')
13346 = gdb::to_string (user_name.substr (1, user_name.size () - 2));
13347 else
13349 = gdb::to_string (user_name.substr (1, user_name.size () - 1));
13350 m_encoded_p = true;
13351 m_verbatim_p = true;
13352 m_wild_match_p = false;
13353 m_standard_p = false;
13354 }
13355 else
13356 {
13357 m_verbatim_p = false;
13358
13359 m_encoded_p = user_name.find ("__") != gdb::string_view::npos;
13360
13361 if (!m_encoded_p)
13362 {
13363 const char *folded = ada_fold_name (user_name);
13364 m_encoded_name = ada_encode_1 (folded, false);
13365 if (m_encoded_name.empty ())
13366 m_encoded_name = gdb::to_string (user_name);
13367 }
13368 else
13369 m_encoded_name = gdb::to_string (user_name);
13370
13371 /* Handle the 'package Standard' special case. See description
13372 of m_standard_p. */
13373 if (startswith (m_encoded_name.c_str (), "standard__"))
13374 {
13375 m_encoded_name = m_encoded_name.substr (sizeof ("standard__") - 1);
13376 m_standard_p = true;
13377 }
13378 else
13379 m_standard_p = false;
13380
13381 /* If the name contains a ".", then the user is entering a fully
13382 qualified entity name, and the match must not be done in wild
13383 mode. Similarly, if the user wants to complete what looks
13384 like an encoded name, the match must not be done in wild
13385 mode. Also, in the standard__ special case always do
13386 non-wild matching. */
13388 = (lookup_name.match_type () != symbol_name_match_type::FULL
13389 && !m_encoded_p
13390 && !m_standard_p
13391 && user_name.find ('.') == std::string::npos);
13392 }
13393}
13394
13395/* symbol_name_matcher_ftype method for Ada. This only handles
13396 completion mode. */
13397
13398static bool
13399ada_symbol_name_matches (const char *symbol_search_name,
13400 const lookup_name_info &lookup_name,
13401 completion_match_result *comp_match_res)
13402{
13403 return lookup_name.ada ().matches (symbol_search_name,
13404 lookup_name.match_type (),
13405 comp_match_res);
13406}
13407
13408/* A name matcher that matches the symbol name exactly, with
13409 strcmp. */
13410
13411static bool
13412literal_symbol_name_matcher (const char *symbol_search_name,
13413 const lookup_name_info &lookup_name,
13414 completion_match_result *comp_match_res)
13415{
13416 gdb::string_view name_view = lookup_name.name ();
13417
13418 if (lookup_name.completion_mode ()
13419 ? (strncmp (symbol_search_name, name_view.data (),
13420 name_view.size ()) == 0)
13421 : symbol_search_name == name_view)
13422 {
13423 if (comp_match_res != NULL)
13424 comp_match_res->set_match (symbol_search_name);
13425 return true;
13426 }
13427 else
13428 return false;
13429}
13430
13431/* Implement the "get_symbol_name_matcher" language_defn method for
13432 Ada. */
13433
13436{
13437 if (lookup_name.match_type () == symbol_name_match_type::SEARCH_NAME)
13439
13440 if (lookup_name.completion_mode ())
13442 else
13443 {
13444 if (lookup_name.ada ().wild_match_p ())
13445 return do_wild_match;
13446 else if (lookup_name.ada ().verbatim_p ())
13447 return do_exact_match;
13448 else
13449 return do_full_match;
13450 }
13451}
13452
13453/* Class representing the Ada language. */
13454
13456{
13457public:
13460 { /* Nothing. */ }
13461
13462 /* See language.h. */
13463
13464 const char *name () const override
13465 { return "ada"; }
13466
13467 /* See language.h. */
13468
13469 const char *natural_name () const override
13470 { return "Ada"; }
13471
13472 /* See language.h. */
13473
13474 const std::vector<const char *> &filename_extensions () const override
13475 {
13476 static const std::vector<const char *> extensions
13477 = { ".adb", ".ads", ".a", ".ada", ".dg" };
13478 return extensions;
13479 }
13480
13481 /* Print an array element index using the Ada syntax. */
13482
13483 void print_array_index (struct type *index_type,
13484 LONGEST index,
13485 struct ui_file *stream,
13486 const value_print_options *options) const override
13487 {
13488 struct value *index_value = val_atr (index_type, index);
13489
13490 value_print (index_value, stream, options);
13491 gdb_printf (stream, " => ");
13492 }
13493
13494 /* Implement the "read_var_value" language_defn method for Ada. */
13495
13496 struct value *read_var_value (struct symbol *var,
13497 const struct block *var_block,
13498 frame_info_ptr frame) const override
13499 {
13500 /* The only case where default_read_var_value is not sufficient
13501 is when VAR is a renaming... */
13502 if (frame != nullptr)
13503 {
13504 const struct block *frame_block = get_frame_block (frame, NULL);
13505 if (frame_block != nullptr && ada_is_renaming_symbol (var))
13506 return ada_read_renaming_var_value (var, frame_block);
13507 }
13508
13509 /* This is a typical case where we expect the default_read_var_value
13510 function to work. */
13511 return language_defn::read_var_value (var, var_block, frame);
13512 }
13513
13514 /* See language.h. */
13515 bool symbol_printing_suppressed (struct symbol *symbol) const override
13516 {
13517 return symbol->is_artificial ();
13518 }
13519
13520 /* See language.h. */
13522 struct language_arch_info *lai) const override
13523 {
13524 const struct builtin_type *builtin = builtin_type (gdbarch);
13525
13526 /* Helper function to allow shorter lines below. */
13527 auto add = [&] (struct type *t)
13528 {
13529 lai->add_primitive_type (t);
13530 };
13531
13533 0, "integer"));
13535 0, "long_integer"));
13537 0, "short_integer"));
13538 struct type *char_type = arch_character_type (gdbarch, TARGET_CHAR_BIT,
13539 1, "character");
13540 lai->set_string_char_type (char_type);
13541 add (char_type);
13542 add (arch_character_type (gdbarch, 16, 1, "wide_character"));
13543 add (arch_character_type (gdbarch, 32, 1, "wide_wide_character"));
13545 "float", gdbarch_float_format (gdbarch)));
13547 "long_float", gdbarch_double_format (gdbarch)));
13549 0, "long_long_integer"));
13551 "long_long_float",
13554 0, "natural"));
13556 0, "positive"));
13557 add (builtin->builtin_void);
13558
13559 struct type *system_addr_ptr
13560 = lookup_pointer_type (arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT,
13561 "void"));
13562 system_addr_ptr->set_name ("system__address");
13563 add (system_addr_ptr);
13564
13565 /* Create the equivalent of the System.Storage_Elements.Storage_Offset
13566 type. This is a signed integral type whose size is the same as
13567 the size of addresses. */
13568 unsigned int addr_length = system_addr_ptr->length ();
13569 add (arch_integer_type (gdbarch, addr_length * HOST_CHAR_BIT, 0,
13570 "storage_offset"));
13571
13572 lai->set_bool_type (builtin->builtin_bool);
13573 }
13574
13575 /* See language.h. */
13576
13578 (const struct block *block, const lookup_name_info &name,
13579 domain_enum domain,
13580 gdb::function_view<symbol_found_callback_ftype> callback) const override
13581 {
13582 std::vector<struct block_symbol> results
13584 for (block_symbol &sym : results)
13585 {
13586 if (!callback (&sym))
13587 return false;
13588 }
13589
13590 return true;
13591 }
13592
13593 /* See language.h. */
13595 (const char *mangled,
13596 gdb::unique_xmalloc_ptr<char> *out) const override
13597 {
13598 std::string demangled = ada_decode (mangled);
13599
13600 *out = NULL;
13601
13602 if (demangled != mangled && demangled[0] != '<')
13603 {
13604 /* Set the gsymbol language to Ada, but still return 0.
13605 Two reasons for that:
13606
13607 1. For Ada, we prefer computing the symbol's decoded name
13608 on the fly rather than pre-compute it, in order to save
13609 memory (Ada projects are typically very large).
13610
13611 2. There are some areas in the definition of the GNAT
13612 encoding where, with a bit of bad luck, we might be able
13613 to decode a non-Ada symbol, generating an incorrect
13614 demangled name (Eg: names ending with "TB" for instance
13615 are identified as task bodies and so stripped from
13616 the decoded name returned).
13617
13618 Returning true, here, but not setting *DEMANGLED, helps us get
13619 a little bit of the best of both worlds. Because we're last,
13620 we should not affect any of the other languages that were
13621 able to demangle the symbol before us; we get to correctly
13622 tag Ada symbols as such; and even if we incorrectly tagged a
13623 non-Ada symbol, which should be rare, any routing through the
13624 Ada language should be transparent (Ada tries to behave much
13625 like C/C++ with non-Ada symbols). */
13626 return true;
13627 }
13628
13629 return false;
13630 }
13631
13632 /* See language.h. */
13633
13634 gdb::unique_xmalloc_ptr<char> demangle_symbol (const char *mangled,
13635 int options) const override
13636 {
13637 return make_unique_xstrdup (ada_decode (mangled).c_str ());
13638 }
13639
13640 /* See language.h. */
13641
13642 void print_type (struct type *type, const char *varstring,
13643 struct ui_file *stream, int show, int level,
13644 const struct type_print_options *flags) const override
13645 {
13646 ada_print_type (type, varstring, stream, show, level, flags);
13647 }
13648
13649 /* See language.h. */
13650
13651 const char *word_break_characters (void) const override
13652 {
13654 }
13655
13656 /* See language.h. */
13657
13660 symbol_name_match_type name_match_type,
13661 const char *text, const char *word,
13662 enum type_code code) const override
13663 {
13664 struct symbol *sym;
13665 const struct block *b, *surrounding_static_block = 0;
13666 struct block_iterator iter;
13667
13668 gdb_assert (code == TYPE_CODE_UNDEF);
13669
13670 lookup_name_info lookup_name (text, name_match_type, true);
13671
13672 /* First, look at the partial symtab symbols. */
13674 lookup_name,
13675 NULL,
13676 NULL,
13678 ALL_DOMAIN);
13679
13680 /* At this point scan through the misc symbol vectors and add each
13681 symbol you find to the list. Eventually we want to ignore
13682 anything that isn't a text symbol (everything else will be
13683 handled by the psymtab code above). */
13684
13686 {
13687 for (minimal_symbol *msymbol : objfile->msymbols ())
13688 {
13689 QUIT;
13690
13691 if (completion_skip_symbol (mode, msymbol))
13692 continue;
13693
13694 language symbol_language = msymbol->language ();
13695
13696 /* Ada minimal symbols won't have their language set to Ada. If
13697 we let completion_list_add_name compare using the
13698 default/C-like matcher, then when completing e.g., symbols in a
13699 package named "pck", we'd match internal Ada symbols like
13700 "pckS", which are invalid in an Ada expression, unless you wrap
13701 them in '<' '>' to request a verbatim match.
13702
13703 Unfortunately, some Ada encoded names successfully demangle as
13704 C++ symbols (using an old mangling scheme), such as "name__2Xn"
13705 -> "Xn::name(void)" and thus some Ada minimal symbols end up
13706 with the wrong language set. Paper over that issue here. */
13707 if (symbol_language == language_auto
13708 || symbol_language == language_cplus)
13709 symbol_language = language_ada;
13710
13711 completion_list_add_name (tracker,
13712 symbol_language,
13713 msymbol->linkage_name (),
13714 lookup_name, text, word);
13715 }
13716 }
13717
13718 /* Search upwards from currently selected frame (so that we can
13719 complete on local vars. */
13720
13721 for (b = get_selected_block (0); b != NULL; b = b->superblock ())
13722 {
13723 if (!b->superblock ())
13724 surrounding_static_block = b; /* For elmin of dups */
13725
13726 ALL_BLOCK_SYMBOLS (b, iter, sym)
13727 {
13728 if (completion_skip_symbol (mode, sym))
13729 continue;
13730
13731 completion_list_add_name (tracker,
13732 sym->language (),
13733 sym->linkage_name (),
13734 lookup_name, text, word);
13735 }
13736 }
13737
13738 /* Go through the symtabs and check the externs and statics for
13739 symbols which match. */
13740
13742 {
13743 for (compunit_symtab *s : objfile->compunits ())
13744 {
13745 QUIT;
13746 b = s->blockvector ()->global_block ();
13747 ALL_BLOCK_SYMBOLS (b, iter, sym)
13748 {
13749 if (completion_skip_symbol (mode, sym))
13750 continue;
13751
13752 completion_list_add_name (tracker,
13753 sym->language (),
13754 sym->linkage_name (),
13755 lookup_name, text, word);
13756 }
13757 }
13758 }
13759
13761 {
13762 for (compunit_symtab *s : objfile->compunits ())
13763 {
13764 QUIT;
13765 b = s->blockvector ()->static_block ();
13766 /* Don't do this block twice. */
13767 if (b == surrounding_static_block)
13768 continue;
13769 ALL_BLOCK_SYMBOLS (b, iter, sym)
13770 {
13771 if (completion_skip_symbol (mode, sym))
13772 continue;
13773
13774 completion_list_add_name (tracker,
13775 sym->language (),
13776 sym->linkage_name (),
13777 lookup_name, text, word);
13778 }
13779 }
13780 }
13781 }
13782
13783 /* See language.h. */
13784
13785 gdb::unique_xmalloc_ptr<char> watch_location_expression
13786 (struct type *type, CORE_ADDR addr) const override
13787 {
13788 type = check_typedef (check_typedef (type)->target_type ());
13789 std::string name = type_to_string (type);
13790 return xstrprintf ("{%s} %s", name.c_str (), core_addr_to_string (addr));
13791 }
13792
13793 /* See language.h. */
13794
13795 void value_print (struct value *val, struct ui_file *stream,
13796 const struct value_print_options *options) const override
13797 {
13798 return ada_value_print (val, stream, options);
13799 }
13800
13801 /* See language.h. */
13802
13804 (struct value *val, struct ui_file *stream, int recurse,
13805 const struct value_print_options *options) const override
13806 {
13807 return ada_value_print_inner (val, stream, recurse, options);
13808 }
13809
13810 /* See language.h. */
13811
13813 (const char *name, const struct block *block,
13814 const domain_enum domain) const override
13815 {
13816 struct block_symbol sym;
13817
13819 if (sym.symbol != NULL)
13820 return sym;
13821
13822 /* If we haven't found a match at this point, try the primitive
13823 types. In other languages, this search is performed before
13824 searching for global symbols in order to short-circuit that
13825 global-symbol search if it happens that the name corresponds
13826 to a primitive type. But we cannot do the same in Ada, because
13827 it is perfectly legitimate for a program to declare a type which
13828 has the same name as a standard type. If looking up a type in
13829 that situation, we have traditionally ignored the primitive type
13830 in favor of user-defined types. This is why, unlike most other
13831 languages, we search the primitive types this late and only after
13832 having searched the global symbols without success. */
13833
13834 if (domain == VAR_DOMAIN)
13835 {
13836 struct gdbarch *gdbarch;
13837
13838 if (block == NULL)
13840 else
13842 sym.symbol
13844 if (sym.symbol != NULL)
13845 return sym;
13846 }
13847
13848 return {};
13849 }
13850
13851 /* See language.h. */
13852
13853 int parser (struct parser_state *ps) const override
13854 {
13855 warnings_issued = 0;
13856 return ada_parse (ps);
13857 }
13858
13859 /* See language.h. */
13860
13861 void emitchar (int ch, struct type *chtype,
13862 struct ui_file *stream, int quoter) const override
13863 {
13864 ada_emit_char (ch, chtype, stream, quoter, 1);
13865 }
13866
13867 /* See language.h. */
13868
13869 void printchar (int ch, struct type *chtype,
13870 struct ui_file *stream) const override
13871 {
13872 ada_printchar (ch, chtype, stream);
13873 }
13874
13875 /* See language.h. */
13876
13877 void printstr (struct ui_file *stream, struct type *elttype,
13878 const gdb_byte *string, unsigned int length,
13879 const char *encoding, int force_ellipses,
13880 const struct value_print_options *options) const override
13881 {
13882 ada_printstr (stream, elttype, string, length, encoding,
13883 force_ellipses, options);
13884 }
13885
13886 /* See language.h. */
13887
13888 void print_typedef (struct type *type, struct symbol *new_symbol,
13889 struct ui_file *stream) const override
13890 {
13892 }
13893
13894 /* See language.h. */
13895
13896 bool is_string_type_p (struct type *type) const override
13897 {
13898 return ada_is_string_type (type);
13899 }
13900
13901 /* See language.h. */
13902
13903 const char *struct_too_deep_ellipsis () const override
13904 { return "(...)"; }
13905
13906 /* See language.h. */
13907
13908 bool c_style_arrays_p () const override
13909 { return false; }
13910
13911 /* See language.h. */
13912
13914 { return true; }
13915
13916 /* See language.h. */
13917
13918 const struct lang_varobj_ops *varobj_ops () const override
13919 { return &ada_varobj_ops; }
13920
13921protected:
13922 /* See language.h. */
13923
13925 (const lookup_name_info &lookup_name) const override
13926 {
13927 return ada_get_symbol_name_matcher (lookup_name);
13928 }
13929};
13930
13931/* Single instance of the Ada language class. */
13932
13934
13935/* Command-list for the "set/show ada" prefix command. */
13938
13939/* This module's 'new_objfile' observer. */
13940
13941static void
13943{
13945}
13946
13947/* This module's 'free_objfile' observer. */
13948
13949static void
13951{
13953}
13954
13955/* Charsets known to GNAT. */
13956static const char * const gnat_source_charsets[] =
13957{
13958 /* Note that code below assumes that the default comes first.
13959 Latin-1 is the default here, because that is also GNAT's
13960 default. */
13961 "ISO-8859-1",
13962 "ISO-8859-2",
13963 "ISO-8859-3",
13964 "ISO-8859-4",
13965 "ISO-8859-5",
13966 "ISO-8859-15",
13967 "CP437",
13968 "CP850",
13969 /* Note that this value is special-cased in the encoder and
13970 decoder. */
13971 ada_utf8,
13972 nullptr
13973};
13974
13976void
13978{
13980 ("ada", no_class,
13981 _("Prefix command for changing Ada-specific settings."),
13982 _("Generic command for showing Ada-specific settings."),
13984 &setlist, &showlist);
13985
13986 add_setshow_boolean_cmd ("trust-PAD-over-XVS", class_obscure,
13987 &trust_pad_over_xvs, _("\
13988Enable or disable an optimization trusting PAD types over XVS types."), _("\
13989Show whether an optimization trusting PAD types over XVS types is activated."),
13990 _("\
13991This is related to the encoding used by the GNAT compiler. The debugger\n\
13992should normally trust the contents of PAD types, but certain older versions\n\
13993of GNAT have a bug that sometimes causes the information in the PAD type\n\
13994to be incorrect. Turning this setting \"off\" allows the debugger to\n\
13995work around this bug. It is always safe to turn this option \"off\", but\n\
13996this incurs a slight performance penalty, so it is recommended to NOT change\n\
13997this option to \"off\" unless necessary."),
13998 NULL, NULL, &set_ada_list, &show_ada_list);
13999
14000 add_setshow_boolean_cmd ("print-signatures", class_vars,
14001 &print_signatures, _("\
14002Enable or disable the output of formal and return types for functions in the \
14003overloads selection menu."), _("\
14004Show whether the output of formal and return types for functions in the \
14005overloads selection menu is activated."),
14006 NULL, NULL, NULL, &set_ada_list, &show_ada_list);
14007
14009 add_setshow_enum_cmd ("source-charset", class_files,
14011 &ada_source_charset, _("\
14012Set the Ada source character set."), _("\
14013Show the Ada source character set."), _("\
14014The character set used for Ada source files.\n\
14015This must correspond to the '-gnati' or '-gnatW' option passed to GNAT."),
14016 nullptr, nullptr,
14018
14019 add_catch_command ("exception", _("\
14020Catch Ada exceptions, when raised.\n\
14021Usage: catch exception [ARG] [if CONDITION]\n\
14022Without any argument, stop when any Ada exception is raised.\n\
14023If ARG is \"unhandled\" (without the quotes), only stop when the exception\n\
14024being raised does not have a handler (and will therefore lead to the task's\n\
14025termination).\n\
14026Otherwise, the catchpoint only stops when the name of the exception being\n\
14027raised is the same as ARG.\n\
14028CONDITION is a boolean expression that is evaluated to see whether the\n\
14029exception should cause a stop."),
14034
14035 add_catch_command ("handlers", _("\
14036Catch Ada exceptions, when handled.\n\
14037Usage: catch handlers [ARG] [if CONDITION]\n\
14038Without any argument, stop when any Ada exception is handled.\n\
14039With an argument, catch only exceptions with the given name.\n\
14040CONDITION is a boolean expression that is evaluated to see whether the\n\
14041exception should cause a stop."),
14046 add_catch_command ("assert", _("\
14047Catch failed Ada assertions, when raised.\n\
14048Usage: catch assert [if CONDITION]\n\
14049CONDITION is a boolean expression that is evaluated to see whether the\n\
14050exception should cause a stop."),
14052 NULL,
14055
14056 add_info ("exceptions", info_exceptions_command,
14057 _("\
14058List all Ada exception names.\n\
14059Usage: info exceptions [REGEXP]\n\
14060If a regular expression is passed as an argument, only those matching\n\
14061the regular expression are listed."));
14062
14064 _("Set Ada maintenance-related variables."),
14065 _("Show Ada maintenance-related variables."),
14068
14070 ("ignore-descriptive-types", class_maintenance,
14072 _("Set whether descriptive types generated by GNAT should be ignored."),
14073 _("Show whether descriptive types generated by GNAT should be ignored."),
14074 _("\
14075When enabled, the debugger will stop using the DW_AT_GNAT_descriptive_type\n\
14076DWARF attribute."),
14078
14079 decoded_names_store = htab_create_alloc (256, htab_hash_string,
14080 htab_eq_string,
14081 NULL, xcalloc, xfree);
14082
14083 /* The ada-lang observers. */
14087}
#define bits(obj, st, fn)
Definition: aarch64-insn.h:35
const char *const name
Definition: aarch64-tdep.c:67
void * xmalloc(YYSIZE_T)
int ada_parse(struct parser_state *par_state)
Definition: ada-exp.c:3064
void xfree(void *)
struct value * ada_val_atr(enum noside noside, struct type *type, struct value *arg)
Definition: ada-lang.c:8961
std::string ada_decode(const char *encoded, bool wrap, bool operators)
Definition: ada-lang.c:1310
static struct value * ensure_lval(struct value *val)
Definition: ada-lang.c:4350
bool is_ada_exception_catchpoint(breakpoint *bp)
Definition: ada-lang.c:12573
static struct type * to_fixed_array_type(struct type *, struct value *, int)
Definition: ada-lang.c:8411
static struct type * template_to_static_fixed_type(struct type *type0)
Definition: ada-lang.c:8103
static int remove_compiler_suffix(const char *encoded, int *len)
Definition: ada-lang.c:1228
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:10380
static struct type * ada_typedef_target_type(struct type *type)
Definition: ada-lang.c:429
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:8932
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:2760
static void ada_add_global_exceptions(compiled_regex *preg, std::vector< ada_exc_info > *exceptions)
Definition: ada-lang.c:13130
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:10141
static struct value * ada_value_assign(struct value *toval, struct value *fromval)
Definition: ada-lang.c:2878
static int lesseq_defined_than(struct symbol *, struct symbol *)
Definition: ada-lang.c:4820
static int ada_is_gnat_encoded_packed_array_type(struct type *type)
Definition: ada-lang.c:2241
static void ada_free_objfile_observer(struct objfile *objfile)
Definition: ada-lang.c:13950
static const utf8_entry ada_case_fold[]
Definition: ada-lang.c:238
static std::string ada_exception_catchpoint_cond_string(const char *excep_string, enum ada_exception_catchpoint_kind ex)
Definition: ada-lang.c:12691
static struct type * ada_lookup_struct_elt_type(struct type *, const char *, int, int)
Definition: ada-lang.c:7321
static struct value * ada_coerce_ref(struct value *)
Definition: ada-lang.c:7540
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:10111
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:9116
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:4905
static bool trust_pad_over_xvs
Definition: ada-lang.c:9032
static CORE_ADDR value_pointer(struct value *value, struct type *type)
Definition: ada-lang.c:4563
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:5652
static const char *const attribute_names[]
Definition: ada-lang.c:8887
static struct value * desc_bounds(struct value *)
Definition: ada-lang.c:1814
static struct ada_pspace_data * get_ada_pspace_data(struct program_space *pspace)
Definition: ada-lang.c:388
static const char *const gnat_source_charsets[]
Definition: ada-lang.c:13956
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:10189
static struct type * desc_data_target_type(struct type *)
Definition: ada-lang.c:1894
static int ada_same_array_size_p(struct type *t1, struct type *t2)
Definition: ada-lang.c:9251
int ada_prefer_type(struct type *type0, struct type *type1)
Definition: ada-lang.c:7637
static struct type * thin_descriptor_type(struct type *type)
Definition: ada-lang.c:1735
struct value * ada_get_decoded_value(struct value *value)
Definition: ada-lang.c:755
struct value * ada_coerce_to_simple_array(struct value *arr)
Definition: ada-lang.c:2206
static int ada_is_redundant_index_type_desc(struct type *array_type, struct type *desc_type)
Definition: ada-lang.c:8385
static std::string ada_encode_1(const char *decoded, bool throw_errors)
Definition: ada-lang.c:931
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:1154
static int ada_is_direct_array_type(struct type *)
Definition: ada-lang.c:2029
static int compare_names(const char *string1, const char *string2)
Definition: ada-lang.c:5541
static int ada_is_non_standard_exception_sym(struct symbol *sym)
Definition: ada-lang.c:12952
static int desc_bound_bitsize(struct type *, int, int)
Definition: ada-lang.c:1983
static int is_thin_pntr(struct type *type)
Definition: ada-lang.c:1725
static int discrete_type_p(struct type *)
Definition: ada-lang.c:4160
void create_ada_exception_catchpoint(struct gdbarch *gdbarch, enum ada_exception_catchpoint_kind ex_kind, const std::string &excep_string, const std::string &cond_string, int tempflag, int disabled, int from_tty)
Definition: ada-lang.c:12795
static struct type * desc_index_type(struct type *, int)
Definition: ada-lang.c:1997
static symbol_name_match_type name_match_type_from_name(const char *lookup_name)
Definition: ada-lang.c:4756
static int ada_in_variant(LONGEST val, struct type *type, int field_num)
Definition: ada-lang.c:6875
static const char ada_completer_word_break_characters[]
Definition: ada-lang.c:283
static int ada_is_interface_tag(struct type *type)
Definition: ada-lang.c:6283
static struct type * ada_find_any_type(const char *name)
Definition: ada-lang.c:7608
static LONGEST recursively_update_array_bitsize(struct type *type)
Definition: ada-lang.c:2461
char * ada_main_name(void)
Definition: ada-lang.c:809
static struct type * decode_constrained_packed_array_type(struct type *)
Definition: ada-lang.c:2415
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:5599
static int return_match(struct type *func_type, struct type *context_type)
Definition: ada-lang.c:4002
static struct type * find_parallel_type_by_descriptive_type(struct type *type, const char *name)
Definition: ada-lang.c:7681
static const char * ada_lookup_name(const lookup_name_info &lookup_name)
Definition: ada-lang.c:5561
static struct value * ada_read_renaming_var_value(struct symbol *renaming_sym, const struct block *block)
Definition: ada-lang.c:4332
static void ada_remove_po_subprogram_suffix(const char *encoded, int *len)
Definition: ada-lang.c:1205
static int scalar_type_p(struct type *)
Definition: ada-lang.c:4135
static bool ada_ignore_descriptive_types_p
Definition: ada-lang.c:316
static struct symbol * ada_find_any_type_symbol(const char *name)
Definition: ada-lang.c:7591
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:11569
static void append_hex_encoded(std::string &result, uint32_t one_char)
Definition: ada-lang.c:882
static struct value * ada_promote_array_of_integrals(struct type *type, struct value *val)
Definition: ada-lang.c:9279
static const struct exception_support_info exception_support_info_v0
Definition: ada-lang.c:11679
int ada_is_variant_part(struct type *type, int field_num)
Definition: ada-lang.c:6738
static struct value * ada_value_slice(struct value *array, int low, int high)
Definition: ada-lang.c:3125
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:6403
static struct value * coerce_unspec_val_to_type(struct value *, struct type *)
Definition: ada-lang.c:549
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:13399
static void lim_warning(const char *format,...) ATTRIBUTE_PRINTF(1
Definition: ada-lang.c:607
value * ada_abs(struct type *expect_type, struct expression *exp, enum noside noside, enum exp_opcode op, struct value *arg1)
Definition: ada-lang.c:10212
static struct value * unwrap_value(struct value *)
Definition: ada-lang.c:9214
int ada_is_modular_type(struct type *type)
Definition: ada-lang.c:11557
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:10524
static struct value * ada_index_struct_field_1(int *, struct value *, int, struct type *)
Definition: ada-lang.c:7253
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:11456
static struct type * static_unwrap_type(struct type *type)
Definition: ada-lang.c:8769
struct type * ada_coerce_to_simple_array_type(struct type *type)
Definition: ada-lang.c:2227
bool get_int_var_value(const char *name, LONGEST &value)
Definition: ada-lang.c:11434
static const char ada_utf8[]
Definition: ada-lang.c:218
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:10129
static struct type * ada_get_tsd_type(struct inferior *inf)
Definition: ada-lang.c:6548
static struct value * make_array_descriptor(struct type *, struct value *)
Definition: ada-lang.c:4583
static std::string add_angle_brackets(const char *str)
Definition: ada-lang.c:464
static const char * ada_source_charset
Definition: ada-lang.c:214
static gdb::unique_xmalloc_ptr< char > ada_exception_message_1(void)
Definition: ada-lang.c:12029
static int ada_resolve_function(std::vector< struct block_symbol > &, struct value **, int, const char *, struct type *, bool)
Definition: ada-lang.c:4040
static const char *const known_runtime_file_name_patterns[]
Definition: ada-lang.c:301
static int ada_is_redundant_range_encoding(struct type *range_type, struct type *encoding_type)
Definition: ada-lang.c:8335
static int fat_pntr_bounds_bitsize(struct type *)
Definition: ada-lang.c:1878
std::string copy_and_hex_encode(struct obstack *storage)
Definition: ada-lang.c:907
static void ada_clear_symbol_cache()
Definition: ada-lang.c:4659
static const struct exception_support_info default_exception_support_info
Definition: ada-lang.c:11666
static int ada_has_this_exception_support(const struct exception_support_info *einfo)
Definition: ada-lang.c:11709
static const char *const known_auxiliary_function_name_patterns[]
Definition: ada-lang.c:305
static void catch_ada_assert_command_split(const char *args, std::string &cond_string)
Definition: ada-lang.c:12890
bool ada_is_access_to_unconstrained_array(struct type *type)
Definition: ada-lang.c:2988
static enum language ada_update_initial_language(enum language lang)
Definition: ada-lang.c:796
static int warnings_issued
Definition: ada-lang.c:299
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:12589
static struct value * val_atr(struct type *, LONGEST)
Definition: ada-lang.c:8946
int ada_which_variant_applies(struct type *var_type, struct value *outer)
Definition: ada-lang.c:7456
static struct cmd_list_element * maint_set_ada_cmdlist
Definition: ada-lang.c:311
static struct cmd_list_element * maint_show_ada_cmdlist
Definition: ada-lang.c:312
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:6074
static int is_dynamic_field(struct type *, int)
Definition: ada-lang.c:7803
static struct cache_entry ** find_entry(const char *name, domain_enum domain)
Definition: ada-lang.c:4672
static int lookup_cached_symbol(const char *name, domain_enum domain, struct symbol **sym, const struct block **block)
Definition: ada-lang.c:4694
#define TRUNCATION_TOWARDS_ZERO
Definition: ada-lang.c:69
static int symbols_are_identical_enums(const std::vector< struct block_symbol > &syms)
Definition: ada-lang.c:5011
static void value_assign_to_component(struct value *container, struct value *component, struct value *val)
Definition: ada-lang.c:2948
static struct value * desc_one_bound(struct value *, int, int)
Definition: ada-lang.c:1959
static struct value * thin_data_pntr(struct value *val)
Definition: ada-lang.c:1757
static LONGEST ada_array_bound(struct value *arr, int n, int which)
Definition: ada-lang.c:3331
static long decode_packed_array_bitsize(struct type *)
Definition: ada-lang.c:2307
static struct value * coerce_for_assign(struct type *type, struct value *val)
Definition: ada-lang.c:9317
static struct cmd_list_element * set_ada_list
Definition: ada-lang.c:13936
static const char * ada_unqualified_name(const char *decoded_name)
Definition: ada-lang.c:441
static const struct exception_support_info exception_support_info_fallback
Definition: ada-lang.c:11692
static int numeric_type_p(struct type *)
Definition: ada-lang.c:4089
static std::string type_as_string(struct type *type)
Definition: ada-lang.c:7291
static bool ada_is_any_packed_array_type(struct type *type)
Definition: ada-lang.c:2296
static struct value * ada_index_struct_field(int, struct value *, int, struct type *)
Definition: ada-lang.c:7241
static struct type * desc_bounds_type(struct type *)
Definition: ada-lang.c:1784
struct value * ada_value_subscript(struct value *arr, int arity, struct value **ind)
Definition: ada-lang.c:2999
static struct type * type_from_tag(struct value *tag)
Definition: ada-lang.c:6428
bool ada_is_string_type(struct type *type)
Definition: ada-lang.c:9006
CORE_ADDR() ada_unhandled_exception_name_addr_ftype(void)
Definition: ada-lang.c:11629
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:5571
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:10269
static struct value * ada_value_tag(struct value *val)
Definition: ada-lang.c:6393
static struct value * ada_value_cast(struct type *type, struct value *arg2)
Definition: ada-lang.c:9846
static CORE_ADDR ada_exception_name_addr_1(enum ada_exception_catchpoint_kind ex)
Definition: ada-lang.c:11985
static void catch_ada_exception_command(const char *arg_entry, int from_tty, struct cmd_list_element *command)
Definition: ada-lang.c:12819
static struct type * ada_tag_type(struct value *val)
Definition: ada-lang.c:6376
static void add_defn_to_vec(std::vector< struct block_symbol > &, struct symbol *, const struct block *)
Definition: ada-lang.c:4867
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:2185
static int ada_identical_enum_types_p(struct type *type1, struct type *type2)
Definition: ada-lang.c:4955
int ada_is_array_descriptor_type(struct type *type)
Definition: ada-lang.c:2068
static int advance_wild_match(const char **, const char *, char)
Definition: ada-lang.c:5990
static void ada_add_exceptions_from_frame(compiled_regex *preg, frame_info_ptr frame, std::vector< ada_exc_info > *exceptions)
Definition: ada-lang.c:13066
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:12869
static int has_negatives(struct type *type)
Definition: ada-lang.c:2609
static gdb::unique_xmalloc_ptr< char > ada_tag_name_from_tsd(struct value *tsd)
Definition: ada-lang.c:6598
static CORE_ADDR ada_unhandled_exception_name_addr_from_raise(void)
Definition: ada-lang.c:11939
static int fat_pntr_data_bitpos(struct type *)
Definition: ada-lang.c:1935
static int is_unchecked_variant(struct type *var_type, struct type *outer_type)
Definition: ada-lang.c:7443
static void ada_exception_support_info_sniffer(void)
Definition: ada-lang.c:11787
static bool convert_from_hex_encoded(std::string &out, const char *str, int n)
Definition: ada-lang.c:1268
static int ada_is_others_clause(struct type *type, int field_num)
Definition: ada-lang.c:6770
static int is_thick_pntr(struct type *type)
Definition: ada-lang.c:1773
static int integer_type_p(struct type *)
Definition: ada-lang.c:4113
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:5733
static void create_excep_cond_exprs(struct ada_catchpoint *c, enum ada_exception_catchpoint_kind ex)
Definition: ada-lang.c:12199
static struct type * empty_record(struct type *templ)
Definition: ada-lang.c:7834
static void remove_extra_symbols(std::vector< struct block_symbol > *syms)
Definition: ada-lang.c:5056
static CORE_ADDR cond_offset_target(CORE_ADDR address, long offset)
Definition: ada-lang.c:589
static int is_valid_name_for_wild_match(const char *name0)
Definition: ada-lang.c:5967
enum ada_renaming_category ada_parse_renaming(struct symbol *sym, const char **renamed_entity, int *len, const char **renaming_expr)
Definition: ada-lang.c:4270
const char * ada_type_name(struct type *type)
Definition: ada-lang.c:7670
static void catch_ada_handlers_command(const char *arg_entry, int from_tty, struct cmd_list_element *command)
Definition: ada-lang.c:12844
static CORE_ADDR ada_unhandled_exception_name_addr(void)
Definition: ada-lang.c:11928
void ada_lookup_encoded_symbol(const char *name, const struct block *block, domain_enum domain, struct block_symbol *info)
Definition: ada-lang.c:5780
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:2637
static int warning_limit
Definition: ada-lang.c:295
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:13275
void ada_find_printable_frame(frame_info_ptr fi)
Definition: ada-lang.c:11908
static bool name_matches_regex(const char *name, compiled_regex *preg)
Definition: ada-lang.c:13104
static int desc_bound_bitpos(struct type *, int, int)
Definition: ada-lang.c:1973
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:13265
static int is_lower_alphanum(const char c)
Definition: ada-lang.c:1164
static int ada_is_exception_sym(struct symbol *sym)
Definition: ada-lang.c:12936
struct type * ada_find_parallel_type(struct type *type, const char *suffix)
Definition: ada-lang.c:7758
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:8176
static bool convert_hex(const char *str, int n, uint32_t *out)
Definition: ada-lang.c:1245
struct type * ada_get_base_type(struct type *raw_type)
Definition: ada-lang.c:9055
static struct value * desc_data(struct value *)
Definition: ada-lang.c:1917
static symbol_name_matcher_ftype * ada_get_symbol_name_matcher(const lookup_name_info &lookup_name)
Definition: ada-lang.c:13435
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:10350
static struct type * to_fixed_record_type(struct type *type0, const gdb_byte *valaddr, CORE_ADDR address, struct value *dval)
Definition: ada-lang.c:8260
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:10247
static int ada_is_dispatch_table_ptr_type(struct type *type)
Definition: ada-lang.c:6266
std::vector< ada_exc_info > ada_exceptions_list(const char *regexp)
Definition: ada-lang.c:13231
static struct value * decode_constrained_packed_array(struct value *)
Definition: ada-lang.c:2492
static LONGEST ada_array_length(struct value *arr, int n)
Definition: ada-lang.c:3354
static struct type * ada_find_parallel_type_with_name(struct type *, const char *)
Definition: ada-lang.c:7742
static ada_language ada_language_defn
Definition: ada-lang.c:13933
static struct value * ada_value_binop(struct value *arg1, struct value *arg2, enum exp_opcode op)
Definition: ada-lang.c:9357
static struct type * dynamic_template_type(struct type *type)
Definition: ada-lang.c:7781
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:2106
static LONGEST max_of_size(int size)
Definition: ada-lang.c:621
static void add_component_interval(LONGEST, LONGEST, std::vector< LONGEST > &)
Definition: ada-lang.c:9808
static void ada_new_objfile_observer(struct objfile *objfile)
Definition: ada-lang.c:13942
bool ada_is_character_type(struct type *type)
Definition: ada-lang.c:8982
static void sort_remove_dups_ada_exceptions_list(std::vector< ada_exc_info > *exceptions, int skip)
Definition: ada-lang.c:13001
struct type * ada_parent_type(struct type *type)
Definition: ada-lang.c:6664
int ada_is_simple_array_type(struct type *type)
Definition: ada-lang.c:2054
static LONGEST min_of_size(int size)
Definition: ada-lang.c:630
int ada_is_system_address_type(struct type *type)
Definition: ada-lang.c:11349
static struct type * to_static_fixed_type(struct type *)
Definition: ada-lang.c:8735
LONGEST ada_discrete_type_high_bound(struct type *type)
Definition: ada-lang.c:666
static void ada_inferior_exit(struct inferior *inf)
Definition: ada-lang.c:363
int ada_is_parent_field(struct type *type, int field_num)
Definition: ada-lang.c:6695
static LONGEST pos_atr(struct value *)
Definition: ada-lang.c:8916
struct type * ada_get_decoded_type(struct type *type)
Definition: ada-lang.c:780
int ada_is_constrained_packed_array_type(struct type *type)
Definition: ada-lang.c:2256
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:10227
static struct value * get_var_value(const char *name, const char *err_msg)
Definition: ada-lang.c:11407
static int num_visible_fields(struct type *type)
Definition: ada-lang.c:7133
int ada_name_prefix_len(const char *name)
Definition: ada-lang.c:515
static struct type * desc_base_type(struct type *)
Definition: ada-lang.c:1706
static const char * ada_exception_sym_name(enum ada_exception_catchpoint_kind ex)
Definition: ada-lang.c:12659
static int ada_is_unconstrained_packed_array_type(struct type *)
Definition: ada-lang.c:2266
std::vector< struct block_symbol > ada_lookup_symbol_list(const char *name, const struct block *block, domain_enum domain)
Definition: ada-lang.c:5763
struct type * ada_aligned_type(struct type *type)
Definition: ada-lang.c:9103
struct value * ada_tag_value_at_base_address(struct value *obj)
Definition: ada-lang.c:6444
static int ada_value_equal(struct value *arg1, struct value *arg2)
Definition: ada-lang.c:9428
static bool ada_is_renaming_symbol(struct symbol *name_sym)
Definition: ada-lang.c:7625
struct type * ada_check_typedef(struct type *type)
Definition: ada-lang.c:8805
struct value * ada_convert_actual(struct value *actual, struct type *formal_type0)
Definition: ada-lang.c:4502
static struct value * ada_value_slice_from_ptr(struct value *array_ptr, struct type *type, int low, int high)
Definition: ada-lang.c:3090
static struct cmd_list_element * show_ada_list
Definition: ada-lang.c:13937
int ada_is_range_type_name(const char *name)
Definition: ada-lang.c:11546
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:3821
int ada_is_wrapper_field(struct type *type, int field_num)
Definition: ada-lang.c:6711
static struct type * constrained_packed_array_type(struct type *, long *)
Definition: ada-lang.c:2365
static void info_exceptions_command(const char *regexp, int from_tty)
Definition: ada-lang.c:13243
static struct value * ada_get_tsd_from_tag(struct value *tag)
Definition: ada-lang.c:6563
static struct ada_symbol_cache * ada_get_symbol_cache(struct program_space *pspace)
Definition: ada-lang.c:4646
static unsigned int field_alignment(struct type *type, int f)
Definition: ada-lang.c:7560
static const char * ada_attribute_name(enum exp_opcode n)
Definition: ada-lang.c:8905
int ada_is_tagged_type(struct type *type, int refok)
Definition: ada-lang.c:6350
static struct value * value_subscript_packed(struct value *, int, struct value **)
Definition: ada-lang.c:2559
struct block_symbol ada_lookup_symbol(const char *name, const struct block *block0, domain_enum domain)
Definition: ada-lang.c:5802
struct value * ada_val_atr(enum noside noside, struct type *type, struct value *arg)
Definition: ada-lang.c:8961
static struct value * ada_value_ptr_subscript(struct value *arr, int arity, struct value **ind)
Definition: ada-lang.c:3058
static int fat_pntr_data_bitsize(struct type *)
Definition: ada-lang.c:1944
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:10175
static const char *const standard_exc[]
Definition: ada-lang.c:11622
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:8699
static struct htab * decoded_names_store
Definition: ada-lang.c:1593
static struct ada_inferior_data * get_ada_inferior_data(struct inferior *inf)
Definition: ada-lang.c:348
static void ada_add_standard_exceptions(compiled_regex *preg, std::vector< ada_exc_info > *exceptions)
Definition: ada-lang.c:13020
static int ada_type_match(struct type *ftype, struct type *atype)
Definition: ada-lang.c:3907
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:7863
const char * ada_decode_symbol(const struct general_symbol_info *arg)
Definition: ada-lang.c:1606
static int equiv_types(struct type *, struct type *)
Definition: ada-lang.c:4800
int ada_is_tag_type(struct type *type)
Definition: ada-lang.c:6358
static bool should_stop_exception(const struct bp_location *bl)
Definition: ada-lang.c:12275
static int is_name_suffix(const char *)
Definition: ada-lang.c:5833
static gdb::unique_xmalloc_ptr< char > ada_exception_message(void)
Definition: ada-lang.c:12061
int ada_is_aligner_type(struct type *type)
Definition: ada-lang.c:9039
static void catch_assert_command(const char *arg_entry, int from_tty, struct cmd_list_element *command)
Definition: ada-lang.c:12914
static struct symtab_and_line ada_exception_sal(enum ada_exception_catchpoint_kind ex, std::string *addr_string)
Definition: ada-lang.c:12753
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:13412
static ULONGEST umax_of_size(int size)
Definition: ada-lang.c:637
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:8566
int ada_scan_number(const char str[], int k, LONGEST *R, int *new_k)
Definition: ada-lang.c:6833
static struct value * ada_value_struct_elt(struct value *arg, const char *name, int no_err)
Definition: ada-lang.c:4380
static const utf8_entry * find_case_fold_entry(uint32_t c)
Definition: ada-lang.c:1019
static struct value * ada_to_fixed_value_create(struct type *type0, CORE_ADDR address, struct value *val0)
Definition: ada-lang.c:8850
int ada_get_field_index(const struct type *type, const char *field_name, int maybe_missing)
Definition: ada-lang.c:495
const struct ada_opname_map ada_opname_table[]
Definition: ada-lang.c:840
static int desc_arity(struct type *)
Definition: ada-lang.c:2015
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:8086
struct value * ada_value_ind(struct value *val0)
Definition: ada-lang.c:7526
LONGEST ada_discrete_type_low_bound(struct type *type)
Definition: ada-lang.c:701
const char * ada_enum_name(const char *name)
Definition: ada-lang.c:9131
static int variant_field_index(struct type *type)
Definition: ada-lang.c:7816
static int fat_pntr_bounds_bitpos(struct type *)
Definition: ada-lang.c:1869
int ada_is_bogus_array_descriptor(struct type *type)
Definition: ada-lang.c:2086
struct value * ada_value_primitive_field(struct value *arg1, int offset, int fieldno, struct type *arg_type)
Definition: ada-lang.c:6924
#define HASH_SIZE
Definition: ada-lang.c:272
static struct symbol * standard_lookup(const char *, const struct block *, domain_enum)
Definition: ada-lang.c:4767
void ada_fixup_array_indexes_type(struct type *index_desc_type)
Definition: ada-lang.c:1668
static void cache_symbol(const char *name, domain_enum domain, struct symbol *sym, const struct block *block)
Definition: ada-lang.c:4712
int ada_is_ignored_field(struct type *type, int field_num)
Definition: ada-lang.c:6297
static LONGEST max_of_type(struct type *t)
Definition: ada-lang.c:646
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:11849
static const gdb_byte * cond_offset_host(const gdb_byte *valaddr, long offset)
Definition: ada-lang.c:580
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:5420
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:7015
static std::vector< ada_exc_info > ada_exceptions_list_1(compiled_regex *preg)
Definition: ada-lang.c:13183
static int ada_args_match(struct symbol *, struct value **, int)
Definition: ada-lang.c:3966
static struct value * ada_search_struct_field(const char *, struct value *, int, struct type *)
Definition: ada-lang.c:7152
static bool wild_match(const char *name, const char *patn)
Definition: ada-lang.c:6042
static int is_nondebugging_type(struct type *type)
Definition: ada-lang.c:4940
static LONGEST min_of_type(struct type *t)
Definition: ada-lang.c:656
static void ada_remove_trailing_digits(const char *encoded, int *len)
Definition: ada-lang.c:1182
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:5476
gdb::unique_xmalloc_ptr< char > ada_tag_name(struct value *tag)
Definition: ada-lang.c:6631
static int is_nonfunction(const std::vector< struct block_symbol > &)
Definition: ada-lang.c:4785
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:6758
static bool print_signatures
Definition: ada-lang.c:3494
static struct type * get_base_type(struct type *type)
Definition: ada-lang.c:738
static int ada_is_array_type(struct type *type)
Definition: ada-lang.c:2042
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:10507
static CORE_ADDR ada_exception_name_addr(enum ada_exception_catchpoint_kind ex)
Definition: ada-lang.c:12083
const char * ada_variant_discrim_name(struct type *type0)
Definition: ada-lang.c:6782
static const registry< program_space >::key< ada_pspace_data > ada_pspace_data_handle
Definition: ada-lang.c:380
static struct type * to_fixed_variant_branch_type(struct type *, const gdb_byte *, CORE_ADDR, struct value *)
Definition: ada-lang.c:8296
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:870
void _initialize_ada_language()
Definition: ada-lang.c:13977
static const char * ada_fold_name(gdb::string_view name, bool throw_on_error=false)
Definition: ada-lang.c:1037
static const char ADA_MAIN_PROGRAM_SYMBOL_NAME[]
Definition: ada-lang.c:292
struct value * ada_to_fixed_value(struct value *val)
Definition: ada-lang.c:8874
static int is_suffix(const char *str, const char *suffix)
Definition: ada-lang.c:534
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:3398
static int field_name_match(const char *field_name, const char *target)
Definition: ada-lang.c:473
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:11365
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:13329
static int is_ada95_tag(struct value *tag)
Definition: ada-lang.c:6385
#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 *)
Definition: ada-valprint.c:362
void ada_emit_char(int, struct type *, struct ui_file *, int, int)
Definition: ada-valprint.c:262
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 *)
Definition: ada-valprint.c:995
void ada_printstr(struct ui_file *, struct type *, const gdb_byte *, unsigned int, const char *, int, const struct value_print_options *)
Definition: ada-valprint.c:537
#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:688
const struct lang_varobj_ops ada_varobj_ops
Definition: ada-varobj.c:1009
void * xcalloc(size_t number, size_t size)
Definition: alloc.c:85
void annotate_field(int num)
Definition: annotate.c:173
void annotate_catchpoint(int num)
Definition: annotate.c:83
struct gdbarch * get_current_arch(void)
Definition: arch-utils.c:846
struct gdbarch * target_gdbarch(void)
Definition: arch-utils.c:1453
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
struct symbol * block_iter_match_next(const lookup_name_info &name, struct block_iterator *iterator)
Definition: block.c:651
struct using_direct * block_using(const struct block *block)
Definition: block.c:325
struct gdbarch * block_gdbarch(const struct block *block)
Definition: block.c:60
const struct block * block_for_pc(CORE_ADDR pc)
Definition: block.c:283
const struct block * block_static_block(const struct block *block)
Definition: block.c:361
struct symbol * block_iter_match_first(const struct block *block, const lookup_name_info &name, struct block_iterator *iterator)
Definition: block.c:635
struct symbol * block_linkage_function(const struct block *bl)
Definition: block.c:99
#define ALL_BLOCK_SYMBOLS(block, iter, sym)
Definition: block.h:534
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)
Definition: breakpoint.c:14303
const char * bpdisp_text(enum bpdisp disp)
Definition: breakpoint.c:437
void print_num_locno(const bpstat *bs, struct ui_out *uiout)
Definition: breakpoint.c:4539
void set_breakpoint_condition(struct breakpoint *b, const char *exp, int from_tty, bool force)
Definition: breakpoint.c:1005
struct gdbarch * get_sal_arch(struct symtab_and_line sal)
Definition: breakpoint.c:7468
void install_breakpoint(int internal, std::unique_ptr< breakpoint > &&arg, int update_gll)
Definition: breakpoint.c:7960
void describe_other_breakpoints(struct gdbarch *gdbarch, struct program_space *pspace, CORE_ADDR pc, struct obj_section *section, int thread)
Definition: breakpoint.c:7018
#define CATCH_PERMANENT
Definition: breakpoint.h:1464
@ disp_donttouch
Definition: breakpoint.h:241
@ disp_del
Definition: breakpoint.h:237
@ bp_catchpoint
Definition: breakpoint.h:182
#define CATCH_TEMPORARY
Definition: breakpoint.h:1465
print_stop_action
Definition: breakpoint.h:543
@ PRINT_SRC_AND_LOC
Definition: breakpoint.h:549
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:12192
ada_catchpoint_location(ada_catchpoint *owner)
Definition: ada-lang.c:12185
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:13877
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:13483
bool c_style_arrays_p() const override
Definition: ada-lang.c:13908
void emitchar(int ch, struct type *chtype, struct ui_file *stream, int quoter) const override
Definition: ada-lang.c:13861
const char * struct_too_deep_ellipsis() const override
Definition: ada-lang.c:13903
bool symbol_printing_suppressed(struct symbol *symbol) const override
Definition: ada-lang.c:13515
const char * word_break_characters(void) const override
Definition: ada-lang.c:13651
gdb::unique_xmalloc_ptr< char > demangle_symbol(const char *mangled, int options) const override
Definition: ada-lang.c:13634
bool store_sym_names_in_linkage_form_p() const override
Definition: ada-lang.c:13913
bool is_string_type_p(struct type *type) const override
Definition: ada-lang.c:13896
struct value * read_var_value(struct symbol *var, const struct block *var_block, frame_info_ptr frame) const override
Definition: ada-lang.c:13496
int parser(struct parser_state *ps) const override
Definition: ada-lang.c:13853
symbol_name_matcher_ftype * get_symbol_name_matcher_inner(const lookup_name_info &lookup_name) const override
Definition: ada-lang.c:13925
const char * name() const override
Definition: ada-lang.c:13464
const std::vector< const char * > & filename_extensions() const override
Definition: ada-lang.c:13474
void print_typedef(struct type *type, struct symbol *new_symbol, struct ui_file *stream) const override
Definition: ada-lang.c:13888
void language_arch_info(struct gdbarch *gdbarch, struct language_arch_info *lai) const override
Definition: ada-lang.c:13521
void value_print(struct value *val, struct ui_file *stream, const struct value_print_options *options) const override
Definition: ada-lang.c:13795
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:13804
gdb::unique_xmalloc_ptr< char > watch_location_expression(struct type *type, CORE_ADDR addr) const override
Definition: ada-lang.c:13786
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:13578
void printchar(int ch, struct type *chtype, struct ui_file *stream) const override
Definition: ada-lang.c:13869
const struct lang_varobj_ops * varobj_ops() const override
Definition: ada-lang.c:13918
bool sniff_from_mangled_name(const char *mangled, gdb::unique_xmalloc_ptr< char > *out) const override
Definition: ada-lang.c:13595
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:13658
const char * natural_name() const override
Definition: ada-lang.c:13469
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:13642
struct block_symbol lookup_symbol_nonlocal(const char *name, const struct block *block, const domain_enum domain) const override
Definition: ada-lang.c:13813
bool verbatim_p() const
Definition: symtab.h:123
bool matches(const char *symbol_search_name, symbol_name_match_type match_type, completion_match_result *comp_match_res) const
Definition: ada-lang.c:6182
const std::string & lookup_name() const
Definition: symtab.h:109
bool standard_p() const
Definition: symtab.h:119
bool wild_match_p() const
Definition: symtab.h:114
ada_lookup_name_info(const lookup_name_info &lookup_name)
Definition: ada-lang.c:13338
std::string m_encoded_name
Definition: symtab.h:143
breakpoint * owner
Definition: breakpoint.h:350
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:593
bool uses_objfile(struct objfile *objfile) override
Definition: ada-lang.c:9508
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition: ada-lang.c:9525
void dump(ui_file *stream, int depth) override
Definition: ada-lang.c:9517
value * assign_aggregate(struct value *container, struct value *lhs, struct expression *exp)
Definition: ada-lang.c:9537
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:9767
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:11013
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10792
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10606
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:10619
void dump(ui_file *stream, int depth) override
Definition: ada-lang.c:9713
std::vector< ada_association_up > m_assocs
Definition: ada-exp.h:710
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition: ada-lang.c:9726
bool uses_objfile(struct objfile *objfile) override
Definition: ada-lang.c:9702
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10727
bool uses_objfile(struct objfile *objfile) override
Definition: ada-lang.c:9613
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:9627
void dump(ui_file *stream, int depth) override
Definition: ada-lang.c:9619
bool resolve(struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition: ada-lang.c:11290
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:11148
void dump(ui_file *stream, int depth) override
Definition: ada-lang.c:9655
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:9662
bool uses_objfile(struct objfile *objfile) override
Definition: ada-lang.c:9649
bool uses_objfile(struct objfile *objfile) override
Definition: ada-lang.c:9736
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition: ada-lang.c:9753
void dump(ui_file *stream, int depth) override
Definition: ada-lang.c:9742
void assign(struct value *container, struct value *lhs, struct expression *exp, std::vector< LONGEST > &indices, LONGEST low, LONGEST high) override
Definition: ada-lang.c:9596
bool uses_objfile(struct objfile *objfile) override
Definition: ada-lang.c:9578
void dump(ui_file *stream, int depth) override
Definition: ada-lang.c:9584
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10772
const char * get_name() const
Definition: ada-exp.h:144
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10663
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:11106
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10781
bool resolve(struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition: ada-lang.c:11327
enum exp_opcode opcode() const override
Definition: ada-exp.h:352
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10832
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:11022
value * evaluate_for_cast(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10853
bool resolve(struct expression *exp, bool deprocedure_p, bool parse_completion, innermost_block_tracker *tracker, struct type *context_type) override
Definition: ada-lang.c:10988
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10899
const block * get_block() const
Definition: ada-exp.h:372
value * evaluate_for_cast(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10877
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: ada-lang.c:10640
enum exp_opcode opcode() const override
Definition: ada-exp.h:131
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: expop.h:1155
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: expop.h:677
symbol * get_symbol() const
Definition: expop.h:656
value * evaluate(struct type *expect_type, struct expression *exp, enum noside noside) override
Definition: eval.c:578
void update(const struct block *b, innermost_block_tracker_types t)
Definition: parse.c:84
static const lookup_name_info & match_any()
Definition: symtab.c:1864
const ada_lookup_name_info & ada() const
Definition: symtab.h:314
symbol_name_match_type match_type() const
Definition: symtab.h:238
gdb::string_view name() const
Definition: symtab.h:240
bool completion_mode() const
Definition: symtab.h:239
void * get(unsigned key)
Definition: registry.h:211
std::string release()
Definition: ui-file.h:200
Definition: ui-out.h:160
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:125
void error_no_arg(const char *why)
Definition: cli-cmds.c:204
struct cmd_list_element * setlist
Definition: cli-cmds.c:117
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:618
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:739
struct cmd_list_element * add_info(const char *name, cmd_simple_func_ftype *fun, const char *doc)
Definition: cli-decode.c:1294
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:346
void read_memory(CORE_ADDR memaddr, gdb_byte *myaddr, ssize_t len)
Definition: corefile.c:237
void write_memory_with_notification(CORE_ADDR memaddr, const bfd_byte *myaddr, ssize_t len)
Definition: corefile.c:359
static struct symbol * new_symbol(struct ctf_context *cp, struct type *type, ctf_id_t tid)
Definition: ctfread.c:468
static void store_unsigned_integer(gdb_byte *addr, int len, enum bfd_endian byte_order, ULONGEST val)
Definition: defs.h:561
EXTERN_C char * re_comp(const char *)
int longest_to_int(LONGEST)
Definition: valprint.c:1353
@ STATIC_BLOCK
Definition: defs.h:632
@ GLOBAL_BLOCK
Definition: defs.h:631
#define INT_MAX
Definition: defs.h:457
language
Definition: defs.h:211
@ language_ada
Definition: defs.h:226
@ language_unknown
Definition: defs.h:212
@ language_cplus
Definition: defs.h:216
@ language_auto
Definition: defs.h:213
@ lval_memory
Definition: defs.h:364
@ not_lval
Definition: defs.h:362
@ lval_internalvar
Definition: defs.h:368
const char * command_line_input(std::string &cmd_line_buffer, const char *, const char *)
Definition: top.c:1339
static ULONGEST extract_unsigned_integer(gdb::array_view< const gdb_byte > buf, enum bfd_endian byte_order)
Definition: defs.h:526
#define QUIT
Definition: defs.h:186
value * evaluate_var_value(enum noside noside, const block *blk, symbol *var)
Definition: eval.c:544
value * evaluate_var_msym_value(enum noside noside, struct objfile *objfile, minimal_symbol *msymbol)
Definition: eval.c:593
void binop_promote(const struct language_defn *language, struct gdbarch *gdbarch, struct value **arg1, struct value **arg2)
Definition: eval.c:262
struct value * evaluate_expression(struct expression *exp, struct type *expect_type)
Definition: eval.c:113
void unop_promote(const struct language_defn *language, struct gdbarch *gdbarch, struct value **arg1)
Definition: eval.c:229
CORE_ADDR parse_and_eval_address(const char *exp)
Definition: eval.c:52
struct value * parse_and_eval(const char *exp)
Definition: eval.c:70
void exception_fprintf(struct ui_file *file, const struct gdb_exception &e, const char *prefix,...)
Definition: exceptions.c:115
std::unique_ptr< expression > expression_up
Definition: expression.h:229
expression_up parse_exp_1(const char **, CORE_ADDR pc, const struct block *, int, innermost_block_tracker *=nullptr)
Definition: parse.c:424
exp_opcode
Definition: expression.h:44
noside
Definition: expression.h:55
@ EVAL_NORMAL
Definition: expression.h:56
@ EVAL_AVOID_SIDE_EFFECTS
Definition: expression.h:57
void select_frame(frame_info_ptr fi)
Definition: frame.c:1852
bool has_stack_frames()
Definition: frame.c:1784
frame_info_ptr get_selected_frame(const char *message)
Definition: frame.c:1813
frame_info_ptr get_current_frame(void)
Definition: frame.c:1615
frame_info_ptr get_prev_frame(frame_info_ptr this_frame)
Definition: frame.c:2494
symtab_and_line find_frame_sal(frame_info_ptr frame)
Definition: frame.c:2701
const struct block * get_selected_block(CORE_ADDR *addr_in_block)
Definition: stack.c:2602
static void ATTRIBUTE_PRINTF(1, 0)
Definition: gdb_bfd.c:1150
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:4972
enum bfd_endian gdbarch_byte_order(struct gdbarch *gdbarch)
Definition: gdbarch.c:1370
int gdbarch_long_long_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1457
int gdbarch_short_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1406
int gdbarch_int_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1423
int gdbarch_float_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1540
const struct floatformat ** gdbarch_double_format(struct gdbarch *gdbarch)
Definition: gdbarch.c:1590
void gdbarch_address_to_pointer(struct gdbarch *gdbarch, struct type *type, gdb_byte *buf, CORE_ADDR addr)
Definition: gdbarch.c:2531
int gdbarch_long_double_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1606
const struct floatformat ** gdbarch_float_format(struct gdbarch *gdbarch)
Definition: gdbarch.c:1557
const struct floatformat ** gdbarch_long_double_format(struct gdbarch *gdbarch)
Definition: gdbarch.c:1623
int gdbarch_long_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1440
int gdbarch_double_bit(struct gdbarch *gdbarch)
Definition: gdbarch.c:1573
struct type * resolve_dynamic_type(struct type *type, gdb::array_view< const gdb_byte > valaddr, CORE_ADDR addr)
Definition: gdbtypes.c:2906
enum bfd_endian type_byte_order(const struct type *type)
Definition: gdbtypes.c:4018
struct type * lookup_pointer_type(struct type *type)
Definition: gdbtypes.c:402
int is_integral_type(struct type *t)
Definition: gdbtypes.c:3772
struct type * lookup_struct_elt_type(struct type *type, const char *name, int noerr)
Definition: gdbtypes.c:1897
struct type * create_array_type_with_stride(struct type *result_type, struct type *element_type, struct type *range_type, struct dynamic_prop *byte_stride_prop, unsigned int bit_stride)
Definition: gdbtypes.c:1368
int is_scalar_type(struct type *type)
Definition: gdbtypes.c:3799
int is_dynamic_type(struct type *type)
Definition: gdbtypes.c:2187
struct type * lookup_array_range_type(struct type *element_type, LONGEST low_bound, LONGEST high_bound)
Definition: gdbtypes.c:1431
bool get_discrete_bounds(struct type *type, LONGEST *lowp, LONGEST *highp)
Definition: gdbtypes.c:1201
struct type * arch_type(struct gdbarch *gdbarch, enum type_code code, int bit, const char *name)
Definition: gdbtypes.c:5815
struct type * create_array_type(struct type *result_type, struct type *element_type, struct type *range_type)
Definition: gdbtypes.c:1422
struct type * arch_float_type(struct gdbarch *gdbarch, int bit, const char *name, const struct floatformat **floatformats)
Definition: gdbtypes.c:5888
struct type * arch_character_type(struct gdbarch *gdbarch, int bit, int unsigned_p, const char *name)
Definition: gdbtypes.c:5853
gdb::optional< LONGEST > discrete_position(struct type *type, LONGEST val)
Definition: gdbtypes.c:1256
bool get_array_bounds(struct type *type, LONGEST *low_bound, LONGEST *high_bound)
Definition: gdbtypes.c:1220
struct type * alloc_type_copy(const struct type *type)
Definition: gdbtypes.c:234
struct type * create_static_range_type(struct type *result_type, struct type *index_type, LONGEST low_bound, LONGEST high_bound)
Definition: gdbtypes.c:1025
struct type * arch_integer_type(struct gdbarch *gdbarch, int bit, int unsigned_p, const char *name)
Definition: gdbtypes.c:5836
struct type * copy_type(const struct type *type)
Definition: gdbtypes.c:5790
struct type * check_typedef(struct type *type)
Definition: gdbtypes.c:3010
#define TYPE_ZALLOC(t, size)
Definition: gdbtypes.h:2415
#define TYPE_DESCRIPTIVE_TYPE(thistype)
Definition: gdbtypes.h:2103
@ PROP_CONST
Definition: gdbtypes.h:293
@ PROP_UNDEFINED
Definition: gdbtypes.h:292
#define INIT_NONE_SPECIFIC(type)
Definition: gdbtypes.h:1991
#define TYPE_MAIN_TYPE(thistype)
Definition: gdbtypes.h:2027
#define ADA_TYPE_P(type)
Definition: gdbtypes.h:2009
type_code
Definition: gdbtypes.h:99
@ TYPE_CODE_UNDEF
Definition: gdbtypes.h:100
#define TYPE_FIELD_BITSIZE(thistype, n)
Definition: gdbtypes.h:2123
#define TYPE_ALLOC(t, size)
Definition: gdbtypes.h:2406
@ DYN_PROP_BYTE_STRIDE
Definition: gdbtypes.h:462
#define HAVE_GNAT_AUX_INFO(type)
Definition: gdbtypes.h:2005
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:1862
size_t size
Definition: go32-nat.c:241
@ L
Definition: ia64-tdep.c:85
uint32_t offset_type
Definition: index-common.h:30
void error_call_unknown_return_type(const char *func_name)
Definition: infcall.c:394
struct value * call_function_by_hand(struct value *function, type *default_return_type, gdb::array_view< value * > args)
Definition: infcall.c:781
ptid_t inferior_ptid
Definition: infcmd.c:91
struct inferior * current_inferior(void)
Definition: inferior.c:54
const struct language_defn * language_def(enum language lang)
Definition: language.c:442
struct type * language_lookup_primitive_type(const struct language_defn *la, struct gdbarch *gdbarch, const char *name)
Definition: language.c:1053
struct type * language_bool_type(const struct language_defn *la, struct gdbarch *gdbarch)
Definition: language.c:935
struct type * language_string_char_type(const struct language_defn *la, struct gdbarch *gdbarch)
Definition: language.c:925
struct symbol * language_lookup_primitive_type_as_symbol(const struct language_defn *la, struct gdbarch *gdbarch, const char *name)
Definition: language.c:1073
case_sensitivity
Definition: language.h:72
@ case_sensitive_on
Definition: language.h:73
@ case_sensitive_off
Definition: language.h:73
location_spec_up string_to_location_spec(const char **stringp, const struct language_defn *language, symbol_name_match_type match_type)
Definition: location.c:825
#define R(name, type, sim_num)
Definition: m32c-tdep.c:729
static struct type * new_type(char *)
Definition: mdebugread.c:4748
const char * async_reason_lookup(enum async_reply_reason reason)
Definition: mi-common.c:49
@ 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
unsigned int msymbol_hash(const char *string)
Definition: minsyms.c:184
Definition: ada-exp.h:80
static LONGEST convert_char_literal(struct type *type, LONGEST val)
Definition: ada-lang.c:10570
static void assign_component(struct value *container, struct value *lhs, LONGEST index, struct expression *exp, operation_up &arg)
Definition: ada-lang.c:9476
std::unique_ptr< operation > operation_up
Definition: expression.h:81
bool check_objfile(const std::unique_ptr< ada_component > &comp, struct objfile *objfile)
Definition: ada-lang.c:9464
observable< struct inferior * > inferior_exit
observable< struct objfile * > free_objfile
observable< struct objfile * > new_objfile
def info(c)
Definition: gdbarch.py:184
Definition: aarch64.h:50
const char * objfile_name(const struct objfile *objfile)
Definition: objfiles.c:1308
struct program_space * current_program_space
Definition: progspace.c:39
static gdbpy_ref field_name(struct type *type, int field)
Definition: py-type.c:234
@ SEARCH_GLOBAL_BLOCK
Definition: quick-symbol.h:27
@ SEARCH_STATIC_BLOCK
Definition: quick-symbol.h:28
void(* func)(remote_target *remote, char *)
#define resolve(X)
const char * symtab_to_fullname(struct symtab *s)
Definition: source.c:1252
const char * symtab_to_filename_for_display(struct symtab *symtab)
Definition: source.c:1287
gdb::unique_xmalloc_ptr< char > find_frame_funname(frame_info_ptr frame, enum language *funlang, struct symbol **funcp)
Definition: stack.c:1278
Definition: 1.cc:26
enum ada_exception_catchpoint_kind m_kind
Definition: ada-lang.c:12176
void print_recreate(struct ui_file *fp) const override
Definition: ada-lang.c:12542
std::string excep_string
Definition: ada-lang.c:12173
struct bp_location * allocate_location() override
Definition: ada-lang.c:12250
void print_mention() const override
Definition: ada-lang.c:12490
void check_status(struct bpstat *bs) override
Definition: ada-lang.c:12336
void re_set() override
Definition: ada-lang.c:12259
ada_catchpoint(struct gdbarch *gdbarch_, enum ada_exception_catchpoint_kind kind, struct symtab_and_line sal, const char *addr_string_, bool tempflag, bool enabled, bool from_tty)
Definition: ada-lang.c:12122
enum print_stop_action print_it(const bpstat *bs) const override
Definition: ada-lang.c:12345
bool print_one(bp_location **) const override
Definition: ada-lang.c:12433
CORE_ADDR addr
Definition: ada-lang.h:361
bool operator<(const ada_exc_info &) const
Definition: ada-lang.c:12977
const char * name
Definition: ada-lang.h:358
bool operator==(const ada_exc_info &) const
Definition: ada-lang.c:12990
const struct exception_support_info * exception_info
Definition: ada-lang.c:333
struct type * tsd_type
Definition: ada-lang.c:328
const char * decoded
Definition: ada-lang.h:73
const char * encoded
Definition: ada-lang.h:72
std::unique_ptr< ada_symbol_cache > sym_cache
Definition: ada-lang.c:375
struct cache_entry * root[HASH_SIZE]
Definition: ada-lang.c:280
struct auto_obstack cache_space
Definition: ada-lang.c:277
const struct block * block
Definition: symtab.h:1498
struct symbol * symbol
Definition: symtab.h:1494
Definition: block.h:109
const block * superblock() const
Definition: block.h:135
symbol * function() const
Definition: block.h:127
struct block * block(size_t i)
Definition: block.h:271
struct block * static_block()
Definition: block.h:302
struct block * global_block()
Definition: block.h:294
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
Definition: breakpoint.h:1315
char stop
Definition: breakpoint.h:1333
location_spec_up locspec
Definition: breakpoint.h:770
bp_location_range locations() const
Definition: breakpoint.c:11573
void print_recreate_thread(struct ui_file *fp) const
Definition: breakpoint.c:14099
struct gdbarch * gdbarch
Definition: breakpoint.h:781
bp_location * loc
Definition: breakpoint.h:742
program_space * pspace
Definition: breakpoint.h:767
bpdisp disposition
Definition: breakpoint.h:737
struct type * builtin_bool
Definition: gdbtypes.h:2263
struct type * builtin_int
Definition: gdbtypes.h:2248
struct type * builtin_void
Definition: gdbtypes.h:2245
Definition: ada-lang.c:248
struct symbol * sym
Definition: ada-lang.c:255
domain_enum domain
Definition: ada-lang.c:252
const char * name
Definition: ada-lang.c:250
struct cache_entry * next
Definition: ada-lang.c:260
const struct block * block
Definition: ada-lang.c:258
void * context() const
Definition: cli-decode.h:109
bp_location * add_location(const symtab_and_line &sal)
Definition: breakpoint.c:8243
void re_set() override
Definition: breakpoint.c:11636
void set_match(const char *m, const char *m_for_lcd=NULL)
Definition: completer.h:216
completion_match match
Definition: completer.h:209
struct blockvector * blockvector()
Definition: symtab.h:1773
struct objfile * objfile() const
Definition: symtab.h:1714
LONGEST const_val() const
Definition: gdbtypes.h:347
dynamic_prop_kind kind() const
Definition: gdbtypes.h:337
ada_unhandled_exception_name_addr_ftype * unhandled_exception_name_addr
Definition: ada-lang.c:11656
const char * catch_handlers_sym
Definition: ada-lang.c:11650
const char * catch_assert_sym
Definition: ada-lang.c:11646
const char * catch_exception_unhandled_sym
Definition: ada-lang.c:11642
const char * catch_exception_sym
Definition: ada-lang.c:11638
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:10550
const struct language_defn * language_defn
Definition: expression.h:223
struct gdbarch * gdbarch
Definition: expression.h:225
void set_type(struct type *type)
Definition: gdbtypes.h:564
void set_loc_bitpos(LONGEST bitpos)
Definition: gdbtypes.h:592
LONGEST loc_bitpos() const
Definition: gdbtypes.h:586
LONGEST loc_enumval() const
Definition: gdbtypes.h:598
void set_name(const char *name)
Definition: gdbtypes.h:574
const char * name() const
Definition: gdbtypes.h:569
struct type * type() const
Definition: gdbtypes.h:559
struct obstack * obstack
Definition: symtab.h:568
const char * natural_name() const
Definition: symtab.c:1027
const char * demangled_name
Definition: symtab.h:572
union general_symbol_info::@178 language_specific
const char * print_name() const
Definition: symtab.h:474
enum language language() const
Definition: symtab.h:501
unsigned int ada_mangled
Definition: symtab.h:585
const struct block * block
Definition: symtab.h:544
const char * linkage_name() const
Definition: symtab.h:459
Definition: gnu-nat.c:154
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:552
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:742
struct gdbarch * arch() const
Definition: objfiles.h:482
compunit_symtab_range compunits()
Definition: objfiles.h:426
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:439
objfiles_range objfiles()
Definition: progspace.h:209
struct dynamic_prop high
Definition: gdbtypes.h:696
struct dynamic_prop low
Definition: gdbtypes.h:692
LONGEST bias
Definition: gdbtypes.h:708
address_class aclass() const
Definition: symtab.h:1235
struct type * type() const
Definition: symtab.h:1285
domain_enum domain() const
Definition: symtab.h:1240
LONGEST value_longest() const
Definition: symtab.h:1305
bool is_objfile_owned() const
Definition: symtab.h:1250
bool is_argument() const
Definition: symtab.h:1260
CORE_ADDR value_address() const
Definition: symtab.h:1315
symbol()
Definition: symtab.h:1198
struct symtab * symtab
Definition: symtab.h:1414
bool is_artificial() const
Definition: symtab.h:1369
unsigned short line() const
Definition: symtab.h:1295
struct obj_section * section
Definition: symtab.h:2265
struct symtab * symtab
Definition: symtab.h:2263
CORE_ADDR pc
Definition: symtab.h:2272
struct program_space * pspace
Definition: symtab.h:2261
struct compunit_symtab * compunit() const
Definition: symtab.h:1603
const char * filename
Definition: symtab.h:1651
Definition: gdbtypes.h:922
struct type * target_type() const
Definition: gdbtypes.h:1000
dynamic_prop * dyn_prop(dynamic_prop_node_kind kind) const
Definition: gdbtypes.c:2919
type_code code() const
Definition: gdbtypes.h:927
void set_code(type_code code)
Definition: gdbtypes.h:933
ULONGEST length() const
Definition: gdbtypes.h:954
bool is_fixed_instance() const
Definition: gdbtypes.h:1199
struct field & field(int idx) const
Definition: gdbtypes.h:983
void set_target_type(struct type *target_type)
Definition: gdbtypes.h:1005
bool is_unsigned() const
Definition: gdbtypes.h:1063
void set_is_stub(bool is_stub)
Definition: gdbtypes.h:1096
void set_num_fields(int num_fields)
Definition: gdbtypes.h:971
int num_fields() const
Definition: gdbtypes.h:965
bool is_stub() const
Definition: gdbtypes.h:1091
void set_name(const char *name)
Definition: gdbtypes.h:945
gdbarch * arch() const
Definition: gdbtypes.c:245
void set_length(ULONGEST length)
Definition: gdbtypes.h:959
struct field * fields() const
Definition: gdbtypes.h:977
range_bounds * bounds() const
Definition: gdbtypes.h:1028
void set_is_fixed_instance(bool is_fixed_instance)
Definition: gdbtypes.h:1204
const char * name() const
Definition: gdbtypes.h:939
type * index_type() const
Definition: gdbtypes.h:995
unsigned short bit_offset() const
Definition: gdbtypes.h:1387
void set_fields(struct field *fields)
Definition: gdbtypes.h:990
unsigned short bit_size() const
Definition: gdbtypes.h:1379
const ui_file_style * ptr() const
Definition: ui-style.h:233
struct using_direct * next
Definition: namespace.h:97
const char * import_src
Definition: namespace.h:91
const char * import_dest
Definition: namespace.h:92
const char * declaration
Definition: namespace.h:95
const char * alias
Definition: namespace.h:94
Definition: ada-lang.c:222
int upper_delta
Definition: ada-lang.c:227
int lower_delta
Definition: ada-lang.c:230
uint32_t start
Definition: ada-lang.c:224
uint32_t end
Definition: ada-lang.c:224
bool operator<(uint32_t val) const
Definition: ada-lang.c:232
Definition: value.c:181
struct type * type
Definition: value.c:304
LONGEST offset
Definition: value.c:281
CORE_ADDR address
Definition: value.c:246
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:3727
const char multiple_symbols_all[]
Definition: symtab.c:280
const char multiple_symbols_cancel[]
Definition: symtab.c:281
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:2814
symtab_and_line find_function_start_sal(CORE_ADDR func_addr, obj_section *section, bool funfirstline)
Definition: symtab.c:3640
struct symbol * fixup_symbol_section(struct symbol *sym, struct objfile *objfile)
Definition: symtab.c:1788
const char * multiple_symbols_select_mode(void)
Definition: symtab.c:298
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:5397
bool symbol_matches_domain(enum language symbol_language, domain_enum symbol_domain, domain_enum domain)
Definition: symtab.c:2649
@ VARIABLES_DOMAIN
Definition: symtab.h:919
@ ALL_DOMAIN
Definition: symtab.h:931
symbol_name_match_type
Definition: symtab.h:62
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:398
@ LOC_STATIC
Definition: symtab.h:950
@ LOC_BLOCK
Definition: symtab.h:999
@ LOC_UNRESOLVED
Definition: symtab.h:1028
@ LOC_LOCAL
Definition: symtab.h:984
@ LOC_CONST
Definition: symtab.h:946
@ LOC_UNDEF
Definition: symtab.h:942
@ LOC_OPTIMIZED_OUT
Definition: symtab.h:1033
@ LOC_TYPEDEF
Definition: symtab.h:989
@ LOC_COMPUTED
Definition: symtab.h:1037
@ mst_solib_trampoline
Definition: symtab.h:688
domain_enum
Definition: symtab.h:871
@ VAR_DOMAIN
Definition: symtab.h:881
@ STRUCT_DOMAIN
Definition: symtab.h:887
@ UNDEF_DOMAIN
Definition: symtab.h:876
static bool completion_skip_symbol(complete_symbol_mode mode, Symbol *sym)
Definition: symtab.h:2366
complete_symbol_mode
Definition: symtab.h:2320
symtab_and_line find_function_start_sal(symbol *sym, bool funfirstline)
Definition: symtab.c:3657
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
const struct type_print_options type_print_raw_options
Definition: typeprint.c:41
std::string type_to_string(struct type *type)
Definition: typeprint.c:402
void type_print(struct type *type, const char *varstring, struct ui_file *stream, int show)
Definition: typeprint.c:391
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:3114
int strcmp_iw_ordered(const char *string1, const char *string2)
Definition: utils.c:3025
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:3536
void gdb_printf(struct ui_file *stream, const char *format,...)
Definition: utils.c:1865
void vwarning(const char *string, va_list args)
Definition: utils.c:138
#define gdb_stderr
Definition: utils.h:193
#define gdb_stdout
Definition: utils.h:188
struct value * value_subscript(struct value *array, LONGEST index)
Definition: valarith.c:146
struct value * value_neg(struct value *arg1)
Definition: valarith.c:1891
int value_equal(struct value *arg1, struct value *arg2)
Definition: valarith.c:1728
int value_less(struct value *arg1, struct value *arg2)
Definition: valarith.c:1818
struct value * value_concat(struct value *arg1, struct value *arg2)
Definition: valarith.c:657
struct value * value_ptradd(struct value *arg1, LONGEST arg2)
Definition: valarith.c:84
struct value * value_binop(struct value *arg1, struct value *arg2, enum exp_opcode op)
Definition: valarith.c:1633
struct value * value_cast_pointers(struct type *type, struct value *arg2, int subclass_check)
Definition: valops.c:296
struct value * value_at(struct type *type, CORE_ADDR addr)
Definition: valops.c:1017
struct value * value_slice(struct value *array, int lowbound, int length)
Definition: valops.c:4031
struct value * value_allocate_space_in_inferior(int len)
Definition: valops.c:175
struct value * value_at_lazy(struct type *type, CORE_ADDR addr)
Definition: valops.c:1028
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:2335
struct value * value_of_variable(struct symbol *var, const struct block *b)
Definition: valops.c:1378
struct value * value_addr(struct value *arg1)
Definition: valops.c:1543
struct value * value_cast(struct type *type, struct value *arg2)
Definition: valops.c:408
struct value * value_assign(struct value *toval, struct value *fromval)
Definition: valops.c:1077
struct value * value_ind(struct value *arg1)
Definition: valops.c:1623
struct value * value_ref(struct value *arg1, enum type_code refcode)
Definition: valops.c:1602
void get_user_print_options(struct value_print_options *opts)
Definition: valprint.c:128
struct value * call_internal_function(struct gdbarch *gdbarch, const struct language_defn *language, struct value *func, int argc, struct value **argv)
Definition: value.c:2551
struct type * value_type(const struct value *value)
Definition: value.c:1109
struct value * value_zero(struct type *type, enum lval_type lv)
Definition: value.c:3613
struct value * allocate_value_lazy(struct type *type)
Definition: value.c:948
gdb::array_view< const gdb_byte > value_contents_all(struct value *value)
Definition: value.c:1284
LONGEST value_bitsize(const struct value *value)
Definition: value.c:1142
int value_lazy(const struct value *value)
Definition: value.c:1440
void clear_internalvar(struct internalvar *var)
Definition: value.c:2498
void value_contents_copy(struct value *dst, LONGEST dst_offset, struct value *src, LONGEST src_offset, LONGEST length)
Definition: value.c:1430
struct value * allocate_value(struct type *type)
Definition: value.c:1053
CORE_ADDR value_as_address(struct value *val)
Definition: value.c:2804
void set_value_address(struct value *value, CORE_ADDR addr)
Definition: value.c:1631
void set_value_component_location(struct value *component, const struct value *whole)
Definition: value.c:1858
void value_fetch_lazy(struct value *val)
Definition: value.c:4162
struct value * value_primitive_field(struct value *arg1, LONGEST offset, int fieldno, struct type *arg_type)
Definition: value.c:3105
void set_value_offset(struct value *value, LONGEST offset)
Definition: value.c:1125
struct value * allocate_optimized_out_value(struct type *type)
Definition: value.c:1097
struct value * value_from_contents_and_address_unresolved(struct type *type, const gdb_byte *valaddr, CORE_ADDR address)
Definition: value.c:3682
void set_value_parent(struct value *value, struct value *parent)
Definition: value.c:1161
CORE_ADDR value_address(const struct value *value)
Definition: value.c:1607
void set_value_bitsize(struct value *value, LONGEST bit)
Definition: value.c:1147
struct value * value_from_longest(struct type *type, LONGEST num)
Definition: value.c:3625
gdb::array_view< gdb_byte > value_contents_raw(struct value *value)
Definition: value.c:1167
struct value * coerce_ref(struct value *arg)
Definition: value.c:3902
struct value * value_from_contents(struct type *type, const gdb_byte *contents)
Definition: value.c:3730
void set_internalvar(struct internalvar *var, struct value *val)
Definition: value.c:2404
gdb::array_view< const gdb_byte > value_contents(struct value *value)
Definition: value.c:1464
gdb::array_view< gdb_byte > value_contents_writeable(struct value *value)
Definition: value.c:1473
struct internalvar * lookup_internalvar(const char *name)
Definition: value.c:2235
LONGEST value_as_long(struct value *val)
Definition: value.c:2791
void modify_field(struct type *type, gdb_byte *addr, LONGEST fieldval, LONGEST bitpos, LONGEST bitsize)
Definition: value.c:3466
void set_value_bitpos(struct value *value, LONGEST bit)
Definition: value.c:1136
struct value * value_copy(const value *arg)
Definition: value.c:1760
int value_optimized_out(struct value *value)
Definition: value.c:1481
gdb::array_view< const gdb_byte > value_contents_for_printing(struct value *value)
Definition: value.c:1265
struct type * value_enclosing_type(const struct value *value)
Definition: value.c:1189
int deprecated_value_modifiable(const struct value *value)
Definition: value.c:1658
void deprecated_set_value_type(struct value *value, struct type *type)
Definition: value.c:1114
struct value * value_from_contents_and_address(struct type *type, const gdb_byte *valaddr, CORE_ADDR address)
Definition: value.c:3703
LONGEST value_bitpos(const struct value *value)
Definition: value.c:1131
#define VALUE_LVAL(val)
Definition: value.h:438
static bool value_true(struct value *val)
Definition: value.h:1055