gcc/fortran/st.c

   1 /* Build executable statement trees.
   2    Copyright (C) 2000-2013 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 3, 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 COPYING3.  If not see
  19 <http://www.gnu.org/licenses/>.  */
  20
  21 /* Executable statements are strung together into a singly linked list
  22    of code structures.  These structures are later translated into GCC
  23    GENERIC tree structures and from there to executable code for a
  24    target.  */
  25
  26 #include "config.h"
  27 #include "system.h"
  28 #include "coretypes.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   memset (&new_st, '\0', sizeof (new_st));
  40   new_st.op = EXEC_NOP;
  41 }
  42
  43
  44 /* Get a gfc_code structure.  */
  45
  46 gfc_code *
  47 gfc_get_code (void)
  48 {
  49   gfc_code *c;
  50
  51   c = XCNEW (gfc_code);
  52   c->loc = gfc_current_locus;
  53   return c;
  54 }
  55
  56
  57 /* Given some part of a gfc_code structure, append a set of code to
  58    its tail, returning a pointer to the new tail.  */
  59
  60 gfc_code *
  61 gfc_append_code (gfc_code *tail, gfc_code *new_code)
  62 {
  63   if (tail != NULL)
  64     {
  65       while (tail->next != NULL)
  66         tail = tail->next;
  67
  68       tail->next = new_code;
  69     }
  70
  71   while (new_code->next != NULL)
  72     new_code = new_code->next;
  73
  74   return new_code;
  75 }
  76
  77
  78 /* Free a single code structure, but not the actual structure itself.  */
  79
  80 void
  81 gfc_free_statement (gfc_code *p)
  82 {
  83   if (p->expr1)
  84     gfc_free_expr (p->expr1);
  85   if (p->expr2)
  86     gfc_free_expr (p->expr2);
  87
  88   switch (p->op)
  89     {
  90     case EXEC_NOP:
  91     case EXEC_END_BLOCK:
  92     case EXEC_END_NESTED_BLOCK:
  93     case EXEC_ASSIGN:
  94     case EXEC_INIT_ASSIGN:
  95     case EXEC_GOTO:
  96     case EXEC_CYCLE:
  97     case EXEC_RETURN:
  98     case EXEC_END_PROCEDURE:
  99     case EXEC_IF:
 100     case EXEC_PAUSE:
 101     case EXEC_STOP:
 102     case EXEC_ERROR_STOP:
 103     case EXEC_EXIT:
 104     case EXEC_WHERE:
 105     case EXEC_IOLENGTH:
 106     case EXEC_POINTER_ASSIGN:
 107     case EXEC_DO_WHILE:
 108     case EXEC_CONTINUE:
 109     case EXEC_TRANSFER:
 110     case EXEC_LABEL_ASSIGN:
 111     case EXEC_ENTRY:
 112     case EXEC_ARITHMETIC_IF:
 113     case EXEC_CRITICAL:
 114     case EXEC_SYNC_ALL:
 115     case EXEC_SYNC_IMAGES:
 116     case EXEC_SYNC_MEMORY:
 117     case EXEC_LOCK:
 118     case EXEC_UNLOCK:
 119       break;
 120
 121     case EXEC_BLOCK:
 122       gfc_free_namespace (p->ext.block.ns);
 123       gfc_free_association_list (p->ext.block.assoc);
 124       break;
 125
 126     case EXEC_COMPCALL:
 127     case EXEC_CALL_PPC:
 128     case EXEC_CALL:
 129     case EXEC_ASSIGN_CALL:
 130       gfc_free_actual_arglist (p->ext.actual);
 131       break;
 132
 133     case EXEC_SELECT:
 134     case EXEC_SELECT_TYPE:
 135       if (p->ext.block.case_list)
 136         gfc_free_case_list (p->ext.block.case_list);
 137       break;
 138
 139     case EXEC_DO:
 140       gfc_free_iterator (p->ext.iterator, 1);
 141       break;
 142
 143     case EXEC_ALLOCATE:
 144     case EXEC_DEALLOCATE:
 145       gfc_free_alloc_list (p->ext.alloc.list);
 146       break;
 147
 148     case EXEC_OPEN:
 149       gfc_free_open (p->ext.open);
 150       break;
 151
 152     case EXEC_CLOSE:
 153       gfc_free_close (p->ext.close);
 154       break;
 155
 156     case EXEC_BACKSPACE:
 157     case EXEC_ENDFILE:
 158     case EXEC_REWIND:
 159     case EXEC_FLUSH:
 160       gfc_free_filepos (p->ext.filepos);
 161       break;
 162
 163     case EXEC_INQUIRE:
 164       gfc_free_inquire (p->ext.inquire);
 165       break;
 166
 167     case EXEC_WAIT:
 168       gfc_free_wait (p->ext.wait);
 169       break;
 170
 171     case EXEC_READ:
 172     case EXEC_WRITE:
 173       gfc_free_dt (p->ext.dt);
 174       break;
 175
 176     case EXEC_DT_END:
 177       /* The ext.dt member is a duplicate pointer and doesn't need to
 178          be freed.  */
 179       break;
 180
 181     case EXEC_DO_CONCURRENT:
 182     case EXEC_FORALL:
 183       gfc_free_forall_iterator (p->ext.forall_iterator);
 184       break;
 185
 186     case EXEC_OMP_DO:
 187     case EXEC_OMP_END_SINGLE:
 188     case EXEC_OMP_PARALLEL:
 189     case EXEC_OMP_PARALLEL_DO:
 190     case EXEC_OMP_PARALLEL_SECTIONS:
 191     case EXEC_OMP_SECTIONS:
 192     case EXEC_OMP_SINGLE:
 193     case EXEC_OMP_TASK:
 194     case EXEC_OMP_WORKSHARE:
 195     case EXEC_OMP_PARALLEL_WORKSHARE:
 196       gfc_free_omp_clauses (p->ext.omp_clauses);
 197       break;
 198
 199     case EXEC_OMP_CRITICAL:
 200       free (CONST_CAST (char *, p->ext.omp_name));
 201       break;
 202
 203     case EXEC_OMP_FLUSH:
 204       gfc_free_namelist (p->ext.omp_namelist);
 205       break;
 206
 207     case EXEC_OMP_ATOMIC:
 208     case EXEC_OMP_BARRIER:
 209     case EXEC_OMP_MASTER:
 210     case EXEC_OMP_ORDERED:
 211     case EXEC_OMP_END_NOWAIT:
 212     case EXEC_OMP_TASKWAIT:
 213     case EXEC_OMP_TASKYIELD:
 214       break;
 215
 216     default:
 217       gfc_internal_error ("gfc_free_statement(): Bad statement");
 218     }
 219 }
 220
 221
 222 /* Free a code statement and all other code structures linked to it.  */
 223
 224 void
 225 gfc_free_statements (gfc_code *p)
 226 {
 227   gfc_code *q;
 228
 229   for (; p; p = q)
 230     {
 231       q = p->next;
 232
 233       if (p->block)
 234         gfc_free_statements (p->block);
 235       gfc_free_statement (p);
 236       free (p);
 237     }
 238 }
 239
 240
 241 /* Free an association list (of an ASSOCIATE statement).  */
 242
 243 void
 244 gfc_free_association_list (gfc_association_list* assoc)
 245 {
 246   if (!assoc)
 247     return;
 248
 249   gfc_free_association_list (assoc->next);
 250   free (assoc);
 251 }