OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.3/] [gdb/] [p-valprint.c] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 1181 sfurman
/* Support for printing Pascal values for GDB, the GNU debugger.
2
   Copyright 2000, 2001
3
   Free Software Foundation, Inc.
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
9
   the Free Software Foundation; either version 2 of the License, or
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
18
   along with this program; if not, write to the Free Software
19
   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
20
 
21
/* This file is derived from c-valprint.c */
22
 
23
#include "defs.h"
24
#include "gdb_obstack.h"
25
#include "symtab.h"
26
#include "gdbtypes.h"
27
#include "expression.h"
28
#include "value.h"
29
#include "command.h"
30
#include "gdbcmd.h"
31
#include "gdbcore.h"
32
#include "demangle.h"
33
#include "valprint.h"
34
#include "typeprint.h"
35
#include "language.h"
36
#include "target.h"
37
#include "annotate.h"
38
#include "p-lang.h"
39
#include "cp-abi.h"
40
 
41
 
42
 
43
 
44
/* Print data of type TYPE located at VALADDR (within GDB), which came from
45
   the inferior at address ADDRESS, onto stdio stream STREAM according to
46
   FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
47
   target byte order.
48
 
49
   If the data are a string pointer, returns the number of string characters
50
   printed.
51
 
52
   If DEREF_REF is nonzero, then dereference references, otherwise just print
53
   them like pointers.
54
 
55
   The PRETTY parameter controls prettyprinting.  */
56
 
57
 
58
int
59
pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
60
                  CORE_ADDR address, struct ui_file *stream, int format,
61
                  int deref_ref, int recurse, enum val_prettyprint pretty)
