1 /* Build executable statement trees. 2 Copyright (C) 2000-2020 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 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 * 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 * 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 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_PARALLEL_LOOP: 202 case EXEC_OACC_PARALLEL: 203 case EXEC_OACC_KERNELS_LOOP: 204 case EXEC_OACC_KERNELS: 205 case EXEC_OACC_SERIAL_LOOP: 206 case EXEC_OACC_SERIAL: 207 case EXEC_OACC_DATA: 208 case EXEC_OACC_HOST_DATA: 209 case EXEC_OACC_LOOP: 210 case EXEC_OACC_UPDATE: 211 case EXEC_OACC_WAIT: 212 case EXEC_OACC_CACHE: 213 case EXEC_OACC_ENTER_DATA: 214 case EXEC_OACC_EXIT_DATA: 215 case EXEC_OACC_ROUTINE: 216 case EXEC_OMP_CANCEL: 217 case EXEC_OMP_CANCELLATION_POINT: 218 case EXEC_OMP_CRITICAL: 219 case EXEC_OMP_DISTRIBUTE: 220 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: 221 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: 222 case EXEC_OMP_DISTRIBUTE_SIMD: 223 case EXEC_OMP_DO: 224 case EXEC_OMP_DO_SIMD: 225 case EXEC_OMP_END_SINGLE: 226 case EXEC_OMP_ORDERED: 227 case EXEC_OMP_PARALLEL: 228 case EXEC_OMP_PARALLEL_DO: 229 case EXEC_OMP_PARALLEL_DO_SIMD: 230 case EXEC_OMP_PARALLEL_SECTIONS: 231 case EXEC_OMP_PARALLEL_WORKSHARE: 232 case EXEC_OMP_SECTIONS: 233 case EXEC_OMP_SIMD: 234 case EXEC_OMP_SINGLE: 235 case EXEC_OMP_TARGET: 236 case EXEC_OMP_TARGET_DATA: 237 case EXEC_OMP_TARGET_ENTER_DATA: 238 case EXEC_OMP_TARGET_EXIT_DATA: 239 case EXEC_OMP_TARGET_PARALLEL: 240 case EXEC_OMP_TARGET_PARALLEL_DO: 241 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: 242 case EXEC_OMP_TARGET_SIMD: 243 case EXEC_OMP_TARGET_TEAMS: 244 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: 245 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: 246 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: 247 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: 248 case EXEC_OMP_TARGET_UPDATE: 249 case EXEC_OMP_TASK: 250 case EXEC_OMP_TASKLOOP: 251 case EXEC_OMP_TASKLOOP_SIMD: 252 case EXEC_OMP_TEAMS: 253 case EXEC_OMP_TEAMS_DISTRIBUTE: 254 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: 255 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: 256 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: 257 case EXEC_OMP_WORKSHARE: 258 gfc_free_omp_clauses (p->ext.omp_clauses); 259 break; 260 261 case EXEC_OMP_END_CRITICAL: 262 free (CONST_CAST (char *, p->ext.omp_name)); 263 break; 264 265 case EXEC_OMP_FLUSH: 266 gfc_free_omp_namelist (p->ext.omp_namelist); 267 break; 268 269 case EXEC_OACC_ATOMIC: 270 case EXEC_OMP_ATOMIC: 271 case EXEC_OMP_BARRIER: 272 case EXEC_OMP_MASTER: 273 case EXEC_OMP_END_NOWAIT: 274 case EXEC_OMP_TASKGROUP: 275 case EXEC_OMP_TASKWAIT: 276 case EXEC_OMP_TASKYIELD: 277 break; 278 279 default: 280 gfc_internal_error ("gfc_free_statement(): Bad statement"); 281 } 282 } 283 284 285 /* Free a code statement and all other code structures linked to it. */ 286 287 void 288 gfc_free_statements (gfc_code *p) 289 { 290 gfc_code *q; 291 292 for (; p; p = q) 293 { 294 q = p->next; 295 296 if (p->block) 297 gfc_free_statements (p->block); 298 gfc_free_statement (p); 299 free (p); 300 } 301 } 302 303 304 /* Free an association list (of an ASSOCIATE statement). */ 305 306 void 307 gfc_free_association_list (gfc_association_list* assoc) 308 { 309 if (!assoc) 310 return; 311 312 gfc_free_association_list (assoc->next); 313 free (assoc); 314 } 315