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
ffename_lookup_(ffenameSpace ns,ffelexToken t,bool * found)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
ffename_find(ffenameSpace ns,ffelexToken t)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
ffename_kill(ffenameSpace ns,ffename n)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
ffename_lookup(ffenameSpace ns,ffelexToken t)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
ffename_space_drive_global(ffenameSpace ns,ffeglobal (* fn)(ffeglobal))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
ffename_space_drive_symbol(ffenameSpace ns,ffesymbol (* fn)(ffesymbol))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
ffename_space_kill(ffenameSpace ns)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
ffename_space_new(mallocPool pool)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