62
{
63
  register unsigned int i = 0;   /* Number of characters printed */
64
  unsigned len;
65
  struct type *elttype;
66
  unsigned eltlen;
67
  int length_pos, length_size, string_pos;
68
  int char_size;
69
  LONGEST val;
70
  CORE_ADDR addr;
71
 
72
  CHECK_TYPEDEF (type);
73
  switch (TYPE_CODE (type))
74
    {
75
    case TYPE_CODE_ARRAY:
76
      if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
77
        {
78
          elttype = check_typedef (TYPE_TARGET_TYPE (type));
79
          eltlen = TYPE_LENGTH (elttype);
80
          len = TYPE_LENGTH (type) / eltlen;
81
          if (prettyprint_arrays)
82
            {
83
              print_spaces_filtered (2 + 2 * recurse, stream);
84
            }
85
          /* For an array of chars, print with string syntax.  */
86
          if (eltlen == 1 &&
87
              ((TYPE_CODE (elttype) == TYPE_CODE_INT)
88
               || ((current_language->la_language == language_m2)
89
                   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
90
              && (format == 0 || format == 's'))
91
            {
92
              /* If requested, look for the first null char and only print
93
                 elements up to it.  */
94
              if (stop_print_at_null)
95
                {
96
                  unsigned int temp_len;
97
 
98
                  /* Look for a NULL char. */
99
                  for (temp_len = 0;
100
                       (valaddr + embedded_offset)[temp_len]
101
                       && temp_len < len && temp_len < print_max;
102
                       temp_len++);
103
                  len = temp_len;
104
                }
105
 
106
              LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0);
107
              i = len;
108
            }
109
          else
110
            {
111
              fprintf_filtered (stream, "{");
112
              /* If this is a virtual function table, print the 0th
113
                 entry specially, and the rest of the members normally.  */
114
              if (pascal_object_is_vtbl_ptr_type (elttype))
115
                {
116
                  i = 1;
117
                  fprintf_filtered (stream, "%d vtable entries", len - 1);
118
                }
119
              else
120
                {
121
                  i = 0;
122
                }
123
              val_print_array_elements (type, valaddr + embedded_offset, address, stream,
124
                                     format, deref_ref, recurse, pretty, i);
125
              fprintf_filtered (stream, "}");
126
            }
127
          break;
128
        }
129
      /* Array of unspecified length: treat like pointer to first elt.  */
130
      addr = address;
131
      goto print_unpacked_pointer;
132
 
133
    case TYPE_CODE_PTR:
134
      if (format && format != 's')
135
        {
136
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
137
          break;
138
        }
139
      if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
140
        {
141
          /* Print the unmangled name if desired.  */
142
          /* Print vtable entry - we only get here if we ARE using
143
             -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.) */
144
          print_address_demangle (extract_address (valaddr + embedded_offset, TYPE_LENGTH (type)),
145
                                  stream, demangle);
146
          break;
147
        }
148
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
149
      if (TYPE_CODE (elttype) == TYPE_CODE_METHOD)
150
        {
151
          pascal_object_print_class_method (valaddr + embedded_offset, type, stream);
152
        }
153
      else if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
154
        {
155
          pascal_object_print_class_member (valaddr + embedded_offset,
156
                                 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type)),
157
                                            stream, "&");
158
        }
159
      else
160
        {
161
          addr = unpack_pointer (type, valaddr + embedded_offset);
162
        print_unpacked_pointer:
163
          elttype = check_typedef (TYPE_TARGET_TYPE (type));
164
 
165
          if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
166
            {
167
              /* Try to print what function it points to.  */
168
              print_address_demangle (addr, stream, demangle);
169
              /* Return value is irrelevant except for string pointers.  */
170
              return (0);
171
            }
172
 
173
          if (addressprint && format != 's')
174
            {
175
              print_address_numeric (addr, 1, stream);
176
            }
177
 
178
          /* For a pointer to char or unsigned char, also print the string
179
             pointed to, unless pointer is null.  */
180
          if (TYPE_LENGTH (elttype) == 1
181
              && TYPE_CODE (elttype) == TYPE_CODE_INT
182
              && (format == 0 || format == 's')
183
              && addr != 0)
184
            {
185
              /* no wide string yet */
186
              i = val_print_string (addr, -1, 1, stream);
187
            }
188
          /* also for pointers to pascal strings */
189
          /* Note: this is Free Pascal specific:
190
             as GDB does not recognize stabs pascal strings
191
             Pascal strings are mapped to records
192
             with lowercase names PM  */
193
          if (is_pascal_string_type (elttype, &length_pos, &length_size,
194
                                     &string_pos, &char_size, NULL)
195
              && addr != 0)
196
            {
197
              ULONGEST string_length;
198
              void *buffer;
199
              buffer = xmalloc (length_size);
200
              read_memory (addr + length_pos, buffer, length_size);
201
              string_length = extract_unsigned_integer (buffer, length_size);
202
              xfree (buffer);
203
              i = val_print_string (addr + string_pos, string_length, char_size, stream);
204
            }
205
          else if (pascal_object_is_vtbl_member (type))
206
            {
207
              /* print vtbl's nicely */
208
              CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
209
 
210
              struct minimal_symbol *msymbol =
211
              lookup_minimal_symbol_by_pc (vt_address);
212
              if ((msymbol != NULL)
213
                  && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
214
                {
215
                  fputs_filtered (" <", stream);
216
                  fputs_filtered (SYMBOL_SOURCE_NAME (msymbol), stream);
217
                  fputs_filtered (">", stream);
218
                }
219
              if (vt_address && vtblprint)
220
                {
221
                  struct value *vt_val;
222
                  struct symbol *wsym = (struct symbol *) NULL;
223
                  struct type *wtype;
224
                  struct symtab *s;
225
                  struct block *block = (struct block *) NULL;
226
                  int is_this_fld;
227
 
228
                  if (msymbol != NULL)
229
                    wsym = lookup_symbol (SYMBOL_NAME (msymbol), block,
230
                                          VAR_NAMESPACE, &is_this_fld, &s);
231
 
232
                  if (wsym)
233
                    {
234
                      wtype = SYMBOL_TYPE (wsym);
235
                    }
236
                  else
237
                    {
238
                      wtype = TYPE_TARGET_TYPE (type);
239
                    }
240
                  vt_val = value_at (wtype, vt_address, NULL);
241
                  val_print (VALUE_TYPE (vt_val), VALUE_CONTENTS (vt_val), 0,
242
                             VALUE_ADDRESS (vt_val), stream, format,
243
                             deref_ref, recurse + 1, pretty);
244
                  if (pretty)
245
                    {
246
                      fprintf_filtered (stream, "\n");
247
                      print_spaces_filtered (2 + 2 * recurse, stream);
248
                    }
249
                }
250
            }
251
 
252
          /* Return number of characters printed, including the terminating
253
             '\0' if we reached the end.  val_print_string takes care including
254
             the terminating '\0' if necessary.  */
255
          return i;
256
        }
257
      break;
258
 
259
    case TYPE_CODE_MEMBER:
260
      error ("not implemented: member type in pascal_val_print");
261
      break;
262
 
263
    case TYPE_CODE_REF:
264
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
265
      if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
266
        {
267
          pascal_object_print_class_member (valaddr + embedded_offset,
268
                                            TYPE_DOMAIN_TYPE (elttype),
269
                                            stream, "");
270
          break;
271
        }
272
      if (addressprint)
273
        {
274
          fprintf_filtered (stream, "@");
275
          print_address_numeric
276
            (extract_address (valaddr + embedded_offset,
277
                              TARGET_PTR_BIT / HOST_CHAR_BIT), 1, stream);
278
          if (deref_ref)
279
            fputs_filtered (": ", stream);
280
        }
281
      /* De-reference the reference.  */
282
      if (deref_ref)
283
        {
284
          if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
285
            {
286
              struct value *deref_val =
287
              value_at
288
              (TYPE_TARGET_TYPE (type),
289
               unpack_pointer (lookup_pointer_type (builtin_type_void),
290
                               valaddr + embedded_offset),
291
               NULL);
292
              val_print (VALUE_TYPE (deref_val),
293
                         VALUE_CONTENTS (deref_val), 0,
294
                         VALUE_ADDRESS (deref_val), stream, format,
295
                         deref_ref, recurse + 1, pretty);
296
            }
297
          else
298
            fputs_filtered ("???", stream);
299
        }
300
      break;
301
 
302
    case TYPE_CODE_UNION:
303
      if (recurse && !unionprint)
304
        {
305
          fprintf_filtered (stream, "{...}");
306
          break;
307
        }
308
      /* Fall through.  */
309
    case TYPE_CODE_STRUCT:
310
      if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
311
        {
312
          /* Print the unmangled name if desired.  */
313
          /* Print vtable entry - we only get here if NOT using
314
             -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
315
          print_address_demangle (extract_address (
316
                                                    valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
317
                  TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET))),
318
                                  stream, demangle);
319
        }
320
      else
321
        {
322
          if (is_pascal_string_type (type, &length_pos, &length_size,
323
                                     &string_pos, &char_size, NULL))
324
            {
325
              len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size);
326
              LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0);
327
            }
328
          else
329
            pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream, format,
330
                                              recurse, pretty, NULL, 0);
331
        }
332
      break;
333
 
334
    case TYPE_CODE_ENUM:
335
      if (format)
336
        {
337
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
338
          break;
339
        }
340
      len = TYPE_NFIELDS (type);
341
      val = unpack_long (type, valaddr + embedded_offset);
342
      for (i = 0; i < len; i++)
343
        {
344
          QUIT;
345
          if (val == TYPE_FIELD_BITPOS (type, i))
346
            {
347
              break;
348
            }
349
        }
350
      if (i < len)
351
        {
352
          fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
353
        }
354
      else
355
        {
356
          print_longest (stream, 'd', 0, val);
357
        }
358
      break;
359
 
360
    case TYPE_CODE_FUNC:
361
      if (format)
362
        {
363
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
364
          break;
365
        }
366
      /* FIXME, we should consider, at least for ANSI C language, eliminating
367
         the distinction made between FUNCs and POINTERs to FUNCs.  */
368
      fprintf_filtered (stream, "{");
369
      type_print (type, "", stream, -1);
370
      fprintf_filtered (stream, "} ");
371
      /* Try to print what function it points to, and its address.  */
372
      print_address_demangle (address, stream, demangle);
373
      break;
374
 
375
    case TYPE_CODE_BOOL:
376
      format = format ? format : output_format;
377
      if (format)
378
        print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
379
      else
380
        {
381
          val = unpack_long (type, valaddr + embedded_offset);
382
          if (val == 0)
383
            fputs_filtered ("false", stream);
384
          else if (val == 1)
385
            fputs_filtered ("true", stream);
386
          else
387
            {
388
              fputs_filtered ("true (", stream);
389
              fprintf_filtered (stream, "%ld)", (long int) val);
390
            }
391
        }
392
      break;
393
 
394
    case TYPE_CODE_RANGE:
395
      /* FIXME: create_range_type does not set the unsigned bit in a
396
         range type (I think it probably should copy it from the target
397
         type), so we won't print values which are too large to
398
         fit in a signed integer correctly.  */
399
      /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
400
         print with the target type, though, because the size of our type
401
         and the target type might differ).  */
402
      /* FALLTHROUGH */
403
 
404
    case TYPE_CODE_INT:
405
      format = format ? format : output_format;
406
      if (format)
407
        {
408
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
409
        }
410
      else
411
        {
412
          val_print_type_code_int (type, valaddr + embedded_offset, stream);
413
        }
414
      break;
415
 
416
    case TYPE_CODE_CHAR:
417
      format = format ? format : output_format;
418
      if (format)
419
        {
420
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
421
        }
422
      else
423
        {
424
          val = unpack_long (type, valaddr + embedded_offset);
425
          if (TYPE_UNSIGNED (type))
426
            fprintf_filtered (stream, "%u", (unsigned int) val);
427
          else
428
            fprintf_filtered (stream, "%d", (int) val);
429
          fputs_filtered (" ", stream);
430
          LA_PRINT_CHAR ((unsigned char) val, stream);
431
        }
432
      break;
433
 
434
    case TYPE_CODE_FLT:
435
      if (format)
436
        {
437
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
438
        }
439
      else
440
        {
441
          print_floating (valaddr + embedded_offset, type, stream);
442
        }
443
      break;
444
 
445
    case TYPE_CODE_BITSTRING:
446
    case TYPE_CODE_SET:
447
      elttype = TYPE_INDEX_TYPE (type);
448
      CHECK_TYPEDEF (elttype);
449
      if (TYPE_STUB (elttype))
450
        {
451
          fprintf_filtered (stream, "<incomplete type>");
452
          gdb_flush (stream);
453
          break;
454
        }
455
      else
456
        {
457
          struct type *range = elttype;
458
          LONGEST low_bound, high_bound;
459
          int i;
460
          int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
461
          int need_comma = 0;
462
 
463
          if (is_bitstring)
464
            fputs_filtered ("B'", stream);
465
          else
466
            fputs_filtered ("[", stream);
467
 
468
          i = get_discrete_bounds (range, &low_bound, &high_bound);
469
        maybe_bad_bstring:
470
          if (i < 0)
471
            {
472
              fputs_filtered ("<error value>", stream);
473
              goto done;
474
            }
475
 
476
          for (i = low_bound; i <= high_bound; i++)
477
            {
478
              int element = value_bit_index (type, valaddr + embedded_offset, i);
479
              if (element < 0)
480
                {
481
                  i = element;
482
                  goto maybe_bad_bstring;
483
                }
484
              if (is_bitstring)
485
                fprintf_filtered (stream, "%d", element);
486
              else if (element)
487
                {
488
                  if (need_comma)
489
                    fputs_filtered (", ", stream);
490
                  print_type_scalar (range, i, stream);
491
                  need_comma = 1;
492
 
493
                  if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
494
                    {
495
                      int j = i;
496
                      fputs_filtered ("..", stream);
497
                      while (i + 1 <= high_bound
498
                             && value_bit_index (type, valaddr + embedded_offset, ++i))
499
                        j = i;
500
                      print_type_scalar (range, j, stream);
501
                    }
502
                }
503
            }
504
        done:
505
          if (is_bitstring)
506
            fputs_filtered ("'", stream);
507
          else
508
            fputs_filtered ("]", stream);
509
        }
510
      break;
511
 
512
    case TYPE_CODE_VOID:
513
      fprintf_filtered (stream, "void");
514
      break;
515
 
516
    case TYPE_CODE_ERROR:
517
      fprintf_filtered (stream, "<error type>");
518
      break;
519
 
520
    case TYPE_CODE_UNDEF:
521
      /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
522
         dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
523
         and no complete type for struct foo in that file.  */
524
      fprintf_filtered (stream, "<incomplete type>");
525
      break;
526
 
527
    default:
528
      error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type));
