#include "defs.h"
#include "obstack.h"
#include "bfd.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "target.h"
#include "command.h"
#include "gdbcmd.h"
#include "language.h"
#include "demangle.h"
#include "f-lang.h"
#include "typeprint.h"
#include "frame.h"
#include "gdb_string.h"
#include <errno.h>
#if 0
static void f_type_print_args (struct type *, struct ui_file *);
#endif
static void print_equivalent_f77_float_type (struct type *,
struct ui_file *);
static void f_type_print_varspec_suffix (struct type *, struct ui_file *,
int, int, int);
void f_type_print_varspec_prefix (struct type *, struct ui_file *,
int, int);
void f_type_print_base (struct type *, struct ui_file *, int, int);
void
f_print_type (struct type *type, char *varstring, struct ui_file *stream,
int show, int level)
{
register enum type_code code;
int demangled_args;
f_type_print_base (type, stream, show, level);
code = TYPE_CODE (type);
if ((varstring != NULL && *varstring != '\0')
||
((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_MEMBER
|| code == TYPE_CODE_REF)))
fputs_filtered (" ", stream);
f_type_print_varspec_prefix (type, stream, show, 0);
fputs_filtered (varstring, stream);
demangled_args = varstring[strlen (varstring) - 1] == ')';
f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
}
void
f_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
int show, int passed_a_ptr)
{
if (type == 0)
return;
if (TYPE_NAME (type) && show <= 0)
return;
QUIT;
switch (TYPE_CODE (type))
{
case TYPE_CODE_PTR:
f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
break;
case TYPE_CODE_FUNC:
f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
if (passed_a_ptr)
fprintf_filtered (stream, "(");
break;
case TYPE_CODE_ARRAY:
f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
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_BITSTRING:
case TYPE_CODE_METHOD:
case TYPE_CODE_MEMBER:
case TYPE_CODE_REF:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_TYPEDEF:
break;
}
}
#if 0
static void
f_type_print_args (struct type *type, struct ui_file *stream)
{
int i;
struct type **args;
fprintf_filtered (stream, "(");
args = TYPE_ARG_TYPES (type);
if (args != NULL)
{
if (args[1] == NULL)
{
fprintf_filtered (stream, "...");
}
else
{
for (i = 1; args[i] != NULL && args[i]->code != TYPE_CODE_VOID; i++)
{
f_print_type (args[i], "", stream, -1, 0);
if (args[i + 1] == NULL)
fprintf_filtered (stream, "...");
else if (args[i + 1]->code != TYPE_CODE_VOID)
{
fprintf_filtered (stream, ",");
wrap_here (" ");
}
}
}
}
fprintf_filtered (stream, ")");
}
#endif
static void
f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
int show, int passed_a_ptr, int demangled_args)
{
int upper_bound, lower_bound;
int lower_bound_was_default = 0;
static int arrayprint_recurse_level = 0;
int retcode;
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_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0);
retcode = f77_get_dynamic_lowerbound (type, &lower_bound);
lower_bound_was_default = 0;
if (retcode == BOUND_FETCH_ERROR)
fprintf_filtered (stream, "???");
else if (lower_bound == 1)
lower_bound_was_default = 1;
else
fprintf_filtered (stream, "%d", lower_bound);
if (lower_bound_was_default)
lower_bound_was_default = 0;
else
fprintf_filtered (stream, ":");
if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
fprintf_filtered (stream, "*");
else
{
retcode = f77_get_dynamic_upperbound (type, &upper_bound);
if (retcode == BOUND_FETCH_ERROR)
fprintf_filtered (stream, "???");
else
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);
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);
fprintf_filtered (stream, ")");
break;
case TYPE_CODE_FUNC:
f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
passed_a_ptr, 0);
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_BITSTRING:
case TYPE_CODE_METHOD:
case TYPE_CODE_MEMBER:
case TYPE_CODE_COMPLEX:
case TYPE_CODE_TYPEDEF:
break;
}
}
static void
print_equivalent_f77_float_type (struct type *type, struct ui_file *stream)
{
fprintf_filtered (stream, "real*%d", TYPE_LENGTH (type));
}
void
f_type_print_base (struct type *type, struct ui_file *stream, int show,
int level)
{
int retcode;
int upper_bound;
QUIT;
wrap_here (" ");
if (type == NULL)
{
fputs_filtered ("<type unknown>", stream);
return;
}
if ((show <= 0) && (TYPE_NAME (type) != NULL))
{
if (TYPE_CODE (type) == TYPE_CODE_FLT)
print_equivalent_f77_float_type (type, stream);
else
fputs_filtered (TYPE_NAME (type), stream);
return;
}
if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
case TYPE_CODE_TYPEDEF:
f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
break;
case TYPE_CODE_ARRAY:
case TYPE_CODE_FUNC:
f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
break;
case TYPE_CODE_PTR:
fprintf_filtered (stream, "PTR TO -> ( ");
f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
break;
case TYPE_CODE_VOID:
fprintf_filtered (stream, "VOID");
break;
case TYPE_CODE_UNDEF:
fprintf_filtered (stream, "struct <unknown>");
break;
case TYPE_CODE_ERROR:
fprintf_filtered (stream, "<unknown type>");
break;
case TYPE_CODE_RANGE:
fprintf_filtered (stream, "<range type>");
break;
case TYPE_CODE_CHAR:
fprintf_filtered (stream, "character");
break;
case TYPE_CODE_INT:
if (STREQ (TYPE_NAME (type), "char"))
fprintf_filtered (stream, "character");
else
goto default_case;
break;
case TYPE_CODE_COMPLEX:
fprintf_filtered (stream, "complex*%d", TYPE_LENGTH (type));
break;
case TYPE_CODE_FLT:
print_equivalent_f77_float_type (type, stream);
break;
case TYPE_CODE_STRING:
if (TYPE_ARRAY_UPPER_BOUND_TYPE (type) == BOUND_CANNOT_BE_DETERMINED)
fprintf_filtered (stream, "character*(*)");
else
{
retcode = f77_get_dynamic_upperbound (type, &upper_bound);
if (retcode == BOUND_FETCH_ERROR)
fprintf_filtered (stream, "character*???");
else
fprintf_filtered (stream, "character*%d", upper_bound);
}
break;
default_case:
default:
if (TYPE_NAME (type) != NULL)
fputs_filtered (TYPE_NAME (type), stream);
else
error ("Invalid type code (%d) in symbol table.", TYPE_CODE (type));
break;
}
}