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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.3/] [gdb/] [p-valprint.c] - Diff between revs 1181 and 1765

Only display areas with differences | Details | Blame | View Log

Rev 1181 Rev 1765
/* Support for printing Pascal values for GDB, the GNU debugger.
/* Support for printing Pascal values for GDB, the GNU debugger.
   Copyright 2000, 2001
   Copyright 2000, 2001
   Free Software Foundation, Inc.
   Free Software Foundation, Inc.
 
 
   This file is part of GDB.
   This file is part of GDB.
 
 
   This program is free software; you can redistribute it and/or modify
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.
   (at your option) any later version.
 
 
   This program is distributed in the hope that it will be useful,
   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
   GNU General Public License for more details.
 
 
   You should have received a copy of the GNU General Public License
   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 
 
/* This file is derived from c-valprint.c */
/* This file is derived from c-valprint.c */
 
 
#include "defs.h"
#include "defs.h"
#include "gdb_obstack.h"
#include "gdb_obstack.h"
#include "symtab.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "gdbtypes.h"
#include "expression.h"
#include "expression.h"
#include "value.h"
#include "value.h"
#include "command.h"
#include "command.h"
#include "gdbcmd.h"
#include "gdbcmd.h"
#include "gdbcore.h"
#include "gdbcore.h"
#include "demangle.h"
#include "demangle.h"
#include "valprint.h"
#include "valprint.h"
#include "typeprint.h"
#include "typeprint.h"
#include "language.h"
#include "language.h"
#include "target.h"
#include "target.h"
#include "annotate.h"
#include "annotate.h"
#include "p-lang.h"
#include "p-lang.h"
#include "cp-abi.h"
#include "cp-abi.h"


 
 
 
 
 
 
/* Print data of type TYPE located at VALADDR (within GDB), which came from
/* Print data of type TYPE located at VALADDR (within GDB), which came from
   the inferior at address ADDRESS, onto stdio stream STREAM according to
   the inferior at address ADDRESS, onto stdio stream STREAM according to
   FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
   FORMAT (a letter or 0 for natural format).  The data at VALADDR is in
   target byte order.
   target byte order.
 
 
   If the data are a string pointer, returns the number of string characters
   If the data are a string pointer, returns the number of string characters
   printed.
   printed.
 
 
   If DEREF_REF is nonzero, then dereference references, otherwise just print
   If DEREF_REF is nonzero, then dereference references, otherwise just print
   them like pointers.
   them like pointers.
 
 
   The PRETTY parameter controls prettyprinting.  */
   The PRETTY parameter controls prettyprinting.  */
 
 
 
 