529
    }
530
  gdb_flush (stream);
531
  return (0);
532
}
533
 
534
int
535
pascal_value_print (struct value *val, struct ui_file *stream, int format,
536
                    enum val_prettyprint pretty)
537
{
538
  struct type *type = VALUE_TYPE (val);
539
 
540
  /* If it is a pointer, indicate what it points to.
541
 
542
     Print type also if it is a reference.
543
 
544
     Object pascal: if it is a member pointer, we will take care
545
     of that when we print it.  */
546
  if (TYPE_CODE (type) == TYPE_CODE_PTR ||
547
      TYPE_CODE (type) == TYPE_CODE_REF)
548
    {
549
      /* Hack:  remove (char *) for char strings.  Their
550
         type is indicated by the quoted string anyway. */
551
      if (TYPE_CODE (type) == TYPE_CODE_PTR &&
552
          TYPE_NAME (type) == NULL &&
553
          TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL &&
554
          STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char"))
555
        {
556
          /* Print nothing */
557
        }
558
      else
559
        {
560
          fprintf_filtered (stream, "(");
561
          type_print (type, "", stream, -1);
562
          fprintf_filtered (stream, ") ");
563
        }
564
    }
565
  return val_print (type, VALUE_CONTENTS (val), VALUE_EMBEDDED_OFFSET (val),
566
                    VALUE_ADDRESS (val) + VALUE_OFFSET (val),
567
                    stream, format, 1, 0, pretty);
568
}
569
 
570
 
571
/******************************************************************************
572
                    Inserted from cp-valprint
573
******************************************************************************/
574
 
575
extern int vtblprint;           /* Controls printing of vtbl's */
576
extern int objectprint;         /* Controls looking up an object's derived type
577
                                   using what we find in its vtables.  */
578
static int pascal_static_field_print;   /* Controls printing of static fields. */
579
 
580
static struct obstack dont_print_vb_obstack;
581
static struct obstack dont_print_statmem_obstack;
582
 
583
static void pascal_object_print_static_field (struct type *, struct value *,
584
                                              struct ui_file *, int, int,
585
                                              enum val_prettyprint);
586
 
587
static void
588
  pascal_object_print_value (struct type *, char *, CORE_ADDR, struct ui_file *,
589
                             int, int, enum val_prettyprint, struct type **);
590
 
591
void
592
pascal_object_print_class_method (char *valaddr, struct type *type,
593
                                  struct ui_file *stream)
594
{
595
  struct type *domain;
596
  struct fn_field *f = NULL;
597
  int j = 0;
598
  int len2;
599
  int offset;
600
  char *kind = "";
601
  CORE_ADDR addr;
602
  struct symbol *sym;
603
  unsigned len;
604
  unsigned int i;
605
  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
606
 
607
  domain = TYPE_DOMAIN_TYPE (target_type);
608
  if (domain == (struct type *) NULL)
609
    {
610
      fprintf_filtered (stream, "<unknown>");
611
      return;
612
    }
613
  addr = unpack_pointer (lookup_pointer_type (builtin_type_void), valaddr);
614
  if (METHOD_PTR_IS_VIRTUAL (addr))
615
    {
616
      offset = METHOD_PTR_TO_VOFFSET (addr);
617
      len = TYPE_NFN_FIELDS (domain);
618
      for (i = 0; i < len; i++)
619
        {
620
          f = TYPE_FN_FIELDLIST1 (domain, i);
621
          len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
622
 
623
          for (j = 0; j < len2; j++)
624
            {
625
              QUIT;
626
              if (TYPE_FN_FIELD_VOFFSET (f, j) == offset)
627
                {
628
                  if (TYPE_FN_FIELD_STUB (f, j))
629
                    check_stub_method (domain, i, j);
630
                  kind = "virtual ";
631
                  goto common;
632
                }
633
            }
634
        }
635
    }
636
  else
637
    {
638
      sym = find_pc_function (addr);
639
      if (sym == 0)
640
        {
641
          error ("invalid pointer to member function");
642
        }
643
      len = TYPE_NFN_FIELDS (domain);
644
      for (i = 0; i < len; i++)
645
        {
646
          f = TYPE_FN_FIELDLIST1 (domain, i);
647
          len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
648
 
649
          for (j = 0; j < len2; j++)
650
            {
651
              QUIT;
652
              if (TYPE_FN_FIELD_STUB (f, j))
653
                check_stub_method (domain, i, j);
654
              if (STREQ (SYMBOL_NAME (sym), TYPE_FN_FIELD_PHYSNAME (f, j)))
655
                {
656
                  goto common;
657
                }
658
            }
659
        }
660
    }
661
common:
662
  if (i < len)
663
    {
664
      char *demangled_name;
665
 
666
      fprintf_filtered (stream, "&");
667
      fprintf_filtered (stream, kind);
668
      demangled_name = cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f, j),
669
                                       DMGL_ANSI | DMGL_PARAMS);
670
      if (demangled_name == NULL)
671
        fprintf_filtered (stream, "<badly mangled name %s>",
672
                          TYPE_FN_FIELD_PHYSNAME (f, j));
673
      else
674
        {
675
          fputs_filtered (demangled_name, stream);
676
          xfree (demangled_name);
677
        }
678
    }
