1 /* stw.c -- Implementation File (module.c template V1.0)
2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
5 This file is part of GNU Fortran.
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)
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.
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
23 None (despite the name, it doesn't really depend on ffest*)
26 Provides abstraction and stack mechanism to track the block structure
47 /* Externals defined here. */
49 ffestw ffestw_stack_top_ = NULL;
51 /* Simple definitions and enumerations. */
54 /* Internal typedefs. */
57 /* Private include files. */
60 /* Internal structure definitions. */
63 /* Static objects accessed by functions in this module. */
66 /* Static functions (internal). */
69 /* Internal macros. */
72 /* ffestw_display_state -- DEBUGGING; display current block state
74 ffestw_display_state(); */
77 ffestw_display_state (void)
79 assert (ffestw_stack_top_ != NULL);
81 if (!ffe_is_ffedebug ())
84 fprintf (dmpout, "; block %lu, state ", ffestw_stack_top_->blocknum_);
85 switch (ffestw_stack_top_->state_)
88 fputs ("NIL", dmpout);
91 case FFESTV_statePROGRAM0:
92 fputs ("PROGRAM0", dmpout);
95 case FFESTV_statePROGRAM1:
96 fputs ("PROGRAM1", dmpout);
99 case FFESTV_statePROGRAM2:
100 fputs ("PROGRAM2", dmpout);
103 case FFESTV_statePROGRAM3:
104 fputs ("PROGRAM3", dmpout);
107 case FFESTV_statePROGRAM4:
108 fputs ("PROGRAM4", dmpout);
111 case FFESTV_statePROGRAM5:
112 fputs ("PROGRAM5", dmpout);
115 case FFESTV_stateSUBROUTINE0:
116 fputs ("SUBROUTINE0", dmpout);
119 case FFESTV_stateSUBROUTINE1:
120 fputs ("SUBROUTINE1", dmpout);
123 case FFESTV_stateSUBROUTINE2:
124 fputs ("SUBROUTINE2", dmpout);
127 case FFESTV_stateSUBROUTINE3:
128 fputs ("SUBROUTINE3", dmpout);
131 case FFESTV_stateSUBROUTINE4:
132 fputs ("SUBROUTINE4", dmpout);
135 case FFESTV_stateSUBROUTINE5:
136 fputs ("SUBROUTINE5", dmpout);
139 case FFESTV_stateFUNCTION0:
140 fputs ("FUNCTION0", dmpout);
143 case FFESTV_stateFUNCTION1:
144 fputs ("FUNCTION1", dmpout);
147 case FFESTV_stateFUNCTION2:
148 fputs ("FUNCTION2", dmpout);
151 case FFESTV_stateFUNCTION3:
152 fputs ("FUNCTION3", dmpout);
155 case FFESTV_stateFUNCTION4:
156 fputs ("FUNCTION4", dmpout);
159 case FFESTV_stateFUNCTION5:
160 fputs ("FUNCTION5", dmpout);
163 case FFESTV_stateMODULE0:
164 fputs ("MODULE0", dmpout);
167 case FFESTV_stateMODULE1:
168 fputs ("MODULE1", dmpout);
171 case FFESTV_stateMODULE2:
172 fputs ("MODULE2", dmpout);
175 case FFESTV_stateMODULE3:
176 fputs ("MODULE3", dmpout);
179 case FFESTV_stateMODULE4:
180 fputs ("MODULE4", dmpout);
183 case FFESTV_stateMODULE5:
184 fputs ("MODULE5", dmpout);
187 case FFESTV_stateBLOCKDATA0:
188 fputs ("BLOCKDATA0", dmpout);
191 case FFESTV_stateBLOCKDATA1:
192 fputs ("BLOCKDATA1", dmpout);
195 case FFESTV_stateBLOCKDATA2:
196 fputs ("BLOCKDATA2", dmpout);
199 case FFESTV_stateBLOCKDATA3:
200 fputs ("BLOCKDATA3", dmpout);
203 case FFESTV_stateBLOCKDATA4:
204 fputs ("BLOCKDATA4", dmpout);
207 case FFESTV_stateBLOCKDATA5:
208 fputs ("BLOCKDATA5", dmpout);
211 case FFESTV_stateUSE:
212 fputs ("USE", dmpout);
215 case FFESTV_stateTYPE:
216 fputs ("TYPE", dmpout);
219 case FFESTV_stateINTERFACE0:
220 fputs ("INTERFACE0", dmpout);
223 case FFESTV_stateINTERFACE1:
224 fputs ("INTERFACE1", dmpout);
227 case FFESTV_stateSTRUCTURE:
228 fputs ("STRUCTURE", dmpout);
231 case FFESTV_stateUNION:
232 fputs ("UNION", dmpout);
235 case FFESTV_stateMAP:
236 fputs ("MAP", dmpout);
239 case FFESTV_stateWHERETHEN:
240 fputs ("WHERETHEN", dmpout);
243 case FFESTV_stateWHERE:
244 fputs ("WHERE", dmpout);
247 case FFESTV_stateIFTHEN:
248 fputs ("IFTHEN", dmpout);
252 fputs ("IF", dmpout);
256 fputs ("DO", dmpout);
259 case FFESTV_stateSELECT0:
260 fputs ("SELECT0", dmpout);
263 case FFESTV_stateSELECT1:
264 fputs ("SELECT1", dmpout);
268 assert ("bad state" == NULL);
271 if (ffestw_stack_top_->top_do_ != NULL)
272 fputs (" (within DO)", dmpout);
273 fputc ('\n', dmpout);
276 /* ffestw_init_0 -- Initialize ffestw structures
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
294 b->state_ = FFESTV_stateNIL;
295 b->line_ = ffewhere_line_unknown ();
296 b->col_ = ffewhere_column_unknown ();
299 /* ffestw_kill -- Kill block
305 ffestw_kill (ffestw b)
308 assert (b->uses_ > 0);
313 ffewhere_line_kill (b->line_);
314 ffewhere_column_kill (b->col_);
317 /* ffestw_new -- Create block
327 b = (ffestw) malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b));
333 /* ffestw_pop -- Pop block off stack
341 ffestw oldb = ffestw_stack_top_;
343 assert (oldb != NULL);
344 ffestw_stack_top_ = b = ffestw_stack_top_->previous_;
346 if ((ffewhere_line_is_unknown (b->line_) || ffewhere_column_is_unknown (b->col_))
347 && (ffesta_tokens[0] != NULL))
349 assert (b->state_ == FFESTV_stateNIL);
350 if (ffewhere_line_is_unknown (b->line_))
352 = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
353 if (ffewhere_column_is_unknown (b->col_))
355 = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
361 /* ffestw_push -- Push block onto stack, return its address
363 ffestw b; // NULL if new block to be obtained first.
366 Returns address of block if desired, also updates ffestw_stack_top_
370 Takes block as arg, or NULL if new block needed. */
373 ffestw_push (ffestw b)
379 b->previous_ = ffestw_stack_top_;
380 b->line_ = ffewhere_line_unknown ();
381 b->col_ = ffewhere_column_unknown ();
382 ffestw_stack_top_ = b;
386 /* ffestw_update -- Update current block line/col info
390 Updates block to point to current statement. */
393 ffestw_update (ffestw b)
397 b = ffestw_stack_top_;
401 if (ffesta_tokens[0] == NULL)
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]));
412 /* ffestw_use -- Mark extra use of block
415 b = ffestw_use(b); // will always return original copy of b
417 Increments use counter for b. */
420 ffestw_use (ffestw b)
423 assert (b->uses_ != 0);