1 /* stw.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 (despite the name, it doesn't really depend on ffest*)
24
25 Description:
26 Provides abstraction and stack mechanism to track the block structure
27 of a Fortran program.
28
29 Modifications:
30 */
31
32 /* Include files. */
33
34 #include "proj.h"
35 #include "stw.h"
36 #include "bld.h"
37 #include "com.h"
38 #include "info.h"
39 #include "lab.h"
40 #include "lex.h"
41 #include "malloc.h"
42 #include "sta.h"
43 #include "stv.h"
44 #include "symbol.h"
45 #include "where.h"
46
47 /* Externals defined here. */
48
49 ffestw ffestw_stack_top_ = NULL;
50
51 /* Simple definitions and enumerations. */
52
53
54 /* Internal typedefs. */
55
56
57 /* Private include files. */
58
59
60 /* Internal structure definitions. */
61
62
63 /* Static objects accessed by functions in this module. */
64
65
66 /* Static functions (internal). */
67
68
69 /* Internal macros. */
70
71
72 /* ffestw_display_state -- DEBUGGING; display current block state
73
74 ffestw_display_state(); */
75
76 void
ffestw_display_state(void)77 ffestw_display_state (void)
78 {
79 assert (ffestw_stack_top_ != NULL);
80
81 if (!ffe_is_ffedebug ())
82 return;
83
84 fprintf (dmpout, "; block %lu, state ", ffestw_stack_top_->blocknum_);
85 switch (ffestw_stack_top_->state_)
86 {
87 case FFESTV_stateNIL:
88 fputs ("NIL", dmpout);
89 break;
90
91 case FFESTV_statePROGRAM0:
92 fputs ("PROGRAM0", dmpout);
93 break;
94
95 case FFESTV_statePROGRAM1:
96 fputs ("PROGRAM1", dmpout);
97 break;
98
99 case FFESTV_statePROGRAM2:
100 fputs ("PROGRAM2", dmpout);
101 break;
102
103 case FFESTV_statePROGRAM3:
104 fputs ("PROGRAM3", dmpout);
105 break;
106
107 case FFESTV_statePROGRAM4:
108 fputs ("PROGRAM4", dmpout);
109 break;
110
111 case FFESTV_statePROGRAM5:
112 fputs ("PROGRAM5", dmpout);
113 break;
114
115 case FFESTV_stateSUBROUTINE0:
116 fputs ("SUBROUTINE0", dmpout);
117 break;
118
119 case FFESTV_stateSUBROUTINE1:
120 fputs ("SUBROUTINE1", dmpout);
121 break;
122
123 case FFESTV_stateSUBROUTINE2:
124 fputs ("SUBROUTINE2", dmpout);
125 break;
126
127 case FFESTV_stateSUBROUTINE3:
128 fputs ("SUBROUTINE3", dmpout);
129 break;
130
131 case FFESTV_stateSUBROUTINE4:
132 fputs ("SUBROUTINE4", dmpout);
133 break;
134
135 case FFESTV_stateSUBROUTINE5:
136 fputs ("SUBROUTINE5", dmpout);
137 break;
138
139 case FFESTV_stateFUNCTION0:
140 fputs ("FUNCTION0", dmpout);
141 break;
142
143 case FFESTV_stateFUNCTION1:
144 fputs ("FUNCTION1", dmpout);
145 break;
146
147 case FFESTV_stateFUNCTION2:
148 fputs ("FUNCTION2", dmpout);
149 break;
150
151 case FFESTV_stateFUNCTION3:
152 fputs ("FUNCTION3", dmpout);
153 break;
154
155 case FFESTV_stateFUNCTION4:
156 fputs ("FUNCTION4", dmpout);
157 break;
158
159 case FFESTV_stateFUNCTION5:
160 fputs ("FUNCTION5", dmpout);
161 break;
162
163 case FFESTV_stateMODULE0:
164 fputs ("MODULE0", dmpout);
165 break;
166
167 case FFESTV_stateMODULE1:
168 fputs ("MODULE1", dmpout);
169 break;
170
171 case FFESTV_stateMODULE2:
172 fputs ("MODULE2", dmpout);
173 break;
174
175 case FFESTV_stateMODULE3:
176 fputs ("MODULE3", dmpout);
177 break;
178
179 case FFESTV_stateMODULE4:
180 fputs ("MODULE4", dmpout);
181 break;
182
183 case FFESTV_stateMODULE5:
184 fputs ("MODULE5", dmpout);
185 break;
186
187 case FFESTV_stateBLOCKDATA0:
188 fputs ("BLOCKDATA0", dmpout);
189 break;
190
191 case FFESTV_stateBLOCKDATA1:
192 fputs ("BLOCKDATA1", dmpout);
193 break;
194
195 case FFESTV_stateBLOCKDATA2:
196 fputs ("BLOCKDATA2", dmpout);
197 break;
198
199 case FFESTV_stateBLOCKDATA3:
200 fputs ("BLOCKDATA3", dmpout);
201 break;
202
203 case FFESTV_stateBLOCKDATA4:
204 fputs ("BLOCKDATA4", dmpout);
205 break;
206
207 case FFESTV_stateBLOCKDATA5:
208 fputs ("BLOCKDATA5", dmpout);
209 break;
210
211 case FFESTV_stateUSE:
212 fputs ("USE", dmpout);
213 break;
214
215 case FFESTV_stateTYPE:
216 fputs ("TYPE", dmpout);
217 break;
218
219 case FFESTV_stateINTERFACE0:
220 fputs ("INTERFACE0", dmpout);
221 break;
222
223 case FFESTV_stateINTERFACE1:
224 fputs ("INTERFACE1", dmpout);
225 break;
226
227 case FFESTV_stateSTRUCTURE:
228 fputs ("STRUCTURE", dmpout);
229 break;
230
231 case FFESTV_stateUNION:
232 fputs ("UNION", dmpout);
233 break;
234
235 case FFESTV_stateMAP:
236 fputs ("MAP", dmpout);
237 break;
238
239 case FFESTV_stateWHERETHEN:
240 fputs ("WHERETHEN", dmpout);
241 break;
242
243 case FFESTV_stateWHERE:
244 fputs ("WHERE", dmpout);
245 break;
246
247 case FFESTV_stateIFTHEN:
248 fputs ("IFTHEN", dmpout);
249 break;
250
251 case FFESTV_stateIF:
252 fputs ("IF", dmpout);
253 break;
254
255 case FFESTV_stateDO:
256 fputs ("DO", dmpout);
257 break;
258
259 case FFESTV_stateSELECT0:
260 fputs ("SELECT0", dmpout);
261 break;
262
263 case FFESTV_stateSELECT1:
264 fputs ("SELECT1", dmpout);
265 break;
266
267 default:
268 assert ("bad state" == NULL);
269 break;
270 }
271 if (ffestw_stack_top_->top_do_ != NULL)
272 fputs (" (within DO)", dmpout);
273 fputc ('\n', dmpout);
274 }
275
276 /* ffestw_init_0 -- Initialize ffestw structures
277
278 ffestw_init_0(); */
279
280 void
ffestw_init_0()281 ffestw_init_0 ()
282 {
283 ffestw b;
284
285 ffestw_stack_top_ = b = (ffestw) malloc_new_kp (malloc_pool_image (),
286 "FFESTW stack base", sizeof (*b));
287 b->uses_ = 0; /* catch if anyone uses, kills, &c this
288 block. */
289 b->next_ = NULL;
290 b->previous_ = NULL;
291 b->top_do_ = NULL;
292 b->blocknum_ = 0;
293 b->shriek_ = NULL;
294 b->state_ = FFESTV_stateNIL;
295 b->line_ = ffewhere_line_unknown ();
296 b->col_ = ffewhere_column_unknown ();
297 }
298
299 /* ffestw_kill -- Kill block
300
301 ffestw b;
302 ffestw_kill(b); */
303
304 void
ffestw_kill(ffestw b)305 ffestw_kill (ffestw b)
306 {
307 assert (b != NULL);
308 assert (b->uses_ > 0);
309
310 if (--b->uses_ != 0)
311 return;
312
313 ffewhere_line_kill (b->line_);
314 ffewhere_column_kill (b->col_);
315 }
316
317 /* ffestw_new -- Create block
318
319 ffestw b;
320 b = ffestw_new(); */
321
322 ffestw
ffestw_new(void)323 ffestw_new (void)
324 {
325 ffestw b;
326
327 b = (ffestw) malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b));
328 b->uses_ = 1;
329
330 return b;
331 }
332
333 /* ffestw_pop -- Pop block off stack
334
335 ffestw_pop(); */
336
337 ffestw
ffestw_pop(void)338 ffestw_pop (void)
339 {
340 ffestw b;
341 ffestw oldb = ffestw_stack_top_;
342
343 assert (oldb != NULL);
344 ffestw_stack_top_ = b = ffestw_stack_top_->previous_;
345 assert (b != NULL);
346 if ((ffewhere_line_is_unknown (b->line_) || ffewhere_column_is_unknown (b->col_))
347 && (ffesta_tokens[0] != NULL))
348 {
349 assert (b->state_ == FFESTV_stateNIL);
350 if (ffewhere_line_is_unknown (b->line_))
351 b->line_
352 = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
353 if (ffewhere_column_is_unknown (b->col_))
354 b->col_
355 = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
356 }
357
358 return oldb;
359 }
360
361 /* ffestw_push -- Push block onto stack, return its address
362
363 ffestw b; // NULL if new block to be obtained first.
364 ffestw_push(b);
365
366 Returns address of block if desired, also updates ffestw_stack_top_
367 to point to it.
368
369 30-Oct-91 JCB 2.0
370 Takes block as arg, or NULL if new block needed. */
371
372 ffestw
ffestw_push(ffestw b)373 ffestw_push (ffestw b)
374 {
375 if (b == NULL)
376 b = ffestw_new ();
377
378 b->next_ = NULL;
379 b->previous_ = ffestw_stack_top_;
380 b->line_ = ffewhere_line_unknown ();
381 b->col_ = ffewhere_column_unknown ();
382 ffestw_stack_top_ = b;
383 return b;
384 }
385
386 /* ffestw_update -- Update current block line/col info
387
388 ffestw_update();
389
390 Updates block to point to current statement. */
391
392 ffestw
ffestw_update(ffestw b)393 ffestw_update (ffestw b)
394 {
395 if (b == NULL)
396 {
397 b = ffestw_stack_top_;
398 assert (b != NULL);
399 }
400
401 if (ffesta_tokens[0] == NULL)
402 return b;
403
404 ffewhere_line_kill (b->line_);
405 ffewhere_column_kill (b->col_);
406 b->line_ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
407 b->col_ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
408
409 return b;
410 }
411
412 /* ffestw_use -- Mark extra use of block
413
414 ffestw b;
415 b = ffestw_use(b); // will always return original copy of b
416
417 Increments use counter for b. */
418
419 ffestw
ffestw_use(ffestw b)420 ffestw_use (ffestw b)
421 {
422 assert (b != NULL);
423 assert (b->uses_ != 0);
424
425 ++b->uses_;
426
427 return b;
428 }
429