Rewrite pascal_value_print_inner
This rewrites pascal_value_print_inner, copying in the body of pascal_val_print_inner and adusting as needed. This will form the base of future changes to fully convert this to using the value-based API. gdb/ChangeLog 2020-03-13 Tom Tromey <tom@tromey.com> * p-valprint.c (pascal_value_print_inner): Rewrite.
This commit is contained in:
Tom Tromey
parent
6a95a1f58d
commit
64d64d3a76
2 changed files with 340 additions and 2 deletions
|
|
@ -1,3 +1,7 @@
|
||||||
|
2020-03-13 Tom Tromey <tom@tromey.com>
|
||||||
|
|
||||||
|
* p-valprint.c (pascal_value_print_inner): Rewrite.
|
||||||
|
|
||||||
2020-03-13 Tom Tromey <tom@tromey.com>
|
2020-03-13 Tom Tromey <tom@tromey.com>
|
||||||
|
|
||||||
* f-valprint.c (f_value_print_innner): Rewrite.
|
* f-valprint.c (f_value_print_innner): Rewrite.
|
||||||
|
|
|
||||||
338
gdb/p-valprint.c
338
gdb/p-valprint.c
|
|
@ -434,8 +434,342 @@ pascal_value_print_inner (struct value *val, struct ui_file *stream,
|
||||||
const struct value_print_options *options)
|
const struct value_print_options *options)
|
||||||
|
|
||||||
{
|
{
|
||||||
pascal_val_print (value_type (val), value_embedded_offset (val),
|
struct type *type = check_typedef (value_type (val));
|
||||||
value_address (val), stream, recurse, val, options);
|
struct gdbarch *gdbarch = get_type_arch (type);
|
||||||
|
enum bfd_endian byte_order = type_byte_order (type);
|
||||||
|
unsigned int i = 0; /* Number of characters printed */
|
||||||
|
unsigned len;
|
||||||
|
struct type *elttype;
|
||||||
|
unsigned eltlen;
|
||||||
|
int length_pos, length_size, string_pos;
|
||||||
|
struct type *char_type;
|
||||||
|
CORE_ADDR addr;
|
||||||
|
int want_space = 0;
|
||||||
|
const gdb_byte *valaddr = value_contents_for_printing (val);
|
||||||
|
|
||||||
|
switch (TYPE_CODE (type))
|
||||||
|
{
|
||||||
|
case TYPE_CODE_ARRAY:
|
||||||
|
{
|
||||||
|
LONGEST low_bound, high_bound;
|
||||||
|
|
||||||
|
if (get_array_bounds (type, &low_bound, &high_bound))
|
||||||
|
{
|
||||||
|
len = high_bound - low_bound + 1;
|
||||||
|
elttype = check_typedef (TYPE_TARGET_TYPE (type));
|
||||||
|
eltlen = TYPE_LENGTH (elttype);
|
||||||
|
if (options->prettyformat_arrays)
|
||||||
|
{
|
||||||
|
print_spaces_filtered (2 + 2 * recurse, stream);
|
||||||
|
}
|
||||||
|
/* If 's' format is used, try to print out as string.
|
||||||
|
If no format is given, print as string if element type
|
||||||
|
is of TYPE_CODE_CHAR and element size is 1,2 or 4. */
|
||||||
|
if (options->format == 's'
|
||||||
|
|| ((eltlen == 1 || eltlen == 2 || eltlen == 4)
|
||||||
|
&& TYPE_CODE (elttype) == TYPE_CODE_CHAR
|
||||||
|
&& options->format == 0))
|
||||||
|
{
|
||||||
|
/* If requested, look for the first null char and only print
|
||||||
|
elements up to it. */
|
||||||
|
if (options->stop_print_at_null)
|
||||||
|
{
|
||||||
|
unsigned int temp_len;
|
||||||
|
|
||||||
|
/* Look for a NULL char. */
|
||||||
|
for (temp_len = 0;
|
||||||
|
extract_unsigned_integer (valaddr + temp_len * eltlen,
|
||||||
|
eltlen, byte_order)
|
||||||
|
&& temp_len < len && temp_len < options->print_max;
|
||||||
|
temp_len++);
|
||||||
|
len = temp_len;
|
||||||
|
}
|
||||||
|
|
||||||
|
LA_PRINT_STRING (stream, TYPE_TARGET_TYPE (type),
|
||||||
|
valaddr, len, NULL, 0, options);
|
||||||
|
i = len;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
fprintf_filtered (stream, "{");
|
||||||
|
/* If this is a virtual function table, print the 0th
|
||||||
|
entry specially, and the rest of the members normally. */
|
||||||
|
if (pascal_object_is_vtbl_ptr_type (elttype))
|
||||||
|
{
|
||||||
|
i = 1;
|
||||||
|
fprintf_filtered (stream, "%d vtable entries", len - 1);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
i = 0;
|
||||||
|
}
|
||||||
|
value_print_array_elements (val, stream, recurse, options, i);
|
||||||
|
fprintf_filtered (stream, "}");
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
/* Array of unspecified length: treat like pointer to first elt. */
|
||||||
|
addr = value_address (val);
|
||||||
|
}
|
||||||
|
goto print_unpacked_pointer;
|
||||||
|
|
||||||
|
case TYPE_CODE_PTR:
|
||||||
|
if (options->format && options->format != 's')
|
||||||
|
{
|
||||||
|
value_print_scalar_formatted (val, options, 0, stream);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
|
||||||
|
{
|
||||||
|
/* Print the unmangled name if desired. */
|
||||||
|
/* Print vtable entry - we only get here if we ARE using
|
||||||
|
-fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */
|
||||||
|
/* Extract the address, assume that it is unsigned. */
|
||||||
|
addr = extract_unsigned_integer (valaddr,
|
||||||
|
TYPE_LENGTH (type), byte_order);
|
||||||
|
print_address_demangle (options, gdbarch, addr, stream, demangle);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
check_typedef (TYPE_TARGET_TYPE (type));
|
||||||
|
|
||||||
|
addr = unpack_pointer (type, valaddr);
|
||||||
|
print_unpacked_pointer:
|
||||||
|
elttype = check_typedef (TYPE_TARGET_TYPE (type));
|
||||||
|
|
||||||
|
if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
|
||||||
|
{
|
||||||
|
/* Try to print what function it points to. */
|
||||||
|
print_address_demangle (options, gdbarch, addr, stream, demangle);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
|| TYPE_CODE (elttype) == TYPE_CODE_CHAR))
|
||||||
|
|| ((TYPE_LENGTH (elttype) == 2 || TYPE_LENGTH (elttype) == 4)
|
||||||
|
&& TYPE_CODE (elttype) == TYPE_CODE_CHAR))
|
||||||
|
&& (options->format == 0 || options->format == 's')
|
||||||
|
&& addr != 0)
|
||||||
|
{
|
||||||
|
if (want_space)
|
||||||
|
fputs_filtered (" ", stream);
|
||||||
|
/* No wide string yet. */
|
||||||
|
i = val_print_string (elttype, NULL, addr, -1, stream, options);
|
||||||
|
}
|
||||||
|
/* Also for pointers to pascal strings. */
|
||||||
|
/* Note: this is Free Pascal specific:
|
||||||
|
as GDB does not recognize stabs pascal strings
|
||||||
|
Pascal strings are mapped to records
|
||||||
|
with lowercase names PM. */
|
||||||
|
if (is_pascal_string_type (elttype, &length_pos, &length_size,
|
||||||
|
&string_pos, &char_type, NULL)
|
||||||
|
&& addr != 0)
|
||||||
|
{
|
||||||
|
ULONGEST string_length;
|
||||||
|
gdb_byte *buffer;
|
||||||
|
|
||||||
|
if (want_space)
|
||||||
|
fputs_filtered (" ", stream);
|
||||||
|
buffer = (gdb_byte *) xmalloc (length_size);
|
||||||
|
read_memory (addr + length_pos, buffer, length_size);
|
||||||
|
string_length = extract_unsigned_integer (buffer, length_size,
|
||||||
|
byte_order);
|
||||||
|
xfree (buffer);
|
||||||
|
i = val_print_string (char_type, NULL,
|
||||||
|
addr + string_pos, string_length,
|
||||||
|
stream, options);
|
||||||
|
}
|
||||||
|
else if (pascal_object_is_vtbl_member (type))
|
||||||
|
{
|
||||||
|
/* Print vtbl's nicely. */
|
||||||
|
CORE_ADDR vt_address = unpack_pointer (type, valaddr);
|
||||||
|
struct bound_minimal_symbol msymbol =
|
||||||
|
lookup_minimal_symbol_by_pc (vt_address);
|
||||||
|
|
||||||
|
/* If 'symbol_print' is set, we did the work above. */
|
||||||
|
if (!options->symbol_print
|
||||||
|
&& (msymbol.minsym != NULL)
|
||||||
|
&& (vt_address == BMSYMBOL_VALUE_ADDRESS (msymbol)))
|
||||||
|
{
|
||||||
|
if (want_space)
|
||||||
|
fputs_filtered (" ", stream);
|
||||||
|
fputs_filtered ("<", stream);
|
||||||
|
fputs_filtered (msymbol.minsym->print_name (), stream);
|
||||||
|
fputs_filtered (">", stream);
|
||||||
|
want_space = 1;
|
||||||
|
}
|
||||||
|
if (vt_address && options->vtblprint)
|
||||||
|
{
|
||||||
|
struct value *vt_val;
|
||||||
|
struct symbol *wsym = NULL;
|
||||||
|
struct type *wtype;
|
||||||
|
|
||||||
|
if (want_space)
|
||||||
|
fputs_filtered (" ", stream);
|
||||||
|
|
||||||
|
if (msymbol.minsym != NULL)
|
||||||
|
{
|
||||||
|
const char *search_name = msymbol.minsym->search_name ();
|
||||||
|
wsym = lookup_symbol_search_name (search_name, NULL,
|
||||||
|
VAR_DOMAIN).symbol;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (wsym)
|
||||||
|
{
|
||||||
|
wtype = SYMBOL_TYPE (wsym);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
wtype = TYPE_TARGET_TYPE (type);
|
||||||
|
}
|
||||||
|
vt_val = value_at (wtype, vt_address);
|
||||||
|
common_val_print (vt_val, stream, recurse + 1, options,
|
||||||
|
current_language);
|
||||||
|
if (options->prettyformat)
|
||||||
|
{
|
||||||
|
fprintf_filtered (stream, "\n");
|
||||||
|
print_spaces_filtered (2 + 2 * recurse, stream);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return;
|
||||||
|
|
||||||
|
case TYPE_CODE_REF:
|
||||||
|
case TYPE_CODE_ENUM:
|
||||||
|
case TYPE_CODE_FLAGS:
|
||||||
|
case TYPE_CODE_FUNC:
|
||||||
|
case TYPE_CODE_RANGE:
|
||||||
|
case TYPE_CODE_INT:
|
||||||
|
case TYPE_CODE_FLT:
|
||||||
|
case TYPE_CODE_VOID:
|
||||||
|
case TYPE_CODE_ERROR:
|
||||||
|
case TYPE_CODE_UNDEF:
|
||||||
|
case TYPE_CODE_BOOL:
|
||||||
|
case TYPE_CODE_CHAR:
|
||||||
|
generic_value_print (val, stream, recurse, options, &p_decorations);
|
||||||
|
break;
|
||||||
|
|
||||||
|
case TYPE_CODE_UNION:
|
||||||
|
if (recurse && !options->unionprint)
|
||||||
|
{
|
||||||
|
fprintf_filtered (stream, "{...}");
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
/* Fall through. */
|
||||||
|
case TYPE_CODE_STRUCT:
|
||||||
|
if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type))
|
||||||
|
{
|
||||||
|
/* Print the unmangled name if desired. */
|
||||||
|
/* Print vtable entry - we only get here if NOT using
|
||||||
|
-fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */
|
||||||
|
/* Extract the address, assume that it is unsigned. */
|
||||||
|
print_address_demangle
|
||||||
|
(options, gdbarch,
|
||||||
|
extract_unsigned_integer (valaddr
|
||||||
|
+ TYPE_FIELD_BITPOS (type,
|
||||||
|
VTBL_FNADDR_OFFSET) / 8,
|
||||||
|
TYPE_LENGTH (TYPE_FIELD_TYPE (type,
|
||||||
|
VTBL_FNADDR_OFFSET)),
|
||||||
|
byte_order),
|
||||||
|
stream, demangle);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
if (is_pascal_string_type (type, &length_pos, &length_size,
|
||||||
|
&string_pos, &char_type, NULL))
|
||||||
|
{
|
||||||
|
len = extract_unsigned_integer (valaddr + length_pos,
|
||||||
|
length_size, byte_order);
|
||||||
|
LA_PRINT_STRING (stream, char_type, valaddr + string_pos,
|
||||||
|
len, NULL, 0, options);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
pascal_object_print_value_fields (type, valaddr, 0,
|
||||||
|
value_address (val), stream,
|
||||||
|
recurse, val, options,
|
||||||
|
NULL, 0);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
|
||||||
|
case TYPE_CODE_SET:
|
||||||
|
elttype = TYPE_INDEX_TYPE (type);
|
||||||
|
elttype = check_typedef (elttype);
|
||||||
|
if (TYPE_STUB (elttype))
|
||||||
|
{
|
||||||
|
fprintf_styled (stream, metadata_style.style (), "<incomplete type>");
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
struct type *range = elttype;
|
||||||
|
LONGEST low_bound, high_bound;
|
||||||
|
int need_comma = 0;
|
||||||
|
|
||||||
|
fputs_filtered ("[", stream);
|
||||||
|
|
||||||
|
int bound_info = get_discrete_bounds (range, &low_bound, &high_bound);
|
||||||
|
if (low_bound == 0 && high_bound == -1 && TYPE_LENGTH (type) > 0)
|
||||||
|
{
|
||||||
|
/* If we know the size of the set type, we can figure out the
|
||||||
|
maximum value. */
|
||||||
|
bound_info = 0;
|
||||||
|
high_bound = TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1;
|
||||||
|
TYPE_HIGH_BOUND (range) = high_bound;
|
||||||
|
}
|
||||||
|
maybe_bad_bstring:
|
||||||
|
if (bound_info < 0)
|
||||||
|
{
|
||||||
|
fputs_styled ("<error value>", metadata_style.style (), stream);
|
||||||
|
goto done;
|
||||||
|
}
|
||||||
|
|
||||||
|
for (i = low_bound; i <= high_bound; i++)
|
||||||
|
{
|
||||||
|
int element = value_bit_index (type, valaddr, i);
|
||||||
|
|
||||||
|
if (element < 0)
|
||||||
|
{
|
||||||
|
i = element;
|
||||||
|
goto maybe_bad_bstring;
|
||||||
|
}
|
||||||
|
if (element)
|
||||||
|
{
|
||||||
|
if (need_comma)
|
||||||
|
fputs_filtered (", ", stream);
|
||||||
|
print_type_scalar (range, i, stream);
|
||||||
|
need_comma = 1;
|
||||||
|
|
||||||
|
if (i + 1 <= high_bound
|
||||||
|
&& value_bit_index (type, valaddr, ++i))
|
||||||
|
{
|
||||||
|
int j = i;
|
||||||
|
|
||||||
|
fputs_filtered ("..", stream);
|
||||||
|
while (i + 1 <= high_bound
|
||||||
|
&& value_bit_index (type, valaddr, ++i))
|
||||||
|
j = i;
|
||||||
|
print_type_scalar (range, j, stream);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
done:
|
||||||
|
fputs_filtered ("]", stream);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
|
||||||
|
default:
|
||||||
|
error (_("Invalid pascal type code %d in symbol table."),
|
||||||
|
TYPE_CODE (type));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue