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 5This file is part of GNU Fortran. 6 7GNU Fortran is free software; you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation; either version 2, or (at your option) 10any later version. 11 12GNU Fortran is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Fortran; see the file COPYING. If not, write to 19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 2002111-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 61static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found); 62 63/* Internal macros. */ 64 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 69static ffename 70ffename_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 93ffename 94ffename_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 = (ffename) 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 127void 128ffename_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 148ffename 149ffename_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 169void 170ffename_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 190void 191ffename_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 212void 213ffename_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 230ffenameSpace 231ffename_space_new (mallocPool pool) 232{ 233 ffenameSpace ns; 234 235 ns = (ffenameSpace) malloc_new_ks (pool, "FFENAME space", 236 sizeof (*ns)); 237 ns->first = (ffename) &ns->first; 238 ns->last = (ffename) &ns->first; 239 ns->pool = pool; 240 241 return ns; 242} 243