Line data    Source code

       1              : /* Build executable statement trees.
       2              :    Copyright (C) 2000-2026 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     30529047 : gfc_clear_new_st (void)
      38              : {
      39     30529047 :   memset (&new_st, '\0', sizeof (new_st));
      40     30529047 :   new_st.op = EXEC_NOP;
      41     30529047 : }
      42              : 
      43              : 
      44              : /* Get a gfc_code structure, initialized with the current locus
      45              :    and a statement code 'op'.  */
      46              : 
      47              : gfc_code *
      48       493096 : gfc_get_code (gfc_exec_op op)
      49              : {
      50       493096 :   gfc_code *c;
      51              : 
      52       493096 :   c = XCNEW (gfc_code);
      53       493096 :   c->op = op;
      54       493096 :   c->loc = gfc_current_locus;
      55       493096 :   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        80235 : gfc_append_code (gfc_code *tail, gfc_code *new_code)
      64              : {
      65        80235 :   if (tail != NULL)
      66              :     {
      67        66297 :       while (tail->next != NULL)
      68              :         tail = tail->next;
      69              : 
      70        49723 :       tail->next = new_code;
      71              :     }
      72              : 
      73        80770 :   while (new_code->next != NULL)
      74              :     new_code = new_code->next;
      75              : 
      76        80235 :   return new_code;
      77              : }
      78              : 
      79              : 
      80              : /* Free a single code structure, but not the actual structure itself.  */
      81              : 
      82              : void
      83     29609103 : gfc_free_statement (gfc_code *p)
      84              : {
      85     29609103 :   if (p->expr1)
      86      1214229 :     gfc_free_expr (p->expr1);
      87     29609103 :   if (p->expr2)
      88       338899 :     gfc_free_expr (p->expr2);
      89     29609103 :   if (p->expr3)
      90         4075 :     gfc_free_expr (p->expr3);
      91     29609103 :   if (p->expr4)
      92           40 :     gfc_free_expr (p->expr4);
      93              : 
      94     29609103 :   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        14302 :     case EXEC_BLOCK:
     135        14302 :       gfc_free_namespace (p->ext.block.ns);
     136        14302 :       gfc_free_association_list (p->ext.block.assoc);
     137        14302 :       break;
     138              : 
     139        85950 :     case EXEC_COMPCALL:
     140        85950 :     case EXEC_CALL_PPC:
     141        85950 :     case EXEC_CALL:
     142        85950 :     case EXEC_ASSIGN_CALL:
     143        85950 :       gfc_free_actual_arglist (p->ext.actual);
     144        85950 :       break;
     145              : 
     146        15063 :     case EXEC_SELECT:
     147        15063 :     case EXEC_SELECT_TYPE:
     148        15063 :     case EXEC_SELECT_RANK:
     149        15063 :       if (p->ext.block.case_list)
     150         9865 :         gfc_free_case_list (p->ext.block.case_list);
     151              :       break;
     152              : 
     153        82015 :     case EXEC_DO:
     154        82015 :       gfc_free_iterator (p->ext.iterator, 1);
     155        82015 :       break;
     156              : 
     157        23583 :     case EXEC_ALLOCATE:
     158        23583 :     case EXEC_DEALLOCATE:
     159        23583 :       gfc_free_alloc_list (p->ext.alloc.list);
     160        23583 :       break;
     161              : 
     162         3906 :     case EXEC_OPEN:
     163         3906 :       gfc_free_open (p->ext.open);
     164         3906 :       break;
     165              : 
     166         3094 :     case EXEC_CLOSE:
     167         3094 :       gfc_free_close (p->ext.close);
     168         3094 :       break;
     169              : 
     170         2809 :     case EXEC_BACKSPACE:
     171         2809 :     case EXEC_ENDFILE:
     172         2809 :     case EXEC_REWIND:
     173         2809 :     case EXEC_FLUSH:
     174         2809 :       gfc_free_filepos (p->ext.filepos);
     175         2809 :       break;
     176              : 
     177          836 :     case EXEC_INQUIRE:
     178          836 :       gfc_free_inquire (p->ext.inquire);
     179          836 :       break;
     180              : 
     181           89 :     case EXEC_WAIT:
     182           89 :       gfc_free_wait (p->ext.wait);
     183           89 :       break;
     184              : 
     185        64938 :     case EXEC_READ:
     186        64938 :     case EXEC_WRITE:
     187        64938 :       gfc_free_dt (p->ext.dt);
     188        64938 :       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         1050 :       for (int i = 0; i < LOCALITY_NUM; i++)
     197          840 :         gfc_free_expr_list (p->ext.concur.locality[i]);
     198         4194 :       gcc_fallthrough ();
     199         4194 :     case EXEC_FORALL:
     200         4194 :       gfc_free_forall_iterator (p->ext.concur.forall_iterator);
     201         4194 :       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        58954 :     case EXEC_OACC_ATOMIC:
     209        58954 :     case EXEC_OACC_PARALLEL_LOOP:
     210        58954 :     case EXEC_OACC_PARALLEL:
     211        58954 :     case EXEC_OACC_KERNELS_LOOP:
     212        58954 :     case EXEC_OACC_KERNELS:
     213        58954 :     case EXEC_OACC_SERIAL_LOOP:
     214        58954 :     case EXEC_OACC_SERIAL:
     215        58954 :     case EXEC_OACC_DATA:
     216        58954 :     case EXEC_OACC_HOST_DATA:
     217        58954 :     case EXEC_OACC_LOOP:
     218        58954 :     case EXEC_OACC_UPDATE:
     219        58954 :     case EXEC_OACC_WAIT:
     220        58954 :     case EXEC_OACC_CACHE:
     221        58954 :     case EXEC_OACC_ENTER_DATA:
     222        58954 :     case EXEC_OACC_EXIT_DATA:
     223        58954 :     case EXEC_OACC_ROUTINE:
     224        58954 :     case EXEC_OMP_ALLOCATE:
     225        58954 :     case EXEC_OMP_ALLOCATORS:
     226        58954 :     case EXEC_OMP_ASSUME:
     227        58954 :     case EXEC_OMP_ATOMIC:
     228        58954 :     case EXEC_OMP_CANCEL:
     229        58954 :     case EXEC_OMP_CANCELLATION_POINT:
     230        58954 :     case EXEC_OMP_CRITICAL:
     231        58954 :     case EXEC_OMP_DEPOBJ:
     232        58954 :     case EXEC_OMP_DISPATCH:
     233        58954 :     case EXEC_OMP_DISTRIBUTE:
     234        58954 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
     235        58954 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
     236        58954 :     case EXEC_OMP_DISTRIBUTE_SIMD:
     237        58954 :     case EXEC_OMP_DO:
     238        58954 :     case EXEC_OMP_DO_SIMD:
     239        58954 :     case EXEC_OMP_ERROR:
     240        58954 :     case EXEC_OMP_INTEROP:
     241        58954 :     case EXEC_OMP_LOOP:
     242        58954 :     case EXEC_OMP_END_SINGLE:
     243        58954 :     case EXEC_OMP_MASKED_TASKLOOP:
     244        58954 :     case EXEC_OMP_MASKED_TASKLOOP_SIMD:
     245        58954 :     case EXEC_OMP_MASTER_TASKLOOP:
     246        58954 :     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     247        58954 :     case EXEC_OMP_ORDERED:
     248        58954 :     case EXEC_OMP_MASKED:
     249        58954 :     case EXEC_OMP_PARALLEL:
     250        58954 :     case EXEC_OMP_PARALLEL_DO:
     251        58954 :     case EXEC_OMP_PARALLEL_DO_SIMD:
     252        58954 :     case EXEC_OMP_PARALLEL_LOOP:
     253        58954 :     case EXEC_OMP_PARALLEL_MASKED:
     254        58954 :     case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
     255        58954 :     case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     256        58954 :     case EXEC_OMP_PARALLEL_MASTER:
     257        58954 :     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     258        58954 :     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
     259        58954 :     case EXEC_OMP_PARALLEL_SECTIONS:
     260        58954 :     case EXEC_OMP_PARALLEL_WORKSHARE:
     261        58954 :     case EXEC_OMP_SCAN:
     262        58954 :     case EXEC_OMP_SCOPE:
     263        58954 :     case EXEC_OMP_SECTIONS:
     264        58954 :     case EXEC_OMP_SIMD:
     265        58954 :     case EXEC_OMP_SINGLE:
     266        58954 :     case EXEC_OMP_TARGET:
     267        58954 :     case EXEC_OMP_TARGET_DATA:
     268        58954 :     case EXEC_OMP_TARGET_ENTER_DATA:
     269        58954 :     case EXEC_OMP_TARGET_EXIT_DATA:
     270        58954 :     case EXEC_OMP_TARGET_PARALLEL:
     271        58954 :     case EXEC_OMP_TARGET_PARALLEL_DO:
     272        58954 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
     273        58954 :     case EXEC_OMP_TARGET_PARALLEL_LOOP:
     274        58954 :     case EXEC_OMP_TARGET_SIMD:
     275        58954 :     case EXEC_OMP_TARGET_TEAMS:
     276        58954 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     277        58954 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     278        58954 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     279        58954 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
     280        58954 :     case EXEC_OMP_TARGET_TEAMS_LOOP:
     281        58954 :     case EXEC_OMP_TARGET_UPDATE:
     282        58954 :     case EXEC_OMP_TASK:
     283        58954 :     case EXEC_OMP_TASKLOOP:
     284        58954 :     case EXEC_OMP_TASKLOOP_SIMD:
     285        58954 :     case EXEC_OMP_TEAMS:
     286        58954 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
     287        58954 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     288        58954 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     289        58954 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
     290        58954 :     case EXEC_OMP_TEAMS_LOOP:
     291        58954 :     case EXEC_OMP_TILE:
     292        58954 :     case EXEC_OMP_UNROLL:
     293        58954 :     case EXEC_OMP_WORKSHARE:
     294        58954 :       gfc_free_omp_clauses (p->ext.omp_clauses);
     295        58954 :       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, OMP_LIST_NONE);
     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           93 :     case EXEC_OMP_METADIRECTIVE:
     314           93 :       gfc_free_omp_variants (p->ext.omp_variants);
     315           93 :       break;
     316              : 
     317            0 :     default:
     318            0 :       gfc_internal_error ("gfc_free_statement(): Bad statement");
     319              :     }
     320     29609103 : }
     321              : 
     322              : 
     323              : /* Free a code statement and all other code structures linked to it.  */
     324              : 
     325              : void
     326     56961192 : gfc_free_statements (gfc_code *p)
     327              : {
     328     56961192 :   gfc_code *q;
     329              : 
     330     58529351 :   for (; p; p = q)
     331              :     {
     332      1568159 :       q = p->next;
     333              : 
     334      1568159 :       if (p->block)
     335       359256 :         gfc_free_statements (p->block);
     336      1568159 :       gfc_free_statement (p);
     337      1568159 :       free (p);
     338              :     }
     339     56961192 : }
     340              : 
     341              : 
     342              : /* Free an association list (of an ASSOCIATE statement).  */
     343              : 
     344              : void
     345        21727 : gfc_free_association_list (gfc_association_list* assoc)
     346              : {
     347        21727 :   if (!assoc)
     348              :     return;
     349              : 
     350         7401 :   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         7401 :   gfc_free_association_list (assoc->next);
     367         7401 :   free (assoc);
     368              : }