binutils-gdb/gdb/ada-typeprint.c

879 lines
24 KiB
C
Raw Normal View History

2002-06-04 17:28:49 +02:00
/* Support for printing Ada types for GDB, the GNU debugger.
2007-01-09 18:59:20 +01:00
Copyright (C) 1986, 1988, 1989, 1991, 1997, 1998, 1999, 2000, 2001, 2002,
2003, 2004, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
2002-06-04 17:28:49 +02:00
This file is part of GDB.
2002-06-04 17:28:49 +02:00
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
2002-06-04 17:28:49 +02:00
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
2002-06-04 17:28:49 +02:00
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
2002-06-04 17:28:49 +02:00
#include "defs.h"
#include "gdb_obstack.h"
2002-06-04 17:28:49 +02:00
#include "bfd.h" /* Binary File Description */
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "target.h"
#include "command.h"
#include "gdbcmd.h"
#include "language.h"
#include "demangle.h"
#include "c-lang.h"
#include "typeprint.h"
#include "ada-lang.h"
#include <ctype.h>
#include "gdb_string.h"
2002-06-04 17:28:49 +02:00
#include <errno.h>
static int print_selected_record_field_types (struct type *, struct type *,
int, int,
struct ui_file *, int, int);
static int print_record_field_types (struct type *, struct type *,
2002-06-04 17:28:49 +02:00
struct ui_file *, int, int);
static void print_array_type (struct type *, struct ui_file *, int, int);
2002-06-04 17:28:49 +02:00
static int print_choices (struct type *, int, struct ui_file *,
struct type *);
2002-06-04 17:28:49 +02:00
static void print_range (struct type *, struct ui_file *);
2002-06-04 17:28:49 +02:00
static void print_range_bound (struct type *, char *, int *,
struct ui_file *);
2002-06-04 17:28:49 +02:00
static void
print_dynamic_range_bound (struct type *, const char *, int,
const char *, struct ui_file *);
2002-06-04 17:28:49 +02:00
static void print_range_type (struct type *, struct ui_file *);
2002-06-04 17:28:49 +02:00
static char *name_buffer;
2002-06-04 17:28:49 +02:00
static int name_buffer_len;
/* The (decoded) Ada name of TYPE. This value persists until the
next call. */
2002-06-04 17:28:49 +02:00
static char *
decoded_type_name (struct type *type)
2002-06-04 17:28:49 +02:00
{
if (ada_type_name (type) == NULL)
return NULL;
else
2002-06-04 17:28:49 +02:00
{
char *raw_name = ada_type_name (type);
char *s, *q;
2002-06-04 17:28:49 +02:00
if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
{
name_buffer_len = 16 + 2 * strlen (raw_name);
name_buffer = xrealloc (name_buffer, name_buffer_len);
}
strcpy (name_buffer, raw_name);
s = (char *) strstr (name_buffer, "___");
2002-06-04 17:28:49 +02:00
if (s != NULL)
*s = '\0';
s = name_buffer + strlen (name_buffer) - 1;
while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
s -= 1;
if (s == name_buffer)
return name_buffer;
if (!islower (s[1]))
2002-06-04 17:28:49 +02:00
return NULL;
for (s = q = name_buffer; *s != '\0'; q += 1)
{
if (s[0] == '_' && s[1] == '_')
{
*q = '.';
s += 2;
2002-06-04 17:28:49 +02:00
}
else
{
*q = *s;
s += 1;
2002-06-04 17:28:49 +02:00
}
}
*q = '\0';
return name_buffer;
}
}
* dwarf2read.c (struct attribute): Increase sizes of unsnd and snd fields to allow larger integer sizes. (read_subrange_type): Increase size of bound values. Add logic to determine signedness based on base-type size, signedness. (read_attribute_value): Change format for bad byte size in message. (read_8_bytes): Increase size of result type. (dump_die_shallow): Change format for value. (dwarf2_get_attr_constant_value): Increase size of return type. Correct comment. * gdbtypes.c (create_range_type): Change API to increase size of bounds. struct field -> union field. Always take signedness from base type. (check_typedef): Use new API for TYPE_LOW_BOUND, TYPE_HIGH_BOUND. (recursive_dump_type, copy_type_recursive): Adjust to new representation of range types. * gdbtypes.h (fields_or_bounds): New union containing struct field and new struct range_bounds, used for range types. (TYPE_RANGE_DATA): New macro to access range_bounds member. (TYPE_LOW_BOUND, TYPE_HIGH_BOUND): Represent with new TYPE_RANGE_DATA. (TYPE_LOW_BOUND_UNDEFINED, TYPE_HIGH_BOUND_UNDEFINED): New macros, taking over the job of TYPE_FIELD_ARTIFICIAL for range bounds. (SET_TYPE_LOW_BOUND, SET_TYPE_HIGH_BOUND, SET_TYPE_LOW_BOUND_DEFINED) (SET_TYPE_HIGH_BOUND_DEFINED): New macros. (TYPE_FIELDS, TYPE_BASECLASS, TYPE_BASECLASS_NAME, TYPE_FIELD) (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED) (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED, TYPE_ARRAY_UPPER_BOUND_VALUE) (TYPE_ARRAY_LOWER_BOUND_VALUE): Adjust to new representation. (create_range_type): Adjust API. * ada-lang.c (ada_modulus): Use new extended bound values. (discrete_type_low_bound): Rename to... (ada_discrete_type_low_bound): ... and make external. (discrete_type_high_bound): Rename to... (ada_discrete_type_high_bound): ... and make external. (ada_value_slice_from_ptr, ada_array_bound_from_type) (ada_evaluate_subexp, to_fixed_range_type): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. * ada-typeprint.c (print_range): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. Don't look at field count, which is no longer meaningful. Print bounds whenever argument is a range or enumeration. * ada-lang.h (ada_discrete_type_low_bound,ada_discrete_type_high_bound): Declare. * varobj.c (c_describe_child): Adjust to render larger values. * mdebugread.c (parse_type): Use proper abstractions for range types: TYPE_RANGE_DATA, SET_TYPE_LOW_BOUND_DEFINED, SET_TYPE_HIGH_BOUND_DEFINED. * p-typeprint.c (pascal_type_print_varspec_prefix): Use larger format for bounds.
2009-12-14 07:19:13 +01:00
/* Print TYPE on STREAM, preferably as a range. */
2002-06-04 17:28:49 +02:00
static void
print_range (struct type *type, struct ui_file *stream)
2002-06-04 17:28:49 +02:00
{
* dwarf2read.c (struct attribute): Increase sizes of unsnd and snd fields to allow larger integer sizes. (read_subrange_type): Increase size of bound values. Add logic to determine signedness based on base-type size, signedness. (read_attribute_value): Change format for bad byte size in message. (read_8_bytes): Increase size of result type. (dump_die_shallow): Change format for value. (dwarf2_get_attr_constant_value): Increase size of return type. Correct comment. * gdbtypes.c (create_range_type): Change API to increase size of bounds. struct field -> union field. Always take signedness from base type. (check_typedef): Use new API for TYPE_LOW_BOUND, TYPE_HIGH_BOUND. (recursive_dump_type, copy_type_recursive): Adjust to new representation of range types. * gdbtypes.h (fields_or_bounds): New union containing struct field and new struct range_bounds, used for range types. (TYPE_RANGE_DATA): New macro to access range_bounds member. (TYPE_LOW_BOUND, TYPE_HIGH_BOUND): Represent with new TYPE_RANGE_DATA. (TYPE_LOW_BOUND_UNDEFINED, TYPE_HIGH_BOUND_UNDEFINED): New macros, taking over the job of TYPE_FIELD_ARTIFICIAL for range bounds. (SET_TYPE_LOW_BOUND, SET_TYPE_HIGH_BOUND, SET_TYPE_LOW_BOUND_DEFINED) (SET_TYPE_HIGH_BOUND_DEFINED): New macros. (TYPE_FIELDS, TYPE_BASECLASS, TYPE_BASECLASS_NAME, TYPE_FIELD) (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED) (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED, TYPE_ARRAY_UPPER_BOUND_VALUE) (TYPE_ARRAY_LOWER_BOUND_VALUE): Adjust to new representation. (create_range_type): Adjust API. * ada-lang.c (ada_modulus): Use new extended bound values. (discrete_type_low_bound): Rename to... (ada_discrete_type_low_bound): ... and make external. (discrete_type_high_bound): Rename to... (ada_discrete_type_high_bound): ... and make external. (ada_value_slice_from_ptr, ada_array_bound_from_type) (ada_evaluate_subexp, to_fixed_range_type): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. * ada-typeprint.c (print_range): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. Don't look at field count, which is no longer meaningful. Print bounds whenever argument is a range or enumeration. * ada-lang.h (ada_discrete_type_low_bound,ada_discrete_type_high_bound): Declare. * varobj.c (c_describe_child): Adjust to render larger values. * mdebugread.c (parse_type): Use proper abstractions for range types: TYPE_RANGE_DATA, SET_TYPE_LOW_BOUND_DEFINED, SET_TYPE_HIGH_BOUND_DEFINED. * p-typeprint.c (pascal_type_print_varspec_prefix): Use larger format for bounds.
2009-12-14 07:19:13 +01:00
switch (TYPE_CODE (type))
2002-06-04 17:28:49 +02:00
{
case TYPE_CODE_RANGE:
case TYPE_CODE_ENUM:
* dwarf2read.c (struct attribute): Increase sizes of unsnd and snd fields to allow larger integer sizes. (read_subrange_type): Increase size of bound values. Add logic to determine signedness based on base-type size, signedness. (read_attribute_value): Change format for bad byte size in message. (read_8_bytes): Increase size of result type. (dump_die_shallow): Change format for value. (dwarf2_get_attr_constant_value): Increase size of return type. Correct comment. * gdbtypes.c (create_range_type): Change API to increase size of bounds. struct field -> union field. Always take signedness from base type. (check_typedef): Use new API for TYPE_LOW_BOUND, TYPE_HIGH_BOUND. (recursive_dump_type, copy_type_recursive): Adjust to new representation of range types. * gdbtypes.h (fields_or_bounds): New union containing struct field and new struct range_bounds, used for range types. (TYPE_RANGE_DATA): New macro to access range_bounds member. (TYPE_LOW_BOUND, TYPE_HIGH_BOUND): Represent with new TYPE_RANGE_DATA. (TYPE_LOW_BOUND_UNDEFINED, TYPE_HIGH_BOUND_UNDEFINED): New macros, taking over the job of TYPE_FIELD_ARTIFICIAL for range bounds. (SET_TYPE_LOW_BOUND, SET_TYPE_HIGH_BOUND, SET_TYPE_LOW_BOUND_DEFINED) (SET_TYPE_HIGH_BOUND_DEFINED): New macros. (TYPE_FIELDS, TYPE_BASECLASS, TYPE_BASECLASS_NAME, TYPE_FIELD) (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED) (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED, TYPE_ARRAY_UPPER_BOUND_VALUE) (TYPE_ARRAY_LOWER_BOUND_VALUE): Adjust to new representation. (create_range_type): Adjust API. * ada-lang.c (ada_modulus): Use new extended bound values. (discrete_type_low_bound): Rename to... (ada_discrete_type_low_bound): ... and make external. (discrete_type_high_bound): Rename to... (ada_discrete_type_high_bound): ... and make external. (ada_value_slice_from_ptr, ada_array_bound_from_type) (ada_evaluate_subexp, to_fixed_range_type): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. * ada-typeprint.c (print_range): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. Don't look at field count, which is no longer meaningful. Print bounds whenever argument is a range or enumeration. * ada-lang.h (ada_discrete_type_low_bound,ada_discrete_type_high_bound): Declare. * varobj.c (c_describe_child): Adjust to render larger values. * mdebugread.c (parse_type): Use proper abstractions for range types: TYPE_RANGE_DATA, SET_TYPE_LOW_BOUND_DEFINED, SET_TYPE_HIGH_BOUND_DEFINED. * p-typeprint.c (pascal_type_print_varspec_prefix): Use larger format for bounds.
2009-12-14 07:19:13 +01:00
{
struct type *target_type;
target_type = TYPE_TARGET_TYPE (type);
if (target_type == NULL)
target_type = type;
ada_print_scalar (target_type, ada_discrete_type_low_bound (type),
stream);
fprintf_filtered (stream, " .. ");
ada_print_scalar (target_type, ada_discrete_type_high_bound (type),
stream);
}
2002-06-04 17:28:49 +02:00
break;
default:
fprintf_filtered (stream, "%.*s",
ada_name_prefix_len (TYPE_NAME (type)),
TYPE_NAME (type));
* dwarf2read.c (struct attribute): Increase sizes of unsnd and snd fields to allow larger integer sizes. (read_subrange_type): Increase size of bound values. Add logic to determine signedness based on base-type size, signedness. (read_attribute_value): Change format for bad byte size in message. (read_8_bytes): Increase size of result type. (dump_die_shallow): Change format for value. (dwarf2_get_attr_constant_value): Increase size of return type. Correct comment. * gdbtypes.c (create_range_type): Change API to increase size of bounds. struct field -> union field. Always take signedness from base type. (check_typedef): Use new API for TYPE_LOW_BOUND, TYPE_HIGH_BOUND. (recursive_dump_type, copy_type_recursive): Adjust to new representation of range types. * gdbtypes.h (fields_or_bounds): New union containing struct field and new struct range_bounds, used for range types. (TYPE_RANGE_DATA): New macro to access range_bounds member. (TYPE_LOW_BOUND, TYPE_HIGH_BOUND): Represent with new TYPE_RANGE_DATA. (TYPE_LOW_BOUND_UNDEFINED, TYPE_HIGH_BOUND_UNDEFINED): New macros, taking over the job of TYPE_FIELD_ARTIFICIAL for range bounds. (SET_TYPE_LOW_BOUND, SET_TYPE_HIGH_BOUND, SET_TYPE_LOW_BOUND_DEFINED) (SET_TYPE_HIGH_BOUND_DEFINED): New macros. (TYPE_FIELDS, TYPE_BASECLASS, TYPE_BASECLASS_NAME, TYPE_FIELD) (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED) (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED, TYPE_ARRAY_UPPER_BOUND_VALUE) (TYPE_ARRAY_LOWER_BOUND_VALUE): Adjust to new representation. (create_range_type): Adjust API. * ada-lang.c (ada_modulus): Use new extended bound values. (discrete_type_low_bound): Rename to... (ada_discrete_type_low_bound): ... and make external. (discrete_type_high_bound): Rename to... (ada_discrete_type_high_bound): ... and make external. (ada_value_slice_from_ptr, ada_array_bound_from_type) (ada_evaluate_subexp, to_fixed_range_type): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. * ada-typeprint.c (print_range): Use ada_discrete_type_low_bound, ada_discrete_type_high_bound. Don't look at field count, which is no longer meaningful. Print bounds whenever argument is a range or enumeration. * ada-lang.h (ada_discrete_type_low_bound,ada_discrete_type_high_bound): Declare. * varobj.c (c_describe_child): Adjust to render larger values. * mdebugread.c (parse_type): Use proper abstractions for range types: TYPE_RANGE_DATA, SET_TYPE_LOW_BOUND_DEFINED, SET_TYPE_HIGH_BOUND_DEFINED. * p-typeprint.c (pascal_type_print_varspec_prefix): Use larger format for bounds.
2009-12-14 07:19:13 +01:00
break;
2002-06-04 17:28:49 +02:00
}
}
/* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
set *N past the bound and its delimiter, if any. */
2002-06-04 17:28:49 +02:00
static void
print_range_bound (struct type *type, char *bounds, int *n,
struct ui_file *stream)
2002-06-04 17:28:49 +02:00
{
LONGEST B;
2002-06-04 17:28:49 +02:00
if (ada_scan_number (bounds, *n, &B, n))
{
/* STABS decodes all range types which bounds are 0 .. -1 as
unsigned integers (ie. the type code is TYPE_CODE_INT, not
TYPE_CODE_RANGE). Unfortunately, ada_print_scalar() relies
on the unsigned flag to determine whether the bound should
be printed as a signed or an unsigned value. This causes
the upper bound of the 0 .. -1 range types to be printed as
a very large unsigned number instead of -1.
To workaround this stabs deficiency, we replace the TYPE by NULL
to indicate default output when we detect that the bound is negative,
and the type is a TYPE_CODE_INT. The bound is negative when
'm' is the last character of the number scanned in BOUNDS. */
if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
type = NULL;
2002-06-04 17:28:49 +02:00
ada_print_scalar (type, B, stream);
if (bounds[*n] == '_')
*n += 2;
}
else
{
int bound_len;
char *bound = bounds + *n;
char *pend;
2002-06-04 17:28:49 +02:00
pend = strstr (bound, "__");
if (pend == NULL)
*n += bound_len = strlen (bound);
else
2002-06-04 17:28:49 +02:00
{
bound_len = pend - bound;
*n += bound_len + 2;
}
fprintf_filtered (stream, "%.*s", bound_len, bound);
}
}
/* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
the value (if found) of the bound indicated by SUFFIX ("___L" or
"___U") according to the ___XD conventions. */
2002-06-04 17:28:49 +02:00
static void
print_dynamic_range_bound (struct type *type, const char *name, int name_len,
const char *suffix, struct ui_file *stream)
2002-06-04 17:28:49 +02:00
{
static char *name_buf = NULL;
static size_t name_buf_len = 0;
LONGEST B;
int OK;
GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
strncpy (name_buf, name, name_len);
strcpy (name_buf + name_len, suffix);
B = get_int_var_value (name_buf, &OK);
2002-06-04 17:28:49 +02:00
if (OK)
ada_print_scalar (type, B, stream);
else
fprintf_filtered (stream, "?");
}
/* Print RAW_TYPE as a range type, using any bound information
following the GNAT encoding (if available). */
2002-06-04 17:28:49 +02:00
static void
print_range_type (struct type *raw_type, struct ui_file *stream)
2002-06-04 17:28:49 +02:00
{
char *name;
2002-06-04 17:28:49 +02:00
struct type *base_type;
char *subtype_info;
2002-06-04 17:28:49 +02:00
gdb_assert (raw_type != NULL);
name = TYPE_NAME (raw_type);
gdb_assert (name != NULL);
if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
2002-06-04 17:28:49 +02:00
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL)
2002-06-04 17:28:49 +02:00
print_range (raw_type, stream);
else
{
int prefix_len = subtype_info - name;
char *bounds_str;
int n;
subtype_info += 5;
bounds_str = strchr (subtype_info, '_');
n = 1;
if (*subtype_info == 'L')
2002-06-04 17:28:49 +02:00
{
print_range_bound (base_type, bounds_str, &n, stream);
2002-06-04 17:28:49 +02:00
subtype_info += 1;
}
else
print_dynamic_range_bound (base_type, name, prefix_len, "___L",
stream);
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, " .. ");
if (*subtype_info == 'U')
print_range_bound (base_type, bounds_str, &n, stream);
2002-06-04 17:28:49 +02:00
else
print_dynamic_range_bound (base_type, name, prefix_len, "___U",
stream);
2002-06-04 17:28:49 +02:00
}
}
2002-06-04 17:28:49 +02:00
/* Print enumerated type TYPE on STREAM. */
2002-06-04 17:28:49 +02:00
static void
print_enum_type (struct type *type, struct ui_file *stream)
2002-06-04 17:28:49 +02:00
{
int len = TYPE_NFIELDS (type);
int i, lastval;
fprintf_filtered (stream, "(");
wrap_here (" ");
lastval = 0;
for (i = 0; i < len; i++)
{
QUIT;
if (i)
fprintf_filtered (stream, ", ");
2002-06-04 17:28:49 +02:00
wrap_here (" ");
fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
if (lastval != TYPE_FIELD_BITPOS (type, i))
{
fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
lastval = TYPE_FIELD_BITPOS (type, i);
}
lastval += 1;
}
fprintf_filtered (stream, ")");
}
/* Print representation of Ada fixed-point type TYPE on STREAM. */
2002-06-04 17:28:49 +02:00
static void
print_fixed_point_type (struct type *type, struct ui_file *stream)
2002-06-04 17:28:49 +02:00
{
DOUBLEST delta = ada_delta (type);
DOUBLEST small = ada_fixed_to_float (type, 1.0);
if (delta < 0.0)
fprintf_filtered (stream, "delta ??");
else
{
fprintf_filtered (stream, "delta %g", (double) delta);
if (delta != small)
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, " <'small = %g>", (double) small);
}
}
/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
recursion (indentation) level, in case the element type itself has
2002-06-04 17:28:49 +02:00
nested structure, and SHOW is the number of levels of internal
structure to show (see ada_print_type). */
2002-06-04 17:28:49 +02:00
static void
print_array_type (struct type *type, struct ui_file *stream, int show,
int level)
2002-06-04 17:28:49 +02:00
{
int bitsize;
int n_indices;
if (ada_is_constrained_packed_array_type (type))
type = ada_coerce_to_simple_array_type (type);
2002-06-04 17:28:49 +02:00
bitsize = 0;
fprintf_filtered (stream, "array (");
if (type == NULL)
{
fprintf_filtered (stream, _("<undecipherable array type>"));
return;
}
2002-06-04 17:28:49 +02:00
n_indices = -1;
if (show < 0)
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, "...");
else
{
if (ada_is_simple_array_type (type))
2002-06-04 17:28:49 +02:00
{
struct type *range_desc_type;
struct type *arr_type;
2002-06-04 17:28:49 +02:00
range_desc_type = ada_find_parallel_type (type, "___XA");
ada_fixup_array_indexes_type (range_desc_type);
2002-06-04 17:28:49 +02:00
bitsize = 0;
if (range_desc_type == NULL)
{
for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
arr_type = TYPE_TARGET_TYPE (arr_type))
{
if (arr_type != type)
fprintf_filtered (stream, ", ");
print_range (TYPE_INDEX_TYPE (arr_type), stream);
if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
}
}
else
2002-06-04 17:28:49 +02:00
{
int k;
n_indices = TYPE_NFIELDS (range_desc_type);
for (k = 0, arr_type = type;
2002-06-04 17:28:49 +02:00
k < n_indices;
k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
{
if (k > 0)
fprintf_filtered (stream, ", ");
print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
stream);
2002-06-04 17:28:49 +02:00
if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
}
2002-06-04 17:28:49 +02:00
}
}
else
2002-06-04 17:28:49 +02:00
{
int i, i0;
2002-06-04 17:28:49 +02:00
for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
}
}
fprintf_filtered (stream, ") of ");
wrap_here ("");
ada_print_type (ada_array_element_type (type, n_indices), "", stream,
show == 0 ? 0 : show - 1, level + 1);
2002-06-04 17:28:49 +02:00
if (bitsize > 0)
fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
}
/* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
values. Returns non-zero if the field is an encoding of
discriminant values, as in a standard variant record, and 0 if the
field is not so encoded (as happens with single-component variants
in types annotated with pragma Unchecked_Variant.)
*/
2002-06-04 17:28:49 +02:00
static int
print_choices (struct type *type, int field_num, struct ui_file *stream,
struct type *val_type)
2002-06-04 17:28:49 +02:00
{
int have_output;
int p;
const char *name = TYPE_FIELD_NAME (type, field_num);
2002-06-04 17:28:49 +02:00
have_output = 0;
/* Skip over leading 'V': NOTE soon to be obsolete. */
2002-06-04 17:28:49 +02:00
if (name[0] == 'V')
{
if (!ada_scan_number (name, 1, NULL, &p))
2002-06-04 17:28:49 +02:00
goto Huh;
}
else
p = 0;
while (1)
{
switch (name[p])
2002-06-04 17:28:49 +02:00
{
default:
goto Huh;
case '_':
case '\0':
fprintf_filtered (stream, " =>");
return 1;
2002-06-04 17:28:49 +02:00
case 'S':
case 'R':
case 'O':
if (have_output)
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, " | ");
have_output = 1;
break;
}
switch (name[p])
2002-06-04 17:28:49 +02:00
{
case 'S':
{
LONGEST W;
if (!ada_scan_number (name, p + 1, &W, &p))
2002-06-04 17:28:49 +02:00
goto Huh;
ada_print_scalar (val_type, W, stream);
break;
}
case 'R':
{
LONGEST L, U;
if (!ada_scan_number (name, p + 1, &L, &p)
|| name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
2002-06-04 17:28:49 +02:00
goto Huh;
ada_print_scalar (val_type, L, stream);
fprintf_filtered (stream, " .. ");
ada_print_scalar (val_type, U, stream);
break;
}
case 'O':
fprintf_filtered (stream, "others");
p += 1;
break;
}
}
Huh:
fprintf_filtered (stream, "?? =>");
return 0;
2002-06-04 17:28:49 +02:00
}
/* Assuming that field FIELD_NUM of TYPE represents variants whose
discriminant is contained in OUTER_TYPE, print its components on STREAM.
LEVEL is the recursion (indentation) level, in case any of the fields
themselves have nested structure, and SHOW is the number of levels of
internal structure to show (see ada_print_type). For this purpose,
fields nested in a variant part are taken to be at the same level as
the fields immediately outside the variant part. */
2002-06-04 17:28:49 +02:00
static void
print_variant_clauses (struct type *type, int field_num,
struct type *outer_type, struct ui_file *stream,
int show, int level)
2002-06-04 17:28:49 +02:00
{
int i;
struct type *var_type, *par_type;
2002-06-04 17:28:49 +02:00
struct type *discr_type;
var_type = TYPE_FIELD_TYPE (type, field_num);
discr_type = ada_variant_discrim_type (var_type, outer_type);
if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
{
var_type = TYPE_TARGET_TYPE (var_type);
if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
return;
2002-06-04 17:28:49 +02:00
}
par_type = ada_find_parallel_type (var_type, "___XVU");
if (par_type != NULL)
var_type = par_type;
for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
2002-06-04 17:28:49 +02:00
{
fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
if (print_choices (var_type, i, stream, discr_type))
{
if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
outer_type, stream, show, level + 4)
<= 0)
fprintf_filtered (stream, " null;");
}
else
print_selected_record_field_types (var_type, outer_type, i, i,
stream, show, level + 4);
2002-06-04 17:28:49 +02:00
}
}
/* Assuming that field FIELD_NUM of TYPE is a variant part whose
2002-06-04 17:28:49 +02:00
discriminants are contained in OUTER_TYPE, print a description of it
on STREAM. LEVEL is the recursion (indentation) level, in case any of
the fields themselves have nested structure, and SHOW is the number of
levels of internal structure to show (see ada_print_type). For this
purpose, fields nested in a variant part are taken to be at the same
level as the fields immediately outside the variant part. */
2002-06-04 17:28:49 +02:00
static void
print_variant_part (struct type *type, int field_num, struct type *outer_type,
struct ui_file *stream, int show, int level)
2002-06-04 17:28:49 +02:00
{
fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
ada_variant_discrim_name
(TYPE_FIELD_TYPE (type, field_num)));
print_variant_clauses (type, field_num, outer_type, stream, show,
level + 4);
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, "\n%*send case;", level + 4, "");
}
/* Print a description on STREAM of the fields FLD0 through FLD1 in
record or union type TYPE, whose discriminants are in OUTER_TYPE.
LEVEL is the recursion (indentation) level, in case any of the
fields themselves have nested structure, and SHOW is the number of
levels of internal structure to show (see ada_print_type). Does
not print parent type information of TYPE. Returns 0 if no fields
printed, -1 for an incomplete type, else > 0. Prints each field
beginning on a new line, but does not put a new line at end. */
2002-06-04 17:28:49 +02:00
static int
print_selected_record_field_types (struct type *type, struct type *outer_type,
int fld0, int fld1,
struct ui_file *stream, int show, int level)
2002-06-04 17:28:49 +02:00
{
int i, flds;
2002-06-04 17:28:49 +02:00
flds = 0;
if (fld0 > fld1 && TYPE_STUB (type))
2002-06-04 17:28:49 +02:00
return -1;
for (i = fld0; i <= fld1; i += 1)
2002-06-04 17:28:49 +02:00
{
QUIT;
if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
2002-06-04 17:28:49 +02:00
;
else if (ada_is_wrapper_field (type, i))
flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
stream, show, level);
else if (ada_is_variant_part (type, i))
2002-06-04 17:28:49 +02:00
{
print_variant_part (type, i, outer_type, stream, show, level);
flds = 1;
}
else
{
flds += 1;
fprintf_filtered (stream, "\n%*s", level + 4, "");
ada_print_type (TYPE_FIELD_TYPE (type, i),
TYPE_FIELD_NAME (type, i),
stream, show - 1, level + 4);
fprintf_filtered (stream, ";");
}
}
return flds;
}
/* Print a description on STREAM of all fields of record or union type
TYPE, as for print_selected_record_field_types, above. */
static int
print_record_field_types (struct type *type, struct type *outer_type,
struct ui_file *stream, int show, int level)
{
return print_selected_record_field_types (type, outer_type,
0, TYPE_NFIELDS (type) - 1,
stream, show, level);
}
/* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
level, in case the element type itself has nested structure, and SHOW is
the number of levels of internal structure to show (see ada_print_type). */
2002-06-04 17:28:49 +02:00
static void
print_record_type (struct type *type0, struct ui_file *stream, int show,
int level)
2002-06-04 17:28:49 +02:00
{
struct type *parent_type;
struct type *type;
type = ada_find_parallel_type (type0, "___XVE");
if (type == NULL)
type = type0;
2002-06-04 17:28:49 +02:00
parent_type = ada_parent_type (type);
if (ada_type_name (parent_type) != NULL)
fprintf_filtered (stream, "new %s with record",
decoded_type_name (parent_type));
else if (parent_type == NULL && ada_is_tagged_type (type, 0))
fprintf_filtered (stream, "tagged record");
else
fprintf_filtered (stream, "record");
2002-06-04 17:28:49 +02:00
if (show < 0)
fprintf_filtered (stream, " ... end record");
2002-06-04 17:28:49 +02:00
else
{
int flds;
flds = 0;
if (parent_type != NULL && ada_type_name (parent_type) == NULL)
flds += print_record_field_types (parent_type, parent_type,
2002-06-04 17:28:49 +02:00
stream, show, level);
flds += print_record_field_types (type, type, stream, show, level);
2002-06-04 17:28:49 +02:00
if (flds > 0)
fprintf_filtered (stream, "\n%*send record", level, "");
else if (flds < 0)
fprintf_filtered (stream, _(" <incomplete type> end record"));
else
fprintf_filtered (stream, " null; end record");
2002-06-04 17:28:49 +02:00
}
}
/* Print the unchecked union type TYPE in something resembling Ada
format on STREAM. LEVEL is the recursion (indentation) level
2002-06-04 17:28:49 +02:00
in case the element type itself has nested structure, and SHOW is the
number of levels of internal structure to show (see ada_print_type). */
2002-06-04 17:28:49 +02:00
static void
print_unchecked_union_type (struct type *type, struct ui_file *stream,
2002-06-04 17:28:49 +02:00
int show, int level)
{
if (show < 0)
fprintf_filtered (stream, "record (?) is ... end record");
else if (TYPE_NFIELDS (type) == 0)
fprintf_filtered (stream, "record (?) is null; end record");
2002-06-04 17:28:49 +02:00
else
{
int i;
fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
2002-06-04 17:28:49 +02:00
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
2002-06-04 17:28:49 +02:00
{
fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
level + 12, "");
2002-06-04 17:28:49 +02:00
ada_print_type (TYPE_FIELD_TYPE (type, i),
TYPE_FIELD_NAME (type, i),
stream, show - 1, level + 12);
fprintf_filtered (stream, ";");
}
fprintf_filtered (stream, "\n%*send case;\n%*send record",
level + 4, "", level, "");
2002-06-04 17:28:49 +02:00
}
}
2002-06-04 17:28:49 +02:00
/* Print function or procedure type TYPE on STREAM. Make it a header
for function or procedure NAME if NAME is not null. */
2002-06-04 17:28:49 +02:00
static void
print_func_type (struct type *type, struct ui_file *stream, const char *name)
2002-06-04 17:28:49 +02:00
{
int i, len = TYPE_NFIELDS (type);
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
fprintf_filtered (stream, "procedure");
else
fprintf_filtered (stream, "function");
if (name != NULL && name[0] != '\0')
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, " %s", name);
if (len > 0)
2002-06-04 17:28:49 +02:00
{
fprintf_filtered (stream, " (");
for (i = 0; i < len; i += 1)
{
if (i > 0)
{
fputs_filtered ("; ", stream);
wrap_here (" ");
}
fprintf_filtered (stream, "a%d: ", i + 1);
2002-06-04 17:28:49 +02:00
ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
}
fprintf_filtered (stream, ")");
}
2002-06-04 17:28:49 +02:00
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
{
fprintf_filtered (stream, " return ");
ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
}
}
/* Print a description of a type TYPE0.
Output goes to STREAM (via stdio).
If VARSTRING is a non-empty string, print as an Ada variable/field
declaration.
SHOW+1 is the maximum number of levels of internal type structure
2002-06-04 17:28:49 +02:00
to show (this applies to record types, enumerated types, and
array types).
SHOW is the number of levels of internal type structure to show
when there is a type name for the SHOWth deepest level (0th is
2002-06-04 17:28:49 +02:00
outer level).
When SHOW<0, no inner structure is shown.
LEVEL indicates level of recursion (for nested definitions). */
2002-06-04 17:28:49 +02:00
void
ada_print_type (struct type *type0, const char *varstring,
struct ui_file *stream, int show, int level)
2002-06-04 17:28:49 +02:00
{
struct type *type = ada_check_typedef (ada_get_base_type (type0));
char *type_name = decoded_type_name (type0);
2002-06-04 17:28:49 +02:00
int is_var_decl = (varstring != NULL && varstring[0] != '\0');
if (type == NULL)
{
if (is_var_decl)
fprintf_filtered (stream, "%.*s: ",
ada_name_prefix_len (varstring), varstring);
2002-06-04 17:28:49 +02:00
fprintf_filtered (stream, "<null type?>");
return;
}
if (show > 0)
type = ada_check_typedef (type);
2002-06-04 17:28:49 +02:00
if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
fprintf_filtered (stream, "%.*s: ",
ada_name_prefix_len (varstring), varstring);
2002-06-04 17:28:49 +02:00
if (type_name != NULL && show <= 0)
{
fprintf_filtered (stream, "%.*s",
2002-06-04 17:28:49 +02:00
ada_name_prefix_len (type_name), type_name);
return;
}
if (ada_is_aligner_type (type))
ada_print_type (ada_aligned_type (type), "", stream, show, level);
else if (ada_is_constrained_packed_array_type (type))
{
if (TYPE_CODE (type) == TYPE_CODE_PTR)
{
fprintf_filtered (stream, "access ");
print_array_type (TYPE_TARGET_TYPE (type), stream, show, level);
}
else
{
print_array_type (type, stream, show, level);
}
}
2002-06-04 17:28:49 +02:00
else
switch (TYPE_CODE (type))
{
default:
fprintf_filtered (stream, "<");
c_print_type (type, "", stream, show, level);
fprintf_filtered (stream, ">");
break;
case TYPE_CODE_PTR:
fprintf_filtered (stream, "access ");
ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
break;
case TYPE_CODE_REF:
fprintf_filtered (stream, "<ref> ");
ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level);
break;
case TYPE_CODE_ARRAY:
2002-06-04 17:28:49 +02:00
print_array_type (type, stream, show, level);
break;
case TYPE_CODE_BOOL:
fprintf_filtered (stream, "(false, true)");
break;
case TYPE_CODE_INT:
if (ada_is_fixed_point_type (type))
print_fixed_point_type (type, stream);
else
{
char *name = ada_type_name (type);
if (!ada_is_range_type_name (name))
fprintf_filtered (stream, _("<%d-byte integer>"),
TYPE_LENGTH (type));
else
{
fprintf_filtered (stream, "range ");
print_range_type (type, stream);
}
}
break;
case TYPE_CODE_RANGE:
if (ada_is_fixed_point_type (type))
print_fixed_point_type (type, stream);
else if (ada_is_modular_type (type))
* ada-lang.c (process_raise_exception_name): Remove extraneous definition from unsubmitted code. (is_lower_alphanum): New function. (ada_decode): Add support for decoding protected object subprograms and entries, and of entities declared inside protected object subprograms. Also add missing handling for__{DIGITS}+ suffixes. Allow '$<digits>' as valid overloading suffix. (is_name_suffix): Add handling for protected type entriy suffixes. Also add support for protected type subprogram suffixes, but keep it commented out for now, as there is an ambiguity between these entities and other internally generated entities. Allow '$<digits>' as valid overloading suffix. (is_valid_name_for_wild_match): New function. (wild_match): Add an exra level of verification of the entity name before declaring it a match for the given pattern. (ada_type_of_array, ada_evaluate_subexp): Use more proper longest_to_int rather than cast. (ada_evaluate_subexp): Use "invalid" rather than "illegal" in comment. (ada_coerce_to_simple_array): Call check_size to make sure that the object size is reasonable. (ada_value_primitive_packed_val): Use correct location in target buffer for extracting packed record fields that are themselves records. (add_defn_to_vec): Do not try to replace a stub type by its full type. Avoids a potential infinite loop. (ada_lookup_symbol): Move return incorrectly placed return statement, causing a loop that should be scanning all object files to only scan the first one. (ada_tag_name_2): New function. (ada_tag_name_1): If no 'tsd' field found in the dispatching table, use alternative representation. (ada_find_renaming_symbol): Strip the function name suffix when computing the XR type name. (ada_to_fixed_type): Try determining the tag only if we have the object's address. (to_fixed_array_type): Add comments. (ada_check_typedef): Replace expression checking whether the given type is a stub or not by a "call" to TYPE_STUB. Clearer and more consistent. * ada-lang.h (ADA_KNOWN_AUXILIARY_FUNCTION_NAME_PATTERNS): Allow '$' in addition to '.' for runtime auxiliary function name suffixes. See changes to ada_decode above. (struct task_control_block): Add field called_task. (This change is to keep synchronized with our local sources; it does not affect the public version yet.) * ada-typeprint.c (ada_print_type): Use int_string for printing modulus of modular type. (print_range): Trivial editorial comment fix. * ada-valprint.c (ada_emit_char): Use normal Ada syntax for double quote in string.
2006-01-02 10:39:21 +01:00
fprintf_filtered (stream, "mod %s",
int_string (ada_modulus (type), 10, 0, 0, 1));
else
{
fprintf_filtered (stream, "range ");
print_range (type, stream);
}
break;
case TYPE_CODE_FLT:
fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
break;
case TYPE_CODE_ENUM:
if (show < 0)
fprintf_filtered (stream, "(...)");
else
print_enum_type (type, stream);
break;
case TYPE_CODE_STRUCT:
if (ada_is_array_descriptor_type (type))
print_array_type (type, stream, show, level);
else if (ada_is_bogus_array_descriptor (type))
fprintf_filtered (stream,
_("array (?) of ? (<mal-formed descriptor>)"));
else
print_record_type (type, stream, show, level);
break;
case TYPE_CODE_UNION:
print_unchecked_union_type (type, stream, show, level);
break;
case TYPE_CODE_FUNC:
print_func_type (type, stream, varstring);
break;
}
2002-06-04 17:28:49 +02:00
}
/* Implement the la_print_typedef language method for Ada. */
void
ada_print_typedef (struct type *type, struct symbol *new_symbol,
struct ui_file *stream)
{
type = ada_check_typedef (type);
ada_print_type (type, "", stream, 0, 0);
fprintf_filtered (stream, "\n");
}