1 /* Build executable statement trees.
2 Copyright (C) 2000-2018 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
gfc_clear_new_st(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, initialized with the current locus
45 and a statement code 'op'. */
46
47 gfc_code *
gfc_get_code(gfc_exec_op op)48 gfc_get_code (gfc_exec_op op)
49 {
50 gfc_code *c;
51
52 c = XCNEW (gfc_code);
53 c->op = op;
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 *
gfc_append_code(gfc_code * tail,gfc_code * new_code)63 gfc_append_code (gfc_code *tail, gfc_code *new_code)
64 {
65 if (tail != NULL)
66 {
67 while (tail->next != NULL)
68 tail = tail->next;
69
70 tail->next = new_code;
71 }
72
73 while (new_code->next != NULL)
74 new_code = new_code->next;
75
76 return new_code;
77 }
78
79
80 /* Free a single code structure, but not the actual structure itself. */
81
82 void
gfc_free_statement(gfc_code * p)83 gfc_free_statement (gfc_code *p)
84 {
85 if (p->expr1)
86 gfc_free_expr (p->expr1);
87 if (p->expr2)
88 gfc_free_expr (p->expr2);
89
90 switch (p->op)
91 {
92 case EXEC_NOP:
93 case EXEC_END_BLOCK:
94 case EXEC_END_NESTED_BLOCK:
95 case EXEC_ASSIGN:
96 case EXEC_INIT_ASSIGN:
97 case EXEC_GOTO:
98 case EXEC_CYCLE:
99 case EXEC_RETURN:
100 case EXEC_END_PROCEDURE:
101 case EXEC_IF:
102 case EXEC_PAUSE:
103 case EXEC_STOP:
104 case EXEC_ERROR_STOP:
105 case EXEC_EXIT:
106 case EXEC_WHERE:
107 case EXEC_IOLENGTH:
108 case EXEC_POINTER_ASSIGN:
109 case EXEC_DO_WHILE:
110 case EXEC_CONTINUE:
111 case EXEC_TRANSFER:
112 case EXEC_LABEL_ASSIGN:
113 case EXEC_ENTRY:
114 case EXEC_ARITHMETIC_IF:
115 case EXEC_CRITICAL:
116 case EXEC_SYNC_ALL:
117 case EXEC_SYNC_IMAGES:
118 case EXEC_SYNC_MEMORY:
119 case EXEC_LOCK:
120 case EXEC_UNLOCK:
121 case EXEC_EVENT_POST:
122 case EXEC_EVENT_WAIT:
123 case EXEC_FAIL_IMAGE:
124 case EXEC_CHANGE_TEAM:
125 case EXEC_END_TEAM:
126 case EXEC_FORM_TEAM:
127 case EXEC_SYNC_TEAM:
128 break;
129
130 case EXEC_BLOCK:
131 gfc_free_namespace (p->ext.block.ns);
132 gfc_free_association_list (p->ext.block.assoc);
133 break;
134
135 case EXEC_COMPCALL:
136 case EXEC_CALL_PPC:
137 case EXEC_CALL:
138 case EXEC_ASSIGN_CALL:
139 gfc_free_actual_arglist (p->ext.actual);
140 break;
141
142 case EXEC_SELECT:
143 case EXEC_SELECT_TYPE:
144 if (p->ext.block.case_list)
145 gfc_free_case_list (p->ext.block.case_list);
146 break;
147
148 case EXEC_DO:
149 gfc_free_iterator (p->ext.iterator, 1);
150 break;
151
152 case EXEC_ALLOCATE:
153 case EXEC_DEALLOCATE:
154 gfc_free_alloc_list (p->ext.alloc.list);
155 break;
156
157 case EXEC_OPEN:
158 gfc_free_open (p->ext.open);
159 break;
160
161 case EXEC_CLOSE:
162 gfc_free_close (p->ext.close);
163 break;
164
165 case EXEC_BACKSPACE:
166 case EXEC_ENDFILE:
167 case EXEC_REWIND:
168 case EXEC_FLUSH:
169 gfc_free_filepos (p->ext.filepos);
170 break;
171
172 case EXEC_INQUIRE:
173 gfc_free_inquire (p->ext.inquire);
174 break;
175
176 case EXEC_WAIT:
177 gfc_free_wait (p->ext.wait);
178 break;
179
180 case EXEC_READ:
181 case EXEC_WRITE:
182 gfc_free_dt (p->ext.dt);
183 break;
184
185 case EXEC_DT_END:
186 /* The ext.dt member is a duplicate pointer and doesn't need to
187 be freed. */
188 break;
189
190 case EXEC_DO_CONCURRENT:
191 case EXEC_FORALL:
192 gfc_free_forall_iterator (p->ext.forall_iterator);
193 break;
194
195 case EXEC_OACC_DECLARE:
196 if (p->ext.oacc_declare)
197 gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
198 break;
199
200 case EXEC_OACC_PARALLEL_LOOP:
201 case EXEC_OACC_PARALLEL:
202 case EXEC_OACC_KERNELS_LOOP:
203 case EXEC_OACC_KERNELS:
204 case EXEC_OACC_DATA:
205 case EXEC_OACC_HOST_DATA:
206 case EXEC_OACC_LOOP:
207 case EXEC_OACC_UPDATE:
208 case EXEC_OACC_WAIT:
209 case EXEC_OACC_CACHE:
210 case EXEC_OACC_ENTER_DATA:
211 case EXEC_OACC_EXIT_DATA:
212 case EXEC_OACC_ROUTINE:
213 case EXEC_OMP_CANCEL:
214 case EXEC_OMP_CANCELLATION_POINT:
215 case EXEC_OMP_CRITICAL:
216 case EXEC_OMP_DISTRIBUTE:
217 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
218 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
219 case EXEC_OMP_DISTRIBUTE_SIMD:
220 case EXEC_OMP_DO:
221 case EXEC_OMP_DO_SIMD:
222 case EXEC_OMP_END_SINGLE:
223 case EXEC_OMP_ORDERED:
224 case EXEC_OMP_PARALLEL:
225 case EXEC_OMP_PARALLEL_DO:
226 case EXEC_OMP_PARALLEL_DO_SIMD:
227 case EXEC_OMP_PARALLEL_SECTIONS:
228 case EXEC_OMP_PARALLEL_WORKSHARE:
229 case EXEC_OMP_SECTIONS:
230 case EXEC_OMP_SIMD:
231 case EXEC_OMP_SINGLE:
232 case EXEC_OMP_TARGET:
233 case EXEC_OMP_TARGET_DATA:
234 case EXEC_OMP_TARGET_ENTER_DATA:
235 case EXEC_OMP_TARGET_EXIT_DATA:
236 case EXEC_OMP_TARGET_PARALLEL:
237 case EXEC_OMP_TARGET_PARALLEL_DO:
238 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
239 case EXEC_OMP_TARGET_SIMD:
240 case EXEC_OMP_TARGET_TEAMS:
241 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
242 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
243 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
244 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
245 case EXEC_OMP_TARGET_UPDATE:
246 case EXEC_OMP_TASK:
247 case EXEC_OMP_TASKLOOP:
248 case EXEC_OMP_TASKLOOP_SIMD:
249 case EXEC_OMP_TEAMS:
250 case EXEC_OMP_TEAMS_DISTRIBUTE:
251 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
252 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
253 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
254 case EXEC_OMP_WORKSHARE:
255 gfc_free_omp_clauses (p->ext.omp_clauses);
256 break;
257
258 case EXEC_OMP_END_CRITICAL:
259 free (CONST_CAST (char *, p->ext.omp_name));
260 break;
261
262 case EXEC_OMP_FLUSH:
263 gfc_free_omp_namelist (p->ext.omp_namelist);
264 break;
265
266 case EXEC_OACC_ATOMIC:
267 case EXEC_OMP_ATOMIC:
268 case EXEC_OMP_BARRIER:
269 case EXEC_OMP_MASTER:
270 case EXEC_OMP_END_NOWAIT:
271 case EXEC_OMP_TASKGROUP:
272 case EXEC_OMP_TASKWAIT:
273 case EXEC_OMP_TASKYIELD:
274 break;
275
276 default:
277 gfc_internal_error ("gfc_free_statement(): Bad statement");
278 }
279 }
280
281
282 /* Free a code statement and all other code structures linked to it. */
283
284 void
gfc_free_statements(gfc_code * p)285 gfc_free_statements (gfc_code *p)
286 {
287 gfc_code *q;
288
289 for (; p; p = q)
290 {
291 q = p->next;
292
293 if (p->block)
294 gfc_free_statements (p->block);
295 gfc_free_statement (p);
296 free (p);
297 }
298 }
299
300
301 /* Free an association list (of an ASSOCIATE statement). */
302
303 void
gfc_free_association_list(gfc_association_list * assoc)304 gfc_free_association_list (gfc_association_list* assoc)
305 {
306 if (!assoc)
307 return;
308
309 gfc_free_association_list (assoc->next);
310 free (assoc);
311 }
312