]>
Commit | Line | Data |
---|---|---|
373a8247 | 1 | /* Support for printing Pascal values for GDB, the GNU debugger. |
5bcca90b | 2 | |
1d506c26 | 3 | Copyright (C) 2000-2024 Free Software Foundation, Inc. |
373a8247 PM |
4 | |
5 | This file is part of GDB. | |
6 | ||
7 | This program is free software; you can redistribute it and/or modify | |
8 | it under the terms of the GNU General Public License as published by | |
a9762ec7 | 9 | the Free Software Foundation; either version 3 of the License, or |
373a8247 PM |
10 | (at your option) any later version. |
11 | ||
12 | This program is distributed in the hope that it will be useful, | |
13 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | GNU General Public License for more details. | |
16 | ||
17 | You should have received a copy of the GNU General Public License | |
a9762ec7 | 18 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ |
373a8247 PM |
19 | |
20 | /* This file is derived from c-valprint.c */ | |
21 | ||
bf31fd38 | 22 | #include "gdbsupport/gdb_obstack.h" |
373a8247 PM |
23 | #include "symtab.h" |
24 | #include "gdbtypes.h" | |
25 | #include "expression.h" | |
26 | #include "value.h" | |
27 | #include "command.h" | |
28 | #include "gdbcmd.h" | |
29 | #include "gdbcore.h" | |
30 | #include "demangle.h" | |
31 | #include "valprint.h" | |
3172dc30 | 32 | #include "typeprint.h" |
373a8247 PM |
33 | #include "language.h" |
34 | #include "target.h" | |
35 | #include "annotate.h" | |
36 | #include "p-lang.h" | |
eb43544b | 37 | #include "cp-abi.h" |
d3cbe7ef | 38 | #include "cp-support.h" |
77e371c0 | 39 | #include "objfiles.h" |
268a13a5 | 40 | #include "gdbsupport/byte-vector.h" |
7f6aba03 | 41 | #include "cli/cli-style.h" |
373a8247 PM |
42 | \f |
43 | ||
07a32858 TT |
44 | static void pascal_object_print_value_fields (struct value *, struct ui_file *, |
45 | int, | |
46 | const struct value_print_options *, | |
47 | struct type **, int); | |
48 | ||
e88acd96 TT |
49 | /* Decorations for Pascal. */ |
50 | ||
51 | static const struct generic_val_print_decorations p_decorations = | |
52 | { | |
53 | "", | |
54 | " + ", | |
55 | " * I", | |
56 | "true", | |
57 | "false", | |
00272ec4 TT |
58 | "void", |
59 | "{", | |
60 | "}" | |
e88acd96 TT |
61 | }; |
62 | ||
426a9c18 | 63 | /* See p-lang.h. */ |
373a8247 | 64 | |
d3eab38a | 65 | void |
46157d77 AB |
66 | pascal_language::value_print_inner (struct value *val, |
67 | struct ui_file *stream, int recurse, | |
68 | const struct value_print_options *options) const | |
426a9c18 | 69 | |
373a8247 | 70 | { |
d0c97917 | 71 | struct type *type = check_typedef (val->type ()); |
8ee511af | 72 | struct gdbarch *gdbarch = type->arch (); |
34877895 | 73 | enum bfd_endian byte_order = type_byte_order (type); |
52f0bd74 | 74 | unsigned int i = 0; /* Number of characters printed */ |
373a8247 PM |
75 | unsigned len; |
76 | struct type *elttype; | |
77 | unsigned eltlen; | |
5598ce11 | 78 | int length_pos, length_size, string_pos; |
6c7a06a3 | 79 | struct type *char_type; |
373a8247 | 80 | CORE_ADDR addr; |
b012acdd | 81 | int want_space = 0; |
efaf1ae0 | 82 | const gdb_byte *valaddr = val->contents_for_printing ().data (); |
373a8247 | 83 | |
78134374 | 84 | switch (type->code ()) |
373a8247 PM |
85 | { |
86 | case TYPE_CODE_ARRAY: | |
b926417a TT |
87 | { |
88 | LONGEST low_bound, high_bound; | |
373a8247 | 89 | |
b926417a TT |
90 | if (get_array_bounds (type, &low_bound, &high_bound)) |
91 | { | |
92 | len = high_bound - low_bound + 1; | |
27710edb | 93 | elttype = check_typedef (type->target_type ()); |
df86565b | 94 | eltlen = elttype->length (); |
b926417a TT |
95 | /* If 's' format is used, try to print out as string. |
96 | If no format is given, print as string if element type | |
97 | is of TYPE_CODE_CHAR and element size is 1,2 or 4. */ | |
98 | if (options->format == 's' | |
99 | || ((eltlen == 1 || eltlen == 2 || eltlen == 4) | |
78134374 | 100 | && elttype->code () == TYPE_CODE_CHAR |
b926417a TT |
101 | && options->format == 0)) |
102 | { | |
103 | /* If requested, look for the first null char and only print | |
104 | elements up to it. */ | |
105 | if (options->stop_print_at_null) | |
106 | { | |
76b58849 AB |
107 | unsigned int print_max_chars |
108 | = get_print_max_chars (options); | |
b926417a TT |
109 | unsigned int temp_len; |
110 | ||
111 | /* Look for a NULL char. */ | |
112 | for (temp_len = 0; | |
76b58849 AB |
113 | (extract_unsigned_integer |
114 | (valaddr + temp_len * eltlen, eltlen, byte_order) | |
115 | && temp_len < len | |
116 | && temp_len < print_max_chars); | |
b926417a TT |
117 | temp_len++); |
118 | len = temp_len; | |
119 | } | |
120 | ||
27710edb | 121 | printstr (stream, type->target_type (), valaddr, len, |
5cc0917c | 122 | NULL, 0, options); |
b926417a TT |
123 | i = len; |
124 | } | |
125 | else | |
126 | { | |
6cb06a8c | 127 | gdb_printf (stream, "{"); |
b926417a TT |
128 | /* If this is a virtual function table, print the 0th |
129 | entry specially, and the rest of the members normally. */ | |
130 | if (pascal_object_is_vtbl_ptr_type (elttype)) | |
131 | { | |
132 | i = 1; | |
6cb06a8c | 133 | gdb_printf (stream, "%d vtable entries", len - 1); |
b926417a TT |
134 | } |
135 | else | |
136 | { | |
137 | i = 0; | |
138 | } | |
426a9c18 | 139 | value_print_array_elements (val, stream, recurse, options, i); |
6cb06a8c | 140 | gdb_printf (stream, "}"); |
b926417a TT |
141 | } |
142 | break; | |
143 | } | |
144 | /* Array of unspecified length: treat like pointer to first elt. */ | |
9feb2d07 | 145 | addr = val->address (); |
b926417a | 146 | } |
373a8247 PM |
147 | goto print_unpacked_pointer; |
148 | ||
149 | case TYPE_CODE_PTR: | |
79a45b7d | 150 | if (options->format && options->format != 's') |
373a8247 | 151 | { |
426a9c18 | 152 | value_print_scalar_formatted (val, options, 0, stream); |
373a8247 PM |
153 | break; |
154 | } | |
79a45b7d | 155 | if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type)) |
373a8247 PM |
156 | { |
157 | /* Print the unmangled name if desired. */ | |
158 | /* Print vtable entry - we only get here if we ARE using | |
0df8b418 | 159 | -fvtable_thunks. (Otherwise, look under TYPE_CODE_STRUCT.) */ |
b276f1bb | 160 | /* Extract the address, assume that it is unsigned. */ |
426a9c18 | 161 | addr = extract_unsigned_integer (valaddr, |
df86565b | 162 | type->length (), byte_order); |
edf0c1b7 | 163 | print_address_demangle (options, gdbarch, addr, stream, demangle); |
373a8247 PM |
164 | break; |
165 | } | |
27710edb | 166 | check_typedef (type->target_type ()); |
e13eedd5 | 167 | |
426a9c18 | 168 | addr = unpack_pointer (type, valaddr); |
e13eedd5 | 169 | print_unpacked_pointer: |
27710edb | 170 | elttype = check_typedef (type->target_type ()); |
e13eedd5 | 171 | |
78134374 | 172 | if (elttype->code () == TYPE_CODE_FUNC) |
373a8247 | 173 | { |
e13eedd5 | 174 | /* Try to print what function it points to. */ |
edf0c1b7 | 175 | print_address_demangle (options, gdbarch, addr, stream, demangle); |
d3eab38a | 176 | return; |
e13eedd5 | 177 | } |
373a8247 | 178 | |
e13eedd5 PM |
179 | if (options->addressprint && options->format != 's') |
180 | { | |
0426ad51 | 181 | gdb_puts (paddress (gdbarch, addr), stream); |
b012acdd | 182 | want_space = 1; |
e13eedd5 | 183 | } |
373a8247 | 184 | |
e13eedd5 PM |
185 | /* For a pointer to char or unsigned char, also print the string |
186 | pointed to, unless pointer is null. */ | |
df86565b | 187 | if (((elttype->length () == 1 |
78134374 | 188 | && (elttype->code () == TYPE_CODE_INT |
dda83cd7 | 189 | || elttype->code () == TYPE_CODE_CHAR)) |
df86565b | 190 | || ((elttype->length () == 2 || elttype->length () == 4) |
dda83cd7 | 191 | && elttype->code () == TYPE_CODE_CHAR)) |
e13eedd5 PM |
192 | && (options->format == 0 || options->format == 's') |
193 | && addr != 0) | |
194 | { | |
b012acdd | 195 | if (want_space) |
0426ad51 | 196 | gdb_puts (" ", stream); |
0df8b418 | 197 | /* No wide string yet. */ |
09ca9e2e | 198 | i = val_print_string (elttype, NULL, addr, -1, stream, options); |
e13eedd5 | 199 | } |
0df8b418 | 200 | /* Also for pointers to pascal strings. */ |
e13eedd5 PM |
201 | /* Note: this is Free Pascal specific: |
202 | as GDB does not recognize stabs pascal strings | |
203 | Pascal strings are mapped to records | |
0df8b418 | 204 | with lowercase names PM. */ |
46157d77 AB |
205 | if (pascal_is_string_type (elttype, &length_pos, &length_size, |
206 | &string_pos, &char_type, NULL) > 0 | |
e13eedd5 PM |
207 | && addr != 0) |
208 | { | |
209 | ULONGEST string_length; | |
7c543f7b | 210 | gdb_byte *buffer; |
ad3bbd48 | 211 | |
b012acdd | 212 | if (want_space) |
0426ad51 | 213 | gdb_puts (" ", stream); |
7c543f7b | 214 | buffer = (gdb_byte *) xmalloc (length_size); |
e13eedd5 PM |
215 | read_memory (addr + length_pos, buffer, length_size); |
216 | string_length = extract_unsigned_integer (buffer, length_size, | |
217 | byte_order); | |
218 | xfree (buffer); | |
09ca9e2e TT |
219 | i = val_print_string (char_type, NULL, |
220 | addr + string_pos, string_length, | |
221 | stream, options); | |
e13eedd5 PM |
222 | } |
223 | else if (pascal_object_is_vtbl_member (type)) | |
224 | { | |
0df8b418 | 225 | /* Print vtbl's nicely. */ |
426a9c18 | 226 | CORE_ADDR vt_address = unpack_pointer (type, valaddr); |
7cbd4a93 | 227 | struct bound_minimal_symbol msymbol = |
ad3bbd48 MS |
228 | lookup_minimal_symbol_by_pc (vt_address); |
229 | ||
9cb709b6 TT |
230 | /* If 'symbol_print' is set, we did the work above. */ |
231 | if (!options->symbol_print | |
7cbd4a93 | 232 | && (msymbol.minsym != NULL) |
4aeddc50 | 233 | && (vt_address == msymbol.value_address ())) |
373a8247 | 234 | { |
b012acdd | 235 | if (want_space) |
0426ad51 TT |
236 | gdb_puts (" ", stream); |
237 | gdb_puts ("<", stream); | |
238 | gdb_puts (msymbol.minsym->print_name (), stream); | |
239 | gdb_puts (">", stream); | |
b012acdd | 240 | want_space = 1; |
373a8247 | 241 | } |
e13eedd5 | 242 | if (vt_address && options->vtblprint) |
373a8247 | 243 | { |
e13eedd5 | 244 | struct value *vt_val; |
be903358 | 245 | struct symbol *wsym = NULL; |
e13eedd5 | 246 | struct type *wtype; |
373a8247 | 247 | |
b012acdd | 248 | if (want_space) |
0426ad51 | 249 | gdb_puts (" ", stream); |
b012acdd | 250 | |
7cbd4a93 | 251 | if (msymbol.minsym != NULL) |
de63c46b | 252 | { |
c9d95fa3 | 253 | const char *search_name = msymbol.minsym->search_name (); |
582942f4 | 254 | wsym = lookup_symbol_search_name (search_name, NULL, |
ccf41c24 | 255 | SEARCH_VFT).symbol; |
de63c46b | 256 | } |
e13eedd5 PM |
257 | |
258 | if (wsym) | |
373a8247 | 259 | { |
5f9c5a63 | 260 | wtype = wsym->type (); |
373a8247 | 261 | } |
e13eedd5 | 262 | else |
373a8247 | 263 | { |
27710edb | 264 | wtype = type->target_type (); |
e13eedd5 PM |
265 | } |
266 | vt_val = value_at (wtype, vt_address); | |
267 | common_val_print (vt_val, stream, recurse + 1, options, | |
268 | current_language); | |
2a998fc0 | 269 | if (options->prettyformat) |
e13eedd5 | 270 | { |
6cb06a8c | 271 | gdb_printf (stream, "\n"); |
d0b1020b | 272 | print_spaces (2 + 2 * recurse, stream); |
373a8247 PM |
273 | } |
274 | } | |
373a8247 | 275 | } |
e13eedd5 | 276 | |
d3eab38a | 277 | return; |
373a8247 | 278 | |
373a8247 | 279 | case TYPE_CODE_REF: |
e88acd96 TT |
280 | case TYPE_CODE_ENUM: |
281 | case TYPE_CODE_FLAGS: | |
282 | case TYPE_CODE_FUNC: | |
283 | case TYPE_CODE_RANGE: | |
284 | case TYPE_CODE_INT: | |
285 | case TYPE_CODE_FLT: | |
286 | case TYPE_CODE_VOID: | |
287 | case TYPE_CODE_ERROR: | |
288 | case TYPE_CODE_UNDEF: | |
289 | case TYPE_CODE_BOOL: | |
290 | case TYPE_CODE_CHAR: | |
426a9c18 | 291 | generic_value_print (val, stream, recurse, options, &p_decorations); |
373a8247 PM |
292 | break; |
293 | ||
294 | case TYPE_CODE_UNION: | |
79a45b7d | 295 | if (recurse && !options->unionprint) |
373a8247 | 296 | { |
6cb06a8c | 297 | gdb_printf (stream, "{...}"); |
373a8247 PM |
298 | break; |
299 | } | |
d182e398 | 300 | [[fallthrough]]; |
373a8247 | 301 | case TYPE_CODE_STRUCT: |
79a45b7d | 302 | if (options->vtblprint && pascal_object_is_vtbl_ptr_type (type)) |
373a8247 PM |
303 | { |
304 | /* Print the unmangled name if desired. */ | |
305 | /* Print vtable entry - we only get here if NOT using | |
0df8b418 | 306 | -fvtable_thunks. (Otherwise, look under TYPE_CODE_PTR.) */ |
b276f1bb AC |
307 | /* Extract the address, assume that it is unsigned. */ |
308 | print_address_demangle | |
edf0c1b7 | 309 | (options, gdbarch, |
940da03e | 310 | extract_unsigned_integer |
b610c045 | 311 | (valaddr + type->field (VTBL_FNADDR_OFFSET).loc_bitpos () / 8, |
df86565b | 312 | type->field (VTBL_FNADDR_OFFSET).type ()->length (), |
940da03e | 313 | byte_order), |
b276f1bb | 314 | stream, demangle); |
373a8247 PM |
315 | } |
316 | else | |
317 | { | |
492325c4 | 318 | if (pascal_is_string_type (type, &length_pos, &length_size, |
46157d77 | 319 | &string_pos, &char_type, NULL) > 0) |
373a8247 | 320 | { |
426a9c18 TT |
321 | len = extract_unsigned_integer (valaddr + length_pos, |
322 | length_size, byte_order); | |
5cc0917c AB |
323 | printstr (stream, char_type, valaddr + string_pos, len, |
324 | NULL, 0, options); | |
373a8247 PM |
325 | } |
326 | else | |
426a9c18 TT |
327 | pascal_object_print_value_fields (val, stream, recurse, |
328 | options, NULL, 0); | |
373a8247 PM |
329 | } |
330 | break; | |
331 | ||
373a8247 | 332 | case TYPE_CODE_SET: |
3d967001 | 333 | elttype = type->index_type (); |
f168693b | 334 | elttype = check_typedef (elttype); |
e46d3488 | 335 | if (elttype->is_stub ()) |
373a8247 | 336 | { |
7f6aba03 | 337 | fprintf_styled (stream, metadata_style.style (), "<incomplete type>"); |
373a8247 PM |
338 | break; |
339 | } | |
340 | else | |
341 | { | |
342 | struct type *range = elttype; | |
343 | LONGEST low_bound, high_bound; | |
373a8247 PM |
344 | int need_comma = 0; |
345 | ||
0426ad51 | 346 | gdb_puts ("[", stream); |
373a8247 | 347 | |
1f8d2881 SM |
348 | int bound_info = (get_discrete_bounds (range, &low_bound, &high_bound) |
349 | ? 0 : -1); | |
df86565b | 350 | if (low_bound == 0 && high_bound == -1 && type->length () > 0) |
7a081a30 PM |
351 | { |
352 | /* If we know the size of the set type, we can figure out the | |
353 | maximum value. */ | |
b926417a | 354 | bound_info = 0; |
df86565b | 355 | high_bound = type->length () * TARGET_CHAR_BIT - 1; |
8c2e4e06 | 356 | range->bounds ()->high.set_const_val (high_bound); |
7a081a30 | 357 | } |
373a8247 | 358 | maybe_bad_bstring: |
b926417a | 359 | if (bound_info < 0) |
373a8247 | 360 | { |
7f6aba03 | 361 | fputs_styled ("<error value>", metadata_style.style (), stream); |
373a8247 PM |
362 | goto done; |
363 | } | |
364 | ||
365 | for (i = low_bound; i <= high_bound; i++) | |
366 | { | |
426a9c18 | 367 | int element = value_bit_index (type, valaddr, i); |
ad3bbd48 | 368 | |
373a8247 PM |
369 | if (element < 0) |
370 | { | |
371 | i = element; | |
372 | goto maybe_bad_bstring; | |
373 | } | |
6b1755ce | 374 | if (element) |
373a8247 PM |
375 | { |
376 | if (need_comma) | |
0426ad51 | 377 | gdb_puts (", ", stream); |
373a8247 PM |
378 | print_type_scalar (range, i, stream); |
379 | need_comma = 1; | |
380 | ||
3e43a32a | 381 | if (i + 1 <= high_bound |
426a9c18 | 382 | && value_bit_index (type, valaddr, ++i)) |
373a8247 PM |
383 | { |
384 | int j = i; | |
ad3bbd48 | 385 | |
0426ad51 | 386 | gdb_puts ("..", stream); |
373a8247 | 387 | while (i + 1 <= high_bound |
426a9c18 | 388 | && value_bit_index (type, valaddr, ++i)) |
373a8247 PM |
389 | j = i; |
390 | print_type_scalar (range, j, stream); | |
391 | } | |
392 | } | |
393 | } | |
394 | done: | |
0426ad51 | 395 | gdb_puts ("]", stream); |
373a8247 PM |
396 | } |
397 | break; | |
398 | ||
373a8247 | 399 | default: |
3e43a32a | 400 | error (_("Invalid pascal type code %d in symbol table."), |
78134374 | 401 | type->code ()); |
373a8247 | 402 | } |
373a8247 | 403 | } |
c0941be6 | 404 | |
426a9c18 | 405 | \f |
c0941be6 | 406 | void |
46157d77 AB |
407 | pascal_language::value_print (struct value *val, struct ui_file *stream, |
408 | const struct value_print_options *options) const | |
c0941be6 | 409 | { |
d0c97917 | 410 | struct type *type = val->type (); |
426a9c18 | 411 | struct value_print_options opts = *options; |
64d64d3a | 412 | |
dad6b350 | 413 | opts.deref_ref = true; |
64d64d3a | 414 | |
426a9c18 | 415 | /* If it is a pointer, indicate what it points to. |
64d64d3a | 416 | |
426a9c18 | 417 | Print type also if it is a reference. |
64d64d3a | 418 | |
426a9c18 TT |
419 | Object pascal: if it is a member pointer, we will take care |
420 | of that when we print it. */ | |
78134374 SM |
421 | if (type->code () == TYPE_CODE_PTR |
422 | || type->code () == TYPE_CODE_REF) | |
426a9c18 TT |
423 | { |
424 | /* Hack: remove (char *) for char strings. Their | |
dda83cd7 | 425 | type is indicated by the quoted string anyway. */ |
78134374 | 426 | if (type->code () == TYPE_CODE_PTR |
7d93a1e0 | 427 | && type->name () == NULL |
27710edb SM |
428 | && type->target_type ()->name () != NULL |
429 | && strcmp (type->target_type ()->name (), "char") == 0) | |
64d64d3a | 430 | { |
426a9c18 | 431 | /* Print nothing. */ |
64d64d3a | 432 | } |
426a9c18 | 433 | else |
64d64d3a | 434 | { |
6cb06a8c | 435 | gdb_printf (stream, "("); |
426a9c18 | 436 | type_print (type, "", stream, -1); |
6cb06a8c | 437 | gdb_printf (stream, ") "); |
64d64d3a | 438 | } |
426a9c18 TT |
439 | } |
440 | common_val_print (val, stream, 0, &opts, current_language); | |
441 | } | |
64d64d3a | 442 | |
64d64d3a | 443 | |
426a9c18 TT |
444 | static void |
445 | show_pascal_static_field_print (struct ui_file *file, int from_tty, | |
446 | struct cmd_list_element *c, const char *value) | |
447 | { | |
6cb06a8c TT |
448 | gdb_printf (file, _("Printing of pascal static members is %s.\n"), |
449 | value); | |
426a9c18 | 450 | } |
64d64d3a | 451 | |
426a9c18 TT |
452 | static struct obstack dont_print_vb_obstack; |
453 | static struct obstack dont_print_statmem_obstack; | |
64d64d3a | 454 | |
426a9c18 TT |
455 | static void pascal_object_print_static_field (struct value *, |
456 | struct ui_file *, int, | |
457 | const struct value_print_options *); | |
64d64d3a | 458 | |
426a9c18 TT |
459 | static void pascal_object_print_value (struct value *, struct ui_file *, int, |
460 | const struct value_print_options *, | |
461 | struct type **); | |
64d64d3a | 462 | |
426a9c18 TT |
463 | /* It was changed to this after 2.4.5. */ |
464 | const char pascal_vtbl_ptr_name[] = | |
465 | {'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0}; | |
64d64d3a | 466 | |
426a9c18 TT |
467 | /* Return truth value for assertion that TYPE is of the type |
468 | "pointer to virtual function". */ | |
64d64d3a | 469 | |
426a9c18 TT |
470 | int |
471 | pascal_object_is_vtbl_ptr_type (struct type *type) | |
472 | { | |
7d93a1e0 | 473 | const char *type_name = type->name (); |
373a8247 | 474 | |
fe978cb0 PA |
475 | return (type_name != NULL |
476 | && strcmp (type_name, pascal_vtbl_ptr_name) == 0); | |
373a8247 PM |
477 | } |
478 | ||
479 | /* Return truth value for the assertion that TYPE is of the type | |
480 | "pointer to virtual function table". */ | |
481 | ||
482 | int | |
fba45db2 | 483 | pascal_object_is_vtbl_member (struct type *type) |
373a8247 | 484 | { |
78134374 | 485 | if (type->code () == TYPE_CODE_PTR) |
373a8247 | 486 | { |
27710edb | 487 | type = type->target_type (); |
78134374 | 488 | if (type->code () == TYPE_CODE_ARRAY) |
373a8247 | 489 | { |
27710edb | 490 | type = type->target_type (); |
78134374 | 491 | if (type->code () == TYPE_CODE_STRUCT /* If not using |
0df8b418 | 492 | thunks. */ |
78134374 | 493 | || type->code () == TYPE_CODE_PTR) /* If using thunks. */ |
373a8247 PM |
494 | { |
495 | /* Virtual functions tables are full of pointers | |
dda83cd7 | 496 | to virtual functions. */ |
373a8247 PM |
497 | return pascal_object_is_vtbl_ptr_type (type); |
498 | } | |
499 | } | |
500 | } | |
501 | return 0; | |
502 | } | |
503 | ||
46157d77 | 504 | /* Helper function for print pascal objects. |
07a32858 TT |
505 | |
506 | VAL, STREAM, RECURSE, and OPTIONS have the same meanings as in | |
507 | pascal_object_print_value and c_value_print. | |
508 | ||
509 | DONT_PRINT is an array of baseclass types that we | |
510 | should not print, or zero if called from top level. */ | |
511 | ||
512 | static void | |
513 | pascal_object_print_value_fields (struct value *val, struct ui_file *stream, | |
514 | int recurse, | |
515 | const struct value_print_options *options, | |
516 | struct type **dont_print_vb, | |
517 | int dont_print_statmem) | |
518 | { | |
519 | int i, len, n_baseclasses; | |
520 | char *last_dont_print | |
521 | = (char *) obstack_next_free (&dont_print_statmem_obstack); | |
522 | ||
d0c97917 | 523 | struct type *type = check_typedef (val->type ()); |
07a32858 | 524 | |
6cb06a8c | 525 | gdb_printf (stream, "{"); |
1f704f76 | 526 | len = type->num_fields (); |
07a32858 TT |
527 | n_baseclasses = TYPE_N_BASECLASSES (type); |
528 | ||
529 | /* Print out baseclasses such that we don't print | |
530 | duplicates of virtual baseclasses. */ | |
531 | if (n_baseclasses > 0) | |
532 | pascal_object_print_value (val, stream, recurse + 1, | |
533 | options, dont_print_vb); | |
534 | ||
535 | if (!len && n_baseclasses == 1) | |
536 | fprintf_styled (stream, metadata_style.style (), "<No data fields>"); | |
537 | else | |
538 | { | |
539 | struct obstack tmp_obstack = dont_print_statmem_obstack; | |
540 | int fields_seen = 0; | |
efaf1ae0 | 541 | const gdb_byte *valaddr = val->contents_for_printing ().data (); |
07a32858 TT |
542 | |
543 | if (dont_print_statmem == 0) | |
544 | { | |
545 | /* If we're at top level, carve out a completely fresh | |
546 | chunk of the obstack and use that until this particular | |
547 | invocation returns. */ | |
548 | obstack_finish (&dont_print_statmem_obstack); | |
549 | } | |
550 | ||
551 | for (i = n_baseclasses; i < len; i++) | |
552 | { | |
553 | /* If requested, skip printing of static fields. */ | |
554 | if (!options->pascal_static_field_print | |
c819a338 | 555 | && type->field (i).is_static ()) |
07a32858 TT |
556 | continue; |
557 | if (fields_seen) | |
6cb06a8c | 558 | gdb_printf (stream, ", "); |
07a32858 TT |
559 | else if (n_baseclasses > 0) |
560 | { | |
561 | if (options->prettyformat) | |
562 | { | |
6cb06a8c | 563 | gdb_printf (stream, "\n"); |
d0b1020b | 564 | print_spaces (2 + 2 * recurse, stream); |
0426ad51 TT |
565 | gdb_puts ("members of ", stream); |
566 | gdb_puts (type->name (), stream); | |
567 | gdb_puts (": ", stream); | |
07a32858 TT |
568 | } |
569 | } | |
570 | fields_seen = 1; | |
571 | ||
572 | if (options->prettyformat) | |
573 | { | |
6cb06a8c | 574 | gdb_printf (stream, "\n"); |
d0b1020b | 575 | print_spaces (2 + 2 * recurse, stream); |
07a32858 TT |
576 | } |
577 | else | |
578 | { | |
1285ce86 | 579 | stream->wrap_here (2 + 2 * recurse); |
07a32858 TT |
580 | } |
581 | ||
940da03e | 582 | annotate_field_begin (type->field (i).type ()); |
07a32858 | 583 | |
c819a338 | 584 | if (type->field (i).is_static ()) |
07a32858 | 585 | { |
0426ad51 | 586 | gdb_puts ("static ", stream); |
bed009b9 TT |
587 | fprintf_symbol (stream, |
588 | type->field (i).name (), | |
589 | current_language->la_language, | |
590 | DMGL_PARAMS | DMGL_ANSI); | |
07a32858 TT |
591 | } |
592 | else | |
33d16dd9 | 593 | fputs_styled (type->field (i).name (), |
07a32858 TT |
594 | variable_name_style.style (), stream); |
595 | annotate_field_name_end (); | |
0426ad51 | 596 | gdb_puts (" = ", stream); |
07a32858 TT |
597 | annotate_field_value (); |
598 | ||
c819a338 | 599 | if (!type->field (i).is_static () |
8c329d5c | 600 | && type->field (i).is_packed ()) |
07a32858 TT |
601 | { |
602 | struct value *v; | |
603 | ||
604 | /* Bitfields require special handling, especially due to byte | |
dda83cd7 | 605 | order problems. */ |
20aadb93 | 606 | if (type->field (i).is_ignored ()) |
07a32858 TT |
607 | { |
608 | fputs_styled ("<optimized out or zero length>", | |
609 | metadata_style.style (), stream); | |
610 | } | |
e989e637 TT |
611 | else if (val->bits_synthetic_pointer |
612 | (type->field (i).loc_bitpos (), | |
3757d2d4 | 613 | type->field (i).bitsize ())) |
07a32858 TT |
614 | { |
615 | fputs_styled (_("<synthetic pointer>"), | |
616 | metadata_style.style (), stream); | |
617 | } | |
618 | else | |
619 | { | |
620 | struct value_print_options opts = *options; | |
621 | ||
622 | v = value_field_bitfield (type, i, valaddr, 0, val); | |
623 | ||
dad6b350 | 624 | opts.deref_ref = false; |
07a32858 TT |
625 | common_val_print (v, stream, recurse + 1, &opts, |
626 | current_language); | |
627 | } | |
628 | } | |
629 | else | |
630 | { | |
20aadb93 | 631 | if (type->field (i).is_ignored ()) |
07a32858 TT |
632 | { |
633 | fputs_styled ("<optimized out or zero length>", | |
634 | metadata_style.style (), stream); | |
635 | } | |
c819a338 | 636 | else if (type->field (i).is_static ()) |
07a32858 TT |
637 | { |
638 | /* struct value *v = value_static_field (type, i); | |
639 | v4.17 specific. */ | |
640 | struct value *v; | |
641 | ||
642 | v = value_field_bitfield (type, i, valaddr, 0, val); | |
643 | ||
644 | if (v == NULL) | |
645 | val_print_optimized_out (NULL, stream); | |
646 | else | |
647 | pascal_object_print_static_field (v, stream, recurse + 1, | |
648 | options); | |
649 | } | |
650 | else | |
651 | { | |
652 | struct value_print_options opts = *options; | |
653 | ||
dad6b350 | 654 | opts.deref_ref = false; |
07a32858 | 655 | |
6c49729e TT |
656 | struct value *v = val->primitive_field (0, i, |
657 | val->type ()); | |
07a32858 TT |
658 | common_val_print (v, stream, recurse + 1, &opts, |
659 | current_language); | |
660 | } | |
661 | } | |
662 | annotate_field_end (); | |
663 | } | |
664 | ||
665 | if (dont_print_statmem == 0) | |
666 | { | |
667 | /* Free the space used to deal with the printing | |
668 | of the members from top level. */ | |
669 | obstack_free (&dont_print_statmem_obstack, last_dont_print); | |
670 | dont_print_statmem_obstack = tmp_obstack; | |
671 | } | |
672 | ||
673 | if (options->prettyformat) | |
674 | { | |
6cb06a8c | 675 | gdb_printf (stream, "\n"); |
d0b1020b | 676 | print_spaces (2 * recurse, stream); |
07a32858 TT |
677 | } |
678 | } | |
6cb06a8c | 679 | gdb_printf (stream, "}"); |
07a32858 TT |
680 | } |
681 | ||
07a32858 TT |
682 | /* Special val_print routine to avoid printing multiple copies of virtual |
683 | baseclasses. */ | |
684 | ||
685 | static void | |
686 | pascal_object_print_value (struct value *val, struct ui_file *stream, | |
687 | int recurse, | |
688 | const struct value_print_options *options, | |
689 | struct type **dont_print_vb) | |
690 | { | |
691 | struct type **last_dont_print | |
692 | = (struct type **) obstack_next_free (&dont_print_vb_obstack); | |
693 | struct obstack tmp_obstack = dont_print_vb_obstack; | |
d0c97917 | 694 | struct type *type = check_typedef (val->type ()); |
07a32858 TT |
695 | int i, n_baseclasses = TYPE_N_BASECLASSES (type); |
696 | ||
697 | if (dont_print_vb == 0) | |
698 | { | |
699 | /* If we're at top level, carve out a completely fresh | |
dda83cd7 SM |
700 | chunk of the obstack and use that until this particular |
701 | invocation returns. */ | |
07a32858 TT |
702 | /* Bump up the high-water mark. Now alpha is omega. */ |
703 | obstack_finish (&dont_print_vb_obstack); | |
704 | } | |
705 | ||
706 | for (i = 0; i < n_baseclasses; i++) | |
707 | { | |
708 | LONGEST boffset = 0; | |
709 | struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i)); | |
7d93a1e0 | 710 | const char *basename = baseclass->name (); |
07a32858 TT |
711 | int skip = 0; |
712 | ||
713 | if (BASETYPE_VIA_VIRTUAL (type, i)) | |
714 | { | |
715 | struct type **first_dont_print | |
716 | = (struct type **) obstack_base (&dont_print_vb_obstack); | |
717 | ||
718 | int j = (struct type **) obstack_next_free (&dont_print_vb_obstack) | |
719 | - first_dont_print; | |
720 | ||
721 | while (--j >= 0) | |
722 | if (baseclass == first_dont_print[j]) | |
723 | goto flush_it; | |
724 | ||
725 | obstack_ptr_grow (&dont_print_vb_obstack, baseclass); | |
726 | } | |
727 | ||
728 | struct value *base_value; | |
729 | try | |
730 | { | |
6c49729e | 731 | base_value = val->primitive_field (0, i, type); |
07a32858 TT |
732 | } |
733 | catch (const gdb_exception_error &ex) | |
734 | { | |
771dd3a8 | 735 | base_value = nullptr; |
07a32858 TT |
736 | if (ex.error == NOT_AVAILABLE_ERROR) |
737 | skip = -1; | |
738 | else | |
739 | skip = 1; | |
740 | } | |
741 | ||
742 | if (skip == 0) | |
743 | { | |
744 | /* The virtual base class pointer might have been clobbered by the | |
745 | user program. Make sure that it still points to a valid memory | |
746 | location. */ | |
747 | ||
df86565b | 748 | if (boffset < 0 || boffset >= type->length ()) |
07a32858 | 749 | { |
9feb2d07 | 750 | CORE_ADDR address= val->address (); |
df86565b | 751 | gdb::byte_vector buf (baseclass->length ()); |
07a32858 TT |
752 | |
753 | if (target_read_memory (address + boffset, buf.data (), | |
df86565b | 754 | baseclass->length ()) != 0) |
07a32858 TT |
755 | skip = 1; |
756 | base_value = value_from_contents_and_address (baseclass, | |
757 | buf.data (), | |
758 | address + boffset); | |
d0c97917 | 759 | baseclass = base_value->type (); |
07a32858 TT |
760 | boffset = 0; |
761 | } | |
762 | } | |
763 | ||
764 | if (options->prettyformat) | |
765 | { | |
6cb06a8c | 766 | gdb_printf (stream, "\n"); |
d0b1020b | 767 | print_spaces (2 * recurse, stream); |
07a32858 | 768 | } |
0426ad51 | 769 | gdb_puts ("<", stream); |
07a32858 | 770 | /* Not sure what the best notation is in the case where there is no |
dda83cd7 | 771 | baseclass name. */ |
07a32858 | 772 | |
0426ad51 TT |
773 | gdb_puts (basename ? basename : "", stream); |
774 | gdb_puts ("> = ", stream); | |
07a32858 TT |
775 | |
776 | if (skip < 0) | |
777 | val_print_unavailable (stream); | |
778 | else if (skip > 0) | |
779 | val_print_invalid_address (stream); | |
780 | else | |
781 | pascal_object_print_value_fields | |
782 | (base_value, stream, recurse, options, | |
783 | (struct type **) obstack_base (&dont_print_vb_obstack), | |
784 | 0); | |
0426ad51 | 785 | gdb_puts (", ", stream); |
07a32858 TT |
786 | |
787 | flush_it: | |
788 | ; | |
789 | } | |
790 | ||
791 | if (dont_print_vb == 0) | |
792 | { | |
793 | /* Free the space used to deal with the printing | |
dda83cd7 | 794 | of this type from top level. */ |
07a32858 TT |
795 | obstack_free (&dont_print_vb_obstack, last_dont_print); |
796 | /* Reset watermark so that we can continue protecting | |
dda83cd7 | 797 | ourselves from whatever we were protecting ourselves. */ |
07a32858 TT |
798 | dont_print_vb_obstack = tmp_obstack; |
799 | } | |
800 | } | |
801 | ||
373a8247 PM |
802 | /* Print value of a static member. |
803 | To avoid infinite recursion when printing a class that contains | |
804 | a static instance of the class, we keep the addresses of all printed | |
805 | static member classes in an obstack and refuse to print them more | |
806 | than once. | |
807 | ||
79a45b7d | 808 | VAL contains the value to print, STREAM, RECURSE, and OPTIONS |
373a8247 PM |
809 | have the same meanings as in c_val_print. */ |
810 | ||
811 | static void | |
806048c6 | 812 | pascal_object_print_static_field (struct value *val, |
79a45b7d TT |
813 | struct ui_file *stream, |
814 | int recurse, | |
815 | const struct value_print_options *options) | |
373a8247 | 816 | { |
d0c97917 | 817 | struct type *type = val->type (); |
79a45b7d | 818 | struct value_print_options opts; |
806048c6 | 819 | |
d00664db | 820 | if (val->entirely_optimized_out ()) |
686d4def PA |
821 | { |
822 | val_print_optimized_out (val, stream); | |
823 | return; | |
824 | } | |
825 | ||
78134374 | 826 | if (type->code () == TYPE_CODE_STRUCT) |
373a8247 | 827 | { |
42ae5230 | 828 | CORE_ADDR *first_dont_print, addr; |
373a8247 PM |
829 | int i; |
830 | ||
831 | first_dont_print | |
832 | = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack); | |
833 | i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack) | |
834 | - first_dont_print; | |
835 | ||
836 | while (--i >= 0) | |
837 | { | |
9feb2d07 | 838 | if (val->address () == first_dont_print[i]) |
373a8247 | 839 | { |
2dbc041e TT |
840 | fputs_styled (_("\ |
841 | <same as static member of an already seen type>"), | |
842 | metadata_style.style (), stream); | |
373a8247 PM |
843 | return; |
844 | } | |
845 | } | |
846 | ||
9feb2d07 | 847 | addr = val->address (); |
42ae5230 | 848 | obstack_grow (&dont_print_statmem_obstack, (char *) &addr, |
373a8247 PM |
849 | sizeof (CORE_ADDR)); |
850 | ||
f168693b | 851 | type = check_typedef (type); |
426a9c18 TT |
852 | pascal_object_print_value_fields (val, stream, recurse, |
853 | options, NULL, 1); | |
373a8247 PM |
854 | return; |
855 | } | |
79a45b7d TT |
856 | |
857 | opts = *options; | |
dad6b350 | 858 | opts.deref_ref = false; |
79a45b7d | 859 | common_val_print (val, stream, recurse, &opts, current_language); |
373a8247 PM |
860 | } |
861 | ||
6c265988 | 862 | void _initialize_pascal_valprint (); |
373a8247 | 863 | void |
6c265988 | 864 | _initialize_pascal_valprint () |
373a8247 | 865 | { |
5bf193a2 | 866 | add_setshow_boolean_cmd ("pascal_static-members", class_support, |
79a45b7d | 867 | &user_print_options.pascal_static_field_print, _("\ |
5bf193a2 AC |
868 | Set printing of pascal static members."), _("\ |
869 | Show printing of pascal static members."), NULL, | |
870 | NULL, | |
920d2a44 | 871 | show_pascal_static_field_print, |
5bf193a2 | 872 | &setprintlist, &showprintlist); |
373a8247 | 873 | } |