2007-07-29 Daniel Franke <franke.daniel@gmail.com>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / misc.c

diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 3ef95db..bf0eca8 100644 (file)
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -1,5 +1,6 @@
 /* Miscellaneous stuff that doesn't fit anywhere else.
-   Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -16,18 +17,13 @@ for more details.
 
 You should have received a copy of the GNU General Public License
 along with GCC; see the file COPYING.  If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.  */
-
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
 
 #include "config.h"
-#include <stdlib.h>
-#include <string.h>
-#include <sys/stat.h>
-
+#include "system.h"
 #include "gfortran.h"
 
-
 /* Get a block of memory.  Many callers assume that the memory we
    return is zeroed.  */
 
@@ -56,7 +52,6 @@ gfc_getmem (size_t n)
 void
 gfc_free (void *p)
 {
-
   if (p != NULL)
     free (p);
 }
@@ -65,10 +60,10 @@ gfc_free (void *p)
 #undef temp
 
 
-/* Get terminal width */
+/* Get terminal width.  */
 
 int
-gfc_terminal_width(void)
+gfc_terminal_width (void)
 {
   return 80;
 }
@@ -77,13 +72,18 @@ gfc_terminal_width(void)
 /* Initialize a typespec to unknown.  */
 
 void
-gfc_clear_ts (gfc_typespec * ts)
+gfc_clear_ts (gfc_typespec *ts)
 {
-
   ts->type = BT_UNKNOWN;
   ts->kind = 0;
   ts->derived = NULL;
   ts->cl = NULL;
+  /* flag that says if the type is C interoperable */
+  ts->is_c_interop = 0;
+  /* says what f90 type the C kind interops with */
+  ts->f90_type = BT_UNKNOWN;
+  /* flag that says whether it's from iso_c_binding or not */
+  ts->is_iso_c = 0;
 }
 
 
@@ -107,36 +107,6 @@ gfc_open_file (const char *name)
 }
 
 
-/* Given a word, return the correct article.  */
-
-const char *
-gfc_article (const char *word)
-{
-  const char *p;
-
-  switch (*word)
-    {
-    case 'a':
-    case 'A':
-    case 'e':
-    case 'E':
-    case 'i':
-    case 'I':
-    case 'o':
-    case 'O':
-    case 'u':
-    case 'U':
-      p = "an";
-      break;
-
-    default:
-      p = "a";
-    }
-
-  return p;
-}
-
-
 /* Return a string for each type.  */
 
 const char *
@@ -161,6 +131,9 @@ gfc_basic_typename (bt type)
     case BT_CHARACTER:
       p = "CHARACTER";
       break;
+    case BT_HOLLERITH:
+      p = "HOLLERITH";
+      break;
     case BT_DERIVED:
       p = "DERIVED";
       break;
@@ -178,14 +151,15 @@ gfc_basic_typename (bt type)
 }
 
 
-/* Return a string descibing the type and kind of a typespec.  Because
+/* Return a string describing the type and kind of a typespec.  Because
    we return alternating buffers, this subroutine can appear twice in
    the argument list of a single statement.  */
 
 const char *
-gfc_typename (gfc_typespec * ts)
+gfc_typename (gfc_typespec *ts)
 {
-  static char buffer1[60], buffer2[60];
+  static char buffer1[GFC_MAX_SYMBOL_LEN + 7];  /* 7 for "TYPE()" + '\0'.  */
+  static char buffer2[GFC_MAX_SYMBOL_LEN + 7];
   static int flag = 0;
   char *buffer;
 
@@ -209,6 +183,9 @@ gfc_typename (gfc_typespec * ts)
     case BT_CHARACTER:
       sprintf (buffer, "CHARACTER(%d)", ts->kind);
       break;
+    case BT_HOLLERITH:
+      sprintf (buffer, "HOLLERITH");
+      break;
     case BT_DERIVED:
       sprintf (buffer, "TYPE(%s)", ts->derived->name);
       break;
@@ -219,7 +196,7 @@ gfc_typename (gfc_typespec * ts)
       strcpy (buffer, "UNKNOWN");
       break;
     default:
-      gfc_internal_error ("gfc_typespec(): Undefined type");
+      gfc_internal_error ("gfc_typename(): Undefined type");
     }
 
   return buffer;
@@ -230,9 +207,8 @@ gfc_typename (gfc_typespec * ts)
    returning a pointer to the string.  */
 
 const char *
-gfc_code2string (const mstring * m, int code)
+gfc_code2string (const mstring *m, int code)
 {
-
   while (m->string != NULL)
     {
       if (m->tag == code)
@@ -246,13 +222,11 @@ gfc_code2string (const mstring * m, int code)
 
 
 /* Given an mstring array and a string, returns the value of the tag
-   field.  Returns the final tag if no matches to the string are
-   found.  */
+   field.  Returns the final tag if no matches to the string are found.  */
 
 int
-gfc_string2code (const mstring * m, const char *string)
+gfc_string2code (const mstring *m, const char *string)
 {
-
   for (; m->string != NULL; m++)
     if (strcmp (m->string, string) == 0)
       return m->tag;
@@ -263,10 +237,10 @@ gfc_string2code (const mstring * m, const char *string)
 
 /* Convert an intent code to a string.  */
 /* TODO: move to gfortran.h as define.  */
+
 const char *
 gfc_intent_string (sym_intent i)
 {
-
   return gfc_code2string (intents, i);
 }
 
@@ -278,13 +252,10 @@ gfc_intent_string (sym_intent i)
 void
 gfc_init_1 (void)
 {
-
   gfc_error_init_1 ();
   gfc_scanner_init_1 ();
   gfc_arith_init_1 ();
   gfc_intrinsic_init_1 ();
-  gfc_iresolve_init_1 ();
-  gfc_simplify_init_1 ();
 }
 
 
@@ -293,7 +264,6 @@ gfc_init_1 (void)
 void
 gfc_init_2 (void)
 {
-
   gfc_symbol_init_2 ();
   gfc_module_init_2 ();
 }
@@ -306,11 +276,8 @@ gfc_init_2 (void)
 void
 gfc_done_1 (void)
 {
-
   gfc_scanner_done_1 ();
   gfc_intrinsic_done_1 ();
-  gfc_simplify_done_1 ();
-  gfc_iresolve_done_1 ();
   gfc_arith_done_1 ();
 }
 
@@ -320,8 +287,22 @@ gfc_done_1 (void)
 void
 gfc_done_2 (void)
 {
-
   gfc_symbol_done_2 ();
   gfc_module_done_2 ();
 }
 
+
+/* Returns the index into the table of C interoperable kinds where the
+   kind with the given name (c_kind_name) was found.  */
+
+int
+get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[])
+{
+  int index = 0;
+
+  for (index = 0; index < ISOCBINDING_LAST; index++)
+    if (strcmp (kinds_table[index].name, c_kind_name) == 0)
+      return index;
+
+  return ISOCBINDING_INVALID;
+}