679
  else
680
    {
681
      fprintf_filtered (stream, "(");
682
      type_print (type, "", stream, -1);
683
      fprintf_filtered (stream, ") %d", (int) addr >> 3);
684
    }
685
}
686
 
687
/* It was changed to this after 2.4.5.  */
688
const char pascal_vtbl_ptr_name[] =
689
{'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
690
 
691
/* Return truth value for assertion that TYPE is of the type
692
   "pointer to virtual function".  */
693
 
694
int
695
pascal_object_is_vtbl_ptr_type (struct type *type)
696
{
697
  char *typename = type_name_no_tag (type);
698
 
699
  return (typename != NULL
700
          && (STREQ (typename, pascal_vtbl_ptr_name)));
701
}
702
 
703
/* Return truth value for the assertion that TYPE is of the type
704
   "pointer to virtual function table".  */
705
 
706
int
707
pascal_object_is_vtbl_member (struct type *type)
708
{
709
  if (TYPE_CODE (type) == TYPE_CODE_PTR)
710
    {
711
      type = TYPE_TARGET_TYPE (type);
712
      if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
713
        {
714
          type = TYPE_TARGET_TYPE (type);
715
          if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
716
              || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
717
            {
718
              /* Virtual functions tables are full of pointers
719
                 to virtual functions. */
720
              return pascal_object_is_vtbl_ptr_type (type);
721
            }
722
        }
723
    }
724
  return 0;
725
}
726
 
727
/* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
728
   print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
729
 
730
   TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
731
   same meanings as in pascal_object_print_value and c_val_print.
732
 
733
   DONT_PRINT is an array of baseclass types that we
734
   should not print, or zero if called from top level.  */
735
 
736
void
737
pascal_object_print_value_fields (struct type *type, char *valaddr,
738
                                  CORE_ADDR address, struct ui_file *stream,
739
                                  int format, int recurse,
740
                                  enum val_prettyprint pretty,
741
                                  struct type **dont_print_vb,
742
                                  int dont_print_statmem)
743
{
744
  int i, len, n_baseclasses;
745
  struct obstack tmp_obstack;
746
  char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
747
 
748
  CHECK_TYPEDEF (type);
749
 
750
  fprintf_filtered (stream, "{");
751
  len = TYPE_NFIELDS (type);
752
  n_baseclasses = TYPE_N_BASECLASSES (type);
753
 
754
  /* Print out baseclasses such that we don't print
755
     duplicates of virtual baseclasses.  */
756
  if (n_baseclasses > 0)
757
    pascal_object_print_value (type, valaddr, address, stream,
758
                               format, recurse + 1, pretty, dont_print_vb);
759
 
760
  if (!len && n_baseclasses == 1)
761
    fprintf_filtered (stream, "<No data fields>");
762
  else
763
    {
764
      extern int inspect_it;
765
      int fields_seen = 0;
766
 
767
      if (dont_print_statmem == 0)
768
        {
769
          /* If we're at top level, carve out a completely fresh
770
             chunk of the obstack and use that until this particular
771
             invocation returns.  */
772
          tmp_obstack = dont_print_statmem_obstack;
773
          obstack_finish (&dont_print_statmem_obstack);
774
        }
775
 
776
      for (i = n_baseclasses; i < len; i++)
777
        {
778
          /* If requested, skip printing of static fields.  */
779
          if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i))
780
            continue;
781
          if (fields_seen)
782
            fprintf_filtered (stream, ", ");
783
          else if (n_baseclasses > 0)
784
            {
785
              if (pretty)
786
                {
787
                  fprintf_filtered (stream, "\n");
788
                  print_spaces_filtered (2 + 2 * recurse, stream);
789
                  fputs_filtered ("members of ", stream);
790
                  fputs_filtered (type_name_no_tag (type), stream);
791
                  fputs_filtered (": ", stream);
792
                }
793
            }
794
          fields_seen = 1;
795
 
796
          if (pretty)
797
            {
798
              fprintf_filtered (stream, "\n");
799
              print_spaces_filtered (2 + 2 * recurse, stream);
800
            }
801
          else
802
            {
803
              wrap_here (n_spaces (2 + 2 * recurse));
804
            }
805
          if (inspect_it)
806
            {
807
              if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
808
                fputs_filtered ("\"( ptr \"", stream);
809
              else
810
                fputs_filtered ("\"( nodef \"", stream);
811
              if (TYPE_FIELD_STATIC (type, i))
812
                fputs_filtered ("static ", stream);
813
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
814
                                       language_cplus,
815
                                       DMGL_PARAMS | DMGL_ANSI);
816
              fputs_filtered ("\" \"", stream);
817
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
818
                                       language_cplus,
819
                                       DMGL_PARAMS | DMGL_ANSI);
820
              fputs_filtered ("\") \"", stream);
821
            }
