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