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