OpenCores
URL https://opencores.org/ocsvn/scarts/scarts/trunk

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [fortran/] [dump-parse-tree.c] - Blame information for rev 20

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner 
/* Parse tree dumper
2 
   Copyright (C) 2003, 2004, 2005 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 2, 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 COPYING.  If not, write to the Free
19 
Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
20 
02110-1301, USA.  */
21 
 
22 
 
23 
/* Actually this is just a collection of routines that used to be
24 
   scattered around the sources.  Now that they are all in a single
25 
   file, almost all of them can be static, and the other files don't
26 
   have this mess in them.
27 
 
28 
   As a nice side-effect, this file can act as documentation of the
29 
   gfc_code and gfc_expr structures and all their friends and
30 
   relatives.
31 
 
32 
   TODO: Dump DATA.  */
33 
 
34 
#include "config.h"
35 
#include "gfortran.h"
36 
 
37 
/* Keep track of indentation for symbol tree dumps.  */
38 
static int show_level = 0;
39 
 
40 
 
41 
/* Forward declaration because this one needs all, and all need
42 
   this one.  */
43 
 
44 
 
45 
/* Do indentation for a specific level.  */
46 
 
47 
static inline void
48 
code_indent (int level, gfc_st_label * label)
49 
{
50 
  int i;
51 
 
52 
  if (label != NULL)
53 
    gfc_status ("%-5d ", label->value);
54 
  else
55 
    gfc_status ("      ");
56 
 
57 
  for (i = 0; i < 2 * level; i++)
58 
    gfc_status_char (' ');
59 
}
60 
 
61 
 
62 
/* Simple indentation at the current level.  This one
63 
   is used to show symbols.  */
64 
 
65 
static inline void
66 
show_indent (void)
67 
{
68 
  gfc_status ("\n");
69 
  code_indent (show_level, NULL);
70 
}
71 
 
72 
 
73 
/* Show type-specific information.  */
74 
 
75 
static void
76 
gfc_show_typespec (gfc_typespec * ts)
77 
{
78 
 
79 
  gfc_status ("(%s ", gfc_basic_typename (ts->type));
80 
 
81 
  switch (ts->type)
82 
    {
83 
    case BT_DERIVED:
84 
      gfc_status ("%s", ts->derived->name);
85 
      break;
86 
 
87 
    case BT_CHARACTER:
88 
      gfc_show_expr (ts->cl->length);
89 
      break;
90 
 
91 
    default:
92 
      gfc_status ("%d", ts->kind);
93 
      break;
94 
    }
95 
 
96 
  gfc_status (")");
97 
}
98 
 
99 
 
100 
/* Show an actual argument list.  */
101 
 
102 
static void
103 
gfc_show_actual_arglist (gfc_actual_arglist * a)
104 
{
105 
 
106 
  gfc_status ("(");
107 
 
108 
  for (; a; a = a->next)
109 
    {
110 
      gfc_status_char ('(');
111 
      if (a->name != NULL)
112 
        gfc_status ("%s = ", a->name);
113 
      if (a->expr != NULL)
114 
        gfc_show_expr (a->expr);
115 
      else
116 
        gfc_status ("(arg not-present)");
117 
 
118 
      gfc_status_char (')');
119 
      if (a->next != NULL)
120 
        gfc_status (" ");
121 
    }
122 
 
123 
  gfc_status (")");
124 
}
125 
 
126 
 
127 
/* Show a gfc_array_spec array specification structure.  */
128 
 
129 
static void
130 
gfc_show_array_spec (gfc_array_spec * as)
131 
{
132 
  const char *c;
133 
  int i;
134 
 
135 
  if (as == NULL)
136 
    {
137 
      gfc_status ("()");
138 
      return;
139 
    }
140 
 
141 
  gfc_status ("(%d", as->rank);
142 
 
143 
  if (as->rank != 0)
144 
    {
145 
      switch (as->type)
146 
      {
147 
        case AS_EXPLICIT:      c = "AS_EXPLICIT";      break;
148 
        case AS_DEFERRED:      c = "AS_DEFERRED";      break;
149 
        case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
150 
        case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
151 
        default:
152 
          gfc_internal_error
153 
                ("gfc_show_array_spec(): Unhandled array shape type.");
154 
      }
155 
      gfc_status (" %s ", c);
156 
 
157 
      for (i = 0; i < as->rank; i++)
158 
        {
159 
          gfc_show_expr (as->lower[i]);
160 
          gfc_status_char (' ');
161 
          gfc_show_expr (as->upper[i]);
162 
          gfc_status_char (' ');
163 
        }
164 
    }
165 
 
166 
  gfc_status (")");
167 
}
168 
 
169 
 
170 
/* Show a gfc_array_ref array reference structure.  */
171 
 
172 
static void
173 
gfc_show_array_ref (gfc_array_ref * ar)
174 
{
175 
  int i;
176 
 
177 
  gfc_status_char ('(');
178 
 
179 
  switch (ar->type)
180 
    {
181 
    case AR_FULL:
182 
      gfc_status ("FULL");
183 
      break;
184 
 
185 
    case AR_SECTION:
186 
      for (i = 0; i < ar->dimen; i++)
187 
        {
188 
          /* There are two types of array sections: either the
189 
             elements are identified by an integer array ('vector'),
190 
             or by an index range. In the former case we only have to
191 
             print the start expression which contains the vector, in
192 
             the latter case we have to print any of lower and upper
193 
             bound and the stride, if they're present.  */
194 
 
195 
          if (ar->start[i] != NULL)
196 
            gfc_show_expr (ar->start[i]);
197 
 
198 
          if (ar->dimen_type[i] == DIMEN_RANGE)
199 
            {
200 
              gfc_status_char (':');
201 
 
202 
              if (ar->end[i] != NULL)
203 
                gfc_show_expr (ar->end[i]);
204 
 
205 
              if (ar->stride[i] != NULL)
206 
                {
207 
                  gfc_status_char (':');
208 
                  gfc_show_expr (ar->stride[i]);
209 
                }
210 
            }
211 
 
212 
          if (i != ar->dimen - 1)
213 
            gfc_status (" , ");
214 
        }
215 
      break;
216 
 
217 
    case AR_ELEMENT:
218 
      for (i = 0; i < ar->dimen; i++)
219 
        {
220 
          gfc_show_expr (ar->start[i]);
221 
          if (i != ar->dimen - 1)
222 
            gfc_status (" , ");
223 
        }
224 
      break;
225 
 
226 
    case AR_UNKNOWN:
227 
      gfc_status ("UNKNOWN");
228 
      break;
229 
 
230 
    default:
231 
      gfc_internal_error ("gfc_show_array_ref(): Unknown array reference");
232 
    }
233 
 
234 
  gfc_status_char (')');
235 
}
236 
 
