gcc/fortran/st.c

   1 /* Build executable statement trees.
   2    Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
   3    Contributed by Andy Vaught
   4
   5 This file is part of GCC.
   6
   7 GCC is free software; you can redistribute it and/or modify it under
   8 the terms of the GNU General Public License as published by the Free
   9 Software Foundation; either version 2, or (at your option) any later
  10 version.
  11
  12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GCC; see the file COPYING.  If not, write to the Free
  19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.  */
  21
  22 /* Executable statements are strung together into a singly linked list
  23    of code structures.  These structures are later translated into GCC
  24    GENERIC tree structures and from there to executable code for a
  25    target.  */
  26
  27 #include "config.h"
  28 #include "system.h"
  29 #include "gfortran.h"
  30
  31 gfc_code new_st;
  32
  33
  34 /* Zeroes out the new_st structure.  */
  35
  36 void
  37 gfc_clear_new_st (void)
  38 {
  39
  40   memset (&new_st, '\0', sizeof (new_st));
  41   new_st.op = EXEC_NOP;
  42 }
  43
  44
  45 /* Get a gfc_code structure.  */
  46
  47 gfc_code *
  48 gfc_get_code (void)
  49 {
  50   gfc_code *c;
  51
  52   c = gfc_getmem (sizeof (gfc_code));
  53   c->loc = gfc_current_locus;
  54   return c;
  55 }
  56
  57
  58 /* Given some part of a gfc_code structure, append a set of code to
  59    its tail, returning a pointer to the new tail.  */
  60
  61 gfc_code *
  62 gfc_append_code (gfc_code * tail, gfc_code * new)
  63 {
  64
  65   if (tail != NULL)
  66     {
  67       while (tail->next != NULL)
  68         tail = tail->next;
  69
  70       tail->next = new;
  71     }
  72
  73   while (new->next != NULL)
  74     new = new->next;
  75
  76   return new;
  77 }
  78
  79
  80 /* Free a single code structure, but not the actual structure itself.  */
  81
  82 void
  83 gfc_free_statement (gfc_code * p)
  84 {
  85
  86   if (p->expr)
  87     gfc_free_expr (p->expr);
  88   if (p->expr2)
  89     gfc_free_expr (p->expr2);
  90
  91   switch (p->op)
  92     {
  93     case EXEC_NOP:
  94     case EXEC_ASSIGN:
  95     case EXEC_GOTO:
  96     case EXEC_CYCLE:
  97     case EXEC_RETURN:
  98     case EXEC_IF:
  99     case EXEC_PAUSE:
 100     case EXEC_STOP:
 101     case EXEC_EXIT:
 102     case EXEC_WHERE:
 103     case EXEC_IOLENGTH:
 104     case EXEC_POINTER_ASSIGN:
 105     case EXEC_DO_WHILE:
 106     case EXEC_CONTINUE:
 107     case EXEC_TRANSFER:
 108     case EXEC_LABEL_ASSIGN:
 109     case EXEC_ENTRY:
 110     case EXEC_ARITHMETIC_IF:
 111       break;
 112
 113     case EXEC_CALL:
 114       gfc_free_actual_arglist (p->ext.actual);
 115       break;
 116
 117     case EXEC_SELECT:
 118       if (p->ext.case_list)
 119         gfc_free_case_list (p->ext.case_list);
 120       break;
 121
 122     case EXEC_DO:
 123       gfc_free_iterator (p->ext.iterator, 1);
 124       break;
 125
 126     case EXEC_ALLOCATE:
 127     case EXEC_DEALLOCATE:
 128       gfc_free_alloc_list (p->ext.alloc_list);
 129       break;
 130
 131     case EXEC_OPEN:
 132       gfc_free_open (p->ext.open);
 133       break;
 134
 135     case EXEC_CLOSE:
 136       gfc_free_close (p->ext.close);
 137       break;
 138
 139     case EXEC_BACKSPACE:
 140     case EXEC_ENDFILE:
 141     case EXEC_REWIND:
 142       gfc_free_filepos (p->ext.filepos);
 143       break;
 144
 145     case EXEC_INQUIRE:
 146       gfc_free_inquire (p->ext.inquire);
 147       break;
 148
 149     case EXEC_READ:
 150     case EXEC_WRITE:
 151       gfc_free_dt (p->ext.dt);
 152       break;
 153
 154     case EXEC_DT_END:
 155       /* The ext.dt member is a duplicate pointer and doesn't need to
 156          be freed.  */
 157       break;
 158
 159     case EXEC_FORALL:
 160       gfc_free_forall_iterator (p->ext.forall_iterator);
 161       break;
 162
 163     default:
 164       gfc_internal_error ("gfc_free_statement(): Bad statement");
 165     }
 166 }
 167
 168
 169 /* Free a code statement and all other code structures linked to it.  */
 170
 171 void
 172 gfc_free_statements (gfc_code * p)
 173 {
 174   gfc_code *q;
 175
 176   for (; p; p = q)
 177     {
 178       q = p->next;
 179
 180       if (p->block)
 181         gfc_free_statements (p->block);
 182       gfc_free_statement (p);
 183       gfc_free (p);
 184     }
 185 }
 186