"}"
};
-/* See val_print for a description of the various parameters of this
- function; they are identical. */
-
-void
-f_val_print (struct type *type, int embedded_offset,
- CORE_ADDR address, struct ui_file *stream, int recurse,
- struct value *original_value,
- const struct value_print_options *options)
-{
- struct gdbarch *gdbarch = get_type_arch (type);
- int printed_field = 0; /* Number of fields printed. */
- struct type *elttype;
- CORE_ADDR addr;
- int index;
- const gdb_byte *valaddr =value_contents_for_printing (original_value);
-
- type = check_typedef (type);
- switch (TYPE_CODE (type))
- {
- case TYPE_CODE_STRING:
- f77_get_dynamic_length_of_aggregate (type);
- LA_PRINT_STRING (stream, builtin_type (gdbarch)->builtin_char,
- valaddr + embedded_offset,
- TYPE_LENGTH (type), NULL, 0, options);
- break;
-
- case TYPE_CODE_ARRAY:
- if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_CHAR)
- {
- fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, embedded_offset,
- address, stream, recurse, original_value, options);
- fprintf_filtered (stream, ")");
- }
- else
- {
- struct type *ch_type = TYPE_TARGET_TYPE (type);
-
- f77_get_dynamic_length_of_aggregate (type);
- LA_PRINT_STRING (stream, ch_type,
- valaddr + embedded_offset,
- TYPE_LENGTH (type) / TYPE_LENGTH (ch_type),
- NULL, 0, options);
- }
- break;
-
- case TYPE_CODE_PTR:
- if (options->format && options->format != 's')
- {
- val_print_scalar_formatted (type, embedded_offset,
- original_value, options, 0, stream);
- break;
- }
- else
- {
- int want_space = 0;
-
- addr = unpack_pointer (type, valaddr + embedded_offset);
- elttype = check_typedef (TYPE_TARGET_TYPE (type));
-
- if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
- {
- /* Try to print what function it points to. */
- print_function_pointer_address (options, gdbarch, addr, stream);
- return;
- }
-
- if (options->symbol_print)
- want_space = print_address_demangle (options, gdbarch, addr,
- stream, demangle);
- else if (options->addressprint && options->format != 's')
- {
- fputs_filtered (paddress (gdbarch, addr), stream);
- want_space = 1;
- }
-
- /* For a pointer to char or unsigned char, also print the string
- pointed to, unless pointer is null. */
- if (TYPE_LENGTH (elttype) == 1
- && TYPE_CODE (elttype) == TYPE_CODE_INT
- && (options->format == 0 || options->format == 's')
- && addr != 0)
- {
- if (want_space)
- fputs_filtered (" ", stream);
- val_print_string (TYPE_TARGET_TYPE (type), NULL, addr, -1,
- stream, options);
- }
- return;
- }
- break;
-
- case TYPE_CODE_INT:
- if (options->format || options->output_format)
- {
- struct value_print_options opts = *options;
-
- opts.format = (options->format ? options->format
- : options->output_format);
- val_print_scalar_formatted (type, embedded_offset,
- original_value, &opts, 0, stream);
- }
- else
- val_print_scalar_formatted (type, embedded_offset,
- original_value, options, 0, stream);
- break;
-
- case TYPE_CODE_STRUCT:
- case TYPE_CODE_UNION:
- /* Starting from the Fortran 90 standard, Fortran supports derived
- types. */
- fprintf_filtered (stream, "( ");
- for (index = 0; index < TYPE_NFIELDS (type); index++)
- {
- struct value *field = value_field
- ((struct value *)original_value, index);
-
- struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, index));
-
-
- if (TYPE_CODE (field_type) != TYPE_CODE_FUNC)
- {
- const char *field_name;
-
- if (printed_field > 0)
- fputs_filtered (", ", stream);
-
- field_name = TYPE_FIELD_NAME (type, index);
- if (field_name != NULL)
- {
- fputs_styled (field_name, variable_name_style.style (),
- stream);
- fputs_filtered (" = ", stream);
- }
-
- common_val_print (field, stream, recurse + 1,
- options, current_language);
-
- ++printed_field;
- }
- }
- fprintf_filtered (stream, " )");
- break;
-
- case TYPE_CODE_BOOL:
- if (options->format || options->output_format)
- {
- struct value_print_options opts = *options;
- opts.format = (options->format ? options->format
- : options->output_format);
- val_print_scalar_formatted (type, embedded_offset,
- original_value, &opts, 0, stream);
- }
- else
- {
- int unit_size = gdbarch_addressable_memory_unit_size (gdbarch);
- LONGEST val
- = unpack_long (type, valaddr + embedded_offset * unit_size);
- /* The Fortran standard doesn't specify how logical types are
- represented. Different compilers use different non zero
- values to represent logical true. */
- if (val == 0)
- fputs_filtered (f_decorations.false_name, stream);
- else
- fputs_filtered (f_decorations.true_name, stream);
- }
- break;
-
- case TYPE_CODE_REF:
- case TYPE_CODE_FUNC:
- case TYPE_CODE_FLAGS:
- case TYPE_CODE_FLT:
- case TYPE_CODE_VOID:
- case TYPE_CODE_ERROR:
- case TYPE_CODE_RANGE:
- case TYPE_CODE_UNDEF:
- case TYPE_CODE_COMPLEX:
- case TYPE_CODE_CHAR:
- default:
- generic_val_print (type, embedded_offset, address,
- stream, recurse, original_value, options,
- &f_decorations);
- break;
- }
-}
-
/* See f-lang.h. */
void
projects / deliverable / binutils-gdb.git / blobdiff