Branch data Line data Source code
1 : : /* Build executable statement trees.
2 : : Copyright (C) 2000-2025 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 : 29786132 : gfc_clear_new_st (void)
38 : : {
39 : 29786132 : memset (&new_st, '\0', sizeof (new_st));
40 : 29786132 : new_st.op = EXEC_NOP;
41 : 29786132 : }
42 : :
43 : :
44 : : /* Get a gfc_code structure, initialized with the current locus
45 : : and a statement code 'op'. */
46 : :
47 : : gfc_code *
48 : 474176 : gfc_get_code (gfc_exec_op op)
49 : : {
50 : 474176 : gfc_code *c;
51 : :
52 : 474176 : c = XCNEW (gfc_code);
53 : 474176 : c->op = op;
54 : 474176 : c->loc = gfc_current_locus;
55 : 474176 : 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 *
63 : 78189 : gfc_append_code (gfc_code *tail, gfc_code *new_code)
64 : : {
65 : 78189 : if (tail != NULL)
66 : : {
67 : 64759 : while (tail->next != NULL)
68 : : tail = tail->next;
69 : :
70 : 48505 : tail->next = new_code;
71 : : }
72 : :
73 : 78724 : while (new_code->next != NULL)
74 : : new_code = new_code->next;
75 : :
76 : 78189 : return new_code;
77 : : }
78 : :
79 : :
80 : : /* Free a single code structure, but not the actual structure itself. */
81 : :
82 : : void
83 : 28880806 : gfc_free_statement (gfc_code *p)
84 : : {
85 : 28880806 : if (p->expr1)
86 : 1181806 : gfc_free_expr (p->expr1);
87 : 28880806 : if (p->expr2)
88 : 328361 : gfc_free_expr (p->expr2);
89 : :
90 : 28880806 : 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 : 13795 : case EXEC_BLOCK:
131 : 13795 : gfc_free_namespace (p->ext.block.ns);
132 : 13795 : gfc_free_association_list (p->ext.block.assoc);
133 : 13795 : break;
134 : :
135 : 83512 : case EXEC_COMPCALL:
136 : 83512 : case EXEC_CALL_PPC:
137 : 83512 : case EXEC_CALL:
138 : 83512 : case EXEC_ASSIGN_CALL:
139 : 83512 : gfc_free_actual_arglist (p->ext.actual);
140 : 83512 : break;
141 : :
142 : 14654 : case EXEC_SELECT:
143 : 14654 : case EXEC_SELECT_TYPE:
144 : 14654 : case EXEC_SELECT_RANK:
145 : 14654 : if (p->ext.block.case_list)
146 : 9631 : gfc_free_case_list (p->ext.block.case_list);
147 : : break;
148 : :
149 : 79151 : case EXEC_DO:
150 : 79151 : gfc_free_iterator (p->ext.iterator, 1);
151 : 79151 : break;
152 : :
153 : 22170 : case EXEC_ALLOCATE:
154 : 22170 : case EXEC_DEALLOCATE:
155 : 22170 : gfc_free_alloc_list (p->ext.alloc.list);
156 : 22170 : break;
157 : :
158 : 3879 : case EXEC_OPEN:
159 : 3879 : gfc_free_open (p->ext.open);
160 : 3879 : break;
161 : :
162 : 3067 : case EXEC_CLOSE:
163 : 3067 : gfc_free_close (p->ext.close);
164 : 3067 : break;
165 : :
166 : 2779 : case EXEC_BACKSPACE:
167 : 2779 : case EXEC_ENDFILE:
168 : 2779 : case EXEC_REWIND:
169 : 2779 : case EXEC_FLUSH:
170 : 2779 : gfc_free_filepos (p->ext.filepos);
171 : 2779 : break;
172 : :
173 : 817 : case EXEC_INQUIRE:
174 : 817 : gfc_free_inquire (p->ext.inquire);
175 : 817 : break;
176 : :
177 : 89 : case EXEC_WAIT:
178 : 89 : gfc_free_wait (p->ext.wait);
179 : 89 : break;
180 : :
181 : 63180 : case EXEC_READ:
182 : 63180 : case EXEC_WRITE:
183 : 63180 : gfc_free_dt (p->ext.dt);
184 : 63180 : 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 : 870 : for (int i = 0; i < LOCALITY_NUM; i++)
193 : 696 : gfc_free_expr_list (p->ext.concur.locality[i]);
194 : 4154 : gcc_fallthrough ();
195 : 4154 : case EXEC_FORALL:
196 : 4154 : gfc_free_forall_iterator (p->ext.concur.forall_iterator);
197 : 4154 : break;
198 : :
199 : 152 : case EXEC_OACC_DECLARE:
200 : 152 : if (p->ext.oacc_declare)
201 : 76 : gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
202 : : break;
203 : :
204 : 58492 : case EXEC_OACC_ATOMIC:
205 : 58492 : case EXEC_OACC_PARALLEL_LOOP:
206 : 58492 : case EXEC_OACC_PARALLEL:
207 : 58492 : case EXEC_OACC_KERNELS_LOOP:
208 : 58492 : case EXEC_OACC_KERNELS:
209 : 58492 : case EXEC_OACC_SERIAL_LOOP:
210 : 58492 : case EXEC_OACC_SERIAL:
211 : 58492 : case EXEC_OACC_DATA:
212 : 58492 : case EXEC_OACC_HOST_DATA:
213 : 58492 : case EXEC_OACC_LOOP:
214 : 58492 : case EXEC_OACC_UPDATE:
215 : 58492 : case EXEC_OACC_WAIT:
216 : 58492 : case EXEC_OACC_CACHE:
217 : 58492 : case EXEC_OACC_ENTER_DATA:
218 : 58492 : case EXEC_OACC_EXIT_DATA:
219 : 58492 : case EXEC_OACC_ROUTINE:
220 : 58492 : case EXEC_OMP_ALLOCATE:
221 : 58492 : case EXEC_OMP_ALLOCATORS:
222 : 58492 : case EXEC_OMP_ASSUME:
223 : 58492 : case EXEC_OMP_ATOMIC:
224 : 58492 : case EXEC_OMP_CANCEL:
225 : 58492 : case EXEC_OMP_CANCELLATION_POINT:
226 : 58492 : case EXEC_OMP_CRITICAL:
227 : 58492 : case EXEC_OMP_DEPOBJ:
228 : 58492 : case EXEC_OMP_DISPATCH:
229 : 58492 : case EXEC_OMP_DISTRIBUTE:
230 : 58492 : case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
231 : 58492 : case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
232 : 58492 : case EXEC_OMP_DISTRIBUTE_SIMD:
233 : 58492 : case EXEC_OMP_DO:
234 : 58492 : case EXEC_OMP_DO_SIMD:
235 : 58492 : case EXEC_OMP_ERROR:
236 : 58492 : case EXEC_OMP_INTEROP:
237 : 58492 : case EXEC_OMP_LOOP:
238 : 58492 : case EXEC_OMP_END_SINGLE:
239 : 58492 : case EXEC_OMP_MASKED_TASKLOOP:
240 : 58492 : case EXEC_OMP_MASKED_TASKLOOP_SIMD:
241 : 58492 : case EXEC_OMP_MASTER_TASKLOOP:
242 : 58492 : case EXEC_OMP_MASTER_TASKLOOP_SIMD:
243 : 58492 : case EXEC_OMP_ORDERED:
244 : 58492 : case EXEC_OMP_MASKED:
245 : 58492 : case EXEC_OMP_PARALLEL:
246 : 58492 : case EXEC_OMP_PARALLEL_DO:
247 : 58492 : case EXEC_OMP_PARALLEL_DO_SIMD:
248 : 58492 : case EXEC_OMP_PARALLEL_LOOP:
249 : 58492 : case EXEC_OMP_PARALLEL_MASKED:
250 : 58492 : case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
251 : 58492 : case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
252 : 58492 : case EXEC_OMP_PARALLEL_MASTER:
253 : 58492 : case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
254 : 58492 : case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
255 : 58492 : case EXEC_OMP_PARALLEL_SECTIONS:
256 : 58492 : case EXEC_OMP_PARALLEL_WORKSHARE:
257 : 58492 : case EXEC_OMP_SCAN:
258 : 58492 : case EXEC_OMP_SCOPE:
259 : 58492 : case EXEC_OMP_SECTIONS:
260 : 58492 : case EXEC_OMP_SIMD:
261 : 58492 : case EXEC_OMP_SINGLE:
262 : 58492 : case EXEC_OMP_TARGET:
263 : 58492 : case EXEC_OMP_TARGET_DATA:
264 : 58492 : case EXEC_OMP_TARGET_ENTER_DATA:
265 : 58492 : case EXEC_OMP_TARGET_EXIT_DATA:
266 : 58492 : case EXEC_OMP_TARGET_PARALLEL:
267 : 58492 : case EXEC_OMP_TARGET_PARALLEL_DO:
268 : 58492 : case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
269 : 58492 : case EXEC_OMP_TARGET_PARALLEL_LOOP:
270 : 58492 : case EXEC_OMP_TARGET_SIMD:
271 : 58492 : case EXEC_OMP_TARGET_TEAMS:
272 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
273 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
274 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
275 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
276 : 58492 : case EXEC_OMP_TARGET_TEAMS_LOOP:
277 : 58492 : case EXEC_OMP_TARGET_UPDATE:
278 : 58492 : case EXEC_OMP_TASK:
279 : 58492 : case EXEC_OMP_TASKLOOP:
280 : 58492 : case EXEC_OMP_TASKLOOP_SIMD:
281 : 58492 : case EXEC_OMP_TEAMS:
282 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE:
283 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
284 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
285 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
286 : 58492 : case EXEC_OMP_TEAMS_LOOP:
287 : 58492 : case EXEC_OMP_TILE:
288 : 58492 : case EXEC_OMP_UNROLL:
289 : 58492 : case EXEC_OMP_WORKSHARE:
290 : 58492 : gfc_free_omp_clauses (p->ext.omp_clauses);
291 : 58492 : break;
292 : :
293 : 3 : case EXEC_OMP_END_CRITICAL:
294 : 3 : free (CONST_CAST (char *, p->ext.omp_name));
295 : 3 : break;
296 : :
297 : 77 : case EXEC_OMP_FLUSH:
298 : 77 : gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false, false);
299 : 77 : break;
300 : :
301 : : case EXEC_OMP_BARRIER:
302 : : case EXEC_OMP_MASTER:
303 : : case EXEC_OMP_END_NOWAIT:
304 : : case EXEC_OMP_TASKGROUP:
305 : : case EXEC_OMP_TASKWAIT:
306 : : case EXEC_OMP_TASKYIELD:
307 : : break;
308 : :
309 : 83 : case EXEC_OMP_METADIRECTIVE:
310 : 83 : gfc_free_omp_variants (p->ext.omp_variants);
311 : 83 : break;
312 : :
313 : 0 : default:
314 : 0 : gfc_internal_error ("gfc_free_statement(): Bad statement");
315 : : }
316 : 28880806 : }
317 : :
318 : :
319 : : /* Free a code statement and all other code structures linked to it. */
320 : :
321 : : void
322 : 55565811 : gfc_free_statements (gfc_code *p)
323 : : {
324 : 55565811 : gfc_code *q;
325 : :
326 : 57091778 : for (; p; p = q)
327 : : {
328 : 1525967 : q = p->next;
329 : :
330 : 1525967 : if (p->block)
331 : 350227 : gfc_free_statements (p->block);
332 : 1525967 : gfc_free_statement (p);
333 : 1525967 : free (p);
334 : : }
335 : 55565811 : }
336 : :
337 : :
338 : : /* Free an association list (of an ASSOCIATE statement). */
339 : :
340 : : void
341 : 20915 : gfc_free_association_list (gfc_association_list* assoc)
342 : : {
343 : 20915 : if (!assoc)
344 : : return;
345 : :
346 : 7096 : if (assoc->ar)
347 : : {
348 : 68 : for (int i = 0; i < assoc->ar->dimen; i++)
349 : : {
350 : 39 : if (assoc->ar->start[i]
351 : 39 : && assoc->ar->start[i]->ts.type == BT_INTEGER)
352 : 39 : gfc_free_expr (assoc->ar->start[i]);
353 : 39 : if (assoc->ar->end[i]
354 : 39 : && assoc->ar->end[i]->ts.type == BT_INTEGER)
355 : 39 : gfc_free_expr (assoc->ar->end[i]);
356 : 39 : if (assoc->ar->stride[i]
357 : 0 : && assoc->ar->stride[i]->ts.type == BT_INTEGER)
358 : 0 : gfc_free_expr (assoc->ar->stride[i]);
359 : : }
360 : : }
361 : :
362 : 7096 : gfc_free_association_list (assoc->next);
363 : 7096 : free (assoc);
364 : : }
|