int
int
pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
pascal_val_print (struct type *type, char *valaddr, int embedded_offset,
                  CORE_ADDR address, struct ui_file *stream, int format,
                  CORE_ADDR address, struct ui_file *stream, int format,
                  int deref_ref, int recurse, enum val_prettyprint pretty)
                  int deref_ref, int recurse, enum val_prettyprint pretty)
{
{
  register unsigned int i = 0;   /* Number of characters printed */
  register unsigned int i = 0;   /* Number of characters printed */
  unsigned len;
  unsigned len;
  struct type *elttype;
  struct type *elttype;
  unsigned eltlen;
  unsigned eltlen;
  int length_pos, length_size, string_pos;
  int length_pos, length_size, string_pos;
  int char_size;
  int char_size;
  LONGEST val;
  LONGEST val;
  CORE_ADDR addr;
  CORE_ADDR addr;
 
 
  CHECK_TYPEDEF (type);
  CHECK_TYPEDEF (type);
  switch (TYPE_CODE (type))
  switch (TYPE_CODE (type))
    {
    {
    case TYPE_CODE_ARRAY:
    case TYPE_CODE_ARRAY:
      if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
      if (TYPE_LENGTH (type) > 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0)
        {
        {
          elttype = check_typedef (TYPE_TARGET_TYPE (type));
          elttype = check_typedef (TYPE_TARGET_TYPE (type));
          eltlen = TYPE_LENGTH (elttype);
          eltlen = TYPE_LENGTH (elttype);
          len = TYPE_LENGTH (type) / eltlen;
          len = TYPE_LENGTH (type) / eltlen;
          if (prettyprint_arrays)
          if (prettyprint_arrays)
            {
            {
              print_spaces_filtered (2 + 2 * recurse, stream);
              print_spaces_filtered (2 + 2 * recurse, stream);
            }
            }
          /* For an array of chars, print with string syntax.  */
          /* For an array of chars, print with string syntax.  */
          if (eltlen == 1 &&
          if (eltlen == 1 &&
              ((TYPE_CODE (elttype) == TYPE_CODE_INT)
              ((TYPE_CODE (elttype) == TYPE_CODE_INT)
               || ((current_language->la_language == language_m2)
               || ((current_language->la_language == language_m2)
                   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
                   && (TYPE_CODE (elttype) == TYPE_CODE_CHAR)))
              && (format == 0 || format == 's'))
              && (format == 0 || format == 's'))
            {
            {
              /* If requested, look for the first null char and only print
              /* If requested, look for the first null char and only print
                 elements up to it.  */
                 elements up to it.  */
              if (stop_print_at_null)
              if (stop_print_at_null)
                {
                {
                  unsigned int temp_len;
                  unsigned int temp_len;
 
 
                  /* Look for a NULL char. */
                  /* Look for a NULL char. */
                  for (temp_len = 0;
                  for (temp_len = 0;
                       (valaddr + embedded_offset)[temp_len]
                       (valaddr + embedded_offset)[temp_len]
                       && temp_len < len && temp_len < print_max;
                       && temp_len < len && temp_len < print_max;
                       temp_len++);
                       temp_len++);
                  len = temp_len;
                  len = temp_len;
                }
                }
 
 
              LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0);
              LA_PRINT_STRING (stream, valaddr + embedded_offset, len, 1, 0);
              i = len;
              i = len;
            }
            }
          else
          else
            {
            {
              fprintf_filtered (stream, "{");
              fprintf_filtered (stream, "{");
              /* If this is a virtual function table, print the 0th
              /* If this is a virtual function table, print the 0th
                 entry specially, and the rest of the members normally.  */
                 entry specially, and the rest of the members normally.  */
              if (pascal_object_is_vtbl_ptr_type (elttype))
              if (pascal_object_is_vtbl_ptr_type (elttype))
                {
                {
                  i = 1;
                  i = 1;
                  fprintf_filtered (stream, "%d vtable entries", len - 1);
                  fprintf_filtered (stream, "%d vtable entries", len - 1);
                }
                }
              else
              else
                {
                {
                  i = 0;
                  i = 0;
                }
                }
              val_print_array_elements (type, valaddr + embedded_offset, address, stream,
              val_print_array_elements (type, valaddr + embedded_offset, address, stream,
                                     format, deref_ref, recurse, pretty, i);
                                     format, deref_ref, recurse, pretty, i);
              fprintf_filtered (stream, "}");
              fprintf_filtered (stream, "}");
            }
            }
          break;
          break;
        }
        }
      /* Array of unspecified length: treat like pointer to first elt.  */
      /* Array of unspecified length: treat like pointer to first elt.  */
      addr = address;
      addr = address;
      goto print_unpacked_pointer;
      goto print_unpacked_pointer;
 
 
    case TYPE_CODE_PTR:
    case TYPE_CODE_PTR:
      if (format && format != 's')
      if (format && format != 's')
        {
        {
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          break;
          break;
        }
        }
      if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
      if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
        {
        {
          /* Print the unmangled name if desired.  */
          /* Print the unmangled name if desired.  */
          /* Print vtable entry - we only get here if we ARE using
          /* Print vtable entry - we only get here if we ARE using
             -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.) */
             -fvtable_thunks.  (Otherwise, look under TYPE_CODE_STRUCT.) */
          print_address_demangle (extract_address (valaddr + embedded_offset, TYPE_LENGTH (type)),
          print_address_demangle (extract_address (valaddr + embedded_offset, TYPE_LENGTH (type)),
                                  stream, demangle);
                                  stream, demangle);
          break;
          break;
        }
        }
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
      if (TYPE_CODE (elttype) == TYPE_CODE_METHOD)
      if (TYPE_CODE (elttype) == TYPE_CODE_METHOD)
        {
        {
          pascal_object_print_class_method (valaddr + embedded_offset, type, stream);
          pascal_object_print_class_method (valaddr + embedded_offset, type, stream);
        }
        }
      else if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
      else if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
        {
        {
          pascal_object_print_class_member (valaddr + embedded_offset,
          pascal_object_print_class_member (valaddr + embedded_offset,
                                 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type)),
                                 TYPE_DOMAIN_TYPE (TYPE_TARGET_TYPE (type)),
                                            stream, "&");
                                            stream, "&");
        }
        }
      else
      else
        {
        {
          addr = unpack_pointer (type, valaddr + embedded_offset);
          addr = unpack_pointer (type, valaddr + embedded_offset);
        print_unpacked_pointer:
        print_unpacked_pointer:
          elttype = check_typedef (TYPE_TARGET_TYPE (type));
          elttype = check_typedef (TYPE_TARGET_TYPE (type));
 
 
          if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
          if (TYPE_CODE (elttype) == TYPE_CODE_FUNC)
            {
            {
              /* Try to print what function it points to.  */
              /* Try to print what function it points to.  */
              print_address_demangle (addr, stream, demangle);
              print_address_demangle (addr, stream, demangle);
              /* Return value is irrelevant except for string pointers.  */
              /* Return value is irrelevant except for string pointers.  */
              return (0);
              return (0);
            }
            }
 
 
          if (addressprint && format != 's')
          if (addressprint && format != 's')
            {
            {
              print_address_numeric (addr, 1, stream);
              print_address_numeric (addr, 1, stream);
            }
            }
 
 
          /* For a pointer to char or unsigned char, also print the string
          /* For a pointer to char or unsigned char, also print the string
             pointed to, unless pointer is null.  */
             pointed to, unless pointer is null.  */
          if (TYPE_LENGTH (elttype) == 1
          if (TYPE_LENGTH (elttype) == 1
              && TYPE_CODE (elttype) == TYPE_CODE_INT
              && TYPE_CODE (elttype) == TYPE_CODE_INT
              && (format == 0 || format == 's')
              && (format == 0 || format == 's')
              && addr != 0)
              && addr != 0)
            {
            {
              /* no wide string yet */
              /* no wide string yet */
              i = val_print_string (addr, -1, 1, stream);
              i = val_print_string (addr, -1, 1, stream);
            }
            }
          /* also for pointers to pascal strings */
          /* also for pointers to pascal strings */
          /* Note: this is Free Pascal specific:
          /* Note: this is Free Pascal specific:
             as GDB does not recognize stabs pascal strings
             as GDB does not recognize stabs pascal strings
             Pascal strings are mapped to records
             Pascal strings are mapped to records
             with lowercase names PM  */
             with lowercase names PM  */
          if (is_pascal_string_type (elttype, &length_pos, &length_size,
          if (is_pascal_string_type (elttype, &length_pos, &length_size,
                                     &string_pos, &char_size, NULL)
                                     &string_pos, &char_size, NULL)
              && addr != 0)
              && addr != 0)
            {
            {
              ULONGEST string_length;
              ULONGEST string_length;
              void *buffer;
              void *buffer;
              buffer = xmalloc (length_size);
              buffer = xmalloc (length_size);
              read_memory (addr + length_pos, buffer, length_size);
              read_memory (addr + length_pos, buffer, length_size);
              string_length = extract_unsigned_integer (buffer, length_size);
              string_length = extract_unsigned_integer (buffer, length_size);
              xfree (buffer);
              xfree (buffer);
              i = val_print_string (addr + string_pos, string_length, char_size, stream);
              i = val_print_string (addr + string_pos, string_length, char_size, stream);
            }
            }
          else if (pascal_object_is_vtbl_member (type))
          else if (pascal_object_is_vtbl_member (type))
            {
            {
              /* print vtbl's nicely */
              /* print vtbl's nicely */
              CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
              CORE_ADDR vt_address = unpack_pointer (type, valaddr + embedded_offset);
 
 
              struct minimal_symbol *msymbol =
              struct minimal_symbol *msymbol =
              lookup_minimal_symbol_by_pc (vt_address);
              lookup_minimal_symbol_by_pc (vt_address);
              if ((msymbol != NULL)
              if ((msymbol != NULL)
                  && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
                  && (vt_address == SYMBOL_VALUE_ADDRESS (msymbol)))
                {
                {
                  fputs_filtered (" <", stream);
                  fputs_filtered (" <", stream);
                  fputs_filtered (SYMBOL_SOURCE_NAME (msymbol), stream);
                  fputs_filtered (SYMBOL_SOURCE_NAME (msymbol), stream);
                  fputs_filtered (">", stream);
                  fputs_filtered (">", stream);
                }
                }
              if (vt_address && vtblprint)
              if (vt_address && vtblprint)
                {
                {
                  struct value *vt_val;
                  struct value *vt_val;
                  struct symbol *wsym = (struct symbol *) NULL;
                  struct symbol *wsym = (struct symbol *) NULL;
                  struct type *wtype;
                  struct type *wtype;
                  struct symtab *s;
                  struct symtab *s;
                  struct block *block = (struct block *) NULL;
                  struct block *block = (struct block *) NULL;
                  int is_this_fld;
                  int is_this_fld;
 
 
                  if (msymbol != NULL)
                  if (msymbol != NULL)
                    wsym = lookup_symbol (SYMBOL_NAME (msymbol), block,
                    wsym = lookup_symbol (SYMBOL_NAME (msymbol), block,
                                          VAR_NAMESPACE, &is_this_fld, &s);
                                          VAR_NAMESPACE, &is_this_fld, &s);
 
 
                  if (wsym)
                  if (wsym)
                    {
                    {
                      wtype = SYMBOL_TYPE (wsym);
                      wtype = SYMBOL_TYPE (wsym);
                    }
                    }
                  else
                  else
                    {
                    {
                      wtype = TYPE_TARGET_TYPE (type);
                      wtype = TYPE_TARGET_TYPE (type);
                    }
                    }
                  vt_val = value_at (wtype, vt_address, NULL);
                  vt_val = value_at (wtype, vt_address, NULL);
                  val_print (VALUE_TYPE (vt_val), VALUE_CONTENTS (vt_val), 0,
                  val_print (VALUE_TYPE (vt_val), VALUE_CONTENTS (vt_val), 0,
                             VALUE_ADDRESS (vt_val), stream, format,
                             VALUE_ADDRESS (vt_val), stream, format,
                             deref_ref, recurse + 1, pretty);
                             deref_ref, recurse + 1, pretty);
                  if (pretty)
                  if (pretty)
                    {
                    {
                      fprintf_filtered (stream, "\n");
                      fprintf_filtered (stream, "\n");
                      print_spaces_filtered (2 + 2 * recurse, stream);
                      print_spaces_filtered (2 + 2 * recurse, stream);
                    }
                    }
                }
                }
            }
            }
 
 
          /* Return number of characters printed, including the terminating
          /* Return number of characters printed, including the terminating
             '\0' if we reached the end.  val_print_string takes care including
             '\0' if we reached the end.  val_print_string takes care including
             the terminating '\0' if necessary.  */
             the terminating '\0' if necessary.  */
          return i;
          return i;
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_MEMBER:
    case TYPE_CODE_MEMBER:
      error ("not implemented: member type in pascal_val_print");
      error ("not implemented: member type in pascal_val_print");
      break;
      break;
 
 
    case TYPE_CODE_REF:
    case TYPE_CODE_REF:
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
      if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
      if (TYPE_CODE (elttype) == TYPE_CODE_MEMBER)
        {
        {
          pascal_object_print_class_member (valaddr + embedded_offset,
          pascal_object_print_class_member (valaddr + embedded_offset,
                                            TYPE_DOMAIN_TYPE (elttype),
                                            TYPE_DOMAIN_TYPE (elttype),
                                            stream, "");
                                            stream, "");
          break;
          break;
        }
        }
      if (addressprint)
      if (addressprint)
        {
        {
          fprintf_filtered (stream, "@");
          fprintf_filtered (stream, "@");
          print_address_numeric
          print_address_numeric
            (extract_address (valaddr + embedded_offset,
            (extract_address (valaddr + embedded_offset,
                              TARGET_PTR_BIT / HOST_CHAR_BIT), 1, stream);
                              TARGET_PTR_BIT / HOST_CHAR_BIT), 1, stream);
          if (deref_ref)
          if (deref_ref)
            fputs_filtered (": ", stream);
            fputs_filtered (": ", stream);
        }
        }
      /* De-reference the reference.  */
      /* De-reference the reference.  */
      if (deref_ref)
      if (deref_ref)
        {
        {
          if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
          if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
            {
            {
              struct value *deref_val =
              struct value *deref_val =
              value_at
              value_at
              (TYPE_TARGET_TYPE (type),
              (TYPE_TARGET_TYPE (type),
               unpack_pointer (lookup_pointer_type (builtin_type_void),
               unpack_pointer (lookup_pointer_type (builtin_type_void),
                               valaddr + embedded_offset),
                               valaddr + embedded_offset),
               NULL);
               NULL);
              val_print (VALUE_TYPE (deref_val),
              val_print (VALUE_TYPE (deref_val),
                         VALUE_CONTENTS (deref_val), 0,
                         VALUE_CONTENTS (deref_val), 0,
                         VALUE_ADDRESS (deref_val), stream, format,
                         VALUE_ADDRESS (deref_val), stream, format,
                         deref_ref, recurse + 1, pretty);
                         deref_ref, recurse + 1, pretty);
            }
            }
          else
          else
            fputs_filtered ("???", stream);
            fputs_filtered ("???", stream);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_UNION:
    case TYPE_CODE_UNION:
      if (recurse && !unionprint)
      if (recurse && !unionprint)
        {
        {
          fprintf_filtered (stream, "{...}");
          fprintf_filtered (stream, "{...}");
          break;
          break;
        }
        }
      /* Fall through.  */
      /* Fall through.  */
    case TYPE_CODE_STRUCT:
    case TYPE_CODE_STRUCT:
      if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
      if (vtblprint && pascal_object_is_vtbl_ptr_type (type))
        {
        {
          /* Print the unmangled name if desired.  */
          /* Print the unmangled name if desired.  */
          /* Print vtable entry - we only get here if NOT using
          /* Print vtable entry - we only get here if NOT using
             -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
             -fvtable_thunks.  (Otherwise, look under TYPE_CODE_PTR.) */
          print_address_demangle (extract_address (
          print_address_demangle (extract_address (
                                                    valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
                                                    valaddr + embedded_offset + TYPE_FIELD_BITPOS (type, VTBL_FNADDR_OFFSET) / 8,
                  TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET))),
                  TYPE_LENGTH (TYPE_FIELD_TYPE (type, VTBL_FNADDR_OFFSET))),
                                  stream, demangle);
                                  stream, demangle);
        }
        }
      else
      else
        {
        {
          if (is_pascal_string_type (type, &length_pos, &length_size,
          if (is_pascal_string_type (type, &length_pos, &length_size,
                                     &string_pos, &char_size, NULL))
                                     &string_pos, &char_size, NULL))
            {
            {
              len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size);
              len = extract_unsigned_integer (valaddr + embedded_offset + length_pos, length_size);
              LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0);
              LA_PRINT_STRING (stream, valaddr + embedded_offset + string_pos, len, char_size, 0);
            }
            }
          else
          else
            pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream, format,
            pascal_object_print_value_fields (type, valaddr + embedded_offset, address, stream, format,
                                              recurse, pretty, NULL, 0);
                                              recurse, pretty, NULL, 0);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_ENUM:
    case TYPE_CODE_ENUM:
      if (format)
      if (format)
        {
        {
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          break;
          break;
        }
        }
      len = TYPE_NFIELDS (type);
      len = TYPE_NFIELDS (type);
      val = unpack_long (type, valaddr + embedded_offset);
      val = unpack_long (type, valaddr + embedded_offset);
      for (i = 0; i < len; i++)
      for (i = 0; i < len; i++)
        {
        {
          QUIT;
          QUIT;
          if (val == TYPE_FIELD_BITPOS (type, i))
          if (val == TYPE_FIELD_BITPOS (type, i))
            {
            {
              break;
              break;
            }
            }
        }
        }
      if (i < len)
      if (i < len)
        {
        {
          fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
          fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
        }
        }
      else
      else
        {
        {
          print_longest (stream, 'd', 0, val);
          print_longest (stream, 'd', 0, val);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_FUNC:
    case TYPE_CODE_FUNC:
      if (format)
      if (format)
        {
        {
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          break;
          break;
        }
        }
      /* FIXME, we should consider, at least for ANSI C language, eliminating
      /* FIXME, we should consider, at least for ANSI C language, eliminating
         the distinction made between FUNCs and POINTERs to FUNCs.  */
         the distinction made between FUNCs and POINTERs to FUNCs.  */
      fprintf_filtered (stream, "{");
      fprintf_filtered (stream, "{");
      type_print (type, "", stream, -1);
      type_print (type, "", stream, -1);
      fprintf_filtered (stream, "} ");
      fprintf_filtered (stream, "} ");
      /* Try to print what function it points to, and its address.  */
      /* Try to print what function it points to, and its address.  */
      print_address_demangle (address, stream, demangle);
      print_address_demangle (address, stream, demangle);
      break;
      break;
 
 
    case TYPE_CODE_BOOL:
    case TYPE_CODE_BOOL:
      format = format ? format : output_format;
      format = format ? format : output_format;
      if (format)
      if (format)
        print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
        print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
      else
      else
        {
        {
          val = unpack_long (type, valaddr + embedded_offset);
          val = unpack_long (type, valaddr + embedded_offset);
          if (val == 0)
          if (val == 0)
            fputs_filtered ("false", stream);
            fputs_filtered ("false", stream);
          else if (val == 1)
          else if (val == 1)
            fputs_filtered ("true", stream);
            fputs_filtered ("true", stream);
          else
          else
            {
            {
              fputs_filtered ("true (", stream);
              fputs_filtered ("true (", stream);
              fprintf_filtered (stream, "%ld)", (long int) val);
              fprintf_filtered (stream, "%ld)", (long int) val);
            }
            }
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_RANGE:
    case TYPE_CODE_RANGE:
      /* FIXME: create_range_type does not set the unsigned bit in a
      /* FIXME: create_range_type does not set the unsigned bit in a
         range type (I think it probably should copy it from the target
         range type (I think it probably should copy it from the target
         type), so we won't print values which are too large to
         type), so we won't print values which are too large to
         fit in a signed integer correctly.  */
         fit in a signed integer correctly.  */
      /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
      /* FIXME: Doesn't handle ranges of enums correctly.  (Can't just
         print with the target type, though, because the size of our type
         print with the target type, though, because the size of our type
         and the target type might differ).  */
         and the target type might differ).  */
      /* FALLTHROUGH */
      /* FALLTHROUGH */
 
 
    case TYPE_CODE_INT:
    case TYPE_CODE_INT:
      format = format ? format : output_format;
      format = format ? format : output_format;
      if (format)
      if (format)
        {
        {
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
        }
        }
      else
      else
        {
        {
          val_print_type_code_int (type, valaddr + embedded_offset, stream);
          val_print_type_code_int (type, valaddr + embedded_offset, stream);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_CHAR:
    case TYPE_CODE_CHAR:
      format = format ? format : output_format;
      format = format ? format : output_format;
      if (format)
      if (format)
        {
        {
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
        }
        }
      else
      else
        {
        {
          val = unpack_long (type, valaddr + embedded_offset);
          val = unpack_long (type, valaddr + embedded_offset);
          if (TYPE_UNSIGNED (type))
          if (TYPE_UNSIGNED (type))
            fprintf_filtered (stream, "%u", (unsigned int) val);
            fprintf_filtered (stream, "%u", (unsigned int) val);
          else
          else
            fprintf_filtered (stream, "%d", (int) val);
            fprintf_filtered (stream, "%d", (int) val);
          fputs_filtered (" ", stream);
          fputs_filtered (" ", stream);
          LA_PRINT_CHAR ((unsigned char) val, stream);
          LA_PRINT_CHAR ((unsigned char) val, stream);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_FLT:
    case TYPE_CODE_FLT:
      if (format)
      if (format)
        {
        {
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
          print_scalar_formatted (valaddr + embedded_offset, type, format, 0, stream);
        }
        }
      else
      else
        {
        {
          print_floating (valaddr + embedded_offset, type, stream);
          print_floating (valaddr + embedded_offset, type, stream);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_BITSTRING:
    case TYPE_CODE_SET:
    case TYPE_CODE_SET:
      elttype = TYPE_INDEX_TYPE (type);
      elttype = TYPE_INDEX_TYPE (type);
      CHECK_TYPEDEF (elttype);
      CHECK_TYPEDEF (elttype);
      if (TYPE_STUB (elttype))
      if (TYPE_STUB (elttype))
        {
        {
          fprintf_filtered (stream, "<incomplete type>");
          fprintf_filtered (stream, "<incomplete type>");
          gdb_flush (stream);
          gdb_flush (stream);
          break;
          break;
        }
        }
      else
      else
        {
        {
          struct type *range = elttype;
          struct type *range = elttype;
          LONGEST low_bound, high_bound;
          LONGEST low_bound, high_bound;
          int i;
          int i;
          int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
          int is_bitstring = TYPE_CODE (type) == TYPE_CODE_BITSTRING;
          int need_comma = 0;
          int need_comma = 0;
 
 
          if (is_bitstring)
          if (is_bitstring)
            fputs_filtered ("B'", stream);
            fputs_filtered ("B'", stream);
          else
          else
            fputs_filtered ("[", stream);
            fputs_filtered ("[", stream);
 
 
          i = get_discrete_bounds (range, &low_bound, &high_bound);
          i = get_discrete_bounds (range, &low_bound, &high_bound);
        maybe_bad_bstring:
        maybe_bad_bstring:
          if (i < 0)
          if (i < 0)
            {
            {
              fputs_filtered ("<error value>", stream);
              fputs_filtered ("<error value>", stream);
              goto done;
              goto done;
            }
            }
 
 
          for (i = low_bound; i <= high_bound; i++)
          for (i = low_bound; i <= high_bound; i++)
            {
            {
              int element = value_bit_index (type, valaddr + embedded_offset, i);
              int element = value_bit_index (type, valaddr + embedded_offset, i);
              if (element < 0)
              if (element < 0)
                {
                {
                  i = element;
                  i = element;
                  goto maybe_bad_bstring;
                  goto maybe_bad_bstring;
                }
                }
              if (is_bitstring)
              if (is_bitstring)
                fprintf_filtered (stream, "%d", element);
                fprintf_filtered (stream, "%d", element);
              else if (element)
              else if (element)
                {
                {
                  if (need_comma)
                  if (need_comma)
                    fputs_filtered (", ", stream);
                    fputs_filtered (", ", stream);
                  print_type_scalar (range, i, stream);
                  print_type_scalar (range, i, stream);
                  need_comma = 1;
                  need_comma = 1;
 
 
                  if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
                  if (i + 1 <= high_bound && value_bit_index (type, valaddr + embedded_offset, ++i))
                    {
                    {
                      int j = i;
                      int j = i;
                      fputs_filtered ("..", stream);
                      fputs_filtered ("..", stream);
                      while (i + 1 <= high_bound
                      while (i + 1 <= high_bound
                             && value_bit_index (type, valaddr + embedded_offset, ++i))
                             && value_bit_index (type, valaddr + embedded_offset, ++i))
                        j = i;
                        j = i;
                      print_type_scalar (range, j, stream);
                      print_type_scalar (range, j, stream);
                    }
                    }
                }
                }
            }
            }
        done:
        done:
          if (is_bitstring)
          if (is_bitstring)
            fputs_filtered ("'", stream);
            fputs_filtered ("'", stream);
          else
          else
            fputs_filtered ("]", stream);
            fputs_filtered ("]", stream);
        }
        }
      break;
      break;
 
 
    case TYPE_CODE_VOID:
    case TYPE_CODE_VOID:
      fprintf_filtered (stream, "void");
      fprintf_filtered (stream, "void");
      break;
      break;
 
 
    case TYPE_CODE_ERROR:
    case TYPE_CODE_ERROR:
      fprintf_filtered (stream, "<error type>");
      fprintf_filtered (stream, "<error type>");
      break;
      break;
 
 
    case TYPE_CODE_UNDEF:
    case TYPE_CODE_UNDEF:
      /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
      /* This happens (without TYPE_FLAG_STUB set) on systems which don't use
         dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
         dbx xrefs (NO_DBX_XREFS in gcc) if a file has a "struct foo *bar"
         and no complete type for struct foo in that file.  */
         and no complete type for struct foo in that file.  */
      fprintf_filtered (stream, "<incomplete type>");
      fprintf_filtered (stream, "<incomplete type>");
      break;
      break;
 
 
    default:
    default:
      error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type));
      error ("Invalid pascal type code %d in symbol table.", TYPE_CODE (type));
    }
    }
  gdb_flush (stream);
  gdb_flush (stream);
  return (0);
  return (0);
}
}


int
int
pascal_value_print (struct value *val, struct ui_file *stream, int format,
pascal_value_print (struct value *val, struct ui_file *stream, int format,
                    enum val_prettyprint pretty)
                    enum val_prettyprint pretty)
{
{
  struct type *type = VALUE_TYPE (val);
  struct type *type = VALUE_TYPE (val);
 
 
  /* If it is a pointer, indicate what it points to.
  /* If it is a pointer, indicate what it points to.
 
 
     Print type also if it is a reference.
     Print type also if it is a reference.
 
 
     Object pascal: if it is a member pointer, we will take care
     Object pascal: if it is a member pointer, we will take care
     of that when we print it.  */
     of that when we print it.  */
  if (TYPE_CODE (type) == TYPE_CODE_PTR ||
  if (TYPE_CODE (type) == TYPE_CODE_PTR ||
      TYPE_CODE (type) == TYPE_CODE_REF)
      TYPE_CODE (type) == TYPE_CODE_REF)
    {
    {
      /* Hack:  remove (char *) for char strings.  Their
      /* Hack:  remove (char *) for char strings.  Their
         type is indicated by the quoted string anyway. */
         type is indicated by the quoted string anyway. */
      if (TYPE_CODE (type) == TYPE_CODE_PTR &&
      if (TYPE_CODE (type) == TYPE_CODE_PTR &&
          TYPE_NAME (type) == NULL &&
          TYPE_NAME (type) == NULL &&
          TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL &&
          TYPE_NAME (TYPE_TARGET_TYPE (type)) != NULL &&
          STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char"))
          STREQ (TYPE_NAME (TYPE_TARGET_TYPE (type)), "char"))
        {
        {
          /* Print nothing */
          /* Print nothing */
        }
        }
      else
      else
        {
        {
          fprintf_filtered (stream, "(");
          fprintf_filtered (stream, "(");
          type_print (type, "", stream, -1);
          type_print (type, "", stream, -1);
          fprintf_filtered (stream, ") ");
          fprintf_filtered (stream, ") ");
        }
        }
    }
    }
  return val_print (type, VALUE_CONTENTS (val), VALUE_EMBEDDED_OFFSET (val),
  return val_print (type, VALUE_CONTENTS (val), VALUE_EMBEDDED_OFFSET (val),
                    VALUE_ADDRESS (val) + VALUE_OFFSET (val),
                    VALUE_ADDRESS (val) + VALUE_OFFSET (val),
                    stream, format, 1, 0, pretty);
                    stream, format, 1, 0, pretty);
}
}
 
 
 
 
/******************************************************************************
/******************************************************************************
                    Inserted from cp-valprint
                    Inserted from cp-valprint
******************************************************************************/
******************************************************************************/
 
 
extern int vtblprint;           /* Controls printing of vtbl's */
extern int vtblprint;           /* Controls printing of vtbl's */
extern int objectprint;         /* Controls looking up an object's derived type
extern int objectprint;         /* Controls looking up an object's derived type
                                   using what we find in its vtables.  */
                                   using what we find in its vtables.  */
static int pascal_static_field_print;   /* Controls printing of static fields. */
static int pascal_static_field_print;   /* Controls printing of static fields. */
 
 
static struct obstack dont_print_vb_obstack;
static struct obstack dont_print_vb_obstack;
static struct obstack dont_print_statmem_obstack;
static struct obstack dont_print_statmem_obstack;
 
 
static void pascal_object_print_static_field (struct type *, struct value *,
static void pascal_object_print_static_field (struct type *, struct value *,
                                              struct ui_file *, int, int,
                                              struct ui_file *, int, int,
                                              enum val_prettyprint);
                                              enum val_prettyprint);
 
 
static void
static void
  pascal_object_print_value (struct type *, char *, CORE_ADDR, struct ui_file *,
  pascal_object_print_value (struct type *, char *, CORE_ADDR, struct ui_file *,
                             int, int, enum val_prettyprint, struct type **);
                             int, int, enum val_prettyprint, struct type **);
 
 
void
void
pascal_object_print_class_method (char *valaddr, struct type *type,
pascal_object_print_class_method (char *valaddr, struct type *type,
                                  struct ui_file *stream)
                                  struct ui_file *stream)
{
{
  struct type *domain;
  struct type *domain;
  struct fn_field *f = NULL;
  struct fn_field *f = NULL;
  int j = 0;
  int j = 0;
  int len2;
  int len2;
  int offset;
  int offset;
  char *kind = "";
  char *kind = "";
  CORE_ADDR addr;
  CORE_ADDR addr;
  struct symbol *sym;
  struct symbol *sym;
  unsigned len;
  unsigned len;
  unsigned int i;
  unsigned int i;
  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
  struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type));
 
 
  domain = TYPE_DOMAIN_TYPE (target_type);
  domain = TYPE_DOMAIN_TYPE (target_type);
  if (domain == (struct type *) NULL)
  if (domain == (struct type *) NULL)
    {
    {
      fprintf_filtered (stream, "<unknown>");
      fprintf_filtered (stream, "<unknown>");
      return;
      return;
    }
    }
  addr = unpack_pointer (lookup_pointer_type (builtin_type_void), valaddr);
  addr = unpack_pointer (lookup_pointer_type (builtin_type_void), valaddr);
  if (METHOD_PTR_IS_VIRTUAL (addr))
  if (METHOD_PTR_IS_VIRTUAL (addr))
    {
    {
      offset = METHOD_PTR_TO_VOFFSET (addr);
      offset = METHOD_PTR_TO_VOFFSET (addr);
      len = TYPE_NFN_FIELDS (domain);
      len = TYPE_NFN_FIELDS (domain);
      for (i = 0; i < len; i++)
      for (i = 0; i < len; i++)
        {
        {
          f = TYPE_FN_FIELDLIST1 (domain, i);
          f = TYPE_FN_FIELDLIST1 (domain, i);
          len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
          len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
 
 
          for (j = 0; j < len2; j++)
          for (j = 0; j < len2; j++)
            {
            {
              QUIT;
              QUIT;
              if (TYPE_FN_FIELD_VOFFSET (f, j) == offset)
              if (TYPE_FN_FIELD_VOFFSET (f, j) == offset)
                {
                {
                  if (TYPE_FN_FIELD_STUB (f, j))
                  if (TYPE_FN_FIELD_STUB (f, j))
                    check_stub_method (domain, i, j);
                    check_stub_method (domain, i, j);
                  kind = "virtual ";
                  kind = "virtual ";
                  goto common;
                  goto common;
                }
                }
            }
            }
        }
        }
    }
    }
  else
  else
    {
    {
      sym = find_pc_function (addr);
      sym = find_pc_function (addr);
      if (sym == 0)
      if (sym == 0)
        {
        {
          error ("invalid pointer to member function");
          error ("invalid pointer to member function");
        }
        }
      len = TYPE_NFN_FIELDS (domain);
      len = TYPE_NFN_FIELDS (domain);
      for (i = 0; i < len; i++)
      for (i = 0; i < len; i++)
        {
        {
          f = TYPE_FN_FIELDLIST1 (domain, i);
          f = TYPE_FN_FIELDLIST1 (domain, i);
          len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
          len2 = TYPE_FN_FIELDLIST_LENGTH (domain, i);
 
 
          for (j = 0; j < len2; j++)
          for (j = 0; j < len2; j++)
            {
            {
              QUIT;
              QUIT;
              if (TYPE_FN_FIELD_STUB (f, j))
              if (TYPE_FN_FIELD_STUB (f, j))
                check_stub_method (domain, i, j);
                check_stub_method (domain, i, j);
              if (STREQ (SYMBOL_NAME (sym), TYPE_FN_FIELD_PHYSNAME (f, j)))
              if (STREQ (SYMBOL_NAME (sym), TYPE_FN_FIELD_PHYSNAME (f, j)))
                {
                {
                  goto common;
                  goto common;
                }
                }
            }
            }
        }
        }
    }
    }
common:
common:
  if (i < len)
  if (i < len)
    {
    {
      char *demangled_name;
      char *demangled_name;
 
 
      fprintf_filtered (stream, "&");
      fprintf_filtered (stream, "&");
      fprintf_filtered (stream, kind);
      fprintf_filtered (stream, kind);
      demangled_name = cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f, j),
      demangled_name = cplus_demangle (TYPE_FN_FIELD_PHYSNAME (f, j),
                                       DMGL_ANSI | DMGL_PARAMS);
                                       DMGL_ANSI | DMGL_PARAMS);
      if (demangled_name == NULL)
      if (demangled_name == NULL)
        fprintf_filtered (stream, "<badly mangled name %s>",
        fprintf_filtered (stream, "<badly mangled name %s>",
                          TYPE_FN_FIELD_PHYSNAME (f, j));
                          TYPE_FN_FIELD_PHYSNAME (f, j));
      else
      else
        {
        {
          fputs_filtered (demangled_name, stream);
          fputs_filtered (demangled_name, stream);
          xfree (demangled_name);
          xfree (demangled_name);
        }
        }
    }
    }
  else
  else
    {
    {
      fprintf_filtered (stream, "(");
      fprintf_filtered (stream, "(");
      type_print (type, "", stream, -1);
      type_print (type, "", stream, -1);
      fprintf_filtered (stream, ") %d", (int) addr >> 3);
      fprintf_filtered (stream, ") %d", (int) addr >> 3);
    }
    }
}
}
 
 
/* It was changed to this after 2.4.5.  */
/* It was changed to this after 2.4.5.  */
const char pascal_vtbl_ptr_name[] =
const char pascal_vtbl_ptr_name[] =
{'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
{'_', '_', 'v', 't', 'b', 'l', '_', 'p', 't', 'r', '_', 't', 'y', 'p', 'e', 0};
 
 
/* Return truth value for assertion that TYPE is of the type
/* Return truth value for assertion that TYPE is of the type
   "pointer to virtual function".  */
   "pointer to virtual function".  */
 
 
int
int
pascal_object_is_vtbl_ptr_type (struct type *type)
pascal_object_is_vtbl_ptr_type (struct type *type)
{
{
  char *typename = type_name_no_tag (type);
  char *typename = type_name_no_tag (type);
 
 
  return (typename != NULL
  return (typename != NULL
          && (STREQ (typename, pascal_vtbl_ptr_name)));
          && (STREQ (typename, pascal_vtbl_ptr_name)));
}
}
 
 
/* Return truth value for the assertion that TYPE is of the type
/* Return truth value for the assertion that TYPE is of the type
   "pointer to virtual function table".  */
   "pointer to virtual function table".  */
 
 
int
int
pascal_object_is_vtbl_member (struct type *type)
pascal_object_is_vtbl_member (struct type *type)
{
{
  if (TYPE_CODE (type) == TYPE_CODE_PTR)
  if (TYPE_CODE (type) == TYPE_CODE_PTR)
    {
    {
      type = TYPE_TARGET_TYPE (type);
      type = TYPE_TARGET_TYPE (type);
      if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
      if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
        {
        {
          type = TYPE_TARGET_TYPE (type);
          type = TYPE_TARGET_TYPE (type);
          if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
          if (TYPE_CODE (type) == TYPE_CODE_STRUCT      /* if not using thunks */
              || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
              || TYPE_CODE (type) == TYPE_CODE_PTR)     /* if using thunks */
            {
            {
              /* Virtual functions tables are full of pointers
              /* Virtual functions tables are full of pointers
                 to virtual functions. */
                 to virtual functions. */
              return pascal_object_is_vtbl_ptr_type (type);
              return pascal_object_is_vtbl_ptr_type (type);
            }
            }
        }
        }
    }
    }
  return 0;
  return 0;
}
}
 
 
/* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
/* Mutually recursive subroutines of pascal_object_print_value and c_val_print to
   print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
   print out a structure's fields: pascal_object_print_value_fields and pascal_object_print_value.
 
 
   TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
   TYPE, VALADDR, ADDRESS, STREAM, RECURSE, and PRETTY have the
   same meanings as in pascal_object_print_value and c_val_print.
   same meanings as in pascal_object_print_value and c_val_print.
 
 
   DONT_PRINT is an array of baseclass types that we
   DONT_PRINT is an array of baseclass types that we
   should not print, or zero if called from top level.  */
   should not print, or zero if called from top level.  */
 
 
void
void
pascal_object_print_value_fields (struct type *type, char *valaddr,
pascal_object_print_value_fields (struct type *type, char *valaddr,
                                  CORE_ADDR address, struct ui_file *stream,
                                  CORE_ADDR address, struct ui_file *stream,
                                  int format, int recurse,
                                  int format, int recurse,
                                  enum val_prettyprint pretty,
                                  enum val_prettyprint pretty,
                                  struct type **dont_print_vb,
                                  struct type **dont_print_vb,
                                  int dont_print_statmem)
                                  int dont_print_statmem)
{
{
  int i, len, n_baseclasses;
  int i, len, n_baseclasses;
  struct obstack tmp_obstack;
  struct obstack tmp_obstack;
  char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
  char *last_dont_print = obstack_next_free (&dont_print_statmem_obstack);
 
 
  CHECK_TYPEDEF (type);
  CHECK_TYPEDEF (type);
 
 
  fprintf_filtered (stream, "{");
  fprintf_filtered (stream, "{");
  len = TYPE_NFIELDS (type);
  len = TYPE_NFIELDS (type);
  n_baseclasses = TYPE_N_BASECLASSES (type);
  n_baseclasses = TYPE_N_BASECLASSES (type);
 
 
  /* Print out baseclasses such that we don't print
  /* Print out baseclasses such that we don't print
     duplicates of virtual baseclasses.  */
     duplicates of virtual baseclasses.  */
  if (n_baseclasses > 0)
  if (n_baseclasses > 0)
    pascal_object_print_value (type, valaddr, address, stream,
    pascal_object_print_value (type, valaddr, address, stream,
                               format, recurse + 1, pretty, dont_print_vb);
                               format, recurse + 1, pretty, dont_print_vb);
 
 
  if (!len && n_baseclasses == 1)
  if (!len && n_baseclasses == 1)
    fprintf_filtered (stream, "<No data fields>");
    fprintf_filtered (stream, "<No data fields>");
  else
  else
    {
    {
      extern int inspect_it;
      extern int inspect_it;
      int fields_seen = 0;
      int fields_seen = 0;
 
 
      if (dont_print_statmem == 0)
      if (dont_print_statmem == 0)
        {
        {
          /* If we're at top level, carve out a completely fresh
          /* If we're at top level, carve out a completely fresh
             chunk of the obstack and use that until this particular
             chunk of the obstack and use that until this particular
             invocation returns.  */
             invocation returns.  */
          tmp_obstack = dont_print_statmem_obstack;
          tmp_obstack = dont_print_statmem_obstack;
          obstack_finish (&dont_print_statmem_obstack);
          obstack_finish (&dont_print_statmem_obstack);
        }
        }
 
 
      for (i = n_baseclasses; i < len; i++)
      for (i = n_baseclasses; i < len; i++)
        {
        {
          /* If requested, skip printing of static fields.  */
          /* If requested, skip printing of static fields.  */
          if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i))
          if (!pascal_static_field_print && TYPE_FIELD_STATIC (type, i))
            continue;
            continue;
          if (fields_seen)
          if (fields_seen)
            fprintf_filtered (stream, ", ");
            fprintf_filtered (stream, ", ");
          else if (n_baseclasses > 0)
          else if (n_baseclasses > 0)
            {
            {
              if (pretty)
              if (pretty)
                {
                {
                  fprintf_filtered (stream, "\n");
                  fprintf_filtered (stream, "\n");
                  print_spaces_filtered (2 + 2 * recurse, stream);
                  print_spaces_filtered (2 + 2 * recurse, stream);
                  fputs_filtered ("members of ", stream);
                  fputs_filtered ("members of ", stream);
                  fputs_filtered (type_name_no_tag (type), stream);
                  fputs_filtered (type_name_no_tag (type), stream);
                  fputs_filtered (": ", stream);
                  fputs_filtered (": ", stream);
                }
                }
            }
            }
          fields_seen = 1;
          fields_seen = 1;
 
 
          if (pretty)
          if (pretty)
            {
            {
              fprintf_filtered (stream, "\n");
              fprintf_filtered (stream, "\n");
              print_spaces_filtered (2 + 2 * recurse, stream);
              print_spaces_filtered (2 + 2 * recurse, stream);
            }
            }
          else
          else
            {
            {
              wrap_here (n_spaces (2 + 2 * recurse));
              wrap_here (n_spaces (2 + 2 * recurse));
            }
            }
          if (inspect_it)
          if (inspect_it)
            {
            {
              if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
              if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) == TYPE_CODE_PTR)
                fputs_filtered ("\"( ptr \"", stream);
                fputs_filtered ("\"( ptr \"", stream);
              else
              else
                fputs_filtered ("\"( nodef \"", stream);
                fputs_filtered ("\"( nodef \"", stream);
              if (TYPE_FIELD_STATIC (type, i))
              if (TYPE_FIELD_STATIC (type, i))
                fputs_filtered ("static ", stream);
                fputs_filtered ("static ", stream);
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
                                       language_cplus,
                                       language_cplus,
                                       DMGL_PARAMS | DMGL_ANSI);
                                       DMGL_PARAMS | DMGL_ANSI);
              fputs_filtered ("\" \"", stream);
              fputs_filtered ("\" \"", stream);
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
                                       language_cplus,
                                       language_cplus,
                                       DMGL_PARAMS | DMGL_ANSI);
                                       DMGL_PARAMS | DMGL_ANSI);
              fputs_filtered ("\") \"", stream);
              fputs_filtered ("\") \"", stream);
            }
            }
          else
          else
            {
            {
              annotate_field_begin (TYPE_FIELD_TYPE (type, i));
              annotate_field_begin (TYPE_FIELD_TYPE (type, i));
 
 
              if (TYPE_FIELD_STATIC (type, i))
              if (TYPE_FIELD_STATIC (type, i))
                fputs_filtered ("static ", stream);
                fputs_filtered ("static ", stream);
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
              fprintf_symbol_filtered (stream, TYPE_FIELD_NAME (type, i),
                                       language_cplus,
                                       language_cplus,
                                       DMGL_PARAMS | DMGL_ANSI);
                                       DMGL_PARAMS | DMGL_ANSI);
              annotate_field_name_end ();
              annotate_field_name_end ();
              fputs_filtered (" = ", stream);
              fputs_filtered (" = ", stream);
              annotate_field_value ();
              annotate_field_value ();
            }
            }
 
 
          if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i))
          if (!TYPE_FIELD_STATIC (type, i) && TYPE_FIELD_PACKED (type, i))
            {
            {
              struct value *v;
              struct value *v;
 
 
              /* Bitfields require special handling, especially due to byte
              /* Bitfields require special handling, especially due to byte
                 order problems.  */
                 order problems.  */
              if (TYPE_FIELD_IGNORE (type, i))
              if (TYPE_FIELD_IGNORE (type, i))
                {
                {
                  fputs_filtered ("<optimized out or zero length>", stream);
                  fputs_filtered ("<optimized out or zero length>", stream);
                }
                }
              else
              else
                {
                {
                  v = value_from_longest (TYPE_FIELD_TYPE (type, i),
                  v = value_from_longest (TYPE_FIELD_TYPE (type, i),
                                   unpack_field_as_long (type, valaddr, i));
                                   unpack_field_as_long (type, valaddr, i));
 
 
                  val_print (TYPE_FIELD_TYPE (type, i), VALUE_CONTENTS (v), 0, 0,
                  val_print (TYPE_FIELD_TYPE (type, i), VALUE_CONTENTS (v), 0, 0,
                             stream, format, 0, recurse + 1, pretty);
                             stream, format, 0, recurse + 1, pretty);
                }
                }
            }
            }
          else
          else
            {
            {
              if (TYPE_FIELD_IGNORE (type, i))
              if (TYPE_FIELD_IGNORE (type, i))
                {
                {
                  fputs_filtered ("<optimized out or zero length>", stream);
                  fputs_filtered ("<optimized out or zero length>", stream);
                }
                }
              else if (TYPE_FIELD_STATIC (type, i))
              else if (TYPE_FIELD_STATIC (type, i))
                {
                {
                  /* struct value *v = value_static_field (type, i); v4.17 specific */
                  /* struct value *v = value_static_field (type, i); v4.17 specific */
                  struct value *v;
                  struct value *v;
                  v = value_from_longest (TYPE_FIELD_TYPE (type, i),
                  v = value_from_longest (TYPE_FIELD_TYPE (type, i),
                                   unpack_field_as_long (type, valaddr, i));
                                   unpack_field_as_long (type, valaddr, i));
 
 
                  if (v == NULL)
                  if (v == NULL)
                    fputs_filtered ("<optimized out>", stream);
                    fputs_filtered ("<optimized out>", stream);
                  else
                  else
                    pascal_object_print_static_field (TYPE_FIELD_TYPE (type, i), v,
                    pascal_object_print_static_field (TYPE_FIELD_TYPE (type, i), v,
                                                stream, format, recurse + 1,
                                                stream, format, recurse + 1,
                                                      pretty);
                                                      pretty);
                }
                }
              else
              else
                {
                {
                  /* val_print (TYPE_FIELD_TYPE (type, i),
                  /* val_print (TYPE_FIELD_TYPE (type, i),
                     valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
                     valaddr + TYPE_FIELD_BITPOS (type, i) / 8,
                     address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
                     address + TYPE_FIELD_BITPOS (type, i) / 8, 0,
                     stream, format, 0, recurse + 1, pretty); */
                     stream, format, 0, recurse + 1, pretty); */
                  val_print (TYPE_FIELD_TYPE (type, i),
                  val_print (TYPE_FIELD_TYPE (type, i),
                             valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
                             valaddr, TYPE_FIELD_BITPOS (type, i) / 8,
                             address + TYPE_FIELD_BITPOS (type, i) / 8,
                             address + TYPE_FIELD_BITPOS (type, i) / 8,
                             stream, format, 0, recurse + 1, pretty);
                             stream, format, 0, recurse + 1, pretty);
                }
                }
            }
            }
          annotate_field_end ();
          annotate_field_end ();
        }
        }
 
 
      if (dont_print_statmem == 0)
      if (dont_print_statmem == 0)
        {
        {
          /* Free the space used to deal with the printing
          /* Free the space used to deal with the printing
             of the members from top level.  */
             of the members from top level.  */
          obstack_free (&dont_print_statmem_obstack, last_dont_print);
          obstack_free (&dont_print_statmem_obstack, last_dont_print);
          dont_print_statmem_obstack = tmp_obstack;
          dont_print_statmem_obstack = tmp_obstack;
        }
        }
 
 
      if (pretty)
      if (pretty)
        {
        {
          fprintf_filtered (stream, "\n");
          fprintf_filtered (stream, "\n");
          print_spaces_filtered (2 * recurse, stream);
          print_spaces_filtered (2 * recurse, stream);
        }
        }
    }
    }
  fprintf_filtered (stream, "}");
  fprintf_filtered (stream, "}");
}
}
 
 
/* Special val_print routine to avoid printing multiple copies of virtual
/* Special val_print routine to avoid printing multiple copies of virtual
   baseclasses.  */
   baseclasses.  */
 
 
