Example #1
0
static struct value *
value_user_defined_cpp_op (struct value **args, int nargs, char *operator,
                           int *static_memfuncp)
{

  struct symbol *symp = NULL;
  struct value *valp = NULL;

  find_overload_match (args, nargs, operator, BOTH /* could be method */,
                       0 /* strict match */, &args[0], /* objp */
                       NULL /* pass NULL symbol since symbol is unknown */,
                       &valp, &symp, static_memfuncp, 0);

  if (valp)
    return valp;

  if (symp)
    {
      /* This is a non member function and does not
         expect a reference as its first argument
         rather the explicit structure.  */
      args[0] = value_ind (args[0]);
      return value_of_variable (symp, 0);
    }

  error (_("Could not find %s."), operator);
}
Example #2
0
void
info_mach_region_command (char *exp, int from_tty)
{
  struct expression *expr;
  struct value *val;

  vm_address_t address;

  expr = parse_expression (exp);
  val = evaluate_expression (expr);
  if (TYPE_CODE (value_type (val)) == TYPE_CODE_REF)
    {
      val = value_ind (val);
    }
  /* In rvalue contexts, such as this, functions are coerced into
     pointers to functions. */
  if (TYPE_CODE (value_type (val)) == TYPE_CODE_FUNC
      && VALUE_LVAL (val) == lval_memory)
    {
      address = VALUE_ADDRESS (val);
    }
  else
    {
      address = value_as_address (val);
    }

  if ((!macosx_status) || (macosx_status->task == TASK_NULL))
    {
      error ("Inferior not available");
    }

  macosx_debug_region (macosx_status->task, address);
}
Example #3
0
/* Given a value of a pointer type, apply the C unary * operator to it.  */
static PyObject *
valpy_dereference (PyObject *self, PyObject *args)
{
    struct value *res_val = NULL;	  /* Initialize to appease gcc warning.  */
    volatile struct gdb_exception except;

    TRY_CATCH (except, RETURN_MASK_ALL)
    {
        res_val = value_ind (((value_object *) self)->value);
    }
Example #4
0
static int
wrap_value_ind (char *opaque_arg)
{
  struct gdb_wrapper_arguments **args = (struct gdb_wrapper_arguments **) opaque_arg;
  value_ptr val;

  val = (value_ptr) (*args)->args[0].ptr;
  (*args)->result.ptr = value_ind (val);
  return 1;
}
static struct value *
gnuv3_method_ptr_to_value (struct value **this_p, struct value *method_ptr)
{
  struct gdbarch *gdbarch;
  const gdb_byte *contents = value_contents (method_ptr);
  CORE_ADDR ptr_value;
  struct type *domain_type, *final_type, *method_type;
  LONGEST adjustment;
  struct value *adjval;
  int vbit;

  domain_type = TYPE_DOMAIN_TYPE (check_typedef (value_type (method_ptr)));
  final_type = lookup_pointer_type (domain_type);

  method_type = TYPE_TARGET_TYPE (check_typedef (value_type (method_ptr)));

  /* Extract the pointer to member.  */
  gdbarch = get_class_arch (domain_type);
  vbit = gnuv3_decode_method_ptr (gdbarch, contents, &ptr_value, &adjustment);

  /* First convert THIS to match the containing type of the pointer to
     member.  This cast may adjust the value of THIS.  */
  *this_p = value_cast (final_type, *this_p);

  /* Then apply whatever adjustment is necessary.  This creates a somewhat
     strange pointer: it claims to have type FINAL_TYPE, but in fact it
     might not be a valid FINAL_TYPE.  For instance, it might be a
     base class of FINAL_TYPE.  And if it's not the primary base class,
     then printing it out as a FINAL_TYPE object would produce some pretty
     garbage.

     But we don't really know the type of the first argument in
     METHOD_TYPE either, which is why this happens.  We can't
     dereference this later as a FINAL_TYPE, but once we arrive in the
     called method we'll have debugging information for the type of
     "this" - and that'll match the value we produce here.

     You can provoke this case by casting a Base::* to a Derived::*, for
     instance.  */
  *this_p = value_cast (builtin_type (gdbarch)->builtin_data_ptr, *this_p);
  adjval = value_from_longest (builtin_type (gdbarch)->builtin_long,
			       adjustment);
  *this_p = value_ptradd (*this_p, adjval);
  *this_p = value_cast (final_type, *this_p);

  if (vbit)
    {
      LONGEST voffset;
      voffset = ptr_value / TYPE_LENGTH (vtable_ptrdiff_type (gdbarch));
      return gnuv3_get_virtual_fn (gdbarch, value_ind (*this_p),
				   method_type, voffset);
    }
  else
    return value_from_pointer (lookup_pointer_type (method_type), ptr_value);
}
Example #6
0
static void
adjust_value_for_child_access (struct value **value,
                               struct type **type,
                               int *was_ptr,
                               int lookup_actual_type)
{
    gdb_assert (type && *type);

    if (was_ptr)
        *was_ptr = 0;

    *type = check_typedef (*type);

    /* The type of value stored in varobj, that is passed
       to us, is already supposed to be
       reference-stripped.  */

    gdb_assert (TYPE_CODE (*type) != TYPE_CODE_REF);

    /* Pointers to structures are treated just like
       structures when accessing children.  Don't
       dererences pointers to other types.  */
    if (TYPE_CODE (*type) == TYPE_CODE_PTR)
    {
        struct type *target_type = get_target_type (*type);
        if (TYPE_CODE (target_type) == TYPE_CODE_STRUCT
                || TYPE_CODE (target_type) == TYPE_CODE_UNION)
        {
            if (value && *value)
            {

                TRY
                {
                    *value = value_ind (*value);
                }

                CATCH (except, RETURN_MASK_ERROR)
                {
                    *value = NULL;
                }
                END_CATCH
            }
            *type = target_type;
            if (was_ptr)
                *was_ptr = 1;
        }
    }
Example #7
0
/* Given a value of a pointer type, apply the C unary * operator to it.  */
static PyObject *
valpy_dereference (PyObject *self, PyObject *args)
{
  PyObject *result = NULL;

  TRY
    {
      struct value *res_val;
      struct cleanup *cleanup = make_cleanup_value_free_to_mark (value_mark ());

      res_val = value_ind (((value_object *) self)->value);
      result = value_to_value_object (res_val);
      do_cleanups (cleanup);
    }
  CATCH (except, RETURN_MASK_ALL)
    {
      GDB_PY_HANDLE_EXCEPTION (except);
    }
Example #8
0
static void
info_mach_region_command (char *exp, int from_tty)
{
  struct value *val;
  mach_vm_address_t address;
  struct inferior *inf;

  expression_up expr = parse_expression (exp);
  val = evaluate_expression (expr.get ());
  if (TYPE_CODE (value_type (val)) == TYPE_CODE_REF)
    {
      val = value_ind (val);
    }
  address = value_as_address (val);

  if (ptid_equal (inferior_ptid, null_ptid))
    error (_("Inferior not available"));

  inf = current_inferior ();
  darwin_debug_region (inf->priv->task, address);
}
Example #9
0
struct value *
value_subscript (struct value *array, LONGEST index)
{
  int c_style = current_language->c_style_arrays;
  struct type *tarray;

  array = coerce_ref (array);
  tarray = check_typedef (value_type (array));

  if (TYPE_CODE (tarray) == TYPE_CODE_ARRAY
      || TYPE_CODE (tarray) == TYPE_CODE_STRING)
    {
      struct type *range_type = TYPE_INDEX_TYPE (tarray);
      LONGEST lowerbound, upperbound;

      get_discrete_bounds (range_type, &lowerbound, &upperbound);
      if (VALUE_LVAL (array) != lval_memory)
	return value_subscripted_rvalue (array, index, lowerbound);

      if (c_style == 0)
	{
	  if (index >= lowerbound && index <= upperbound)
	    return value_subscripted_rvalue (array, index, lowerbound);
	  /* Emit warning unless we have an array of unknown size.
	     An array of unknown size has lowerbound 0 and upperbound -1.  */
	  if (upperbound > -1)
	    warning (_("array or string index out of range"));
	  /* fall doing C stuff */
	  c_style = 1;
	}

      index -= lowerbound;
      array = value_coerce_array (array);
    }

  if (c_style)
    return value_ind (value_ptradd (array, index));
  else
    error (_("not an array or string"));
}
static void info_embedded_symbol_command (char *exp, int from_tty)
{
  struct expression *expr;
  struct value *val;
  CORE_ADDR address;
  struct embedded_symbol *sym;

  expr = parse_expression (exp);
  val = evaluate_expression (expr);
  if (TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_REF)
    val = value_ind (val);
  if ((TYPE_CODE (VALUE_TYPE (val)) == TYPE_CODE_FUNC) && (VALUE_LVAL (val) == lval_memory))
    address = VALUE_ADDRESS (val);
  else
    address = value_as_address (val);

  sym = search_for_embedded_symbol (address);
  if (sym != NULL)
    fprintf_unfiltered
      (gdb_stderr, "Symbol at 0x%lx is \"%s\".\n", (unsigned long) address, sym->name);
  else
    fprintf_unfiltered
      (gdb_stderr, "Symbol at 0x%lx is unknown.\n", (unsigned long) address);
}
Example #11
0
/* Return a virtual function as a value.
   ARG1 is the object which provides the virtual function
   table pointer.  *ARG1P is side-effected in calling this function.
   F is the list of member functions which contains the desired virtual
   function.
   J is an index into F which provides the desired virtual function.

   TYPE is the type in which F is located.  */
static struct value *
gnuv2_virtual_fn_field (struct value **arg1p, struct fn_field * f, int j,
			struct type * type, int offset)
{
  struct value *arg1 = *arg1p;
  struct type *type1 = check_typedef (value_type (arg1));


  struct type *entry_type;
  /* First, get the virtual function table pointer.  That comes
     with a strange type, so cast it to type `pointer to long' (which
     should serve just fine as a function type).  Then, index into
     the table, and convert final value to appropriate function type.  */
  struct value *entry;
  struct value *vfn;
  struct value *vtbl;
  struct value *vi = value_from_longest (builtin_type_int,
				     (LONGEST) TYPE_FN_FIELD_VOFFSET (f, j));
  struct type *fcontext = TYPE_FN_FIELD_FCONTEXT (f, j);
  struct type *context;
  if (fcontext == NULL)
    /* We don't have an fcontext (e.g. the program was compiled with
       g++ version 1).  Try to get the vtbl from the TYPE_VPTR_BASETYPE.
       This won't work right for multiple inheritance, but at least we
       should do as well as GDB 3.x did.  */
    fcontext = TYPE_VPTR_BASETYPE (type);
  context = lookup_pointer_type (fcontext);
  /* Now context is a pointer to the basetype containing the vtbl.  */
  if (TYPE_TARGET_TYPE (context) != type1)
    {
      struct value *tmp = value_cast (context, value_addr (arg1));
      arg1 = value_ind (tmp);
      type1 = check_typedef (value_type (arg1));
    }

  context = type1;
  /* Now context is the basetype containing the vtbl.  */

  /* This type may have been defined before its virtual function table
     was.  If so, fill in the virtual function table entry for the
     type now.  */
  if (TYPE_VPTR_FIELDNO (context) < 0)
    fill_in_vptr_fieldno (context);

  /* The virtual function table is now an array of structures
     which have the form { int16 offset, delta; void *pfn; }.  */
  vtbl = value_primitive_field (arg1, 0, TYPE_VPTR_FIELDNO (context),
				TYPE_VPTR_BASETYPE (context));

  /* With older versions of g++, the vtbl field pointed to an array
     of structures.  Nowadays it points directly to the structure. */
  if (TYPE_CODE (value_type (vtbl)) == TYPE_CODE_PTR
      && TYPE_CODE (TYPE_TARGET_TYPE (value_type (vtbl))) == TYPE_CODE_ARRAY)
    {
      /* Handle the case where the vtbl field points to an
         array of structures. */
      vtbl = value_ind (vtbl);

      /* Index into the virtual function table.  This is hard-coded because
         looking up a field is not cheap, and it may be important to save
         time, e.g. if the user has set a conditional breakpoint calling
         a virtual function.  */
      entry = value_subscript (vtbl, vi);
    }
  else
    {
      /* Handle the case where the vtbl field points directly to a structure. */
      vtbl = value_add (vtbl, vi);
      entry = value_ind (vtbl);
    }

  entry_type = check_typedef (value_type (entry));

  if (TYPE_CODE (entry_type) == TYPE_CODE_STRUCT)
    {
      /* Move the `this' pointer according to the virtual function table. */
      set_value_offset (arg1, value_offset (arg1) + value_as_long (value_field (entry, 0)));

      if (!value_lazy (arg1))
	{
	  set_value_lazy (arg1, 1);
	  value_fetch_lazy (arg1);
	}

      vfn = value_field (entry, 2);
    }
  else if (TYPE_CODE (entry_type) == TYPE_CODE_PTR)
    vfn = entry;
  else
    error (_("I'm confused:  virtual function table has bad type"));
  /* Reinstantiate the function pointer with the correct type.  */
  deprecated_set_value_type (vfn, lookup_pointer_type (TYPE_FN_FIELD_TYPE (f, j)));

  *arg1p = arg1;
  return vfn;
}
Example #12
0
static struct type *
java_link_class_type (struct gdbarch *gdbarch,
		      struct type *type, struct value *clas)
{
  struct value *temp;
  const char *unqualified_name;
  const char *name = TYPE_TAG_NAME (type);
  int ninterfaces, nfields, nmethods;
  int type_is_object = 0;
  struct fn_field *fn_fields;
  struct fn_fieldlist *fn_fieldlists;
  struct value *fields;
  struct value *methods;
  struct value *method = NULL;
  struct value *field = NULL;
  int i, j;
  struct objfile *objfile = get_dynamics_objfile (gdbarch);
  struct type *tsuper;

  gdb_assert (name != NULL);
  unqualified_name = strrchr (name, '.');
  if (unqualified_name == NULL)
    unqualified_name = name;

  temp = clas;
  temp = value_struct_elt (&temp, NULL, "superclass", NULL, "structure");
  if (strcmp (name, "java.lang.Object") == 0)
    {
      tsuper = get_java_object_type ();
      if (tsuper && TYPE_CODE (tsuper) == TYPE_CODE_PTR)
	tsuper = TYPE_TARGET_TYPE (tsuper);
      type_is_object = 1;
    }
  else
    tsuper = type_from_class (gdbarch, temp);

#if 1
  ninterfaces = 0;
#else
  temp = clas;
  ninterfaces = value_as_long (value_struct_elt (&temp, NULL, "interface_len",
						 NULL, "structure"));
#endif
  TYPE_N_BASECLASSES (type) = (tsuper == NULL ? 0 : 1) + ninterfaces;
  temp = clas;
  nfields = value_as_long (value_struct_elt (&temp, NULL, "field_count",
					     NULL, "structure"));
  nfields += TYPE_N_BASECLASSES (type);
  nfields++;			/* Add one for dummy "class" field.  */
  TYPE_NFIELDS (type) = nfields;
  TYPE_FIELDS (type) = (struct field *)
    TYPE_ALLOC (type, sizeof (struct field) * nfields);

  memset (TYPE_FIELDS (type), 0, sizeof (struct field) * nfields);

  TYPE_FIELD_PRIVATE_BITS (type) =
    (B_TYPE *) TYPE_ALLOC (type, B_BYTES (nfields));
  B_CLRALL (TYPE_FIELD_PRIVATE_BITS (type), nfields);

  TYPE_FIELD_PROTECTED_BITS (type) =
    (B_TYPE *) TYPE_ALLOC (type, B_BYTES (nfields));
  B_CLRALL (TYPE_FIELD_PROTECTED_BITS (type), nfields);

  TYPE_FIELD_IGNORE_BITS (type) =
    (B_TYPE *) TYPE_ALLOC (type, B_BYTES (nfields));
  B_CLRALL (TYPE_FIELD_IGNORE_BITS (type), nfields);

  TYPE_FIELD_VIRTUAL_BITS (type) = (B_TYPE *)
    TYPE_ALLOC (type, B_BYTES (TYPE_N_BASECLASSES (type)));
  B_CLRALL (TYPE_FIELD_VIRTUAL_BITS (type), TYPE_N_BASECLASSES (type));

  if (tsuper != NULL)
    {
      TYPE_BASECLASS (type, 0) = tsuper;
      if (type_is_object)
	SET_TYPE_FIELD_PRIVATE (type, 0);
    }

  i = strlen (name);
  if (i > 2 && name[i - 1] == ']' && tsuper != NULL)
    {
      /* FIXME */
      TYPE_LENGTH (type) = TYPE_LENGTH (tsuper) + 4;   /* size with "length" */
    }
  else
    {
      temp = clas;
      temp = value_struct_elt (&temp, NULL, "size_in_bytes",
			       NULL, "structure");
      TYPE_LENGTH (type) = value_as_long (temp);
    }

  fields = NULL;
  nfields--;			/* First set up dummy "class" field.  */
  SET_FIELD_PHYSADDR (TYPE_FIELD (type, nfields), value_address (clas));
  TYPE_FIELD_NAME (type, nfields) = "class";
  TYPE_FIELD_TYPE (type, nfields) = value_type (clas);
  SET_TYPE_FIELD_PRIVATE (type, nfields);

  for (i = TYPE_N_BASECLASSES (type); i < nfields; i++)
    {
      int accflags;
      int boffset;

      if (fields == NULL)
	{
	  temp = clas;
	  fields = value_struct_elt (&temp, NULL, "fields", NULL, "structure");
	  field = value_ind (fields);
	}
      else
	{			/* Re-use field value for next field.  */
	  CORE_ADDR addr
	    = value_address (field) + TYPE_LENGTH (value_type (field));

	  set_value_address (field, addr);
	  set_value_lazy (field, 1);
	}
      temp = field;
      temp = value_struct_elt (&temp, NULL, "name", NULL, "structure");
      TYPE_FIELD_NAME (type, i) =
	get_java_utf8_name (&objfile->objfile_obstack, temp);
      temp = field;
      accflags = value_as_long (value_struct_elt (&temp, NULL, "accflags",
						  NULL, "structure"));
      temp = field;
      temp = value_struct_elt (&temp, NULL, "info", NULL, "structure");
      boffset = value_as_long (value_struct_elt (&temp, NULL, "boffset",
						 NULL, "structure"));
      if (accflags & 0x0001)	/* public access */
	{
	  /* ??? */
	}
      if (accflags & 0x0002)	/* private access */
	{
	  SET_TYPE_FIELD_PRIVATE (type, i);
	}
      if (accflags & 0x0004)	/* protected access */
	{
	  SET_TYPE_FIELD_PROTECTED (type, i);
	}
      if (accflags & 0x0008)	/* ACC_STATIC */
	SET_FIELD_PHYSADDR (TYPE_FIELD (type, i), boffset);
      else
	SET_FIELD_BITPOS (TYPE_FIELD (type, i), 8 * boffset);
      if (accflags & 0x8000)	/* FIELD_UNRESOLVED_FLAG */
	{
	  TYPE_FIELD_TYPE (type, i) = get_java_object_type ();	/* FIXME */
	}
      else
	{
	  struct type *ftype;

	  temp = field;
	  temp = value_struct_elt (&temp, NULL, "type", NULL, "structure");
	  ftype = type_from_class (gdbarch, temp);
	  if (TYPE_CODE (ftype) == TYPE_CODE_STRUCT)
	    ftype = lookup_pointer_type (ftype);
	  TYPE_FIELD_TYPE (type, i) = ftype;
	}
    }

  temp = clas;
  nmethods = value_as_long (value_struct_elt (&temp, NULL, "method_count",
					      NULL, "structure"));
  j = nmethods * sizeof (struct fn_field);
  fn_fields = (struct fn_field *)
    obstack_alloc (&objfile->objfile_obstack, j);
  memset (fn_fields, 0, j);
  fn_fieldlists = (struct fn_fieldlist *)
    alloca (nmethods * sizeof (struct fn_fieldlist));

  methods = NULL;
  for (i = 0; i < nmethods; i++)
    {
      const char *mname;
      int k;

      if (methods == NULL)
	{
	  temp = clas;
	  methods = value_struct_elt (&temp, NULL, "methods",
				      NULL, "structure");
	  method = value_ind (methods);
	}
      else
	{			/* Re-use method value for next method.  */
	  CORE_ADDR addr
	    = value_address (method) + TYPE_LENGTH (value_type (method));

	  set_value_address (method, addr);
	  set_value_lazy (method, 1);
	}

      /* Get method name.  */
      temp = method;
      temp = value_struct_elt (&temp, NULL, "name", NULL, "structure");
      mname = get_java_utf8_name (&objfile->objfile_obstack, temp);
      if (strcmp (mname, "<init>") == 0)
	mname = unqualified_name;

      /* Check for an existing method with the same name.
       * This makes building the fn_fieldslists an O(nmethods**2)
       * operation.  That could be using hashing, but I doubt it
       * is worth it.  Note that we do maintain the order of methods
       * in the inferior's Method table (as long as that is grouped
       * by method name), which I think is desirable.  --PB */
      for (k = 0, j = TYPE_NFN_FIELDS (type);;)
	{
	  if (--j < 0)
	    {			/* No match - new method name.  */
	      j = TYPE_NFN_FIELDS (type)++;
	      fn_fieldlists[j].name = mname;
	      fn_fieldlists[j].length = 1;
	      fn_fieldlists[j].fn_fields = &fn_fields[i];
	      k = i;
	      break;
	    }
	  if (strcmp (mname, fn_fieldlists[j].name) == 0)
	    {		/* Found an existing method with the same name.  */
	      int l;

	      if (mname != unqualified_name)
		obstack_free (&objfile->objfile_obstack, mname);
	      mname = fn_fieldlists[j].name;
	      fn_fieldlists[j].length++;
	      k = i - k;	/* Index of new slot.  */
	      /* Shift intervening fn_fields (between k and i) down.  */
	      for (l = i; l > k; l--)
		fn_fields[l] = fn_fields[l - 1];
	      for (l = TYPE_NFN_FIELDS (type); --l > j;)
		fn_fieldlists[l].fn_fields++;
	      break;
	    }
	  k += fn_fieldlists[j].length;
	}
      fn_fields[k].physname = "";
      fn_fields[k].is_stub = 1;
      /* FIXME */
      fn_fields[k].type = lookup_function_type
			   (builtin_java_type (gdbarch)->builtin_void);
      TYPE_CODE (fn_fields[k].type) = TYPE_CODE_METHOD;
    }

  j = TYPE_NFN_FIELDS (type) * sizeof (struct fn_fieldlist);
  TYPE_FN_FIELDLISTS (type) = (struct fn_fieldlist *)
    obstack_alloc (&objfile->objfile_obstack, j);
  memcpy (TYPE_FN_FIELDLISTS (type), fn_fieldlists, j);

  return type;
}
Example #13
0
static struct value *
evaluate_subexp_java (struct type *expect_type, struct expression *exp,
		      int *pos, enum noside noside)
{
  int pc = *pos;
  int i;
  const char *name;
  enum exp_opcode op = exp->elts[*pos].opcode;
  struct value *arg1;
  struct value *arg2;
  struct type *type;

  switch (op)
    {
    case UNOP_IND:
      if (noside == EVAL_SKIP)
	goto standard;
      (*pos)++;
      arg1 = evaluate_subexp_java (NULL_TYPE, exp, pos, EVAL_NORMAL);
      if (is_object_type (value_type (arg1)))
	{
	  struct type *type;

	  type = type_from_class (exp->gdbarch, java_class_from_object (arg1));
	  arg1 = value_cast (lookup_pointer_type (type), arg1);
	}
      return value_ind (arg1);

    case BINOP_SUBSCRIPT:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
	goto nosideret;
      /* If the user attempts to subscript something that is not an
         array or pointer type (like a plain int variable for example),
         then report this as an error.  */

      arg1 = coerce_ref (arg1);
      type = check_typedef (value_type (arg1));
      if (TYPE_CODE (type) == TYPE_CODE_PTR)
	type = check_typedef (TYPE_TARGET_TYPE (type));
      name = TYPE_NAME (type);
      if (name == NULL)
	name = TYPE_TAG_NAME (type);
      i = name == NULL ? 0 : strlen (name);
      if (TYPE_CODE (type) == TYPE_CODE_STRUCT
	  && i > 2 && name[i - 1] == ']')
	{
	  enum bfd_endian byte_order = gdbarch_byte_order (exp->gdbarch);
	  CORE_ADDR address;
	  long length, index;
	  struct type *el_type;
	  gdb_byte buf4[4];

	  struct value *clas = java_class_from_object (arg1);
	  struct value *temp = clas;
	  /* Get CLASS_ELEMENT_TYPE of the array type.  */
	  temp = value_struct_elt (&temp, NULL, "methods",
				   NULL, "structure");
	  deprecated_set_value_type (temp, value_type (clas));
	  el_type = type_from_class (exp->gdbarch, temp);
	  if (TYPE_CODE (el_type) == TYPE_CODE_STRUCT)
	    el_type = lookup_pointer_type (el_type);

	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
	    return value_zero (el_type, VALUE_LVAL (arg1));
	  address = value_as_address (arg1);
	  address += get_java_object_header_size (exp->gdbarch);
	  read_memory (address, buf4, 4);
	  length = (long) extract_signed_integer (buf4, 4, byte_order);
	  index = (long) value_as_long (arg2);
	  if (index >= length || index < 0)
	    error (_("array index (%ld) out of bounds (length: %ld)"),
		   index, length);
	  address = (address + 4) + index * TYPE_LENGTH (el_type);
	  return value_at (el_type, address);
	}
      else if (TYPE_CODE (type) == TYPE_CODE_ARRAY)
	{
	  if (noside == EVAL_AVOID_SIDE_EFFECTS)
	    return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
	  else
	    return value_subscript (arg1, value_as_long (arg2));
	}
      if (name)
	error (_("cannot subscript something of type `%s'"), name);
      else
	error (_("cannot subscript requested type"));

    case OP_STRING:
      (*pos)++;
      i = longest_to_int (exp->elts[pc + 1].longconst);
      (*pos) += 3 + BYTES_TO_EXP_ELEM (i + 1);
      if (noside == EVAL_SKIP)
	goto nosideret;
      return java_value_string (&exp->elts[pc + 2].string, i);

    case STRUCTOP_PTR:
      arg1 = evaluate_subexp_standard (expect_type, exp, pos, noside);
      /* Convert object field (such as TYPE.class) to reference.  */
      if (TYPE_CODE (value_type (arg1)) == TYPE_CODE_STRUCT)
	arg1 = value_addr (arg1);
      return arg1;
    default:
      break;
    }
standard:
  return evaluate_subexp_standard (expect_type, exp, pos, noside);
nosideret:
  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
Example #14
0
struct type *
type_from_class (struct gdbarch *gdbarch, struct value *clas)
{
  struct type *type;
  char *name;
  struct value *temp;
  struct objfile *objfile;
  struct value *utf8_name;
  char *nptr;
  CORE_ADDR addr;

  type = check_typedef (value_type (clas));
  if (TYPE_CODE (type) == TYPE_CODE_PTR)
    {
      if (value_logical_not (clas))
	return NULL;
      clas = value_ind (clas);
    }
  addr = value_address (clas);

  objfile = get_dynamics_objfile (gdbarch);
  if (java_class_is_primitive (clas))
    {
      struct value *sig;

      temp = clas;
      sig = value_struct_elt (&temp, NULL, "method_count", NULL, "structure");
      return java_primitive_type (gdbarch, value_as_long (sig));
    }

  /* Get Class name.  */
  /* If clasloader non-null, prepend loader address.  FIXME */
  temp = clas;
  utf8_name = value_struct_elt (&temp, NULL, "name", NULL, "structure");
  name = get_java_utf8_name (&objfile->objfile_obstack, utf8_name);
  for (nptr = name; *nptr != 0; nptr++)
    {
      if (*nptr == '/')
	*nptr = '.';
    }

  type = java_lookup_class (name);
  if (type != NULL)
    return type;

  type = alloc_type (objfile);
  TYPE_CODE (type) = TYPE_CODE_STRUCT;
  INIT_CPLUS_SPECIFIC (type);

  if (name[0] == '[')
    {
      char *signature = name;
      int namelen = java_demangled_signature_length (signature);

      if (namelen > strlen (name))
	name = obstack_alloc (&objfile->objfile_obstack, namelen + 1);
      java_demangled_signature_copy (name, signature);
      name[namelen] = '\0';
      temp = clas;
      /* Set array element type.  */
      temp = value_struct_elt (&temp, NULL, "methods", NULL, "structure");
      deprecated_set_value_type (temp,
				 lookup_pointer_type (value_type (clas)));
      TYPE_TARGET_TYPE (type) = type_from_class (gdbarch, temp);
    }

  ALLOCATE_CPLUS_STRUCT_TYPE (type);
  TYPE_TAG_NAME (type) = name;

  add_class_symtab_symbol (add_class_symbol (type, addr));
  return java_link_class_type (gdbarch, type, clas);
}
Example #15
0
void
c_value_print (struct value *val, struct ui_file *stream, 
	       const struct value_print_options *options)
{
  struct type *type, *real_type, *val_type;
  int full, top, using_enc;
  struct value_print_options opts = *options;

  opts.deref_ref = 1;

  /* If it is a pointer, indicate what it points to.

     Print type also if it is a reference.

     C++: if it is a member pointer, we will take care
     of that when we print it.  */

  /* Preserve the original type before stripping typedefs.  We prefer
     to pass down the original type when possible, but for local
     checks it is better to look past the typedefs.  */
  val_type = value_type (val);
  type = check_typedef (val_type);

  if (TYPE_CODE (type) == TYPE_CODE_PTR
      || TYPE_CODE (type) == TYPE_CODE_REF)
    {
      /* Hack:  remove (char *) for char strings.  Their
         type is indicated by the quoted string anyway.
         (Don't use c_textual_element_type here; quoted strings
         are always exactly (char *), (wchar_t *), or the like.  */
      if (TYPE_CODE (val_type) == TYPE_CODE_PTR
	  && TYPE_NAME (val_type) == NULL
	  && TYPE_NAME (TYPE_TARGET_TYPE (val_type)) != NULL
	  && (strcmp (TYPE_NAME (TYPE_TARGET_TYPE (val_type)),
		      "char") == 0
	      || textual_name (TYPE_NAME (TYPE_TARGET_TYPE (val_type)))))
	{
	  /* Print nothing.  */
	}
      else if (options->objectprint
	       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
	{
	  int is_ref = TYPE_CODE (type) == TYPE_CODE_REF;

	  if (is_ref)
	    val = value_addr (val);

	  /* Pointer to class, check real type of object.  */
	  fprintf_filtered (stream, "(");

	  if (value_entirely_available (val))
 	    {
	      real_type = value_rtti_indirect_type (val, &full, &top,
						    &using_enc);
	      if (real_type)
		{
		  /* RTTI entry found.  */
		  type = real_type;

		  /* Need to adjust pointer value.  */
		  val = value_from_pointer (real_type,
					    value_as_address (val) - top);

		  if (is_ref)
		    {
		      val = value_ref (value_ind (val));
		      type = value_type (val);
		    }

		  /* Note: When we look up RTTI entries, we don't get
		     any information on const or volatile
		     attributes.  */
		}
	    }
          type_print (type, "", stream, -1);
	  fprintf_filtered (stream, ") ");
	  val_type = type;
	}
      else
	{
	  /* normal case */
	  fprintf_filtered (stream, "(");
	  type_print (value_type (val), "", stream, -1);
	  fprintf_filtered (stream, ") ");
	}
    }

  if (!value_initialized (val))
    fprintf_filtered (stream, " [uninitialized] ");

  if (options->objectprint && (TYPE_CODE (type) == TYPE_CODE_CLASS))
    {
      /* Attempt to determine real type of object.  */
      real_type = value_rtti_type (val, &full, &top, &using_enc);
      if (real_type)
	{
	  /* We have RTTI information, so use it.  */
	  val = value_full_object (val, real_type, 
				   full, top, using_enc);
	  fprintf_filtered (stream, "(%s%s) ",
			    TYPE_NAME (real_type),
			    full ? "" : _(" [incomplete object]"));
	  /* Print out object: enclosing type is same as real_type if
	     full.  */
	  val_print (value_enclosing_type (val),
		     value_contents_for_printing (val), 0,
		     value_address (val), stream, 0,
		     val, &opts, current_language);
	  return;
          /* Note: When we look up RTTI entries, we don't get any
             information on const or volatile attributes.  */
	}
      else if (type != check_typedef (value_enclosing_type (val)))
	{
	  /* No RTTI information, so let's do our best.  */
	  fprintf_filtered (stream, "(%s ?) ",
			    TYPE_NAME (value_enclosing_type (val)));
	  val_print (value_enclosing_type (val),
		     value_contents_for_printing (val), 0,
		     value_address (val), stream, 0,
		     val, &opts, current_language);
	  return;
	}
      /* Otherwise, we end up at the return outside this "if".  */
    }

  val_print (val_type, value_contents_for_printing (val),
	     value_embedded_offset (val),
	     value_address (val),
	     stream, 0,
	     val, &opts, current_language);
}
Example #16
0
static struct value *
evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
			 int *pos, enum noside noside)
{
  enum exp_opcode op = exp->elts[*pos].opcode;
  struct value *arg1;
  struct value *arg2;
  struct type *type;

  switch (op)
    {
    case UNOP_HIGH:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);

      if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
	return arg1;
      else
	{
	  arg1 = coerce_ref (arg1);
	  type = check_typedef (value_type (arg1));

	  if (m2_is_unbounded_array (type))
	    {
	      struct value *temp = arg1;

	      type = TYPE_FIELD_TYPE (type, 1);
	      /* i18n: Do not translate the "_m2_high" part!  */
	      arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
				       _("unbounded structure "
					 "missing _m2_high field"));
	  
	      if (value_type (arg1) != type)
		arg1 = value_cast (type, arg1);
	    }
	}
      return arg1;

    case BINOP_SUBSCRIPT:
      (*pos)++;
      arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
      arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
      if (noside == EVAL_SKIP)
	goto nosideret;
      /* If the user attempts to subscript something that is not an
         array or pointer type (like a plain int variable for example),
         then report this as an error.  */

      arg1 = coerce_ref (arg1);
      type = check_typedef (value_type (arg1));

      if (m2_is_unbounded_array (type))
	{
	  struct value *temp = arg1;
	  type = TYPE_FIELD_TYPE (type, 0);
	  if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR))
	    {
	      warning (_("internal error: unbounded "
			 "array structure is unknown"));
	      return evaluate_subexp_standard (expect_type, exp, pos, noside);
	    }
	  /* i18n: Do not translate the "_m2_contents" part!  */
	  arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
				   _("unbounded structure "
				     "missing _m2_contents field"));
	  
	  if (value_type (arg1) != type)
	    arg1 = value_cast (type, arg1);

	  check_typedef (value_type (arg1));
	  return value_ind (value_ptradd (arg1, value_as_long (arg2)));
	}
      else
	if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
	  {
	    if (TYPE_NAME (type))
	      error (_("cannot subscript something of type `%s'"),
		     TYPE_NAME (type));
	    else
	      error (_("cannot subscript requested type"));
	  }

      if (noside == EVAL_AVOID_SIDE_EFFECTS)
	return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
      else
	return value_subscript (arg1, value_as_long (arg2));

    default:
      return evaluate_subexp_standard (expect_type, exp, pos, noside);
    }

 nosideret:
  return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
}
Example #17
0
void
java_value_print (struct value *val, struct ui_file *stream, 
		  const struct value_print_options *options)
{
  struct gdbarch *gdbarch = get_type_arch (value_type (val));
  enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
  struct type *type;
  CORE_ADDR address;
  int i;
  const char *name;
  struct value_print_options opts;

  type = value_type (val);
  address = value_address (val);

  if (is_object_type (type))
    {
      CORE_ADDR obj_addr;
      struct value *tem = val;

      /* Get the run-time type, and cast the object into that.  */
      while (TYPE_CODE (value_type (tem)) == TYPE_CODE_PTR)
	tem = value_ind (tem);

      obj_addr = value_address (tem);

      if (obj_addr != 0)
	{
	  type = type_from_class (gdbarch, java_class_from_object (val));
	  type = lookup_pointer_type (type);

	  val = value_at (type, address);
	}
    }

  if (TYPE_CODE (type) == TYPE_CODE_PTR && !value_logical_not (val))
    type_print (TYPE_TARGET_TYPE (type), "", stream, -1);

  name = TYPE_TAG_NAME (type);
  if (TYPE_CODE (type) == TYPE_CODE_STRUCT && name != NULL
      && (i = strlen (name), name[i - 1] == ']'))
    {
      gdb_byte buf4[4];
      long length;
      unsigned int things_printed = 0;
      int reps;
      struct type *el_type
	= java_primitive_type_from_name (gdbarch, name, i - 2);

      i = 0;
      read_memory (address + get_java_object_header_size (gdbarch), buf4, 4);

      length = (long) extract_signed_integer (buf4, 4, byte_order);
      fprintf_filtered (stream, "{length: %ld", length);

      if (el_type == NULL)
	{
	  CORE_ADDR element;
	  CORE_ADDR next_element = -1; /* Dummy initial value.  */

	  /* Skip object header and length.  */
	  address += get_java_object_header_size (gdbarch) + 4;

	  while (i < length && things_printed < options->print_max)
	    {
	      gdb_byte *buf;

	      buf = alloca (gdbarch_ptr_bit (gdbarch) / HOST_CHAR_BIT);
	      fputs_filtered (", ", stream);
	      wrap_here (n_spaces (2));

	      if (i > 0)
		element = next_element;
	      else
		{
		  read_memory (address, buf, sizeof (buf));
		  address += gdbarch_ptr_bit (gdbarch) / HOST_CHAR_BIT;
		  /* FIXME: cagney/2003-05-24: Bogus or what.  It
                     pulls a host sized pointer out of the target and
                     then extracts that as an address (while assuming
                     that the address is unsigned)!  */
		  element = extract_unsigned_integer (buf, sizeof (buf),
						      byte_order);
		}

	      for (reps = 1; i + reps < length; reps++)
		{
		  read_memory (address, buf, sizeof (buf));
		  address += gdbarch_ptr_bit (gdbarch) / HOST_CHAR_BIT;
		  /* FIXME: cagney/2003-05-24: Bogus or what.  It
                     pulls a host sized pointer out of the target and
                     then extracts that as an address (while assuming
                     that the address is unsigned)!  */
		  next_element = extract_unsigned_integer (buf, sizeof (buf),
							   byte_order);
		  if (next_element != element)
		    break;
		}

	      if (reps == 1)
		fprintf_filtered (stream, "%d: ", i);
	      else
		fprintf_filtered (stream, "%d..%d: ", i, i + reps - 1);

	      if (element == 0)
		fprintf_filtered (stream, "null");
	      else
		fprintf_filtered (stream, "@%s", paddress (gdbarch, element));

	      things_printed++;
	      i += reps;
	    }
	}
      else
	{
	  struct value *v = allocate_value (el_type);
	  struct value *next_v = allocate_value (el_type);

	  set_value_address (v, (address
				 + get_java_object_header_size (gdbarch) + 4));
	  set_value_address (next_v, value_raw_address (v));

	  while (i < length && things_printed < options->print_max)
	    {
	      fputs_filtered (", ", stream);
	      wrap_here (n_spaces (2));

	      if (i > 0)
		{
		  struct value *tmp;

		  tmp = next_v;
		  next_v = v;
		  v = tmp;
		}
	      else
		{
		  set_value_lazy (v, 1);
		  set_value_offset (v, 0);
		}

	      set_value_offset (next_v, value_offset (v));

	      for (reps = 1; i + reps < length; reps++)
		{
		  set_value_lazy (next_v, 1);
		  set_value_offset (next_v, value_offset (next_v)
				    + TYPE_LENGTH (el_type));
		  value_fetch_lazy (next_v);
		  if (!(value_available_contents_eq
			(v, value_embedded_offset (v),
			 next_v, value_embedded_offset (next_v),
			 TYPE_LENGTH (el_type))))
		    break;
		}

	      if (reps == 1)
		fprintf_filtered (stream, "%d: ", i);
	      else
		fprintf_filtered (stream, "%d..%d: ", i, i + reps - 1);

	      opts = *options;
	      opts.deref_ref = 1;
	      common_val_print (v, stream, 1, &opts, current_language);

	      things_printed++;
	      i += reps;
	    }
	}

      if (i < length)
	fprintf_filtered (stream, "...");

      fprintf_filtered (stream, "}");

      return;
    }

  /* If it's type String, print it.  */

  if (TYPE_CODE (type) == TYPE_CODE_PTR
      && TYPE_TARGET_TYPE (type)
      && TYPE_TAG_NAME (TYPE_TARGET_TYPE (type))
      && strcmp (TYPE_TAG_NAME (TYPE_TARGET_TYPE (type)),
		 "java.lang.String") == 0
      && (options->format == 0 || options->format == 's')
      && address != 0
      && value_as_address (val) != 0)
    {
      struct type *char_type;
      struct value *data_val;
      CORE_ADDR data;
      struct value *boffset_val;
      unsigned long boffset;
      struct value *count_val;
      unsigned long count;
      struct value *mark;

      fputs_filtered (" ", stream);

      mark = value_mark ();	/* Remember start of new values.  */

      data_val = value_struct_elt (&val, NULL, "data", NULL, NULL);
      data = value_as_address (data_val);

      boffset_val = value_struct_elt (&val, NULL, "boffset", NULL, NULL);
      boffset = value_as_address (boffset_val);

      count_val = value_struct_elt (&val, NULL, "count", NULL, NULL);
      count = value_as_address (count_val);

      value_free_to_mark (mark);	/* Release unnecessary values.  */

      char_type = builtin_java_type (gdbarch)->builtin_char;
      val_print_string (char_type, NULL, data + boffset, count, stream,
			options);

      return;
    }

  opts = *options;
  opts.deref_ref = 1;
  common_val_print (val, stream, 0, &opts, current_language);
}
static int
ada_val_print_1 (struct type *type, char *valaddr0, int embedded_offset,
		 CORE_ADDR address, struct ui_file *stream, int format,
		 int deref_ref, int recurse, enum val_prettyprint pretty)
{
  unsigned int len;
  int i;
  struct type *elttype;
  unsigned int eltlen;
  LONGEST val;
  char *valaddr = valaddr0 + embedded_offset;

  CHECK_TYPEDEF (type);

  if (ada_is_array_descriptor_type (type) || ada_is_packed_array_type (type))
    {
      int retn;
      struct value *mark = value_mark ();
      struct value *val;
      val = value_from_contents_and_address (type, valaddr, address);
      val = ada_coerce_to_simple_array_ptr (val);
      if (val == NULL)
	{
	  fprintf_filtered (stream, "(null)");
	  retn = 0;
	}
      else
	retn = ada_val_print_1 (VALUE_TYPE (val), VALUE_CONTENTS (val), 0,
				VALUE_ADDRESS (val), stream, format,
				deref_ref, recurse, pretty);
      value_free_to_mark (mark);
      return retn;
    }

  valaddr = ada_aligned_value_addr (type, valaddr);
  embedded_offset -= valaddr - valaddr0 - embedded_offset;
  type = printable_val_type (type, valaddr);

  switch (TYPE_CODE (type))
    {
    default:
      return c_val_print (type, valaddr0, embedded_offset, address, stream,
			  format, deref_ref, recurse, pretty);

    case TYPE_CODE_PTR:
      {
	int ret = c_val_print (type, valaddr0, embedded_offset, address, 
			       stream, format, deref_ref, recurse, pretty);
	if (ada_is_tag_type (type))
	  {
	    struct value *val = 
	      value_from_contents_and_address (type, valaddr, address);
	    const char *name = ada_tag_name (val);
	    if (name != NULL) 
	      fprintf_filtered (stream, " (%s)", name);
	    return 0;
	}
	return ret;
      }

    case TYPE_CODE_INT:
    case TYPE_CODE_RANGE:
      if (ada_is_fixed_point_type (type))
	{
	  LONGEST v = unpack_long (type, valaddr);
	  int len = TYPE_LENGTH (type);

	  fprintf_filtered (stream, len < 4 ? "%.11g" : "%.17g",
			    (double) ada_fixed_to_float (type, v));
	  return 0;
	}
      else if (ada_is_vax_floating_type (type))
	{
	  struct value *val =
	    value_from_contents_and_address (type, valaddr, address);
	  struct value *func = ada_vax_float_print_function (type);
	  if (func != 0)
	    {
	      static struct type *parray_of_char = NULL;
	      struct value *printable_val;

	      if (parray_of_char == NULL)
		parray_of_char =
		  make_pointer_type
		  (create_array_type
		   (NULL, builtin_type_char,
		    create_range_type (NULL, builtin_type_int, 0, 32)), NULL);

	      printable_val =
		value_ind (value_cast (parray_of_char,
				       call_function_by_hand (func, 1,
							      &val)));

	      fprintf_filtered (stream, "%s", VALUE_CONTENTS (printable_val));
	      return 0;
	    }
	  /* No special printing function.  Do as best we can.  */
	}
      else if (TYPE_CODE (type) == TYPE_CODE_RANGE)
	{
	  struct type *target_type = TYPE_TARGET_TYPE (type);
	  if (TYPE_LENGTH (type) != TYPE_LENGTH (target_type))
	    {
	      /* Obscure case of range type that has different length from
	         its base type.  Perform a conversion, or we will get a
	         nonsense value.  Actually, we could use the same
	         code regardless of lengths; I'm just avoiding a cast.  */
	      struct value *v = value_cast (target_type,
					    value_from_contents_and_address
					    (type, valaddr, 0));
	      return ada_val_print_1 (target_type, VALUE_CONTENTS (v), 0, 0,
				      stream, format, 0, recurse + 1, pretty);
	    }
	  else
	    return ada_val_print_1 (TYPE_TARGET_TYPE (type),
				    valaddr0, embedded_offset,
				    address, stream, format, deref_ref,
				    recurse, pretty);
	}
      else
	{
	  format = format ? format : output_format;
	  if (format)
	    {
	      print_scalar_formatted (valaddr, type, format, 0, stream);
	    }
          else if (ada_is_system_address_type (type))
            {
              /* FIXME: We want to print System.Address variables using
                 the same format as for any access type.  But for some
                 reason GNAT encodes the System.Address type as an int,
                 so we have to work-around this deficiency by handling
                 System.Address values as a special case.  */
              fprintf_filtered (stream, "(");
              type_print (type, "", stream, -1);
              fprintf_filtered (stream, ") ");
              print_address_numeric 
		(extract_typed_address (valaddr, builtin_type_void_data_ptr),
                 1, stream);
            }
	  else
	    {
	      val_print_type_code_int (type, valaddr, stream);
	      if (ada_is_character_type (type))
		{
		  fputs_filtered (" ", stream);
		  ada_printchar ((unsigned char) unpack_long (type, valaddr),
				 stream);
		}
	    }
	  return 0;
	}

    case TYPE_CODE_ENUM:
      if (format)
	{
	  print_scalar_formatted (valaddr, type, format, 0, stream);
	  break;
	}
      len = TYPE_NFIELDS (type);
      val = unpack_long (type, valaddr);
      for (i = 0; i < len; i++)
	{
	  QUIT;
	  if (val == TYPE_FIELD_BITPOS (type, i))
	    {
	      break;
	    }
	}
      if (i < len)
	{
	  const char *name = ada_enum_name (TYPE_FIELD_NAME (type, i));
	  if (name[0] == '\'')
	    fprintf_filtered (stream, "%ld %s", (long) val, name);
	  else
	    fputs_filtered (name, stream);
	}
      else
	{
	  print_longest (stream, 'd', 0, val);
	}
      break;

    case TYPE_CODE_FLT:
      if (format)
	return c_val_print (type, valaddr0, embedded_offset, address, stream,
			    format, deref_ref, recurse, pretty);
      else
	ada_print_floating (valaddr0 + embedded_offset, type, stream);
      break;

    case TYPE_CODE_UNION:
    case TYPE_CODE_STRUCT:
      if (ada_is_bogus_array_descriptor (type))
	{
	  fprintf_filtered (stream, "(...?)");
	  return 0;
	}
      else
	{
	  print_record (type, valaddr, stream, format, recurse, pretty);
	  return 0;
	}

    case TYPE_CODE_ARRAY:
      elttype = TYPE_TARGET_TYPE (type);
      if (elttype == NULL)
	eltlen = 0;
      else
	eltlen = TYPE_LENGTH (elttype);
      /* FIXME: This doesn't deal with non-empty arrays of
	 0-length items (not a typical case!) */
      if (eltlen == 0)
	len = 0;
      else
	len = TYPE_LENGTH (type) / eltlen;

	  /* For an array of chars, print with string syntax.  */
      if (ada_is_string_type (type) && (format == 0 || format == 's'))
	{
	  if (prettyprint_arrays)
	    {
	      print_spaces_filtered (2 + 2 * recurse, stream);
	    }
	  /* If requested, look for the first null char and only print
	     elements up to it.  */
	  if (stop_print_at_null)
	    {
	      int temp_len;

	      /* Look for a NULL char.  */
	      for (temp_len = 0;
		   temp_len < len && temp_len < print_max
		     && char_at (valaddr, temp_len, eltlen) != 0;
		   temp_len += 1);
	      len = temp_len;
	    }

	  printstr (stream, valaddr, len, 0, eltlen);
	}
      else
	{
	  len = 0;
	  fprintf_filtered (stream, "(");
	  print_optional_low_bound (stream, type);
	  if (TYPE_FIELD_BITSIZE (type, 0) > 0)
	    val_print_packed_array_elements (type, valaddr, 0, stream,
					     format, recurse, pretty);
	  else
	    val_print_array_elements (type, valaddr, address, stream,
				      format, deref_ref, recurse,
				      pretty, 0);
	  fprintf_filtered (stream, ")");
	}
      gdb_flush (stream);
      return len;

    case TYPE_CODE_REF:
      elttype = check_typedef (TYPE_TARGET_TYPE (type));
      /* De-reference the reference */
      if (deref_ref)
	{
	  if (TYPE_CODE (elttype) != TYPE_CODE_UNDEF)
	    {
	      LONGEST deref_val_int = (LONGEST)
		unpack_pointer (lookup_pointer_type (builtin_type_void),
				valaddr);
	      if (deref_val_int != 0)
		{
		  struct value *deref_val =
		    ada_value_ind (value_from_longest
				   (lookup_pointer_type (elttype),
				    deref_val_int));
		  val_print (VALUE_TYPE (deref_val),
			     VALUE_CONTENTS (deref_val), 0,
			     VALUE_ADDRESS (deref_val), stream, format,
			     deref_ref, recurse + 1, pretty);
		}
	      else
		fputs_filtered ("(null)", stream);
	    }
	  else
	    fputs_filtered ("???", stream);
	}
      break;
    }
  gdb_flush (stream);
  return 0;
}