+++ /dev/null
-/* 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. */
-\f
-
-/* 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 ()
-{
-}
projects / msp430-gcc.git / blobdiff