822
          else
823
            {
824
              annotate_field_begin (TYPE_FIELD_TYPE (type, i));
825
 
826
              if (TYPE_FIELD_STATIC (type, i))
827
                fputs_filtered ("static ", stream);
828
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
829
                                       language_cplus,
830
                                       DMGL_PARAMS | DMGL_ANSI);
831
              annotate_field_name_end ();
832
              fputs_filtered (" = ", stream);
833
              annotate_field_value ();
834
            }
835
 
836
          if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i))
837
            {
838
              struct value *v;
839
 
840
              /* Bitfields require special handling, especially due to byte
841
                 order problems.  */
842
              if (TYPE_FIELD_IGNORE (type, i))
843
                {
844
                  fputs_filtered ("<optimized out or zero length>", stream);
845
                }
846
              else
847
                {
848
                  v = value_from_longest (TYPE_FIELD_TYPE (type, i),
849
                                   unpack_field_as_long (type, valaddr, i));
850
 
851
                  val_print (TYPE_FIELD_TYPE (type, i), VALUE_CONTENTS (v), 0, 0,
852
                             stream, format, 0, recurse + 1, pretty);
853
                }
854
            }
855
          else
856
            {
857
              if (TYPE_FIELD_IGNORE (type, i))
858
                {
859
                  fputs_filtered ("<optimized out or zero length>", stream);
860
                }
861
              else if (TYPE_FIELD_STATIC (type, i))
862
                {
863
                  /* struct value *v = value_static_field (type, i); v4.17 specific */
864
                  struct value *v;
865
                  v = value_from_longest (TYPE_FIELD_TYPE (type, i),
866
                                   unpack_field_as_long (type, valaddr, i));
867
 
868
                  if (v == NULL)
869
                    fputs_filtered ("<optimized out>", stream);
870
                  else
871
                    pascal_object_print_static_field (TYPE_FIELD_TYPE (type, i), v,
872
                                                stream, format, recurse + 1,
873
                                                      pretty);
874
                }
875
              else
876
                {
877
                  /* val_print (TYPE_FIELD_TYPE (type, i),
878
                     valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
879
                     address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
880
                     stream, format, 0, recurse + 1, pretty); */
881
                  val_print (TYPE_FIELD_TYPE (type, i),
882
                             valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
883
                             address + TYPE_FIELD_BITPOS (type, i) / 8,
884
                             stream, format, 0, recurse + 1, pretty);
885
                }
886
            }
