OSDN Git Service

f9ad5d82793e8233b0026588dbdec3bf7fb578d2
[pf3gnuchains/gcc-fork.git] / gcc / fortran / st.c
1 /* Build executable statement trees.
2    Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
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 3, 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 COPYING3.  If not see
20 <http://www.gnu.org/licenses/>.  */
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   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_ASSIGN:
93     case EXEC_INIT_ASSIGN:
94     case EXEC_GOTO:
95     case EXEC_CYCLE:
96     case EXEC_RETURN:
97     case EXEC_END_PROCEDURE:
98     case EXEC_IF:
99     case EXEC_PAUSE:
100     case EXEC_STOP:
101     case EXEC_ERROR_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     case EXEC_CRITICAL:
113     case EXEC_SYNC_ALL:
114     case EXEC_SYNC_IMAGES:
115     case EXEC_SYNC_MEMORY:
116       break;
117
118     case EXEC_BLOCK:
119       gfc_free_namespace (p->ext.block.ns);
120       gfc_free_association_list (p->ext.block.assoc);
121       break;
122
123     case EXEC_COMPCALL:
124     case EXEC_CALL_PPC:
125     case EXEC_CALL:
126     case EXEC_ASSIGN_CALL:
127       gfc_free_actual_arglist (p->ext.actual);
128       break;
129
130     case EXEC_SELECT:
131     case EXEC_SELECT_TYPE:
132       if (p->ext.case_list)
133         gfc_free_case_list (p->ext.case_list);
134       break;
135
136     case EXEC_DO:
137       gfc_free_iterator (p->ext.iterator, 1);
138       break;
139
140     case EXEC_ALLOCATE:
141     case EXEC_DEALLOCATE:
142       gfc_free_alloc_list (p->ext.alloc.list);
143       break;
144
145     case EXEC_OPEN:
146       gfc_free_open (p->ext.open);
147       break;
148
149     case EXEC_CLOSE:
150       gfc_free_close (p->ext.close);
151       break;
152
153     case EXEC_BACKSPACE:
154     case EXEC_ENDFILE:
155     case EXEC_REWIND:
156     case EXEC_FLUSH:
157       gfc_free_filepos (p->ext.filepos);
158       break;
159
160     case EXEC_INQUIRE:
161       gfc_free_inquire (p->ext.inquire);
162       break;
163
164     case EXEC_WAIT:
165       gfc_free_wait (p->ext.wait);
166       break;
167
168     case EXEC_READ:
169     case EXEC_WRITE:
170       gfc_free_dt (p->ext.dt);
171       break;
172
173     case EXEC_DT_END:
174       /* The ext.dt member is a duplicate pointer and doesn't need to
175          be freed.  */
176       break;
177
178     case EXEC_FORALL:
179       gfc_free_forall_iterator (p->ext.forall_iterator);
180       break;
181
182     case EXEC_OMP_DO:
183     case EXEC_OMP_END_SINGLE:
184     case EXEC_OMP_PARALLEL:
185     case EXEC_OMP_PARALLEL_DO:
186     case EXEC_OMP_PARALLEL_SECTIONS:
187     case EXEC_OMP_SECTIONS:
188     case EXEC_OMP_SINGLE:
189     case EXEC_OMP_TASK:
190     case EXEC_OMP_WORKSHARE:
191     case EXEC_OMP_PARALLEL_WORKSHARE:
192       gfc_free_omp_clauses (p->ext.omp_clauses);
193       break;
194
195     case EXEC_OMP_CRITICAL:
196       gfc_free (CONST_CAST (char *, p->ext.omp_name));
197       break;
198
199     case EXEC_OMP_FLUSH:
200       gfc_free_namelist (p->ext.omp_namelist);
201       break;
202
203     case EXEC_OMP_ATOMIC:
204     case EXEC_OMP_BARRIER:
205     case EXEC_OMP_MASTER:
206     case EXEC_OMP_ORDERED:
207     case EXEC_OMP_END_NOWAIT:
208     case EXEC_OMP_TASKWAIT:
209       break;
210
211     default:
212       gfc_internal_error ("gfc_free_statement(): Bad statement");
213     }
214 }
215
216
217 /* Free a code statement and all other code structures linked to it.  */
218
219 void
220 gfc_free_statements (gfc_code *p)
221 {
222   gfc_code *q;
223
224   for (; p; p = q)
225     {
226       q = p->next;
227
228       if (p->block)
229         gfc_free_statements (p->block);
230       gfc_free_statement (p);
231       gfc_free (p);
232     }
233 }
234
235
236 /* Free an association list (of an ASSOCIATE statement).  */
237
238 void
239 gfc_free_association_list (gfc_association_list* assoc)
240 {
241   if (!assoc)
242     return;
243
244   gfc_free_association_list (assoc->next);
245   gfc_free (assoc);
246 }