/* Fortran language support routines for GDB, the GNU debugger.
Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
- 2004, 2005, 2007 Free Software Foundation, Inc.
+ 2004, 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
Contributed by Motorola. Adapted from the C parser by Farooq Butt
(fmbutt@engage.sps.mot.com).
#include "f-lang.h"
#include "valprint.h"
#include "value.h"
+#include "cp-support.h"
/* Following is dubious stuff that had been in the xcoff reader. */
static void patch_common_entries (SAVED_F77_COMMON_PTR, CORE_ADDR, int);
#endif
-static struct type *f_create_fundamental_type (struct objfile *, int);
-static void f_printchar (int c, struct ui_file * stream);
-static void f_emit_char (int c, struct ui_file * stream, int quoter);
+static void f_printchar (int c, struct type *type, struct ui_file * stream);
+static void f_emit_char (int c, struct type *type,
+ struct ui_file * stream, int quoter);
/* Print the character C on STREAM as part of the contents of a literal
string whose delimiter is QUOTER. Note that that format for printing
be replaced with a true F77 version. */
static void
-f_emit_char (int c, struct ui_file *stream, int quoter)
+f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
{
c &= 0xFF; /* Avoid sign bit follies */
be replaced with a true F77version. */
static void
-f_printchar (int c, struct ui_file *stream)
+f_printchar (int c, struct type *type, struct ui_file *stream)
{
fputs_filtered ("'", stream);
- LA_EMIT_CHAR (c, stream, '\'');
+ LA_EMIT_CHAR (c, type, stream, '\'');
fputs_filtered ("'", stream);
}
be replaced with a true F77 version. */
static void
-f_printstr (struct ui_file *stream, const gdb_byte *string,
- unsigned int length, int width, int force_ellipses)
+f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
+ unsigned int length, const char *encoding, int force_ellipses,
+ const struct value_print_options *options)
{
unsigned int i;
unsigned int things_printed = 0;
return;
}
- for (i = 0; i < length && things_printed < print_max; ++i)
+ for (i = 0; i < length && things_printed < options->print_max; ++i)
{
/* Position of the character we are examining
to see whether it is repeated. */
++reps;
}
- if (reps > repeat_count_threshold)
+ if (reps > options->repeat_count_threshold)
{
if (in_quotes)
{
- if (inspect_it)
+ if (options->inspect_it)
fputs_filtered ("\\', ", stream);
else
fputs_filtered ("', ", stream);
in_quotes = 0;
}
- f_printchar (string[i], stream);
+ f_printchar (string[i], type, stream);
fprintf_filtered (stream, " <repeats %u times>", reps);
i = rep1 - 1;
- things_printed += repeat_count_threshold;
+ things_printed += options->repeat_count_threshold;
need_comma = 1;
}
else
{
if (!in_quotes)
{
- if (inspect_it)
+ if (options->inspect_it)
fputs_filtered ("\\'", stream);
else
fputs_filtered ("'", stream);
in_quotes = 1;
}
- LA_EMIT_CHAR (string[i], stream, '"');
+ LA_EMIT_CHAR (string[i], type, stream, '"');
++things_printed;
}
}
/* Terminate the quotes if necessary. */
if (in_quotes)
{
- if (inspect_it)
+ if (options->inspect_it)
fputs_filtered ("\\'", stream);
else
fputs_filtered ("'", stream);
if (force_ellipses || i < length)
fputs_filtered ("...", stream);
}
-
-/* FIXME: This is a copy of c_create_fundamental_type(), before
- all the non-C types were stripped from it. Needs to be fixed
- by an experienced F77 programmer. */
-
-static struct type *
-f_create_fundamental_type (struct objfile *objfile, int typeid)
-{
- struct type *type = NULL;
-
- switch (typeid)
- {
- case FT_VOID:
- type = init_type (TYPE_CODE_VOID,
- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- 0, "VOID", objfile);
- break;
- case FT_BOOLEAN:
- type = init_type (TYPE_CODE_BOOL,
- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "boolean", objfile);
- break;
- case FT_STRING:
- type = init_type (TYPE_CODE_STRING,
- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- 0, "string", objfile);
- break;
- case FT_CHAR:
- type = init_type (TYPE_CODE_INT,
- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- 0, "character", objfile);
- break;
- case FT_SIGNED_CHAR:
- type = init_type (TYPE_CODE_INT,
- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- 0, "integer*1", objfile);
- break;
- case FT_UNSIGNED_CHAR:
- type = init_type (TYPE_CODE_BOOL,
- TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "logical*1", objfile);
- break;
- case FT_SHORT:
- type = init_type (TYPE_CODE_INT,
- gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "integer*2", objfile);
- break;
- case FT_SIGNED_SHORT:
- type = init_type (TYPE_CODE_INT,
- gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "short", objfile); /* FIXME-fnf */
- break;
- case FT_UNSIGNED_SHORT:
- type = init_type (TYPE_CODE_BOOL,
- gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "logical*2", objfile);
- break;
- case FT_INTEGER:
- type = init_type (TYPE_CODE_INT,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "integer*4", objfile);
- break;
- case FT_SIGNED_INTEGER:
- type = init_type (TYPE_CODE_INT,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "integer", objfile); /* FIXME -fnf */
- break;
- case FT_UNSIGNED_INTEGER:
- type = init_type (TYPE_CODE_BOOL,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "logical*4", objfile);
- break;
- case FT_FIXED_DECIMAL:
- type = init_type (TYPE_CODE_INT,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "fixed decimal", objfile);
- break;
- case FT_LONG:
- type = init_type (TYPE_CODE_INT,
- gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "long", objfile);
- break;
- case FT_SIGNED_LONG:
- type = init_type (TYPE_CODE_INT,
- gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "long", objfile); /* FIXME -fnf */
- break;
- case FT_UNSIGNED_LONG:
- type = init_type (TYPE_CODE_INT,
- gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
- break;
- case FT_LONG_LONG:
- type = init_type (TYPE_CODE_INT,
- gdbarch_long_long_bit (current_gdbarch)
- / TARGET_CHAR_BIT,
- 0, "long long", objfile);
- break;
- case FT_SIGNED_LONG_LONG:
- type = init_type (TYPE_CODE_INT,
- gdbarch_long_long_bit (current_gdbarch)
- / TARGET_CHAR_BIT,
- 0, "signed long long", objfile);
- break;
- case FT_UNSIGNED_LONG_LONG:
- type = init_type (TYPE_CODE_INT,
- gdbarch_long_long_bit (current_gdbarch)
- / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
- break;
- case FT_FLOAT:
- type = init_type (TYPE_CODE_FLT,
- gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "real", objfile);
- break;
- case FT_DBL_PREC_FLOAT:
- type = init_type (TYPE_CODE_FLT,
- gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "real*8", objfile);
- break;
- case FT_FLOAT_DECIMAL:
- type = init_type (TYPE_CODE_FLT,
- gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "floating decimal", objfile);
- break;
- case FT_EXT_PREC_FLOAT:
- type = init_type (TYPE_CODE_FLT,
- gdbarch_long_double_bit (current_gdbarch)
- / TARGET_CHAR_BIT,
- 0, "real*16", objfile);
- break;
- case FT_COMPLEX:
- type = init_type (TYPE_CODE_COMPLEX,
- 2 * gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "complex*8", objfile);
- TYPE_TARGET_TYPE (type) = builtin_type_f_real;
- break;
- case FT_DBL_PREC_COMPLEX:
- type = init_type (TYPE_CODE_COMPLEX,
- 2 * gdbarch_double_bit (current_gdbarch)
- / TARGET_CHAR_BIT,
- 0, "complex*16", objfile);
- TYPE_TARGET_TYPE (type) = builtin_type_f_real_s8;
- break;
- case FT_EXT_PREC_COMPLEX:
- type = init_type (TYPE_CODE_COMPLEX,
- 2 * gdbarch_long_double_bit (current_gdbarch)
- / TARGET_CHAR_BIT,
- 0, "complex*32", objfile);
- TYPE_TARGET_TYPE (type) = builtin_type_f_real_s16;
- break;
- default:
- /* FIXME: For now, if we are asked to produce a type not in this
- language, create the equivalent of a C integer type with the
- name "<?type?>". When all the dust settles from the type
- reconstruction work, this should probably become an error. */
- type = init_type (TYPE_CODE_INT,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "<?type?>", objfile);
- warning (_("internal error: no F77 fundamental type %d"), typeid);
- break;
- }
- return (type);
-}
\f
/* Table of operators and their precedences for printing expressions. */
f_primitive_type_logical,
f_primitive_type_logical_s1,
f_primitive_type_logical_s2,
+ f_primitive_type_logical_s8,
f_primitive_type_integer,
f_primitive_type_integer_s2,
f_primitive_type_real,
= builtin->builtin_logical_s1;
lai->primitive_type_vector [f_primitive_type_logical_s2]
= builtin->builtin_logical_s2;
+ lai->primitive_type_vector [f_primitive_type_logical_s8]
+ = builtin->builtin_logical_s8;
lai->primitive_type_vector [f_primitive_type_real]
= builtin->builtin_real;
lai->primitive_type_vector [f_primitive_type_real_s8]
= builtin->builtin_complex_s16;
lai->primitive_type_vector [f_primitive_type_void]
= builtin->builtin_void;
+
+ lai->bool_type_symbol = "logical";
+ lai->bool_type_default = builtin->builtin_logical_s2;
+}
+
+/* Remove the modules separator :: from the default break list. */
+
+static char *
+f_word_break_characters (void)
+{
+ static char *retval;
+
+ if (!retval)
+ {
+ char *s;
+
+ retval = xstrdup (default_word_break_characters ());
+ s = strchr (retval, ':');
+ if (s)
+ {
+ char *last_char = &s[strlen (s) - 1];
+
+ *s = *last_char;
+ *last_char = 0;
+ }
+ }
+ return retval;
+}
+
+/* Consider the modules separator :: as a valid symbol name character class. */
+
+static char **
+f_make_symbol_completion_list (char *text, char *word)
+{
+ return default_make_symbol_completion_list_break_on (text, word, ":");
}
/* This is declared in c-lang.h but it is silly to import that file for what
is already just a hack. */
-extern int c_value_print (struct value *, struct ui_file *, int,
- enum val_prettyprint);
+extern int c_value_print (struct value *, struct ui_file *,
+ const struct value_print_options *);
const struct language_defn f_language_defn =
{
"fortran",
language_fortran,
- NULL,
range_check_on,
type_check_on,
case_sensitive_off,
array_column_major,
+ macro_expansion_no,
&exp_descriptor_standard,
f_parse, /* parser */
f_error, /* parser error function */
f_printchar, /* Print character constant */
f_printstr, /* function to print string constant */
f_emit_char, /* Function to print a single character */
- f_create_fundamental_type, /* Create fundamental type in this language */
f_print_type, /* Print a type using appropriate syntax */
+ default_print_typedef, /* Print a typedef using appropriate syntax */
f_val_print, /* Print a value using appropriate syntax */
c_value_print, /* FIXME */
NULL, /* Language specific skip_trampoline */
- value_of_this, /* value_of_this */
- basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
+ NULL, /* name_of_this */
+ cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
basic_lookup_transparent_type,/* lookup_transparent_type */
NULL, /* Language specific symbol demangler */
NULL, /* Language specific class_name_from_physname */
f_op_print_tab, /* expression operators for printing */
0, /* arrays are first-class (not c-style) */
1, /* String lower bound */
- NULL,
- default_word_break_characters,
+ f_word_break_characters,
+ f_make_symbol_completion_list,
f_language_arch_info,
default_print_array_index,
default_pass_by_reference,
+ default_get_string,
LANG_MAGIC
};
struct builtin_f_type *builtin_f_type
= GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
- builtin_f_type->builtin_void =
- init_type (TYPE_CODE_VOID, 1,
- 0,
- "VOID", (struct objfile *) NULL);
-
- builtin_f_type->builtin_character =
- init_type (TYPE_CODE_INT, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- 0,
- "character", (struct objfile *) NULL);
-
- builtin_f_type->builtin_logical_s1 =
- init_type (TYPE_CODE_BOOL, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED,
- "logical*1", (struct objfile *) NULL);
-
- builtin_f_type->builtin_integer_s2 =
- init_type (TYPE_CODE_INT,
- gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "integer*2", (struct objfile *) NULL);
-
- builtin_f_type->builtin_logical_s2 =
- init_type (TYPE_CODE_BOOL,
- gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "logical*2", (struct objfile *) NULL);
-
- builtin_f_type->builtin_integer =
- init_type (TYPE_CODE_INT,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "integer", (struct objfile *) NULL);
-
- builtin_f_type->builtin_logical =
- init_type (TYPE_CODE_BOOL,
- gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
- TYPE_FLAG_UNSIGNED, "logical*4", (struct objfile *) NULL);
-
- builtin_f_type->builtin_real =
- init_type (TYPE_CODE_FLT,
- gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0,
- "real", (struct objfile *) NULL);
-
- builtin_f_type->builtin_real_s8 =
- init_type (TYPE_CODE_FLT,
- gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0,
- "real*8", (struct objfile *) NULL);
-
- builtin_f_type->builtin_real_s16 =
- init_type (TYPE_CODE_FLT,
- gdbarch_long_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0,
- "real*16", (struct objfile *) NULL);
-
- builtin_f_type->builtin_complex_s8 =
- init_type (TYPE_CODE_COMPLEX,
- 2 * gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0,
- "complex*8", (struct objfile *) NULL);
- TYPE_TARGET_TYPE (builtin_f_type->builtin_complex_s8)
- = builtin_f_type->builtin_real;
-
- builtin_f_type->builtin_complex_s16 =
- init_type (TYPE_CODE_COMPLEX,
- 2 * gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0,
- "complex*16", (struct objfile *) NULL);
- TYPE_TARGET_TYPE (builtin_f_type->builtin_complex_s16)
- = builtin_f_type->builtin_real_s8;
-
- /* We have a new size == 4 double floats for the
- complex*32 data type */
-
- builtin_f_type->builtin_complex_s32 =
- init_type (TYPE_CODE_COMPLEX,
- 2 * gdbarch_long_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0,
- "complex*32", (struct objfile *) NULL);
- TYPE_TARGET_TYPE (builtin_f_type->builtin_complex_s32)
- = builtin_f_type->builtin_real_s16;
+ builtin_f_type->builtin_void
+ = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
+
+ builtin_f_type->builtin_character
+ = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
+
+ builtin_f_type->builtin_logical_s1
+ = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
+
+ builtin_f_type->builtin_integer_s2
+ = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
+ "integer*2");
+
+ builtin_f_type->builtin_logical_s2
+ = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
+ "logical*2");
+
+ builtin_f_type->builtin_logical_s8
+ = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
+ "logical*8");
+
+ builtin_f_type->builtin_integer
+ = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0,
+ "integer");
+
+ builtin_f_type->builtin_logical
+ = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1,
+ "logical*4");
+
+ builtin_f_type->builtin_real
+ = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch),
+ "real", NULL);
+ builtin_f_type->builtin_real_s8
+ = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch),
+ "real*8", NULL);
+ builtin_f_type->builtin_real_s16
+ = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch),
+ "real*16", NULL);
+
+ builtin_f_type->builtin_complex_s8
+ = arch_complex_type (gdbarch, "complex*8",
+ builtin_f_type->builtin_real);
+ builtin_f_type->builtin_complex_s16
+ = arch_complex_type (gdbarch, "complex*16",
+ builtin_f_type->builtin_real_s8);
+ builtin_f_type->builtin_complex_s32
+ = arch_complex_type (gdbarch, "complex*32",
+ builtin_f_type->builtin_real_s16);
return builtin_f_type;
}
while (tmp != NULL)
{
- if (DEPRECATED_STREQ (tmp->name, name)
- && DEPRECATED_STREQ (tmp->owning_function, funcname))
+ if (strcmp (tmp->name, name) == 0
+ && strcmp (tmp->owning_function, funcname) == 0)
return (tmp);
else
tmp = tmp->next;