コード例 #1
0
void
gfc_show_namespace (gfc_namespace * ns)
{
  gfc_interface *intr;
  gfc_namespace *save;
  gfc_intrinsic_op op;
  gfc_equiv *eq;
  int i;

  save = gfc_current_ns;
  show_level++;

  show_indent ();
  gfc_status ("Namespace:");

  if (ns != NULL)
    {
      i = 0;
      do
	{
	  int l = i;
	  while (i < GFC_LETTERS - 1
		 && gfc_compare_types(&ns->default_type[i+1],
				      &ns->default_type[l]))
	    i++;

	  if (i > l)
	    gfc_status(" %c-%c: ", l+'A', i+'A');
	  else
	    gfc_status(" %c: ", l+'A');

	  gfc_show_typespec(&ns->default_type[l]);
	  i++;
      } while (i < GFC_LETTERS);

      if (ns->proc_name != NULL)
	{
	  show_indent ();
	  gfc_status ("procedure name = %s", ns->proc_name->name);
	}

      gfc_current_ns = ns;
      gfc_traverse_symtree (ns->common_root, show_common);

      gfc_traverse_symtree (ns->sym_root, show_symtree);

      for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
	{
	  /* User operator interfaces */
	  intr = ns->operator[op];
	  if (intr == NULL)
	    continue;

	  show_indent ();
	  gfc_status ("Operator interfaces for %s:", gfc_op2string (op));

	  for (; intr; intr = intr->next)
	    gfc_status (" %s", intr->sym->name);
	}

      if (ns->uop_root != NULL)
	{
	  show_indent ();
	  gfc_status ("User operators:\n");
	  gfc_traverse_user_op (ns, show_uop);
	}
    }
  
  for (eq = ns->equiv; eq; eq = eq->next)
    gfc_show_equiv (eq);

  gfc_status_char ('\n');
  gfc_status_char ('\n');

  gfc_show_code (0, ns->code);

  for (ns = ns->contained; ns; ns = ns->sibling)
    {
      show_indent ();
      gfc_status ("CONTAINS\n");
      gfc_show_namespace (ns);
    }

  show_level--;
  gfc_status_char ('\n');
  gfc_current_ns = save;
}
コード例 #2
0
static void
gfc_show_code_node (int level, gfc_code * c)
{
  gfc_forall_iterator *fa;
  gfc_open *open;
  gfc_case *cp;
  gfc_alloc *a;
  gfc_code *d;
  gfc_close *close;
  gfc_filepos *fp;
  gfc_inquire *i;
  gfc_dt *dt;

  code_indent (level, c->here);

  switch (c->op)
    {
    case EXEC_NOP:
      gfc_status ("NOP");
      break;

    case EXEC_CONTINUE:
      gfc_status ("CONTINUE");
      break;

    case EXEC_ENTRY:
      gfc_status ("ENTRY %s", c->ext.entry->sym->name);
      break;

    case EXEC_INIT_ASSIGN:
    case EXEC_ASSIGN:
      gfc_status ("ASSIGN ");
      gfc_show_expr (c->expr);
      gfc_status_char (' ');
      gfc_show_expr (c->expr2);
      break;

    case EXEC_LABEL_ASSIGN:
      gfc_status ("LABEL ASSIGN ");
      gfc_show_expr (c->expr);
      gfc_status (" %d", c->label->value);
      break;

    case EXEC_POINTER_ASSIGN:
      gfc_status ("POINTER ASSIGN ");
      gfc_show_expr (c->expr);
      gfc_status_char (' ');
      gfc_show_expr (c->expr2);
      break;

    case EXEC_GOTO:
      gfc_status ("GOTO ");
      if (c->label)
        gfc_status ("%d", c->label->value);
      else
        {
          gfc_show_expr (c->expr);
          d = c->block;
          if (d != NULL)
            {
              gfc_status (", (");
              for (; d; d = d ->block)
                {
                  code_indent (level, d->label);
                  if (d->block != NULL)
                    gfc_status_char (',');
                  else
                    gfc_status_char (')');
                }
            }
        }
      break;

    case EXEC_CALL:
      if (c->resolved_sym)
	gfc_status ("CALL %s ", c->resolved_sym->name);
      else if (c->symtree)
	gfc_status ("CALL %s ", c->symtree->name);
      else
	gfc_status ("CALL ?? ");

      gfc_show_actual_arglist (c->ext.actual);
      break;

    case EXEC_RETURN:
      gfc_status ("RETURN ");
      if (c->expr)
	gfc_show_expr (c->expr);
      break;

    case EXEC_PAUSE:
      gfc_status ("PAUSE ");

      if (c->expr != NULL)
        gfc_show_expr (c->expr);
      else
        gfc_status ("%d", c->ext.stop_code);

      break;

    case EXEC_STOP:
      gfc_status ("STOP ");

      if (c->expr != NULL)
        gfc_show_expr (c->expr);
      else
        gfc_status ("%d", c->ext.stop_code);

      break;

    case EXEC_ARITHMETIC_IF:
      gfc_status ("IF ");
      gfc_show_expr (c->expr);
      gfc_status (" %d, %d, %d",
		  c->label->value, c->label2->value, c->label3->value);
      break;

    case EXEC_IF:
      d = c->block;
      gfc_status ("IF ");
      gfc_show_expr (d->expr);
      gfc_status_char ('\n');
      gfc_show_code (level + 1, d->next);

      d = d->block;
      for (; d; d = d->block)
	{
	  code_indent (level, 0);

	  if (d->expr == NULL)
	    gfc_status ("ELSE\n");
	  else
	    {
	      gfc_status ("ELSE IF ");
	      gfc_show_expr (d->expr);
	      gfc_status_char ('\n');
	    }

	  gfc_show_code (level + 1, d->next);
	}

      code_indent (level, c->label);

      gfc_status ("ENDIF");
      break;

    case EXEC_SELECT:
      d = c->block;
      gfc_status ("SELECT CASE ");
      gfc_show_expr (c->expr);
      gfc_status_char ('\n');

      for (; d; d = d->block)
	{
	  code_indent (level, 0);

	  gfc_status ("CASE ");
	  for (cp = d->ext.case_list; cp; cp = cp->next)
	    {
	      gfc_status_char ('(');
	      gfc_show_expr (cp->low);
	      gfc_status_char (' ');
	      gfc_show_expr (cp->high);
	      gfc_status_char (')');
	      gfc_status_char (' ');
	    }
	  gfc_status_char ('\n');

	  gfc_show_code (level + 1, d->next);
	}

      code_indent (level, c->label);
      gfc_status ("END SELECT");
      break;

    case EXEC_WHERE:
      gfc_status ("WHERE ");

      d = c->block;
      gfc_show_expr (d->expr);
      gfc_status_char ('\n');

      gfc_show_code (level + 1, d->next);

      for (d = d->block; d; d = d->block)
	{
	  code_indent (level, 0);
	  gfc_status ("ELSE WHERE ");
	  gfc_show_expr (d->expr);
	  gfc_status_char ('\n');
	  gfc_show_code (level + 1, d->next);
	}

      code_indent (level, 0);
      gfc_status ("END WHERE");
      break;


    case EXEC_FORALL:
      gfc_status ("FORALL ");
      for (fa = c->ext.forall_iterator; fa; fa = fa->next)
	{
	  gfc_show_expr (fa->var);
	  gfc_status_char (' ');
	  gfc_show_expr (fa->start);
	  gfc_status_char (':');
	  gfc_show_expr (fa->end);
	  gfc_status_char (':');
	  gfc_show_expr (fa->stride);

	  if (fa->next != NULL)
	    gfc_status_char (',');
	}

      if (c->expr != NULL)
	{
	  gfc_status_char (',');
	  gfc_show_expr (c->expr);
	}
      gfc_status_char ('\n');

      gfc_show_code (level + 1, c->block->next);

      code_indent (level, 0);
      gfc_status ("END FORALL");
      break;

    case EXEC_DO:
      gfc_status ("DO ");

      gfc_show_expr (c->ext.iterator->var);
      gfc_status_char ('=');
      gfc_show_expr (c->ext.iterator->start);
      gfc_status_char (' ');
      gfc_show_expr (c->ext.iterator->end);
      gfc_status_char (' ');
      gfc_show_expr (c->ext.iterator->step);
      gfc_status_char ('\n');

      gfc_show_code (level + 1, c->block->next);

      code_indent (level, 0);
      gfc_status ("END DO");
      break;

    case EXEC_DO_WHILE:
      gfc_status ("DO WHILE ");
      gfc_show_expr (c->expr);
      gfc_status_char ('\n');

      gfc_show_code (level + 1, c->block->next);

      code_indent (level, c->label);
      gfc_status ("END DO");
      break;

    case EXEC_CYCLE:
      gfc_status ("CYCLE");
      if (c->symtree)
	gfc_status (" %s", c->symtree->n.sym->name);
      break;

    case EXEC_EXIT:
      gfc_status ("EXIT");
      if (c->symtree)
	gfc_status (" %s", c->symtree->n.sym->name);
      break;

    case EXEC_ALLOCATE:
      gfc_status ("ALLOCATE ");
      if (c->expr)
	{
	  gfc_status (" STAT=");
	  gfc_show_expr (c->expr);
	}

      for (a = c->ext.alloc_list; a; a = a->next)
	{
	  gfc_status_char (' ');
	  gfc_show_expr (a->expr);
	}

      break;

    case EXEC_DEALLOCATE:
      gfc_status ("DEALLOCATE ");
      if (c->expr)
	{
	  gfc_status (" STAT=");
	  gfc_show_expr (c->expr);
	}

      for (a = c->ext.alloc_list; a; a = a->next)
	{
	  gfc_status_char (' ');
	  gfc_show_expr (a->expr);
	}

      break;

    case EXEC_OPEN:
      gfc_status ("OPEN");
      open = c->ext.open;

      if (open->unit)
	{
	  gfc_status (" UNIT=");
	  gfc_show_expr (open->unit);
	}
      if (open->iomsg)
	{
	  gfc_status (" IOMSG=");
	  gfc_show_expr (open->iomsg);
	}
      if (open->iostat)
	{
	  gfc_status (" IOSTAT=");
	  gfc_show_expr (open->iostat);
	}
      if (open->file)
	{
	  gfc_status (" FILE=");
	  gfc_show_expr (open->file);
	}
      if (open->status)
	{
	  gfc_status (" STATUS=");
	  gfc_show_expr (open->status);
	}
      if (open->access)
	{
	  gfc_status (" ACCESS=");
	  gfc_show_expr (open->access);
	}
      if (open->form)
	{
	  gfc_status (" FORM=");
	  gfc_show_expr (open->form);
	}
      if (open->recl)
	{
	  gfc_status (" RECL=");
	  gfc_show_expr (open->recl);
	}
      if (open->blank)
	{
	  gfc_status (" BLANK=");
	  gfc_show_expr (open->blank);
	}
      if (open->position)
	{
	  gfc_status (" POSITION=");
	  gfc_show_expr (open->position);
	}
      if (open->action)
	{
	  gfc_status (" ACTION=");
	  gfc_show_expr (open->action);
	}
      if (open->delim)
	{
	  gfc_status (" DELIM=");
	  gfc_show_expr (open->delim);
	}
      if (open->pad)
	{
	  gfc_status (" PAD=");
	  gfc_show_expr (open->pad);
	}
      if (open->convert)
	{
	  gfc_status (" CONVERT=");
	  gfc_show_expr (open->convert);
	}
      if (open->err != NULL)
	gfc_status (" ERR=%d", open->err->value);

      break;

    case EXEC_CLOSE:
      gfc_status ("CLOSE");
      close = c->ext.close;

      if (close->unit)
	{
	  gfc_status (" UNIT=");
	  gfc_show_expr (close->unit);
	}
      if (close->iomsg)
	{
	  gfc_status (" IOMSG=");
	  gfc_show_expr (close->iomsg);
	}
      if (close->iostat)
	{
	  gfc_status (" IOSTAT=");
	  gfc_show_expr (close->iostat);
	}
      if (close->status)
	{
	  gfc_status (" STATUS=");
	  gfc_show_expr (close->status);
	}
      if (close->err != NULL)
	gfc_status (" ERR=%d", close->err->value);
      break;

    case EXEC_BACKSPACE:
      gfc_status ("BACKSPACE");
      goto show_filepos;

    case EXEC_ENDFILE:
      gfc_status ("ENDFILE");
      goto show_filepos;

    case EXEC_REWIND:
      gfc_status ("REWIND");
      goto show_filepos;

    case EXEC_FLUSH:
      gfc_status ("FLUSH");

    show_filepos:
      fp = c->ext.filepos;

      if (fp->unit)
	{
	  gfc_status (" UNIT=");
	  gfc_show_expr (fp->unit);
	}
      if (fp->iomsg)
	{
	  gfc_status (" IOMSG=");
	  gfc_show_expr (fp->iomsg);
	}
      if (fp->iostat)
	{
	  gfc_status (" IOSTAT=");
	  gfc_show_expr (fp->iostat);
	}
      if (fp->err != NULL)
	gfc_status (" ERR=%d", fp->err->value);
      break;

    case EXEC_INQUIRE:
      gfc_status ("INQUIRE");
      i = c->ext.inquire;

      if (i->unit)
	{
	  gfc_status (" UNIT=");
	  gfc_show_expr (i->unit);
	}
      if (i->file)
	{
	  gfc_status (" FILE=");
	  gfc_show_expr (i->file);
	}

      if (i->iomsg)
	{
	  gfc_status (" IOMSG=");
	  gfc_show_expr (i->iomsg);
	}
      if (i->iostat)
	{
	  gfc_status (" IOSTAT=");
	  gfc_show_expr (i->iostat);
	}
      if (i->exist)
	{
	  gfc_status (" EXIST=");
	  gfc_show_expr (i->exist);
	}
      if (i->opened)
	{
	  gfc_status (" OPENED=");
	  gfc_show_expr (i->opened);
	}
      if (i->number)
	{
	  gfc_status (" NUMBER=");
	  gfc_show_expr (i->number);
	}
      if (i->named)
	{
	  gfc_status (" NAMED=");
	  gfc_show_expr (i->named);
	}
      if (i->name)
	{
	  gfc_status (" NAME=");
	  gfc_show_expr (i->name);
	}
      if (i->access)
	{
	  gfc_status (" ACCESS=");
	  gfc_show_expr (i->access);
	}
      if (i->sequential)
	{
	  gfc_status (" SEQUENTIAL=");
	  gfc_show_expr (i->sequential);
	}

      if (i->direct)
	{
	  gfc_status (" DIRECT=");
	  gfc_show_expr (i->direct);
	}
      if (i->form)
	{
	  gfc_status (" FORM=");
	  gfc_show_expr (i->form);
	}
      if (i->formatted)
	{
	  gfc_status (" FORMATTED");
	  gfc_show_expr (i->formatted);
	}
      if (i->unformatted)
	{
	  gfc_status (" UNFORMATTED=");
	  gfc_show_expr (i->unformatted);
	}
      if (i->recl)
	{
	  gfc_status (" RECL=");
	  gfc_show_expr (i->recl);
	}
      if (i->nextrec)
	{
	  gfc_status (" NEXTREC=");
	  gfc_show_expr (i->nextrec);
	}
      if (i->blank)
	{
	  gfc_status (" BLANK=");
	  gfc_show_expr (i->blank);
	}
      if (i->position)
	{
	  gfc_status (" POSITION=");
	  gfc_show_expr (i->position);
	}
      if (i->action)
	{
	  gfc_status (" ACTION=");
	  gfc_show_expr (i->action);
	}
      if (i->read)
	{
	  gfc_status (" READ=");
	  gfc_show_expr (i->read);
	}
      if (i->write)
	{
	  gfc_status (" WRITE=");
	  gfc_show_expr (i->write);
	}
      if (i->readwrite)
	{
	  gfc_status (" READWRITE=");
	  gfc_show_expr (i->readwrite);
	}
      if (i->delim)
	{
	  gfc_status (" DELIM=");
	  gfc_show_expr (i->delim);
	}
      if (i->pad)
	{
	  gfc_status (" PAD=");
	  gfc_show_expr (i->pad);
	}
      if (i->convert)
	{
	  gfc_status (" CONVERT=");
	  gfc_show_expr (i->convert);
	}

      if (i->err != NULL)
	gfc_status (" ERR=%d", i->err->value);
      break;

    case EXEC_IOLENGTH:
      gfc_status ("IOLENGTH ");
      gfc_show_expr (c->expr);
      goto show_dt_code;
      break;

    case EXEC_READ:
      gfc_status ("READ");
      goto show_dt;

    case EXEC_WRITE:
      gfc_status ("WRITE");

    show_dt:
      dt = c->ext.dt;
      if (dt->io_unit)
	{
	  gfc_status (" UNIT=");
	  gfc_show_expr (dt->io_unit);
	}

      if (dt->format_expr)
	{
	  gfc_status (" FMT=");
	  gfc_show_expr (dt->format_expr);
	}

      if (dt->format_label != NULL)
	gfc_status (" FMT=%d", dt->format_label->value);
      if (dt->namelist)
	gfc_status (" NML=%s", dt->namelist->name);

      if (dt->iomsg)
	{
	  gfc_status (" IOMSG=");
	  gfc_show_expr (dt->iomsg);
	}
      if (dt->iostat)
	{
	  gfc_status (" IOSTAT=");
	  gfc_show_expr (dt->iostat);
	}
      if (dt->size)
	{
	  gfc_status (" SIZE=");
	  gfc_show_expr (dt->size);
	}
      if (dt->rec)
	{
	  gfc_status (" REC=");
	  gfc_show_expr (dt->rec);
	}
      if (dt->advance)
	{
	  gfc_status (" ADVANCE=");
	  gfc_show_expr (dt->advance);
	}

    show_dt_code:
      gfc_status_char ('\n');
      for (c = c->block->next; c; c = c->next)
	gfc_show_code_node (level + (c->next != NULL), c);
      return;

    case EXEC_TRANSFER:
      gfc_status ("TRANSFER ");
      gfc_show_expr (c->expr);
      break;

    case EXEC_DT_END:
      gfc_status ("DT_END");
      dt = c->ext.dt;

      if (dt->err != NULL)
	gfc_status (" ERR=%d", dt->err->value);
      if (dt->end != NULL)
	gfc_status (" END=%d", dt->end->value);
      if (dt->eor != NULL)
	gfc_status (" EOR=%d", dt->eor->value);
      break;

    default:
      gfc_internal_error ("gfc_show_code_node(): Bad statement code");
    }

  gfc_status_char ('\n');
}
コード例 #3
0
static void
gfc_show_omp_node (int level, gfc_code * c)
{
  gfc_omp_clauses *omp_clauses = NULL;
  const char *name = NULL;

  switch (c->op)
    {
    case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
    case EXEC_OMP_BARRIER: name = "BARRIER"; break;
    case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
    case EXEC_OMP_FLUSH: name = "FLUSH"; break;
    case EXEC_OMP_DO: name = "DO"; break;
    case EXEC_OMP_MASTER: name = "MASTER"; break;
    case EXEC_OMP_ORDERED: name = "ORDERED"; break;
    case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
    case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
    case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
    case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
    case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
    case EXEC_OMP_SINGLE: name = "SINGLE"; break;
    case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
    default:
      gcc_unreachable ();
    }
  gfc_status ("!$OMP %s", name);
  switch (c->op)
    {
    case EXEC_OMP_DO:
    case EXEC_OMP_PARALLEL:
    case EXEC_OMP_PARALLEL_DO:
    case EXEC_OMP_PARALLEL_SECTIONS:
    case EXEC_OMP_SECTIONS:
    case EXEC_OMP_SINGLE:
    case EXEC_OMP_WORKSHARE:
    case EXEC_OMP_PARALLEL_WORKSHARE:
      omp_clauses = c->ext.omp_clauses;
      break;
    case EXEC_OMP_CRITICAL:
      if (c->ext.omp_name)
	gfc_status (" (%s)", c->ext.omp_name);
      break;
    case EXEC_OMP_FLUSH:
      if (c->ext.omp_namelist)
	{
	  gfc_status (" (");
	  gfc_show_namelist (c->ext.omp_namelist);
	  gfc_status_char (')');
	}
      return;
    case EXEC_OMP_BARRIER:
      return;
    default:
      break;
    }
  if (omp_clauses)
    {
      int list_type;

      if (omp_clauses->if_expr)
	{
	  gfc_status (" IF(");
	  gfc_show_expr (omp_clauses->if_expr);
	  gfc_status_char (')');
	}
      if (omp_clauses->num_threads)
	{
	  gfc_status (" NUM_THREADS(");
	  gfc_show_expr (omp_clauses->num_threads);
	  gfc_status_char (')');
	}
      if (omp_clauses->sched_kind != OMP_SCHED_NONE)
	{
	  const char *type;
	  switch (omp_clauses->sched_kind)
	    {
	    case OMP_SCHED_STATIC: type = "STATIC"; break;
	    case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
	    case OMP_SCHED_GUIDED: type = "GUIDED"; break;
	    case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
	    default:
	      gcc_unreachable ();
	    }
	  gfc_status (" SCHEDULE (%s", type);
	  if (omp_clauses->chunk_size)
	    {
	      gfc_status_char (',');
	      gfc_show_expr (omp_clauses->chunk_size);
	    }
	  gfc_status_char (')');
	}
      if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
	{
	  const char *type;
	  switch (omp_clauses->default_sharing)
	    {
	    case OMP_DEFAULT_NONE: type = "NONE"; break;
	    case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
	    case OMP_DEFAULT_SHARED: type = "SHARED"; break;
	    case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
	    default:
	      gcc_unreachable ();
	    }
	  gfc_status (" DEFAULT(%s)", type);
	}
      if (omp_clauses->ordered)
	gfc_status (" ORDERED");
      for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
	if (omp_clauses->lists[list_type] != NULL
	    && list_type != OMP_LIST_COPYPRIVATE)
	  {
	    const char *type;
	    if (list_type >= OMP_LIST_REDUCTION_FIRST)
	      {
		switch (list_type)
		  {
		  case OMP_LIST_PLUS: type = "+"; break;
		  case OMP_LIST_MULT: type = "*"; break;
		  case OMP_LIST_SUB: type = "-"; break;
		  case OMP_LIST_AND: type = ".AND."; break;
		  case OMP_LIST_OR: type = ".OR."; break;
		  case OMP_LIST_EQV: type = ".EQV."; break;
		  case OMP_LIST_NEQV: type = ".NEQV."; break;
		  case OMP_LIST_MAX: type = "MAX"; break;
		  case OMP_LIST_MIN: type = "MIN"; break;
		  case OMP_LIST_IAND: type = "IAND"; break;
		  case OMP_LIST_IOR: type = "IOR"; break;
		  case OMP_LIST_IEOR: type = "IEOR"; break;
		  default:
		    gcc_unreachable ();
		  }
		gfc_status (" REDUCTION(%s:", type);
	      }
	    else
	      {
		switch (list_type)
		  {
		  case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
		  case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
		  case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
		  case OMP_LIST_SHARED: type = "SHARED"; break;
		  case OMP_LIST_COPYIN: type = "COPYIN"; break;
		  default:
		    gcc_unreachable ();
		  }
		gfc_status (" %s(", type);
	      }
	    gfc_show_namelist (omp_clauses->lists[list_type]);
	    gfc_status_char (')');
	  }
    }
  gfc_status_char ('\n');
  if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
    {
      gfc_code *d = c->block;
      while (d != NULL)
	{
	  gfc_show_code (level + 1, d->next);
	  if (d->block == NULL)
	    break;
	  code_indent (level, 0);
	  gfc_status ("!$OMP SECTION\n");
	  d = d->block;
	}
    }
  else
    gfc_show_code (level + 1, c->block->next);
  if (c->op == EXEC_OMP_ATOMIC)
    return;
  code_indent (level, 0);
  gfc_status ("!$OMP END %s", name);
  if (omp_clauses != NULL)
    {
      if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
	{
	  gfc_status (" COPYPRIVATE(");
	  gfc_show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
	  gfc_status_char (')');
	}
      else if (omp_clauses->nowait)
	gfc_status (" NOWAIT");
    }
  else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
    gfc_status (" (%s)", c->ext.omp_name);
}