void
void
pascal_object_print_value (struct type *type, char *valaddr, CORE_ADDR address,
pascal_object_print_value (struct type *type, char *valaddr, CORE_ADDR address,
                           struct ui_file *stream, int format, int recurse,
                           struct ui_file *stream, int format, int recurse,
                           enum val_prettyprint pretty,
                           enum val_prettyprint pretty,
                           struct type **dont_print_vb)
                           struct type **dont_print_vb)
{
{
  struct obstack tmp_obstack;
  struct obstack tmp_obstack;
  struct type **last_dont_print
  struct type **last_dont_print
  = (struct type **) obstack_next_free (&dont_print_vb_obstack);
  = (struct type **) obstack_next_free (&dont_print_vb_obstack);
  int i, n_baseclasses = TYPE_N_BASECLASSES (type);
  int i, n_baseclasses = TYPE_N_BASECLASSES (type);
 
 
  if (dont_print_vb == 0)
  if (dont_print_vb == 0)
    {
    {
      /* If we're at top level, carve out a completely fresh
      /* If we're at top level, carve out a completely fresh
         chunk of the obstack and use that until this particular
         chunk of the obstack and use that until this particular
         invocation returns.  */
         invocation returns.  */
      tmp_obstack = dont_print_vb_obstack;
      tmp_obstack = dont_print_vb_obstack;
      /* Bump up the high-water mark.  Now alpha is omega.  */
      /* Bump up the high-water mark.  Now alpha is omega.  */
      obstack_finish (&dont_print_vb_obstack);
      obstack_finish (&dont_print_vb_obstack);
    }
    }
 
 
  for (i = 0; i < n_baseclasses; i++)
  for (i = 0; i < n_baseclasses; i++)
    {
    {
      int boffset;
      int boffset;
      struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
      struct type *baseclass = check_typedef (TYPE_BASECLASS (type, i));
      char *basename = TYPE_NAME (baseclass);
      char *basename = TYPE_NAME (baseclass);
      char *base_valaddr;
      char *base_valaddr;
 
 
      if (BASETYPE_VIA_VIRTUAL (type, i))
      if (BASETYPE_VIA_VIRTUAL (type, i))
        {
        {
          struct type **first_dont_print
          struct type **first_dont_print
          = (struct type **) obstack_base (&dont_print_vb_obstack);
          = (struct type **) obstack_base (&dont_print_vb_obstack);
 
 
          int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
          int j = (struct type **) obstack_next_free (&dont_print_vb_obstack)
          - first_dont_print;
          - first_dont_print;
 
 
          while (--j >= 0)
          while (--j >= 0)
            if (baseclass == first_dont_print[j])
            if (baseclass == first_dont_print[j])
              goto flush_it;
              goto flush_it;
 
 
          obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
          obstack_ptr_grow (&dont_print_vb_obstack, baseclass);
        }
        }
 
 
      boffset = baseclass_offset (type, i, valaddr, address);
      boffset = baseclass_offset (type, i, valaddr, address);
 
 
      if (pretty)
      if (pretty)
        {
        {
          fprintf_filtered (stream, "\n");
          fprintf_filtered (stream, "\n");
          print_spaces_filtered (2 * recurse, stream);
          print_spaces_filtered (2 * recurse, stream);
        }
        }
      fputs_filtered ("<", stream);
      fputs_filtered ("<", stream);
      /* Not sure what the best notation is in the case where there is no
      /* Not sure what the best notation is in the case where there is no
         baseclass name.  */
         baseclass name.  */
 
 
      fputs_filtered (basename ? basename : "", stream);
      fputs_filtered (basename ? basename : "", stream);
      fputs_filtered ("> = ", stream);
      fputs_filtered ("> = ", stream);
 
 
      /* The virtual base class pointer might have been clobbered by the
      /* The virtual base class pointer might have been clobbered by the
         user program. Make sure that it still points to a valid memory
         user program. Make sure that it still points to a valid memory
         location.  */
         location.  */
 
 
      if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
      if (boffset != -1 && (boffset < 0 || boffset >= TYPE_LENGTH (type)))
        {
        {
          /* FIXME (alloc): not safe is baseclass is really really big. */
          /* FIXME (alloc): not safe is baseclass is really really big. */
          base_valaddr = (char *) alloca (TYPE_LENGTH (baseclass));
          base_valaddr = (char *) alloca (TYPE_LENGTH (baseclass));
          if (target_read_memory (address + boffset, base_valaddr,
          if (target_read_memory (address + boffset, base_valaddr,
                                  TYPE_LENGTH (baseclass)) != 0)
                                  TYPE_LENGTH (baseclass)) != 0)
            boffset = -1;
            boffset = -1;
        }
        }
      else
      else
        base_valaddr = valaddr + boffset;
        base_valaddr = valaddr + boffset;
 
 
      if (boffset == -1)
      if (boffset == -1)
        fprintf_filtered (stream, "<invalid address>");
        fprintf_filtered (stream, "<invalid address>");
      else
      else
        pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
        pascal_object_print_value_fields (baseclass, base_valaddr, address + boffset,
                                          stream, format, recurse, pretty,
                                          stream, format, recurse, pretty,
                     (struct type **) obstack_base (&dont_print_vb_obstack),
                     (struct type **) obstack_base (&dont_print_vb_obstack),
                                          0);
                                          0);
      fputs_filtered (", ", stream);
      fputs_filtered (", ", stream);
 
 
    flush_it:
    flush_it:
      ;
      ;
    }
    }
 
 
  if (dont_print_vb == 0)
  if (dont_print_vb == 0)
    {
    {
      /* Free the space used to deal with the printing
      /* Free the space used to deal with the printing
         of this type from top level.  */
         of this type from top level.  */
      obstack_free (&dont_print_vb_obstack, last_dont_print);
      obstack_free (&dont_print_vb_obstack, last_dont_print);
      /* Reset watermark so that we can continue protecting
      /* Reset watermark so that we can continue protecting
         ourselves from whatever we were protecting ourselves.  */
         ourselves from whatever we were protecting ourselves.  */
      dont_print_vb_obstack = tmp_obstack;
      dont_print_vb_obstack = tmp_obstack;
    }
    }
}
}
 
 
/* Print value of a static member.
/* Print value of a static member.
   To avoid infinite recursion when printing a class that contains
   To avoid infinite recursion when printing a class that contains
   a static instance of the class, we keep the addresses of all printed
   a static instance of the class, we keep the addresses of all printed
   static member classes in an obstack and refuse to print them more
   static member classes in an obstack and refuse to print them more
   than once.
   than once.
 
 
   VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
   VAL contains the value to print, TYPE, STREAM, RECURSE, and PRETTY
   have the same meanings as in c_val_print.  */
   have the same meanings as in c_val_print.  */
 
 
