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

Subversion Repositories or1k

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

powered by: WebSVN 2.1.0

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