gcc/fortran/st.c

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