static void
static void
pascal_object_print_static_field (struct type *type, struct value *val,
pascal_object_print_static_field (struct type *type, struct value *val,
                                  struct ui_file *stream, int format,
                                  struct ui_file *stream, int format,
                                  int recurse, enum val_prettyprint pretty)
                                  int recurse, enum val_prettyprint pretty)
{
{
  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
  if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
    {
    {
      CORE_ADDR *first_dont_print;
      CORE_ADDR *first_dont_print;
      int i;
      int i;
 
 
      first_dont_print
      first_dont_print
        = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
        = (CORE_ADDR *) obstack_base (&dont_print_statmem_obstack);
      i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
      i = (CORE_ADDR *) obstack_next_free (&dont_print_statmem_obstack)
        - first_dont_print;
        - first_dont_print;
 
 
      while (--i >= 0)
      while (--i >= 0)
        {
        {
          if (VALUE_ADDRESS (val) == first_dont_print[i])
          if (VALUE_ADDRESS (val) == first_dont_print[i])
            {
            {
              fputs_filtered ("<same as static member of an already seen type>",
              fputs_filtered ("<same as static member of an already seen type>",
                              stream);
                              stream);
              return;
              return;
            }
            }
        }
        }
 
 
      obstack_grow (&dont_print_statmem_obstack, (char *) &VALUE_ADDRESS (val),
      obstack_grow (&dont_print_statmem_obstack, (char *) &VALUE_ADDRESS (val),
                    sizeof (CORE_ADDR));
                    sizeof (CORE_ADDR));
 
 
      CHECK_TYPEDEF (type);
      CHECK_TYPEDEF (type);
      pascal_object_print_value_fields (type, VALUE_CONTENTS (val), VALUE_ADDRESS (val),
      pascal_object_print_value_fields (type, VALUE_CONTENTS (val), VALUE_ADDRESS (val),
                                  stream, format, recurse, pretty, NULL, 1);
                                  stream, format, recurse, pretty, NULL, 1);
      return;
      return;
    }
    }
  val_print (type, VALUE_CONTENTS (val), 0, VALUE_ADDRESS (val),
  val_print (type, VALUE_CONTENTS (val), 0, VALUE_ADDRESS (val),
             stream, format, 0, recurse, pretty);
             stream, format, 0, recurse, pretty);
}
}
 
 
void
void
pascal_object_print_class_member (char *valaddr, struct type *domain,
pascal_object_print_class_member (char *valaddr, struct type *domain,
                                  struct ui_file *stream, char *prefix)
                                  struct ui_file *stream, char *prefix)
{
{
 
 
  /* VAL is a byte offset into the structure type DOMAIN.
  /* VAL is a byte offset into the structure type DOMAIN.
     Find the name of the field for that offset and
     Find the name of the field for that offset and
     print it.  */
     print it.  */
  int extra = 0;
  int extra = 0;
  int bits = 0;
  int bits = 0;
  register unsigned int i;
  register unsigned int i;
  unsigned len = TYPE_NFIELDS (domain);
  unsigned len = TYPE_NFIELDS (domain);
  /* @@ Make VAL into bit offset */
  /* @@ Make VAL into bit offset */
  LONGEST val = unpack_long (builtin_type_int, valaddr) << 3;
  LONGEST val = unpack_long (builtin_type_int, valaddr) << 3;
  for (i = TYPE_N_BASECLASSES (domain); i < len; i++)
  for (i = TYPE_N_BASECLASSES (domain); i < len; i++)
    {
    {
      int bitpos = TYPE_FIELD_BITPOS (domain, i);
      int bitpos = TYPE_FIELD_BITPOS (domain, i);
      QUIT;
      QUIT;
      if (val == bitpos)
      if (val == bitpos)
        break;
        break;
      if (val < bitpos && i != 0)
      if (val < bitpos && i != 0)
        {
        {
          /* Somehow pointing into a field.  */
          /* Somehow pointing into a field.  */
          i -= 1;
          i -= 1;
          extra = (val - TYPE_FIELD_BITPOS (domain, i));
          extra = (val - TYPE_FIELD_BITPOS (domain, i));
          if (extra & 0x7)
          if (extra & 0x7)
            bits = 1;
            bits = 1;
          else
          else
            extra >>= 3;
            extra >>= 3;
          break;
          break;
        }
        }
    }
    }
  if (i < len)
  if (i < len)
    {
    {
      char *name;
      char *name;
      fprintf_filtered (stream, prefix);
      fprintf_filtered (stream, prefix);
      name = type_name_no_tag (domain);
      name = type_name_no_tag (domain);
      if (name)
      if (name)
        fputs_filtered (name, stream);
        fputs_filtered (name, stream);
      else
      else
        pascal_type_print_base (domain, stream, 0, 0);
        pascal_type_print_base (domain, stream, 0, 0);
      fprintf_filtered (stream, "::");
      fprintf_filtered (stream, "::");
      fputs_filtered (TYPE_FIELD_NAME (domain, i), stream);
      fputs_filtered (TYPE_FIELD_NAME (domain, i), stream);
      if (extra)
      if (extra)
        fprintf_filtered (stream, " + %d bytes", extra);
        fprintf_filtered (stream, " + %d bytes", extra);
      if (bits)
      if (bits)
        fprintf_filtered (stream, " (offset in bits)");
        fprintf_filtered (stream, " (offset in bits)");
    }
    }
  else
  else
    fprintf_filtered (stream, "%ld", (long int) (val >> 3));
    fprintf_filtered (stream, "%ld", (long int) (val >> 3));
}
}
 
 
 
 
void
void
_initialize_pascal_valprint (void)
_initialize_pascal_valprint (void)
{
{
  add_show_from_set
  add_show_from_set
    (add_set_cmd ("pascal_static-members", class_support, var_boolean,
    (add_set_cmd ("pascal_static-members", class_support, var_boolean,
                  (char *) &pascal_static_field_print,
                  (char *) &pascal_static_field_print,
                  "Set printing of pascal static members.",
                  "Set printing of pascal static members.",
                  &setprintlist),
                  &setprintlist),
     &showprintlist);
     &showprintlist);
  /* Turn on printing of static fields.  */
  /* Turn on printing of static fields.  */
  pascal_static_field_print = 1;
  pascal_static_field_print = 1;
 
 
}
}
 
 

powered by: WebSVN 2.1.0

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