/* 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, 2008
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
-This file is part of GNU G95.
+This file is part of GCC.
-GNU G95 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 2, or (at your option)
-any later version.
+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.
-GNU G95 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.
+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 GNU G95; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
#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. */
}
-/* gfortran.h defines free to something that triggers a syntax error,
- but we need free() here. */
-
-#define temp free
-#undef free
-
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);
+ (free) (p);
}
-#define free temp
-#undef temp
-
-/* Get terminal width */
+/* Get terminal width. */
int
-gfc_terminal_width(void)
+gfc_terminal_width (void)
{
return 80;
}
/* Initialize a typespec to unknown. */
void
-gfc_clear_ts (gfc_typespec * ts)
+gfc_clear_ts (gfc_typespec *ts)
{
-
ts->type = BT_UNKNOWN;
+ ts->u.derived = NULL;
ts->kind = 0;
- ts->derived = NULL;
- ts->cl = NULL;
+ 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;
}
}
-/* 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 *
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;
}
-/* 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;
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);
+ 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");
strcpy (buffer, "UNKNOWN");
break;
default:
- gfc_internal_error ("gfc_typespec(): Undefined type");
+ gfc_internal_error ("gfc_typename(): Undefined type");
}
return buffer;
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)
/* 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;
/* 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);
}
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 ();
}
void
gfc_init_2 (void)
{
-
gfc_symbol_init_2 ();
gfc_module_init_2 ();
}
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 ();
}
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;
+}
OSDN Git Service