887
          annotate_field_end ();
888
        }
889
 
890
      if (dont_print_statmem == 0)
891
        {
892
          /* Free the space used to deal with the printing
893
             of the members from top level.  */
894
          obstack_free (&dont_print_statmem_obstack, last_dont_print);
895
          dont_print_statmem_obstack = tmp_obstack;
896
        }
897
 
898
      if (pretty)
899
        {
900
          fprintf_filtered (stream, "\n");
901
          print_spaces_filtered (2 * recurse, stream);
902
        }
903
    }
904
  fprintf_filtered (stream, "}");
905
}
906
 
907
/* Special val_print routine to avoid printing multiple copies of virtual
908
   baseclasses.  */
909
 
910
void
911
pascal_object_print_value (struct type *type, char *valaddr, CORE_ADDR address,
912
                           struct ui_file *stream, int format, int recurse,
913
                           enum val_prettyprint pretty,
914
                           struct type **dont_print_vb)
915
{
916
  struct obstack tmp_obstack;
917
  struct type **last_dont_print
918
  = (struct type **) obstack_next_free (&dont_print_vb_obstack);
919
  int i, n_baseclasses = TYPE_N_BASECLASSES (type);
920
 
921
  if (dont_print_vb == 0)
922
    {
923
      /* If we're at top level, carve out a completely fresh
924
         chunk of the obstack and use that until this particular
925
         invocation returns.  */
926
      tmp_obstack = dont_print_vb_obstack;
927
      /* Bump up the high-water mark.  Now alpha is omega.  */
928
      obstack_finish (&dont_print_vb_obstack);
929
    }
930
 
931
  for (i = 0; i < n_baseclasses; i++)
932
    {
933
      int boffset;
934
      struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
935
      char *basename = TYPE_NAME (baseclass);
936
      char *base_valaddr;
937
 
938
      if (BASETYPE_VIA_VIRTUAL (type, i))
939
        {
940
          struct type **first_dont_print
941
          = (struct type **) obstack_base (&dont_print_vb_obstack);
942
 
943
          int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
944
          - first_dont_print;
945
 
946
          while (--j >= 0)
947
            if (baseclass == first_dont_print[j])
948
              goto flush_it;
949
 
950
          obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
951
        }
952
 
953
      boffset = baseclass_offset (type, i, valaddr, address);
954
 
955
      if (pretty)
956
        {
957
          fprintf_filtered (stream, "\n");
958
          print_spaces_filtered (2 * recurse, stream);
959
        }
960
      fputs_filtered ("<", stream);
961
      /* Not sure what the best notation is in the case where there is no
962
         baseclass name.  */
963
 
964
      fputs_filtered (basename ? basename : "", stream);
965
      fputs_filtered ("> = ", stream);
966
 
967
      /* The virtual base class pointer might have been clobbered by the
968
         user program. Make sure that it still points to a valid memory
969
         location.  */
970
 
971
      if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
972
        {
973
          /* FIXME (alloc): not safe is baseclass is really really big. */
974
          base_valaddr = (char *) alloca (TYPE_LENGTH (baseclass));
975
          if (target_read_memory (address + boffset, base_valaddr,
976
                                  TYPE_LENGTH (baseclass)) != 0)
977
            boffset = -1;
978
        }
979
      else
980
        base_valaddr = valaddr + boffset;
981
 
982
      if (boffset == -1)
983
        fprintf_filtered (stream, "<invalid address>");
984
      else
985
        pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
986
                                          stream, format, recurse, pretty,
987
                     (struct type **) obstack_base (&dont_print_vb_obstack),
988
                                          0);
989
      fputs_filtered (", ", stream);
990
 
991
    flush_it:
992
      ;
993
    }