237 
 
238 
/* Show a list of gfc_ref structures.  */
239 
 
240 
static void
241 
gfc_show_ref (gfc_ref * p)
242 
{
243 
 
244 
  for (; p; p = p->next)
245 
    switch (p->type)
246 
      {
247 
      case REF_ARRAY:
248 
        gfc_show_array_ref (&p->u.ar);
249 
        break;
250 
 
251 
      case REF_COMPONENT:
252 
        gfc_status (" %% %s", p->u.c.component->name);
253 
        break;
254 
 
255 
      case REF_SUBSTRING:
256 
        gfc_status_char ('(');
257 
        gfc_show_expr (p->u.ss.start);
258 
        gfc_status_char (':');
259 
        gfc_show_expr (p->u.ss.end);
260 
        gfc_status_char (')');
261 
        break;
262 
 
263 
      default:
264 
        gfc_internal_error ("gfc_show_ref(): Bad component code");
265 
      }
266 
}
267 
 
268 
 
269 
/* Display a constructor.  Works recursively for array constructors.  */
270 
 
271 
static void
272 
gfc_show_constructor (gfc_constructor * c)
273 
{
274 
 
275 
  for (; c; c = c->next)
276 
    {
277 
      if (c->iterator == NULL)
278 
        gfc_show_expr (c->expr);
279 
      else
280 
        {
281 
          gfc_status_char ('(');
282 
          gfc_show_expr (c->expr);
283 
 
284 
          gfc_status_char (' ');
285 
          gfc_show_expr (c->iterator->var);
286 
          gfc_status_char ('=');
287 
          gfc_show_expr (c->iterator->start);
288 
          gfc_status_char (',');
289 
          gfc_show_expr (c->iterator->end);
290 
          gfc_status_char (',');
291 
          gfc_show_expr (c->iterator->step);
292 
 
293 
          gfc_status_char (')');
294 
        }
295 
 
296 
      if (c->next != NULL)
297 
        gfc_status (" , ");
298 
    }
299 
}
300 
 
301 
 
302 
/* Show an expression.  */
303 
 
304 
void
305 
gfc_show_expr (gfc_expr * p)
306 
{
307 
  const char *c;
308 
  int i;
309 
 
310 
  if (p == NULL)
311 
    {
312 
      gfc_status ("()");
313 
      return;
314 
    }
315 
 
316 
  switch (p->expr_type)
317 
    {
318 
    case EXPR_SUBSTRING:
319 
      c = p->value.character.string;
320 
 
321 
      for (i = 0; i < p->value.character.length; i++, c++)
322 
        {
323 
          if (*c == '\'')
324 
            gfc_status ("''");
325 
          else
326 
            gfc_status ("%c", *c);
327 
        }
328 
 
329 
      gfc_show_ref (p->ref);
330 
      break;
331 
 
332 
    case EXPR_STRUCTURE:
333 
      gfc_status ("%s(", p->ts.derived->name);
334 
      gfc_show_constructor (p->value.constructor);
335 
      gfc_status_char (')');
336 
      break;
337 
 
338 
    case EXPR_ARRAY:
339 
      gfc_status ("(/ ");
340 
      gfc_show_constructor (p->value.constructor);
341 
      gfc_status (" /)");
342 
 
343 
      gfc_show_ref (p->ref);
344 
      break;
345 
 
346 
    case EXPR_NULL:
347 
      gfc_status ("NULL()");
348 
      break;
349 
 
350 
    case EXPR_CONSTANT:
351 
      switch (p->ts.type)
352 
        {
353 
        case BT_INTEGER:
354 
          mpz_out_str (stdout, 10, p->value.integer);
355 
 
356 
          if (p->ts.kind != gfc_default_integer_kind)
357 
            gfc_status ("_%d", p->ts.kind);
358 
          break;
359 
 
360 
        case BT_LOGICAL:
361 
          if (p->value.logical)
362 
            gfc_status (".true.");
363 
          else
364 
            gfc_status (".false.");
365 
          break;
366 
 
367 
        case BT_REAL:
368 
          mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
369 
          if (p->ts.kind != gfc_default_real_kind)
370 
            gfc_status ("_%d", p->ts.kind);
371 
          break;
372 
 
373 
        case BT_CHARACTER:
374 
          c = p->value.character.string;
375 
 
376 
          gfc_status_char ('\'');
377 
 
378 
          for (i = 0; i < p->value.character.length; i++, c++)
379 
            {
380 
              if (*c == '\'')
381 
                gfc_status ("''");
382 
              else
383 
                gfc_status_char (*c);
384 
            }
385 
 
386 
          gfc_status_char ('\'');
387 
 
388 
          break;
389 
 
390 
        case BT_COMPLEX:
391 
          gfc_status ("(complex ");
392 
 
393 
          mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE);
394 
          if (p->ts.kind != gfc_default_complex_kind)
395 
            gfc_status ("_%d", p->ts.kind);
396 
 
397 
          gfc_status (" ");
398 
 
399 
          mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE);
400 
          if (p->ts.kind != gfc_default_complex_kind)
401 
            gfc_status ("_%d", p->ts.kind);
402 
 
403 
          gfc_status (")");
404 
          break;
405 
 
406 
        default:
407 
          gfc_status ("???");
408 
          break;
409 
        }
410 
 
411 
      break;
412 
 
413 
    case EXPR_VARIABLE:
414 
      if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
415 
        gfc_status ("%s:", p->symtree->n.sym->ns->proc_name->name);
416 
      gfc_status ("%s", p->symtree->n.sym->name);
417 
      gfc_show_ref (p->ref);
418 
      break;
419 
 
420 
    case EXPR_OP:
421 
      gfc_status ("(");
422 
      switch (p->value.op.operator)
