1/* Build executable statement trees.
2 Copyright (C) 2000-2023 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4
5This file is part of GCC.
6
7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 3, or (at your option) any later
10version.
11
12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
16
17You should have received a copy of the GNU General Public License
18along 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
31gfc_code new_st;
32
33
34/* Zeroes out the new_st structure. */
35
36void
37gfc_clear_new_st (void)
38{
39 memset (s: &new_st, c: '\0', n: 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
47gfc_code *
48gfc_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
62gfc_code *
63gfc_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
82void
83gfc_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_ALLOCATE:
218 case EXEC_OMP_ALLOCATORS:
219 case EXEC_OMP_ASSUME:
220 case EXEC_OMP_ATOMIC:
221 case EXEC_OMP_CANCEL:
222 case EXEC_OMP_CANCELLATION_POINT:
223 case EXEC_OMP_CRITICAL:
224 case EXEC_OMP_DEPOBJ:
225 case EXEC_OMP_DISTRIBUTE:
226 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
227 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
228 case EXEC_OMP_DISTRIBUTE_SIMD:
229 case EXEC_OMP_DO:
230 case EXEC_OMP_DO_SIMD:
231 case EXEC_OMP_ERROR:
232 case EXEC_OMP_LOOP:
233 case EXEC_OMP_END_SINGLE:
234 case EXEC_OMP_MASKED_TASKLOOP:
235 case EXEC_OMP_MASKED_TASKLOOP_SIMD:
236 case EXEC_OMP_MASTER_TASKLOOP:
237 case EXEC_OMP_MASTER_TASKLOOP_SIMD:
238 case EXEC_OMP_ORDERED:
239 case EXEC_OMP_MASKED:
240 case EXEC_OMP_PARALLEL:
241 case EXEC_OMP_PARALLEL_DO:
242 case EXEC_OMP_PARALLEL_DO_SIMD:
243 case EXEC_OMP_PARALLEL_LOOP:
244 case EXEC_OMP_PARALLEL_MASKED:
245 case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
246 case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
247 case EXEC_OMP_PARALLEL_MASTER:
248 case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
249 case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
250 case EXEC_OMP_PARALLEL_SECTIONS:
251 case EXEC_OMP_PARALLEL_WORKSHARE:
252 case EXEC_OMP_SCAN:
253 case EXEC_OMP_SCOPE:
254 case EXEC_OMP_SECTIONS:
255 case EXEC_OMP_SIMD:
256 case EXEC_OMP_SINGLE:
257 case EXEC_OMP_TARGET:
258 case EXEC_OMP_TARGET_DATA:
259 case EXEC_OMP_TARGET_ENTER_DATA:
260 case EXEC_OMP_TARGET_EXIT_DATA:
261 case EXEC_OMP_TARGET_PARALLEL:
262 case EXEC_OMP_TARGET_PARALLEL_DO:
263 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
264 case EXEC_OMP_TARGET_PARALLEL_LOOP:
265 case EXEC_OMP_TARGET_SIMD:
266 case EXEC_OMP_TARGET_TEAMS:
267 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
268 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
269 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
270 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
271 case EXEC_OMP_TARGET_TEAMS_LOOP:
272 case EXEC_OMP_TARGET_UPDATE:
273 case EXEC_OMP_TASK:
274 case EXEC_OMP_TASKLOOP:
275 case EXEC_OMP_TASKLOOP_SIMD:
276 case EXEC_OMP_TEAMS:
277 case EXEC_OMP_TEAMS_DISTRIBUTE:
278 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
279 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
280 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
281 case EXEC_OMP_TEAMS_LOOP:
282 case EXEC_OMP_WORKSHARE:
283 gfc_free_omp_clauses (p->ext.omp_clauses);
284 break;
285
286 case EXEC_OMP_END_CRITICAL:
287 free (CONST_CAST (char *, p->ext.omp_name));
288 break;
289
290 case EXEC_OMP_FLUSH:
291 gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false);
292 break;
293
294 case EXEC_OMP_BARRIER:
295 case EXEC_OMP_MASTER:
296 case EXEC_OMP_END_NOWAIT:
297 case EXEC_OMP_TASKGROUP:
298 case EXEC_OMP_TASKWAIT:
299 case EXEC_OMP_TASKYIELD:
300 break;
301
302 default:
303 gfc_internal_error ("gfc_free_statement(): Bad statement");
304 }
305}
306
307
308/* Free a code statement and all other code structures linked to it. */
309
310void
311gfc_free_statements (gfc_code *p)
312{
313 gfc_code *q;
314
315 for (; p; p = q)
316 {
317 q = p->next;
318
319 if (p->block)
320 gfc_free_statements (p: p->block);
321 gfc_free_statement (p);
322 free (ptr: p);
323 }
324}
325
326
327/* Free an association list (of an ASSOCIATE statement). */
328
329void
330gfc_free_association_list (gfc_association_list* assoc)
331{
332 if (!assoc)
333 return;
334
335 gfc_free_association_list (assoc: assoc->next);
336 free (ptr: assoc);
337}
338

source code of gcc/fortran/st.cc