994
 
995
  if (dont_print_vb == 0)
996
    {
997
      /* Free the space used to deal with the printing
998
         of this type from top level.  */
999
      obstack_free (&dont_print_vb_obstack, last_dont_print);
1000
      /* Reset watermark so that we can continue protecting
1001
         ourselves from whatever we were protecting ourselves.  */
1002
      dont_print_vb_obstack = tmp_obstack;
1003
    }
1004
}
1005
 
1006
/* Print value of a static member.
1007
   To avoid infinite recursion when printing a class that contains
1008
   a static instance of the class, we keep the addresses of all printed
1009
   static member classes in an obstack and refuse to print them more
1010
   than once.
1011
 
1012
   VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
1013
   have the same meanings as in c_val_print.  */
1014
 
1015
static void
1016
pascal_object_print_static_field (struct type *type, struct value *val,
1017
                                  struct ui_file *stream, int format,
1018
                                  int recurse, enum val_prettyprint pretty)
1019
{
1020
  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
1021
    {
1022
      CORE_ADDR *first_dont_print;
1023
      int i;
1024
 
1025
      first_dont_print
1026
        = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
1027
      i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
1028
        - first_dont_print;
1029
 
1030
      while (--i >= 0)
1031
        {
1032
          if (VALUE_ADDRESS (val) == first_dont_print[i])
1033
            {
1034
              fputs_filtered ("<same as static member of an already seen type>",
1035
                              stream);
1036
              return;
1037
            }
1038
        }
1039
 
1040
      obstack_grow (&dont_print_statmem_obstack, (char *) &VALUE_ADDRESS (val),
1041
                    sizeof (CORE_ADDR));
1042
 
1043
      CHECK_TYPEDEF (type);
1044
      pascal_object_print_value_fields (type, VALUE_CONTENTS (val), VALUE_ADDRESS (val),
1045
                                  stream, format, recurse, pretty, NULL, 1);
1046
      return;
1047
    }
1048
  val_print (type, VALUE_CONTENTS (val), 0, VALUE_ADDRESS (val),
1049
             stream, format, 0, recurse, pretty);
1050
}
1051
 