423 
        {
424 
        case INTRINSIC_UPLUS:
425 
          gfc_status ("U+ ");
426 
          break;
427 
        case INTRINSIC_UMINUS:
428 
          gfc_status ("U- ");
429 
          break;
430 
        case INTRINSIC_PLUS:
431 
          gfc_status ("+ ");
432 
          break;
433 
        case INTRINSIC_MINUS:
434 
          gfc_status ("- ");
435 
          break;
436 
        case INTRINSIC_TIMES:
437 
          gfc_status ("* ");
438 
          break;
439 
        case INTRINSIC_DIVIDE:
440 
          gfc_status ("/ ");
441 
          break;
442 
        case INTRINSIC_POWER:
443 
          gfc_status ("** ");
444 
          break;
445 
        case INTRINSIC_CONCAT:
446 
          gfc_status ("// ");
447 
          break;
448 
        case INTRINSIC_AND:
449 
          gfc_status ("AND ");
450 
          break;
451 
        case INTRINSIC_OR:
452 
          gfc_status ("OR ");
453 
          break;
454 
        case INTRINSIC_EQV:
455 
          gfc_status ("EQV ");
456 
          break;
457 
        case INTRINSIC_NEQV:
458 
          gfc_status ("NEQV ");
459 
          break;
460 
        case INTRINSIC_EQ:
461 
          gfc_status ("= ");
462 
          break;
463 
        case INTRINSIC_NE:
464 
          gfc_status ("<> ");
465 
          break;
466 
        case INTRINSIC_GT:
467 
          gfc_status ("> ");
468 
          break;
469 
        case INTRINSIC_GE:
470 
          gfc_status (">= ");
471 
          break;
472 
        case INTRINSIC_LT:
473 
          gfc_status ("< ");
474 
          break;
475 
        case INTRINSIC_LE:
476 
          gfc_status ("<= ");
477 
          break;
478 
        case INTRINSIC_NOT:
479 
          gfc_status ("NOT ");
480 
          break;
481 
        case INTRINSIC_PARENTHESES:
482 
          gfc_status ("parens");
483 
          break;
484 
 
485 
        default:
486 
          gfc_internal_error
487 
            ("gfc_show_expr(): Bad intrinsic in expression!");
488 
        }
489 
 
490 
      gfc_show_expr (p->value.op.op1);
491 
 
492 
      if (p->value.op.op2)
493 
        {
494 
          gfc_status (" ");
495 
          gfc_show_expr (p->value.op.op2);
496 
        }
497 
 
498 
      gfc_status (")");
499 
      break;
500 
 
501 
    case EXPR_FUNCTION:
502 
      if (p->value.function.name == NULL)
503 
        {
504 
          gfc_status ("%s[", p->symtree->n.sym->name);
505 
          gfc_show_actual_arglist (p->value.function.actual);
506 
          gfc_status_char (']');
507 
        }
508 
      else
509 
        {
510 
          gfc_status ("%s[[", p->value.function.name);
511 
          gfc_show_actual_arglist (p->value.function.actual);
512 
          gfc_status_char (']');
513 
          gfc_status_char (']');
514 
        }
515 
 
516 
      break;
517 
 
518 
    default:
519 
      gfc_internal_error ("gfc_show_expr(): Don't know how to show expr");
520 
    }
521 
}
522 
 
523 
 
524 
/* Show symbol attributes.  The flavor and intent are followed by
525 
   whatever single bit attributes are present.  */
526 
 
527 
static void
528 
gfc_show_attr (symbol_attribute * attr)
529 
{
530 
 
531 
  gfc_status ("(%s %s %s %s", gfc_code2string (flavors, attr->flavor),
532 
              gfc_intent_string (attr->intent),
533 
              gfc_code2string (access_types, attr->access),
534 
              gfc_code2string (procedures, attr->proc));
535 
 
536 
  if (attr->allocatable)
537 
    gfc_status (" ALLOCATABLE");
538 
  if (attr->dimension)
539 
    gfc_status (" DIMENSION");
540 
  if (attr->external)
541 
    gfc_status (" EXTERNAL");
542 
  if (attr->intrinsic)
543 
    gfc_status (" INTRINSIC");
544 
  if (attr->optional)
545 
    gfc_status (" OPTIONAL");
546 
  if (attr->pointer)
547 
    gfc_status (" POINTER");
548 
  if (attr->save)
549 
    gfc_status (" SAVE");
550 
  if (attr->target)
551 
    gfc_status (" TARGET");
552 
  if (attr->dummy)
553 
    gfc_status (" DUMMY");
554 
  if (attr->result)
555 
    gfc_status (" RESULT");
556 
  if (attr->entry)
557 
    gfc_status (" ENTRY");
558 
 
559 
  if (attr->data)
560 
    gfc_status (" DATA");
561 
  if (attr->use_assoc)
562 
    gfc_status (" USE-ASSOC");
563 
  if (attr->in_namelist)
564 
    gfc_status (" IN-NAMELIST");
565 
  if (attr->in_common)
566 
    gfc_status (" IN-COMMON");
567 
 
568 
  if (attr->function)
569 
    gfc_status (" FUNCTION");
570 
  if (attr->subroutine)
571 
    gfc_status (" SUBROUTINE");
572 
  if (attr->implicit_type)
573 
    gfc_status (" IMPLICIT-TYPE");
574 
 
575 
  if (attr->sequence)
576 
    gfc_status (" SEQUENCE");
577 
  if (attr->elemental)
578 
    gfc_status (" ELEMENTAL");
579 
  if (attr->pure)
580 
    gfc_status (" PURE");
581 
  if (attr->recursive)
582 
    gfc_status (" RECURSIVE");
583 
 
584 
  gfc_status (")");
585 
}
586 
 
587 
 
588 
/* Show components of a derived type.  */
589 
 
590 
static void
591 
gfc_show_components (gfc_symbol * sym)
592 
{
593 
  gfc_component *c;
594 
 
595 
  for (c = sym->components; c; c = c->next)
596 
    {
597 
      gfc_status ("(%s ", c->name);
598 
      gfc_show_typespec (&c->ts);
599 
      if (c->pointer)
600 
        gfc_status (" POINTER");
601 
      if (c->dimension)
602 
        gfc_status (" DIMENSION");
603 
      gfc_status_char (' ');
604 
      gfc_show_array_spec (c->as);
605 
      gfc_status (")");
606 
      if (c->next != NULL)
607 
        gfc_status_char (' ');
608 
    }
609 
}
610 
 
