]>
Commit | Line | Data |
---|---|---|
5ff904cd | 1 | /* Implementation of Fortran symbol manager |
ddc612a2 AJ |
2 | Copyright (C) 1995, 1996, 1997, 2003 |
3 | Free Software Foundation, Inc. | |
25d7717e | 4 | Contributed by James Craig Burley. |
5ff904cd JL |
5 | |
6 | This file is part of GNU Fortran. | |
7 | ||
8 | GNU Fortran is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 2, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Fortran is distributed in the hope that it will be useful, | |
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | GNU General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Fortran; see the file COPYING. If not, write to | |
20 | the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA | |
21 | 02111-1307, USA. */ | |
22 | ||
23 | #include "proj.h" | |
24 | #include "symbol.h" | |
25 | #include "bad.h" | |
26 | #include "bld.h" | |
27 | #include "com.h" | |
28 | #include "equiv.h" | |
29 | #include "global.h" | |
30 | #include "info.h" | |
31 | #include "intrin.h" | |
32 | #include "lex.h" | |
33 | #include "malloc.h" | |
34 | #include "src.h" | |
35 | #include "st.h" | |
36 | #include "storag.h" | |
37 | #include "target.h" | |
38 | #include "where.h" | |
39 | ||
40 | /* Choice of how to handle global symbols -- either global only within the | |
41 | program unit being defined or global within the entire source file. | |
42 | The former is appropriate for systems where an object file can | |
43 | easily be taken apart program unit by program unit, the latter is the | |
44 | UNIX/C model where the object file is essentially a monolith. */ | |
45 | ||
46 | #define FFESYMBOL_globalPROGUNIT_ 1 | |
47 | #define FFESYMBOL_globalFILE_ 2 | |
48 | ||
49 | /* Choose how to handle global symbols here. */ | |
50 | ||
5ff904cd JL |
51 | /* Would be good to understand why PROGUNIT in this case too. |
52 | (1995-08-22). */ | |
53 | #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_ | |
5ff904cd JL |
54 | |
55 | /* Choose how to handle memory pools based on global symbol stuff. */ | |
56 | ||
57 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ | |
58 | #define FFESYMBOL_SPACE_POOL_ ffe_pool_program_unit() | |
59 | #elif FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ | |
60 | #define FFESYMBOL_SPACE_POOL_ ffe_pool_file() | |
61 | #else | |
62 | #error | |
63 | #endif | |
64 | ||
65 | /* What kind of retraction is needed for a symbol? */ | |
66 | ||
67 | enum _ffesymbol_retractcommand_ | |
68 | { | |
69 | FFESYMBOL_retractcommandDELETE_, | |
70 | FFESYMBOL_retractcommandRETRACT_, | |
71 | FFESYMBOL_retractcommand_ | |
72 | }; | |
73 | typedef enum _ffesymbol_retractcommand_ ffesymbolRetractCommand_; | |
74 | ||
75 | /* This object keeps track of retraction for a symbol and links to the next | |
76 | such object. */ | |
77 | ||
78 | typedef struct _ffesymbol_retract_ *ffesymbolRetract_; | |
79 | struct _ffesymbol_retract_ | |
80 | { | |
81 | ffesymbolRetract_ next; | |
82 | ffesymbolRetractCommand_ command; | |
83 | ffesymbol live; /* Live symbol. */ | |
84 | ffesymbol symbol; /* Backup copy of symbol. */ | |
85 | }; | |
86 | ||
87 | static ffebad ffesymbol_check_token_ (ffelexToken t, char *c); | |
88 | static void ffesymbol_kill_manifest_ (void); | |
89 | static ffesymbol ffesymbol_new_ (ffename n); | |
90 | static ffesymbol ffesymbol_unhook_ (ffesymbol s); | |
91 | static void ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c); | |
92 | ||
93 | /* Manifest names for unnamed things (as tokens) so we make them only | |
94 | once. */ | |
95 | ||
96 | static ffelexToken ffesymbol_token_blank_common_ = NULL; | |
97 | static ffelexToken ffesymbol_token_unnamed_main_ = NULL; | |
98 | static ffelexToken ffesymbol_token_unnamed_blockdata_ = NULL; | |
99 | ||
100 | /* Name spaces currently in force. */ | |
101 | ||
102 | static ffenameSpace ffesymbol_global_ = NULL; | |
103 | static ffenameSpace ffesymbol_local_ = NULL; | |
104 | static ffenameSpace ffesymbol_sfunc_ = NULL; | |
105 | ||
106 | /* Keep track of retraction. */ | |
107 | ||
108 | static bool ffesymbol_retractable_ = FALSE; | |
109 | static mallocPool ffesymbol_retract_pool_; | |
110 | static ffesymbolRetract_ ffesymbol_retract_first_; | |
111 | static ffesymbolRetract_ *ffesymbol_retract_list_; | |
112 | ||
113 | /* List of state names. */ | |
114 | ||
19dab795 | 115 | static const char *const ffesymbol_state_name_[] = |
5ff904cd JL |
116 | { |
117 | "?", | |
118 | "@", | |
119 | "&", | |
120 | "$", | |
121 | }; | |
122 | ||
123 | /* List of attribute names. */ | |
124 | ||
19dab795 | 125 | static const char *const ffesymbol_attr_name_[] = |
5ff904cd JL |
126 | { |
127 | #define DEFATTR(ATTR,ATTRS,NAME) NAME, | |
128 | #include "symbol.def" | |
129 | #undef DEFATTR | |
130 | }; | |
131 | \f | |
132 | ||
133 | /* Check whether the token text has any invalid characters. If not, | |
134 | return FALSE. If so, if error messages inhibited, return TRUE | |
135 | so caller knows to try again later, else report error and return | |
136 | FALSE. */ | |
137 | ||
138 | static ffebad | |
139 | ffesymbol_check_token_ (ffelexToken t, char *c) | |
140 | { | |
141 | char *p = ffelex_token_text (t); | |
142 | ffeTokenLength len = ffelex_token_length (t); | |
143 | ffebad bad; | |
144 | ffeTokenLength i = 0; | |
145 | ffebad skip_me = ((ffe_case_symbol () == FFE_caseINITCAP) | |
146 | ? FFEBAD_SYMBOL_NOLOWER_INITCAP : FFEBAD + 1); | |
147 | ffebad stop_me = ((ffe_case_symbol () == FFE_caseINITCAP) | |
148 | ? FFEBAD : FFEBAD + 1); | |
149 | if (len == 0) | |
150 | return FFEBAD; | |
151 | ||
152 | bad = ffesrc_bad_char_symbol_init (*p); | |
153 | if (bad == FFEBAD) | |
154 | { | |
155 | for (++i, ++p; i < len; ++i, ++p) | |
156 | { | |
157 | bad = ffesrc_bad_char_symbol_noninit (*p); | |
158 | if (bad == skip_me) | |
159 | continue; /* Keep looking for good InitCap character. */ | |
160 | if (bad == stop_me) | |
161 | break; /* Found good InitCap character. */ | |
162 | if (bad != FFEBAD) | |
163 | break; /* Bad character found. */ | |
164 | } | |
165 | } | |
166 | ||
167 | if (bad != FFEBAD) | |
567f3d36 KG |
168 | { |
169 | if (i >= len) | |
170 | *c = *(ffelex_token_text (t)); | |
171 | else | |
172 | *c = *p; | |
173 | } | |
5ff904cd JL |
174 | |
175 | return bad; | |
176 | } | |
177 | ||
178 | /* Kill manifest (g77-picked) names. */ | |
179 | ||
180 | static void | |
77f9b92c | 181 | ffesymbol_kill_manifest_ (void) |
5ff904cd JL |
182 | { |
183 | if (ffesymbol_token_blank_common_ != NULL) | |
184 | ffelex_token_kill (ffesymbol_token_blank_common_); | |
185 | if (ffesymbol_token_unnamed_main_ != NULL) | |
186 | ffelex_token_kill (ffesymbol_token_unnamed_main_); | |
187 | if (ffesymbol_token_unnamed_blockdata_ != NULL) | |
188 | ffelex_token_kill (ffesymbol_token_unnamed_blockdata_); | |
189 | ||
190 | ffesymbol_token_blank_common_ = NULL; | |
191 | ffesymbol_token_unnamed_main_ = NULL; | |
192 | ffesymbol_token_unnamed_blockdata_ = NULL; | |
193 | } | |
194 | ||
195 | /* Make new symbol. | |
196 | ||
197 | If the "retractable" flag is not set, just return the new symbol. | |
198 | Else, add symbol to the "retract" list as a delete item, set | |
199 | the "have_old" flag, and return the new symbol. */ | |
200 | ||
201 | static ffesymbol | |
202 | ffesymbol_new_ (ffename n) | |
203 | { | |
204 | ffesymbol s; | |
205 | ffesymbolRetract_ r; | |
206 | ||
207 | assert (n != NULL); | |
208 | ||
c68b0a84 | 209 | s = malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL", sizeof (*s)); |
5ff904cd JL |
210 | s->name = n; |
211 | s->other_space_name = NULL; | |
212 | #if FFEGLOBAL_ENABLED | |
213 | s->global = NULL; | |
214 | #endif | |
215 | s->attrs = FFESYMBOL_attrsetNONE; | |
216 | s->state = FFESYMBOL_stateNONE; | |
217 | s->info = ffeinfo_new_null (); | |
218 | s->dims = NULL; | |
219 | s->extents = NULL; | |
220 | s->dim_syms = NULL; | |
221 | s->array_size = NULL; | |
222 | s->init = NULL; | |
223 | s->accretion = NULL; | |
224 | s->accretes = 0; | |
225 | s->dummy_args = NULL; | |
226 | s->namelist = NULL; | |
227 | s->common_list = NULL; | |
228 | s->sfunc_expr = NULL; | |
229 | s->list_bottom = NULL; | |
230 | s->common = NULL; | |
231 | s->equiv = NULL; | |
232 | s->storage = NULL; | |
5ff904cd | 233 | s->hook = FFECOM_symbolNULL; |
5ff904cd JL |
234 | s->sfa_dummy_parent = NULL; |
235 | s->func_result = NULL; | |
236 | s->value = 0; | |
237 | s->check_state = FFESYMBOL_checkstateNONE_; | |
238 | s->check_token = NULL; | |
239 | s->max_entry_num = 0; | |
240 | s->num_entries = 0; | |
241 | s->generic = FFEINTRIN_genNONE; | |
242 | s->specific = FFEINTRIN_specNONE; | |
243 | s->implementation = FFEINTRIN_impNONE; | |
244 | s->is_save = FALSE; | |
245 | s->is_init = FALSE; | |
246 | s->do_iter = FALSE; | |
247 | s->reported = FALSE; | |
248 | s->explicit_where = FALSE; | |
249 | s->namelisted = FALSE; | |
c7e4ee3a | 250 | s->assigned = FALSE; |
5ff904cd JL |
251 | |
252 | ffename_set_symbol (n, s); | |
253 | ||
254 | if (!ffesymbol_retractable_) | |
255 | { | |
256 | s->have_old = FALSE; | |
257 | return s; | |
258 | } | |
259 | ||
c68b0a84 KG |
260 | r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract", |
261 | sizeof (*r)); | |
5ff904cd JL |
262 | r->next = NULL; |
263 | r->command = FFESYMBOL_retractcommandDELETE_; | |
264 | r->live = s; | |
265 | r->symbol = NULL; /* No backup copy. */ | |
266 | ||
267 | *ffesymbol_retract_list_ = r; | |
268 | ffesymbol_retract_list_ = &r->next; | |
269 | ||
270 | s->have_old = TRUE; | |
271 | return s; | |
272 | } | |
273 | ||
274 | /* Unhook a symbol from its (soon-to-be-killed) name obj. | |
275 | ||
276 | NULLify the names to which this symbol points. Do other cleanup as | |
277 | needed. */ | |
278 | ||
279 | static ffesymbol | |
280 | ffesymbol_unhook_ (ffesymbol s) | |
281 | { | |
282 | s->other_space_name = s->name = NULL; | |
283 | if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK) | |
284 | || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST)) | |
285 | ffebld_end_list (ffesymbol_ptr_to_listbottom (s)); | |
286 | if (s->check_state == FFESYMBOL_checkstatePENDING_) | |
287 | ffelex_token_kill (s->check_token); | |
288 | ||
289 | return s; | |
290 | } | |
291 | ||
292 | /* Issue diagnostic about bad character in token representing user-defined | |
293 | symbol name. */ | |
294 | ||
295 | static void | |
296 | ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c) | |
297 | { | |
298 | char badstr[2]; | |
299 | ||
300 | badstr[0] = c; | |
301 | badstr[1] = '\0'; | |
302 | ||
303 | ffebad_start (bad); | |
304 | ffebad_here (0, ffelex_token_where_line (t), | |
305 | ffelex_token_where_column (t)); | |
306 | ffebad_string (badstr); | |
307 | ffebad_finish (); | |
308 | } | |
309 | ||
310 | /* Returns a string representing the attributes set. */ | |
311 | ||
26f096f9 | 312 | const char * |
5ff904cd JL |
313 | ffesymbol_attrs_string (ffesymbolAttrs attrs) |
314 | { | |
315 | static char string[FFESYMBOL_attr * 12 + 20]; | |
316 | char *p; | |
317 | ffesymbolAttr attr; | |
318 | ||
319 | p = &string[0]; | |
320 | ||
321 | if (attrs == FFESYMBOL_attrsetNONE) | |
322 | { | |
323 | strcpy (p, "NONE"); | |
324 | return &string[0]; | |
325 | } | |
326 | ||
327 | for (attr = 0; attr < FFESYMBOL_attr; ++attr) | |
328 | { | |
329 | if (attrs & ((ffesymbolAttrs) 1 << attr)) | |
330 | { | |
331 | attrs &= ~((ffesymbolAttrs) 1 << attr); | |
332 | strcpy (p, ffesymbol_attr_name_[attr]); | |
333 | while (*p) | |
334 | ++p; | |
335 | *(p++) = '|'; | |
336 | } | |
337 | } | |
338 | if (attrs == FFESYMBOL_attrsetNONE) | |
339 | *--p = '\0'; | |
340 | else | |
341 | sprintf (p, "?0x%" ffesymbolAttrs_f "x?", attrs); | |
342 | assert (((size_t) (p - &string[0])) < ARRAY_SIZE (string)); | |
343 | return &string[0]; | |
344 | } | |
345 | ||
346 | /* Check symbol's name for validity, considering that it might actually | |
347 | be an intrinsic and thus should not be complained about just yet. */ | |
348 | ||
349 | void | |
350 | ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin) | |
351 | { | |
352 | char c; | |
353 | ffebad bad; | |
354 | ffeintrinGen gen; | |
355 | ffeintrinSpec spec; | |
356 | ffeintrinImp imp; | |
357 | ||
358 | if (!ffesrc_check_symbol () | |
359 | || ((s->check_state != FFESYMBOL_checkstateNONE_) | |
360 | && ((s->check_state != FFESYMBOL_checkstateINHIBITED_) | |
361 | || ffebad_inhibit ()))) | |
362 | return; | |
363 | ||
364 | bad = ffesymbol_check_token_ (t, &c); | |
365 | ||
366 | if (bad == FFEBAD) | |
367 | { | |
368 | s->check_state = FFESYMBOL_checkstateCHECKED_; | |
369 | return; | |
370 | } | |
371 | ||
372 | if (maybe_intrin | |
373 | && ffeintrin_is_intrinsic (ffelex_token_text (t), NULL, FALSE, | |
374 | &gen, &spec, &imp)) | |
375 | { | |
376 | s->check_state = FFESYMBOL_checkstatePENDING_; | |
377 | s->check_token = ffelex_token_use (t); | |
378 | return; | |
379 | } | |
380 | ||
381 | if (ffebad_inhibit ()) | |
382 | { | |
383 | s->check_state = FFESYMBOL_checkstateINHIBITED_; | |
384 | return; /* Don't complain now, do it later. */ | |
385 | } | |
386 | ||
387 | s->check_state = FFESYMBOL_checkstateCHECKED_; | |
388 | ||
389 | ffesymbol_whine_state_ (bad, t, c); | |
390 | } | |
391 | ||
392 | /* Declare a BLOCKDATA unit. | |
393 | ||
394 | Retrieves or creates the ffesymbol for the specified BLOCKDATA (unnamed | |
395 | if t is NULL). Doesn't actually ensure the named item is a | |
396 | BLOCKDATA; the caller must handle that. */ | |
397 | ||
398 | ffesymbol | |
399 | ffesymbol_declare_blockdataunit (ffelexToken t, ffewhereLine wl, | |
400 | ffewhereColumn wc) | |
401 | { | |
402 | ffename n; | |
403 | ffesymbol s; | |
404 | bool user = (t != NULL); | |
405 | ||
406 | assert (!ffesymbol_retractable_); | |
407 | ||
408 | if (t == NULL) | |
409 | { | |
410 | if (ffesymbol_token_unnamed_blockdata_ == NULL) | |
411 | ffesymbol_token_unnamed_blockdata_ | |
412 | = ffelex_token_new_name (FFETARGET_nameUNNAMED_BLOCK_DATA, wl, wc); | |
413 | t = ffesymbol_token_unnamed_blockdata_; | |
414 | } | |
415 | ||
416 | n = ffename_lookup (ffesymbol_local_, t); | |
417 | if (n != NULL) | |
418 | return ffename_symbol (n); /* This will become an error. */ | |
419 | ||
420 | n = ffename_find (ffesymbol_global_, t); | |
421 | s = ffename_symbol (n); | |
422 | if (s != NULL) | |
423 | { | |
424 | if (user) | |
425 | ffesymbol_check (s, t, FALSE); | |
426 | return s; | |
427 | } | |
428 | ||
429 | s = ffesymbol_new_ (n); | |
430 | if (user) | |
431 | ffesymbol_check (s, t, FALSE); | |
432 | ||
433 | /* A program unit name also is in the local name space. */ | |
434 | ||
435 | n = ffename_find (ffesymbol_local_, t); | |
436 | ffename_set_symbol (n, s); | |
437 | s->other_space_name = n; | |
438 | ||
439 | ffeglobal_new_blockdata (s, t); /* Detect conflicts, when | |
440 | appropriate. */ | |
441 | ||
442 | return s; | |
443 | } | |
444 | ||
445 | /* Declare a common block (named or unnamed). | |
446 | ||
447 | Retrieves or creates the ffesymbol for the specified common block (blank | |
448 | common if t is NULL). Doesn't actually ensure the named item is a | |
449 | common block; the caller must handle that. */ | |
450 | ||
451 | ffesymbol | |
452 | ffesymbol_declare_cblock (ffelexToken t, ffewhereLine wl, ffewhereColumn wc) | |
453 | { | |
454 | ffename n; | |
455 | ffesymbol s; | |
456 | bool blank; | |
457 | ||
458 | assert (!ffesymbol_retractable_); | |
459 | ||
460 | if (t == NULL) | |
461 | { | |
462 | blank = TRUE; | |
463 | if (ffesymbol_token_blank_common_ == NULL) | |
464 | ffesymbol_token_blank_common_ | |
465 | = ffelex_token_new_name (FFETARGET_nameBLANK_COMMON, wl, wc); | |
466 | t = ffesymbol_token_blank_common_; | |
467 | } | |
468 | else | |
469 | blank = FALSE; | |
470 | ||
471 | n = ffename_find (ffesymbol_global_, t); | |
472 | s = ffename_symbol (n); | |
473 | if (s != NULL) | |
474 | { | |
475 | if (!blank) | |
476 | ffesymbol_check (s, t, FALSE); | |
477 | return s; | |
478 | } | |
479 | ||
480 | s = ffesymbol_new_ (n); | |
481 | if (!blank) | |
482 | ffesymbol_check (s, t, FALSE); | |
483 | ||
484 | ffeglobal_new_common (s, t, blank); /* Detect conflicts. */ | |
485 | ||
486 | return s; | |
487 | } | |
488 | ||
489 | /* Declare a FUNCTION program unit (with distinct RESULT() name). | |
490 | ||
491 | Retrieves or creates the ffesymbol for the specified function. Doesn't | |
492 | actually ensure the named item is a function; the caller must handle | |
493 | that. | |
494 | ||
495 | If FUNCTION with RESULT() is specified but the names are the same, | |
496 | pretend as though RESULT() was not specified, and don't call this | |
497 | function; use ffesymbol_declare_funcunit() instead. */ | |
498 | ||
499 | ffesymbol | |
500 | ffesymbol_declare_funcnotresunit (ffelexToken t) | |
501 | { | |
502 | ffename n; | |
503 | ffesymbol s; | |
504 | ||
505 | assert (t != NULL); | |
506 | assert (!ffesymbol_retractable_); | |
507 | ||
508 | n = ffename_lookup (ffesymbol_local_, t); | |
509 | if (n != NULL) | |
510 | return ffename_symbol (n); /* This will become an error. */ | |
511 | ||
512 | n = ffename_find (ffesymbol_global_, t); | |
513 | s = ffename_symbol (n); | |
514 | if (s != NULL) | |
515 | { | |
516 | ffesymbol_check (s, t, FALSE); | |
517 | return s; | |
518 | } | |
519 | ||
520 | s = ffesymbol_new_ (n); | |
521 | ffesymbol_check (s, t, FALSE); | |
522 | ||
523 | /* A FUNCTION program unit name also is in the local name space; handle it | |
524 | here since RESULT() is a different name and is handled separately. */ | |
525 | ||
526 | n = ffename_find (ffesymbol_local_, t); | |
527 | ffename_set_symbol (n, s); | |
528 | s->other_space_name = n; | |
529 | ||
530 | ffeglobal_new_function (s, t);/* Detect conflicts, when appropriate. */ | |
531 | ||
532 | return s; | |
533 | } | |
534 | ||
535 | /* Declare a function result. | |
536 | ||
537 | Retrieves or creates the ffesymbol for the specified function result, | |
538 | whether specified via a distinct RESULT() or by default in a FUNCTION or | |
539 | ENTRY statement. */ | |
540 | ||
541 | ffesymbol | |
542 | ffesymbol_declare_funcresult (ffelexToken t) | |
543 | { | |
544 | ffename n; | |
545 | ffesymbol s; | |
546 | ||
547 | assert (t != NULL); | |
548 | assert (!ffesymbol_retractable_); | |
549 | ||
550 | n = ffename_find (ffesymbol_local_, t); | |
551 | s = ffename_symbol (n); | |
552 | if (s != NULL) | |
553 | return s; | |
554 | ||
555 | return ffesymbol_new_ (n); | |
556 | } | |
557 | ||
558 | /* Declare a FUNCTION program unit with no RESULT(). | |
559 | ||
560 | Retrieves or creates the ffesymbol for the specified function. Doesn't | |
561 | actually ensure the named item is a function; the caller must handle | |
562 | that. | |
563 | ||
564 | This is the function to call when the FUNCTION or ENTRY statement has | |
565 | no separate and distinct name specified via RESULT(). That's because | |
566 | this function enters the global name of the function in only the global | |
567 | name space. ffesymbol_declare_funcresult() must still be called to | |
568 | declare the name for the function result in the local name space. */ | |
569 | ||
570 | ffesymbol | |
571 | ffesymbol_declare_funcunit (ffelexToken t) | |
572 | { | |
573 | ffename n; | |
574 | ffesymbol s; | |
575 | ||
576 | assert (t != NULL); | |
577 | assert (!ffesymbol_retractable_); | |
578 | ||
579 | n = ffename_find (ffesymbol_global_, t); | |
580 | s = ffename_symbol (n); | |
581 | if (s != NULL) | |
582 | { | |
583 | ffesymbol_check (s, t, FALSE); | |
584 | return s; | |
585 | } | |
586 | ||
587 | s = ffesymbol_new_ (n); | |
588 | ffesymbol_check (s, t, FALSE); | |
589 | ||
590 | ffeglobal_new_function (s, t);/* Detect conflicts. */ | |
591 | ||
592 | return s; | |
593 | } | |
594 | ||
595 | /* Declare a local entity. | |
596 | ||
597 | Retrieves or creates the ffesymbol for the specified local entity. | |
598 | Set maybe_intrin TRUE if this name might turn out to name an | |
599 | intrinsic (legitimately); otherwise if the name doesn't meet the | |
600 | requirements for a user-defined symbol name, a diagnostic will be | |
601 | issued right away rather than waiting until the intrinsicness of the | |
602 | symbol is determined. */ | |
603 | ||
604 | ffesymbol | |
605 | ffesymbol_declare_local (ffelexToken t, bool maybe_intrin) | |
606 | { | |
607 | ffename n; | |
608 | ffesymbol s; | |
609 | ||
610 | assert (t != NULL); | |
611 | ||
612 | /* If we're parsing within a statement function definition, return the | |
613 | symbol if already known (a dummy argument for the statement function). | |
614 | Otherwise continue on, which means the symbol is declared within the | |
615 | containing (local) program unit rather than the statement function | |
616 | definition. */ | |
617 | ||
618 | if ((ffesymbol_sfunc_ != NULL) | |
619 | && ((n = ffename_lookup (ffesymbol_sfunc_, t)) != NULL)) | |
620 | return ffename_symbol (n); | |
621 | ||
622 | n = ffename_find (ffesymbol_local_, t); | |
623 | s = ffename_symbol (n); | |
624 | if (s != NULL) | |
625 | { | |
626 | ffesymbol_check (s, t, maybe_intrin); | |
627 | return s; | |
628 | } | |
629 | ||
630 | s = ffesymbol_new_ (n); | |
631 | ffesymbol_check (s, t, maybe_intrin); | |
632 | return s; | |
633 | } | |
634 | ||
635 | /* Declare a main program unit. | |
636 | ||
637 | Retrieves or creates the ffesymbol for the specified main program unit | |
638 | (unnamed main program unit if t is NULL). Doesn't actually ensure the | |
639 | named item is a program; the caller must handle that. */ | |
640 | ||
641 | ffesymbol | |
642 | ffesymbol_declare_programunit (ffelexToken t, ffewhereLine wl, | |
643 | ffewhereColumn wc) | |
644 | { | |
645 | ffename n; | |
646 | ffesymbol s; | |
647 | bool user = (t != NULL); | |
648 | ||
649 | assert (!ffesymbol_retractable_); | |
650 | ||
651 | if (t == NULL) | |
652 | { | |
653 | if (ffesymbol_token_unnamed_main_ == NULL) | |
654 | ffesymbol_token_unnamed_main_ | |
655 | = ffelex_token_new_name (FFETARGET_nameUNNAMED_MAIN, wl, wc); | |
656 | t = ffesymbol_token_unnamed_main_; | |
657 | } | |
658 | ||
659 | n = ffename_lookup (ffesymbol_local_, t); | |
660 | if (n != NULL) | |
661 | return ffename_symbol (n); /* This will become an error. */ | |
662 | ||
663 | n = ffename_find (ffesymbol_global_, t); | |
664 | s = ffename_symbol (n); | |
665 | if (s != NULL) | |
666 | { | |
667 | if (user) | |
668 | ffesymbol_check (s, t, FALSE); | |
669 | return s; | |
670 | } | |
671 | ||
672 | s = ffesymbol_new_ (n); | |
673 | if (user) | |
674 | ffesymbol_check (s, t, FALSE); | |
675 | ||
676 | /* A program unit name also is in the local name space. */ | |
677 | ||
678 | n = ffename_find (ffesymbol_local_, t); | |
679 | ffename_set_symbol (n, s); | |
680 | s->other_space_name = n; | |
681 | ||
682 | ffeglobal_new_program (s, t); /* Detect conflicts. */ | |
683 | ||
684 | return s; | |
685 | } | |
686 | ||
687 | /* Declare a statement-function dummy. | |
688 | ||
689 | Retrieves or creates the ffesymbol for the specified statement | |
690 | function dummy. Also ensures that it has a link to the parent (local) | |
691 | ffesymbol with the same name, creating it if necessary. */ | |
692 | ||
693 | ffesymbol | |
694 | ffesymbol_declare_sfdummy (ffelexToken t) | |
695 | { | |
696 | ffename n; | |
697 | ffesymbol s; | |
698 | ffesymbol sp; /* Parent symbol in local area. */ | |
699 | ||
700 | assert (t != NULL); | |
701 | ||
702 | n = ffename_find (ffesymbol_local_, t); | |
703 | sp = ffename_symbol (n); | |
704 | if (sp == NULL) | |
705 | sp = ffesymbol_new_ (n); | |
706 | ffesymbol_check (sp, t, FALSE); | |
707 | ||
708 | n = ffename_find (ffesymbol_sfunc_, t); | |
709 | s = ffename_symbol (n); | |
710 | if (s == NULL) | |
711 | { | |
712 | s = ffesymbol_new_ (n); | |
713 | s->sfa_dummy_parent = sp; | |
714 | } | |
715 | else | |
716 | assert (s->sfa_dummy_parent == sp); | |
717 | ||
718 | return s; | |
719 | } | |
720 | ||
721 | /* Declare a subroutine program unit. | |
722 | ||
723 | Retrieves or creates the ffesymbol for the specified subroutine | |
724 | Doesn't actually ensure the named item is a subroutine; the caller must | |
725 | handle that. */ | |
726 | ||
727 | ffesymbol | |
728 | ffesymbol_declare_subrunit (ffelexToken t) | |
729 | { | |
730 | ffename n; | |
731 | ffesymbol s; | |
732 | ||
733 | assert (!ffesymbol_retractable_); | |
734 | assert (t != NULL); | |
735 | ||
736 | n = ffename_lookup (ffesymbol_local_, t); | |
737 | if (n != NULL) | |
738 | return ffename_symbol (n); /* This will become an error. */ | |
739 | ||
740 | n = ffename_find (ffesymbol_global_, t); | |
741 | s = ffename_symbol (n); | |
742 | if (s != NULL) | |
743 | { | |
744 | ffesymbol_check (s, t, FALSE); | |
745 | return s; | |
746 | } | |
747 | ||
748 | s = ffesymbol_new_ (n); | |
749 | ffesymbol_check (s, t, FALSE); | |
750 | ||
751 | /* A program unit name also is in the local name space. */ | |
752 | ||
753 | n = ffename_find (ffesymbol_local_, t); | |
754 | ffename_set_symbol (n, s); | |
755 | s->other_space_name = n; | |
756 | ||
757 | ffeglobal_new_subroutine (s, t); /* Detect conflicts, when | |
758 | appropriate. */ | |
759 | ||
760 | return s; | |
761 | } | |
762 | ||
763 | /* Call given fn with all local/global symbols. | |
764 | ||
765 | ffesymbol (*fn) (ffesymbol s); | |
766 | ffesymbol_drive (fn); */ | |
767 | ||
768 | void | |
26f096f9 | 769 | ffesymbol_drive (ffesymbol (*fn) (ffesymbol)) |
5ff904cd JL |
770 | { |
771 | assert (ffesymbol_sfunc_ == NULL); /* Might be ok, but not for current | |
772 | uses. */ | |
773 | ffename_space_drive_symbol (ffesymbol_local_, fn); | |
774 | ffename_space_drive_symbol (ffesymbol_global_, fn); | |
775 | } | |
776 | ||
777 | /* Call given fn with all sfunc-only symbols. | |
778 | ||
779 | ffesymbol (*fn) (ffesymbol s); | |
780 | ffesymbol_drive_sfnames (fn); */ | |
781 | ||
782 | void | |
26f096f9 | 783 | ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol)) |
5ff904cd JL |
784 | { |
785 | ffename_space_drive_symbol (ffesymbol_sfunc_, fn); | |
786 | } | |
787 | ||
5ff904cd JL |
788 | /* Produce generic error message about a symbol. |
789 | ||
790 | For now, just output error message using symbol's name and pointing to | |
791 | the token. */ | |
792 | ||
793 | void | |
794 | ffesymbol_error (ffesymbol s, ffelexToken t) | |
795 | { | |
796 | if ((t != NULL) | |
797 | && ffest_ffebad_start (FFEBAD_SYMERR)) | |
798 | { | |
799 | ffebad_string (ffesymbol_text (s)); | |
800 | ffebad_here (0, ffelex_token_where_line (t), | |
801 | ffelex_token_where_column (t)); | |
802 | ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s)); | |
803 | ffebad_finish (); | |
804 | } | |
805 | ||
806 | if (ffesymbol_attr (s, FFESYMBOL_attrANY)) | |
807 | return; | |
808 | ||
809 | ffesymbol_signal_change (s); /* May need to back up to previous version. */ | |
810 | if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK) | |
811 | || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST)) | |
812 | ffebld_end_list (ffesymbol_ptr_to_listbottom (s)); | |
813 | ffesymbol_set_attr (s, FFESYMBOL_attrANY); | |
814 | ffesymbol_set_info (s, ffeinfo_new_any ()); | |
815 | ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD); | |
816 | if (s->check_state == FFESYMBOL_checkstatePENDING_) | |
817 | ffelex_token_kill (s->check_token); | |
818 | s->check_state = FFESYMBOL_checkstateCHECKED_; | |
819 | s = ffecom_sym_learned (s); | |
820 | ffesymbol_signal_unreported (s); | |
821 | } | |
822 | ||
823 | void | |
77f9b92c | 824 | ffesymbol_init_0 (void) |
5ff904cd JL |
825 | { |
826 | ffesymbolAttrs attrs = FFESYMBOL_attrsetNONE; | |
827 | ||
828 | assert (FFESYMBOL_state == ARRAY_SIZE (ffesymbol_state_name_)); | |
829 | assert (FFESYMBOL_attr == ARRAY_SIZE (ffesymbol_attr_name_)); | |
830 | assert (attrs == FFESYMBOL_attrsetNONE); | |
831 | attrs = ((ffesymbolAttrs) 1 << FFESYMBOL_attr); | |
832 | assert (attrs != 0); | |
833 | } | |
834 | ||
835 | void | |
77f9b92c | 836 | ffesymbol_init_1 (void) |
5ff904cd JL |
837 | { |
838 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ | |
839 | ffesymbol_global_ = ffename_space_new (ffe_pool_file ()); | |
840 | #endif | |
841 | } | |
842 | ||
843 | void | |
77f9b92c | 844 | ffesymbol_init_2 (void) |
5ff904cd JL |
845 | { |
846 | } | |
847 | ||
848 | void | |
77f9b92c | 849 | ffesymbol_init_3 (void) |
5ff904cd JL |
850 | { |
851 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ | |
852 | ffesymbol_global_ = ffename_space_new (ffe_pool_program_unit ()); | |
853 | #endif | |
854 | ffesymbol_local_ = ffename_space_new (ffe_pool_program_unit ()); | |
855 | } | |
856 | ||
857 | void | |
77f9b92c | 858 | ffesymbol_init_4 (void) |
5ff904cd JL |
859 | { |
860 | ffesymbol_sfunc_ = ffename_space_new (ffe_pool_program_unit ()); | |
861 | } | |
862 | ||
863 | /* Look up a local entity. | |
864 | ||
865 | Retrieves the ffesymbol for the specified local entity, or returns NULL | |
866 | if no local entity by that name exists. */ | |
867 | ||
868 | ffesymbol | |
869 | ffesymbol_lookup_local (ffelexToken t) | |
870 | { | |
871 | ffename n; | |
872 | ffesymbol s; | |
873 | ||
874 | assert (t != NULL); | |
875 | ||
876 | n = ffename_lookup (ffesymbol_local_, t); | |
877 | if (n == NULL) | |
878 | return NULL; | |
879 | ||
880 | s = ffename_symbol (n); | |
881 | return s; /* May be NULL here, too. */ | |
882 | } | |
883 | ||
884 | /* Registers the symbol as one that is referenced by the | |
885 | current program unit. Currently applies only to | |
886 | symbols known to have global interest (globals and | |
887 | intrinsics). | |
888 | ||
889 | s is the (global/intrinsic) symbol referenced; t is the | |
890 | referencing token; explicit is TRUE if the reference | |
891 | is, e.g., INTRINSIC FOO. */ | |
892 | ||
893 | void | |
894 | ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit) | |
895 | { | |
896 | ffename gn; | |
897 | ffesymbol gs = NULL; | |
898 | ffeinfoKind kind; | |
899 | ffeinfoWhere where; | |
900 | bool okay; | |
901 | ||
902 | if (ffesymbol_retractable_) | |
903 | return; | |
904 | ||
905 | if (t == NULL) | |
906 | t = ffename_token (s->name); /* Use the first reference in this program unit. */ | |
907 | ||
908 | kind = ffesymbol_kind (s); | |
909 | where = ffesymbol_where (s); | |
910 | ||
911 | if (where == FFEINFO_whereINTRINSIC) | |
912 | { | |
913 | ffeglobal_ref_intrinsic (s, t, | |
914 | explicit | |
915 | || s->explicit_where | |
916 | || ffeintrin_is_standard (s->generic, s->specific)); | |
917 | return; | |
918 | } | |
919 | ||
920 | if ((where != FFEINFO_whereGLOBAL) | |
921 | && ((where != FFEINFO_whereLOCAL) | |
922 | || ((kind != FFEINFO_kindFUNCTION) | |
923 | && (kind != FFEINFO_kindSUBROUTINE)))) | |
924 | return; | |
925 | ||
926 | gn = ffename_lookup (ffesymbol_global_, t); | |
927 | if (gn != NULL) | |
928 | gs = ffename_symbol (gn); | |
929 | if ((gs != NULL) && (gs != s)) | |
930 | { | |
931 | /* We have just discovered another global symbol with the same name | |
932 | but a different `nature'. Complain. Note that COMMON /FOO/ can | |
933 | coexist with local symbol FOO, e.g. local variable, just not with | |
934 | CALL FOO, hence the separate namespaces. */ | |
935 | ||
936 | ffesymbol_error (gs, t); | |
937 | ffesymbol_error (s, NULL); | |
938 | return; | |
939 | } | |
940 | ||
941 | switch (kind) | |
942 | { | |
943 | case FFEINFO_kindBLOCKDATA: | |
944 | okay = ffeglobal_ref_blockdata (s, t); | |
945 | break; | |
946 | ||
947 | case FFEINFO_kindSUBROUTINE: | |
948 | okay = ffeglobal_ref_subroutine (s, t); | |
949 | break; | |
950 | ||
951 | case FFEINFO_kindFUNCTION: | |
952 | okay = ffeglobal_ref_function (s, t); | |
953 | break; | |
954 | ||
955 | case FFEINFO_kindNONE: | |
956 | okay = ffeglobal_ref_external (s, t); | |
957 | break; | |
958 | ||
959 | default: | |
960 | assert ("bad kind in global ref" == NULL); | |
961 | return; | |
962 | } | |
963 | ||
964 | if (! okay) | |
965 | ffesymbol_error (s, NULL); | |
966 | } | |
967 | ||
5ff904cd JL |
968 | /* Resolve symbol that has become known intrinsic or non-intrinsic. */ |
969 | ||
970 | void | |
971 | ffesymbol_resolve_intrin (ffesymbol s) | |
972 | { | |
973 | char c; | |
974 | ffebad bad; | |
975 | ||
976 | if (!ffesrc_check_symbol ()) | |
977 | return; | |
978 | if (s->check_state != FFESYMBOL_checkstatePENDING_) | |
979 | return; | |
980 | if (ffebad_inhibit ()) | |
981 | return; /* We'll get back to this later. */ | |
982 | ||
983 | if (ffesymbol_where (s) != FFEINFO_whereINTRINSIC) | |
984 | { | |
985 | bad = ffesymbol_check_token_ (s->check_token, &c); | |
986 | assert (bad != FFEBAD); /* How did this suddenly become ok? */ | |
987 | ffesymbol_whine_state_ (bad, s->check_token, c); | |
988 | } | |
989 | ||
990 | s->check_state = FFESYMBOL_checkstateCHECKED_; | |
991 | ffelex_token_kill (s->check_token); | |
992 | } | |
993 | ||
994 | /* Retract or cancel retract list. */ | |
995 | ||
996 | void | |
997 | ffesymbol_retract (bool retract) | |
998 | { | |
999 | ffesymbolRetract_ r; | |
1000 | ffename name; | |
1001 | ffename other_space_name; | |
1002 | ffesymbol ls; | |
1003 | ffesymbol os; | |
1004 | ||
1005 | assert (ffesymbol_retractable_); | |
1006 | ||
1007 | ffesymbol_retractable_ = FALSE; | |
1008 | ||
1009 | for (r = ffesymbol_retract_first_; r != NULL; r = r->next) | |
1010 | { | |
1011 | ls = r->live; | |
1012 | os = r->symbol; | |
1013 | switch (r->command) | |
1014 | { | |
1015 | case FFESYMBOL_retractcommandDELETE_: | |
1016 | if (retract) | |
1017 | { | |
1018 | ffecom_sym_retract (ls); | |
1019 | name = ls->name; | |
1020 | other_space_name = ls->other_space_name; | |
1021 | ffesymbol_unhook_ (ls); | |
1022 | malloc_kill_ks (FFESYMBOL_SPACE_POOL_, ls, sizeof (*ls)); | |
1023 | if (name != NULL) | |
1024 | ffename_set_symbol (name, NULL); | |
1025 | if (other_space_name != NULL) | |
1026 | ffename_set_symbol (other_space_name, NULL); | |
1027 | } | |
1028 | else | |
1029 | { | |
1030 | ffecom_sym_commit (ls); | |
1031 | ls->have_old = FALSE; | |
1032 | } | |
1033 | break; | |
1034 | ||
1035 | case FFESYMBOL_retractcommandRETRACT_: | |
1036 | if (retract) | |
1037 | { | |
1038 | ffecom_sym_retract (ls); | |
1039 | ffesymbol_unhook_ (ls); | |
1040 | *ls = *os; | |
1041 | malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os)); | |
1042 | } | |
1043 | else | |
1044 | { | |
1045 | ffecom_sym_commit (ls); | |
1046 | ffesymbol_unhook_ (os); | |
1047 | malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os)); | |
1048 | ls->have_old = FALSE; | |
1049 | } | |
1050 | break; | |
1051 | ||
1052 | default: | |
1053 | assert ("bad command" == NULL); | |
1054 | break; | |
1055 | } | |
1056 | } | |
1057 | } | |
1058 | ||
1059 | /* Return retractable flag. */ | |
1060 | ||
1061 | bool | |
77f9b92c | 1062 | ffesymbol_retractable (void) |
5ff904cd JL |
1063 | { |
1064 | return ffesymbol_retractable_; | |
1065 | } | |
1066 | ||
1067 | /* Set retractable flag, retract pool. | |
1068 | ||
1069 | Between this call and ffesymbol_retract, any changes made to existing | |
1070 | symbols cause the previous versions of those symbols to be saved, and any | |
1071 | newly created symbols to have their previous nonexistence saved. When | |
1072 | ffesymbol_retract is called, this information either is used to retract | |
1073 | the changes and new symbols, or is discarded. */ | |
1074 | ||
1075 | void | |
1076 | ffesymbol_set_retractable (mallocPool pool) | |
1077 | { | |
1078 | assert (!ffesymbol_retractable_); | |
1079 | ||
1080 | ffesymbol_retractable_ = TRUE; | |
1081 | ffesymbol_retract_pool_ = pool; | |
1082 | ffesymbol_retract_list_ = &ffesymbol_retract_first_; | |
1083 | ffesymbol_retract_first_ = NULL; | |
1084 | } | |
1085 | ||
1086 | /* Existing symbol about to be changed; save? | |
1087 | ||
1088 | Call this function before changing a symbol if it is possible that | |
1089 | the current actions may need to be undone (i.e. one of several possible | |
1090 | statement forms are being used to analyze the current system). | |
1091 | ||
1092 | If the "retractable" flag is not set, just return. | |
1093 | Else, if the symbol's "have_old" flag is set, just return. | |
1094 | Else, make a copy of the symbol and add it to the "retract" list, set | |
1095 | the "have_old" flag, and return. */ | |
1096 | ||
1097 | void | |
1098 | ffesymbol_signal_change (ffesymbol s) | |
1099 | { | |
1100 | ffesymbolRetract_ r; | |
1101 | ffesymbol sym; | |
1102 | ||
1103 | if (!ffesymbol_retractable_ || s->have_old) | |
1104 | return; | |
1105 | ||
c68b0a84 KG |
1106 | r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract", |
1107 | sizeof (*r)); | |
5ff904cd JL |
1108 | r->next = NULL; |
1109 | r->command = FFESYMBOL_retractcommandRETRACT_; | |
1110 | r->live = s; | |
c68b0a84 KG |
1111 | r->symbol = sym = malloc_new_ks (FFESYMBOL_SPACE_POOL_, |
1112 | "FFESYMBOL", sizeof (*sym)); | |
5ff904cd JL |
1113 | *sym = *s; /* Make an exact copy of the symbol in case |
1114 | we need it back. */ | |
1115 | sym->info = ffeinfo_use (s->info); | |
1116 | if (s->check_state == FFESYMBOL_checkstatePENDING_) | |
1117 | sym->check_token = ffelex_token_use (s->check_token); | |
1118 | ||
1119 | *ffesymbol_retract_list_ = r; | |
1120 | ffesymbol_retract_list_ = &r->next; | |
1121 | ||
1122 | s->have_old = TRUE; | |
1123 | } | |
1124 | ||
1125 | /* Returns the string based on the state. */ | |
1126 | ||
26f096f9 | 1127 | const char * |
5ff904cd JL |
1128 | ffesymbol_state_string (ffesymbolState state) |
1129 | { | |
1130 | if (state >= ARRAY_SIZE (ffesymbol_state_name_)) | |
1131 | return "?\?\?"; | |
1132 | return ffesymbol_state_name_[state]; | |
1133 | } | |
1134 | ||
1135 | void | |
77f9b92c | 1136 | ffesymbol_terminate_0 (void) |
5ff904cd JL |
1137 | { |
1138 | } | |
1139 | ||
1140 | void | |
77f9b92c | 1141 | ffesymbol_terminate_1 (void) |
5ff904cd JL |
1142 | { |
1143 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_ | |
1144 | ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_); | |
1145 | ffename_space_kill (ffesymbol_global_); | |
1146 | ffesymbol_global_ = NULL; | |
1147 | ||
1148 | ffesymbol_kill_manifest_ (); | |
1149 | #endif | |
1150 | } | |
1151 | ||
1152 | void | |
77f9b92c | 1153 | ffesymbol_terminate_2 (void) |
5ff904cd JL |
1154 | { |
1155 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ | |
1156 | ffesymbol_kill_manifest_ (); | |
1157 | #endif | |
1158 | } | |
1159 | ||
1160 | void | |
77f9b92c | 1161 | ffesymbol_terminate_3 (void) |
5ff904cd JL |
1162 | { |
1163 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ | |
1164 | ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_); | |
1165 | ffename_space_kill (ffesymbol_global_); | |
1166 | #endif | |
1167 | ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_unhook_); | |
1168 | ffename_space_kill (ffesymbol_local_); | |
1169 | #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_ | |
1170 | ffesymbol_global_ = NULL; | |
1171 | #endif | |
1172 | ffesymbol_local_ = NULL; | |
1173 | } | |
1174 | ||
1175 | void | |
77f9b92c | 1176 | ffesymbol_terminate_4 (void) |
5ff904cd JL |
1177 | { |
1178 | ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_unhook_); | |
1179 | ffename_space_kill (ffesymbol_sfunc_); | |
1180 | ffesymbol_sfunc_ = NULL; | |
1181 | } | |
1182 | ||
1183 | /* Update INIT info to TRUE and all equiv/storage too. | |
1184 | ||
1185 | If INIT flag is TRUE, does nothing. Else sets it to TRUE and calls | |
1186 | on the ffeequiv and ffestorag modules to update their INIT flags if | |
1187 | the <s> symbol has those objects, and also updates the common area if | |
1188 | it exists. */ | |
1189 | ||
1190 | void | |
1191 | ffesymbol_update_init (ffesymbol s) | |
1192 | { | |
1193 | ffebld item; | |
1194 | ||
1195 | if (s->is_init) | |
1196 | return; | |
1197 | ||
1198 | s->is_init = TRUE; | |
1199 | ||
1200 | if ((s->equiv != NULL) | |
1201 | && !ffeequiv_is_init (s->equiv)) | |
1202 | ffeequiv_update_init (s->equiv); | |
1203 | ||
1204 | if ((s->storage != NULL) | |
1205 | && !ffestorag_is_init (s->storage)) | |
1206 | ffestorag_update_init (s->storage); | |
1207 | ||
1208 | if ((s->common != NULL) | |
1209 | && (!ffesymbol_is_init (s->common))) | |
1210 | ffesymbol_update_init (s->common); | |
1211 | ||
1212 | for (item = s->common_list; item != NULL; item = ffebld_trail (item)) | |
1213 | { | |
1214 | if (!ffesymbol_is_init (ffebld_symter (ffebld_head (item)))) | |
1215 | ffesymbol_update_init (ffebld_symter (ffebld_head (item))); | |
1216 | } | |
1217 | } | |
1218 | ||
1219 | /* Update SAVE info to TRUE and all equiv/storage too. | |
1220 | ||
1221 | If SAVE flag is TRUE, does nothing. Else sets it to TRUE and calls | |
1222 | on the ffeequiv and ffestorag modules to update their SAVE flags if | |
1223 | the <s> symbol has those objects, and also updates the common area if | |
1224 | it exists. */ | |
1225 | ||
1226 | void | |
1227 | ffesymbol_update_save (ffesymbol s) | |
1228 | { | |
1229 | ffebld item; | |
1230 | ||
1231 | if (s->is_save) | |
1232 | return; | |
1233 | ||
1234 | s->is_save = TRUE; | |
1235 | ||
1236 | if ((s->equiv != NULL) | |
1237 | && !ffeequiv_is_save (s->equiv)) | |
1238 | ffeequiv_update_save (s->equiv); | |
1239 | ||
1240 | if ((s->storage != NULL) | |
1241 | && !ffestorag_is_save (s->storage)) | |
1242 | ffestorag_update_save (s->storage); | |
1243 | ||
1244 | if ((s->common != NULL) | |
1245 | && (!ffesymbol_is_save (s->common))) | |
1246 | ffesymbol_update_save (s->common); | |
1247 | ||
1248 | for (item = s->common_list; item != NULL; item = ffebld_trail (item)) | |
1249 | { | |
1250 | if (!ffesymbol_is_save (ffebld_symter (ffebld_head (item)))) | |
1251 | ffesymbol_update_save (ffebld_symter (ffebld_head (item))); | |
1252 | } | |
1253 | } |