1 /* Miscellaneous stuff that doesn't fit anywhere else.
2 Copyright (C) 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
5 This file is part of GCC.
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 2, or (at your option) any later
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING. If not, write to the Free
19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
31 /* Get a block of memory. Many callers assume that the memory we
44 gfc_fatal_error ("Out of memory-- malloc() failed");
50 /* gfortran.h defines free to something that triggers a syntax error,
51 but we need free() here. */
68 /* Get terminal width */
71 gfc_terminal_width(void)
77 /* Initialize a typespec to unknown. */
80 gfc_clear_ts (gfc_typespec * ts)
83 ts->type = BT_UNKNOWN;
90 /* Open a file for reading. */
93 gfc_open_file (const char *name)
100 if (stat (name, &statbuf) < 0)
103 if (!S_ISREG (statbuf.st_mode))
106 return fopen (name, "r");
110 /* Given a word, return the correct article. */
113 gfc_article (const char *word)
140 /* Return a string for each type. */
143 gfc_basic_typename (bt type)
174 gfc_internal_error ("gfc_basic_typename(): Undefined type");
181 /* Return a string descibing the type and kind of a typespec. Because
182 we return alternating buffers, this subroutine can appear twice in
183 the argument list of a single statement. */
186 gfc_typename (gfc_typespec * ts)
188 static char buffer1[60], buffer2[60];
192 buffer = flag ? buffer1 : buffer2;
198 sprintf (buffer, "INTEGER(%d)", ts->kind);
201 sprintf (buffer, "REAL(%d)", ts->kind);
204 sprintf (buffer, "COMPLEX(%d)", ts->kind);
207 sprintf (buffer, "LOGICAL(%d)", ts->kind);
210 sprintf (buffer, "CHARACTER(%d)", ts->kind);
213 sprintf (buffer, "TYPE(%s)", ts->derived->name);
216 strcpy (buffer, "PROCEDURE");
219 strcpy (buffer, "UNKNOWN");
222 gfc_internal_error ("gfc_typespec(): Undefined type");
229 /* Given an mstring array and a code, locate the code in the table,
230 returning a pointer to the string. */
233 gfc_code2string (const mstring * m, int code)
236 while (m->string != NULL)
243 gfc_internal_error ("gfc_code2string(): Bad code");
248 /* Given an mstring array and a string, returns the value of the tag
249 field. Returns the final tag if no matches to the string are
253 gfc_string2code (const mstring * m, const char *string)
256 for (; m->string != NULL; m++)
257 if (strcmp (m->string, string) == 0)
264 /* Convert an intent code to a string. */
265 /* TODO: move to gfortran.h as define. */
267 gfc_intent_string (sym_intent i)
270 return gfc_code2string (intents, i);
274 /***************** Initialization functions ****************/
276 /* Top level initialization. */
283 gfc_scanner_init_1 ();
285 gfc_intrinsic_init_1 ();
286 gfc_iresolve_init_1 ();
287 gfc_simplify_init_1 ();
291 /* Per program unit initialization. */
297 gfc_symbol_init_2 ();
298 gfc_module_init_2 ();
302 /******************* Destructor functions ******************/
304 /* Call all of the top level destructors. */
310 gfc_scanner_done_1 ();
311 gfc_intrinsic_done_1 ();
312 gfc_iresolve_done_1 ();
317 /* Per program unit destructors. */
323 gfc_symbol_done_2 ();
324 gfc_module_done_2 ();