611 
 
612 
/* Show a symbol.  If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
613 
   show the interface.  Information needed to reconstruct the list of
614 
   specific interfaces associated with a generic symbol is done within
615 
   that symbol.  */
616 
 
617 
static void
618 
gfc_show_symbol (gfc_symbol * sym)
619 
{
620 
  gfc_formal_arglist *formal;
621 
  gfc_interface *intr;
622 
 
623 
  if (sym == NULL)
624 
    return;
625 
 
626 
  show_indent ();
627 
 
628 
  gfc_status ("symbol %s ", sym->name);
629 
  gfc_show_typespec (&sym->ts);
630 
  gfc_show_attr (&sym->attr);
631 
 
632 
  if (sym->value)
633 
    {
634 
      show_indent ();
635 
      gfc_status ("value: ");
636 
      gfc_show_expr (sym->value);
637 
    }
638 
 
639 
  if (sym->as)
640 
    {
641 
      show_indent ();
642 
      gfc_status ("Array spec:");
643 
      gfc_show_array_spec (sym->as);
644 
    }
645 
 
646 
  if (sym->generic)
647 
    {
648 
      show_indent ();
649 
      gfc_status ("Generic interfaces:");
650 
      for (intr = sym->generic; intr; intr = intr->next)
651 
        gfc_status (" %s", intr->sym->name);
652 
    }
653 
 
654 
  if (sym->result)
655 
    {
656 
      show_indent ();
657 
      gfc_status ("result: %s", sym->result->name);
658 
    }
659 
 
660 
  if (sym->components)
661 
    {
662 
      show_indent ();
663 
      gfc_status ("components: ");
664 
      gfc_show_components (sym);
665 
    }
666 
 
667 
  if (sym->formal)
668 
    {
669 
      show_indent ();
670 
      gfc_status ("Formal arglist:");
671 
 
672 
      for (formal = sym->formal; formal; formal = formal->next)
673 
        {
674 
          if (formal->sym != NULL)
675 
            gfc_status (" %s", formal->sym->name);
676 
          else
677 
            gfc_status (" [Alt Return]");
678 
        }
679 
    }
680 
 
681 
  if (sym->formal_ns)
682 
    {
683 
      show_indent ();
684 
      gfc_status ("Formal namespace");
685 
      gfc_show_namespace (sym->formal_ns);
686 
    }
687 
 
688 
  gfc_status_char ('\n');
689 
}
690 
 
691 
 
692 
/* Show a user-defined operator.  Just prints an operator
693 
   and the name of the associated subroutine, really.  */
694 
 
695 
static void
696 
show_uop (gfc_user_op * uop)
697 
{
698 
  gfc_interface *intr;
699 
 
700 
  show_indent ();
701 
  gfc_status ("%s:", uop->name);
702 
 
703 
  for (intr = uop->operator; intr; intr = intr->next)
704 
    gfc_status (" %s", intr->sym->name);
705 
}
706 
 
707 
 
708 
/* Workhorse function for traversing the user operator symtree.  */
709 
 
710 
static void
711 
traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
712 
{
713 
 
714 
  if (st == NULL)
715 
    return;
716 
 
717 
  (*func) (st->n.uop);
718 
 
719 
  traverse_uop (st->left, func);
720 
  traverse_uop (st->right, func);
721 
}
722 
 
723 
 
724 
/* Traverse the tree of user operator nodes.  */
725 
 
726 
void
727 
gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
728 
{
729 
 
730 
  traverse_uop (ns->uop_root, func);
731 
}
732 
 
733 
 
734 
/* Function to display a common block.  */
735 
 
736 
static void
737 
show_common (gfc_symtree * st)
738 
{
739 
  gfc_symbol *s;
740 
 
741 
  show_indent ();
742 
  gfc_status ("common: /%s/ ", st->name);
743 
 
744 
  s = st->n.common->head;
745 
  while (s)
746 
    {
747 
      gfc_status ("%s", s->name);
748 
      s = s->common_next;
749 
      if (s)
750 
        gfc_status (", ");
751 
    }
752 
  gfc_status_char ('\n');
753 
}
754 
 
755 
 
756 
/* Worker function to display the symbol tree.  */
757 
 
758 
static void
759 
show_symtree (gfc_symtree * st)
760 
{
761 
 
762 
  show_indent ();
763 
  gfc_status ("symtree: %s  Ambig %d", st->name, st->ambiguous);
764 
 
765 
  if (st->n.sym->ns != gfc_current_ns)
766 
    gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name);
767 
  else
768 
    gfc_show_symbol (st->n.sym);
769 
}
770 
 
771 
 
772 
/******************* Show gfc_code structures **************/
773 
 
774 
 
775 
 
776 
static void gfc_show_code_node (int level, gfc_code * c);
777 
 
778 
/* Show a list of code structures.  Mutually recursive with
779 
   gfc_show_code_node().  */
780 
 
781 
static void
782 
gfc_show_code (int level, gfc_code * c)
783 
{
784 
 
785 
  for (; c; c = c->next)
786 
    gfc_show_code_node (level, c);
787 
}
788 
 
789 
 
790 
/* Show a single code node and everything underneath it if necessary.  */
791 
 
