diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/fortran/misc.c | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/fortran/misc.c')
-rw-r--r-- | gcc/fortran/misc.c | 312 |
1 files changed, 312 insertions, 0 deletions
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c new file mode 100644 index 000000000..4dd186f6a --- /dev/null +++ b/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; +} |