LCOV - code coverage report
Current view: top level - gcc/fortran - dump-parse-tree.c (source / functions) Hit Total Coverage
Test: gcc.info Lines: 495 2197 22.5 %
Date: 2020-03-28 11:57:23 Functions: 20 50 40.0 %
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: 0 0 -

           Branch data     Line data    Source code
       1                 :            : /* Parse tree dumper
       2                 :            :    Copyright (C) 2003-2020 Free Software Foundation, Inc.
       3                 :            :    Contributed by Steven Bosscher
       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                 :            : 
      22                 :            : /* Actually this is just a collection of routines that used to be
      23                 :            :    scattered around the sources.  Now that they are all in a single
      24                 :            :    file, almost all of them can be static, and the other files don't
      25                 :            :    have this mess in them.
      26                 :            : 
      27                 :            :    As a nice side-effect, this file can act as documentation of the
      28                 :            :    gfc_code and gfc_expr structures and all their friends and
      29                 :            :    relatives.
      30                 :            : 
      31                 :            :    TODO: Dump DATA.  */
      32                 :            : 
      33                 :            : #include "config.h"
      34                 :            : #include "system.h"
      35                 :            : #include "coretypes.h"
      36                 :            : #include "gfortran.h"
      37                 :            : #include "constructor.h"
      38                 :            : #include "version.h"
      39                 :            : 
      40                 :            : /* Keep track of indentation for symbol tree dumps.  */
      41                 :            : static int show_level = 0;
      42                 :            : 
      43                 :            : /* The file handle we're dumping to is kept in a static variable.  This
      44                 :            :    is not too cool, but it avoids a lot of passing it around.  */
      45                 :            : static FILE *dumpfile;
      46                 :            : 
      47                 :            : /* Forward declaration of some of the functions.  */
      48                 :            : static void show_expr (gfc_expr *p);
      49                 :            : static void show_code_node (int, gfc_code *);
      50                 :            : static void show_namespace (gfc_namespace *ns);
      51                 :            : static void show_code (int, gfc_code *);
      52                 :            : static void show_symbol (gfc_symbol *);
      53                 :            : static void show_typespec (gfc_typespec *);
      54                 :            : static void show_ref (gfc_ref *);
      55                 :            : static void show_attr (symbol_attribute *, const char *);
      56                 :            : 
      57                 :            : /* Allow dumping of an expression in the debugger.  */
      58                 :            : void gfc_debug_expr (gfc_expr *);
      59                 :            : 
      60                 :          0 : void debug (symbol_attribute *attr)
      61                 :            : {
      62                 :          0 :   FILE *tmp = dumpfile;
      63                 :          0 :   dumpfile = stderr;
      64                 :          0 :   show_attr (attr, NULL);
      65                 :          0 :   fputc ('\n', dumpfile);
      66                 :          0 :   dumpfile = tmp;
      67                 :          0 : }
      68                 :            : 
      69                 :          0 : void debug (gfc_formal_arglist *formal)
      70                 :            : {
      71                 :          0 :   FILE *tmp = dumpfile;
      72                 :          0 :   dumpfile = stderr;
      73                 :          0 :   for (; formal; formal = formal->next)
      74                 :            :     {
      75                 :          0 :       fputc ('\n', dumpfile);
      76                 :          0 :       show_symbol (formal->sym);
      77                 :            :     }
      78                 :          0 :   fputc ('\n', dumpfile);
      79                 :          0 :   dumpfile = tmp;
      80                 :          0 : }
      81                 :            : 
      82                 :          0 : void debug (symbol_attribute attr)
      83                 :            : {
      84                 :          0 :   debug (&attr);
      85                 :          0 : }
      86                 :            : 
      87                 :          0 : void debug (gfc_expr *e)
      88                 :            : {
      89                 :          0 :   FILE *tmp = dumpfile;
      90                 :          0 :   dumpfile = stderr;
      91                 :          0 :   if (e != NULL)
      92                 :            :     {
      93                 :          0 :       show_expr (e);
      94                 :          0 :       fputc (' ', dumpfile);
      95                 :          0 :       show_typespec (&e->ts);
      96                 :            :     }
      97                 :            :   else
      98                 :          0 :     fputs ("() ", dumpfile);
      99                 :            : 
     100                 :          0 :   fputc ('\n', dumpfile);
     101                 :          0 :   dumpfile = tmp;
     102                 :          0 : }
     103                 :            : 
     104                 :          0 : void debug (gfc_typespec *ts)
     105                 :            : {
     106                 :          0 :   FILE *tmp = dumpfile;
     107                 :          0 :   dumpfile = stderr;
     108                 :          0 :   show_typespec (ts);
     109                 :          0 :   fputc ('\n', dumpfile);
     110                 :          0 :   dumpfile = tmp;
     111                 :          0 : }
     112                 :            : 
     113                 :          0 : void debug (gfc_typespec ts)
     114                 :            : {
     115                 :          0 :   debug (&ts);
     116                 :          0 : }
     117                 :            : 
     118                 :          0 : void debug (gfc_ref *p)
     119                 :            : {
     120                 :          0 :   FILE *tmp = dumpfile;
     121                 :          0 :   dumpfile = stderr;
     122                 :          0 :   show_ref (p);
     123                 :          0 :   fputc ('\n', dumpfile);
     124                 :          0 :   dumpfile = tmp;
     125                 :          0 : }
     126                 :            : 
     127                 :            : void
     128                 :          0 : gfc_debug_expr (gfc_expr *e)
     129                 :            : {
     130                 :          0 :   FILE *tmp = dumpfile;
     131                 :          0 :   dumpfile = stderr;
     132                 :          0 :   show_expr (e);
     133                 :          0 :   fputc ('\n', dumpfile);
     134                 :          0 :   dumpfile = tmp;
     135                 :          0 : }
     136                 :            : 
     137                 :            : /* Allow for dumping of a piece of code in the debugger.  */
     138                 :            : void gfc_debug_code (gfc_code *c);
     139                 :            : 
     140                 :            : void
     141                 :          0 : gfc_debug_code (gfc_code *c)
     142                 :            : {
     143                 :          0 :   FILE *tmp = dumpfile;
     144                 :          0 :   dumpfile = stderr;
     145                 :          0 :   show_code (1, c);
     146                 :          0 :   fputc ('\n', dumpfile);
     147                 :          0 :   dumpfile = tmp;
     148                 :          0 : }
     149                 :            : 
     150                 :          0 : void debug (gfc_symbol *sym)
     151                 :            : {
     152                 :          0 :   FILE *tmp = dumpfile;
     153                 :          0 :   dumpfile = stderr;
     154                 :          0 :   show_symbol (sym);
     155                 :          0 :   fputc ('\n', dumpfile);
     156                 :          0 :   dumpfile = tmp;
     157                 :          0 : }
     158                 :            : 
     159                 :            : /* Do indentation for a specific level.  */
     160                 :            : 
     161                 :            : static inline void
     162                 :       1832 : code_indent (int level, gfc_st_label *label)
     163                 :            : {
     164                 :       1832 :   int i;
     165                 :            : 
     166                 :       1832 :   if (label != NULL)
     167                 :          0 :     fprintf (dumpfile, "%-5d ", label->value);
     168                 :            : 
     169                 :      16792 :   for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
     170                 :       6564 :     fputc (' ', dumpfile);
     171                 :       1832 : }
     172                 :            : 
     173                 :            : 
     174                 :            : /* Simple indentation at the current level.  This one
     175                 :            :    is used to show symbols.  */
     176                 :            : 
     177                 :            : static inline void
     178                 :       1784 : show_indent (void)
     179                 :            : {
     180                 :       1784 :   fputc ('\n', dumpfile);
     181                 :       1784 :   code_indent (show_level, NULL);
     182                 :       1784 : }
     183                 :            : 
     184                 :            : 
     185                 :            : /* Show type-specific information.  */
     186                 :            : 
     187                 :            : static void
     188                 :        538 : show_typespec (gfc_typespec *ts)
     189                 :            : {
     190                 :        538 :   if (ts->type == BT_ASSUMED)
     191                 :            :     {
     192                 :          0 :       fputs ("(TYPE(*))", dumpfile);
     193                 :          0 :       return;
     194                 :            :     }
     195                 :            : 
     196                 :        538 :   fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
     197                 :            : 
     198                 :        538 :   switch (ts->type)
     199                 :            :     {
     200                 :        150 :     case BT_DERIVED:
     201                 :        150 :     case BT_CLASS:
     202                 :        150 :     case BT_UNION:
     203                 :        150 :       fprintf (dumpfile, "%s", ts->u.derived->name);
     204                 :        150 :       break;
     205                 :            : 
     206                 :         16 :     case BT_CHARACTER:
     207                 :         16 :       if (ts->u.cl)
     208                 :         16 :         show_expr (ts->u.cl->length);
     209                 :         16 :       fprintf(dumpfile, " %d", ts->kind);
     210                 :         16 :       break;
     211                 :            : 
     212                 :        372 :     default:
     213                 :        372 :       fprintf (dumpfile, "%d", ts->kind);
     214                 :        372 :       break;
     215                 :            :     }
     216                 :        538 :   if (ts->is_c_interop)
     217                 :        100 :     fputs (" C_INTEROP", dumpfile);
     218                 :            : 
     219                 :        538 :   if (ts->is_iso_c)
     220                 :         92 :     fputs (" ISO_C", dumpfile);
     221                 :            : 
     222                 :        538 :   if (ts->deferred)
     223                 :          0 :     fputs (" DEFERRED", dumpfile);
     224                 :            : 
     225                 :        538 :   fputc (')', dumpfile);
     226                 :            : }
     227                 :            : 
     228                 :            : 
     229                 :            : /* Show an actual argument list.  */
     230                 :            : 
     231                 :            : static void
     232                 :         24 : show_actual_arglist (gfc_actual_arglist *a)
     233                 :            : {
     234                 :         24 :   fputc ('(', dumpfile);
     235                 :            : 
     236                 :         48 :   for (; a; a = a->next)
     237                 :            :     {
     238                 :         24 :       fputc ('(', dumpfile);
     239                 :         24 :       if (a->name != NULL)
     240                 :          0 :         fprintf (dumpfile, "%s = ", a->name);
     241                 :         24 :       if (a->expr != NULL)
     242                 :         24 :         show_expr (a->expr);
     243                 :            :       else
     244                 :          0 :         fputs ("(arg not-present)", dumpfile);
     245                 :            : 
     246                 :         24 :       fputc (')', dumpfile);
     247                 :         24 :       if (a->next != NULL)
     248                 :          0 :         fputc (' ', dumpfile);
     249                 :            :     }
     250                 :            : 
     251                 :         24 :   fputc (')', dumpfile);
     252                 :         24 : }
     253                 :            : 
     254                 :            : 
     255                 :            : /* Show a gfc_array_spec array specification structure.  */
     256                 :            : 
     257                 :            : static void
     258                 :        142 : show_array_spec (gfc_array_spec *as)
     259                 :            : {
     260                 :        142 :   const char *c;
     261                 :        142 :   int i;
     262                 :            : 
     263                 :        142 :   if (as == NULL)
     264                 :            :     {
     265                 :        142 :       fputs ("()", dumpfile);
     266                 :        142 :       return;
     267                 :            :     }
     268                 :            : 
     269                 :          0 :   fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
     270                 :            : 
     271                 :          0 :   if (as->rank + as->corank > 0 || as->rank == -1)
     272                 :            :     {
     273                 :          0 :       switch (as->type)
     274                 :            :       {
     275                 :            :         case AS_EXPLICIT:      c = "AS_EXPLICIT";      break;
     276                 :          0 :         case AS_DEFERRED:      c = "AS_DEFERRED";      break;
     277                 :          0 :         case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
     278                 :          0 :         case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
     279                 :          0 :         case AS_ASSUMED_RANK:  c = "AS_ASSUMED_RANK";  break;
     280                 :          0 :         default:
     281                 :          0 :           gfc_internal_error ("show_array_spec(): Unhandled array shape "
     282                 :            :                               "type.");
     283                 :            :       }
     284                 :          0 :       fprintf (dumpfile, " %s ", c);
     285                 :            : 
     286                 :          0 :       for (i = 0; i < as->rank + as->corank; i++)
     287                 :            :         {
     288                 :          0 :           show_expr (as->lower[i]);
     289                 :          0 :           fputc (' ', dumpfile);
     290                 :          0 :           show_expr (as->upper[i]);
     291                 :          0 :           fputc (' ', dumpfile);
     292                 :            :         }
     293                 :            :     }
     294                 :            : 
     295                 :          0 :   fputc (')', dumpfile);
     296                 :            : }
     297                 :            : 
     298                 :            : 
     299                 :            : /* Show a gfc_array_ref array reference structure.  */
     300                 :            : 
     301                 :            : static void
     302                 :          0 : show_array_ref (gfc_array_ref * ar)
     303                 :            : {
     304                 :          0 :   int i;
     305                 :            : 
     306                 :          0 :   fputc ('(', dumpfile);
     307                 :            : 
     308                 :          0 :   switch (ar->type)
     309                 :            :     {
     310                 :          0 :     case AR_FULL:
     311                 :          0 :       fputs ("FULL", dumpfile);
     312                 :          0 :       break;
     313                 :            : 
     314                 :            :     case AR_SECTION:
     315                 :          0 :       for (i = 0; i < ar->dimen; i++)
     316                 :            :         {
     317                 :            :           /* There are two types of array sections: either the
     318                 :            :              elements are identified by an integer array ('vector'),
     319                 :            :              or by an index range. In the former case we only have to
     320                 :            :              print the start expression which contains the vector, in
     321                 :            :              the latter case we have to print any of lower and upper
     322                 :            :              bound and the stride, if they're present.  */
     323                 :            : 
     324                 :          0 :           if (ar->start[i] != NULL)
     325                 :          0 :             show_expr (ar->start[i]);
     326                 :            : 
     327                 :          0 :           if (ar->dimen_type[i] == DIMEN_RANGE)
     328                 :            :             {
     329                 :          0 :               fputc (':', dumpfile);
     330                 :            : 
     331                 :          0 :               if (ar->end[i] != NULL)
     332                 :          0 :                 show_expr (ar->end[i]);
     333                 :            : 
     334                 :          0 :               if (ar->stride[i] != NULL)
     335                 :            :                 {
     336                 :          0 :                   fputc (':', dumpfile);
     337                 :          0 :                   show_expr (ar->stride[i]);
     338                 :            :                 }
     339                 :            :             }
     340                 :            : 
     341                 :          0 :           if (i != ar->dimen - 1)
     342                 :          0 :             fputs (" , ", dumpfile);
     343                 :            :         }
     344                 :            :       break;
     345                 :            : 
     346                 :            :     case AR_ELEMENT:
     347                 :          0 :       for (i = 0; i < ar->dimen; i++)
     348                 :            :         {
     349                 :          0 :           show_expr (ar->start[i]);
     350                 :          0 :           if (i != ar->dimen - 1)
     351                 :          0 :             fputs (" , ", dumpfile);
     352                 :            :         }
     353                 :            :       break;
     354                 :            : 
     355                 :          0 :     case AR_UNKNOWN:
     356                 :          0 :       fputs ("UNKNOWN", dumpfile);
     357                 :          0 :       break;
     358                 :            : 
     359                 :          0 :     default:
     360                 :          0 :       gfc_internal_error ("show_array_ref(): Unknown array reference");
     361                 :            :     }
     362                 :            : 
     363                 :          0 :   fputc (')', dumpfile);
     364                 :          0 : }
     365                 :            : 
     366                 :            : 
     367                 :            : /* Show a list of gfc_ref structures.  */
     368                 :            : 
     369                 :            : static void
     370                 :         84 : show_ref (gfc_ref *p)
     371                 :            : {
     372                 :        120 :   for (; p; p = p->next)
     373                 :         36 :     switch (p->type)
     374                 :            :       {
     375                 :          0 :       case REF_ARRAY:
     376                 :          0 :         show_array_ref (&p->u.ar);
     377                 :          0 :         break;
     378                 :            : 
     379                 :         36 :       case REF_COMPONENT:
     380                 :         36 :         fprintf (dumpfile, " %% %s", p->u.c.component->name);
     381                 :         36 :         break;
     382                 :            : 
     383                 :          0 :       case REF_SUBSTRING:
     384                 :          0 :         fputc ('(', dumpfile);
     385                 :          0 :         show_expr (p->u.ss.start);
     386                 :          0 :         fputc (':', dumpfile);
     387                 :          0 :         show_expr (p->u.ss.end);
     388                 :          0 :         fputc (')', dumpfile);
     389                 :          0 :         break;
     390                 :            : 
     391                 :          0 :       case REF_INQUIRY:
     392                 :          0 :         switch (p->u.i)
     393                 :            :         {
     394                 :          0 :           case INQUIRY_KIND:
     395                 :          0 :             fprintf (dumpfile, " INQUIRY_KIND ");
     396                 :          0 :             break;
     397                 :          0 :           case INQUIRY_LEN:
     398                 :          0 :             fprintf (dumpfile, " INQUIRY_LEN ");
     399                 :          0 :             break;
     400                 :          0 :           case INQUIRY_RE:
     401                 :          0 :             fprintf (dumpfile, " INQUIRY_RE ");
     402                 :          0 :             break;
     403                 :          0 :           case INQUIRY_IM:
     404                 :          0 :             fprintf (dumpfile, " INQUIRY_IM ");
     405                 :            :         }
     406                 :            :         break;
     407                 :            : 
     408                 :          0 :       default:
     409                 :          0 :         gfc_internal_error ("show_ref(): Bad component code");
     410                 :            :       }
     411                 :         84 : }
     412                 :            : 
     413                 :            : 
     414                 :            : /* Display a constructor.  Works recursively for array constructors.  */
     415                 :            : 
     416                 :            : static void
     417                 :         40 : show_constructor (gfc_constructor_base base)
     418                 :            : {
     419                 :         40 :   gfc_constructor *c;
     420                 :        170 :   for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
     421                 :            :     {
     422                 :        130 :       if (c->iterator == NULL)
     423                 :        130 :         show_expr (c->expr);
     424                 :            :       else
     425                 :            :         {
     426                 :          0 :           fputc ('(', dumpfile);
     427                 :          0 :           show_expr (c->expr);
     428                 :            : 
     429                 :          0 :           fputc (' ', dumpfile);
     430                 :          0 :           show_expr (c->iterator->var);
     431                 :          0 :           fputc ('=', dumpfile);
     432                 :          0 :           show_expr (c->iterator->start);
     433                 :          0 :           fputc (',', dumpfile);
     434                 :          0 :           show_expr (c->iterator->end);
     435                 :          0 :           fputc (',', dumpfile);
     436                 :          0 :           show_expr (c->iterator->step);
     437                 :            : 
     438                 :          0 :           fputc (')', dumpfile);
     439                 :            :         }
     440                 :            : 
     441                 :        130 :       if (gfc_constructor_next (c) != NULL)
     442                 :         90 :         fputs (" , ", dumpfile);
     443                 :            :     }
     444                 :         40 : }
     445                 :            : 
     446                 :            : 
     447                 :            : static void
     448                 :         16 : show_char_const (const gfc_char_t *c, gfc_charlen_t length)
     449                 :            : {
     450                 :         16 :   fputc ('\'', dumpfile);
     451                 :         32 :   for (size_t i = 0; i < (size_t) length; i++)
     452                 :            :     {
     453                 :         16 :       if (c[i] == '\'')
     454                 :          0 :         fputs ("''", dumpfile);
     455                 :            :       else
     456                 :         16 :         fputs (gfc_print_wide_char (c[i]), dumpfile);
     457                 :            :     }
     458                 :         16 :   fputc ('\'', dumpfile);
     459                 :         16 : }
     460                 :            : 
     461                 :            : 
     462                 :            : /* Show a component-call expression.  */
     463                 :            : 
     464                 :            : static void
     465                 :          0 : show_compcall (gfc_expr* p)
     466                 :            : {
     467                 :          0 :   gcc_assert (p->expr_type == EXPR_COMPCALL);
     468                 :            : 
     469                 :          0 :   fprintf (dumpfile, "%s", p->symtree->n.sym->name);
     470                 :          0 :   show_ref (p->ref);
     471                 :          0 :   fprintf (dumpfile, "%s", p->value.compcall.name);
     472                 :            : 
     473                 :          0 :   show_actual_arglist (p->value.compcall.actual);
     474                 :          0 : }
     475                 :            : 
     476                 :            : 
     477                 :            : /* Show an expression.  */
     478                 :            : 
     479                 :            : static void
     480                 :        502 : show_expr (gfc_expr *p)
     481                 :            : {
     482                 :        502 :   const char *c;
     483                 :        502 :   int i;
     484                 :            : 
     485                 :        502 :   if (p == NULL)
     486                 :            :     {
     487                 :         42 :       fputs ("()", dumpfile);
     488                 :         42 :       return;
     489                 :            :     }
     490                 :            : 
     491                 :        460 :   switch (p->expr_type)
     492                 :            :     {
     493                 :          0 :     case EXPR_SUBSTRING:
     494                 :          0 :       show_char_const (p->value.character.string, p->value.character.length);
     495                 :          0 :       show_ref (p->ref);
     496                 :          0 :       break;
     497                 :            : 
     498                 :         40 :     case EXPR_STRUCTURE:
     499                 :         40 :       fprintf (dumpfile, "%s(", p->ts.u.derived->name);
     500                 :         40 :       show_constructor (p->value.constructor);
     501                 :         40 :       fputc (')', dumpfile);
     502                 :         40 :       break;
     503                 :            : 
     504                 :          0 :     case EXPR_ARRAY:
     505                 :          0 :       fputs ("(/ ", dumpfile);
     506                 :          0 :       show_constructor (p->value.constructor);
     507                 :          0 :       fputs (" /)", dumpfile);
     508                 :            : 
     509                 :          0 :       show_ref (p->ref);
     510                 :          0 :       break;
     511                 :            : 
     512                 :         60 :     case EXPR_NULL:
     513                 :         60 :       fputs ("NULL()", dumpfile);
     514                 :         60 :       break;
     515                 :            : 
     516                 :        240 :     case EXPR_CONSTANT:
     517                 :        240 :       switch (p->ts.type)
     518                 :            :         {
     519                 :        216 :         case BT_INTEGER:
     520                 :        216 :           mpz_out_str (dumpfile, 10, p->value.integer);
     521                 :            : 
     522                 :        216 :           if (p->ts.kind != gfc_default_integer_kind)
     523                 :         22 :             fprintf (dumpfile, "_%d", p->ts.kind);
     524                 :            :           break;
     525                 :            : 
     526                 :          0 :         case BT_LOGICAL:
     527                 :          0 :           if (p->value.logical)
     528                 :          0 :             fputs (".true.", dumpfile);
     529                 :            :           else
     530                 :          0 :             fputs (".false.", dumpfile);
     531                 :            :           break;
     532                 :            : 
     533                 :          8 :         case BT_REAL:
     534                 :          8 :           mpfr_out_str (dumpfile, 10, 0, p->value.real, GFC_RND_MODE);
     535                 :          8 :           if (p->ts.kind != gfc_default_real_kind)
     536                 :          6 :             fprintf (dumpfile, "_%d", p->ts.kind);
     537                 :            :           break;
     538                 :            : 
     539                 :         16 :         case BT_CHARACTER:
     540                 :         16 :           show_char_const (p->value.character.string,
     541                 :            :                            p->value.character.length);
     542                 :         16 :           break;
     543                 :            : 
     544                 :          0 :         case BT_COMPLEX:
     545                 :          0 :           fputs ("(complex ", dumpfile);
     546                 :            : 
     547                 :          0 :           mpfr_out_str (dumpfile, 10, 0, mpc_realref (p->value.complex),
     548                 :            :                         GFC_RND_MODE);
     549                 :          0 :           if (p->ts.kind != gfc_default_complex_kind)
     550                 :          0 :             fprintf (dumpfile, "_%d", p->ts.kind);
     551                 :            : 
     552                 :          0 :           fputc (' ', dumpfile);
     553                 :            : 
     554                 :          0 :           mpfr_out_str (dumpfile, 10, 0, mpc_imagref (p->value.complex),
     555                 :            :                         GFC_RND_MODE);
     556                 :          0 :           if (p->ts.kind != gfc_default_complex_kind)
     557                 :          0 :             fprintf (dumpfile, "_%d", p->ts.kind);
     558                 :            : 
     559                 :          0 :           fputc (')', dumpfile);
     560                 :          0 :           break;
     561                 :            : 
     562                 :          0 :         case BT_BOZ:
     563                 :          0 :           if (p->boz.rdx == 2)
     564                 :          0 :             fputs ("b'", dumpfile);
     565                 :          0 :           else if (p->boz.rdx == 8)
     566                 :          0 :             fputs ("o'", dumpfile);
     567                 :            :           else
     568                 :          0 :             fputs ("z'", dumpfile);
     569                 :          0 :           fprintf (dumpfile, "%s'", p->boz.str);
     570                 :          0 :           break;
     571                 :            : 
     572                 :          0 :         case BT_HOLLERITH:
     573                 :          0 :           fprintf (dumpfile, HOST_WIDE_INT_PRINT_DEC "H",
     574                 :            :                    p->representation.length);
     575                 :          0 :           c = p->representation.string;
     576                 :          0 :           for (i = 0; i < p->representation.length; i++, c++)
     577                 :            :             {
     578                 :          0 :               fputc (*c, dumpfile);
     579                 :            :             }
     580                 :            :           break;
     581                 :            : 
     582                 :          0 :         default:
     583                 :          0 :           fputs ("???", dumpfile);
     584                 :          0 :           break;
     585                 :            :         }
     586                 :            : 
     587                 :        240 :       if (p->representation.string)
     588                 :            :         {
     589                 :          0 :           fputs (" {", dumpfile);
     590                 :          0 :           c = p->representation.string;
     591                 :          0 :           for (i = 0; i < p->representation.length; i++, c++)
     592                 :            :             {
     593                 :          0 :               fprintf (dumpfile, "%.2x", (unsigned int) *c);
     594                 :          0 :               if (i < p->representation.length - 1)
     595                 :          0 :                 fputc (',', dumpfile);
     596                 :            :             }
     597                 :          0 :           fputc ('}', dumpfile);
     598                 :            :         }
     599                 :            : 
     600                 :            :       break;
     601                 :            : 
     602                 :         84 :     case EXPR_VARIABLE:
     603                 :         84 :       if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
     604                 :         84 :         fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
     605                 :         84 :       fprintf (dumpfile, "%s", p->symtree->n.sym->name);
     606                 :         84 :       show_ref (p->ref);
     607                 :         84 :       break;
     608                 :            : 
     609                 :         12 :     case EXPR_OP:
     610                 :         12 :       fputc ('(', dumpfile);
     611                 :         12 :       switch (p->value.op.op)
     612                 :            :         {
     613                 :          0 :         case INTRINSIC_UPLUS:
     614                 :          0 :           fputs ("U+ ", dumpfile);
     615                 :          0 :           break;
     616                 :          0 :         case INTRINSIC_UMINUS:
     617                 :          0 :           fputs ("U- ", dumpfile);
     618                 :          0 :           break;
     619                 :          0 :         case INTRINSIC_PLUS:
     620                 :          0 :           fputs ("+ ", dumpfile);
     621                 :          0 :           break;
     622                 :          0 :         case INTRINSIC_MINUS:
     623                 :          0 :           fputs ("- ", dumpfile);
     624                 :          0 :           break;
     625                 :          0 :         case INTRINSIC_TIMES:
     626                 :          0 :           fputs ("* ", dumpfile);
     627                 :          0 :           break;
     628                 :          0 :         case INTRINSIC_DIVIDE:
     629                 :          0 :           fputs ("/ ", dumpfile);
     630                 :          0 :           break;
     631                 :          0 :         case INTRINSIC_POWER:
     632                 :          0 :           fputs ("** ", dumpfile);
     633                 :          0 :           break;
     634                 :          0 :         case INTRINSIC_CONCAT:
     635                 :          0 :           fputs ("// ", dumpfile);
     636                 :          0 :           break;
     637                 :          0 :         case INTRINSIC_AND:
     638                 :          0 :           fputs ("AND ", dumpfile);
     639                 :          0 :           break;
     640                 :          0 :         case INTRINSIC_OR:
     641                 :          0 :           fputs ("OR ", dumpfile);
     642                 :          0 :           break;
     643                 :          0 :         case INTRINSIC_EQV:
     644                 :          0 :           fputs ("EQV ", dumpfile);
     645                 :          0 :           break;
     646                 :          0 :         case INTRINSIC_NEQV:
     647                 :          0 :           fputs ("NEQV ", dumpfile);
     648                 :          0 :           break;
     649                 :          0 :         case INTRINSIC_EQ:
     650                 :          0 :         case INTRINSIC_EQ_OS:
     651                 :          0 :           fputs ("= ", dumpfile);
     652                 :          0 :           break;
     653                 :         12 :         case INTRINSIC_NE:
     654                 :         12 :         case INTRINSIC_NE_OS:
     655                 :         12 :           fputs ("/= ", dumpfile);
     656                 :         12 :           break;
     657                 :          0 :         case INTRINSIC_GT:
     658                 :          0 :         case INTRINSIC_GT_OS:
     659                 :          0 :           fputs ("> ", dumpfile);
     660                 :          0 :           break;
     661                 :          0 :         case INTRINSIC_GE:
     662                 :          0 :         case INTRINSIC_GE_OS:
     663                 :          0 :           fputs (">= ", dumpfile);
     664                 :          0 :           break;
     665                 :          0 :         case INTRINSIC_LT:
     666                 :          0 :         case INTRINSIC_LT_OS:
     667                 :          0 :           fputs ("< ", dumpfile);
     668                 :          0 :           break;
     669                 :          0 :         case INTRINSIC_LE:
     670                 :          0 :         case INTRINSIC_LE_OS:
     671                 :          0 :           fputs ("<= ", dumpfile);
     672                 :          0 :           break;
     673                 :          0 :         case INTRINSIC_NOT:
     674                 :          0 :           fputs ("NOT ", dumpfile);
     675                 :          0 :           break;
     676                 :          0 :         case INTRINSIC_PARENTHESES:
     677                 :          0 :           fputs ("parens ", dumpfile);
     678                 :          0 :           break;
     679                 :            : 
     680                 :          0 :         default:
     681                 :          0 :           gfc_internal_error
     682                 :          0 :             ("show_expr(): Bad intrinsic in expression");
     683                 :            :         }
     684                 :            : 
     685                 :         12 :       show_expr (p->value.op.op1);
     686                 :            : 
     687                 :         12 :       if (p->value.op.op2)
     688                 :            :         {
     689                 :         12 :           fputc (' ', dumpfile);
     690                 :         12 :           show_expr (p->value.op.op2);
     691                 :            :         }
     692                 :            : 
     693                 :         12 :       fputc (')', dumpfile);
     694                 :         12 :       break;
     695                 :            : 
     696                 :         24 :     case EXPR_FUNCTION:
     697                 :         24 :       if (p->value.function.name == NULL)
     698                 :            :         {
     699                 :         24 :           fprintf (dumpfile, "%s", p->symtree->n.sym->name);
     700                 :         24 :           if (gfc_is_proc_ptr_comp (p))
     701                 :          0 :             show_ref (p->ref);
     702                 :         24 :           fputc ('[', dumpfile);
     703                 :         24 :           show_actual_arglist (p->value.function.actual);
     704                 :         24 :           fputc (']', dumpfile);
     705                 :            :         }
     706                 :            :       else
     707                 :            :         {
     708                 :          0 :           fprintf (dumpfile, "%s", p->value.function.name);
     709                 :          0 :           if (gfc_is_proc_ptr_comp (p))
     710                 :          0 :             show_ref (p->ref);
     711                 :          0 :           fputc ('[', dumpfile);
     712                 :          0 :           fputc ('[', dumpfile);
     713                 :          0 :           show_actual_arglist (p->value.function.actual);
     714                 :          0 :           fputc (']', dumpfile);
     715                 :          0 :           fputc (']', dumpfile);
     716                 :            :         }
     717                 :            : 
     718                 :            :       break;
     719                 :            : 
     720                 :          0 :     case EXPR_COMPCALL:
     721                 :          0 :       show_compcall (p);
     722                 :          0 :       break;
     723                 :            : 
     724                 :          0 :     default:
     725                 :          0 :       gfc_internal_error ("show_expr(): Don't know how to show expr");
     726                 :            :     }
     727                 :            : }
     728                 :            : 
     729                 :            : /* Show symbol attributes.  The flavor and intent are followed by
     730                 :            :    whatever single bit attributes are present.  */
     731                 :            : 
     732                 :            : static void
     733                 :        316 : show_attr (symbol_attribute *attr, const char * module)
     734                 :            : {
     735                 :        316 :   if (attr->flavor != FL_UNKNOWN)
     736                 :            :     {
     737                 :        316 :       if (attr->flavor == FL_DERIVED && attr->pdt_template)
     738                 :          0 :         fputs (" (PDT template", dumpfile);
     739                 :            :       else
     740                 :        316 :     fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
     741                 :            :     }
     742                 :        316 :   if (attr->access != ACCESS_UNKNOWN)
     743                 :         62 :     fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
     744                 :        316 :   if (attr->proc != PROC_UNKNOWN)
     745                 :          6 :     fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
     746                 :        316 :   if (attr->save != SAVE_NONE)
     747                 :         18 :     fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
     748                 :            : 
     749                 :        316 :   if (attr->artificial)
     750                 :         24 :     fputs (" ARTIFICIAL", dumpfile);
     751                 :        316 :   if (attr->allocatable)
     752                 :          0 :     fputs (" ALLOCATABLE", dumpfile);
     753                 :        316 :   if (attr->asynchronous)
     754                 :          0 :     fputs (" ASYNCHRONOUS", dumpfile);
     755                 :        316 :   if (attr->codimension)
     756                 :          0 :     fputs (" CODIMENSION", dumpfile);
     757                 :        316 :   if (attr->dimension)
     758                 :          0 :     fputs (" DIMENSION", dumpfile);
     759                 :        316 :   if (attr->contiguous)
     760                 :          0 :     fputs (" CONTIGUOUS", dumpfile);
     761                 :        316 :   if (attr->external)
     762                 :          0 :     fputs (" EXTERNAL", dumpfile);
     763                 :        316 :   if (attr->intrinsic)
     764                 :         20 :     fputs (" INTRINSIC", dumpfile);
     765                 :        316 :   if (attr->optional)
     766                 :          0 :     fputs (" OPTIONAL", dumpfile);
     767                 :        316 :   if (attr->pdt_kind)
     768                 :          0 :     fputs (" KIND", dumpfile);
     769                 :        316 :   if (attr->pdt_len)
     770                 :          0 :     fputs (" LEN", dumpfile);
     771                 :        316 :   if (attr->pointer)
     772                 :          0 :     fputs (" POINTER", dumpfile);
     773                 :        316 :   if (attr->is_protected)
     774                 :          0 :     fputs (" PROTECTED", dumpfile);
     775                 :        316 :   if (attr->value)
     776                 :          0 :     fputs (" VALUE", dumpfile);
     777                 :        316 :   if (attr->volatile_)
     778                 :          0 :     fputs (" VOLATILE", dumpfile);
     779                 :        316 :   if (attr->threadprivate)
     780                 :          0 :     fputs (" THREADPRIVATE", dumpfile);
     781                 :        316 :   if (attr->target)
     782                 :         18 :     fputs (" TARGET", dumpfile);
     783                 :        316 :   if (attr->dummy)
     784                 :            :     {
     785                 :         18 :       fputs (" DUMMY", dumpfile);
     786                 :         18 :       if (attr->intent != INTENT_UNKNOWN)
     787                 :         12 :         fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
     788                 :            :     }
     789                 :            : 
     790                 :        316 :   if (attr->result)
     791                 :          0 :     fputs (" RESULT", dumpfile);
     792                 :        316 :   if (attr->entry)
     793                 :          0 :     fputs (" ENTRY", dumpfile);
     794                 :        316 :   if (attr->is_bind_c)
     795                 :          8 :     fputs (" BIND(C)", dumpfile);
     796                 :            : 
     797                 :        316 :   if (attr->data)
     798                 :          0 :     fputs (" DATA", dumpfile);
     799                 :        316 :   if (attr->use_assoc)
     800                 :            :     {
     801                 :        108 :       fputs (" USE-ASSOC", dumpfile);
     802                 :        108 :       if (module != NULL)
     803                 :        108 :         fprintf (dumpfile, "(%s)", module);
     804                 :            :     }
     805                 :            : 
     806                 :        316 :   if (attr->in_namelist)
     807                 :          0 :     fputs (" IN-NAMELIST", dumpfile);
     808                 :        316 :   if (attr->in_common)
     809                 :          0 :     fputs (" IN-COMMON", dumpfile);
     810                 :            : 
     811                 :        316 :   if (attr->abstract)
     812                 :          0 :     fputs (" ABSTRACT", dumpfile);
     813                 :        316 :   if (attr->function)
     814                 :         42 :     fputs (" FUNCTION", dumpfile);
     815                 :        316 :   if (attr->subroutine)
     816                 :         48 :     fputs (" SUBROUTINE", dumpfile);
     817                 :        316 :   if (attr->implicit_type)
     818                 :         24 :     fputs (" IMPLICIT-TYPE", dumpfile);
     819                 :            : 
     820                 :        316 :   if (attr->sequence)
     821                 :          0 :     fputs (" SEQUENCE", dumpfile);
     822                 :        316 :   if (attr->elemental)
     823                 :          6 :     fputs (" ELEMENTAL", dumpfile);
     824                 :        316 :   if (attr->pure)
     825                 :         10 :     fputs (" PURE", dumpfile);
     826                 :        316 :   if (attr->implicit_pure)
     827                 :          0 :     fputs (" IMPLICIT_PURE", dumpfile);
     828                 :        316 :   if (attr->recursive)
     829                 :          0 :     fputs (" RECURSIVE", dumpfile);
     830                 :            : 
     831                 :        316 :   fputc (')', dumpfile);
     832                 :        316 : }
     833                 :            : 
     834                 :            : 
     835                 :            : /* Show components of a derived type.  */
     836                 :            : 
     837                 :            : static void
     838                 :         40 : show_components (gfc_symbol *sym)
     839                 :            : {
     840                 :         40 :   gfc_component *c;
     841                 :            : 
     842                 :        182 :   for (c = sym->components; c; c = c->next)
     843                 :            :     {
     844                 :        142 :       show_indent ();
     845                 :        142 :       fprintf (dumpfile, "(%s ", c->name);
     846                 :        142 :       show_typespec (&c->ts);
     847                 :        142 :       if (c->kind_expr)
     848                 :            :         {
     849                 :          0 :           fputs (" kind_expr: ", dumpfile);
     850                 :          0 :           show_expr (c->kind_expr);
     851                 :            :         }
     852                 :        142 :       if (c->param_list)
     853                 :            :         {
     854                 :          0 :           fputs ("PDT parameters", dumpfile);
     855                 :          0 :           show_actual_arglist (c->param_list);
     856                 :            :         }
     857                 :            : 
     858                 :        142 :       if (c->attr.allocatable)
     859                 :         12 :         fputs (" ALLOCATABLE", dumpfile);
     860                 :        142 :       if (c->attr.pdt_kind)
     861                 :          0 :         fputs (" KIND", dumpfile);
     862                 :        142 :       if (c->attr.pdt_len)
     863                 :          0 :         fputs (" LEN", dumpfile);
     864                 :        142 :       if (c->attr.pointer)
     865                 :         48 :         fputs (" POINTER", dumpfile);
     866                 :        142 :       if (c->attr.proc_pointer)
     867                 :         36 :         fputs (" PPC", dumpfile);
     868                 :        142 :       if (c->attr.dimension)
     869                 :          0 :         fputs (" DIMENSION", dumpfile);
     870                 :        142 :       fputc (' ', dumpfile);
     871                 :        142 :       show_array_spec (c->as);
     872                 :        142 :       if (c->attr.access)
     873                 :        136 :         fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
     874                 :        142 :       fputc (')', dumpfile);
     875                 :        142 :       if (c->next != NULL)
     876                 :        102 :         fputc (' ', dumpfile);
     877                 :            :     }
     878                 :         40 : }
     879                 :            : 
     880                 :            : 
     881                 :            : /* Show the f2k_derived namespace with procedure bindings.  */
     882                 :            : 
     883                 :            : static void
     884                 :          0 : show_typebound_proc (gfc_typebound_proc* tb, const char* name)
     885                 :            : {
     886                 :          0 :   show_indent ();
     887                 :            : 
     888                 :          0 :   if (tb->is_generic)
     889                 :          0 :     fputs ("GENERIC", dumpfile);
     890                 :            :   else
     891                 :            :     {
     892                 :          0 :       fputs ("PROCEDURE, ", dumpfile);
     893                 :          0 :       if (tb->nopass)
     894                 :          0 :         fputs ("NOPASS", dumpfile);
     895                 :            :       else
     896                 :            :         {
     897                 :          0 :           if (tb->pass_arg)
     898                 :          0 :             fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
     899                 :            :           else
     900                 :          0 :             fputs ("PASS", dumpfile);
     901                 :            :         }
     902                 :          0 :       if (tb->non_overridable)
     903                 :          0 :         fputs (", NON_OVERRIDABLE", dumpfile);
     904                 :            :     }
     905                 :            : 
     906                 :          0 :   if (tb->access == ACCESS_PUBLIC)
     907                 :          0 :     fputs (", PUBLIC", dumpfile);
     908                 :            :   else
     909                 :          0 :     fputs (", PRIVATE", dumpfile);
     910                 :            : 
     911                 :          0 :   fprintf (dumpfile, " :: %s => ", name);
     912                 :            : 
     913                 :          0 :   if (tb->is_generic)
     914                 :            :     {
     915                 :          0 :       gfc_tbp_generic* g;
     916                 :          0 :       for (g = tb->u.generic; g; g = g->next)
     917                 :            :         {
     918                 :          0 :           fputs (g->specific_st->name, dumpfile);
     919                 :          0 :           if (g->next)
     920                 :          0 :             fputs (", ", dumpfile);
     921                 :            :         }
     922                 :            :     }
     923                 :            :   else
     924                 :          0 :     fputs (tb->u.specific->n.sym->name, dumpfile);
     925                 :          0 : }
     926                 :            : 
     927                 :            : static void
     928                 :          0 : show_typebound_symtree (gfc_symtree* st)
     929                 :            : {
     930                 :          0 :   gcc_assert (st->n.tb);
     931                 :          0 :   show_typebound_proc (st->n.tb, st->name);
     932                 :          0 : }
     933                 :            : 
     934                 :            : static void
     935                 :         24 : show_f2k_derived (gfc_namespace* f2k)
     936                 :            : {
     937                 :         24 :   gfc_finalizer* f;
     938                 :         24 :   int op;
     939                 :            : 
     940                 :         24 :   show_indent ();
     941                 :         24 :   fputs ("Procedure bindings:", dumpfile);
     942                 :         24 :   ++show_level;
     943                 :            : 
     944                 :            :   /* Finalizer bindings.  */
     945                 :         24 :   for (f = f2k->finalizers; f; f = f->next)
     946                 :            :     {
     947                 :          0 :       show_indent ();
     948                 :          0 :       fprintf (dumpfile, "FINAL %s", f->proc_tree->n.sym->name);
     949                 :            :     }
     950                 :            : 
     951                 :            :   /* Type-bound procedures.  */
     952                 :         24 :   gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
     953                 :            : 
     954                 :         24 :   --show_level;
     955                 :            : 
     956                 :         24 :   show_indent ();
     957                 :         24 :   fputs ("Operator bindings:", dumpfile);
     958                 :         24 :   ++show_level;
     959                 :            : 
     960                 :            :   /* User-defined operators.  */
     961                 :         24 :   gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
     962                 :            : 
     963                 :            :   /* Intrinsic operators.  */
     964                 :        696 :   for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
     965                 :        672 :     if (f2k->tb_op[op])
     966                 :          0 :       show_typebound_proc (f2k->tb_op[op],
     967                 :            :                            gfc_op2string ((gfc_intrinsic_op) op));
     968                 :            : 
     969                 :         24 :   --show_level;
     970                 :         24 : }
     971                 :            : 
     972                 :            : 
     973                 :            : /* Show a symbol.  If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
     974                 :            :    show the interface.  Information needed to reconstruct the list of
     975                 :            :    specific interfaces associated with a generic symbol is done within
     976                 :            :    that symbol.  */
     977                 :            : 
     978                 :            : static void
     979                 :        316 : show_symbol (gfc_symbol *sym)
     980                 :            : {
     981                 :        316 :   gfc_formal_arglist *formal;
     982                 :        316 :   gfc_interface *intr;
     983                 :        316 :   int i,len;
     984                 :            : 
     985                 :        316 :   if (sym == NULL)
     986                 :            :     return;
     987                 :            : 
     988                 :        316 :   fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
     989                 :        316 :   len = strlen (sym->name);
     990                 :       1568 :   for (i=len; i<12; i++)
     991                 :       1252 :     fputc(' ', dumpfile);
     992                 :            : 
     993                 :        316 :   if (sym->binding_label)
     994                 :          0 :       fprintf (dumpfile,"|| binding_label: '%s' ", sym->binding_label);
     995                 :            : 
     996                 :        316 :   ++show_level;
     997                 :            : 
     998                 :        316 :   show_indent ();
     999                 :        316 :   fputs ("type spec : ", dumpfile);
    1000                 :        316 :   show_typespec (&sym->ts);
    1001                 :            : 
    1002                 :        316 :   show_indent ();
    1003                 :        316 :   fputs ("attributes: ", dumpfile);
    1004                 :        316 :   show_attr (&sym->attr, sym->module);
    1005                 :            : 
    1006                 :        316 :   if (sym->value)
    1007                 :            :     {
    1008                 :        112 :       show_indent ();
    1009                 :        112 :       fputs ("value: ", dumpfile);
    1010                 :        112 :       show_expr (sym->value);
    1011                 :            :     }
    1012                 :            : 
    1013                 :        316 :   if (sym->ts.type != BT_CLASS && sym->as)
    1014                 :            :     {
    1015                 :          0 :       show_indent ();
    1016                 :          0 :       fputs ("Array spec:", dumpfile);
    1017                 :          0 :       show_array_spec (sym->as);
    1018                 :            :     }
    1019                 :        316 :   else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as)
    1020                 :            :     {
    1021                 :          0 :       show_indent ();
    1022                 :          0 :       fputs ("Array spec:", dumpfile);
    1023                 :          0 :       show_array_spec (CLASS_DATA (sym)->as);
    1024                 :            :     }
    1025                 :            : 
    1026                 :        316 :   if (sym->generic)
    1027                 :            :     {
    1028                 :         10 :       show_indent ();
    1029                 :         10 :       fputs ("Generic interfaces:", dumpfile);
    1030                 :         20 :       for (intr = sym->generic; intr; intr = intr->next)
    1031                 :         10 :         fprintf (dumpfile, " %s", intr->sym->name);
    1032                 :            :     }
    1033                 :            : 
    1034                 :        316 :   if (sym->result)
    1035                 :            :     {
    1036                 :         36 :       show_indent ();
    1037                 :         36 :       fprintf (dumpfile, "result: %s", sym->result->name);
    1038                 :            :     }
    1039                 :            : 
    1040                 :        316 :   if (sym->components)
    1041                 :            :     {
    1042                 :         40 :       show_indent ();
    1043                 :         40 :       fputs ("components: ", dumpfile);
    1044                 :         40 :       show_components (sym);
    1045                 :            :     }
    1046                 :            : 
    1047                 :        316 :   if (sym->f2k_derived)
    1048                 :            :     {
    1049                 :         24 :       show_indent ();
    1050                 :         24 :       if (sym->hash_value)
    1051                 :          6 :         fprintf (dumpfile, "hash: %d", sym->hash_value);
    1052                 :         24 :       show_f2k_derived (sym->f2k_derived);
    1053                 :            :     }
    1054                 :            : 
    1055                 :        316 :   if (sym->formal)
    1056                 :            :     {
    1057                 :         20 :       show_indent ();
    1058                 :         20 :       fputs ("Formal arglist:", dumpfile);
    1059                 :            : 
    1060                 :         54 :       for (formal = sym->formal; formal; formal = formal->next)
    1061                 :            :         {
    1062                 :         34 :           if (formal->sym != NULL)
    1063                 :         34 :             fprintf (dumpfile, " %s", formal->sym->name);
    1064                 :            :           else
    1065                 :          0 :             fputs (" [Alt Return]", dumpfile);
    1066                 :            :         }
    1067                 :            :     }
    1068                 :            : 
    1069                 :        316 :   if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
    1070                 :          0 :       && sym->attr.proc != PROC_ST_FUNCTION
    1071                 :          0 :       && !sym->attr.entry)
    1072                 :            :     {
    1073                 :          0 :       show_indent ();
    1074                 :          0 :       fputs ("Formal namespace", dumpfile);
    1075                 :          0 :       show_namespace (sym->formal_ns);
    1076                 :            :     }
    1077                 :            : 
    1078                 :        316 :   if (sym->attr.flavor == FL_VARIABLE
    1079                 :         60 :       && sym->param_list)
    1080                 :            :     {
    1081                 :          0 :       show_indent ();
    1082                 :          0 :       fputs ("PDT parameters", dumpfile);
    1083                 :          0 :       show_actual_arglist (sym->param_list);
    1084                 :            :     }
    1085                 :            : 
    1086                 :        316 :   if (sym->attr.flavor == FL_NAMELIST)
    1087                 :            :     {
    1088                 :          0 :       gfc_namelist *nl;
    1089                 :          0 :       show_indent ();
    1090                 :          0 :       fputs ("variables : ", dumpfile);
    1091                 :          0 :       for (nl = sym->namelist; nl; nl = nl->next)
    1092                 :          0 :         fprintf (dumpfile, " %s",nl->sym->name);
    1093                 :            :     }
    1094                 :            : 
    1095                 :        316 :   --show_level;
    1096                 :            : }
    1097                 :            : 
    1098                 :            : 
    1099                 :            : /* Show a user-defined operator.  Just prints an operator
    1100                 :            :    and the name of the associated subroutine, really.  */
    1101                 :            : 
    1102                 :            : static void
    1103                 :          0 : show_uop (gfc_user_op *uop)
    1104                 :            : {
    1105                 :          0 :   gfc_interface *intr;
    1106                 :            : 
    1107                 :          0 :   show_indent ();
    1108                 :          0 :   fprintf (dumpfile, "%s:", uop->name);
    1109                 :            : 
    1110                 :          0 :   for (intr = uop->op; intr; intr = intr->next)
    1111                 :          0 :     fprintf (dumpfile, " %s", intr->sym->name);
    1112                 :          0 : }
    1113                 :            : 
    1114                 :            : 
    1115                 :            : /* Workhorse function for traversing the user operator symtree.  */
    1116                 :            : 
    1117                 :            : static void
    1118                 :     168593 : traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
    1119                 :            : {
    1120                 :     168983 :   if (st == NULL)
    1121                 :     168593 :     return;
    1122                 :            : 
    1123                 :        390 :   (*func) (st->n.uop);
    1124                 :            : 
    1125                 :        390 :   traverse_uop (st->left, func);
    1126                 :        390 :   traverse_uop (st->right, func);
    1127                 :            : }
    1128                 :            : 
    1129                 :            : 
    1130                 :            : /* Traverse the tree of user operator nodes.  */
    1131                 :            : 
    1132                 :            : void
    1133                 :     168203 : gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
    1134                 :            : {
    1135                 :     168203 :   traverse_uop (ns->uop_root, func);
    1136                 :     168203 : }
    1137                 :            : 
    1138                 :            : 
    1139                 :            : /* Function to display a common block.  */
    1140                 :            : 
    1141                 :            : static void
    1142                 :          0 : show_common (gfc_symtree *st)
    1143                 :            : {
    1144                 :          0 :   gfc_symbol *s;
    1145                 :            : 
    1146                 :          0 :   show_indent ();
    1147                 :          0 :   fprintf (dumpfile, "common: /%s/ ", st->name);
    1148                 :            : 
    1149                 :          0 :   s = st->n.common->head;
    1150                 :          0 :   while (s)
    1151                 :            :     {
    1152                 :          0 :       fprintf (dumpfile, "%s", s->name);
    1153                 :          0 :       s = s->common_next;
    1154                 :          0 :       if (s)
    1155                 :          0 :         fputs (", ", dumpfile);
    1156                 :            :     }
    1157                 :          0 :   fputc ('\n', dumpfile);
    1158                 :          0 : }
    1159                 :            : 
    1160                 :            : 
    1161                 :            : /* Worker function to display the symbol tree.  */
    1162                 :            : 
    1163                 :            : static void
    1164                 :        328 : show_symtree (gfc_symtree *st)
    1165                 :            : {
    1166                 :        328 :   int len, i;
    1167                 :            : 
    1168                 :        328 :   show_indent ();
    1169                 :            : 
    1170                 :        328 :   len = strlen(st->name);
    1171                 :        328 :   fprintf (dumpfile, "symtree: '%s'", st->name);
    1172                 :            : 
    1173                 :       1676 :   for (i=len; i<12; i++)
    1174                 :       1348 :     fputc(' ', dumpfile);
    1175                 :            : 
    1176                 :        328 :   if (st->ambiguous)
    1177                 :          0 :     fputs( " Ambiguous", dumpfile);
    1178                 :            : 
    1179                 :        328 :   if (st->n.sym->ns != gfc_current_ns)
    1180                 :         12 :     fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
    1181                 :         12 :              st->n.sym->ns->proc_name->name);
    1182                 :            :   else
    1183                 :        316 :     show_symbol (st->n.sym);
    1184                 :        328 : }
    1185                 :            : 
    1186                 :            : 
    1187                 :            : /******************* Show gfc_code structures **************/
    1188                 :            : 
    1189                 :            : 
    1190                 :            : /* Show a list of code structures.  Mutually recursive with
    1191                 :            :    show_code_node().  */
    1192                 :            : 
    1193                 :            : static void
    1194                 :         60 : show_code (int level, gfc_code *c)
    1195                 :            : {
    1196                 :        252 :   for (; c; c = c->next)
    1197                 :        148 :     show_code_node (level, c);
    1198                 :         60 : }
    1199                 :            : 
    1200                 :            : static void
    1201                 :          0 : show_omp_namelist (int list_type, gfc_omp_namelist *n)
    1202                 :            : {
    1203                 :          0 :   for (; n; n = n->next)
    1204                 :            :     {
    1205                 :          0 :       if (list_type == OMP_LIST_REDUCTION)
    1206                 :          0 :         switch (n->u.reduction_op)
    1207                 :            :           {
    1208                 :          0 :           case OMP_REDUCTION_PLUS:
    1209                 :          0 :           case OMP_REDUCTION_TIMES:
    1210                 :          0 :           case OMP_REDUCTION_MINUS:
    1211                 :          0 :           case OMP_REDUCTION_AND:
    1212                 :          0 :           case OMP_REDUCTION_OR:
    1213                 :          0 :           case OMP_REDUCTION_EQV:
    1214                 :          0 :           case OMP_REDUCTION_NEQV:
    1215                 :          0 :             fprintf (dumpfile, "%s:",
    1216                 :            :                      gfc_op2string ((gfc_intrinsic_op) n->u.reduction_op));
    1217                 :          0 :             break;
    1218                 :          0 :           case OMP_REDUCTION_MAX: fputs ("max:", dumpfile); break;
    1219                 :          0 :           case OMP_REDUCTION_MIN: fputs ("min:", dumpfile); break;
    1220                 :          0 :           case OMP_REDUCTION_IAND: fputs ("iand:", dumpfile); break;
    1221                 :          0 :           case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break;
    1222                 :          0 :           case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
    1223                 :          0 :           case OMP_REDUCTION_USER:
    1224                 :          0 :             if (n->udr)
    1225                 :          0 :               fprintf (dumpfile, "%s:", n->udr->udr->name);
    1226                 :            :             break;
    1227                 :            :           default: break;
    1228                 :            :           }
    1229                 :          0 :       else if (list_type == OMP_LIST_DEPEND)
    1230                 :          0 :         switch (n->u.depend_op)
    1231                 :            :           {
    1232                 :          0 :           case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
    1233                 :          0 :           case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
    1234                 :          0 :           case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
    1235                 :          0 :           case OMP_DEPEND_SINK_FIRST:
    1236                 :          0 :             fputs ("sink:", dumpfile);
    1237                 :          0 :             while (1)
    1238                 :            :               {
    1239                 :          0 :                 fprintf (dumpfile, "%s", n->sym->name);
    1240                 :          0 :                 if (n->expr)
    1241                 :            :                   {
    1242                 :          0 :                     fputc ('+', dumpfile);
    1243                 :          0 :                     show_expr (n->expr);
    1244                 :            :                   }
    1245                 :          0 :                 if (n->next == NULL)
    1246                 :            :                   break;
    1247                 :          0 :                 else if (n->next->u.depend_op != OMP_DEPEND_SINK)
    1248                 :            :                   {
    1249                 :          0 :                     fputs (") DEPEND(", dumpfile);
    1250                 :          0 :                     break;
    1251                 :            :                   }
    1252                 :          0 :                 fputc (',', dumpfile);
    1253                 :          0 :                 n = n->next;
    1254                 :            :               }
    1255                 :          0 :             continue;
    1256                 :            :           default: break;
    1257                 :            :           }
    1258                 :          0 :       else if (list_type == OMP_LIST_MAP)
    1259                 :          0 :         switch (n->u.map_op)
    1260                 :            :           {
    1261                 :          0 :           case OMP_MAP_ALLOC: fputs ("alloc:", dumpfile); break;
    1262                 :          0 :           case OMP_MAP_TO: fputs ("to:", dumpfile); break;
    1263                 :          0 :           case OMP_MAP_FROM: fputs ("from:", dumpfile); break;
    1264                 :          0 :           case OMP_MAP_TOFROM: fputs ("tofrom:", dumpfile); break;
    1265                 :            :           default: break;
    1266                 :            :           }
    1267                 :          0 :       else if (list_type == OMP_LIST_LINEAR)
    1268                 :          0 :         switch (n->u.linear_op)
    1269                 :            :           {
    1270                 :          0 :           case OMP_LINEAR_REF: fputs ("ref(", dumpfile); break;
    1271                 :          0 :           case OMP_LINEAR_VAL: fputs ("val(", dumpfile); break;
    1272                 :          0 :           case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
    1273                 :            :           default: break;
    1274                 :            :           }
    1275                 :          0 :       fprintf (dumpfile, "%s", n->sym->name);
    1276                 :          0 :       if (list_type == OMP_LIST_LINEAR && n->u.linear_op != OMP_LINEAR_DEFAULT)
    1277                 :          0 :         fputc (')', dumpfile);
    1278                 :          0 :       if (n->expr)
    1279                 :            :         {
    1280                 :          0 :           fputc (':', dumpfile);
    1281                 :          0 :           show_expr (n->expr);
    1282                 :            :         }
    1283                 :          0 :       if (n->next)
    1284                 :          0 :         fputc (',', dumpfile);
    1285                 :            :     }
    1286                 :          0 : }
    1287                 :            : 
    1288                 :            : 
    1289                 :            : /* Show OpenMP or OpenACC clauses.  */
    1290                 :            : 
    1291                 :            : static void
    1292                 :          0 : show_omp_clauses (gfc_omp_clauses *omp_clauses)
    1293                 :            : {
    1294                 :          0 :   int list_type, i;
    1295                 :            : 
    1296                 :          0 :   switch (omp_clauses->cancel)
    1297                 :            :     {
    1298                 :            :     case OMP_CANCEL_UNKNOWN:
    1299                 :            :       break;
    1300                 :          0 :     case OMP_CANCEL_PARALLEL:
    1301                 :          0 :       fputs (" PARALLEL", dumpfile);
    1302                 :          0 :       break;
    1303                 :          0 :     case OMP_CANCEL_SECTIONS:
    1304                 :          0 :       fputs (" SECTIONS", dumpfile);
    1305                 :          0 :       break;
    1306                 :          0 :     case OMP_CANCEL_DO:
    1307                 :          0 :       fputs (" DO", dumpfile);
    1308                 :          0 :       break;
    1309                 :          0 :     case OMP_CANCEL_TASKGROUP:
    1310                 :          0 :       fputs (" TASKGROUP", dumpfile);
    1311                 :          0 :       break;
    1312                 :            :     }
    1313                 :          0 :   if (omp_clauses->if_expr)
    1314                 :            :     {
    1315                 :          0 :       fputs (" IF(", dumpfile);
    1316                 :          0 :       show_expr (omp_clauses->if_expr);
    1317                 :          0 :       fputc (')', dumpfile);
    1318                 :            :     }
    1319                 :          0 :   if (omp_clauses->final_expr)
    1320                 :            :     {
    1321                 :          0 :       fputs (" FINAL(", dumpfile);
    1322                 :          0 :       show_expr (omp_clauses->final_expr);
    1323                 :          0 :       fputc (')', dumpfile);
    1324                 :            :     }
    1325                 :          0 :   if (omp_clauses->num_threads)
    1326                 :            :     {
    1327                 :          0 :       fputs (" NUM_THREADS(", dumpfile);
    1328                 :          0 :       show_expr (omp_clauses->num_threads);
    1329                 :          0 :       fputc (')', dumpfile);
    1330                 :            :     }
    1331                 :          0 :   if (omp_clauses->async)
    1332                 :            :     {
    1333                 :          0 :       fputs (" ASYNC", dumpfile);
    1334                 :          0 :       if (omp_clauses->async_expr)
    1335                 :            :         {
    1336                 :          0 :           fputc ('(', dumpfile);
    1337                 :          0 :           show_expr (omp_clauses->async_expr);
    1338                 :          0 :           fputc (')', dumpfile);
    1339                 :            :         }
    1340                 :            :     }
    1341                 :          0 :   if (omp_clauses->num_gangs_expr)
    1342                 :            :     {
    1343                 :          0 :       fputs (" NUM_GANGS(", dumpfile);
    1344                 :          0 :       show_expr (omp_clauses->num_gangs_expr);
    1345                 :          0 :       fputc (')', dumpfile);
    1346                 :            :     }
    1347                 :          0 :   if (omp_clauses->num_workers_expr)
    1348                 :            :     {
    1349                 :          0 :       fputs (" NUM_WORKERS(", dumpfile);
    1350                 :          0 :       show_expr (omp_clauses->num_workers_expr);
    1351                 :          0 :       fputc (')', dumpfile);
    1352                 :            :     }
    1353                 :          0 :   if (omp_clauses->vector_length_expr)
    1354                 :            :     {
    1355                 :          0 :       fputs (" VECTOR_LENGTH(", dumpfile);
    1356                 :          0 :       show_expr (omp_clauses->vector_length_expr);
    1357                 :          0 :       fputc (')', dumpfile);
    1358                 :            :     }
    1359                 :          0 :   if (omp_clauses->gang)
    1360                 :            :     {
    1361                 :          0 :       fputs (" GANG", dumpfile);
    1362                 :          0 :       if (omp_clauses->gang_num_expr || omp_clauses->gang_static_expr)
    1363                 :            :         {
    1364                 :          0 :           fputc ('(', dumpfile);
    1365                 :          0 :           if (omp_clauses->gang_num_expr)
    1366                 :            :             {
    1367                 :          0 :               fprintf (dumpfile, "num:");
    1368                 :          0 :               show_expr (omp_clauses->gang_num_expr);
    1369                 :            :             }
    1370                 :          0 :           if (omp_clauses->gang_num_expr && omp_clauses->gang_static)
    1371                 :          0 :             fputc (',', dumpfile);
    1372                 :          0 :           if (omp_clauses->gang_static)
    1373                 :            :             {
    1374                 :          0 :               fprintf (dumpfile, "static:");
    1375                 :          0 :               if (omp_clauses->gang_static_expr)
    1376                 :          0 :                 show_expr (omp_clauses->gang_static_expr);
    1377                 :            :               else
    1378                 :          0 :                 fputc ('*', dumpfile);
    1379                 :            :             }
    1380                 :          0 :           fputc (')', dumpfile);
    1381                 :            :         }
    1382                 :            :     }
    1383                 :          0 :   if (omp_clauses->worker)
    1384                 :            :     {
    1385                 :          0 :       fputs (" WORKER", dumpfile);
    1386                 :          0 :       if (omp_clauses->worker_expr)
    1387                 :            :         {
    1388                 :          0 :           fputc ('(', dumpfile);
    1389                 :          0 :           show_expr (omp_clauses->worker_expr);
    1390                 :          0 :           fputc (')', dumpfile);
    1391                 :            :         }
    1392                 :            :     }
    1393                 :          0 :   if (omp_clauses->vector)
    1394                 :            :     {
    1395                 :          0 :       fputs (" VECTOR", dumpfile);
    1396                 :          0 :       if (omp_clauses->vector_expr)
    1397                 :            :         {
    1398                 :          0 :           fputc ('(', dumpfile);
    1399                 :          0 :           show_expr (omp_clauses->vector_expr);
    1400                 :          0 :           fputc (')', dumpfile);
    1401                 :            :         }
    1402                 :            :     }
    1403                 :          0 :   if (omp_clauses->sched_kind != OMP_SCHED_NONE)
    1404                 :            :     {
    1405                 :          0 :       const char *type;
    1406                 :          0 :       switch (omp_clauses->sched_kind)
    1407                 :            :         {
    1408                 :            :         case OMP_SCHED_STATIC: type = "STATIC"; break;
    1409                 :          0 :         case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
    1410                 :          0 :         case OMP_SCHED_GUIDED: type = "GUIDED"; break;
    1411                 :          0 :         case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
    1412                 :          0 :         case OMP_SCHED_AUTO: type = "AUTO"; break;
    1413                 :          0 :         default:
    1414                 :          0 :           gcc_unreachable ();
    1415                 :            :         }
    1416                 :          0 :       fputs (" SCHEDULE (", dumpfile);
    1417                 :          0 :       if (omp_clauses->sched_simd)
    1418                 :            :         {
    1419                 :          0 :           if (omp_clauses->sched_monotonic
    1420                 :          0 :               || omp_clauses->sched_nonmonotonic)
    1421                 :          0 :             fputs ("SIMD, ", dumpfile);
    1422                 :            :           else
    1423                 :          0 :             fputs ("SIMD: ", dumpfile);
    1424                 :            :         }
    1425                 :          0 :       if (omp_clauses->sched_monotonic)
    1426                 :          0 :         fputs ("MONOTONIC: ", dumpfile);
    1427                 :          0 :       else if (omp_clauses->sched_nonmonotonic)
    1428                 :          0 :         fputs ("NONMONOTONIC: ", dumpfile);
    1429                 :          0 :       fputs (type, dumpfile);
    1430                 :          0 :       if (omp_clauses->chunk_size)
    1431                 :            :         {
    1432                 :          0 :           fputc (',', dumpfile);
    1433                 :          0 :           show_expr (omp_clauses->chunk_size);
    1434                 :            :         }
    1435                 :          0 :       fputc (')', dumpfile);
    1436                 :            :     }
    1437                 :          0 :   if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
    1438                 :            :     {
    1439                 :          0 :       const char *type;
    1440                 :          0 :       switch (omp_clauses->default_sharing)
    1441                 :            :         {
    1442                 :            :         case OMP_DEFAULT_NONE: type = "NONE"; break;
    1443                 :          0 :         case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
    1444                 :          0 :         case OMP_DEFAULT_SHARED: type = "SHARED"; break;
    1445                 :          0 :         case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
    1446                 :          0 :         case OMP_DEFAULT_PRESENT: type = "PRESENT"; break;
    1447                 :          0 :         default:
    1448                 :          0 :           gcc_unreachable ();
    1449                 :            :         }
    1450                 :          0 :       fprintf (dumpfile, " DEFAULT(%s)", type);
    1451                 :            :     }
    1452                 :          0 :   if (omp_clauses->tile_list)
    1453                 :            :     {
    1454                 :          0 :       gfc_expr_list *list;
    1455                 :          0 :       fputs (" TILE(", dumpfile);
    1456                 :          0 :       for (list = omp_clauses->tile_list; list; list = list->next)
    1457                 :            :         {
    1458                 :          0 :           show_expr (list->expr);
    1459                 :          0 :           if (list->next)
    1460                 :          0 :             fputs (", ", dumpfile);
    1461                 :            :         }
    1462                 :          0 :       fputc (')', dumpfile);
    1463                 :            :     }
    1464                 :          0 :   if (omp_clauses->wait_list)
    1465                 :            :     {
    1466                 :          0 :       gfc_expr_list *list;
    1467                 :          0 :       fputs (" WAIT(", dumpfile);
    1468                 :          0 :       for (list = omp_clauses->wait_list; list; list = list->next)
    1469                 :            :         {
    1470                 :          0 :           show_expr (list->expr);
    1471                 :          0 :           if (list->next)
    1472                 :          0 :             fputs (", ", dumpfile);
    1473                 :            :         }
    1474                 :          0 :       fputc (')', dumpfile);
    1475                 :            :     }
    1476                 :          0 :   if (omp_clauses->seq)
    1477                 :          0 :     fputs (" SEQ", dumpfile);
    1478                 :          0 :   if (omp_clauses->independent)
    1479                 :          0 :     fputs (" INDEPENDENT", dumpfile);
    1480                 :          0 :   if (omp_clauses->ordered)
    1481                 :            :     {
    1482                 :          0 :       if (omp_clauses->orderedc)
    1483                 :          0 :         fprintf (dumpfile, " ORDERED(%d)", omp_clauses->orderedc);
    1484                 :            :       else
    1485                 :          0 :         fputs (" ORDERED", dumpfile);
    1486                 :            :     }
    1487                 :          0 :   if (omp_clauses->untied)
    1488                 :          0 :     fputs (" UNTIED", dumpfile);
    1489                 :          0 :   if (omp_clauses->mergeable)
    1490                 :          0 :     fputs (" MERGEABLE", dumpfile);
    1491                 :          0 :   if (omp_clauses->collapse)
    1492                 :          0 :     fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
    1493                 :          0 :   for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
    1494                 :          0 :     if (omp_clauses->lists[list_type] != NULL
    1495                 :          0 :         && list_type != OMP_LIST_COPYPRIVATE)
    1496                 :            :       {
    1497                 :          0 :         const char *type = NULL;
    1498                 :          0 :         switch (list_type)
    1499                 :            :           {
    1500                 :            :           case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
    1501                 :          0 :           case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
    1502                 :          0 :           case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
    1503                 :          0 :           case OMP_LIST_COPYPRIVATE: type = "COPYPRIVATE"; break;
    1504                 :          0 :           case OMP_LIST_SHARED: type = "SHARED"; break;
    1505                 :          0 :           case OMP_LIST_COPYIN: type = "COPYIN"; break;
    1506                 :          0 :           case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
    1507                 :          0 :           case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
    1508                 :          0 :           case OMP_LIST_LINEAR: type = "LINEAR"; break;
    1509                 :          0 :           case OMP_LIST_DEPEND: type = "DEPEND"; break;
    1510                 :          0 :           case OMP_LIST_MAP: type = "MAP"; break;
    1511                 :          0 :           case OMP_LIST_TO: type = "TO"; break;
    1512                 :          0 :           case OMP_LIST_FROM: type = "FROM"; break;
    1513                 :          0 :           case OMP_LIST_REDUCTION: type = "REDUCTION"; break;
    1514                 :          0 :           case OMP_LIST_DEVICE_RESIDENT: type = "DEVICE_RESIDENT"; break;
    1515                 :          0 :           case OMP_LIST_LINK: type = "LINK"; break;
    1516                 :          0 :           case OMP_LIST_USE_DEVICE: type = "USE_DEVICE"; break;
    1517                 :          0 :           case OMP_LIST_CACHE: type = "CACHE"; break;
    1518                 :          0 :           case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break;
    1519                 :          0 :           case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
    1520                 :          0 :           case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
    1521                 :            :           default:
    1522                 :            :             gcc_unreachable ();
    1523                 :            :           }
    1524                 :          0 :         fprintf (dumpfile, " %s(", type);
    1525                 :          0 :         show_omp_namelist (list_type, omp_clauses->lists[list_type]);
    1526                 :          0 :         fputc (')', dumpfile);
    1527                 :            :       }
    1528                 :          0 :   if (omp_clauses->safelen_expr)
    1529                 :            :     {
    1530                 :          0 :       fputs (" SAFELEN(", dumpfile);
    1531                 :          0 :       show_expr (omp_clauses->safelen_expr);
    1532                 :          0 :       fputc (')', dumpfile);
    1533                 :            :     }
    1534                 :          0 :   if (omp_clauses->simdlen_expr)
    1535                 :            :     {
    1536                 :          0 :       fputs (" SIMDLEN(", dumpfile);
    1537                 :          0 :       show_expr (omp_clauses->simdlen_expr);
    1538                 :          0 :       fputc (')', dumpfile);
    1539                 :            :     }
    1540                 :          0 :   if (omp_clauses->inbranch)
    1541                 :          0 :     fputs (" INBRANCH", dumpfile);
    1542                 :          0 :   if (omp_clauses->notinbranch)
    1543                 :          0 :     fputs (" NOTINBRANCH", dumpfile);
    1544                 :          0 :   if (omp_clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
    1545                 :            :     {
    1546                 :          0 :       const char *type;
    1547                 :          0 :       switch (omp_clauses->proc_bind)
    1548                 :            :         {
    1549                 :            :         case OMP_PROC_BIND_MASTER: type = "MASTER"; break;
    1550                 :          0 :         case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break;
    1551                 :          0 :         case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break;
    1552                 :          0 :         default:
    1553                 :          0 :           gcc_unreachable ();
    1554                 :            :         }
    1555                 :          0 :       fprintf (dumpfile, " PROC_BIND(%s)", type);
    1556                 :            :     }
    1557                 :          0 :   if (omp_clauses->num_teams)
    1558                 :            :     {
    1559                 :          0 :       fputs (" NUM_TEAMS(", dumpfile);
    1560                 :          0 :       show_expr (omp_clauses->num_teams);
    1561                 :          0 :       fputc (')', dumpfile);
    1562                 :            :     }
    1563                 :          0 :   if (omp_clauses->device)
    1564                 :            :     {
    1565                 :          0 :       fputs (" DEVICE(", dumpfile);
    1566                 :          0 :       show_expr (omp_clauses->device);
    1567                 :          0 :       fputc (')', dumpfile);
    1568                 :            :     }
    1569                 :          0 :   if (omp_clauses->thread_limit)
    1570                 :            :     {
    1571                 :          0 :       fputs (" THREAD_LIMIT(", dumpfile);
    1572                 :          0 :       show_expr (omp_clauses->thread_limit);
    1573                 :          0 :       fputc (')', dumpfile);
    1574                 :            :     }
    1575                 :          0 :   if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE)
    1576                 :            :     {
    1577                 :          0 :       fprintf (dumpfile, " DIST_SCHEDULE (STATIC");
    1578                 :          0 :       if (omp_clauses->dist_chunk_size)
    1579                 :            :         {
    1580                 :          0 :           fputc (',', dumpfile);
    1581                 :          0 :           show_expr (omp_clauses->dist_chunk_size);
    1582                 :            :         }
    1583                 :          0 :       fputc (')', dumpfile);
    1584                 :            :     }
    1585                 :          0 :   if (omp_clauses->defaultmap)
    1586                 :          0 :     fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile);
    1587                 :          0 :   if (omp_clauses->nogroup)
    1588                 :          0 :     fputs (" NOGROUP", dumpfile);
    1589                 :          0 :   if (omp_clauses->simd)
    1590                 :          0 :     fputs (" SIMD", dumpfile);
    1591                 :          0 :   if (omp_clauses->threads)
    1592                 :          0 :     fputs (" THREADS", dumpfile);
    1593                 :          0 :   if (omp_clauses->grainsize)
    1594                 :            :     {
    1595                 :          0 :       fputs (" GRAINSIZE(", dumpfile);
    1596                 :          0 :       show_expr (omp_clauses->grainsize);
    1597                 :          0 :       fputc (')', dumpfile);
    1598                 :            :     }
    1599                 :          0 :   if (omp_clauses->hint)
    1600                 :            :     {
    1601                 :          0 :       fputs (" HINT(", dumpfile);
    1602                 :          0 :       show_expr (omp_clauses->hint);
    1603                 :          0 :       fputc (')', dumpfile);
    1604                 :            :     }
    1605                 :          0 :   if (omp_clauses->num_tasks)
    1606                 :            :     {
    1607                 :          0 :       fputs (" NUM_TASKS(", dumpfile);
    1608                 :          0 :       show_expr (omp_clauses->num_tasks);
    1609                 :          0 :       fputc (')', dumpfile);
    1610                 :            :     }
    1611                 :          0 :   if (omp_clauses->priority)
    1612                 :            :     {
    1613                 :          0 :       fputs (" PRIORITY(", dumpfile);
    1614                 :          0 :       show_expr (omp_clauses->priority);
    1615                 :          0 :       fputc (')', dumpfile);
    1616                 :            :     }
    1617                 :          0 :   for (i = 0; i < OMP_IF_LAST; i++)
    1618                 :          0 :     if (omp_clauses->if_exprs[i])
    1619                 :            :       {
    1620                 :          0 :         static const char *ifs[] = {
    1621                 :            :           "PARALLEL",
    1622                 :            :           "TASK",
    1623                 :            :           "TASKLOOP",
    1624                 :            :           "TARGET",
    1625                 :            :           "TARGET DATA",
    1626                 :            :           "TARGET UPDATE",
    1627                 :            :           "TARGET ENTER DATA",
    1628                 :            :           "TARGET EXIT DATA"
    1629                 :            :         };
    1630                 :          0 :       fputs (" IF(", dumpfile);
    1631                 :          0 :       fputs (ifs[i], dumpfile);
    1632                 :          0 :       fputs (": ", dumpfile);
    1633                 :          0 :       show_expr (omp_clauses->if_exprs[i]);
    1634                 :          0 :       fputc (')', dumpfile);
    1635                 :            :     }
    1636                 :          0 :   if (omp_clauses->depend_source)
    1637                 :          0 :     fputs (" DEPEND(source)", dumpfile);
    1638                 :          0 : }
    1639                 :            : 
    1640                 :            : /* Show a single OpenMP or OpenACC directive node and everything underneath it
    1641                 :            :    if necessary.  */
    1642                 :            : 
    1643                 :            : static void
    1644                 :          0 : show_omp_node (int level, gfc_code *c)
    1645                 :            : {
    1646                 :          0 :   gfc_omp_clauses *omp_clauses = NULL;
    1647                 :          0 :   const char *name = NULL;
    1648                 :          0 :   bool is_oacc = false;
    1649                 :            : 
    1650                 :          0 :   switch (c->op)
    1651                 :            :     {
    1652                 :            :     case EXEC_OACC_PARALLEL_LOOP:
    1653                 :            :       name = "PARALLEL LOOP"; is_oacc = true; break;
    1654                 :          0 :     case EXEC_OACC_PARALLEL: name = "PARALLEL"; is_oacc = true; break;
    1655                 :          0 :     case EXEC_OACC_KERNELS_LOOP: name = "KERNELS LOOP"; is_oacc = true; break;
    1656                 :          0 :     case EXEC_OACC_KERNELS: name = "KERNELS"; is_oacc = true; break;
    1657                 :          0 :     case EXEC_OACC_SERIAL_LOOP: name = "SERIAL LOOP"; is_oacc = true; break;
    1658                 :          0 :     case EXEC_OACC_SERIAL: name = "SERIAL"; is_oacc = true; break;
    1659                 :          0 :     case EXEC_OACC_DATA: name = "DATA"; is_oacc = true; break;
    1660                 :          0 :     case EXEC_OACC_HOST_DATA: name = "HOST_DATA"; is_oacc = true; break;
    1661                 :          0 :     case EXEC_OACC_LOOP: name = "LOOP"; is_oacc = true; break;
    1662                 :          0 :     case EXEC_OACC_UPDATE: name = "UPDATE"; is_oacc = true; break;
    1663                 :          0 :     case EXEC_OACC_WAIT: name = "WAIT"; is_oacc = true; break;
    1664                 :          0 :     case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
    1665                 :          0 :     case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
    1666                 :          0 :     case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
    1667                 :          0 :     case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
    1668                 :          0 :     case EXEC_OMP_BARRIER: name = "BARRIER"; break;
    1669                 :          0 :     case EXEC_OMP_CANCEL: name = "CANCEL"; break;
    1670                 :          0 :     case EXEC_OMP_CANCELLATION_POINT: name = "CANCELLATION POINT"; break;
    1671                 :          0 :     case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
    1672                 :          0 :     case EXEC_OMP_DISTRIBUTE: name = "DISTRIBUTE"; break;
    1673                 :          0 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    1674                 :          0 :       name = "DISTRIBUTE PARALLEL DO"; break;
    1675                 :          0 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    1676                 :          0 :       name = "DISTRIBUTE PARALLEL DO SIMD"; break;
    1677                 :          0 :     case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break;
    1678                 :          0 :     case EXEC_OMP_DO: name = "DO"; break;
    1679                 :          0 :     case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
    1680                 :          0 :     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
    1681                 :          0 :     case EXEC_OMP_MASTER: name = "MASTER"; break;
    1682                 :          0 :     case EXEC_OMP_ORDERED: name = "ORDERED"; break;
    1683                 :          0 :     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
    1684                 :          0 :     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
    1685                 :          0 :     case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
    1686                 :          0 :     case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
    1687                 :          0 :     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
    1688                 :          0 :     case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
    1689                 :          0 :     case EXEC_OMP_SIMD: name = "SIMD"; break;
    1690                 :          0 :     case EXEC_OMP_SINGLE: name = "SINGLE"; break;
    1691                 :          0 :     case EXEC_OMP_TARGET: name = "TARGET"; break;
    1692                 :          0 :     case EXEC_OMP_TARGET_DATA: name = "TARGET DATA"; break;
    1693                 :          0 :     case EXEC_OMP_TARGET_ENTER_DATA: name = "TARGET ENTER DATA"; break;
    1694                 :          0 :     case EXEC_OMP_TARGET_EXIT_DATA: name = "TARGET EXIT DATA"; break;
    1695                 :          0 :     case EXEC_OMP_TARGET_PARALLEL: name = "TARGET PARALLEL"; break;
    1696                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break;
    1697                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    1698                 :          0 :       name = "TARGET_PARALLEL_DO_SIMD"; break;
    1699                 :          0 :     case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break;
    1700                 :          0 :     case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break;
    1701                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    1702                 :          0 :       name = "TARGET TEAMS DISTRIBUTE"; break;
    1703                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    1704                 :          0 :       name = "TARGET TEAMS DISTRIBUTE PARALLEL DO"; break;
    1705                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    1706                 :          0 :       name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
    1707                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    1708                 :          0 :       name = "TARGET TEAMS DISTRIBUTE SIMD"; break;
    1709                 :            :     case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break;
    1710                 :            :     case EXEC_OMP_TASK: name = "TASK"; break;
    1711                 :          0 :     case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break;
    1712                 :          0 :     case EXEC_OMP_TASKLOOP: name = "TASKLOOP"; break;
    1713                 :          0 :     case EXEC_OMP_TASKLOOP_SIMD: name = "TASKLOOP SIMD"; break;
    1714                 :          0 :     case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
    1715                 :          0 :     case EXEC_OMP_TASKYIELD: name = "TASKYIELD"; break;
    1716                 :          0 :     case EXEC_OMP_TEAMS: name = "TEAMS"; break;
    1717                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE: name = "TEAMS DISTRIBUTE"; break;
    1718                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    1719                 :          0 :       name = "TEAMS DISTRIBUTE PARALLEL DO"; break;
    1720                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    1721                 :          0 :       name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
    1722                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break;
    1723                 :          0 :     case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
    1724                 :          0 :     default:
    1725                 :          0 :       gcc_unreachable ();
    1726                 :            :     }
    1727                 :          0 :   fprintf (dumpfile, "!$%s %s", is_oacc ? "ACC" : "OMP", name);
    1728                 :          0 :   switch (c->op)
    1729                 :            :     {
    1730                 :          0 :     case EXEC_OACC_PARALLEL_LOOP:
    1731                 :          0 :     case EXEC_OACC_PARALLEL:
    1732                 :          0 :     case EXEC_OACC_KERNELS_LOOP:
    1733                 :          0 :     case EXEC_OACC_KERNELS:
    1734                 :          0 :     case EXEC_OACC_SERIAL_LOOP:
    1735                 :          0 :     case EXEC_OACC_SERIAL:
    1736                 :          0 :     case EXEC_OACC_DATA:
    1737                 :          0 :     case EXEC_OACC_HOST_DATA:
    1738                 :          0 :     case EXEC_OACC_LOOP:
    1739                 :          0 :     case EXEC_OACC_UPDATE:
    1740                 :          0 :     case EXEC_OACC_WAIT:
    1741                 :          0 :     case EXEC_OACC_CACHE:
    1742                 :          0 :     case EXEC_OACC_ENTER_DATA:
    1743                 :          0 :     case EXEC_OACC_EXIT_DATA:
    1744                 :          0 :     case EXEC_OMP_CANCEL:
    1745                 :          0 :     case EXEC_OMP_CANCELLATION_POINT:
    1746                 :          0 :     case EXEC_OMP_DISTRIBUTE:
    1747                 :          0 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    1748                 :          0 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    1749                 :          0 :     case EXEC_OMP_DISTRIBUTE_SIMD:
    1750                 :          0 :     case EXEC_OMP_DO:
    1751                 :          0 :     case EXEC_OMP_DO_SIMD:
    1752                 :          0 :     case EXEC_OMP_ORDERED:
    1753                 :          0 :     case EXEC_OMP_PARALLEL:
    1754                 :          0 :     case EXEC_OMP_PARALLEL_DO:
    1755                 :          0 :     case EXEC_OMP_PARALLEL_DO_SIMD:
    1756                 :          0 :     case EXEC_OMP_PARALLEL_SECTIONS:
    1757                 :          0 :     case EXEC_OMP_PARALLEL_WORKSHARE:
    1758                 :          0 :     case EXEC_OMP_SECTIONS:
    1759                 :          0 :     case EXEC_OMP_SIMD:
    1760                 :          0 :     case EXEC_OMP_SINGLE:
    1761                 :          0 :     case EXEC_OMP_TARGET:
    1762                 :          0 :     case EXEC_OMP_TARGET_DATA:
    1763                 :          0 :     case EXEC_OMP_TARGET_ENTER_DATA:
    1764                 :          0 :     case EXEC_OMP_TARGET_EXIT_DATA:
    1765                 :          0 :     case EXEC_OMP_TARGET_PARALLEL:
    1766                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO:
    1767                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    1768                 :          0 :     case EXEC_OMP_TARGET_SIMD:
    1769                 :          0 :     case EXEC_OMP_TARGET_TEAMS:
    1770                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    1771                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    1772                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    1773                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    1774                 :          0 :     case EXEC_OMP_TARGET_UPDATE:
    1775                 :          0 :     case EXEC_OMP_TASK:
    1776                 :          0 :     case EXEC_OMP_TASKLOOP:
    1777                 :          0 :     case EXEC_OMP_TASKLOOP_SIMD:
    1778                 :          0 :     case EXEC_OMP_TEAMS:
    1779                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    1780                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    1781                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    1782                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
    1783                 :          0 :     case EXEC_OMP_WORKSHARE:
    1784                 :          0 :       omp_clauses = c->ext.omp_clauses;
    1785                 :          0 :       break;
    1786                 :          0 :     case EXEC_OMP_CRITICAL:
    1787                 :          0 :       omp_clauses = c->ext.omp_clauses;
    1788                 :          0 :       if (omp_clauses)
    1789                 :          0 :         fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
    1790                 :            :       break;
    1791                 :          0 :     case EXEC_OMP_FLUSH:
    1792                 :          0 :       if (c->ext.omp_namelist)
    1793                 :            :         {
    1794                 :          0 :           fputs (" (", dumpfile);
    1795                 :          0 :           show_omp_namelist (OMP_LIST_NUM, c->ext.omp_namelist);
    1796                 :          0 :           fputc (')', dumpfile);
    1797                 :            :         }
    1798                 :            :       return;
    1799                 :            :     case EXEC_OMP_BARRIER:
    1800                 :            :     case EXEC_OMP_TASKWAIT:
    1801                 :            :     case EXEC_OMP_TASKYIELD:
    1802                 :            :       return;
    1803                 :            :     default:
    1804                 :            :       break;
    1805                 :            :     }
    1806                 :          0 :   if (omp_clauses)
    1807                 :          0 :     show_omp_clauses (omp_clauses);
    1808                 :          0 :   fputc ('\n', dumpfile);
    1809                 :            : 
    1810                 :            :   /* OpenMP and OpenACC executable directives don't have associated blocks.  */
    1811                 :          0 :   if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
    1812                 :          0 :       || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
    1813                 :          0 :       || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
    1814                 :          0 :       || c->op == EXEC_OMP_TARGET_EXIT_DATA
    1815                 :          0 :       || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
    1816                 :            :     return;
    1817                 :          0 :   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
    1818                 :            :     {
    1819                 :          0 :       gfc_code *d = c->block;
    1820                 :          0 :       while (d != NULL)
    1821                 :            :         {
    1822                 :          0 :           show_code (level + 1, d->next);
    1823                 :          0 :           if (d->block == NULL)
    1824                 :            :             break;
    1825                 :          0 :           code_indent (level, 0);
    1826                 :          0 :           fputs ("!$OMP SECTION\n", dumpfile);
    1827                 :          0 :           d = d->block;
    1828                 :            :         }
    1829                 :            :     }
    1830                 :            :   else
    1831                 :          0 :     show_code (level + 1, c->block->next);
    1832                 :          0 :   if (c->op == EXEC_OMP_ATOMIC)
    1833                 :            :     return;
    1834                 :          0 :   fputc ('\n', dumpfile);
    1835                 :          0 :   code_indent (level, 0);
    1836                 :          0 :   fprintf (dumpfile, "!$%s END %s", is_oacc ? "ACC" : "OMP", name);
    1837                 :          0 :   if (omp_clauses != NULL)
    1838                 :            :     {
    1839                 :          0 :       if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
    1840                 :            :         {
    1841                 :          0 :           fputs (" COPYPRIVATE(", dumpfile);
    1842                 :          0 :           show_omp_namelist (OMP_LIST_COPYPRIVATE,
    1843                 :            :                              omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
    1844                 :          0 :           fputc (')', dumpfile);
    1845                 :            :         }
    1846                 :          0 :       else if (omp_clauses->nowait)
    1847                 :          0 :         fputs (" NOWAIT", dumpfile);
    1848                 :            :     }
    1849                 :          0 :   else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_clauses)
    1850                 :          0 :     fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
    1851                 :            : }
    1852                 :            : 
    1853                 :            : 
    1854                 :            : /* Show a single code node and everything underneath it if necessary.  */
    1855                 :            : 
    1856                 :            : static void
    1857                 :        200 : show_code_node (int level, gfc_code *c)
    1858                 :            : {
    1859                 :        200 :   gfc_forall_iterator *fa;
    1860                 :        200 :   gfc_open *open;
    1861                 :        200 :   gfc_case *cp;
    1862                 :        200 :   gfc_alloc *a;
    1863                 :        200 :   gfc_code *d;
    1864                 :        200 :   gfc_close *close;
    1865                 :        200 :   gfc_filepos *fp;
    1866                 :        200 :   gfc_inquire *i;
    1867                 :        200 :   gfc_dt *dt;
    1868                 :        200 :   gfc_namespace *ns;
    1869                 :            : 
    1870                 :        200 :   if (c->here)
    1871                 :            :     {
    1872                 :          0 :       fputc ('\n', dumpfile);
    1873                 :          0 :       code_indent (level, c->here);
    1874                 :            :     }
    1875                 :            :   else
    1876                 :        200 :     show_indent ();
    1877                 :            : 
    1878                 :        200 :   switch (c->op)
    1879                 :            :     {
    1880                 :            :     case EXEC_END_PROCEDURE:
    1881                 :            :       break;
    1882                 :            : 
    1883                 :          0 :     case EXEC_NOP:
    1884                 :          0 :       fputs ("NOP", dumpfile);
    1885                 :          0 :       break;
    1886                 :            : 
    1887                 :          0 :     case EXEC_CONTINUE:
    1888                 :          0 :       fputs ("CONTINUE", dumpfile);
    1889                 :          0 :       break;
    1890                 :            : 
    1891                 :          0 :     case EXEC_ENTRY:
    1892                 :          0 :       fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
    1893                 :          0 :       break;
    1894                 :            : 
    1895                 :          6 :     case EXEC_INIT_ASSIGN:
    1896                 :          6 :     case EXEC_ASSIGN:
    1897                 :          6 :       fputs ("ASSIGN ", dumpfile);
    1898                 :          6 :       show_expr (c->expr1);
    1899                 :          6 :       fputc (' ', dumpfile);
    1900                 :          6 :       show_expr (c->expr2);
    1901                 :          6 :       break;
    1902                 :            : 
    1903                 :          0 :     case EXEC_LABEL_ASSIGN:
    1904                 :          0 :       fputs ("LABEL ASSIGN ", dumpfile);
    1905                 :          0 :       show_expr (c->expr1);
    1906                 :          0 :       fprintf (dumpfile, " %d", c->label1->value);
    1907                 :          0 :       break;
    1908                 :            : 
    1909                 :          0 :     case EXEC_POINTER_ASSIGN:
    1910                 :          0 :       fputs ("POINTER ASSIGN ", dumpfile);
    1911                 :          0 :       show_expr (c->expr1);
    1912                 :          0 :       fputc (' ', dumpfile);
    1913                 :          0 :       show_expr (c->expr2);
    1914                 :          0 :       break;
    1915                 :            : 
    1916                 :          0 :     case EXEC_GOTO:
    1917                 :          0 :       fputs ("GOTO ", dumpfile);
    1918                 :          0 :       if (c->label1)
    1919                 :          0 :         fprintf (dumpfile, "%d", c->label1->value);
    1920                 :            :       else
    1921                 :            :         {
    1922                 :          0 :           show_expr (c->expr1);
    1923                 :          0 :           d = c->block;
    1924                 :          0 :           if (d != NULL)
    1925                 :            :             {
    1926                 :          0 :               fputs (", (", dumpfile);
    1927                 :          0 :               for (; d; d = d ->block)
    1928                 :            :                 {
    1929                 :          0 :                   code_indent (level, d->label1);
    1930                 :          0 :                   if (d->block != NULL)
    1931                 :          0 :                     fputc (',', dumpfile);
    1932                 :            :                   else
    1933                 :          0 :                     fputc (')', dumpfile);
    1934                 :            :                 }
    1935                 :            :             }
    1936                 :            :         }
    1937                 :            :       break;
    1938                 :            : 
    1939                 :          0 :     case EXEC_CALL:
    1940                 :          0 :     case EXEC_ASSIGN_CALL:
    1941                 :          0 :       if (c->resolved_sym)
    1942                 :          0 :         fprintf (dumpfile, "CALL %s ", c->resolved_sym->name);
    1943                 :          0 :       else if (c->symtree)
    1944                 :          0 :         fprintf (dumpfile, "CALL %s ", c->symtree->name);
    1945                 :            :       else
    1946                 :          0 :         fputs ("CALL ?? ", dumpfile);
    1947                 :            : 
    1948                 :          0 :       show_actual_arglist (c->ext.actual);
    1949                 :          0 :       break;
    1950                 :            : 
    1951                 :          0 :     case EXEC_COMPCALL:
    1952                 :          0 :       fputs ("CALL ", dumpfile);
    1953                 :          0 :       show_compcall (c->expr1);
    1954                 :          0 :       break;
    1955                 :            : 
    1956                 :          0 :     case EXEC_CALL_PPC:
    1957                 :          0 :       fputs ("CALL ", dumpfile);
    1958                 :          0 :       show_expr (c->expr1);
    1959                 :          0 :       show_actual_arglist (c->ext.actual);
    1960                 :          0 :       break;
    1961                 :            : 
    1962                 :          0 :     case EXEC_RETURN:
    1963                 :          0 :       fputs ("RETURN ", dumpfile);
    1964                 :          0 :       if (c->expr1)
    1965                 :          0 :         show_expr (c->expr1);
    1966                 :            :       break;
    1967                 :            : 
    1968                 :          0 :     case EXEC_PAUSE:
    1969                 :          0 :       fputs ("PAUSE ", dumpfile);
    1970                 :            : 
    1971                 :          0 :       if (c->expr1 != NULL)
    1972                 :          0 :         show_expr (c->expr1);
    1973                 :            :       else
    1974                 :          0 :         fprintf (dumpfile, "%d", c->ext.stop_code);
    1975                 :            : 
    1976                 :            :       break;
    1977                 :            : 
    1978                 :          0 :     case EXEC_ERROR_STOP:
    1979                 :          0 :       fputs ("ERROR ", dumpfile);
    1980                 :            :       /* Fall through.  */
    1981                 :            : 
    1982                 :         24 :     case EXEC_STOP:
    1983                 :         24 :       fputs ("STOP ", dumpfile);
    1984                 :            : 
    1985                 :         24 :       if (c->expr1 != NULL)
    1986                 :         24 :         show_expr (c->expr1);
    1987                 :            :       else
    1988                 :          0 :         fprintf (dumpfile, "%d", c->ext.stop_code);
    1989                 :            : 
    1990                 :            :       break;
    1991                 :            : 
    1992                 :          0 :     case EXEC_FAIL_IMAGE:
    1993                 :          0 :       fputs ("FAIL IMAGE ", dumpfile);
    1994                 :          0 :       break;
    1995                 :            : 
    1996                 :          0 :     case EXEC_CHANGE_TEAM:
    1997                 :          0 :       fputs ("CHANGE TEAM", dumpfile);
    1998                 :          0 :       break;
    1999                 :            : 
    2000                 :          0 :     case EXEC_END_TEAM:
    2001                 :          0 :       fputs ("END TEAM", dumpfile);
    2002                 :          0 :       break;
    2003                 :            : 
    2004                 :          0 :     case EXEC_FORM_TEAM:
    2005                 :          0 :       fputs ("FORM TEAM", dumpfile);
    2006                 :          0 :       break;
    2007                 :            : 
    2008                 :          0 :     case EXEC_SYNC_TEAM:
    2009                 :          0 :       fputs ("SYNC TEAM", dumpfile);
    2010                 :          0 :       break;
    2011                 :            : 
    2012                 :          0 :     case EXEC_SYNC_ALL:
    2013                 :          0 :       fputs ("SYNC ALL ", dumpfile);
    2014                 :          0 :       if (c->expr2 != NULL)
    2015                 :            :         {
    2016                 :          0 :           fputs (" stat=", dumpfile);
    2017                 :          0 :           show_expr (c->expr2);
    2018                 :            :         }
    2019                 :          0 :       if (c->expr3 != NULL)
    2020                 :            :         {
    2021                 :          0 :           fputs (" errmsg=", dumpfile);
    2022                 :          0 :           show_expr (c->expr3);
    2023                 :            :         }
    2024                 :            :       break;
    2025                 :            : 
    2026                 :          0 :     case EXEC_SYNC_MEMORY:
    2027                 :          0 :       fputs ("SYNC MEMORY ", dumpfile);
    2028                 :          0 :       if (c->expr2 != NULL)
    2029                 :            :         {
    2030                 :          0 :           fputs (" stat=", dumpfile);
    2031                 :          0 :           show_expr (c->expr2);
    2032                 :            :         }
    2033                 :          0 :       if (c->expr3 != NULL)
    2034                 :            :         {
    2035                 :          0 :           fputs (" errmsg=", dumpfile);
    2036                 :          0 :           show_expr (c->expr3);
    2037                 :            :         }
    2038                 :            :       break;
    2039                 :            : 
    2040                 :          0 :     case EXEC_SYNC_IMAGES:
    2041                 :          0 :       fputs ("SYNC IMAGES  image-set=", dumpfile);
    2042                 :          0 :       if (c->expr1 != NULL)
    2043                 :          0 :         show_expr (c->expr1);
    2044                 :            :       else
    2045                 :          0 :         fputs ("* ", dumpfile);
    2046                 :          0 :       if (c->expr2 != NULL)
    2047                 :            :         {
    2048                 :          0 :           fputs (" stat=", dumpfile);
    2049                 :          0 :           show_expr (c->expr2);
    2050                 :            :         }
    2051                 :          0 :       if (c->expr3 != NULL)
    2052                 :            :         {
    2053                 :          0 :           fputs (" errmsg=", dumpfile);
    2054                 :          0 :           show_expr (c->expr3);
    2055                 :            :         }
    2056                 :            :       break;
    2057                 :            : 
    2058                 :          0 :     case EXEC_EVENT_POST:
    2059                 :          0 :     case EXEC_EVENT_WAIT:
    2060                 :          0 :       if (c->op == EXEC_EVENT_POST)
    2061                 :          0 :         fputs ("EVENT POST ", dumpfile);
    2062                 :            :       else
    2063                 :          0 :         fputs ("EVENT WAIT ", dumpfile);
    2064                 :            : 
    2065                 :          0 :       fputs ("event-variable=", dumpfile);
    2066                 :          0 :       if (c->expr1 != NULL)
    2067                 :          0 :         show_expr (c->expr1);
    2068                 :          0 :       if (c->expr4 != NULL)
    2069                 :            :         {
    2070                 :          0 :           fputs (" until_count=", dumpfile);
    2071                 :          0 :           show_expr (c->expr4);
    2072                 :            :         }
    2073                 :          0 :       if (c->expr2 != NULL)
    2074                 :            :         {
    2075                 :          0 :           fputs (" stat=", dumpfile);
    2076                 :          0 :           show_expr (c->expr2);
    2077                 :            :         }
    2078                 :          0 :       if (c->expr3 != NULL)
    2079                 :            :         {
    2080                 :          0 :           fputs (" errmsg=", dumpfile);
    2081                 :          0 :           show_expr (c->expr3);
    2082                 :            :         }
    2083                 :            :       break;
    2084                 :            : 
    2085                 :          0 :     case EXEC_LOCK:
    2086                 :          0 :     case EXEC_UNLOCK:
    2087                 :          0 :       if (c->op == EXEC_LOCK)
    2088                 :          0 :         fputs ("LOCK ", dumpfile);
    2089                 :            :       else
    2090                 :          0 :         fputs ("UNLOCK ", dumpfile);
    2091                 :            : 
    2092                 :          0 :       fputs ("lock-variable=", dumpfile);
    2093                 :          0 :       if (c->expr1 != NULL)
    2094                 :          0 :         show_expr (c->expr1);
    2095                 :          0 :       if (c->expr4 != NULL)
    2096                 :            :         {
    2097                 :          0 :           fputs (" acquired_lock=", dumpfile);
    2098                 :          0 :           show_expr (c->expr4);
    2099                 :            :         }
    2100                 :          0 :       if (c->expr2 != NULL)
    2101                 :            :         {
    2102                 :          0 :           fputs (" stat=", dumpfile);
    2103                 :          0 :           show_expr (c->expr2);
    2104                 :            :         }
    2105                 :          0 :       if (c->expr3 != NULL)
    2106                 :            :         {
    2107                 :          0 :           fputs (" errmsg=", dumpfile);
    2108                 :          0 :           show_expr (c->expr3);
    2109                 :            :         }
    2110                 :            :       break;
    2111                 :            : 
    2112                 :          0 :     case EXEC_ARITHMETIC_IF:
    2113                 :          0 :       fputs ("IF ", dumpfile);
    2114                 :          0 :       show_expr (c->expr1);
    2115                 :          0 :       fprintf (dumpfile, " %d, %d, %d",
    2116                 :          0 :                   c->label1->value, c->label2->value, c->label3->value);
    2117                 :          0 :       break;
    2118                 :            : 
    2119                 :         12 :     case EXEC_IF:
    2120                 :         12 :       d = c->block;
    2121                 :         12 :       fputs ("IF ", dumpfile);
    2122                 :         12 :       show_expr (d->expr1);
    2123                 :            : 
    2124                 :         12 :       ++show_level;
    2125                 :         12 :       show_code (level + 1, d->next);
    2126                 :         12 :       --show_level;
    2127                 :            : 
    2128                 :         12 :       d = d->block;
    2129                 :         12 :       for (; d; d = d->block)
    2130                 :            :         {
    2131                 :          0 :           fputs("\n", dumpfile);
    2132                 :          0 :           code_indent (level, 0);
    2133                 :          0 :           if (d->expr1 == NULL)
    2134                 :          0 :             fputs ("ELSE", dumpfile);
    2135                 :            :           else
    2136                 :            :             {
    2137                 :          0 :               fputs ("ELSE IF ", dumpfile);
    2138                 :          0 :               show_expr (d->expr1);
    2139                 :            :             }
    2140                 :            : 
    2141                 :          0 :           ++show_level;
    2142                 :          0 :           show_code (level + 1, d->next);
    2143                 :          0 :           --show_level;
    2144                 :            :         }
    2145                 :            : 
    2146                 :         12 :       if (c->label1)
    2147                 :          0 :         code_indent (level, c->label1);
    2148                 :            :       else
    2149                 :         12 :         show_indent ();
    2150                 :            : 
    2151                 :         12 :       fputs ("ENDIF", dumpfile);
    2152                 :         12 :       break;
    2153                 :            : 
    2154                 :         24 :     case EXEC_BLOCK:
    2155                 :         24 :       {
    2156                 :         24 :         const char* blocktype;
    2157                 :         24 :         gfc_namespace *saved_ns;
    2158                 :         24 :         gfc_association_list *alist;
    2159                 :            : 
    2160                 :         24 :         if (c->ext.block.assoc)
    2161                 :            :           blocktype = "ASSOCIATE";
    2162                 :            :         else
    2163                 :         12 :           blocktype = "BLOCK";
    2164                 :         24 :         show_indent ();
    2165                 :         24 :         fprintf (dumpfile, "%s ", blocktype);
    2166                 :         36 :         for (alist = c->ext.block.assoc; alist; alist = alist->next)
    2167                 :            :           {
    2168                 :         12 :             fprintf (dumpfile, " %s = ", alist->name);
    2169                 :         12 :             show_expr (alist->target);
    2170                 :            :           }
    2171                 :            : 
    2172                 :         24 :         ++show_level;
    2173                 :         24 :         ns = c->ext.block.ns;
    2174                 :         24 :         saved_ns = gfc_current_ns;
    2175                 :         24 :         gfc_current_ns = ns;
    2176                 :         24 :         gfc_traverse_symtree (ns->sym_root, show_symtree);
    2177                 :         24 :         gfc_current_ns = saved_ns;
    2178                 :         24 :         show_code (show_level, ns->code);
    2179                 :         24 :         --show_level;
    2180                 :         24 :         show_indent ();
    2181                 :         24 :         fprintf (dumpfile, "END %s ", blocktype);
    2182                 :         24 :         break;
    2183                 :            :       }
    2184                 :            : 
    2185                 :            :     case EXEC_END_BLOCK:
    2186                 :            :       /* Only come here when there is a label on an
    2187                 :            :          END ASSOCIATE construct.  */
    2188                 :            :       break;
    2189                 :            : 
    2190                 :         12 :     case EXEC_SELECT:
    2191                 :         12 :     case EXEC_SELECT_TYPE:
    2192                 :         12 :     case EXEC_SELECT_RANK:
    2193                 :         12 :       d = c->block;
    2194                 :         12 :       fputc ('\n', dumpfile);
    2195                 :         12 :       code_indent (level, 0);
    2196                 :         12 :       if (c->op == EXEC_SELECT_RANK)
    2197                 :          0 :         fputs ("SELECT RANK ", dumpfile);
    2198                 :         12 :       else if (c->op == EXEC_SELECT_TYPE)
    2199                 :         12 :         fputs ("SELECT TYPE ", dumpfile);
    2200                 :            :       else
    2201                 :          0 :         fputs ("SELECT CASE ", dumpfile);
    2202                 :         12 :       show_expr (c->expr1);
    2203                 :            : 
    2204                 :         36 :       for (; d; d = d->block)
    2205                 :            :         {
    2206                 :         24 :           fputc ('\n', dumpfile);
    2207                 :         24 :           code_indent (level, 0);
    2208                 :         24 :           fputs ("CASE ", dumpfile);
    2209                 :         48 :           for (cp = d->ext.block.case_list; cp; cp = cp->next)
    2210                 :            :             {
    2211                 :         24 :               fputc ('(', dumpfile);
    2212                 :         24 :               show_expr (cp->low);
    2213                 :         24 :               fputc (' ', dumpfile);
    2214                 :         24 :               show_expr (cp->high);
    2215                 :         24 :               fputc (')', dumpfile);
    2216                 :         24 :               fputc (' ', dumpfile);
    2217                 :            :             }
    2218                 :            : 
    2219                 :         24 :           show_code (level + 1, d->next);
    2220                 :         24 :           fputc ('\n', dumpfile);
    2221                 :            :         }
    2222                 :            : 
    2223                 :         12 :       code_indent (level, c->label1);
    2224                 :         12 :       fputs ("END SELECT", dumpfile);
    2225                 :         12 :       break;
    2226                 :            : 
    2227                 :          0 :     case EXEC_WHERE:
    2228                 :          0 :       fputs ("WHERE ", dumpfile);
    2229                 :            : 
    2230                 :          0 :       d = c->block;
    2231                 :          0 :       show_expr (d->expr1);
    2232                 :          0 :       fputc ('\n', dumpfile);
    2233                 :            : 
    2234                 :          0 :       show_code (level + 1, d->next);
    2235                 :            : 
    2236                 :          0 :       for (d = d->block; d; d = d->block)
    2237                 :            :         {
    2238                 :          0 :           code_indent (level, 0);
    2239                 :          0 :           fputs ("ELSE WHERE ", dumpfile);
    2240                 :          0 :           show_expr (d->expr1);
    2241                 :          0 :           fputc ('\n', dumpfile);
    2242                 :          0 :           show_code (level + 1, d->next);
    2243                 :            :         }
    2244                 :            : 
    2245                 :          0 :       code_indent (level, 0);
    2246                 :          0 :       fputs ("END WHERE", dumpfile);
    2247                 :          0 :       break;
    2248                 :            : 
    2249                 :            : 
    2250                 :          0 :     case EXEC_FORALL:
    2251                 :          0 :       fputs ("FORALL ", dumpfile);
    2252                 :          0 :       for (fa = c->ext.forall_iterator; fa; fa = fa->next)
    2253                 :            :         {
    2254                 :          0 :           show_expr (fa->var);
    2255                 :          0 :           fputc (' ', dumpfile);
    2256                 :          0 :           show_expr (fa->start);
    2257                 :          0 :           fputc (':', dumpfile);
    2258                 :          0 :           show_expr (fa->end);
    2259                 :          0 :           fputc (':', dumpfile);
    2260                 :          0 :           show_expr (fa->stride);
    2261                 :            : 
    2262                 :          0 :           if (fa->next != NULL)
    2263                 :          0 :             fputc (',', dumpfile);
    2264                 :            :         }
    2265                 :            : 
    2266                 :          0 :       if (c->expr1 != NULL)
    2267                 :            :         {
    2268                 :          0 :           fputc (',', dumpfile);
    2269                 :          0 :           show_expr (c->expr1);
    2270                 :            :         }
    2271                 :          0 :       fputc ('\n', dumpfile);
    2272                 :            : 
    2273                 :          0 :       show_code (level + 1, c->block->next);
    2274                 :            : 
    2275                 :          0 :       code_indent (level, 0);
    2276                 :          0 :       fputs ("END FORALL", dumpfile);
    2277                 :          0 :       break;
    2278                 :            : 
    2279                 :          0 :     case EXEC_CRITICAL:
    2280                 :          0 :       fputs ("CRITICAL\n", dumpfile);
    2281                 :          0 :       show_code (level + 1, c->block->next);
    2282                 :          0 :       code_indent (level, 0);
    2283                 :          0 :       fputs ("END CRITICAL", dumpfile);
    2284                 :          0 :       break;
    2285                 :            : 
    2286                 :          0 :     case EXEC_DO:
    2287                 :          0 :       fputs ("DO ", dumpfile);
    2288                 :          0 :       if (c->label1)
    2289                 :          0 :         fprintf (dumpfile, " %-5d ", c->label1->value);
    2290                 :            : 
    2291                 :          0 :       show_expr (c->ext.iterator->var);
    2292                 :          0 :       fputc ('=', dumpfile);
    2293                 :          0 :       show_expr (c->ext.iterator->start);
    2294                 :          0 :       fputc (' ', dumpfile);
    2295                 :          0 :       show_expr (c->ext.iterator->end);
    2296                 :          0 :       fputc (' ', dumpfile);
    2297                 :          0 :       show_expr (c->ext.iterator->step);
    2298                 :            : 
    2299                 :          0 :       ++show_level;
    2300                 :          0 :       show_code (level + 1, c->block->next);
    2301                 :          0 :       --show_level;
    2302                 :            : 
    2303                 :          0 :       if (c->label1)
    2304                 :            :         break;
    2305                 :            : 
    2306                 :          0 :       show_indent ();
    2307                 :          0 :       fputs ("END DO", dumpfile);
    2308                 :          0 :       break;
    2309                 :            : 
    2310                 :          0 :     case EXEC_DO_CONCURRENT:
    2311                 :          0 :       fputs ("DO CONCURRENT ", dumpfile);
    2312                 :          0 :       for (fa = c->ext.forall_iterator; fa; fa = fa->next)
    2313                 :            :         {
    2314                 :          0 :           show_expr (fa->var);
    2315                 :          0 :           fputc (' ', dumpfile);
    2316                 :          0 :           show_expr (fa->start);
    2317                 :          0 :           fputc (':', dumpfile);
    2318                 :          0 :           show_expr (fa->end);
    2319                 :          0 :           fputc (':', dumpfile);
    2320                 :          0 :           show_expr (fa->stride);
    2321                 :            : 
    2322                 :          0 :           if (fa->next != NULL)
    2323                 :          0 :             fputc (',', dumpfile);
    2324                 :            :         }
    2325                 :          0 :       show_expr (c->expr1);
    2326                 :          0 :       ++show_level;
    2327                 :            : 
    2328                 :          0 :       show_code (level + 1, c->block->next);
    2329                 :          0 :       --show_level;
    2330                 :          0 :       code_indent (level, c->label1);
    2331                 :          0 :       show_indent ();
    2332                 :          0 :       fputs ("END DO", dumpfile);
    2333                 :          0 :       break;
    2334                 :            : 
    2335                 :          0 :     case EXEC_DO_WHILE:
    2336                 :          0 :       fputs ("DO WHILE ", dumpfile);
    2337                 :          0 :       show_expr (c->expr1);
    2338                 :          0 :       fputc ('\n', dumpfile);
    2339                 :            : 
    2340                 :          0 :       show_code (level + 1, c->block->next);
    2341                 :            : 
    2342                 :          0 :       code_indent (level, c->label1);
    2343                 :          0 :       fputs ("END DO", dumpfile);
    2344                 :          0 :       break;
    2345                 :            : 
    2346                 :          0 :     case EXEC_CYCLE:
    2347                 :          0 :       fputs ("CYCLE", dumpfile);
    2348                 :          0 :       if (c->symtree)
    2349                 :          0 :         fprintf (dumpfile, " %s", c->symtree->n.sym->name);
    2350                 :            :       break;
    2351                 :            : 
    2352                 :          0 :     case EXEC_EXIT:
    2353                 :          0 :       fputs ("EXIT", dumpfile);
    2354                 :          0 :       if (c->symtree)
    2355                 :          0 :         fprintf (dumpfile, " %s", c->symtree->n.sym->name);
    2356                 :            :       break;
    2357                 :            : 
    2358                 :         12 :     case EXEC_ALLOCATE:
    2359                 :         12 :       fputs ("ALLOCATE ", dumpfile);
    2360                 :         12 :       if (c->expr1)
    2361                 :            :         {
    2362                 :          0 :           fputs (" STAT=", dumpfile);
    2363                 :          0 :           show_expr (c->expr1);
    2364                 :            :         }
    2365                 :            : 
    2366                 :         12 :       if (c->expr2)
    2367                 :            :         {
    2368                 :          0 :           fputs (" ERRMSG=", dumpfile);
    2369                 :          0 :           show_expr (c->expr2);
    2370                 :            :         }
    2371                 :            : 
    2372                 :         12 :       if (c->expr3)
    2373                 :            :         {
    2374                 :         12 :           if (c->expr3->mold)
    2375                 :          0 :             fputs (" MOLD=", dumpfile);
    2376                 :            :           else
    2377                 :         12 :             fputs (" SOURCE=", dumpfile);
    2378                 :         12 :           show_expr (c->expr3);
    2379                 :            :         }
    2380                 :            : 
    2381                 :         24 :       for (a = c->ext.alloc.list; a; a = a->next)
    2382                 :            :         {
    2383                 :         12 :           fputc (' ', dumpfile);
    2384                 :         12 :           show_expr (a->expr);
    2385                 :            :         }
    2386                 :            : 
    2387                 :            :       break;
    2388                 :            : 
    2389                 :          0 :     case EXEC_DEALLOCATE:
    2390                 :          0 :       fputs ("DEALLOCATE ", dumpfile);
    2391                 :          0 :       if (c->expr1)
    2392                 :            :         {
    2393                 :          0 :           fputs (" STAT=", dumpfile);
    2394                 :          0 :           show_expr (c->expr1);
    2395                 :            :         }
    2396                 :            : 
    2397                 :          0 :       if (c->expr2)
    2398                 :            :         {
    2399                 :          0 :           fputs (" ERRMSG=", dumpfile);
    2400                 :          0 :           show_expr (c->expr2);
    2401                 :            :         }
    2402                 :            : 
    2403                 :          0 :       for (a = c->ext.alloc.list; a; a = a->next)
    2404                 :            :         {
    2405                 :          0 :           fputc (' ', dumpfile);
    2406                 :          0 :           show_expr (a->expr);
    2407                 :            :         }
    2408                 :            : 
    2409                 :            :       break;
    2410                 :            : 
    2411                 :          0 :     case EXEC_OPEN:
    2412                 :          0 :       fputs ("OPEN", dumpfile);
    2413                 :          0 :       open = c->ext.open;
    2414                 :            : 
    2415                 :          0 :       if (open->unit)
    2416                 :            :         {
    2417                 :          0 :           fputs (" UNIT=", dumpfile);
    2418                 :          0 :           show_expr (open->unit);
    2419                 :            :         }
    2420                 :          0 :       if (open->iomsg)
    2421                 :            :         {
    2422                 :          0 :           fputs (" IOMSG=", dumpfile);
    2423                 :          0 :           show_expr (open->iomsg);
    2424                 :            :         }
    2425                 :          0 :       if (open->iostat)
    2426                 :            :         {
    2427                 :          0 :           fputs (" IOSTAT=", dumpfile);
    2428                 :          0 :           show_expr (open->iostat);
    2429                 :            :         }
    2430                 :          0 :       if (open->file)
    2431                 :            :         {
    2432                 :          0 :           fputs (" FILE=", dumpfile);
    2433                 :          0 :           show_expr (open->file);
    2434                 :            :         }
    2435                 :          0 :       if (open->status)
    2436                 :            :         {
    2437                 :          0 :           fputs (" STATUS=", dumpfile);
    2438                 :          0 :           show_expr (open->status);
    2439                 :            :         }
    2440                 :          0 :       if (open->access)
    2441                 :            :         {
    2442                 :          0 :           fputs (" ACCESS=", dumpfile);
    2443                 :          0 :           show_expr (open->access);
    2444                 :            :         }
    2445                 :          0 :       if (open->form)
    2446                 :            :         {
    2447                 :          0 :           fputs (" FORM=", dumpfile);
    2448                 :          0 :           show_expr (open->form);
    2449                 :            :         }
    2450                 :          0 :       if (open->recl)
    2451                 :            :         {
    2452                 :          0 :           fputs (" RECL=", dumpfile);
    2453                 :          0 :           show_expr (open->recl);
    2454                 :            :         }
    2455                 :          0 :       if (open->blank)
    2456                 :            :         {
    2457                 :          0 :           fputs (" BLANK=", dumpfile);
    2458                 :          0 :           show_expr (open->blank);
    2459                 :            :         }
    2460                 :          0 :       if (open->position)
    2461                 :            :         {
    2462                 :          0 :           fputs (" POSITION=", dumpfile);
    2463                 :          0 :           show_expr (open->position);
    2464                 :            :         }
    2465                 :          0 :       if (open->action)
    2466                 :            :         {
    2467                 :          0 :           fputs (" ACTION=", dumpfile);
    2468                 :          0 :           show_expr (open->action);
    2469                 :            :         }
    2470                 :          0 :       if (open->delim)
    2471                 :            :         {
    2472                 :          0 :           fputs (" DELIM=", dumpfile);
    2473                 :          0 :           show_expr (open->delim);
    2474                 :            :         }
    2475                 :          0 :       if (open->pad)
    2476                 :            :         {
    2477                 :          0 :           fputs (" PAD=", dumpfile);
    2478                 :          0 :           show_expr (open->pad);
    2479                 :            :         }
    2480                 :          0 :       if (open->decimal)
    2481                 :            :         {
    2482                 :          0 :           fputs (" DECIMAL=", dumpfile);
    2483                 :          0 :           show_expr (open->decimal);
    2484                 :            :         }
    2485                 :          0 :       if (open->encoding)
    2486                 :            :         {
    2487                 :          0 :           fputs (" ENCODING=", dumpfile);
    2488                 :          0 :           show_expr (open->encoding);
    2489                 :            :         }
    2490                 :          0 :       if (open->round)
    2491                 :            :         {
    2492                 :          0 :           fputs (" ROUND=", dumpfile);
    2493                 :          0 :           show_expr (open->round);
    2494                 :            :         }
    2495                 :          0 :       if (open->sign)
    2496                 :            :         {
    2497                 :          0 :           fputs (" SIGN=", dumpfile);
    2498                 :          0 :           show_expr (open->sign);
    2499                 :            :         }
    2500                 :          0 :       if (open->convert)
    2501                 :            :         {
    2502                 :          0 :           fputs (" CONVERT=", dumpfile);
    2503                 :          0 :           show_expr (open->convert);
    2504                 :            :         }
    2505                 :          0 :       if (open->asynchronous)
    2506                 :            :         {
    2507                 :          0 :           fputs (" ASYNCHRONOUS=", dumpfile);
    2508                 :          0 :           show_expr (open->asynchronous);
    2509                 :            :         }
    2510                 :          0 :       if (open->err != NULL)
    2511                 :          0 :         fprintf (dumpfile, " ERR=%d", open->err->value);
    2512                 :            : 
    2513                 :            :       break;
    2514                 :            : 
    2515                 :          0 :     case EXEC_CLOSE:
    2516                 :          0 :       fputs ("CLOSE", dumpfile);
    2517                 :          0 :       close = c->ext.close;
    2518                 :            : 
    2519                 :          0 :       if (close->unit)
    2520                 :            :         {
    2521                 :          0 :           fputs (" UNIT=", dumpfile);
    2522                 :          0 :           show_expr (close->unit);
    2523                 :            :         }
    2524                 :          0 :       if (close->iomsg)
    2525                 :            :         {
    2526                 :          0 :           fputs (" IOMSG=", dumpfile);
    2527                 :          0 :           show_expr (close->iomsg);
    2528                 :            :         }
    2529                 :          0 :       if (close->iostat)
    2530                 :            :         {
    2531                 :          0 :           fputs (" IOSTAT=", dumpfile);
    2532                 :          0 :           show_expr (close->iostat);
    2533                 :            :         }
    2534                 :          0 :       if (close->status)
    2535                 :            :         {
    2536                 :          0 :           fputs (" STATUS=", dumpfile);
    2537                 :          0 :           show_expr (close->status);
    2538                 :            :         }
    2539                 :          0 :       if (close->err != NULL)
    2540                 :          0 :         fprintf (dumpfile, " ERR=%d", close->err->value);
    2541                 :            :       break;
    2542                 :            : 
    2543                 :          0 :     case EXEC_BACKSPACE:
    2544                 :          0 :       fputs ("BACKSPACE", dumpfile);
    2545                 :          0 :       goto show_filepos;
    2546                 :            : 
    2547                 :          0 :     case EXEC_ENDFILE:
    2548                 :          0 :       fputs ("ENDFILE", dumpfile);
    2549                 :          0 :       goto show_filepos;
    2550                 :            : 
    2551                 :          0 :     case EXEC_REWIND:
    2552                 :          0 :       fputs ("REWIND", dumpfile);
    2553                 :          0 :       goto show_filepos;
    2554                 :            : 
    2555                 :          0 :     case EXEC_FLUSH:
    2556                 :          0 :       fputs ("FLUSH", dumpfile);
    2557                 :            : 
    2558                 :          0 :     show_filepos:
    2559                 :          0 :       fp = c->ext.filepos;
    2560                 :            : 
    2561                 :          0 :       if (fp->unit)
    2562                 :            :         {
    2563                 :          0 :           fputs (" UNIT=", dumpfile);
    2564                 :          0 :           show_expr (fp->unit);
    2565                 :            :         }
    2566                 :          0 :       if (fp->iomsg)
    2567                 :            :         {
    2568                 :          0 :           fputs (" IOMSG=", dumpfile);
    2569                 :          0 :           show_expr (fp->iomsg);
    2570                 :            :         }
    2571                 :          0 :       if (fp->iostat)
    2572                 :            :         {
    2573                 :          0 :           fputs (" IOSTAT=", dumpfile);
    2574                 :          0 :           show_expr (fp->iostat);
    2575                 :            :         }
    2576                 :          0 :       if (fp->err != NULL)
    2577                 :          0 :         fprintf (dumpfile, " ERR=%d", fp->err->value);
    2578                 :            :       break;
    2579                 :            : 
    2580                 :          0 :     case EXEC_INQUIRE:
    2581                 :          0 :       fputs ("INQUIRE", dumpfile);
    2582                 :          0 :       i = c->ext.inquire;
    2583                 :            : 
    2584                 :          0 :       if (i->unit)
    2585                 :            :         {
    2586                 :          0 :           fputs (" UNIT=", dumpfile);
    2587                 :          0 :           show_expr (i->unit);
    2588                 :            :         }
    2589                 :          0 :       if (i->file)
    2590                 :            :         {
    2591                 :          0 :           fputs (" FILE=", dumpfile);
    2592                 :          0 :           show_expr (i->file);
    2593                 :            :         }
    2594                 :            : 
    2595                 :          0 :       if (i->iomsg)
    2596                 :            :         {
    2597                 :          0 :           fputs (" IOMSG=", dumpfile);
    2598                 :          0 :           show_expr (i->iomsg);
    2599                 :            :         }
    2600                 :          0 :       if (i->iostat)
    2601                 :            :         {
    2602                 :          0 :           fputs (" IOSTAT=", dumpfile);
    2603                 :          0 :           show_expr (i->iostat);
    2604                 :            :         }
    2605                 :          0 :       if (i->exist)
    2606                 :            :         {
    2607                 :          0 :           fputs (" EXIST=", dumpfile);
    2608                 :          0 :           show_expr (i->exist);
    2609                 :            :         }
    2610                 :          0 :       if (i->opened)
    2611                 :            :         {
    2612                 :          0 :           fputs (" OPENED=", dumpfile);
    2613                 :          0 :           show_expr (i->opened);
    2614                 :            :         }
    2615                 :          0 :       if (i->number)
    2616                 :            :         {
    2617                 :          0 :           fputs (" NUMBER=", dumpfile);
    2618                 :          0 :           show_expr (i->number);
    2619                 :            :         }
    2620                 :          0 :       if (i->named)
    2621                 :            :         {
    2622                 :          0 :           fputs (" NAMED=", dumpfile);
    2623                 :          0 :           show_expr (i->named);
    2624                 :            :         }
    2625                 :          0 :       if (i->name)
    2626                 :            :         {
    2627                 :          0 :           fputs (" NAME=", dumpfile);
    2628                 :          0 :           show_expr (i->name);
    2629                 :            :         }
    2630                 :          0 :       if (i->access)
    2631                 :            :         {
    2632                 :          0 :           fputs (" ACCESS=", dumpfile);
    2633                 :          0 :           show_expr (i->access);
    2634                 :            :         }
    2635                 :          0 :       if (i->sequential)
    2636                 :            :         {
    2637                 :          0 :           fputs (" SEQUENTIAL=", dumpfile);
    2638                 :          0 :           show_expr (i->sequential);
    2639                 :            :         }
    2640                 :            : 
    2641                 :          0 :       if (i->direct)
    2642                 :            :         {
    2643                 :          0 :           fputs (" DIRECT=", dumpfile);
    2644                 :          0 :           show_expr (i->direct);
    2645                 :            :         }
    2646                 :          0 :       if (i->form)
    2647                 :            :         {
    2648                 :          0 :           fputs (" FORM=", dumpfile);
    2649                 :          0 :           show_expr (i->form);
    2650                 :            :         }
    2651                 :          0 :       if (i->formatted)
    2652                 :            :         {
    2653                 :          0 :           fputs (" FORMATTED", dumpfile);
    2654                 :          0 :           show_expr (i->formatted);
    2655                 :            :         }
    2656                 :          0 :       if (i->unformatted)
    2657                 :            :         {
    2658                 :          0 :           fputs (" UNFORMATTED=", dumpfile);
    2659                 :          0 :           show_expr (i->unformatted);
    2660                 :            :         }
    2661                 :          0 :       if (i->recl)
    2662                 :            :         {
    2663                 :          0 :           fputs (" RECL=", dumpfile);
    2664                 :          0 :           show_expr (i->recl);
    2665                 :            :         }
    2666                 :          0 :       if (i->nextrec)
    2667                 :            :         {
    2668                 :          0 :           fputs (" NEXTREC=", dumpfile);
    2669                 :          0 :           show_expr (i->nextrec);
    2670                 :            :         }
    2671                 :          0 :       if (i->blank)
    2672                 :            :         {
    2673                 :          0 :           fputs (" BLANK=", dumpfile);
    2674                 :          0 :           show_expr (i->blank);
    2675                 :            :         }
    2676                 :          0 :       if (i->position)
    2677                 :            :         {
    2678                 :          0 :           fputs (" POSITION=", dumpfile);
    2679                 :          0 :           show_expr (i->position);
    2680                 :            :         }
    2681                 :          0 :       if (i->action)
    2682                 :            :         {
    2683                 :          0 :           fputs (" ACTION=", dumpfile);
    2684                 :          0 :           show_expr (i->action);
    2685                 :            :         }
    2686                 :          0 :       if (i->read)
    2687                 :            :         {
    2688                 :          0 :           fputs (" READ=", dumpfile);
    2689                 :          0 :           show_expr (i->read);
    2690                 :            :         }
    2691                 :          0 :       if (i->write)
    2692                 :            :         {
    2693                 :          0 :           fputs (" WRITE=", dumpfile);
    2694                 :          0 :           show_expr (i->write);
    2695                 :            :         }
    2696                 :          0 :       if (i->readwrite)
    2697                 :            :         {
    2698                 :          0 :           fputs (" READWRITE=", dumpfile);
    2699                 :          0 :           show_expr (i->readwrite);
    2700                 :            :         }
    2701                 :          0 :       if (i->delim)
    2702                 :            :         {
    2703                 :          0 :           fputs (" DELIM=", dumpfile);
    2704                 :          0 :           show_expr (i->delim);
    2705                 :            :         }
    2706                 :          0 :       if (i->pad)
    2707                 :            :         {
    2708                 :          0 :           fputs (" PAD=", dumpfile);
    2709                 :          0 :           show_expr (i->pad);
    2710                 :            :         }
    2711                 :          0 :       if (i->convert)
    2712                 :            :         {
    2713                 :          0 :           fputs (" CONVERT=", dumpfile);
    2714                 :          0 :           show_expr (i->convert);
    2715                 :            :         }
    2716                 :          0 :       if (i->asynchronous)
    2717                 :            :         {
    2718                 :          0 :           fputs (" ASYNCHRONOUS=", dumpfile);
    2719                 :          0 :           show_expr (i->asynchronous);
    2720                 :            :         }
    2721                 :          0 :       if (i->decimal)
    2722                 :            :         {
    2723                 :          0 :           fputs (" DECIMAL=", dumpfile);
    2724                 :          0 :           show_expr (i->decimal);
    2725                 :            :         }
    2726                 :          0 :       if (i->encoding)
    2727                 :            :         {
    2728                 :          0 :           fputs (" ENCODING=", dumpfile);
    2729                 :          0 :           show_expr (i->encoding);
    2730                 :            :         }
    2731                 :          0 :       if (i->pending)
    2732                 :            :         {
    2733                 :          0 :           fputs (" PENDING=", dumpfile);
    2734                 :          0 :           show_expr (i->pending);
    2735                 :            :         }
    2736                 :          0 :       if (i->round)
    2737                 :            :         {
    2738                 :          0 :           fputs (" ROUND=", dumpfile);
    2739                 :          0 :           show_expr (i->round);
    2740                 :            :         }
    2741                 :          0 :       if (i->sign)
    2742                 :            :         {
    2743                 :          0 :           fputs (" SIGN=", dumpfile);
    2744                 :          0 :           show_expr (i->sign);
    2745                 :            :         }
    2746                 :          0 :       if (i->size)
    2747                 :            :         {
    2748                 :          0 :           fputs (" SIZE=", dumpfile);
    2749                 :          0 :           show_expr (i->size);
    2750                 :            :         }
    2751                 :          0 :       if (i->id)
    2752                 :            :         {
    2753                 :          0 :           fputs (" ID=", dumpfile);
    2754                 :          0 :           show_expr (i->id);
    2755                 :            :         }
    2756                 :            : 
    2757                 :          0 :       if (i->err != NULL)
    2758                 :          0 :         fprintf (dumpfile, " ERR=%d", i->err->value);
    2759                 :            :       break;
    2760                 :            : 
    2761                 :          0 :     case EXEC_IOLENGTH:
    2762                 :          0 :       fputs ("IOLENGTH ", dumpfile);
    2763                 :          0 :       show_expr (c->expr1);
    2764                 :          0 :       goto show_dt_code;
    2765                 :          0 :       break;
    2766                 :            : 
    2767                 :          0 :     case EXEC_READ:
    2768                 :          0 :       fputs ("READ", dumpfile);
    2769                 :          0 :       goto show_dt;
    2770                 :            : 
    2771                 :         26 :     case EXEC_WRITE:
    2772                 :         26 :       fputs ("WRITE", dumpfile);
    2773                 :            : 
    2774                 :         26 :     show_dt:
    2775                 :         26 :       dt = c->ext.dt;
    2776                 :         26 :       if (dt->io_unit)
    2777                 :            :         {
    2778                 :         26 :           fputs (" UNIT=", dumpfile);
    2779                 :         26 :           show_expr (dt->io_unit);
    2780                 :            :         }
    2781                 :            : 
    2782                 :         26 :       if (dt->format_expr)
    2783                 :            :         {
    2784                 :          0 :           fputs (" FMT=", dumpfile);
    2785                 :          0 :           show_expr (dt->format_expr);
    2786                 :            :         }
    2787                 :            : 
    2788                 :         26 :       if (dt->format_label != NULL)
    2789                 :         26 :         fprintf (dumpfile, " FMT=%d", dt->format_label->value);
    2790                 :         26 :       if (dt->namelist)
    2791                 :          0 :         fprintf (dumpfile, " NML=%s", dt->namelist->name);
    2792                 :            : 
    2793                 :         26 :       if (dt->iomsg)
    2794                 :            :         {
    2795                 :          0 :           fputs (" IOMSG=", dumpfile);
    2796                 :          0 :           show_expr (dt->iomsg);
    2797                 :            :         }
    2798                 :         26 :       if (dt->iostat)
    2799                 :            :         {
    2800                 :          0 :           fputs (" IOSTAT=", dumpfile);
    2801                 :          0 :           show_expr (dt->iostat);
    2802                 :            :         }
    2803                 :         26 :       if (dt->size)
    2804                 :            :         {
    2805                 :          0 :           fputs (" SIZE=", dumpfile);
    2806                 :          0 :           show_expr (dt->size);
    2807                 :            :         }
    2808                 :         26 :       if (dt->rec)
    2809                 :            :         {
    2810                 :          0 :           fputs (" REC=", dumpfile);
    2811                 :          0 :           show_expr (dt->rec);
    2812                 :            :         }
    2813                 :         26 :       if (dt->advance)
    2814                 :            :         {
    2815                 :          0 :           fputs (" ADVANCE=", dumpfile);
    2816                 :          0 :           show_expr (dt->advance);
    2817                 :            :         }
    2818                 :         26 :       if (dt->id)
    2819                 :            :         {
    2820                 :          0 :           fputs (" ID=", dumpfile);
    2821                 :          0 :           show_expr (dt->id);
    2822                 :            :         }
    2823                 :         26 :       if (dt->pos)
    2824                 :            :         {
    2825                 :          0 :           fputs (" POS=", dumpfile);
    2826                 :          0 :           show_expr (dt->pos);
    2827                 :            :         }
    2828                 :         26 :       if (dt->asynchronous)
    2829                 :            :         {
    2830                 :          0 :           fputs (" ASYNCHRONOUS=", dumpfile);
    2831                 :          0 :           show_expr (dt->asynchronous);
    2832                 :            :         }
    2833                 :         26 :       if (dt->blank)
    2834                 :            :         {
    2835                 :          0 :           fputs (" BLANK=", dumpfile);
    2836                 :          0 :           show_expr (dt->blank);
    2837                 :            :         }
    2838                 :         26 :       if (dt->decimal)
    2839                 :            :         {
    2840                 :          0 :           fputs (" DECIMAL=", dumpfile);
    2841                 :          0 :           show_expr (dt->decimal);
    2842                 :            :         }
    2843                 :         26 :       if (dt->delim)
    2844                 :            :         {
    2845                 :          0 :           fputs (" DELIM=", dumpfile);
    2846                 :          0 :           show_expr (dt->delim);
    2847                 :            :         }
    2848                 :         26 :       if (dt->pad)
    2849                 :            :         {
    2850                 :          0 :           fputs (" PAD=", dumpfile);
    2851                 :          0 :           show_expr (dt->pad);
    2852                 :            :         }
    2853                 :         26 :       if (dt->round)
    2854                 :            :         {
    2855                 :          0 :           fputs (" ROUND=", dumpfile);
    2856                 :          0 :           show_expr (dt->round);
    2857                 :            :         }
    2858                 :         26 :       if (dt->sign)
    2859                 :            :         {
    2860                 :          0 :           fputs (" SIGN=", dumpfile);
    2861                 :          0 :           show_expr (dt->sign);
    2862                 :            :         }
    2863                 :            : 
    2864                 :         26 :     show_dt_code:
    2865                 :         78 :       for (c = c->block->next; c; c = c->next)
    2866                 :         52 :         show_code_node (level + (c->next != NULL), c);
    2867                 :            :       return;
    2868                 :            : 
    2869                 :         26 :     case EXEC_TRANSFER:
    2870                 :         26 :       fputs ("TRANSFER ", dumpfile);
    2871                 :         26 :       show_expr (c->expr1);
    2872                 :         26 :       break;
    2873                 :            : 
    2874                 :         26 :     case EXEC_DT_END:
    2875                 :         26 :       fputs ("DT_END", dumpfile);
    2876                 :         26 :       dt = c->ext.dt;
    2877                 :            : 
    2878                 :         26 :       if (dt->err != NULL)
    2879                 :          0 :         fprintf (dumpfile, " ERR=%d", dt->err->value);
    2880                 :         26 :       if (dt->end != NULL)
    2881                 :          0 :         fprintf (dumpfile, " END=%d", dt->end->value);
    2882                 :         26 :       if (dt->eor != NULL)
    2883                 :          0 :         fprintf (dumpfile, " EOR=%d", dt->eor->value);
    2884                 :            :       break;
    2885                 :            : 
    2886                 :          0 :     case EXEC_WAIT:
    2887                 :          0 :       fputs ("WAIT", dumpfile);
    2888                 :            : 
    2889                 :          0 :       if (c->ext.wait != NULL)
    2890                 :            :         {
    2891                 :          0 :           gfc_wait *wait = c->ext.wait;
    2892                 :          0 :           if (wait->unit)
    2893                 :            :             {
    2894                 :          0 :               fputs (" UNIT=", dumpfile);
    2895                 :          0 :               show_expr (wait->unit);
    2896                 :            :             }
    2897                 :          0 :           if (wait->iostat)
    2898                 :            :             {
    2899                 :          0 :               fputs (" IOSTAT=", dumpfile);
    2900                 :          0 :               show_expr (wait->iostat);
    2901                 :            :             }
    2902                 :          0 :           if (wait->iomsg)
    2903                 :            :             {
    2904                 :          0 :               fputs (" IOMSG=", dumpfile);
    2905                 :          0 :               show_expr (wait->iomsg);
    2906                 :            :             }
    2907                 :          0 :           if (wait->id)
    2908                 :            :             {
    2909                 :          0 :               fputs (" ID=", dumpfile);
    2910                 :          0 :               show_expr (wait->id);
    2911                 :            :             }
    2912                 :          0 :           if (wait->err)
    2913                 :          0 :             fprintf (dumpfile, " ERR=%d", wait->err->value);
    2914                 :          0 :           if (wait->end)
    2915                 :          0 :             fprintf (dumpfile, " END=%d", wait->end->value);
    2916                 :          0 :           if (wait->eor)
    2917                 :          0 :             fprintf (dumpfile, " EOR=%d", wait->eor->value);
    2918                 :            :         }
    2919                 :            :       break;
    2920                 :            : 
    2921                 :          0 :     case EXEC_OACC_PARALLEL_LOOP:
    2922                 :          0 :     case EXEC_OACC_PARALLEL:
    2923                 :          0 :     case EXEC_OACC_KERNELS_LOOP:
    2924                 :          0 :     case EXEC_OACC_KERNELS:
    2925                 :          0 :     case EXEC_OACC_SERIAL_LOOP:
    2926                 :          0 :     case EXEC_OACC_SERIAL:
    2927                 :          0 :     case EXEC_OACC_DATA:
    2928                 :          0 :     case EXEC_OACC_HOST_DATA:
    2929                 :          0 :     case EXEC_OACC_LOOP:
    2930                 :          0 :     case EXEC_OACC_UPDATE:
    2931                 :          0 :     case EXEC_OACC_WAIT:
    2932                 :          0 :     case EXEC_OACC_CACHE:
    2933                 :          0 :     case EXEC_OACC_ENTER_DATA:
    2934                 :          0 :     case EXEC_OACC_EXIT_DATA:
    2935                 :          0 :     case EXEC_OMP_ATOMIC:
    2936                 :          0 :     case EXEC_OMP_CANCEL:
    2937                 :          0 :     case EXEC_OMP_CANCELLATION_POINT:
    2938                 :          0 :     case EXEC_OMP_BARRIER:
    2939                 :          0 :     case EXEC_OMP_CRITICAL:
    2940                 :          0 :     case EXEC_OMP_DISTRIBUTE:
    2941                 :          0 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
    2942                 :          0 :     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
    2943                 :          0 :     case EXEC_OMP_DISTRIBUTE_SIMD:
    2944                 :          0 :     case EXEC_OMP_DO:
    2945                 :          0 :     case EXEC_OMP_DO_SIMD:
    2946                 :          0 :     case EXEC_OMP_FLUSH:
    2947                 :          0 :     case EXEC_OMP_MASTER:
    2948                 :          0 :     case EXEC_OMP_ORDERED:
    2949                 :          0 :     case EXEC_OMP_PARALLEL:
    2950                 :          0 :     case EXEC_OMP_PARALLEL_DO:
    2951                 :          0 :     case EXEC_OMP_PARALLEL_DO_SIMD:
    2952                 :          0 :     case EXEC_OMP_PARALLEL_SECTIONS:
    2953                 :          0 :     case EXEC_OMP_PARALLEL_WORKSHARE:
    2954                 :          0 :     case EXEC_OMP_SECTIONS:
    2955                 :          0 :     case EXEC_OMP_SIMD:
    2956                 :          0 :     case EXEC_OMP_SINGLE:
    2957                 :          0 :     case EXEC_OMP_TARGET:
    2958                 :          0 :     case EXEC_OMP_TARGET_DATA:
    2959                 :          0 :     case EXEC_OMP_TARGET_ENTER_DATA:
    2960                 :          0 :     case EXEC_OMP_TARGET_EXIT_DATA:
    2961                 :          0 :     case EXEC_OMP_TARGET_PARALLEL:
    2962                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO:
    2963                 :          0 :     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
    2964                 :          0 :     case EXEC_OMP_TARGET_SIMD:
    2965                 :          0 :     case EXEC_OMP_TARGET_TEAMS:
    2966                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
    2967                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
    2968                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    2969                 :          0 :     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
    2970                 :          0 :     case EXEC_OMP_TARGET_UPDATE:
    2971                 :          0 :     case EXEC_OMP_TASK:
    2972                 :          0 :     case EXEC_OMP_TASKGROUP:
    2973                 :          0 :     case EXEC_OMP_TASKLOOP:
    2974                 :          0 :     case EXEC_OMP_TASKLOOP_SIMD:
    2975                 :          0 :     case EXEC_OMP_TASKWAIT:
    2976                 :          0 :     case EXEC_OMP_TASKYIELD:
    2977                 :          0 :     case EXEC_OMP_TEAMS:
    2978                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE:
    2979                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
    2980                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
    2981                 :          0 :     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
    2982                 :          0 :     case EXEC_OMP_WORKSHARE:
    2983                 :          0 :       show_omp_node (level, c);
    2984                 :          0 :       break;
    2985                 :            : 
    2986                 :          0 :     default:
    2987                 :          0 :       gfc_internal_error ("show_code_node(): Bad statement code");
    2988                 :            :     }
    2989                 :            : }
    2990                 :            : 
    2991                 :            : 
    2992                 :            : /* Show an equivalence chain.  */
    2993                 :            : 
    2994                 :            : static void
    2995                 :          0 : show_equiv (gfc_equiv *eq)
    2996                 :            : {
    2997                 :          0 :   show_indent ();
    2998                 :          0 :   fputs ("Equivalence: ", dumpfile);
    2999                 :          0 :   while (eq)
    3000                 :            :     {
    3001                 :          0 :       show_expr (eq->expr);
    3002                 :          0 :       eq = eq->eq;
    3003                 :          0 :       if (eq)
    3004                 :          0 :         fputs (", ", dumpfile);
    3005                 :            :     }
    3006                 :          0 : }
    3007                 :            : 
    3008                 :            : 
    3009                 :            : /* Show a freakin' whole namespace.  */
    3010                 :            : 
    3011                 :            : static void
    3012                 :         44 : show_namespace (gfc_namespace *ns)
    3013                 :            : {
    3014                 :         44 :   gfc_interface *intr;
    3015                 :         44 :   gfc_namespace *save;
    3016                 :         44 :   int op;
    3017                 :         44 :   gfc_equiv *eq;
    3018                 :         44 :   int i;
    3019                 :            : 
    3020                 :         44 :   gcc_assert (ns);
    3021                 :         44 :   save = gfc_current_ns;
    3022                 :            : 
    3023                 :         44 :   show_indent ();
    3024                 :         44 :   fputs ("Namespace:", dumpfile);
    3025                 :            : 
    3026                 :         44 :   i = 0;
    3027                 :         80 :   do
    3028                 :            :     {
    3029                 :         80 :       int l = i;
    3030                 :       1144 :       while (i < GFC_LETTERS - 1
    3031                 :       1144 :              && gfc_compare_types (&ns->default_type[i+1],
    3032                 :            :                                    &ns->default_type[l]))
    3033                 :            :         i++;
    3034                 :            : 
    3035                 :         80 :       if (i > l)
    3036                 :         74 :         fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
    3037                 :            :       else
    3038                 :          6 :         fprintf (dumpfile, " %c: ", l+'A');
    3039                 :            : 
    3040                 :         80 :       show_typespec(&ns->default_type[l]);
    3041                 :         80 :       i++;
    3042                 :         80 :     } while (i < GFC_LETTERS);
    3043                 :            : 
    3044                 :         44 :   if (ns->proc_name != NULL)
    3045                 :            :     {
    3046                 :         44 :       show_indent ();
    3047                 :         44 :       fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
    3048                 :            :     }
    3049                 :            : 
    3050                 :         44 :   ++show_level;
    3051                 :         44 :   gfc_current_ns = ns;
    3052                 :         44 :   gfc_traverse_symtree (ns->common_root, show_common);
    3053                 :            : 
    3054                 :         44 :   gfc_traverse_symtree (ns->sym_root, show_symtree);
    3055                 :            : 
    3056                 :       1276 :   for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
    3057                 :            :     {
    3058                 :            :       /* User operator interfaces */
    3059                 :       1232 :       intr = ns->op[op];
    3060                 :       1232 :       if (intr == NULL)
    3061                 :       1232 :         continue;
    3062                 :            : 
    3063                 :          0 :       show_indent ();
    3064                 :          0 :       fprintf (dumpfile, "Operator interfaces for %s:",
    3065                 :            :                gfc_op2string ((gfc_intrinsic_op) op));
    3066                 :            : 
    3067                 :          0 :       for (; intr; intr = intr->next)
    3068                 :          0 :         fprintf (dumpfile, " %s", intr->sym->name);
    3069                 :            :     }
    3070                 :            : 
    3071                 :         44 :   if (ns->uop_root != NULL)
    3072                 :            :     {
    3073                 :          0 :       show_indent ();
    3074                 :          0 :       fputs ("User operators:\n", dumpfile);
    3075                 :          0 :       gfc_traverse_user_op (ns, show_uop);
    3076                 :            :     }
    3077                 :            : 
    3078                 :         44 :   for (eq = ns->equiv; eq; eq = eq->next)
    3079                 :          0 :     show_equiv (eq);
    3080                 :            : 
    3081                 :         44 :   if (ns->oacc_declare)
    3082                 :            :     {
    3083                 :            :       struct gfc_oacc_declare *decl;
    3084                 :            :       /* Dump !$ACC DECLARE clauses.  */
    3085                 :          0 :       for (decl = ns->oacc_declare; decl; decl = decl->next)
    3086                 :            :         {
    3087                 :          0 :           show_indent ();
    3088                 :          0 :           fprintf (dumpfile, "!$ACC DECLARE");
    3089                 :          0 :           show_omp_clauses (decl->clauses);
    3090                 :            :         }
    3091                 :            :     }
    3092                 :            : 
    3093                 :         44 :   fputc ('\n', dumpfile);
    3094                 :         44 :   show_indent ();
    3095                 :         44 :   fputs ("code:", dumpfile);
    3096                 :         44 :   show_code (show_level, ns->code);
    3097                 :         44 :   --show_level;
    3098                 :            : 
    3099                 :         56 :   for (ns = ns->contained; ns; ns = ns->sibling)
    3100                 :            :     {
    3101                 :         12 :       fputs ("\nCONTAINS\n", dumpfile);
    3102                 :         12 :       ++show_level;
    3103                 :         12 :       show_namespace (ns);
    3104                 :         12 :       --show_level;
    3105                 :            :     }
    3106                 :            : 
    3107                 :         44 :   fputc ('\n', dumpfile);
    3108                 :         44 :   gfc_current_ns = save;
    3109                 :         44 : }
    3110                 :            : 
    3111                 :            : 
    3112                 :            : /* Main function for dumping a parse tree.  */
    3113                 :            : 
    3114                 :            : void
    3115                 :         32 : gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
    3116                 :            : {
    3117                 :         32 :   dumpfile = file;
    3118                 :         32 :   show_namespace (ns);
    3119                 :         32 : }
    3120                 :            : 
    3121                 :            : /* This part writes BIND(C) definition for use in external C programs.  */
    3122                 :            : 
    3123                 :            : static void write_interop_decl (gfc_symbol *);
    3124                 :            : static void write_proc (gfc_symbol *, bool);
    3125                 :            : 
    3126                 :            : void
    3127                 :          0 : gfc_dump_c_prototypes (gfc_namespace *ns, FILE *file)
    3128                 :            : {
    3129                 :          0 :   int error_count;
    3130                 :          0 :   gfc_get_errors (NULL, &error_count);
    3131                 :          0 :   if (error_count != 0)
    3132                 :          0 :     return;
    3133                 :          0 :   dumpfile = file;
    3134                 :          0 :   gfc_traverse_ns (ns, write_interop_decl);
    3135                 :            : }
    3136                 :            : 
    3137                 :            : /* Loop over all global symbols, writing out their declrations.  */
    3138                 :            : 
    3139                 :            : void
    3140                 :          0 : gfc_dump_external_c_prototypes (FILE * file)
    3141                 :            : {
    3142                 :          0 :   dumpfile = file;
    3143                 :          0 :   fprintf (dumpfile,
    3144                 :          0 :            _("/* Prototypes for external procedures generated from %s\n"
    3145                 :            :              "   by GNU Fortran %s%s.\n\n"
    3146                 :            :              "   Use of this interface is discouraged, consider using the\n"
    3147                 :            :              "   BIND(C) feature of standard Fortran instead.  */\n\n"),
    3148                 :            :            gfc_source_file, pkgversion_string, version_string);
    3149                 :            : 
    3150                 :          0 :   for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
    3151                 :          0 :        gfc_current_ns = gfc_current_ns->sibling)
    3152                 :            :     {
    3153                 :          0 :       gfc_symbol *sym = gfc_current_ns->proc_name;
    3154                 :            : 
    3155                 :          0 :       if (sym == NULL || sym->attr.flavor != FL_PROCEDURE
    3156                 :          0 :           || sym->attr.is_bind_c)
    3157                 :          0 :         continue;
    3158                 :            : 
    3159                 :          0 :       write_proc (sym, false);
    3160                 :            :     }
    3161                 :          0 :   return;
    3162                 :            : }
    3163                 :            : 
    3164                 :            : enum type_return { T_OK=0, T_WARN, T_ERROR };
    3165                 :            : 
    3166                 :            : /* Return the name of the type for later output.  Both function pointers and
    3167                 :            :    void pointers will be mapped to void *.  */
    3168                 :            : 
    3169                 :            : static enum type_return
    3170                 :          0 : get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre,
    3171                 :            :                  const char **type_name, bool *asterisk, const char **post,
    3172                 :            :                  bool func_ret)
    3173                 :            : {
    3174                 :          0 :   static char post_buffer[40];
    3175                 :          0 :   enum type_return ret;
    3176                 :          0 :   ret = T_ERROR;
    3177                 :            : 
    3178                 :          0 :   *pre = " ";
    3179                 :          0 :   *asterisk = false;
    3180                 :          0 :   *post = "";
    3181                 :          0 :   *type_name = "<error>";
    3182                 :          0 :   if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX)
    3183                 :            :     {
    3184                 :          0 :       if (ts->is_c_interop && ts->interop_kind)
    3185                 :            :         {
    3186                 :          0 :           *type_name = ts->interop_kind->name + 2;
    3187                 :          0 :           if (strcmp (*type_name, "signed_char") == 0)
    3188                 :          0 :             *type_name = "signed char";
    3189                 :          0 :           else if (strcmp (*type_name, "size_t") == 0)
    3190                 :          0 :             *type_name = "ssize_t";
    3191                 :          0 :           else if (strcmp (*type_name, "float_complex") == 0)
    3192                 :          0 :             *type_name = "__GFORTRAN_FLOAT_COMPLEX";
    3193                 :          0 :           else if (strcmp (*type_name, "double_complex") == 0)
    3194                 :          0 :             *type_name = "__GFORTRAN_DOUBLE_COMPLEX";
    3195                 :          0 :           else if (strcmp (*type_name, "long_double_complex") == 0)
    3196                 :          0 :             *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
    3197                 :            : 
    3198                 :            :           ret = T_OK;
    3199                 :            :         }
    3200                 :            :       else
    3201                 :            :         {
    3202                 :            :           /* The user did not specify a C interop type.  Let's look through
    3203                 :            :              the available table and use the first one, but warn.  */
    3204                 :          0 :           for (int i = 0; i < ISOCBINDING_NUMBER; i++)
    3205                 :            :             {
    3206                 :          0 :               if (c_interop_kinds_table[i].f90_type == ts->type
    3207                 :          0 :                   && c_interop_kinds_table[i].value == ts->kind)
    3208                 :            :                 {
    3209                 :          0 :                   *type_name = c_interop_kinds_table[i].name + 2;
    3210                 :          0 :                   if (strcmp (*type_name, "signed_char") == 0)
    3211                 :          0 :                     *type_name = "signed char";
    3212                 :          0 :                   else if (strcmp (*type_name, "size_t") == 0)
    3213                 :          0 :                     *type_name = "ssize_t";
    3214                 :          0 :                   else if (strcmp (*type_name, "float_complex") == 0)
    3215                 :          0 :                     *type_name = "__GFORTRAN_FLOAT_COMPLEX";
    3216                 :          0 :                   else if (strcmp (*type_name, "double_complex") == 0)
    3217                 :          0 :                     *type_name = "__GFORTRAN_DOUBLE_COMPLEX";
    3218                 :          0 :                   else if (strcmp (*type_name, "long_double_complex") == 0)
    3219                 :          0 :                     *type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
    3220                 :            : 
    3221                 :            :                   ret = T_WARN;
    3222                 :            :                   break;
    3223                 :            :                 }
    3224                 :            :             }
    3225                 :            :         }
    3226                 :            :     }
    3227                 :          0 :   else if (ts->type == BT_LOGICAL)
    3228                 :            :     {
    3229                 :          0 :       if (ts->is_c_interop && ts->interop_kind)
    3230                 :            :         {
    3231                 :          0 :           *type_name = "_Bool";
    3232                 :          0 :           ret = T_OK;
    3233                 :            :         }
    3234                 :            :       else
    3235                 :            :         {
    3236                 :            :           /* Let's select an appropriate int, with a warning. */
    3237                 :          0 :           for (int i = 0; i < ISOCBINDING_NUMBER; i++)
    3238                 :            :             {
    3239                 :          0 :               if (c_interop_kinds_table[i].f90_type == BT_INTEGER
    3240                 :          0 :                   && c_interop_kinds_table[i].value == ts->kind)
    3241                 :            :                 {
    3242                 :          0 :                   *type_name = c_interop_kinds_table[i].name + 2;
    3243                 :          0 :                   ret = T_WARN;
    3244                 :            :                 }
    3245                 :            :             }
    3246                 :            :         }
    3247                 :            :     }
    3248                 :          0 :   else if (ts->type == BT_CHARACTER)
    3249                 :            :     {
    3250                 :          0 :       if (ts->is_c_interop)
    3251                 :            :         {
    3252                 :          0 :           *type_name = "char";
    3253                 :          0 :           ret = T_OK;
    3254                 :            :         }
    3255                 :            :       else
    3256                 :            :         {
    3257                 :          0 :           if (ts->kind == gfc_default_character_kind)
    3258                 :          0 :             *type_name = "char";
    3259                 :            :           else
    3260                 :            :             /* Let's select an appropriate int. */
    3261                 :          0 :             for (int i = 0; i < ISOCBINDING_NUMBER; i++)
    3262                 :            :               {
    3263                 :          0 :                 if (c_interop_kinds_table[i].f90_type == BT_INTEGER
    3264                 :          0 :                     && c_interop_kinds_table[i].value == ts->kind)
    3265                 :            :                   {
    3266                 :          0 :                     *type_name = c_interop_kinds_table[i].name + 2;
    3267                 :          0 :                     break;
    3268                 :            :                   }
    3269                 :            :             }
    3270                 :            :           ret = T_WARN;
    3271                 :            : 
    3272                 :            :         }
    3273                 :            :     }
    3274                 :          0 :   else if (ts->type == BT_DERIVED)
    3275                 :            :     {
    3276                 :          0 :       if (ts->u.derived->from_intmod == INTMOD_ISO_C_BINDING)
    3277                 :            :         {
    3278                 :          0 :           if (strcmp (ts->u.derived->name, "c_ptr") == 0)
    3279                 :          0 :             *type_name = "void";
    3280                 :          0 :           else if (strcmp (ts->u.derived->name, "c_funptr") == 0)
    3281                 :            :             {
    3282                 :          0 :               *type_name = "int ";
    3283                 :          0 :               if (func_ret)
    3284                 :            :                 {
    3285                 :          0 :                   *pre = "(";
    3286                 :          0 :                   *post = "())";
    3287                 :            :                 }
    3288                 :            :               else
    3289                 :            :                 {
    3290                 :          0 :                   *pre = "(";
    3291                 :          0 :                   *post = ")()";
    3292                 :            :                 }
    3293                 :            :             }
    3294                 :          0 :           *asterisk = true;
    3295                 :          0 :           ret = T_OK;
    3296                 :            :         }
    3297                 :            :       else
    3298                 :          0 :         *type_name = ts->u.derived->name;
    3299                 :            : 
    3300                 :            :       ret = T_OK;
    3301                 :            :     }
    3302                 :            : 
    3303                 :          0 :   if (ret != T_ERROR && as)
    3304                 :            :     {
    3305                 :          0 :       mpz_t sz;
    3306                 :          0 :       bool size_ok;
    3307                 :          0 :       size_ok = spec_size (as, &sz);
    3308                 :          0 :       gcc_assert (size_ok == true);
    3309                 :          0 :       gmp_snprintf (post_buffer, sizeof(post_buffer), "[%Zd]", sz);
    3310                 :          0 :       *post = post_buffer;
    3311                 :          0 :       mpz_clear (sz);
    3312                 :            :     }
    3313                 :          0 :   return ret;
    3314                 :            : }
    3315                 :            : 
    3316                 :            : /* Write out a declaration.  */
    3317                 :            : static void
    3318                 :          0 : write_decl (gfc_typespec *ts, gfc_array_spec *as, const char *sym_name,
    3319                 :            :             bool func_ret, locus *where, bool bind_c)
    3320                 :            : {
    3321                 :          0 :   const char *pre, *type_name, *post;
    3322                 :          0 :   bool asterisk;
    3323                 :          0 :   enum type_return rok;
    3324                 :            : 
    3325                 :          0 :   rok = get_c_type_name (ts, as, &pre, &type_name, &asterisk, &post, func_ret);
    3326                 :          0 :   if (rok == T_ERROR)
    3327                 :            :     {
    3328                 :          0 :       gfc_error_now ("Cannot convert %qs to interoperable type at %L",
    3329                 :            :                      gfc_typename (ts), where);
    3330                 :          0 :       fprintf (dumpfile, "/* Cannot convert '%s' to interoperable type */",
    3331                 :            :                gfc_typename (ts));
    3332                 :          0 :       return;
    3333                 :            :     }
    3334                 :          0 :   fputs (type_name, dumpfile);
    3335                 :          0 :   fputs (pre, dumpfile);
    3336                 :          0 :   if (asterisk)
    3337                 :          0 :     fputs ("*", dumpfile);
    3338                 :            : 
    3339                 :          0 :   fputs (sym_name, dumpfile);
    3340                 :          0 :   fputs (post, dumpfile);
    3341                 :            : 
    3342                 :          0 :   if (rok == T_WARN && bind_c)
    3343                 :          0 :     fprintf (dumpfile," /* WARNING: Converting '%s' to interoperable type */",
    3344                 :            :              gfc_typename (ts));
    3345                 :            : }
    3346                 :            : 
    3347                 :            : /* Write out an interoperable type.  It will be written as a typedef
    3348                 :            :    for a struct.  */
    3349                 :            : 
    3350                 :            : static void
    3351                 :          0 : write_type (gfc_symbol *sym)
    3352                 :            : {
    3353                 :          0 :   gfc_component *c;
    3354                 :            : 
    3355                 :          0 :   fprintf (dumpfile, "typedef struct %s {\n", sym->name);
    3356                 :          0 :   for (c = sym->components; c; c = c->next)
    3357                 :            :     {
    3358                 :          0 :       fputs ("    ", dumpfile);
    3359                 :          0 :       write_decl (&(c->ts), c->as, c->name, false, &sym->declared_at, true);
    3360                 :          0 :       fputs (";\n", dumpfile);
    3361                 :            :     }
    3362                 :            : 
    3363                 :          0 :   fprintf (dumpfile, "} %s;\n", sym->name);
    3364                 :          0 : }
    3365                 :            : 
    3366                 :            : /* Write out a variable.  */
    3367                 :            : 
    3368                 :            : static void
    3369                 :          0 : write_variable (gfc_symbol *sym)
    3370                 :            : {
    3371                 :          0 :   const char *sym_name;
    3372                 :            : 
    3373                 :          0 :   gcc_assert (sym->attr.flavor == FL_VARIABLE);
    3374                 :            : 
    3375                 :          0 :   if (sym->binding_label)
    3376                 :            :     sym_name = sym->binding_label;
    3377                 :            :   else
    3378                 :          0 :     sym_name = sym->name;
    3379                 :            : 
    3380                 :          0 :   fputs ("extern ", dumpfile);
    3381                 :          0 :   write_decl (&(sym->ts), sym->as, sym_name, false, &sym->declared_at, true);
    3382                 :          0 :   fputs (";\n", dumpfile);
    3383                 :          0 : }
    3384                 :            : 
    3385                 :            : 
    3386                 :            : /* Write out a procedure, including its arguments.  */
    3387                 :            : static void
    3388                 :          0 : write_proc (gfc_symbol *sym, bool bind_c)
    3389                 :            : {
    3390                 :          0 :   const char *pre, *type_name, *post;
    3391                 :          0 :   bool asterisk;
    3392                 :          0 :   enum type_return rok;
    3393                 :          0 :   gfc_formal_arglist *f;
    3394                 :          0 :   const char *sym_name;
    3395                 :          0 :   const char *intent_in;
    3396                 :          0 :   bool external_character;
    3397                 :            : 
    3398                 :          0 :   external_character =  sym->ts.type == BT_CHARACTER && !bind_c;
    3399                 :            : 
    3400                 :          0 :   if (sym->binding_label)
    3401                 :            :     sym_name = sym->binding_label;
    3402                 :            :   else
    3403                 :          0 :     sym_name = sym->name;
    3404                 :            : 
    3405                 :          0 :   if (sym->ts.type == BT_UNKNOWN || external_character)
    3406                 :            :     {
    3407                 :          0 :       fprintf (dumpfile, "void ");
    3408                 :          0 :       fputs (sym_name, dumpfile);
    3409                 :            :     }
    3410                 :            :   else
    3411                 :          0 :     write_decl (&(sym->ts), sym->as, sym_name, true, &sym->declared_at, bind_c);
    3412                 :            : 
    3413                 :          0 :   if (!bind_c)
    3414                 :          0 :     fputs ("_", dumpfile);
    3415                 :            : 
    3416                 :          0 :   fputs (" (", dumpfile);
    3417                 :          0 :   if (external_character)
    3418                 :            :     {
    3419                 :          0 :       fprintf (dumpfile, "char *result_%s, size_t result_%s_len",
    3420                 :            :                sym_name, sym_name);
    3421                 :          0 :       if (sym->formal)
    3422                 :          0 :         fputs (", ", dumpfile);
    3423                 :            :     }
    3424                 :            :       
    3425                 :          0 :   for (f = sym->formal; f; f = f->next)
    3426                 :            :     {
    3427                 :          0 :       gfc_symbol *s;
    3428                 :          0 :       s = f->sym;
    3429                 :          0 :       rok = get_c_type_name (&(s->ts), NULL, &pre, &type_name, &asterisk,
    3430                 :            :                              &post, false);
    3431                 :          0 :       if (rok == T_ERROR)
    3432                 :            :         {
    3433                 :          0 :           gfc_error_now ("Cannot convert %qs to interoperable type at %L",
    3434                 :            :                          gfc_typename (&s->ts), &s->declared_at);
    3435                 :          0 :           fprintf (dumpfile, "/* Cannot convert '%s' to interoperable type */",
    3436                 :            :                    gfc_typename (&s->ts));
    3437                 :          0 :           return;
    3438                 :            :         }
    3439                 :            : 
    3440                 :          0 :       if (!s->attr.value)
    3441                 :          0 :         asterisk = true;
    3442                 :            : 
    3443                 :          0 :       if (s->attr.intent == INTENT_IN && !s->attr.value)
    3444                 :            :         intent_in = "const ";
    3445                 :            :       else
    3446                 :          0 :         intent_in = "";
    3447                 :            : 
    3448                 :          0 :       fputs (intent_in, dumpfile);
    3449                 :          0 :       fputs (type_name, dumpfile);
    3450                 :          0 :       fputs (pre, dumpfile);
    3451                 :          0 :       if (asterisk)
    3452                 :          0 :         fputs ("*", dumpfile);
    3453                 :            : 
    3454                 :          0 :       fputs (s->name, dumpfile);
    3455                 :          0 :       fputs (post, dumpfile);
    3456                 :          0 :       if (bind_c && rok == T_WARN)
    3457                 :          0 :         fputs(" /* WARNING: non-interoperable KIND */ ", dumpfile);
    3458                 :            : 
    3459                 :          0 :       if (f->next)
    3460                 :          0 :         fputs(", ", dumpfile);
    3461                 :            :     }
    3462                 :          0 :   if (!bind_c)
    3463                 :          0 :     for (f = sym->formal; f; f = f->next)
    3464                 :          0 :       if (f->sym->ts.type == BT_CHARACTER)
    3465                 :          0 :         fprintf (dumpfile, ", size_t %s_len", f->sym->name);
    3466                 :            : 
    3467                 :          0 :   fputs (");\n", dumpfile);
    3468                 :            : }
    3469                 :            : 
    3470                 :            : 
    3471                 :            : /* Write a C-interoperable declaration as a C prototype or extern
    3472                 :            :    declaration.  */
    3473                 :            : 
    3474                 :            : static void
    3475                 :          0 : write_interop_decl (gfc_symbol *sym)
    3476                 :            : {
    3477                 :            :   /* Only dump bind(c) entities.  */
    3478                 :          0 :   if (!sym->attr.is_bind_c)
    3479                 :            :     return;
    3480                 :            : 
    3481                 :            :   /* Don't dump our iso c module.  */
    3482                 :          0 :   if (sym->from_intmod == INTMOD_ISO_C_BINDING)
    3483                 :            :     return;
    3484                 :            : 
    3485                 :          0 :   if (sym->attr.flavor == FL_VARIABLE)
    3486                 :          0 :     write_variable (sym);
    3487                 :          0 :   else if (sym->attr.flavor == FL_DERIVED)
    3488                 :          0 :     write_type (sym);
    3489                 :          0 :   else if (sym->attr.flavor == FL_PROCEDURE)
    3490                 :          0 :     write_proc (sym, true);
    3491                 :            : }
    3492                 :            : 
    3493                 :            : /* This section deals with dumping the global symbol tree.  */
    3494                 :            : 
    3495                 :            : /* Callback function for printing out the contents of the tree.  */
    3496                 :            : 
    3497                 :            : static void
    3498                 :          0 : show_global_symbol (gfc_gsymbol *gsym, void *f_data)
    3499                 :            : {
    3500                 :          0 :   FILE *out;
    3501                 :          0 :   out = (FILE *) f_data;
    3502                 :            : 
    3503                 :          0 :   if (gsym->name)
    3504                 :          0 :     fprintf (out, "name=%s", gsym->name);
    3505                 :            : 
    3506                 :          0 :   if (gsym->sym_name)
    3507                 :          0 :     fprintf (out, ", sym_name=%s", gsym->sym_name);
    3508                 :            : 
    3509                 :          0 :   if (gsym->mod_name)
    3510                 :          0 :     fprintf (out, ", mod_name=%s", gsym->mod_name);
    3511                 :            : 
    3512                 :          0 :   if (gsym->binding_label)
    3513                 :          0 :     fprintf (out, ", binding_label=%s", gsym->binding_label);
    3514                 :            : 
    3515                 :          0 :   fputc ('\n', out);
    3516                 :          0 : }
    3517                 :            : 
    3518                 :            : /* Show all global symbols.  */
    3519                 :            : 
    3520                 :            : void
    3521                 :          0 : gfc_dump_global_symbols (FILE *f)
    3522                 :            : {
    3523                 :          0 :   gfc_traverse_gsymbol (gfc_gsym_root, show_global_symbol, (void *) f);
    3524                 :          0 : }

Generated by: LCOV version 1.0

LCOV profile is generated on x86_64 machine using following configure options: configure --disable-bootstrap --enable-coverage=opt --enable-languages=c,c++,fortran,go,jit,lto --enable-host-shared. GCC test suite is run with the built compiler.