792 
static void
793 
gfc_show_code_node (int level, gfc_code * c)
794 
{
795 
  gfc_forall_iterator *fa;
796 
  gfc_open *open;
797 
  gfc_case *cp;
798 
  gfc_alloc *a;
799 
  gfc_code *d;
800 
  gfc_close *close;
801 
  gfc_filepos *fp;
802 
  gfc_inquire *i;
803 
  gfc_dt *dt;
804 
 
805 
  code_indent (level, c->here);
806 
 
807 
  switch (c->op)
808 
    {
809 
    case EXEC_NOP:
810 
      gfc_status ("NOP");
811 
      break;
812 
 
813 
    case EXEC_CONTINUE:
814 
      gfc_status ("CONTINUE");
815 
      break;
816 
 
817 
    case EXEC_ENTRY:
818 
      gfc_status ("ENTRY %s", c->ext.entry->sym->name);
819 
      break;
820 
 
821 
    case EXEC_ASSIGN:
822 
      gfc_status ("ASSIGN ");
823 
      gfc_show_expr (c->expr);
824 
      gfc_status_char (' ');
825 
      gfc_show_expr (c->expr2);
826 
      break;
827 
 
828 
    case EXEC_LABEL_ASSIGN:
829 
      gfc_status ("LABEL ASSIGN ");
830 
      gfc_show_expr (c->expr);
831 
      gfc_status (" %d", c->label->value);
832 
      break;
833 
 
834 
    case EXEC_POINTER_ASSIGN:
835 
      gfc_status ("POINTER ASSIGN ");
836 
      gfc_show_expr (c->expr);
837 
      gfc_status_char (' ');
838 
      gfc_show_expr (c->expr2);
839 
      break;
840 
 
841 
    case EXEC_GOTO:
842 
      gfc_status ("GOTO ");
843 
      if (c->label)
844 
        gfc_status ("%d", c->label->value);
845 
      else
846 
        {
847 
          gfc_show_expr (c->expr);
848 
          d = c->block;
849 
          if (d != NULL)
850 
            {
851 
              gfc_status (", (");
852 
              for (; d; d = d ->block)
853 
                {
854 
                  code_indent (level, d->label);
855 
                  if (d->block != NULL)
856 
                    gfc_status_char (',');
857 
                  else
858 
                    gfc_status_char (')');
859 
                }
860 
            }
861 
        }
862 
      break;
863 
 
864 
    case EXEC_CALL:
865 
      gfc_status ("CALL %s ", c->resolved_sym->name);
866 
      gfc_show_actual_arglist (c->ext.actual);
867 
      break;
868 
 
869 
    case EXEC_RETURN:
870 
      gfc_status ("RETURN ");
871 
      if (c->expr)
872 
        gfc_show_expr (c->expr);
873 
      break;
874 
 
875 
    case EXEC_PAUSE:
876 
      gfc_status ("PAUSE ");
877 
 
878 
      if (c->expr != NULL)
879 
        gfc_show_expr (c->expr);
880 
      else
881 
        gfc_status ("%d", c->ext.stop_code);
882 
 
883 
      break;
884 
 
885 
    case EXEC_STOP:
886 
      gfc_status ("STOP ");
887 
 
888 
      if (c->expr != NULL)
889 
        gfc_show_expr (c->expr);
890 
      else
891 
        gfc_status ("%d", c->ext.stop_code);
892 
 
893 
      break;
894 
 
895 
    case EXEC_ARITHMETIC_IF:
896 
      gfc_status ("IF ");
897 
      gfc_show_expr (c->expr);
898 
      gfc_status (" %d, %d, %d",
899 
                  c->label->value, c->label2->value, c->label3->value);
900 
      break;
901 
 
902 
    case EXEC_IF:
903 
      d = c->block;
904 
      gfc_status ("IF ");
905 
      gfc_show_expr (d->expr);
906 
      gfc_status_char ('\n');
907 
      gfc_show_code (level + 1, d->next);
908 
 
909 
      d = d->block;
910 
      for (; d; d = d->block)
911 
        {
912 
          code_indent (level, 0);
913 
 
914 
          if (d->expr == NULL)
915 
            gfc_status ("ELSE\n");
916 
          else
917 
            {
918 
              gfc_status ("ELSE IF ");
919 
              gfc_show_expr (d->expr);
920 
              gfc_status_char ('\n');
921 
            }
922 
 
923 
          gfc_show_code (level + 1, d->next);
924 
        }
925 
 
926 
      code_indent (level, c->label);
927 
 
928 
      gfc_status ("ENDIF");
929 
      break;
930 
 
931 
    case EXEC_SELECT:
932 
      d = c->block;
933 
      gfc_status ("SELECT CASE ");
934 
      gfc_show_expr (c->expr);
935 
      gfc_status_char ('\n');
936 
 
937 
      for (; d; d = d->block)
938 
        {
939 
          code_indent (level, 0);
940 
 
941 
          gfc_status ("CASE ");
942 
          for (cp = d->ext.case_list; cp; cp = cp->next)
943 
            {
944 
              gfc_status_char ('(');
945 
              gfc_show_expr (cp->low);
946 
              gfc_status_char (' ');
947 
              gfc_show_expr (cp->high);
948 
              gfc_status_char (')');
949 
              gfc_status_char (' ');
950 
            }
951 
          gfc_status_char ('\n');
952 
 
953 
          gfc_show_code (level + 1, d->next);
954 
        }
955 
 
956 
      code_indent (level, c->label);
957 
      gfc_status ("END SELECT");
958 
      break;
959 
 
960 
    case EXEC_WHERE:
961 
      gfc_status ("WHERE ");
962 
 
963 
      d = c->block;
964 
      gfc_show_expr (d->expr);
965 
      gfc_status_char ('\n');
966 
 
967 
      gfc_show_code (level + 1, d->next);
968 
 
969 
      for (d = d->block; d; d = d->block)
970 
        {
971 
          code_indent (level, 0);
972 
          gfc_status ("ELSE WHERE ");
973 
          gfc_show_expr (d->expr);
974 
          gfc_status_char ('\n');
975 
          gfc_show_code (level + 1, d->next);
976 
        }
977 
 
978 
      code_indent (level, 0);
979 
      gfc_status ("END WHERE");
980 
      break;
981 
 
982 
 
983 
    case EXEC_FORALL:
984 
      gfc_status ("FORALL ");
985 
      for (fa = c->ext.forall_iterator; fa; fa = fa->next)
986 
        {
987 
          gfc_show_expr (fa->var);
988 
          gfc_status_char (' ');
989 
          gfc_show_expr (fa->start);
990 
          gfc_status_char (':');
991 
          gfc_show_expr (fa->end);
992 
          gfc_status_char (':');
993 
          gfc_show_expr (fa->stride);
994 
 
995 
          if (fa->next != NULL)
996 
            gfc_status_char (',');
997 
        }
998 
 
999 
      if (c->expr != NULL)
1000 
        {
1001 
          gfc_status_char (',');
1002 
          gfc_show_expr (c->expr);
1003 
        }
1004 
      gfc_status_char ('\n');
1005 
 
1006 
      gfc_show_code (level + 1, c->block->next);
1007 
 
1008 
      code_indent (level, 0);
1009 
      gfc_status ("END FORALL");
1010 
      break;
1011 
 
1012 
    case EXEC_DO:
1013 
      gfc_status ("DO ");
1014 
 
1015 
      gfc_show_expr (c->ext.iterator->var);
1016 
      gfc_status_char ('=');
1017 
      gfc_show_expr (c->ext.iterator->start);
1018 
      gfc_status_char (' ');
1019 
      gfc_show_expr (c->ext.iterator->end);
1020 
      gfc_status_char (' ');
1021 
      gfc_show_expr (c->ext.iterator->step);
1022 
      gfc_status_char ('\n');
1023 
 
1024 
      gfc_show_code (level + 1, c->block->next);
1025 
 
1026 
      code_indent (level, 0);
1027 
      gfc_status ("END DO");
1028 
      break;
1029 
 
1030 
    case EXEC_DO_WHILE:
1031 
      gfc_status ("DO WHILE ");
1032 
      gfc_show_expr (c->expr);
1033 
      gfc_status_char ('\n');
1034 
 
1035 
      gfc_show_code (level + 1, c->block->next);
1036 
 
1037 
      code_indent (level, c->label);
1038 
      gfc_status ("END DO");
1039 
      break;
1040 
 
1041 
    case EXEC_CYCLE:
1042 
      gfc_status ("CYCLE");
1043 
      if (c->symtree)
1044 
        gfc_status (" %s", c->symtree->n.sym->name);
1045 
      break;
1046 
 
1047 
    case EXEC_EXIT:
1048 
      gfc_status ("EXIT");
1049 
      if (c->symtree)
1050 
        gfc_status (" %s", c->symtree->n.sym->name);
1051 
      break;
1052 
 
1053 
    case EXEC_ALLOCATE:
1054 
      gfc_status ("ALLOCATE ");
1055 
      if (c->expr)
1056 
        {
1057 
          gfc_status (" STAT=");
1058 
          gfc_show_expr (c->expr);
1059 
        }
1060 
 
1061 
      for (a = c->ext.alloc_list; a; a = a->next)
1062 
        {
1063 
          gfc_status_char (' ');
1064 
          gfc_show_expr (a->expr);
1065 
        }
1066 
 
1067 
      break;
1068 
 
1069 
    case EXEC_DEALLOCATE:
1070 
      gfc_status ("DEALLOCATE ");
1071 
      if (c->expr)
1072 
        {
1073 
          gfc_status (" STAT=");
1074 
          gfc_show_expr (c->expr);
1075 
        }
1076 
 
1077 
      for (a = c->ext.alloc_list; a; a = a->next)
1078 
        {
1079 
          gfc_status_char (' ');
1080 
          gfc_show_expr (a->expr);
1081 
        }
1082 
 
1083 
      break;
1084 
 
1085 
    case EXEC_OPEN:
1086 
      gfc_status ("OPEN");
1087 
      open = c->ext.open;
1088 
 
1089 
      if (open->unit)
1090 
        {
1091 
          gfc_status (" UNIT=");
1092 
          gfc_show_expr (open->unit);
1093 
        }
1094 
      if (open->iomsg)
1095 
        {
1096 
          gfc_status (" IOMSG=");
1097 
          gfc_show_expr (open->iomsg);
1098 
        }
1099 
      if (open->iostat)
1100 
        {
1101 
          gfc_status (" IOSTAT=");
1102 
          gfc_show_expr (open->iostat);
1103 
        }
1104 
      if (open->file)
1105 
        {
1106 
          gfc_status (" FILE=");
1107 
          gfc_show_expr (open->file);
1108 
        }
1109 
      if (open->status)
1110 
        {
1111 
          gfc_status (" STATUS=");
1112 
          gfc_show_expr (open->status);
1113 
        }
1114 
      if (open->access)
1115 
        {
1116 
          gfc_status (" ACCESS=");
1117 
          gfc_show_expr (open->access);
1118 
        }
1119 
      if (open->form)
1120 
        {
1121 
          gfc_status (" FORM=");
1122 
          gfc_show_expr (open->form);
1123 
        }
1124 
      if (open->recl)
1125 
        {
1126 
          gfc_status (" RECL=");
1127 
          gfc_show_expr (open->recl);
1128 
        }
1129 
      if (open->blank)
1130 
        {
1131 
          gfc_status (" BLANK=");
1132 
          gfc_show_expr (open->blank);
1133 
        }
1134 
      if (open->position)
1135 
        {
1136 
          gfc_status (" POSITION=");
1137 
          gfc_show_expr (open->position);
1138 
        }
1139 
      if (open->action)
1140 
        {
1141 
          gfc_status (" ACTION=");
1142 
          gfc_show_expr (open->action);
1143 
        }
1144 
      if (open->delim)
1145 
        {
1146 
          gfc_status (" DELIM=");
1147 
          gfc_show_expr (open->delim);
1148 
        }
1149 
      if (open->pad)
1150 
        {
1151 
          gfc_status (" PAD=");
1152 
          gfc_show_expr (open->pad);
1153 
        }
1154 
      if (open->convert)
1155 
        {
1156 
          gfc_status (" CONVERT=");
1157 
          gfc_show_expr (open->convert);
1158 
        }
1159 
      if (open->err != NULL)
1160 
        gfc_status (" ERR=%d", open->err->value);
1161 
 
1162 
      break;
1163 
 
1164 
    case EXEC_CLOSE:
1165 
      gfc_status ("CLOSE");
1166 
      close = c->ext.close;
1167 
 
1168 
      if (close->unit)
1169 
        {
1170 
          gfc_status (" UNIT=");
1171 
          gfc_show_expr (close->unit);
1172 
        }
1173 
      if (close->iomsg)
1174 
        {
1175 
          gfc_status (" IOMSG=");
1176 
          gfc_show_expr (close->iomsg);
1177 
        }
1178 
      if (close->iostat)
1179 
        {
1180 
          gfc_status (" IOSTAT=");
1181 
          gfc_show_expr (close->iostat);
1182 
        }
1183 
      if (close->status)
1184 
        {
1185 
          gfc_status (" STATUS=");
1186 
          gfc_show_expr (close->status);
1187 
        }
1188 
      if (close->err != NULL)
1189 
        gfc_status (" ERR=%d", close->err->value);
1190 
      break;
1191 
 
1192 
    case EXEC_BACKSPACE:
1193 
      gfc_status ("BACKSPACE");
1194 
      goto show_filepos;
1195 
 
1196 
    case EXEC_ENDFILE:
1197 
      gfc_status ("ENDFILE");
1198 
      goto show_filepos;
1199 
 
1200 
    case EXEC_REWIND:
1201 
      gfc_status ("REWIND");
1202 
      goto show_filepos;
1203 
 
1204 
    case EXEC_FLUSH:
1205 
      gfc_status ("FLUSH");
1206 
 
1207 
    show_filepos:
1208 
      fp = c->ext.filepos;
1209 
 
1210 
      if (fp->unit)
1211 
        {
1212 
          gfc_status (" UNIT=");
1213 
          gfc_show_expr (fp->unit);
1214 
        }
1215 
      if (fp->iomsg)
1216 
        {
1217 
          gfc_status (" IOMSG=");
1218 
          gfc_show_expr (fp->iomsg);
1219 
        }
1220 
      if (fp->iostat)
1221 
        {
1222 
          gfc_status (" IOSTAT=");
1223 
          gfc_show_expr (fp->iostat);
1224 
        }
1225 
      if (fp->err != NULL)
1226 
        gfc_status (" ERR=%d", fp->err->value);
1227 
      break;
1228 
 
1229 
    case EXEC_INQUIRE:
1230 
      gfc_status ("INQUIRE");
1231 
      i = c->ext.inquire;
1232 
 
1233 
      if (i->unit)
1234 
        {
1235 
          gfc_status (" UNIT=");
1236 
          gfc_show_expr (i->unit);
1237 
        }
1238 
      if (i->file)
1239 
        {
1240 
          gfc_status (" FILE=");
1241 
          gfc_show_expr (i->file);
1242 
        }
1243 
 
1244 
      if (i->iomsg)
1245 
        {
1246 
          gfc_status (" IOMSG=");
1247 
          gfc_show_expr (i->iomsg);
1248 
        }
1249 
      if (i->iostat)
1250 
        {
1251 
          gfc_status (" IOSTAT=");
1252 
          gfc_show_expr (i->iostat);
1253 
        }
1254 
      if (i->exist)
1255 
        {
1256 
          gfc_status (" EXIST=");
1257 
          gfc_show_expr (i->exist);
1258 
        }
1259 
      if (i->opened)
1260 
        {
1261 
          gfc_status (" OPENED=");
1262 
          gfc_show_expr (i->opened);
1263 
        }
1264 
      if (i->number)
1265 
        {
1266 
          gfc_status (" NUMBER=");
1267 
          gfc_show_expr (i->number);
1268 
        }
1269 
      if (i->named)
1270 
        {
1271 
          gfc_status (" NAMED=");
1272 
          gfc_show_expr (i->named);
1273 
        }
1274 
      if (i->name)
1275 
        {
1276 
          gfc_status (" NAME=");
1277 
          gfc_show_expr (i->name);
1278 
        }
1279 
      if (i->access)
1280 
        {
1281 
          gfc_status (" ACCESS=");
1282 
          gfc_show_expr (i->access);
1283 
        }
1284 
      if (i->sequential)
1285 
        {
1286 
          gfc_status (" SEQUENTIAL=");
1287 
          gfc_show_expr (i->sequential);
1288 
        }
1289 
 
1290 
      if (i->direct)
1291 
        {
1292 
          gfc_status (" DIRECT=");
1293 
          gfc_show_expr (i->direct);
1294 
        }
1295 
      if (i->form)
1296 
        {
1297 
          gfc_status (" FORM=");
1298 
          gfc_show_expr (i->form);
1299 
        }
1300 
      if (i->formatted)
1301 
        {
1302 
          gfc_status (" FORMATTED");
1303 
          gfc_show_expr (i->formatted);
1304 
        }
1305 
      if (i->unformatted)
1306 
        {
1307 
          gfc_status (" UNFORMATTED=");
1308 
          gfc_show_expr (i->unformatted);
1309 
        }
1310 
      if (i->recl)
1311 
        {
1312 
          gfc_status (" RECL=");
1313 
          gfc_show_expr (i->recl);
1314 
        }
1315 
      if (i->nextrec)
1316 
        {
1317 
          gfc_status (" NEXTREC=");
1318 
          gfc_show_expr (i->nextrec);
1319 
        }
1320 
      if (i->blank)
1321 
        {
1322 
          gfc_status (" BLANK=");
1323 
          gfc_show_expr (i->blank);
1324 
        }
1325 
      if (i->position)
1326 
        {
1327 
          gfc_status (" POSITION=");
1328 
          gfc_show_expr (i->position);
1329 
        }
1330 
      if (i->action)
1331 
        {
1332 
          gfc_status (" ACTION=");
1333 
          gfc_show_expr (i->action);
1334 
        }
1335 
      if (i->read)
1336 
        {
1337 
          gfc_status (" READ=");
1338 
          gfc_show_expr (i->read);
1339 
        }
1340 
      if (i->write)
1341 
        {
1342 
          gfc_status (" WRITE=");
1343 
          gfc_show_expr (i->write);
1344 
        }
1345 
      if (i->readwrite)
1346 
        {
1347 
          gfc_status (" READWRITE=");
1348 
          gfc_show_expr (i->readwrite);
1349 
        }
1350 
      if (i->delim)
1351 
        {
1352 
          gfc_status (" DELIM=");
1353 
          gfc_show_expr (i->delim);
1354 
        }
1355 
      if (i->pad)
1356 
        {
1357 
          gfc_status (" PAD=");
1358 
          gfc_show_expr (i->pad);
1359 
        }
1360 
      if (i->convert)
1361 
        {
1362 
          gfc_status (" CONVERT=");
1363 
          gfc_show_expr (i->convert);
1364 
        }
1365 
 
1366 
      if (i->err != NULL)
1367 
        gfc_status (" ERR=%d", i->err->value);
1368 
      break;
1369 
 
1370 
    case EXEC_IOLENGTH:
1371 
      gfc_status ("IOLENGTH ");
1372 
      gfc_show_expr (c->expr);
1373 
      goto show_dt_code;
1374 
      break;
1375 
 
1376 
    case EXEC_READ:
1377 
      gfc_status ("READ");
1378 
      goto show_dt;
1379 
 
1380 
    case EXEC_WRITE:
1381 
      gfc_status ("WRITE");
1382 
 
1383 
    show_dt:
1384 
      dt = c->ext.dt;
1385 
      if (dt->io_unit)
1386 
        {
1387 
          gfc_status (" UNIT=");
1388 
          gfc_show_expr (dt->io_unit);
1389 
        }
1390 
 
1391 
      if (dt->format_expr)
1392 
        {
1393 
          gfc_status (" FMT=");
1394 
          gfc_show_expr (dt->format_expr);
1395 
        }
1396 
 
1397 
      if (dt->format_label != NULL)
1398 
        gfc_status (" FMT=%d", dt->format_label->value);
1399 
      if (dt->namelist)
1400 
        gfc_status (" NML=%s", dt->namelist->name);
1401 
 
1402 
      if (dt->iomsg)
1403 
        {
1404 
          gfc_status (" IOMSG=");
1405 
          gfc_show_expr (dt->iomsg);
1406 
        }
1407 
      if (dt->iostat)
1408 
        {
1409 
          gfc_status (" IOSTAT=");
1410 
          gfc_show_expr (dt->iostat);
1411 
        }
1412 
      if (dt->size)
1413 
        {
1414 
          gfc_status (" SIZE=");
1415 
          gfc_show_expr (dt->size);
1416 
        }
1417 
      if (dt->rec)
1418 
        {
1419 
          gfc_status (" REC=");
1420 
          gfc_show_expr (dt->rec);
1421 
        }
1422 
      if (dt->advance)
1423 
        {
1424 
          gfc_status (" ADVANCE=");
1425 
          gfc_show_expr (dt->advance);
1426 
        }
1427 
 
1428 
    show_dt_code:
1429 
      gfc_status_char ('\n');
1430 
      for (c = c->block->next; c; c = c->next)
1431 
        gfc_show_code_node (level + (c->next != NULL), c);
1432 
      return;
1433 
 
1434 
    case EXEC_TRANSFER:
1435 
      gfc_status ("TRANSFER ");
1436 
      gfc_show_expr (c->expr);
1437 
      break;
1438 
 
1439 
    case EXEC_DT_END:
1440 
      gfc_status ("DT_END");
1441 
      dt = c->ext.dt;
1442 
 
1443 
      if (dt->err != NULL)
1444 
        gfc_status (" ERR=%d", dt->err->value);
1445 
      if (dt->end != NULL)
1446 
        gfc_status (" END=%d", dt->end->value);
1447 
      if (dt->eor != NULL)
1448 
        gfc_status (" EOR=%d", dt->eor->value);
1449 
      break;
1450 
 
1451 
    default:
1452 
      gfc_internal_error ("gfc_show_code_node(): Bad statement code");
1453 
    }
1454 
 
1455 
  gfc_status_char ('\n');
1456 
}
1457 
 
