+++ /dev/null
-/* stw.c -- Implementation File (module.c template V1.0)
- Copyright (C) 1995 Free Software Foundation, Inc.
- Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU Fortran is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU Fortran; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
- Related Modules:
- None (despite the name, it doesn't really depend on ffest*)
-
- Description:
- Provides abstraction and stack mechanism to track the block structure
- of a Fortran program.
-
- Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stw.h"
-#include "bld.h"
-#include "com.h"
-#include "info.h"
-#include "lab.h"
-#include "lex.h"
-#include "malloc.h"
-#include "sta.h"
-#include "stv.h"
-#include "symbol.h"
-#include "where.h"
-
-/* Externals defined here. */
-
-ffestw ffestw_stack_top_ = NULL;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-\f
-
-/* ffestw_display_state -- DEBUGGING; display current block state
-
- ffestw_display_state(); */
-
-void
-ffestw_display_state (void)
-{
- assert (ffestw_stack_top_ != NULL);
-
- if (!ffe_is_ffedebug ())
- return;
-
- fprintf (dmpout, "; block %lu, state ", ffestw_stack_top_->blocknum_);
- switch (ffestw_stack_top_->state_)
- {
- case FFESTV_stateNIL:
- fputs ("NIL", dmpout);
- break;
-
- case FFESTV_statePROGRAM0:
- fputs ("PROGRAM0", dmpout);
- break;
-
- case FFESTV_statePROGRAM1:
- fputs ("PROGRAM1", dmpout);
- break;
-
- case FFESTV_statePROGRAM2:
- fputs ("PROGRAM2", dmpout);
- break;
-
- case FFESTV_statePROGRAM3:
- fputs ("PROGRAM3", dmpout);
- break;
-
- case FFESTV_statePROGRAM4:
- fputs ("PROGRAM4", dmpout);
- break;
-
- case FFESTV_statePROGRAM5:
- fputs ("PROGRAM5", dmpout);
- break;
-
- case FFESTV_stateSUBROUTINE0:
- fputs ("SUBROUTINE0", dmpout);
- break;
-
- case FFESTV_stateSUBROUTINE1:
- fputs ("SUBROUTINE1", dmpout);
- break;
-
- case FFESTV_stateSUBROUTINE2:
- fputs ("SUBROUTINE2", dmpout);
- break;
-
- case FFESTV_stateSUBROUTINE3:
- fputs ("SUBROUTINE3", dmpout);
- break;
-
- case FFESTV_stateSUBROUTINE4:
- fputs ("SUBROUTINE4", dmpout);
- break;
-
- case FFESTV_stateSUBROUTINE5:
- fputs ("SUBROUTINE5", dmpout);
- break;
-
- case FFESTV_stateFUNCTION0:
- fputs ("FUNCTION0", dmpout);
- break;
-
- case FFESTV_stateFUNCTION1:
- fputs ("FUNCTION1", dmpout);
- break;
-
- case FFESTV_stateFUNCTION2:
- fputs ("FUNCTION2", dmpout);
- break;
-
- case FFESTV_stateFUNCTION3:
- fputs ("FUNCTION3", dmpout);
- break;
-
- case FFESTV_stateFUNCTION4:
- fputs ("FUNCTION4", dmpout);
- break;
-
- case FFESTV_stateFUNCTION5:
- fputs ("FUNCTION5", dmpout);
- break;
-
- case FFESTV_stateMODULE0:
- fputs ("MODULE0", dmpout);
- break;
-
- case FFESTV_stateMODULE1:
- fputs ("MODULE1", dmpout);
- break;
-
- case FFESTV_stateMODULE2:
- fputs ("MODULE2", dmpout);
- break;
-
- case FFESTV_stateMODULE3:
- fputs ("MODULE3", dmpout);
- break;
-
- case FFESTV_stateMODULE4:
- fputs ("MODULE4", dmpout);
- break;
-
- case FFESTV_stateMODULE5:
- fputs ("MODULE5", dmpout);
- break;
-
- case FFESTV_stateBLOCKDATA0:
- fputs ("BLOCKDATA0", dmpout);
- break;
-
- case FFESTV_stateBLOCKDATA1:
- fputs ("BLOCKDATA1", dmpout);
- break;
-
- case FFESTV_stateBLOCKDATA2:
- fputs ("BLOCKDATA2", dmpout);
- break;
-
- case FFESTV_stateBLOCKDATA3:
- fputs ("BLOCKDATA3", dmpout);
- break;
-
- case FFESTV_stateBLOCKDATA4:
- fputs ("BLOCKDATA4", dmpout);
- break;
-
- case FFESTV_stateBLOCKDATA5:
- fputs ("BLOCKDATA5", dmpout);
- break;
-
- case FFESTV_stateUSE:
- fputs ("USE", dmpout);
- break;
-
- case FFESTV_stateTYPE:
- fputs ("TYPE", dmpout);
- break;
-
- case FFESTV_stateINTERFACE0:
- fputs ("INTERFACE0", dmpout);
- break;
-
- case FFESTV_stateINTERFACE1:
- fputs ("INTERFACE1", dmpout);
- break;
-
- case FFESTV_stateSTRUCTURE:
- fputs ("STRUCTURE", dmpout);
- break;
-
- case FFESTV_stateUNION:
- fputs ("UNION", dmpout);
- break;
-
- case FFESTV_stateMAP:
- fputs ("MAP", dmpout);
- break;
-
- case FFESTV_stateWHERETHEN:
- fputs ("WHERETHEN", dmpout);
- break;
-
- case FFESTV_stateWHERE:
- fputs ("WHERE", dmpout);
- break;
-
- case FFESTV_stateIFTHEN:
- fputs ("IFTHEN", dmpout);
- break;
-
- case FFESTV_stateIF:
- fputs ("IF", dmpout);
- break;
-
- case FFESTV_stateDO:
- fputs ("DO", dmpout);
- break;
-
- case FFESTV_stateSELECT0:
- fputs ("SELECT0", dmpout);
- break;
-
- case FFESTV_stateSELECT1:
- fputs ("SELECT1", dmpout);
- break;
-
- default:
- assert ("bad state" == NULL);
- break;
- }
- if (ffestw_stack_top_->top_do_ != NULL)
- fputs (" (within DO)", dmpout);
- fputc ('\n', dmpout);
-}
-
-/* ffestw_init_0 -- Initialize ffestw structures
-
- ffestw_init_0(); */
-
-void
-ffestw_init_0 ()
-{
- ffestw b;
-
- ffestw_stack_top_ = b = (ffestw) malloc_new_kp (malloc_pool_image (),
- "FFESTW stack base", sizeof (*b));
- b->uses_ = 0; /* catch if anyone uses, kills, &c this
- block. */
- b->next_ = NULL;
- b->previous_ = NULL;
- b->top_do_ = NULL;
- b->blocknum_ = 0;
- b->shriek_ = NULL;
- b->state_ = FFESTV_stateNIL;
- b->line_ = ffewhere_line_unknown ();
- b->col_ = ffewhere_column_unknown ();
-}
-
-/* ffestw_kill -- Kill block
-
- ffestw b;
- ffestw_kill(b); */
-
-void
-ffestw_kill (ffestw b)
-{
- assert (b != NULL);
- assert (b->uses_ > 0);
-
- if (--b->uses_ != 0)
- return;
-
- ffewhere_line_kill (b->line_);
- ffewhere_column_kill (b->col_);
-}
-
-/* ffestw_new -- Create block
-
- ffestw b;
- b = ffestw_new(); */
-
-ffestw
-ffestw_new (void)
-{
- ffestw b;
-
- b = (ffestw) malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b));
- b->uses_ = 1;
-
- return b;
-}
-
-/* ffestw_pop -- Pop block off stack
-
- ffestw_pop(); */
-
-ffestw
-ffestw_pop (void)
-{
- ffestw b;
- ffestw oldb = ffestw_stack_top_;
-
- assert (oldb != NULL);
- ffestw_stack_top_ = b = ffestw_stack_top_->previous_;
- assert (b != NULL);
- if ((ffewhere_line_is_unknown (b->line_) || ffewhere_column_is_unknown (b->col_))
- && (ffesta_tokens[0] != NULL))
- {
- assert (b->state_ == FFESTV_stateNIL);
- if (ffewhere_line_is_unknown (b->line_))
- b->line_
- = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
- if (ffewhere_column_is_unknown (b->col_))
- b->col_
- = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
- }
-
- return oldb;
-}
-
-/* ffestw_push -- Push block onto stack, return its address
-
- ffestw b; // NULL if new block to be obtained first.
- ffestw_push(b);
-
- Returns address of block if desired, also updates ffestw_stack_top_
- to point to it.
-
- 30-Oct-91 JCB 2.0
- Takes block as arg, or NULL if new block needed. */
-
-ffestw
-ffestw_push (ffestw b)
-{
- if (b == NULL)
- b = ffestw_new ();
-
- b->next_ = NULL;
- b->previous_ = ffestw_stack_top_;
- b->line_ = ffewhere_line_unknown ();
- b->col_ = ffewhere_column_unknown ();
- ffestw_stack_top_ = b;
- return b;
-}
-
-/* ffestw_update -- Update current block line/col info
-
- ffestw_update();
-
- Updates block to point to current statement. */
-
-ffestw
-ffestw_update (ffestw b)
-{
- if (b == NULL)
- {
- b = ffestw_stack_top_;
- assert (b != NULL);
- }
-
- if (ffesta_tokens[0] == NULL)
- return b;
-
- ffewhere_line_kill (b->line_);
- ffewhere_column_kill (b->col_);
- b->line_ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
- b->col_ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
-
- return b;
-}
-
-/* ffestw_use -- Mark extra use of block
-
- ffestw b;
- b = ffestw_use(b); // will always return original copy of b
-
- Increments use counter for b. */
-
-ffestw
-ffestw_use (ffestw b)
-{
- assert (b != NULL);
- assert (b->uses_ != 0);
-
- ++b->uses_;
-
- return b;
-}
projects / msp430-gcc.git / blobdiff