../commit.txt~
[deliverable/binutils-gdb.git] / gdb / f-lang.c
index 7adb48b8a861861ec469d2b18d364aea80f8d866..61513c121eac654a2da26ba5f912fab1051f138d 100644 (file)
@@ -1,7 +1,7 @@
 /* Fortran language support routines for GDB, the GNU debugger.
 
    Copyright (C) 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003,
-   2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
+   2004, 2005, 2007, 2008, 2009, 2010, 2011 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. */
+/* Following is dubious stuff that had been in the xcoff reader.  */
 
 struct saved_fcn
   {
-    long line_offset;          /* Line offset for function */
+    long line_offset;          /* Line offset for function */
     struct saved_fcn *next;
   };
 
 
 struct saved_bf_symnum
   {
-    long symnum_fcn;           /* Symnum of function (i.e. .function directive) */
-    long symnum_bf;            /* Symnum of .bf for this function */
+    long symnum_fcn;           /* Symnum of function (i.e. .function
+                                  directive).  */
+    long symnum_bf;            /* Symnum of .bf for this function.  */
     struct saved_bf_symnum *next;
   };
 
@@ -83,7 +85,7 @@ static void f_emit_char (int c, struct type *type,
 static void
 f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
 {
-  c &= 0xFF;                   /* Avoid sign bit follies */
+  c &= 0xFF;                   /* Avoid sign bit follies */
 
   if (PRINT_LITERAL_FORM (c))
     {
@@ -124,7 +126,7 @@ f_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
 }
 
 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
-   be replaced with a true F77version. */
+   be replaced with a true F77version.  */
 
 static void
 f_printchar (int c, struct type *type, struct ui_file *stream)
@@ -139,18 +141,17 @@ f_printchar (int c, struct type *type, struct ui_file *stream)
    are printed as appropriate.  Print ellipses at the end if we
    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
    FIXME:  This is a copy of the same function from c-exp.y.  It should
-   be replaced with a true F77 version. */
+   be replaced with a true F77 version.  */
 
 static void
 f_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
-           unsigned int length, int force_ellipses,
+           unsigned int length, const char *encoding, int force_ellipses,
            const struct value_print_options *options)
 {
   unsigned int i;
   unsigned int things_printed = 0;
   int in_quotes = 0;
   int need_comma = 0;
-  int width = TYPE_LENGTH (type);
 
   if (length == 0)
     {
@@ -259,6 +260,7 @@ enum f_primitive_types {
   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,
@@ -289,6 +291,8 @@ f_language_arch_info (struct gdbarch *gdbarch,
     = 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]
@@ -306,8 +310,41 @@ f_language_arch_info (struct gdbarch *gdbarch,
   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. */
+   is already just a hack.  */
 extern int c_value_print (struct value *, struct ui_file *,
                          const struct value_print_options *);
 
@@ -333,15 +370,16 @@ const struct language_defn f_language_defn =
   c_value_print,               /* FIXME */
   NULL,                                /* Language specific skip_trampoline */
   NULL,                        /* name_of_this */
-  basic_lookup_symbol_nonlocal,        /* lookup_symbol_nonlocal */
+  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 */
+  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 */
-  default_word_break_characters,
-  default_make_symbol_completion_list,
+  f_word_break_characters,
+  f_make_symbol_completion_list,
   f_language_arch_info,
   default_print_array_index,
   default_pass_by_reference,
@@ -355,60 +393,54 @@ build_fortran_types (struct gdbarch *gdbarch)
   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 (gdbarch) / TARGET_CHAR_BIT,
-              0, "integer*2", (struct objfile *) NULL);
-
-  builtin_f_type->builtin_logical_s2 =
-    init_type (TYPE_CODE_BOOL,
-              gdbarch_short_bit (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 (gdbarch) / TARGET_CHAR_BIT,
-              0, "integer", (struct objfile *) NULL);
-
-  builtin_f_type->builtin_logical =
-    init_type (TYPE_CODE_BOOL, 
-              gdbarch_int_bit (gdbarch) / TARGET_CHAR_BIT,
-              TYPE_FLAG_UNSIGNED, "logical*4", (struct objfile *) NULL);
-
-  builtin_f_type->builtin_real =
-    init_float_type (gdbarch_float_bit (gdbarch),
-                    "real", NULL);
-  builtin_f_type->builtin_real_s8 =
-    init_float_type (gdbarch_double_bit (gdbarch),
-                    "real*8", NULL);
-  builtin_f_type->builtin_real_s16 =
-    init_float_type (gdbarch_long_double_bit (gdbarch),
-                    "real*16", NULL);
-
-  builtin_f_type->builtin_complex_s8 =
-    init_complex_type ("complex*8",
-                      builtin_f_type->builtin_real);
-  builtin_f_type->builtin_complex_s16 =
-    init_complex_type ("complex*16",
-                      builtin_f_type->builtin_real_s8);
-  builtin_f_type->builtin_complex_s32 =
-    init_complex_type ("complex*32",
-                      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;
 }
@@ -475,14 +507,14 @@ SAVED_F77_COMMON_PTR current_common = NULL;       /* Ptr to current COMMON */
 static SAVED_BF_PTR saved_bf_list = NULL;      /* Ptr to (.bf,function) 
                                                   list */
 static SAVED_BF_PTR saved_bf_list_end = NULL;  /* Ptr to above list's end */
-static SAVED_BF_PTR current_head_bf_list = NULL;       /* Current head of above list
-                                                        */
+static SAVED_BF_PTR current_head_bf_list = NULL;    /* Current head of
+                                                      above list.  */
 
 static SAVED_BF_PTR tmp_bf_ptr;        /* Generic temporary for use 
-                                  in macros */
+                                  in macros */
 
 /* The following function simply enters a given common block onto 
-   the global common block chain */
+   the global common block chain */
 
 static void
 add_common_block (char *name, CORE_ADDR offset, int secnum, char *func_stab)
@@ -493,7 +525,7 @@ add_common_block (char *name, CORE_ADDR offset, int secnum, char *func_stab)
   /* If the COMMON block we are trying to add has a blank 
      name (i.e. "#BLNK_COM") then we set it to __BLANK
      because the darn "#" character makes GDB's input 
-     parser have fits. */
+     parser have fits.  */
 
 
   if (strcmp (name, BLANK_COMMON_NAME_ORIGINAL) == 0
@@ -513,7 +545,7 @@ add_common_block (char *name, CORE_ADDR offset, int secnum, char *func_stab)
   tmp->name = xmalloc (strlen (name) + 1);
 
   /* local_copy_func_stab is a stabstring, let us first extract the 
-     function name from the stab by NULLing out the ':' character. */
+     function name from the stab by NULLing out the ':' character.  */
 
 
   c = NULL;
@@ -550,7 +582,7 @@ add_common_block (char *name, CORE_ADDR offset, int secnum, char *func_stab)
 #endif
 
 /* The following function simply enters a given common entry onto 
-   the "current_common" block that has been saved away. */
+   the "current_common" block that has been saved away.  */
 
 #if 0
 static void
@@ -562,7 +594,7 @@ add_common_entry (struct symbol *entry_sym_ptr)
 
   /* The order of this list is important, since 
      we expect the entries to appear in decl.
-     order when we later issue "info common" calls */
+     order when we later issue "info common" calls */
 
   tmp = allocate_common_entry_node ();
 
@@ -587,7 +619,7 @@ add_common_entry (struct symbol *entry_sym_ptr)
 }
 #endif
 
-/* This routine finds the first encountred COMMON block named "name" */
+/* This routine finds the first encountred COMMON block named "name" */
 
 #if 0
 static SAVED_F77_COMMON_PTR
@@ -610,7 +642,7 @@ find_first_common_named (char *name)
 #endif
 
 /* This routine finds the first encountred COMMON block named "name" 
-   that belongs to function funcname */
+   that belongs to function funcname */
 
 SAVED_F77_COMMON_PTR
 find_common_for_function (char *name, char *funcname)
@@ -643,7 +675,7 @@ patch_common_entries (SAVED_F77_COMMON_PTR blk, CORE_ADDR offset, int secnum)
 {
   COMMON_ENTRY_PTR entry;
 
-  blk->offset = offset;                /* Keep this around for future use. */
+  blk->offset = offset;                /* Keep this around for future use.  */
 
   entry = blk->entries;
 
@@ -661,7 +693,7 @@ patch_common_entries (SAVED_F77_COMMON_PTR blk, CORE_ADDR offset, int secnum)
    blocks occur with relative infrequency, we simply do a linear scan on
    the name.  Eventually, the best way to do this will be a
    hashed-lookup.  Secnum is the section number for the .bss section
-   (which is where common data lives). */
+   (which is where common data lives).  */
 
 static void
 patch_all_commons_by_name (char *name, CORE_ADDR offset, int secnum)
@@ -699,7 +731,7 @@ patch_all_commons_by_name (char *name, CORE_ADDR offset, int secnum)
    #line pragmas sometimes cause line ranges to get messed up 
    we simply create a linear list.  This list can then be searched 
    first by a queueing algorithm and upon failure fall back to 
-   a linear scan. */
+   a linear scan.  */
 
 #if 0
 #define ADD_BF_SYMNUM(bf_sym,fcn_sym) \
@@ -728,7 +760,7 @@ else \
                   }
 #endif
 
-/* This function frees the entire (.bf,function) list */
+/* This function frees the entire (.bf,function) list */
 
 #if 0
 static void
@@ -759,7 +791,7 @@ get_bf_for_fcn (long the_function)
   int nprobes = 0;
 
   /* First use a simple queuing algorithm (i.e. look and see if the 
-     item at the head of the queue is the one you want)  */
+     item at the head of the queue is the one you want).  */
 
   if (saved_bf_list == NULL)
     internal_error (__FILE__, __LINE__,
@@ -778,7 +810,7 @@ get_bf_for_fcn (long the_function)
 
   /* If the above did not work (probably because #line directives were 
      used in the sourcefile and they messed up our internal tables) we now do
-     the ugly linear scan */
+     the ugly linear scan */
 
   if (global_remote_debug)
     fprintf_unfiltered (gdb_stderr, "\ndefaulting to linear scan\n");
This page took 0.03245 seconds and 4 git commands to generate.