struct value *
value_subscripted_rvalue (struct value *array, LONGEST index, int lowerbound)
{
struct type *array_type = check_typedef (value_type (array));
struct type *elt_type = check_typedef (TYPE_TARGET_TYPE (array_type));
ULONGEST elt_size = type_length_units (elt_type);
ULONGEST elt_offs = elt_size * (index - lowerbound);
if (index < lowerbound
|| (!TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)
&& elt_offs >= type_length_units (array_type))
|| (VALUE_LVAL (array) != lval_memory
&& TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (array_type)))
{
if (type_not_associated (array_type))
error (_("no such vector element (vector not associated)"));
else if (type_not_allocated (array_type))
error (_("no such vector element (vector not allocated)"));
else
error (_("no such vector element"));
}
if (is_dynamic_type (elt_type))
{
CORE_ADDR address;
address = value_address (array) + elt_offs;
elt_type = resolve_dynamic_type (elt_type, NULL, address);
}
return value_from_component (array, elt_type, elt_offs);
}
void
f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
int show, int level, const struct type_print_options *flags)
{
enum type_code code;
int demangled_args;
if (type_not_associated (type))
{
val_print_not_associated (stream);
return;
}
if (type_not_allocated (type))
{
val_print_not_allocated (stream);
return;
}
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
/* Need a space if going to print stars or brackets;
but not if we will print just a type name. */
|| ((show > 0 || TYPE_NAME (type) == 0)
&& (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
|| code == TYPE_CODE_METHOD
|| code == TYPE_CODE_ARRAY
|| code == TYPE_CODE_REF)))
fputs_filtered (" ", stream);
f_type_print_varspec_prefix (type, stream, show, 0);
if (varstring != NULL)
{
fputs_filtered (varstring, stream);
/* For demangled function names, we have the arglist as part of the name,
so don't print an additional pair of ()'s. */
demangled_args = varstring[strlen (varstring) - 1] == ')';
f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
}
}
static void
f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
int show, int passed_a_ptr, int demangled_args,
int arrayprint_recurse_level)
{
int upper_bound, lower_bound;
/* No static variables are permitted as an error call may occur during
execution of this function. */
if (type == 0)
return;
if (TYPE_NAME (type) && show <= 0)
return;
QUIT;
switch (TYPE_CODE (type))
{
case TYPE_CODE_ARRAY:
arrayprint_recurse_level++;
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, "(");
if (type_not_associated (type))
val_print_not_associated (stream);
else if (type_not_allocated (type))
val_print_not_allocated (stream);
else
{
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
0, 0, arrayprint_recurse_level);
lower_bound = f77_get_lowerbound (type);
if (lower_bound != 1) /* Not the default. */
fprintf_filtered (stream, "%d:", lower_bound);
/* Make sure that, if we have an assumed size array, we
print out a warning and print the upperbound as '*'. */
if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
fprintf_filtered (stream, "*");
else
{
upper_bound = f77_get_upperbound (type);
fprintf_filtered (stream, "%d", upper_bound);
}
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
0, 0, arrayprint_recurse_level);
}
if (arrayprint_recurse_level == 1)
fprintf_filtered (stream, ")");
else
fprintf_filtered (stream, ",");
arrayprint_recurse_level--;
break;
case TYPE_CODE_PTR:
case TYPE_CODE_REF:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
arrayprint_recurse_level);
fprintf_filtered (stream, ")");
break;
case TYPE_CODE_FUNC:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
passed_a_ptr, 0, arrayprint_recurse_level);
if (passed_a_ptr)
fprintf_filtered (stream, ")");
fprintf_filtered (stream, "()");
break;
case TYPE_CODE_UNDEF:
case TYPE_CODE_STRUCT:
case TYPE_CODE_UNION:
case TYPE_CODE_ENUM:
case TYPE_CODE_INT:
case TYPE_CODE_FLT:
case TYPE_CODE_VOID:
case TYPE_CODE_ERROR:
case TYPE_CODE_CHAR:
case TYPE_CODE_BOOL:
case TYPE_CODE_SET:
case TYPE_CODE_RANGE:
case TYPE_CODE_STRING:
case TYPE_CODE_METHOD:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_TYPEDEF:
/* These types do not need a suffix. They are listed so that
gcc -Wall will report types that may not have been considered. */
break;
}
}
