contrib/gcc-3.4/gcc/f/name.c

   1 /* name.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   4
   5 This file is part of GNU Fortran.
   6
   7 GNU Fortran is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Fortran is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Fortran; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Related Modules:
  23       None.
  24
  25    Description:
  26       Name and name space abstraction.
  27
  28    Modifications:
  29 */
  30
  31 /* Include files. */
  32
  33 #include "proj.h"
  34 #include "bad.h"
  35 #include "name.h"
  36 #include "lex.h"
  37 #include "malloc.h"
  38 #include "src.h"
  39 #include "where.h"
  40
  41 /* Externals defined here. */
  42
  43
  44 /* Simple definitions and enumerations. */
  45
  46
  47 /* Internal typedefs. */
  48
  49
  50 /* Private include files. */
  51
  52
  53 /* Internal structure definitions. */
  54
  55
  56 /* Static objects accessed by functions in this module. */
  57
  58
  59 /* Static functions (internal). */
  60
  61 static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found);
  62
  63 /* Internal macros. */
  64 \f
  65
  66 /* Searches for and returns the matching ffename object, or returns a
  67    pointer to the name before which the new name should go.  */
  68
  69 static ffename
  70 ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found)
  71 {
  72   ffename n;
  73
  74   for (n = ns->first; n != (ffename) &ns->first; n = n->next)
  75     {
  76       if (ffelex_token_strcmp (t, n->t) == 0)
  77         {
  78           *found = TRUE;
  79           return n;
  80         }
  81     }
  82
  83   *found = FALSE;
  84   return n;                     /* (n == (ffename) &ns->first) */
  85 }
  86
  87 /* Searches for and returns the matching ffename object, or creates a new
  88    one (with a NULL ffesymbol) and returns that.  If last arg is TRUE,
  89    check whether token meets character-content requirements (such as
  90    "all characters must be uppercase", as determined by
  91    ffesrc_bad_char_symbol (), issue diagnostic if it doesn't.  */
  92
  93 ffename
  94 ffename_find (ffenameSpace ns, ffelexToken t)
  95 {
  96   ffename n;
  97   ffename newn;
  98   bool found;
  99
 100   assert (ns != NULL);
 101   assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
 102                           || (ffelex_token_type (t) == FFELEX_typeNAMES)));
 103
 104   n = ffename_lookup_ (ns, t, &found);
 105   if (found)
 106     return n;
 107
 108   newn = malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n));
 109   newn->next = n;
 110   newn->previous = n->previous;
 111   n->previous = newn;
 112   newn->previous->next = newn;
 113   newn->t = ffelex_token_use (t);
 114   newn->u.s = NULL;
 115
 116   return newn;
 117 }
 118
 119 /* ffename_kill -- Kill name from name space
 120
 121    ffenameSpace ns;
 122    ffename s;
 123    ffename_kill(ns,s);
 124
 125    Removes the name from the name space.  */
 126
 127 void
 128 ffename_kill (ffenameSpace ns, ffename n)
 129 {
 130   assert (ns != NULL);
 131   assert (n != NULL);
 132
 133   ffelex_token_kill (n->t);
 134   n->next->previous = n->previous;
 135   n->previous->next = n->next;
 136   malloc_kill_ks (ns->pool, n, sizeof (*n));
 137 }
 138
 139 /* ffename_lookup -- Look up name in name space
 140
 141    ffenameSpace ns;
 142    ffelexToken t;
 143    ffename s;
 144    n = ffename_lookup(ns,t);
 145
 146    Searches for and returns the matching ffename object, or returns NULL.  */
 147
 148 ffename
 149 ffename_lookup (ffenameSpace ns, ffelexToken t)
 150 {
 151   ffename n;
 152   bool found;
 153
 154   assert (ns != NULL);
 155   assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
 156                           || (ffelex_token_type (t) == FFELEX_typeNAMES)));
 157
 158   n = ffename_lookup_ (ns, t, &found);
 159
 160   return found ? n : NULL;
 161 }
 162
 163 /* ffename_space_drive_global -- Call given fn for each global in name space
 164
 165    ffenameSpace ns;
 166    ffeglobal (*fn)();
 167    ffename_space_drive_global(ns,fn);  */
 168
 169 void
 170 ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal))
 171 {
 172   ffename n;
 173
 174   if (ns == NULL)
 175     return;
 176
 177   for (n = ns->first; n != (ffename) &ns->first; n = n->next)
 178     {
 179       if (n->u.g != NULL)
 180         n->u.g = (*fn) (n->u.g);
 181     }
 182 }
 183
 184 /* ffename_space_drive_symbol -- Call given fn for each symbol in name space
 185
 186    ffenameSpace ns;
 187    ffesymbol (*fn)();
 188    ffename_space_drive_symbol(ns,fn);  */
 189
 190 void
 191 ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol))
 192 {
 193   ffename n;
 194
 195   if (ns == NULL)
 196     return;
 197
 198   for (n = ns->first; n != (ffename) &ns->first; n = n->next)
 199     {
 200       if (n->u.s != NULL)
 201         n->u.s = (*fn) (n->u.s);
 202     }
 203 }
 204
 205 /* ffename_space_kill -- Kill name space
 206
 207    ffenameSpace ns;
 208    ffename_space_kill(ns);
 209
 210    Removes the names from the name space; kills the name space.  */
 211
 212 void
 213 ffename_space_kill (ffenameSpace ns)
 214 {
 215   assert (ns != NULL);
 216
 217   while (ns->first != (ffename) &ns->first)
 218     ffename_kill (ns, ns->first);
 219
 220   malloc_kill_ks (ns->pool, ns, sizeof (*ns));
 221 }
 222
 223 /* ffename_space_new -- Create name space
 224
 225    ffenameSpace ns;
 226    ns = ffename_space_new(malloc_pool_image());
 227
 228    Create new name space.  */
 229
 230 ffenameSpace
 231 ffename_space_new (mallocPool pool)
 232 {
 233   ffenameSpace ns;
 234
 235   ns = malloc_new_ks (pool, "FFENAME space", sizeof (*ns));
 236   ns->first = (ffename) &ns->first;
 237   ns->last = (ffename) &ns->first;
 238   ns->pool = pool;
 239
 240   return ns;
 241 }