1052
void
1053
pascal_object_print_class_member (char *valaddr, struct type *domain,
1054
                                  struct ui_file *stream, char *prefix)
1055
{
1056
 
1057
  /* VAL is a byte offset into the structure type DOMAIN.
1058
     Find the name of the field for that offset and
1059
     print it.  */
1060
  int extra = 0;
1061
  int bits = 0;
1062
  register unsigned int i;
1063
  unsigned len = TYPE_NFIELDS (domain);
1064
  /* @@ Make VAL into bit offset */
1065
  LONGEST val = unpack_long (builtin_type_int, valaddr) << 3;
1066
  for (i = TYPE_N_BASECLASSES (domain); i < len; i++)
1067
    {
1068
      int bitpos = TYPE_FIELD_BITPOS (domain, i);
1069
      QUIT;
1070
      if (val == bitpos)
1071
        break;
1072
      if (val < bitpos && i != 0)
1073
        {
1074
          /* Somehow pointing into a field.  */
1075
          i -= 1;
1076
          extra = (val - TYPE_FIELD_BITPOS (domain, i));
1077
          if (extra & 0x7)
1078
            bits = 1;
1079
          else
1080
            extra >>= 3;
1081
          break;
1082
        }
1083
    }
1084
  if (i < len)
1085
    {
1086
      char *name;
1087
      fprintf_filtered (stream, prefix);
1088
      name = type_name_no_tag (domain);
1089
      if (name)
1090
        fputs_filtered (name, stream);
1091
      else
1092
        pascal_type_print_base (domain, stream, 0, 0);
1093
      fprintf_filtered (stream, "::");
1094
      fputs_filtered (TYPE_FIELD_NAME (domain, i), stream);
1095
      if (extra)
1096
        fprintf_filtered (stream, " + %d bytes", extra);
1097
      if (bits)
1098
        fprintf_filtered (stream, " (offset in bits)");
1099
    }
1100
  else
1101
    fprintf_filtered (stream, "%ld", (long int) (val >> 3));
1102
}
1103
 
1104
 
1105
void
1106
_initialize_pascal_valprint (void)
1107
{
1108
  add_show_from_set
1109
    (add_set_cmd ("pascal_static-members", class_support, var_boolean,
1110
                  (char *) &pascal_static_field_print,
1111
                  "Set printing of pascal static members.",
1112
                  &setprintlist),
1113
     &showprintlist);
1114
  /* Turn on printing of static fields.  */
1115
  pascal_static_field_print = 1;
1116
 
1117
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.