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 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 = (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 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 = (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