1 /* Miscellaneous stuff that doesn't fit anywhere else.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010, 2011
3 Free Software Foundation, Inc.
4 Contributed by Andy Vaught
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
27 /* Get terminal width. */
30 gfc_terminal_width (void)
36 /* Initialize a typespec to unknown. */
39 gfc_clear_ts (gfc_typespec *ts)
41 ts->type = BT_UNKNOWN;
46 /* flag that says if the type is C interoperable */
48 /* says what f90 type the C kind interops with */
49 ts->f90_type = BT_UNKNOWN;
50 /* flag that says whether it's from iso_c_binding or not */
56 /* Open a file for reading. */
59 gfc_open_file (const char *name)
66 if (stat (name, &statbuf) < 0)
69 if (!S_ISREG (statbuf.st_mode))
72 return fopen (name, "r");
76 /* Return a string for each type. */
79 gfc_basic_typename (bt type)
119 gfc_internal_error ("gfc_basic_typename(): Undefined type");
126 /* Return a string describing the type and kind of a typespec. Because
127 we return alternating buffers, this subroutine can appear twice in
128 the argument list of a single statement. */
131 gfc_typename (gfc_typespec *ts)
133 static char buffer1[GFC_MAX_SYMBOL_LEN + 7]; /* 7 for "TYPE()" + '\0'. */
134 static char buffer2[GFC_MAX_SYMBOL_LEN + 7];
138 buffer = flag ? buffer1 : buffer2;
144 sprintf (buffer, "INTEGER(%d)", ts->kind);
147 sprintf (buffer, "REAL(%d)", ts->kind);
150 sprintf (buffer, "COMPLEX(%d)", ts->kind);
153 sprintf (buffer, "LOGICAL(%d)", ts->kind);
156 sprintf (buffer, "CHARACTER(%d)", ts->kind);
159 sprintf (buffer, "HOLLERITH");
162 sprintf (buffer, "TYPE(%s)", ts->u.derived->name);
165 sprintf (buffer, "CLASS(%s)",
166 ts->u.derived->components->ts.u.derived->name);
169 strcpy (buffer, "PROCEDURE");
172 strcpy (buffer, "UNKNOWN");
175 gfc_internal_error ("gfc_typename(): Undefined type");
182 /* Given an mstring array and a code, locate the code in the table,
183 returning a pointer to the string. */
186 gfc_code2string (const mstring *m, int code)
188 while (m->string != NULL)
195 gfc_internal_error ("gfc_code2string(): Bad code");
200 /* Given an mstring array and a string, returns the value of the tag
201 field. Returns the final tag if no matches to the string are found. */
204 gfc_string2code (const mstring *m, const char *string)
206 for (; m->string != NULL; m++)
207 if (strcmp (m->string, string) == 0)
214 /* Convert an intent code to a string. */
215 /* TODO: move to gfortran.h as define. */
218 gfc_intent_string (sym_intent i)
220 return gfc_code2string (intents, i);
224 /***************** Initialization functions ****************/
226 /* Top level initialization. */
232 gfc_scanner_init_1 ();
234 gfc_intrinsic_init_1 ();
238 /* Per program unit initialization. */
243 gfc_symbol_init_2 ();
244 gfc_module_init_2 ();
248 /******************* Destructor functions ******************/
250 /* Call all of the top level destructors. */
255 gfc_scanner_done_1 ();
256 gfc_intrinsic_done_1 ();
261 /* Per program unit destructors. */
266 gfc_symbol_done_2 ();
267 gfc_module_done_2 ();
271 /* Returns the index into the table of C interoperable kinds where the
272 kind with the given name (c_kind_name) was found. */
275 get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[])
279 for (index = 0; index < ISOCBINDING_LAST; index++)
280 if (strcmp (kinds_table[index].name, c_kind_name) == 0)
283 return ISOCBINDING_INVALID;