diff options
Diffstat (limited to 'gcc/f/stw.c')
| -rw-r--r-- | gcc/f/stw.c | 428 |
1 files changed, 428 insertions, 0 deletions
diff --git a/gcc/f/stw.c b/gcc/f/stw.c new file mode 100644 index 00000000000..70d8803dcb0 --- /dev/null +++ b/gcc/f/stw.c @@ -0,0 +1,428 @@ +/* stw.c -- Implementation File (module.c template V1.0) + Copyright (C) 1995 Free Software Foundation, Inc. + Contributed by James Craig Burley (burley@gnu.ai.mit.edu). + +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. */ + + +/* ffestw_display_state -- DEBUGGING; display current block state + + ffestw_display_state(); */ + +void +ffestw_display_state () +{ + 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 () +{ + 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 () +{ + 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; +} |