/* Support for printing Fortran values for GDB, the GNU debugger.
Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2003, 2005, 2006,
- 2007 Free Software Foundation, Inc.
+ 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C definitions by Farooq Butt
(fmbutt@engage.sps.mot.com), additionally worked over by Stan Shebs.
#define F77_DIM_OFFSET(n) (f77_array_offset_tbl[n][0])
int
-f77_get_dynamic_lowerbound (struct type *type, int *lower_bound)
+f77_get_lowerbound (struct type *type)
{
- struct frame_info *frame;
- CORE_ADDR current_frame_addr;
- CORE_ADDR ptr_to_lower_bound;
+ if (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED (type))
+ error (_("Lower bound may not be '*' in F77"));
- switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type))
- {
- case BOUND_BY_VALUE_ON_STACK:
- frame = deprecated_safe_get_selected_frame ();
- current_frame_addr = get_frame_base (frame);
- if (current_frame_addr > 0)
- {
- *lower_bound =
- read_memory_integer (current_frame_addr +
- TYPE_ARRAY_LOWER_BOUND_VALUE (type),
- 4);
- }
- else
- {
- *lower_bound = DEFAULT_LOWER_BOUND;
- return BOUND_FETCH_ERROR;
- }
- break;
-
- case BOUND_SIMPLE:
- *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type);
- break;
-
- case BOUND_CANNOT_BE_DETERMINED:
- error (_("Lower bound may not be '*' in F77"));
- break;
-
- case BOUND_BY_REF_ON_STACK:
- frame = deprecated_safe_get_selected_frame ();
- current_frame_addr = get_frame_base (frame);
- if (current_frame_addr > 0)
- {
- ptr_to_lower_bound =
- read_memory_typed_address (current_frame_addr +
- TYPE_ARRAY_LOWER_BOUND_VALUE (type),
- builtin_type_void_data_ptr);
- *lower_bound = read_memory_integer (ptr_to_lower_bound, 4);
- }
- else
- {
- *lower_bound = DEFAULT_LOWER_BOUND;
- return BOUND_FETCH_ERROR;
- }
- break;
-
- case BOUND_BY_REF_IN_REG:
- case BOUND_BY_VALUE_IN_REG:
- default:
- error (_("??? unhandled dynamic array bound type ???"));
- break;
- }
- return BOUND_FETCH_OK;
+ return TYPE_ARRAY_LOWER_BOUND_VALUE (type);
}
int
-f77_get_dynamic_upperbound (struct type *type, int *upper_bound)
+f77_get_upperbound (struct type *type)
{
- struct frame_info *frame;
- CORE_ADDR current_frame_addr = 0;
- CORE_ADDR ptr_to_upper_bound;
-
- switch (TYPE_ARRAY_UPPER_BOUND_TYPE (type))
+ if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
{
- case BOUND_BY_VALUE_ON_STACK:
- frame = deprecated_safe_get_selected_frame ();
- current_frame_addr = get_frame_base (frame);
- if (current_frame_addr > 0)
- {
- *upper_bound =
- read_memory_integer (current_frame_addr +
- TYPE_ARRAY_UPPER_BOUND_VALUE (type),
- 4);
- }
- else
- {
- *upper_bound = DEFAULT_UPPER_BOUND;
- return BOUND_FETCH_ERROR;
- }
- break;
-
- case BOUND_SIMPLE:
- *upper_bound = TYPE_ARRAY_UPPER_BOUND_VALUE (type);
- break;
-
- case BOUND_CANNOT_BE_DETERMINED:
- /* we have an assumed size array on our hands. Assume that
- upper_bound == lower_bound so that we show at least
- 1 element.If the user wants to see more elements, let
- him manually ask for 'em and we'll subscript the
- array and show him */
- f77_get_dynamic_lowerbound (type, upper_bound);
- break;
-
- case BOUND_BY_REF_ON_STACK:
- frame = deprecated_safe_get_selected_frame ();
- current_frame_addr = get_frame_base (frame);
- if (current_frame_addr > 0)
- {
- ptr_to_upper_bound =
- read_memory_typed_address (current_frame_addr +
- TYPE_ARRAY_UPPER_BOUND_VALUE (type),
- builtin_type_void_data_ptr);
- *upper_bound = read_memory_integer (ptr_to_upper_bound, 4);
- }
- else
- {
- *upper_bound = DEFAULT_UPPER_BOUND;
- return BOUND_FETCH_ERROR;
- }
- break;
+ /* We have an assumed size array on our hands. Assume that
+ upper_bound == lower_bound so that we show at least 1 element.
+ If the user wants to see more elements, let him manually ask for 'em
+ and we'll subscript the array and show him. */
- case BOUND_BY_REF_IN_REG:
- case BOUND_BY_VALUE_IN_REG:
- default:
- error (_("??? unhandled dynamic array bound type ???"));
- break;
+ return f77_get_lowerbound (type);
}
- return BOUND_FETCH_OK;
+
+ return TYPE_ARRAY_UPPER_BOUND_VALUE (type);
}
/* Obtain F77 adjustable array dimensions */
f77_get_dynamic_length_of_aggregate (TYPE_TARGET_TYPE (type));
/* Recursion ends here, start setting up lengths. */
- retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
- if (retcode == BOUND_FETCH_ERROR)
- error (_("Cannot obtain valid array lower bound"));
-
- retcode = f77_get_dynamic_upperbound (type, &upper_bound);
- if (retcode == BOUND_FETCH_ERROR)
- error (_("Cannot obtain valid array upper bound"));
+ lower_bound = f77_get_lowerbound (type);
+ upper_bound = f77_get_upperbound (type);
/* Patch in a valid length value. */
while ((TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY))
{
- if (TYPE_ARRAY_UPPER_BOUND_TYPE (tmp_type) == BOUND_CANNOT_BE_DETERMINED)
- fprintf_filtered (stream, "<assumed size array> ");
-
- retcode = f77_get_dynamic_upperbound (tmp_type, &upper);
- if (retcode == BOUND_FETCH_ERROR)
- error (_("Cannot obtain dynamic upper bound"));
-
- retcode = f77_get_dynamic_lowerbound (tmp_type, &lower);
- if (retcode == BOUND_FETCH_ERROR)
- error (_("Cannot obtain dynamic lower bound"));
+ upper = f77_get_upperbound (tmp_type);
+ lower = f77_get_lowerbound (tmp_type);
F77_DIM_SIZE (ndimen) = upper - lower + 1;
static void
f77_print_array_1 (int nss, int ndimensions, struct type *type,
const gdb_byte *valaddr, CORE_ADDR address,
- struct ui_file *stream, int format,
- int deref_ref, int recurse, enum val_prettyprint pretty,
+ struct ui_file *stream, int recurse,
+ const struct value_print_options *options,
int *elts)
{
int i;
if (nss != ndimensions)
{
- for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < print_max); i++)
+ for (i = 0; (i < F77_DIM_SIZE (nss) && (*elts) < options->print_max); i++)
{
fprintf_filtered (stream, "( ");
f77_print_array_1 (nss + 1, ndimensions, TYPE_TARGET_TYPE (type),
valaddr + i * F77_DIM_OFFSET (nss),
address + i * F77_DIM_OFFSET (nss),
- stream, format, deref_ref, recurse, pretty, elts);
+ stream, recurse, options, elts);
fprintf_filtered (stream, ") ");
}
- if (*elts >= print_max && i < F77_DIM_SIZE (nss))
+ if (*elts >= options->print_max && i < F77_DIM_SIZE (nss))
fprintf_filtered (stream, "...");
}
else
{
- for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < print_max;
+ for (i = 0; i < F77_DIM_SIZE (nss) && (*elts) < options->print_max;
i++, (*elts)++)
{
val_print (TYPE_TARGET_TYPE (type),
valaddr + i * F77_DIM_OFFSET (ndimensions),
0,
address + i * F77_DIM_OFFSET (ndimensions),
- stream, format, deref_ref, recurse, pretty);
+ stream, recurse, options, current_language);
if (i != (F77_DIM_SIZE (nss) - 1))
fprintf_filtered (stream, ", ");
- if ((*elts == print_max - 1) && (i != (F77_DIM_SIZE (nss) - 1)))
+ if ((*elts == options->print_max - 1)
+ && (i != (F77_DIM_SIZE (nss) - 1)))
fprintf_filtered (stream, "...");
}
}
static void
f77_print_array (struct type *type, const gdb_byte *valaddr,
CORE_ADDR address, struct ui_file *stream,
- int format, int deref_ref, int recurse,
- enum val_prettyprint pretty)
+ int recurse, const struct value_print_options *options)
{
int ndimensions;
int elts = 0;
f77_create_arrayprint_offset_tbl (type, stream);
- f77_print_array_1 (1, ndimensions, type, valaddr, address, stream, format,
- deref_ref, recurse, pretty, &elts);
+ f77_print_array_1 (1, ndimensions, type, valaddr, address, stream,
+ recurse, options, &elts);
}
\f
/* Print data of type TYPE located at VALADDR (within GDB), which came from
the inferior at address ADDRESS, onto stdio stream STREAM according to
- FORMAT (a letter or 0 for natural format). The data at VALADDR is in
- target byte order.
+ OPTIONS. The data at VALADDR is in target byte order.
If the data are a string pointer, returns the number of string characters
- printed.
-
- If DEREF_REF is nonzero, then dereference references, otherwise just print
- them like pointers.
-
- The PRETTY parameter controls prettyprinting. */
+ printed. */
int
f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
- CORE_ADDR address, struct ui_file *stream, int format,
- int deref_ref, int recurse, enum val_prettyprint pretty)
+ CORE_ADDR address, struct ui_file *stream, int recurse,
+ const struct value_print_options *options)
{
+ struct gdbarch *gdbarch = get_type_arch (type);
+ enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
unsigned int i = 0; /* Number of characters printed */
struct type *elttype;
LONGEST val;
{
case TYPE_CODE_STRING:
f77_get_dynamic_length_of_aggregate (type);
- LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
+ LA_PRINT_STRING (stream, builtin_type (gdbarch)->builtin_char,
+ valaddr, TYPE_LENGTH (type), NULL, 0, options);
break;
case TYPE_CODE_ARRAY:
fprintf_filtered (stream, "(");
- f77_print_array (type, valaddr, address, stream, format,
- deref_ref, recurse, pretty);
+ f77_print_array (type, valaddr, address, stream, recurse, options);
fprintf_filtered (stream, ")");
break;
case TYPE_CODE_PTR:
- if (format && format != 's')
+ if (options->format && options->format != 's')
{
- print_scalar_formatted (valaddr, type, format, 0, stream);
+ print_scalar_formatted (valaddr, type, options, 0, stream);
break;
}
else
if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
{
/* Try to print what function it points to. */
- print_address_demangle (addr, stream, demangle);
+ print_address_demangle (gdbarch, addr, stream, demangle);
/* Return value is irrelevant except for string pointers. */
return 0;
}
- if (addressprint && format != 's')
- deprecated_print_address_numeric (addr, 1, stream);
+ if (options->addressprint && options->format != 's')
+ fputs_filtered (paddress (gdbarch, addr), stream);
/* 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
- && (format == 0 || format == 's')
+ && (options->format == 0 || options->format == 's')
&& addr != 0)
- i = val_print_string (addr, -1, TYPE_LENGTH (elttype), stream);
+ i = val_print_string (TYPE_TARGET_TYPE (type), addr, -1, stream,
+ options);
/* Return number of characters printed, including the terminating
'\0' if we reached the end. val_print_string takes care including
case TYPE_CODE_REF:
elttype = check_typedef (TYPE_TARGET_TYPE (type));
- if (addressprint)
+ if (options->addressprint)
{
CORE_ADDR addr
= extract_typed_address (valaddr + embedded_offset, type);
fprintf_filtered (stream, "@");
- deprecated_print_address_numeric (addr, 1, stream);
- if (deref_ref)
+ fputs_filtered (paddress (gdbarch, addr), stream);
+ if (options->deref_ref)
fputs_filtered (": ", stream);
}
/* De-reference the reference. */
- if (deref_ref)
+ if (options->deref_ref)
{
if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
{
struct value *deref_val =
value_at
(TYPE_TARGET_TYPE (type),
- unpack_pointer (lookup_pointer_type (builtin_type_void),
- valaddr + embedded_offset));
- common_val_print (deref_val, stream, format, deref_ref, recurse,
- pretty);
+ unpack_pointer (type, valaddr + embedded_offset));
+ common_val_print (deref_val, stream, recurse,
+ options, current_language);
}
else
fputs_filtered ("???", stream);
break;
case TYPE_CODE_FUNC:
- if (format)
+ if (options->format)
{
- print_scalar_formatted (valaddr, type, format, 0, stream);
+ print_scalar_formatted (valaddr, type, options, 0, stream);
break;
}
/* FIXME, we should consider, at least for ANSI C language, eliminating
type_print (type, "", stream, -1);
fprintf_filtered (stream, "} ");
/* Try to print what function it points to, and its address. */
- print_address_demangle (address, stream, demangle);
+ print_address_demangle (gdbarch, address, stream, demangle);
break;
case TYPE_CODE_INT:
- format = format ? format : output_format;
- if (format)
- print_scalar_formatted (valaddr, type, format, 0, stream);
+ if (options->format || options->output_format)
+ {
+ struct value_print_options opts = *options;
+ opts.format = (options->format ? options->format
+ : options->output_format);
+ print_scalar_formatted (valaddr, type, &opts, 0, stream);
+ }
else
{
val_print_type_code_int (type, valaddr, stream);
{
fputs_filtered (" ", stream);
LA_PRINT_CHAR ((unsigned char) unpack_long (type, valaddr),
- stream);
+ type, stream);
}
}
break;
case TYPE_CODE_FLAGS:
- if (format)
- print_scalar_formatted (valaddr, type, format, 0, stream);
+ if (options->format)
+ print_scalar_formatted (valaddr, type, options, 0, stream);
else
val_print_type_code_flags (type, valaddr, stream);
break;
case TYPE_CODE_FLT:
- if (format)
- print_scalar_formatted (valaddr, type, format, 0, stream);
+ if (options->format)
+ print_scalar_formatted (valaddr, type, options, 0, stream);
else
print_floating (valaddr, type, stream);
break;
break;
case TYPE_CODE_BOOL:
- format = format ? format : output_format;
- if (format)
- print_scalar_formatted (valaddr, type, format, 0, stream);
+ if (options->format || options->output_format)
+ {
+ struct value_print_options opts = *options;
+ opts.format = (options->format ? options->format
+ : options->output_format);
+ print_scalar_formatted (valaddr, type, &opts, 0, stream);
+ }
else
{
- val = 0;
- switch (TYPE_LENGTH (type))
- {
- case 1:
- val = unpack_long (builtin_type_f_logical_s1, valaddr);
- break;
-
- case 2:
- val = unpack_long (builtin_type_f_logical_s2, valaddr);
- break;
-
- case 4:
- val = unpack_long (builtin_type_f_logical, valaddr);
- break;
-
- default:
- error (_("Logicals of length %d bytes not supported"),
- TYPE_LENGTH (type));
-
- }
-
+ val = extract_unsigned_integer (valaddr,
+ TYPE_LENGTH (type), byte_order);
if (val == 0)
fprintf_filtered (stream, ".FALSE.");
else if (val == 1)
{
/* Bash the type code temporarily. */
TYPE_CODE (type) = TYPE_CODE_INT;
- f_val_print (type, valaddr, 0, address, stream, format,
- deref_ref, recurse, pretty);
+ f_val_print (type, valaddr, 0, address, stream, recurse, options);
/* Restore the type code so later uses work as intended. */
TYPE_CODE (type) = TYPE_CODE_BOOL;
}
break;
case TYPE_CODE_COMPLEX:
- switch (TYPE_LENGTH (type))
- {
- case 8:
- type = builtin_type_f_real;
- break;
- case 16:
- type = builtin_type_f_real_s8;
- break;
- case 32:
- type = builtin_type_f_real_s16;
- break;
- default:
- error (_("Cannot print out complex*%d variables"), TYPE_LENGTH (type));
- }
+ type = TYPE_TARGET_TYPE (type);
fputs_filtered ("(", stream);
print_floating (valaddr, type, stream);
fputs_filtered (",", stream);
break;
case TYPE_CODE_STRUCT:
+ case TYPE_CODE_UNION:
/* Starting from the Fortran 90 standard, Fortran supports derived
types. */
- fprintf_filtered (stream, "{ ");
+ fprintf_filtered (stream, "( ");
for (index = 0; index < TYPE_NFIELDS (type); index++)
{
int offset = TYPE_FIELD_BITPOS (type, index) / 8;
f_val_print (TYPE_FIELD_TYPE (type, index), valaddr + offset,
- embedded_offset, address, stream,
- format, deref_ref, recurse, pretty);
+ embedded_offset, address, stream, recurse, options);
if (index != TYPE_NFIELDS (type) - 1)
fputs_filtered (", ", stream);
}
- fprintf_filtered (stream, "}");
+ fprintf_filtered (stream, " )");
break;
default:
if (msymbol != NULL
&& (SYMBOL_VALUE_ADDRESS (msymbol)
> BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
- funname = DEPRECATED_SYMBOL_NAME (msymbol);
+ funname = SYMBOL_LINKAGE_NAME (msymbol);
else
- funname = DEPRECATED_SYMBOL_NAME (func);
+ funname = SYMBOL_LINKAGE_NAME (func);
}
else
{
lookup_minimal_symbol_by_pc (get_frame_pc (fi));
if (msymbol != NULL)
- funname = DEPRECATED_SYMBOL_NAME (msymbol);
+ funname = SYMBOL_LINKAGE_NAME (msymbol);
else /* Got no 'funname', code below will fail. */
error (_("No function found for frame."));
}
while (entry != NULL)
{
- printf_filtered ("%s = ", DEPRECATED_SYMBOL_NAME (entry->symbol));
- print_variable_value (entry->symbol, fi, gdb_stdout);
- printf_filtered ("\n");
+ print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0);
entry = entry->next;
}
}
if (msymbol != NULL
&& (SYMBOL_VALUE_ADDRESS (msymbol)
> BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
- funname = DEPRECATED_SYMBOL_NAME (msymbol);
+ funname = SYMBOL_LINKAGE_NAME (msymbol);
else
- funname = DEPRECATED_SYMBOL_NAME (func);
+ funname = SYMBOL_LINKAGE_NAME (func);
}
else
{
lookup_minimal_symbol_by_pc (fi->pc);
if (msymbol != NULL)
- funname = DEPRECATED_SYMBOL_NAME (msymbol);
+ funname = SYMBOL_LINKAGE_NAME (msymbol);
}
the_common = find_common_for_function (comname, funname);