Add gcc-4.6. Synced to @180989

Change-Id: Ie3676586e1d8e3c8cd9f07d022f450d05fa08439
svn://gcc.gnu.org/svn/gcc/branches/google/gcc-4_6-mobile

1 files changed, 312 insertions, 0 deletions

diff --git a/gcc-4.6/gcc/fortran/misc.c b/gcc-4.6/gcc/fortran/misc.c
new file mode 100644
index 000000000..4dd186f6a
--- /dev/null
+++ b/gcc-4.6/gcc/fortran/misc.c
@@ -0,0 +1,312 @@
+/* Miscellaneous stuff that doesn't fit anywhere else.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+
+/* Get a block of memory.  Many callers assume that the memory we
+   return is zeroed.  */
+
+void *
+gfc_getmem (size_t n)
+{
+  void *p;
+
+  if (n == 0)
+    return NULL;
+
+  p = xmalloc (n);
+  if (p == NULL)
+    gfc_fatal_error ("Allocation would exceed memory limit -- malloc() failed");
+  memset (p, 0, n);
+  return p;
+}
+
+
+void
+gfc_free (void *p)
+{
+  /* The parentheses around free are needed in order to call not
+     the redefined free of gfortran.h.  */
+  if (p != NULL)
+    (free) (p);
+}
+
+
+/* Get terminal width.  */
+
+int
+gfc_terminal_width (void)
+{
+  return 80;
+}
+
+
+/* Initialize a typespec to unknown.  */
+
+void
+gfc_clear_ts (gfc_typespec *ts)
+{
+  ts->type = BT_UNKNOWN;
+  ts->u.derived = NULL;
+  ts->kind = 0;
+  ts->u.cl = NULL;
+  ts->interface = 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;
+  ts->deferred = false;
+}
+
+
+/* Open a file for reading.  */
+
+FILE *
+gfc_open_file (const char *name)
+{
+  struct stat statbuf;
+
+  if (!*name)
+    return stdin;
+
+  if (stat (name, &statbuf) < 0)
+    return NULL;
+
+  if (!S_ISREG (statbuf.st_mode))
+    return NULL;
+
+  return fopen (name, "r");
+}
+
+
+/* Return a string for each type.  */
+
+const char *
+gfc_basic_typename (bt type)
+{
+  const char *p;
+
+  switch (type)
+    {
+    case BT_INTEGER:
+      p = "INTEGER";
+      break;
+    case BT_REAL:
+      p = "REAL";
+      break;
+    case BT_COMPLEX:
+      p = "COMPLEX";
+      break;
+    case BT_LOGICAL:
+      p = "LOGICAL";
+      break;
+    case BT_CHARACTER:
+      p = "CHARACTER";
+      break;
+    case BT_HOLLERITH:
+      p = "HOLLERITH";
+      break;
+    case BT_DERIVED:
+      p = "DERIVED";
+      break;
+    case BT_CLASS:
+      p = "CLASS";
+      break;
+    case BT_PROCEDURE:
+      p = "PROCEDURE";
+      break;
+    case BT_VOID:
+      p = "VOID";
+      break;
+    case BT_UNKNOWN:
+      p = "UNKNOWN";
+      break;
+    default:
+      gfc_internal_error ("gfc_basic_typename(): Undefined type");
+    }
+
+  return p;
+}
+
+
+/* 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)
+{
+  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;
+
+  buffer = flag ? buffer1 : buffer2;
+  flag = !flag;
+
+  switch (ts->type)
+    {
+    case BT_INTEGER:
+      sprintf (buffer, "INTEGER(%d)", ts->kind);
+      break;
+    case BT_REAL:
+      sprintf (buffer, "REAL(%d)", ts->kind);
+      break;
+    case BT_COMPLEX:
+      sprintf (buffer, "COMPLEX(%d)", ts->kind);
+      break;
+    case BT_LOGICAL:
+      sprintf (buffer, "LOGICAL(%d)", ts->kind);
+      break;
+    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->u.derived->name);
+      break;
+    case BT_CLASS:
+      sprintf (buffer, "CLASS(%s)",
+	       ts->u.derived->components->ts.u.derived->name);
+      break;
+    case BT_PROCEDURE:
+      strcpy (buffer, "PROCEDURE");
+      break;
+    case BT_UNKNOWN:
+      strcpy (buffer, "UNKNOWN");
+      break;
+    default:
+      gfc_internal_error ("gfc_typename(): Undefined type");
+    }
+
+  return buffer;
+}
+
+
+/* Given an mstring array and a code, locate the code in the table,
+   returning a pointer to the string.  */
+
+const char *
+gfc_code2string (const mstring *m, int code)
+{
+  while (m->string != NULL)
+    {
+      if (m->tag == code)
+	return m->string;
+      m++;
+    }
+
+  gfc_internal_error ("gfc_code2string(): Bad code");
+  /* Not reached */
+}
+
+
+/* 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.  */
+
+int
+gfc_string2code (const mstring *m, const char *string)
+{
+  for (; m->string != NULL; m++)
+    if (strcmp (m->string, string) == 0)
+      return m->tag;
+
+  return m->tag;
+}
+
+
+/* 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);
+}
+
+
+/***************** Initialization functions ****************/
+
+/* Top level initialization.  */
+
+void
+gfc_init_1 (void)
+{
+  gfc_error_init_1 ();
+  gfc_scanner_init_1 ();
+  gfc_arith_init_1 ();
+  gfc_intrinsic_init_1 ();
+}
+
+
+/* Per program unit initialization.  */
+
+void
+gfc_init_2 (void)
+{
+  gfc_symbol_init_2 ();
+  gfc_module_init_2 ();
+}
+
+
+/******************* Destructor functions ******************/
+
+/* Call all of the top level destructors.  */
+
+void
+gfc_done_1 (void)
+{
+  gfc_scanner_done_1 ();
+  gfc_intrinsic_done_1 ();
+  gfc_arith_done_1 ();
+}
+
+
+/* Per program unit destructors.  */
+
+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;
+}