+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_ARRAY of characters. */
+
+static void
+ada_val_print_string (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ enum bfd_endian byte_order = type_byte_order (type);
+ struct type *elttype = TYPE_TARGET_TYPE (type);
+ unsigned int eltlen;
+ unsigned int len;
+
+ /* We know that ELTTYPE cannot possibly be null, because we assume
+ that we're called only when TYPE is a string-like type.
+ Similarly, the size of ELTTYPE should also be non-null, since
+ it's a character-like type. */
+ gdb_assert (elttype != NULL);
+ gdb_assert (TYPE_LENGTH (elttype) != 0);
+
+ eltlen = TYPE_LENGTH (elttype);
+ len = TYPE_LENGTH (type) / eltlen;
+
+ if (options->prettyformat_arrays)
+ print_spaces_filtered (2 + 2 * recurse, stream);
+
+ /* If requested, look for the first null char and only print
+ elements up to it. */
+ if (options->stop_print_at_null)
+ {
+ int temp_len;
+
+ /* Look for a NULL char. */
+ for (temp_len = 0;
+ (temp_len < len
+ && temp_len < options->print_max
+ && char_at (valaddr + offset_aligned,
+ temp_len, eltlen, byte_order) != 0);
+ temp_len += 1);
+ len = temp_len;
+ }
+
+ printstr (stream, elttype, valaddr + offset_aligned, len, 0,
+ eltlen, options);
+}
+
+/* Implement Ada val_print-ing for GNAT arrays (Eg. fat pointers,
+ thin pointers, etc). */
+
+static void
+ada_val_print_gnat_array (struct type *type, const gdb_byte *valaddr,
+ int offset, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ struct value *mark = value_mark ();
+ struct value *val;
+
+ val = value_from_contents_and_address (type, valaddr + offset, address);
+ /* If this is a reference, coerce it now. This helps taking care
+ of the case where ADDRESS is meaningless because original_value
+ was not an lval. */
+ val = coerce_ref (val);
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF) /* array access type. */
+ val = ada_coerce_to_simple_array_ptr (val);
+ else
+ val = ada_coerce_to_simple_array (val);
+ if (val == NULL)
+ {
+ gdb_assert (TYPE_CODE (type) == TYPE_CODE_TYPEDEF);
+ fprintf_filtered (stream, "0x0");
+ }
+ else
+ val_print (value_type (val),
+ value_embedded_offset (val), value_address (val),
+ stream, recurse, val, options,
+ language_def (language_ada));
+ value_free_to_mark (mark);
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_PTR. */
+
+static void
+ada_val_print_ptr (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ val_print (type, offset, address, stream, recurse,
+ original_value, options, language_def (language_c));
+
+ if (ada_is_tag_type (type))
+ {
+ struct value *val =
+ value_from_contents_and_address (type,
+ valaddr + offset_aligned,
+ address + offset_aligned);
+ const char *name = ada_tag_name (val);
+
+ if (name != NULL)
+ fprintf_filtered (stream, " (%s)", name);
+ }
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_INT or TYPE_CODE_RANGE. */
+
+static void
+ada_val_print_num (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ if (ada_is_fixed_point_type (type))
+ {
+ struct value *scale = ada_scaling_factor (type);
+ struct value *v = value_from_contents (type, valaddr + offset_aligned);
+ v = value_cast (value_type (scale), v);
+ v = value_binop (v, scale, BINOP_MUL);
+
+ const char *fmt = TYPE_LENGTH (type) < 4 ? "%.11g" : "%.17g";
+ std::string str
+ = target_float_to_string (value_contents (v), value_type (v), fmt);
+ fputs_filtered (str.c_str (), stream);
+ return;
+ }
+ else if (TYPE_CODE (type) == TYPE_CODE_RANGE
+ && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ENUM
+ || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_BOOL
+ || TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CHAR))
+ {
+ /* For enum-valued ranges, we want to recurse, because we'll end
+ up printing the constant's name rather than its numeric
+ value. Character and fixed-point types are also printed
+ differently, so recuse for those as well. */
+ struct type *target_type = TYPE_TARGET_TYPE (type);
+
+ if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
+ {
+ /* Obscure case of range type that has different length from
+ its base type. Perform a conversion, or we will get a
+ nonsense value. Actually, we could use the same
+ code regardless of lengths; I'm just avoiding a cast. */
+ struct value *v1
+ = value_from_contents_and_address (type, valaddr + offset, 0);
+ struct value *v = value_cast (target_type, v1);
+
+ val_print (target_type,
+ value_embedded_offset (v), 0, stream,
+ recurse + 1, v, options,
+ language_def (language_ada));
+ }
+ else
+ val_print (TYPE_TARGET_TYPE (type), offset,
+ address, stream, recurse, original_value,
+ options, language_def (language_ada));
+ return;
+ }
+ else
+ {
+ int format = (options->format ? options->format
+ : options->output_format);
+
+ if (format)
+ {
+ struct value_print_options opts = *options;
+
+ opts.format = format;
+ val_print_scalar_formatted (type, offset_aligned,
+ original_value, &opts, 0, stream);
+ }
+ else if (ada_is_system_address_type (type))
+ {
+ /* FIXME: We want to print System.Address variables using
+ the same format as for any access type. But for some
+ reason GNAT encodes the System.Address type as an int,
+ so we have to work-around this deficiency by handling
+ System.Address values as a special case. */
+
+ struct gdbarch *gdbarch = get_type_arch (type);
+ struct type *ptr_type = builtin_type (gdbarch)->builtin_data_ptr;
+ CORE_ADDR addr = extract_typed_address (valaddr + offset_aligned,
+ ptr_type);
+
+ fprintf_filtered (stream, "(");
+ type_print (type, "", stream, -1);
+ fprintf_filtered (stream, ") ");
+ fputs_filtered (paddress (gdbarch, addr), stream);
+ }
+ else
+ {
+ val_print_scalar_formatted (type, offset_aligned,
+ original_value, options, 0, stream);
+ if (ada_is_character_type (type))
+ {
+ LONGEST c;
+
+ fputs_filtered (" ", stream);
+ c = unpack_long (type, valaddr + offset_aligned);
+ ada_printchar (c, type, stream);
+ }
+ }
+ return;
+ }
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_ENUM. */
+
+static void
+ada_val_print_enum (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ int i;
+ unsigned int len;
+ LONGEST val;
+
+ if (options->format)
+ {
+ val_print_scalar_formatted (type, offset_aligned,
+ original_value, options, 0, stream);
+ return;
+ }
+
+ len = TYPE_NFIELDS (type);
+ val = unpack_long (type, valaddr + offset_aligned);
+ for (i = 0; i < len; i++)
+ {
+ QUIT;
+ if (val == TYPE_FIELD_ENUMVAL (type, i))
+ break;
+ }
+
+ if (i < len)
+ {
+ const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
+
+ if (name[0] == '\'')
+ fprintf_filtered (stream, "%ld %s", (long) val, name);
+ else
+ fputs_filtered (name, stream);
+ }
+ else
+ print_longest (stream, 'd', 0, val);
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_FLT. */
+
+static void
+ada_val_print_flt (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ if (options->format)
+ {
+ val_print (type, offset, address, stream, recurse,
+ original_value, options, language_def (language_c));
+ return;
+ }
+
+ ada_print_floating (valaddr + offset, type, stream);
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_STRUCT or TYPE_CODE_UNION. */
+
+static void
+ada_val_print_struct_union
+ (struct type *type, const gdb_byte *valaddr, int offset,
+ int offset_aligned, CORE_ADDR address, struct ui_file *stream,
+ int recurse, struct value *original_value,
+ const struct value_print_options *options)
+{
+ if (ada_is_bogus_array_descriptor (type))
+ {
+ fprintf_filtered (stream, "(...?)");
+ return;
+ }
+
+ fprintf_filtered (stream, "(");
+
+ if (print_field_values (type, valaddr, offset_aligned,
+ stream, recurse, original_value, options,
+ 0, type, offset_aligned,
+ language_def (language_ada)) != 0
+ && options->prettyformat)
+ {
+ fprintf_filtered (stream, "\n");
+ print_spaces_filtered (2 * recurse, stream);
+ }
+
+ fprintf_filtered (stream, ")");
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_ARRAY. */
+
+static void
+ada_val_print_array (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ /* For an array of characters, print with string syntax. */
+ if (ada_is_string_type (type)
+ && (options->format == 0 || options->format == 's'))
+ {
+ ada_val_print_string (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ return;
+ }
+
+ fprintf_filtered (stream, "(");
+ print_optional_low_bound (stream, type, options);
+ if (TYPE_FIELD_BITSIZE (type, 0) > 0)
+ val_print_packed_array_elements (type, valaddr, offset_aligned,
+ 0, stream, recurse,
+ original_value, options);
+ else
+ val_print_array_elements (type, offset_aligned, address,
+ stream, recurse, original_value,
+ options, 0);
+ fprintf_filtered (stream, ")");
+}
+
+/* Implement Ada val_print'ing for the case where TYPE is
+ a TYPE_CODE_REF. */
+
+static void
+ada_val_print_ref (struct type *type, const gdb_byte *valaddr,
+ int offset, int offset_aligned, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ /* For references, the debugger is expected to print the value as
+ an address if DEREF_REF is null. But printing an address in place
+ of the object value would be confusing to an Ada programmer.
+ So, for Ada values, we print the actual dereferenced value
+ regardless. */
+ struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
+ struct value *deref_val;
+ CORE_ADDR deref_val_int;
+
+ if (TYPE_CODE (elttype) == TYPE_CODE_UNDEF)
+ {
+ fputs_styled ("<ref to undefined type>", metadata_style.style (),
+ stream);
+ return;
+ }
+
+ deref_val = coerce_ref_if_computed (original_value);
+ if (deref_val)
+ {
+ if (ada_is_tagged_type (value_type (deref_val), 1))
+ deref_val = ada_tag_value_at_base_address (deref_val);
+
+ common_val_print (deref_val, stream, recurse + 1, options,
+ language_def (language_ada));
+ return;
+ }
+
+ deref_val_int = unpack_pointer (type, valaddr + offset_aligned);
+ if (deref_val_int == 0)
+ {
+ fputs_filtered ("(null)", stream);
+ return;
+ }
+
+ deref_val
+ = ada_value_ind (value_from_pointer (lookup_pointer_type (elttype),
+ deref_val_int));
+ if (ada_is_tagged_type (value_type (deref_val), 1))
+ deref_val = ada_tag_value_at_base_address (deref_val);
+
+ /* Make sure that the object does not have an unreasonable size
+ before trying to print it. This can happen for instance with
+ references to dynamic objects whose contents is uninitialized
+ (Eg: an array whose bounds are not set yet). */
+ ada_ensure_varsize_limit (value_type (deref_val));
+
+ if (value_lazy (deref_val))
+ value_fetch_lazy (deref_val);
+
+ val_print (value_type (deref_val),
+ value_embedded_offset (deref_val),
+ value_address (deref_val), stream, recurse + 1,
+ deref_val, options, language_def (language_ada));
+}
+
+/* See the comment on ada_val_print. This function differs in that it
+ does not catch evaluation errors (leaving that to ada_val_print). */
+
+static void
+ada_val_print_1 (struct type *type,
+ int offset, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *original_value,
+ const struct value_print_options *options)
+{
+ int offset_aligned;
+ const gdb_byte *valaddr = value_contents_for_printing (original_value);
+
+ type = ada_check_typedef (type);
+
+ if (ada_is_array_descriptor_type (type)
+ || (ada_is_constrained_packed_array_type (type)
+ && TYPE_CODE (type) != TYPE_CODE_PTR))
+ {
+ ada_val_print_gnat_array (type, valaddr, offset, address,
+ stream, recurse, original_value,
+ options);
+ return;
+ }
+
+ offset_aligned = offset + ada_aligned_value_addr (type, valaddr) - valaddr;
+ type = printable_val_type (type, valaddr + offset_aligned);
+ type = resolve_dynamic_type (type, valaddr + offset_aligned,
+ address + offset_aligned);
+
+ switch (TYPE_CODE (type))
+ {
+ default:
+ val_print (type, offset, address, stream, recurse,
+ original_value, options, language_def (language_c));
+ break;
+
+ case TYPE_CODE_PTR:
+ ada_val_print_ptr (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ break;
+
+ case TYPE_CODE_INT:
+ case TYPE_CODE_RANGE:
+ ada_val_print_num (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ break;
+
+ case TYPE_CODE_ENUM:
+ ada_val_print_enum (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ break;
+
+ case TYPE_CODE_FLT:
+ ada_val_print_flt (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ break;
+
+ case TYPE_CODE_UNION:
+ case TYPE_CODE_STRUCT:
+ ada_val_print_struct_union (type, valaddr, offset, offset_aligned,
+ address, stream, recurse,
+ original_value, options);
+ break;
+
+ case TYPE_CODE_ARRAY:
+ ada_val_print_array (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ return;
+
+ case TYPE_CODE_REF:
+ ada_val_print_ref (type, valaddr, offset, offset_aligned,
+ address, stream, recurse, original_value,
+ options);
+ break;
+ }
+}
+
+/* See val_print for a description of the various parameters of this
+ function; they are identical. */
+
+void
+ada_val_print (struct type *type,
+ int embedded_offset, CORE_ADDR address,
+ struct ui_file *stream, int recurse,
+ struct value *val,
+ const struct value_print_options *options)
+{
+ try
+ {
+ ada_val_print_1 (type, embedded_offset, address,
+ stream, recurse, val, options);
+ }
+ catch (const gdb_exception_error &except)
+ {
+ fprintf_styled (stream, metadata_style.style (),
+ _("<error reading variable: %s>"),
+ except.what ());
+ }
+}
+
+void
+ada_value_print (struct value *val0, struct ui_file *stream,
+ const struct value_print_options *options)
+{
+ struct value *val = ada_to_fixed_value (val0);
+ CORE_ADDR address = value_address (val);
+ struct type *type = ada_check_typedef (value_type (val));
+ struct value_print_options opts;
+
+ /* If it is a pointer, indicate what it points to. */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ {
+ /* Hack: don't print (char *) for char strings. Their
+ type is indicated by the quoted string anyway. */
+ if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) != sizeof (char)
+ || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_INT
+ || TYPE_UNSIGNED (TYPE_TARGET_TYPE (type)))
+ {
+ fprintf_filtered (stream, "(");
+ type_print (type, "", stream, -1);
+ fprintf_filtered (stream, ") ");
+ }
+ }
+ else if (ada_is_array_descriptor_type (type))
+ {
+ /* We do not print the type description unless TYPE is an array
+ access type (this is encoded by the compiler as a typedef to
+ a fat pointer - hence the check against TYPE_CODE_TYPEDEF). */
+ if (TYPE_CODE (type) == TYPE_CODE_TYPEDEF)
+ {
+ fprintf_filtered (stream, "(");
+ type_print (type, "", stream, -1);
+ fprintf_filtered (stream, ") ");
+ }
+ }
+ else if (ada_is_bogus_array_descriptor (type))
+ {
+ fprintf_filtered (stream, "(");
+ type_print (type, "", stream, -1);
+ fprintf_filtered (stream, ") (...?)");
+ return;
+ }
+
+ opts = *options;
+ opts.deref_ref = 1;
+ val_print (type,
+ value_embedded_offset (val), address,
+ stream, 0, val, &opts, current_language);
+}