1 /* Build executable statement trees.
2 Copyright (C) 2000-2021 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 case EXEC_SELECT_RANK:
145 if (p->ext.block.case_list)
146 gfc_free_case_list (p->ext.block.case_list);
147 break;
148
149 case EXEC_DO:
150 gfc_free_iterator (p->ext.iterator, 1);
151 break;
152
153 case EXEC_ALLOCATE:
154 case EXEC_DEALLOCATE:
155 gfc_free_alloc_list (p->ext.alloc.list);
156 break;
157
158 case EXEC_OPEN:
159 gfc_free_open (p->ext.open);
160 break;
161
162 case EXEC_CLOSE:
163 gfc_free_close (p->ext.close);
164 break;
165
166 case EXEC_BACKSPACE:
167 case EXEC_ENDFILE:
168 case EXEC_REWIND:
169 case EXEC_FLUSH:
170 gfc_free_filepos (p->ext.filepos);
171 break;
172
173 case EXEC_INQUIRE:
174 gfc_free_inquire (p->ext.inquire);
175 break;
176
177 case EXEC_WAIT:
178 gfc_free_wait (p->ext.wait);
179 break;
180
181 case EXEC_READ:
182 case EXEC_WRITE:
183 gfc_free_dt (p->ext.dt);
184 break;
185
186 case EXEC_DT_END:
187 /* The ext.dt member is a duplicate pointer and doesn't need to
188 be freed. */
189 break;
190
191 case EXEC_DO_CONCURRENT:
192 case EXEC_FORALL:
193 gfc_free_forall_iterator (p->ext.forall_iterator);
194 break;
195
196 case EXEC_OACC_DECLARE:
197 if (p->ext.oacc_declare)
198 gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
199 break;
200
201 case EXEC_OACC_ATOMIC:
202 case EXEC_OACC_PARALLEL_LOOP:
203 case EXEC_OACC_PARALLEL:
204 case EXEC_OACC_KERNELS_LOOP:
205 case EXEC_OACC_KERNELS:
206 case EXEC_OACC_SERIAL_LOOP:
207 case EXEC_OACC_SERIAL:
208 case EXEC_OACC_DATA:
209 case EXEC_OACC_HOST_DATA:
210 case EXEC_OACC_LOOP:
211 case EXEC_OACC_UPDATE:
212 case EXEC_OACC_WAIT:
213 case EXEC_OACC_CACHE:
214 case EXEC_OACC_ENTER_DATA:
215 case EXEC_OACC_EXIT_DATA:
216 case EXEC_OACC_ROUTINE:
217 case EXEC_OMP_ATOMIC:
218 case EXEC_OMP_CANCEL:
219 case EXEC_OMP_CANCELLATION_POINT:
220 case EXEC_OMP_CRITICAL:
221 case EXEC_OMP_DISTRIBUTE:
222 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
223 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
224 case EXEC_OMP_DISTRIBUTE_SIMD:
225 case EXEC_OMP_DO:
226 case EXEC_OMP_DO_SIMD:
227 case EXEC_OMP_END_SINGLE:
228 case EXEC_OMP_ORDERED:
229 case EXEC_OMP_PARALLEL:
230 case EXEC_OMP_PARALLEL_DO:
231 case EXEC_OMP_PARALLEL_DO_SIMD:
232 case EXEC_OMP_PARALLEL_SECTIONS:
233 case EXEC_OMP_PARALLEL_WORKSHARE:
234 case EXEC_OMP_SCAN:
235 case EXEC_OMP_SECTIONS:
236 case EXEC_OMP_SIMD:
237 case EXEC_OMP_SINGLE:
238 case EXEC_OMP_TARGET:
239 case EXEC_OMP_TARGET_DATA:
240 case EXEC_OMP_TARGET_ENTER_DATA:
241 case EXEC_OMP_TARGET_EXIT_DATA:
242 case EXEC_OMP_TARGET_PARALLEL:
243 case EXEC_OMP_TARGET_PARALLEL_DO:
244 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
245 case EXEC_OMP_TARGET_SIMD:
246 case EXEC_OMP_TARGET_TEAMS:
247 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
248 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
249 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
250 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
251 case EXEC_OMP_TARGET_UPDATE:
252 case EXEC_OMP_TASK:
253 case EXEC_OMP_TASKLOOP:
254 case EXEC_OMP_TASKLOOP_SIMD:
255 case EXEC_OMP_TEAMS:
256 case EXEC_OMP_TEAMS_DISTRIBUTE:
257 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
258 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
259 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
260 case EXEC_OMP_WORKSHARE:
261 gfc_free_omp_clauses (p->ext.omp_clauses);
262 break;
263
264 case EXEC_OMP_END_CRITICAL:
265 free (CONST_CAST (char *, p->ext.omp_name));
266 break;
267
268 case EXEC_OMP_FLUSH:
269 gfc_free_omp_namelist (p->ext.omp_namelist);
270 break;
271
272 case EXEC_OMP_BARRIER:
273 case EXEC_OMP_MASTER:
274 case EXEC_OMP_END_NOWAIT:
275 case EXEC_OMP_TASKGROUP:
276 case EXEC_OMP_TASKWAIT:
277 case EXEC_OMP_TASKYIELD:
278 break;
279
280 default:
281 gfc_internal_error ("gfc_free_statement(): Bad statement");
282 }
283 }
284
285
286 /* Free a code statement and all other code structures linked to it. */
287
288 void
gfc_free_statements(gfc_code * p)289 gfc_free_statements (gfc_code *p)
290 {
291 gfc_code *q;
292
293 for (; p; p = q)
294 {
295 q = p->next;
296
297 if (p->block)
298 gfc_free_statements (p->block);
299 gfc_free_statement (p);
300 free (p);
301 }
302 }
303
304
305 /* Free an association list (of an ASSOCIATE statement). */
306
307 void
gfc_free_association_list(gfc_association_list * assoc)308 gfc_free_association_list (gfc_association_list* assoc)
309 {
310 if (!assoc)
311 return;
312
313 gfc_free_association_list (assoc->next);
314 free (assoc);
315 }
316