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 : 29851974 : gfc_clear_new_st (void)
38 : : {
39 : 29851974 : memset (&new_st, '\0', sizeof (new_st));
40 : 29851974 : new_st.op = EXEC_NOP;
41 : 29851974 : }
42 : :
43 : :
44 : : /* Get a gfc_code structure, initialized with the current locus
45 : : and a statement code 'op'. */
46 : :
47 : : gfc_code *
48 : 476163 : gfc_get_code (gfc_exec_op op)
49 : : {
50 : 476163 : gfc_code *c;
51 : :
52 : 476163 : c = XCNEW (gfc_code);
53 : 476163 : c->op = op;
54 : 476163 : c->loc = gfc_current_locus;
55 : 476163 : 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 : 78954 : gfc_append_code (gfc_code *tail, gfc_code *new_code)
64 : : {
65 : 78954 : if (tail != NULL)
66 : : {
67 : 65155 : while (tail->next != NULL)
68 : : tail = tail->next;
69 : :
70 : 48892 : tail->next = new_code;
71 : : }
72 : :
73 : 79489 : while (new_code->next != NULL)
74 : : new_code = new_code->next;
75 : :
76 : 78954 : return new_code;
77 : : }
78 : :
79 : :
80 : : /* Free a single code structure, but not the actual structure itself. */
81 : :
82 : : void
83 : 28945714 : gfc_free_statement (gfc_code *p)
84 : : {
85 : 28945714 : if (p->expr1)
86 : 1185211 : gfc_free_expr (p->expr1);
87 : 28945714 : if (p->expr2)
88 : 328945 : gfc_free_expr (p->expr2);
89 : 28945714 : if (p->expr3)
90 : 3976 : gfc_free_expr (p->expr3);
91 : 28945714 : if (p->expr4)
92 : 28 : gfc_free_expr (p->expr4);
93 : :
94 : 28945714 : switch (p->op)
95 : : {
96 : : case EXEC_NOP:
97 : : case EXEC_END_BLOCK:
98 : : case EXEC_END_NESTED_BLOCK:
99 : : case EXEC_ASSIGN:
100 : : case EXEC_INIT_ASSIGN:
101 : : case EXEC_GOTO:
102 : : case EXEC_CYCLE:
103 : : case EXEC_RETURN:
104 : : case EXEC_END_PROCEDURE:
105 : : case EXEC_IF:
106 : : case EXEC_PAUSE:
107 : : case EXEC_STOP:
108 : : case EXEC_ERROR_STOP:
109 : : case EXEC_EXIT:
110 : : case EXEC_WHERE:
111 : : case EXEC_IOLENGTH:
112 : : case EXEC_POINTER_ASSIGN:
113 : : case EXEC_DO_WHILE:
114 : : case EXEC_CONTINUE:
115 : : case EXEC_TRANSFER:
116 : : case EXEC_LABEL_ASSIGN:
117 : : case EXEC_ENTRY:
118 : : case EXEC_ARITHMETIC_IF:
119 : : case EXEC_CRITICAL:
120 : : case EXEC_SYNC_ALL:
121 : : case EXEC_SYNC_IMAGES:
122 : : case EXEC_SYNC_MEMORY:
123 : : case EXEC_LOCK:
124 : : case EXEC_UNLOCK:
125 : : case EXEC_EVENT_POST:
126 : : case EXEC_EVENT_WAIT:
127 : : case EXEC_FAIL_IMAGE:
128 : : case EXEC_CHANGE_TEAM:
129 : : case EXEC_END_TEAM:
130 : : case EXEC_FORM_TEAM:
131 : : case EXEC_SYNC_TEAM:
132 : : break;
133 : :
134 : 13796 : case EXEC_BLOCK:
135 : 13796 : gfc_free_namespace (p->ext.block.ns);
136 : 13796 : gfc_free_association_list (p->ext.block.assoc);
137 : 13796 : break;
138 : :
139 : 83574 : case EXEC_COMPCALL:
140 : 83574 : case EXEC_CALL_PPC:
141 : 83574 : case EXEC_CALL:
142 : 83574 : case EXEC_ASSIGN_CALL:
143 : 83574 : gfc_free_actual_arglist (p->ext.actual);
144 : 83574 : break;
145 : :
146 : 14660 : case EXEC_SELECT:
147 : 14660 : case EXEC_SELECT_TYPE:
148 : 14660 : case EXEC_SELECT_RANK:
149 : 14660 : if (p->ext.block.case_list)
150 : 9635 : gfc_free_case_list (p->ext.block.case_list);
151 : : break;
152 : :
153 : 79277 : case EXEC_DO:
154 : 79277 : gfc_free_iterator (p->ext.iterator, 1);
155 : 79277 : break;
156 : :
157 : 22337 : case EXEC_ALLOCATE:
158 : 22337 : case EXEC_DEALLOCATE:
159 : 22337 : gfc_free_alloc_list (p->ext.alloc.list);
160 : 22337 : break;
161 : :
162 : 3879 : case EXEC_OPEN:
163 : 3879 : gfc_free_open (p->ext.open);
164 : 3879 : break;
165 : :
166 : 3067 : case EXEC_CLOSE:
167 : 3067 : gfc_free_close (p->ext.close);
168 : 3067 : break;
169 : :
170 : 2779 : case EXEC_BACKSPACE:
171 : 2779 : case EXEC_ENDFILE:
172 : 2779 : case EXEC_REWIND:
173 : 2779 : case EXEC_FLUSH:
174 : 2779 : gfc_free_filepos (p->ext.filepos);
175 : 2779 : break;
176 : :
177 : 817 : case EXEC_INQUIRE:
178 : 817 : gfc_free_inquire (p->ext.inquire);
179 : 817 : break;
180 : :
181 : 89 : case EXEC_WAIT:
182 : 89 : gfc_free_wait (p->ext.wait);
183 : 89 : break;
184 : :
185 : 63934 : case EXEC_READ:
186 : 63934 : case EXEC_WRITE:
187 : 63934 : gfc_free_dt (p->ext.dt);
188 : 63934 : break;
189 : :
190 : : case EXEC_DT_END:
191 : : /* The ext.dt member is a duplicate pointer and doesn't need to
192 : : be freed. */
193 : : break;
194 : :
195 : : case EXEC_DO_CONCURRENT:
196 : 870 : for (int i = 0; i < LOCALITY_NUM; i++)
197 : 696 : gfc_free_expr_list (p->ext.concur.locality[i]);
198 : 4154 : gcc_fallthrough ();
199 : 4154 : case EXEC_FORALL:
200 : 4154 : gfc_free_forall_iterator (p->ext.concur.forall_iterator);
201 : 4154 : break;
202 : :
203 : 152 : case EXEC_OACC_DECLARE:
204 : 152 : if (p->ext.oacc_declare)
205 : 76 : gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
206 : : break;
207 : :
208 : 58492 : case EXEC_OACC_ATOMIC:
209 : 58492 : case EXEC_OACC_PARALLEL_LOOP:
210 : 58492 : case EXEC_OACC_PARALLEL:
211 : 58492 : case EXEC_OACC_KERNELS_LOOP:
212 : 58492 : case EXEC_OACC_KERNELS:
213 : 58492 : case EXEC_OACC_SERIAL_LOOP:
214 : 58492 : case EXEC_OACC_SERIAL:
215 : 58492 : case EXEC_OACC_DATA:
216 : 58492 : case EXEC_OACC_HOST_DATA:
217 : 58492 : case EXEC_OACC_LOOP:
218 : 58492 : case EXEC_OACC_UPDATE:
219 : 58492 : case EXEC_OACC_WAIT:
220 : 58492 : case EXEC_OACC_CACHE:
221 : 58492 : case EXEC_OACC_ENTER_DATA:
222 : 58492 : case EXEC_OACC_EXIT_DATA:
223 : 58492 : case EXEC_OACC_ROUTINE:
224 : 58492 : case EXEC_OMP_ALLOCATE:
225 : 58492 : case EXEC_OMP_ALLOCATORS:
226 : 58492 : case EXEC_OMP_ASSUME:
227 : 58492 : case EXEC_OMP_ATOMIC:
228 : 58492 : case EXEC_OMP_CANCEL:
229 : 58492 : case EXEC_OMP_CANCELLATION_POINT:
230 : 58492 : case EXEC_OMP_CRITICAL:
231 : 58492 : case EXEC_OMP_DEPOBJ:
232 : 58492 : case EXEC_OMP_DISPATCH:
233 : 58492 : case EXEC_OMP_DISTRIBUTE:
234 : 58492 : case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
235 : 58492 : case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
236 : 58492 : case EXEC_OMP_DISTRIBUTE_SIMD:
237 : 58492 : case EXEC_OMP_DO:
238 : 58492 : case EXEC_OMP_DO_SIMD:
239 : 58492 : case EXEC_OMP_ERROR:
240 : 58492 : case EXEC_OMP_INTEROP:
241 : 58492 : case EXEC_OMP_LOOP:
242 : 58492 : case EXEC_OMP_END_SINGLE:
243 : 58492 : case EXEC_OMP_MASKED_TASKLOOP:
244 : 58492 : case EXEC_OMP_MASKED_TASKLOOP_SIMD:
245 : 58492 : case EXEC_OMP_MASTER_TASKLOOP:
246 : 58492 : case EXEC_OMP_MASTER_TASKLOOP_SIMD:
247 : 58492 : case EXEC_OMP_ORDERED:
248 : 58492 : case EXEC_OMP_MASKED:
249 : 58492 : case EXEC_OMP_PARALLEL:
250 : 58492 : case EXEC_OMP_PARALLEL_DO:
251 : 58492 : case EXEC_OMP_PARALLEL_DO_SIMD:
252 : 58492 : case EXEC_OMP_PARALLEL_LOOP:
253 : 58492 : case EXEC_OMP_PARALLEL_MASKED:
254 : 58492 : case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
255 : 58492 : case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
256 : 58492 : case EXEC_OMP_PARALLEL_MASTER:
257 : 58492 : case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
258 : 58492 : case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
259 : 58492 : case EXEC_OMP_PARALLEL_SECTIONS:
260 : 58492 : case EXEC_OMP_PARALLEL_WORKSHARE:
261 : 58492 : case EXEC_OMP_SCAN:
262 : 58492 : case EXEC_OMP_SCOPE:
263 : 58492 : case EXEC_OMP_SECTIONS:
264 : 58492 : case EXEC_OMP_SIMD:
265 : 58492 : case EXEC_OMP_SINGLE:
266 : 58492 : case EXEC_OMP_TARGET:
267 : 58492 : case EXEC_OMP_TARGET_DATA:
268 : 58492 : case EXEC_OMP_TARGET_ENTER_DATA:
269 : 58492 : case EXEC_OMP_TARGET_EXIT_DATA:
270 : 58492 : case EXEC_OMP_TARGET_PARALLEL:
271 : 58492 : case EXEC_OMP_TARGET_PARALLEL_DO:
272 : 58492 : case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
273 : 58492 : case EXEC_OMP_TARGET_PARALLEL_LOOP:
274 : 58492 : case EXEC_OMP_TARGET_SIMD:
275 : 58492 : case EXEC_OMP_TARGET_TEAMS:
276 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
277 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
278 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
279 : 58492 : case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
280 : 58492 : case EXEC_OMP_TARGET_TEAMS_LOOP:
281 : 58492 : case EXEC_OMP_TARGET_UPDATE:
282 : 58492 : case EXEC_OMP_TASK:
283 : 58492 : case EXEC_OMP_TASKLOOP:
284 : 58492 : case EXEC_OMP_TASKLOOP_SIMD:
285 : 58492 : case EXEC_OMP_TEAMS:
286 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE:
287 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
288 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
289 : 58492 : case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
290 : 58492 : case EXEC_OMP_TEAMS_LOOP:
291 : 58492 : case EXEC_OMP_TILE:
292 : 58492 : case EXEC_OMP_UNROLL:
293 : 58492 : case EXEC_OMP_WORKSHARE:
294 : 58492 : gfc_free_omp_clauses (p->ext.omp_clauses);
295 : 58492 : break;
296 : :
297 : 3 : case EXEC_OMP_END_CRITICAL:
298 : 3 : free (CONST_CAST (char *, p->ext.omp_name));
299 : 3 : break;
300 : :
301 : 77 : case EXEC_OMP_FLUSH:
302 : 77 : gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false, false);
303 : 77 : break;
304 : :
305 : : case EXEC_OMP_BARRIER:
306 : : case EXEC_OMP_MASTER:
307 : : case EXEC_OMP_END_NOWAIT:
308 : : case EXEC_OMP_TASKGROUP:
309 : : case EXEC_OMP_TASKWAIT:
310 : : case EXEC_OMP_TASKYIELD:
311 : : break;
312 : :
313 : 83 : case EXEC_OMP_METADIRECTIVE:
314 : 83 : gfc_free_omp_variants (p->ext.omp_variants);
315 : 83 : break;
316 : :
317 : 0 : default:
318 : 0 : gfc_internal_error ("gfc_free_statement(): Bad statement");
319 : : }
320 : 28945714 : }
321 : :
322 : :
323 : : /* Free a code statement and all other code structures linked to it. */
324 : :
325 : : void
326 : 55688599 : gfc_free_statements (gfc_code *p)
327 : : {
328 : 55688599 : gfc_code *q;
329 : :
330 : 57218985 : for (; p; p = q)
331 : : {
332 : 1530386 : q = p->next;
333 : :
334 : 1530386 : if (p->block)
335 : 351304 : gfc_free_statements (p->block);
336 : 1530386 : gfc_free_statement (p);
337 : 1530386 : free (p);
338 : : }
339 : 55688599 : }
340 : :
341 : :
342 : : /* Free an association list (of an ASSOCIATE statement). */
343 : :
344 : : void
345 : 20917 : gfc_free_association_list (gfc_association_list* assoc)
346 : : {
347 : 20917 : if (!assoc)
348 : : return;
349 : :
350 : 7097 : if (assoc->ar)
351 : : {
352 : 68 : for (int i = 0; i < assoc->ar->dimen; i++)
353 : : {
354 : 39 : if (assoc->ar->start[i]
355 : 39 : && assoc->ar->start[i]->ts.type == BT_INTEGER)
356 : 39 : gfc_free_expr (assoc->ar->start[i]);
357 : 39 : if (assoc->ar->end[i]
358 : 39 : && assoc->ar->end[i]->ts.type == BT_INTEGER)
359 : 39 : gfc_free_expr (assoc->ar->end[i]);
360 : 39 : if (assoc->ar->stride[i]
361 : 0 : && assoc->ar->stride[i]->ts.type == BT_INTEGER)
362 : 0 : gfc_free_expr (assoc->ar->stride[i]);
363 : : }
364 : : }
365 : :
366 : 7097 : gfc_free_association_list (assoc->next);
367 : 7097 : free (assoc);
368 : : }
|
