src/basesuif/fixfortran/mark_io.cc

   1 /* file "mark_io.cc" of the fixfortran program for SUIF */
   2
   3 /*  Copyright (c) 1994 Stanford University
   4
   5     All rights reserved.
   6
   7     This software is provided under the terms described in
   8     the "suif_copyright.h" include file. */
   9
  10 #include <suif_copyright.h>
  11
  12 /*
  13  *  This file contains code to mark call instructions that do Fortran
  14  *  I/O as either input or output.
  15  */
  16
  17 #define RCS_BASE_FILE mark_io_cc
  18
  19 #include "fixfortran.h"
  20 #include <string.h>
  21
  22 RCS_BASE(
  23     "$Id: mark_io.cc,v 1.1.1.1 1998/06/16 15:17:25 brm Exp $")
  24
  25 /*----------------------------------------------------------------------*
  26     Begin Type Declarations
  27  *----------------------------------------------------------------------*/
  28
  29 /*----------------------------------------------------------------------*
  30     End Type Declarations
  31  *----------------------------------------------------------------------*/
  32 /*----------------------------------------------------------------------*
  33     Begin Private Function Declarations
  34  *----------------------------------------------------------------------*/
  35
  36 /*----------------------------------------------------------------------*
  37     End Private Function Declarations
  38  *----------------------------------------------------------------------*/
  39 /*----------------------------------------------------------------------*
  40     Begin Public Function Implementations
  41  *----------------------------------------------------------------------*/
  42
  43 extern void mark_io_on_list(tree_node_list *node_list)
  44   {
  45     static boolean is_read = FALSE;
  46     static boolean is_write = FALSE;
  47
  48     tree_node_list_iter node_iter(node_list);
  49     while (!node_iter.is_empty())
  50       {
  51         tree_node *this_node = node_iter.step();
  52         switch (this_node->kind())
  53           {
  54             case TREE_INSTR:
  55               {
  56                 tree_instr *the_tree_instr = (tree_instr *)this_node;
  57                 instruction *the_instr = the_tree_instr->instr();
  58                 if (the_instr->opcode() != io_cal)
  59                     break;
  60                 in_cal *the_call = (in_cal *)the_instr;
  61                 proc_sym *the_proc = proc_for_call(the_call);
  62                 if (the_proc == NULL)
  63                     break;
  64                 const char *pname = the_proc->name();
  65                 if ((strcmp(pname, "do_fio") == 0) ||
  66                     (strcmp(pname, "do_lio") == 0) ||
  67                     (strcmp(pname, "do_uio") == 0))
  68                   {
  69                     assert(is_read || is_write);
  70                     if (is_read)
  71                         the_call->append_annote(k_io_read);
  72                     else
  73                         the_call->append_annote(k_io_write);
  74                   }
  75                 else if ((strlen(pname) == 6) && (pname[1] == '_'))
  76                   {
  77                     if (pname[0] == 's')
  78                       {
  79                         boolean closed = FALSE;
  80                         if (strcmp(&(pname[3]), "sne") == 0)
  81                             closed = TRUE;
  82                         if (pname[2] == 'r')
  83                           {
  84                             assert(!is_read);
  85                             assert(!is_write);
  86                             if (!closed)
  87                                 is_read = TRUE;
  88                             the_call->append_annote(k_io_read);
  89                           }
  90                         else if (pname[2] == 'w')
  91                           {
  92                             assert(!is_read);
  93                             assert(!is_write);
  94                             if (!closed)
  95                                 is_write = TRUE;
  96                             the_call->append_annote(k_io_write);
  97                           }
  98                       }
  99                     else if (pname[0] == 'e')
 100                       {
 101                         if (pname[2] == 'r')
 102                           {
 103                             assert(is_read);
 104                             the_call->append_annote(k_io_read);
 105                             is_read = FALSE;
 106                           }
 107                         else if (pname[2] == 'w')
 108                           {
 109                             assert(is_write);
 110                             the_call->append_annote(k_io_write);
 111                             is_write = FALSE;
 112                           }
 113                       }
 114                   }
 115                 break;
 116               }
 117             case TREE_LOOP:
 118               {
 119                 tree_loop *the_loop = (tree_loop *)this_node;
 120                 mark_io_on_list(the_loop->body());
 121                 mark_io_on_list(the_loop->test());
 122                 break;
 123               }
 124             case TREE_FOR:
 125               {
 126                 tree_for *the_for = (tree_for *)this_node;
 127                 mark_io_on_list(the_for->body());
 128                 mark_io_on_list(the_for->landing_pad());
 129                 break;
 130               }
 131             case TREE_IF:
 132               {
 133                 tree_if *the_if = (tree_if *)this_node;
 134                 mark_io_on_list(the_if->header());
 135                 mark_io_on_list(the_if->then_part());
 136                 mark_io_on_list(the_if->else_part());
 137                 break;
 138               }
 139             case TREE_BLOCK:
 140               {
 141                 tree_block *the_block = (tree_block *)this_node;
 142                 mark_io_on_list(the_block->body());
 143                 break;
 144               }
 145             default:
 146                 assert(FALSE);
 147           }
 148       }
 149   }
 150
 151 /*----------------------------------------------------------------------*
 152     End Public Function Implementations
 153  *----------------------------------------------------------------------*/
 154 /*----------------------------------------------------------------------*
 155     Begin Private Function Implementations
 156  *----------------------------------------------------------------------*/
 157
 158 /*----------------------------------------------------------------------*
 159     End Private Function Implementations
 160  *----------------------------------------------------------------------*/