1 /* Build executable statement trees. 2 Copyright (C) 2000-2019 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 if (p->ext.block.case_list) 145 gfc_free_case_list (p->ext.block.case_list); 146 break; 147 148 case EXEC_DO: 149 gfc_free_iterator (p->ext.iterator, 1); 150 break; 151 152 case EXEC_ALLOCATE: 153 case EXEC_DEALLOCATE: 154 gfc_free_alloc_list (p->ext.alloc.list); 155 break; 156 157 case EXEC_OPEN: 158 gfc_free_open (p->ext.open); 159 break; 160 161 case EXEC_CLOSE: 162 gfc_free_close (p->ext.close); 163 break; 164 165 case EXEC_BACKSPACE: 166 case EXEC_ENDFILE: 167 case EXEC_REWIND: 168 case EXEC_FLUSH: 169 gfc_free_filepos (p->ext.filepos); 170 break; 171 172 case EXEC_INQUIRE: 173 gfc_free_inquire (p->ext.inquire); 174 break; 175 176 case EXEC_WAIT: 177 gfc_free_wait (p->ext.wait); 178 break; 179 180 case EXEC_READ: 181 case EXEC_WRITE: 182 gfc_free_dt (p->ext.dt); 183 break; 184 185 case EXEC_DT_END: 186 /* The ext.dt member is a duplicate pointer and doesn't need to 187 be freed. */ 188 break; 189 190 case EXEC_DO_CONCURRENT: 191 case EXEC_FORALL: 192 gfc_free_forall_iterator (p->ext.forall_iterator); 193 break; 194 195 case EXEC_OACC_DECLARE: 196 if (p->ext.oacc_declare) 197 gfc_free_oacc_declare_clauses (p->ext.oacc_declare); 198 break; 199 200 case EXEC_OACC_PARALLEL_LOOP: 201 case EXEC_OACC_PARALLEL: 202 case EXEC_OACC_KERNELS_LOOP: 203 case EXEC_OACC_KERNELS: 204 case EXEC_OACC_DATA: 205 case EXEC_OACC_HOST_DATA: 206 case EXEC_OACC_LOOP: 207 case EXEC_OACC_UPDATE: 208 case EXEC_OACC_WAIT: 209 case EXEC_OACC_CACHE: 210 case EXEC_OACC_ENTER_DATA: 211 case EXEC_OACC_EXIT_DATA: 212 case EXEC_OACC_ROUTINE: 213 case EXEC_OMP_CANCEL: 214 case EXEC_OMP_CANCELLATION_POINT: 215 case EXEC_OMP_CRITICAL: 216 case EXEC_OMP_DISTRIBUTE: 217 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO: 218 case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: 219 case EXEC_OMP_DISTRIBUTE_SIMD: 220 case EXEC_OMP_DO: 221 case EXEC_OMP_DO_SIMD: 222 case EXEC_OMP_END_SINGLE: 223 case EXEC_OMP_ORDERED: 224 case EXEC_OMP_PARALLEL: 225 case EXEC_OMP_PARALLEL_DO: 226 case EXEC_OMP_PARALLEL_DO_SIMD: 227 case EXEC_OMP_PARALLEL_SECTIONS: 228 case EXEC_OMP_PARALLEL_WORKSHARE: 229 case EXEC_OMP_SECTIONS: 230 case EXEC_OMP_SIMD: 231 case EXEC_OMP_SINGLE: 232 case EXEC_OMP_TARGET: 233 case EXEC_OMP_TARGET_DATA: 234 case EXEC_OMP_TARGET_ENTER_DATA: 235 case EXEC_OMP_TARGET_EXIT_DATA: 236 case EXEC_OMP_TARGET_PARALLEL: 237 case EXEC_OMP_TARGET_PARALLEL_DO: 238 case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: 239 case EXEC_OMP_TARGET_SIMD: 240 case EXEC_OMP_TARGET_TEAMS: 241 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: 242 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: 243 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: 244 case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: 245 case EXEC_OMP_TARGET_UPDATE: 246 case EXEC_OMP_TASK: 247 case EXEC_OMP_TASKLOOP: 248 case EXEC_OMP_TASKLOOP_SIMD: 249 case EXEC_OMP_TEAMS: 250 case EXEC_OMP_TEAMS_DISTRIBUTE: 251 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: 252 case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: 253 case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: 254 case EXEC_OMP_WORKSHARE: 255 gfc_free_omp_clauses (p->ext.omp_clauses); 256 break; 257 258 case EXEC_OMP_END_CRITICAL: 259 free (CONST_CAST (char *, p->ext.omp_name)); 260 break; 261 262 case EXEC_OMP_FLUSH: 263 gfc_free_omp_namelist (p->ext.omp_namelist); 264 break; 265 266 case EXEC_OACC_ATOMIC: 267 case EXEC_OMP_ATOMIC: 268 case EXEC_OMP_BARRIER: 269 case EXEC_OMP_MASTER: 270 case EXEC_OMP_END_NOWAIT: 271 case EXEC_OMP_TASKGROUP: 272 case EXEC_OMP_TASKWAIT: 273 case EXEC_OMP_TASKYIELD: 274 break; 275 276 default: 277 gfc_internal_error ("gfc_free_statement(): Bad statement"); 278 } 279 } 280 281 282 /* Free a code statement and all other code structures linked to it. */ 283 284 void 285 gfc_free_statements (gfc_code *p) 286 { 287 gfc_code *q; 288 289 for (; p; p = q) 290 { 291 q = p->next; 292 293 if (p->block) 294 gfc_free_statements (p->block); 295 gfc_free_statement (p); 296 free (p); 297 } 298 } 299 300 301 /* Free an association list (of an ASSOCIATE statement). */ 302 303 void 304 gfc_free_association_list (gfc_association_list* assoc) 305 { 306 if (!assoc) 307 return; 308 309 gfc_free_association_list (assoc->next); 310 free (assoc); 311 } 312