blob: 73f30c2137fa86bd5517cf789496fd064fc85ab5 [file] [log] [blame]
/* Build executable statement trees.
Copyright (C) 2000-2022 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
GCC is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
GCC is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING3. If not see
<http://www.gnu.org/licenses/>. */
/* Executable statements are strung together into a singly linked list
of code structures. These structures are later translated into GCC
GENERIC tree structures and from there to executable code for a
target. */
#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "gfortran.h"
gfc_code new_st;
/* Zeroes out the new_st structure. */
void
gfc_clear_new_st (void)
{
memset (&new_st, '\0', sizeof (new_st));
new_st.op = EXEC_NOP;
}
/* Get a gfc_code structure, initialized with the current locus
and a statement code 'op'. */
gfc_code *
gfc_get_code (gfc_exec_op op)
{
gfc_code *c;
c = XCNEW (gfc_code);
c->op = op;
c->loc = gfc_current_locus;
return c;
}
/* Given some part of a gfc_code structure, append a set of code to
its tail, returning a pointer to the new tail. */
gfc_code *
gfc_append_code (gfc_code *tail, gfc_code *new_code)
{
if (tail != NULL)
{
while (tail->next != NULL)
tail = tail->next;
tail->next = new_code;
}
while (new_code->next != NULL)
new_code = new_code->next;
return new_code;
}
/* Free a single code structure, but not the actual structure itself. */
void
gfc_free_statement (gfc_code *p)
{
if (p->expr1)
gfc_free_expr (p->expr1);
if (p->expr2)
gfc_free_expr (p->expr2);
switch (p->op)
{
case EXEC_NOP:
case EXEC_END_BLOCK:
case EXEC_END_NESTED_BLOCK:
case EXEC_ASSIGN:
case EXEC_INIT_ASSIGN:
case EXEC_GOTO:
case EXEC_CYCLE:
case EXEC_RETURN:
case EXEC_END_PROCEDURE:
case EXEC_IF:
case EXEC_PAUSE:
case EXEC_STOP:
case EXEC_ERROR_STOP:
case EXEC_EXIT:
case EXEC_WHERE:
case EXEC_IOLENGTH:
case EXEC_POINTER_ASSIGN:
case EXEC_DO_WHILE:
case EXEC_CONTINUE:
case EXEC_TRANSFER:
case EXEC_LABEL_ASSIGN:
case EXEC_ENTRY:
case EXEC_ARITHMETIC_IF:
case EXEC_CRITICAL:
case EXEC_SYNC_ALL:
case EXEC_SYNC_IMAGES:
case EXEC_SYNC_MEMORY:
case EXEC_LOCK:
case EXEC_UNLOCK:
case EXEC_EVENT_POST:
case EXEC_EVENT_WAIT:
case EXEC_FAIL_IMAGE:
case EXEC_CHANGE_TEAM:
case EXEC_END_TEAM:
case EXEC_FORM_TEAM:
case EXEC_SYNC_TEAM:
break;
case EXEC_BLOCK:
gfc_free_namespace (p->ext.block.ns);
gfc_free_association_list (p->ext.block.assoc);
break;
case EXEC_COMPCALL:
case EXEC_CALL_PPC:
case EXEC_CALL:
case EXEC_ASSIGN_CALL:
gfc_free_actual_arglist (p->ext.actual);
break;
case EXEC_SELECT:
case EXEC_SELECT_TYPE:
case EXEC_SELECT_RANK:
if (p->ext.block.case_list)
gfc_free_case_list (p->ext.block.case_list);
break;
case EXEC_DO:
gfc_free_iterator (p->ext.iterator, 1);
break;
case EXEC_ALLOCATE:
case EXEC_DEALLOCATE:
gfc_free_alloc_list (p->ext.alloc.list);
break;
case EXEC_OPEN:
gfc_free_open (p->ext.open);
break;
case EXEC_CLOSE:
gfc_free_close (p->ext.close);
break;
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
case EXEC_FLUSH:
gfc_free_filepos (p->ext.filepos);
break;
case EXEC_INQUIRE:
gfc_free_inquire (p->ext.inquire);
break;
case EXEC_WAIT:
gfc_free_wait (p->ext.wait);
break;
case EXEC_READ:
case EXEC_WRITE:
gfc_free_dt (p->ext.dt);
break;
case EXEC_DT_END:
/* The ext.dt member is a duplicate pointer and doesn't need to
be freed. */
break;
case EXEC_DO_CONCURRENT:
case EXEC_FORALL:
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
case EXEC_OACC_DECLARE:
if (p->ext.oacc_declare)
gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
break;
case EXEC_OACC_ATOMIC:
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
case EXEC_OACC_KERNELS:
case EXEC_OACC_SERIAL_LOOP:
case EXEC_OACC_SERIAL:
case EXEC_OACC_DATA:
case EXEC_OACC_HOST_DATA:
case EXEC_OACC_LOOP:
case EXEC_OACC_UPDATE:
case EXEC_OACC_WAIT:
case EXEC_OACC_CACHE:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ROUTINE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_ERROR:
case EXEC_OMP_LOOP:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_MASKED_TASKLOOP:
case EXEC_OMP_MASKED_TASKLOOP_SIMD:
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
case EXEC_OMP_ORDERED:
case EXEC_OMP_MASKED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_LOOP:
case EXEC_OMP_PARALLEL_MASKED:
case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
case EXEC_OMP_PARALLEL_MASTER:
case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SIMD:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TARGET:
case EXEC_OMP_TARGET_DATA:
case EXEC_OMP_TARGET_ENTER_DATA:
case EXEC_OMP_TARGET_EXIT_DATA:
case EXEC_OMP_TARGET_PARALLEL:
case EXEC_OMP_TARGET_PARALLEL_DO:
case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_PARALLEL_LOOP:
case EXEC_OMP_TARGET_SIMD:
case EXEC_OMP_TARGET_TEAMS:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TARGET_TEAMS_LOOP:
case EXEC_OMP_TARGET_UPDATE:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKLOOP:
case EXEC_OMP_TASKLOOP_SIMD:
case EXEC_OMP_TEAMS:
case EXEC_OMP_TEAMS_DISTRIBUTE:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
case EXEC_OMP_TEAMS_LOOP:
case EXEC_OMP_WORKSHARE:
gfc_free_omp_clauses (p->ext.omp_clauses);
break;
case EXEC_OMP_END_CRITICAL:
free (CONST_CAST (char *, p->ext.omp_name));
break;
case EXEC_OMP_FLUSH:
gfc_free_omp_namelist (p->ext.omp_namelist, false);
break;
case EXEC_OMP_BARRIER:
case EXEC_OMP_MASTER:
case EXEC_OMP_END_NOWAIT:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TASKYIELD:
break;
default:
gfc_internal_error ("gfc_free_statement(): Bad statement");
}
}
/* Free a code statement and all other code structures linked to it. */
void
gfc_free_statements (gfc_code *p)
{
gfc_code *q;
for (; p; p = q)
{
q = p->next;
if (p->block)
gfc_free_statements (p->block);
gfc_free_statement (p);
free (p);
}
}
/* Free an association list (of an ASSOCIATE statement). */
void
gfc_free_association_list (gfc_association_list* assoc)
{
if (!assoc)
return;
gfc_free_association_list (assoc->next);
free (assoc);
}