gdb/p-valprint.c

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