X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Ff%2Fimplic.c;fp=gcc%2Ff%2Fimplic.c;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=6fe4606e357eb650eeb9ecac8cd321ec45b2c888;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/f/implic.c b/gcc/f/implic.c deleted file mode 100644 index 6fe4606e..00000000 --- a/gcc/f/implic.c +++ /dev/null @@ -1,383 +0,0 @@ -/* implic.c -- Implementation File (module.c template V1.0) - Copyright (C) 1995, 2002 Free Software Foundation, Inc. - Contributed by James Craig Burley. - -This file is part of GNU Fortran. - -GNU Fortran 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. - -GNU Fortran 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 Fortran; see the file COPYING. If not, write to -the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA -02111-1307, USA. - - Related Modules: - None. - - Description: - The GNU Fortran Front End. - - Modifications: -*/ - -/* Include files. */ - -#include "proj.h" -#include "implic.h" -#include "info.h" -#include "src.h" -#include "symbol.h" -#include "target.h" - -/* Externals defined here. */ - - -/* Simple definitions and enumerations. */ - -typedef enum - { - FFEIMPLIC_stateINITIAL_, - FFEIMPLIC_stateASSUMED_, - FFEIMPLIC_stateESTABLISHED_, - FFEIMPLIC_state - } ffeimplicState_; - -/* Internal typedefs. */ - -typedef struct _ffeimplic_ *ffeimplic_; - -/* Private include files. */ - - -/* Internal structure definitions. */ - -struct _ffeimplic_ - { - ffeimplicState_ state; - ffeinfo info; - }; - -/* Static objects accessed by functions in this module. */ - -/* NOTE: This is definitely ASCII-specific!! */ - -static struct _ffeimplic_ ffeimplic_table_['z' - 'A' + 1]; - -/* Static functions (internal). */ - -static ffeimplic_ ffeimplic_lookup_ (unsigned char c); - -/* Internal macros. */ - - -/* ffeimplic_lookup_ -- Look up implicit descriptor for initial character - - ffeimplic_ imp; - if ((imp = ffeimplic_lookup_('A')) == NULL) - // error - - Returns a pointer to an implicit descriptor block based on the character - passed, or NULL if it is not a valid initial character for an implicit - data type. */ - -static ffeimplic_ -ffeimplic_lookup_ (unsigned char c) -{ - /* NOTE: This is definitely ASCII-specific!! */ - if (ISIDST (c)) - return &ffeimplic_table_[c - 'A']; - return NULL; -} - -/* ffeimplic_establish_initial -- Establish type of implicit initial letter - - ffesymbol s; - if (!ffeimplic_establish_initial(s)) - // error - - Assigns implicit type information to the symbol based on the first - character of the symbol's name. */ - -bool -ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type, - ffeinfoKindtype kind_type, ffetargetCharacterSize size) -{ - ffeimplic_ imp; - - imp = ffeimplic_lookup_ (c); - if (imp == NULL) - return FALSE; /* Character not A-Z or some such thing. */ - if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE) - return FALSE; /* IMPLICIT NONE in effect here. */ - - switch (imp->state) - { - case FFEIMPLIC_stateINITIAL_: - imp->info = ffeinfo_new (basic_type, - kind_type, - 0, - FFEINFO_kindNONE, - FFEINFO_whereNONE, - size); - imp->state = FFEIMPLIC_stateESTABLISHED_; - return TRUE; - - case FFEIMPLIC_stateASSUMED_: - if ((ffeinfo_basictype (imp->info) != basic_type) - || (ffeinfo_kindtype (imp->info) != kind_type) - || (ffeinfo_size (imp->info) != size)) - return FALSE; - imp->state = FFEIMPLIC_stateESTABLISHED_; - return TRUE; - - case FFEIMPLIC_stateESTABLISHED_: - return FALSE; - - default: - assert ("Weird state for implicit object" == NULL); - return FALSE; - } -} - -/* ffeimplic_establish_symbol -- Establish implicit type of a symbol - - ffesymbol s; - if (!ffeimplic_establish_symbol(s)) - // error - - Assigns implicit type information to the symbol based on the first - character of the symbol's name. - - If symbol already has a type, return TRUE. - Get first character of symbol's name. - Get ffeimplic_ object for it (return FALSE if NULL returned). - Return FALSE if object has no assigned type (IMPLICIT NONE). - Copy the type information from the object to the symbol. - If the object is state "INITIAL", set to state "ASSUMED" so no - subsequent IMPLICIT statement may change the state. - Return TRUE. */ - -bool -ffeimplic_establish_symbol (ffesymbol s) -{ - char c; - ffeimplic_ imp; - - if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) - return TRUE; - - c = *(ffesymbol_text (s)); - imp = ffeimplic_lookup_ (c); - if (imp == NULL) - return FALSE; /* First character not A-Z or some such - thing. */ - if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE) - return FALSE; /* IMPLICIT NONE in effect here. */ - - ffesymbol_signal_change (s); /* Gonna change, save existing? */ - - /* Establish basictype, kindtype, size; preserve rank, kind, where. */ - - ffesymbol_set_info (s, - ffeinfo_new (ffeinfo_basictype (imp->info), - ffeinfo_kindtype (imp->info), - ffesymbol_rank (s), - ffesymbol_kind (s), - ffesymbol_where (s), - ffeinfo_size (imp->info))); - - if (imp->state == FFEIMPLIC_stateINITIAL_) - imp->state = FFEIMPLIC_stateASSUMED_; - - if (ffe_is_warn_implicit ()) - { - /* xgettext:no-c-format */ - ffebad_start_msg ("Implicit declaration of `%A' at %0", - FFEBAD_severityWARNING); - ffebad_here (0, ffesymbol_where_line (s), - ffesymbol_where_column (s)); - ffebad_string (ffesymbol_text (s)); - ffebad_finish (); - } - - return TRUE; -} - -/* ffeimplic_init_2 -- Initialize table - - ffeimplic_init_2(); - - Assigns initial type information to all initial letters. - - Allows for holes in the sequence of letters (i.e. EBCDIC). */ - -void -ffeimplic_init_2 () -{ - ffeimplic_ imp; - char c; - - for (c = 'A'; c <= 'z'; ++c) - { - imp = &ffeimplic_table_[c - 'A']; - imp->state = FFEIMPLIC_stateINITIAL_; - switch (c) - { - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'F': - case 'G': - case 'H': - case 'O': - case 'P': - case 'Q': - case 'R': - case 'S': - case 'T': - case 'U': - case 'V': - case 'W': - case 'X': - case 'Y': - case 'Z': - case '_': - case 'a': - case 'b': - case 'c': - case 'd': - case 'e': - case 'f': - case 'g': - case 'h': - case 'o': - case 'p': - case 'q': - case 'r': - case 's': - case 't': - case 'u': - case 'v': - case 'w': - case 'x': - case 'y': - case 'z': - imp->info = ffeinfo_new (FFEINFO_basictypeREAL, - FFEINFO_kindtypeREALDEFAULT, - 0, - FFEINFO_kindNONE, - FFEINFO_whereNONE, - FFETARGET_charactersizeNONE); - break; - - case 'I': - case 'J': - case 'K': - case 'L': - case 'M': - case 'N': - case 'i': - case 'j': - case 'k': - case 'l': - case 'm': - case 'n': - imp->info = ffeinfo_new (FFEINFO_basictypeINTEGER, - FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindNONE, FFEINFO_whereNONE, - FFETARGET_charactersizeNONE); - break; - - default: - imp->info = ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0, - FFEINFO_kindNONE, FFEINFO_whereNONE, FFETARGET_charactersizeNONE); - break; - } - } -} - -/* ffeimplic_none -- Implement IMPLICIT NONE statement - - ffeimplic_none(); - - Assigns null type information to all initial letters. */ - -void -ffeimplic_none () -{ - ffeimplic_ imp; - - for (imp = &ffeimplic_table_[0]; - imp != &ffeimplic_table_[ARRAY_SIZE (ffeimplic_table_)]; - imp++) - { - imp->info = ffeinfo_new (FFEINFO_basictypeNONE, - FFEINFO_kindtypeNONE, - 0, - FFEINFO_kindNONE, - FFEINFO_whereNONE, - FFETARGET_charactersizeNONE); - } -} - -/* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol - - ffesymbol s; - const char *name; // name for s in case it is NULL, or NULL if s never NULL - if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER) - // is or will be a CHARACTER-typed name - - Like establish_symbol, but doesn't change anything. - - If symbol is non-NULL and already has a type, return it. - Get first character of symbol's name or from name arg if symbol is NULL. - Get ffeimplic_ object for it (return FALSE if NULL returned). - Return NONE if object has no assigned type (IMPLICIT NONE). - Return the data type indicated in the object. - - 24-Oct-91 JCB 2.0 - Take a char * instead of ffelexToken, since the latter isn't always - needed anyway (as when ffecom calls it). */ - -ffeinfoBasictype -ffeimplic_peek_symbol_type (ffesymbol s, const char *name) -{ - char c; - ffeimplic_ imp; - - if (s == NULL) - c = *name; - else - { - if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE) - return ffesymbol_basictype (s); - - c = *(ffesymbol_text (s)); - } - - imp = ffeimplic_lookup_ (c); - if (imp == NULL) - return FFEINFO_basictypeNONE; /* First character not A-Z or - something. */ - return ffeinfo_basictype (imp->info); -} - -/* ffeimplic_terminate_2 -- Terminate table - - ffeimplic_terminate_2(); - - Kills info object for each entry in table. */ - -void -ffeimplic_terminate_2 () -{ -}