429 lines
8.5 KiB
C
429 lines
8.5 KiB
C
/* 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. */
|
||
|
||
|
||
/* 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;
|
||
}
|