1458 
 
1459 
/* Show an equivalence chain.  */
1460 
 
1461 
static void
1462 
gfc_show_equiv (gfc_equiv *eq)
1463 
{
1464 
  show_indent ();
1465 
  gfc_status ("Equivalence: ");
1466 
  while (eq)
1467 
    {
1468 
      gfc_show_expr (eq->expr);
1469 
      eq = eq->eq;
1470 
      if (eq)
1471 
        gfc_status (", ");
1472 
    }
1473 
}
1474 
 
1475 
 
1476 
/* Show a freakin' whole namespace.  */
1477 
 
1478 
void
1479 
gfc_show_namespace (gfc_namespace * ns)
1480 
{
1481 
  gfc_interface *intr;
1482 
  gfc_namespace *save;
1483 
  gfc_intrinsic_op op;
1484 
  gfc_equiv *eq;
1485 
  int i;
1486 
 
1487 
  save = gfc_current_ns;
1488 
  show_level++;
1489 
 
1490 
  show_indent ();
1491 
  gfc_status ("Namespace:");
1492 
 
1493 
  if (ns != NULL)
1494 
    {
1495 
      i = 0;
1496 
      do
1497 
        {
1498 
          int l = i;
1499 
          while (i < GFC_LETTERS - 1
1500 
                 && gfc_compare_types(&ns->default_type[i+1],
1501 
                                      &ns->default_type[l]))
1502 
            i++;
1503 
 
1504 
          if (i > l)
1505 
            gfc_status(" %c-%c: ", l+'A', i+'A');
1506 
          else
1507 
            gfc_status(" %c: ", l+'A');
1508 
 
1509 
          gfc_show_typespec(&ns->default_type[l]);
1510 
          i++;
1511 
      } while (i < GFC_LETTERS);
1512 
 
1513 
      if (ns->proc_name != NULL)
1514 
        {
1515 
          show_indent ();
1516 
          gfc_status ("procedure name = %s", ns->proc_name->name);
1517 
        }
1518 
 
1519 
      gfc_current_ns = ns;
1520 
      gfc_traverse_symtree (ns->common_root, show_common);
1521 
 
1522 
      gfc_traverse_symtree (ns->sym_root, show_symtree);
1523 
 
1524 
      for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
1525 
        {
1526 
          /* User operator interfaces */
1527 
          intr = ns->operator[op];
1528 
          if (intr == NULL)
1529 
            continue;
1530 
 
1531 
          show_indent ();
1532 
          gfc_status ("Operator interfaces for %s:", gfc_op2string (op));
1533 
 
1534 
          for (; intr; intr = intr->next)
1535 
            gfc_status (" %s", intr->sym->name);
1536 
        }
1537 
 
1538 
      if (ns->uop_root != NULL)
1539 
        {
1540 
          show_indent ();
1541 
          gfc_status ("User operators:\n");
1542 
          gfc_traverse_user_op (ns, show_uop);
1543 
        }
1544 
    }
1545 
 
1546 
  for (eq = ns->equiv; eq; eq = eq->next)
1547 
    gfc_show_equiv (eq);
1548 
 
1549 
  gfc_status_char ('\n');
1550 
  gfc_status_char ('\n');
1551 
 
1552 
  gfc_show_code (0, ns->code);
1553 
 
1554 
  for (ns = ns->contained; ns; ns = ns->sibling)
1555 
    {
1556 
      show_indent ();
1557 
      gfc_status ("CONTAINS\n");
1558 
      gfc_show_namespace (ns);
1559 
    }
1560 
 
1561 
  show_level--;
1562 
  gfc_status_char ('\n');
1563 
  gfc_current_ns = save;
1564 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.