2 Copyright (C) 2003, 2004 Free Software Foundation, Inc.
3 Contributed by Steven Bosscher
5 This file is part of GCC.
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
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
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, 59 Temple Place - Suite 330, Boston, MA
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.
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
37 /* Keep track of indentation for symbol tree dumps. */
38 static int show_level = 0;
41 /* Forward declaration because this one needs all, and all need
43 static void gfc_show_expr (gfc_expr *);
45 /* Do indentation for a specific level. */
48 code_indent (int level, gfc_st_label * label)
53 gfc_status ("%-5d ", label->value);
57 for (i = 0; i < 2 * level; i++)
58 gfc_status_char (' ');
62 /* Simple indentation at the current level. This one
63 is used to show symbols. */
68 code_indent (show_level, NULL);
72 /* Show type-specific information. */
74 gfc_show_typespec (gfc_typespec * ts)
77 gfc_status ("(%s ", gfc_basic_typename (ts->type));
82 gfc_status ("%s", ts->derived->name);
86 gfc_show_expr (ts->cl->length);
90 gfc_status ("%d", ts->kind);
98 /* Show an actual argument list. */
101 gfc_show_actual_arglist (gfc_actual_arglist * a)
106 for (; a; a = a->next)
108 gfc_status_char ('(');
109 if (a->name[0] != '\0')
110 gfc_status ("%s = ", a->name);
112 gfc_show_expr (a->expr);
114 gfc_status ("(arg not-present)");
116 gfc_status_char (')');
125 /* Show an gfc_array_spec array specification structure. */
128 gfc_show_array_spec (gfc_array_spec * as)
139 gfc_status ("(%d", as->rank);
145 case AS_EXPLICIT: c = "AS_EXPLICIT"; break;
146 case AS_DEFERRED: c = "AS_DEFERRED"; break;
147 case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break;
148 case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
151 ("gfc_show_array_spec(): Unhandled array shape type.");
153 gfc_status (" %s ", c);
155 for (i = 0; i < as->rank; i++)
157 gfc_show_expr (as->lower[i]);
158 gfc_status_char (' ');
159 gfc_show_expr (as->upper[i]);
160 gfc_status_char (' ');
168 /* Show an gfc_array_ref array reference structure. */
171 gfc_show_array_ref (gfc_array_ref * ar)
175 gfc_status_char ('(');
184 for (i = 0; i < ar->dimen; i++)
186 /* There are two types of array sections: either the
187 elements are identified by an integer array ('vector'),
188 or by an index range. In the former case we only have to
189 print the start expression which contains the vector, in
190 the latter case we have to print any of lower and upper
191 bound and the stride, if they're present. */
193 if (ar->start[i] != NULL)
194 gfc_show_expr (ar->start[i]);
196 if (ar->dimen_type[i] == DIMEN_RANGE)
198 gfc_status_char (':');
200 if (ar->end[i] != NULL)
201 gfc_show_expr (ar->end[i]);
203 if (ar->stride[i] != NULL)
205 gfc_status_char (':');
206 gfc_show_expr (ar->stride[i]);
210 if (i != ar->dimen - 1)
216 for (i = 0; i < ar->dimen; i++)
218 gfc_show_expr (ar->start[i]);
219 if (i != ar->dimen - 1)
225 gfc_status ("UNKNOWN");
229 gfc_internal_error ("gfc_show_array_ref(): Unknown array reference");
232 gfc_status_char (')');
236 /* Show a list of gfc_ref structures. */
239 gfc_show_ref (gfc_ref * p)
242 for (; p; p = p->next)
246 gfc_show_array_ref (&p->u.ar);
250 gfc_status (" %% %s", p->u.c.component->name);
254 gfc_status_char ('(');
255 gfc_show_expr (p->u.ss.start);
256 gfc_status_char (':');
257 gfc_show_expr (p->u.ss.end);
258 gfc_status_char (')');
262 gfc_internal_error ("gfc_show_ref(): Bad component code");
267 /* Display a constructor. Works recursively for array constructors. */
270 gfc_show_constructor (gfc_constructor * c)
273 for (; c; c = c->next)
275 if (c->iterator == NULL)
276 gfc_show_expr (c->expr);
279 gfc_status_char ('(');
280 gfc_show_expr (c->expr);
282 gfc_status_char (' ');
283 gfc_show_expr (c->iterator->var);
284 gfc_status_char ('=');
285 gfc_show_expr (c->iterator->start);
286 gfc_status_char (',');
287 gfc_show_expr (c->iterator->end);
288 gfc_status_char (',');
289 gfc_show_expr (c->iterator->step);
291 gfc_status_char (')');
300 /* Show an expression. */
303 gfc_show_expr (gfc_expr * p)
314 switch (p->expr_type)
317 c = p->value.character.string;
319 for (i = 0; i < p->value.character.length; i++, c++)
324 gfc_status ("%c", *c);
327 gfc_show_ref (p->ref);
331 gfc_status ("%s(", p->ts.derived->name);
332 gfc_show_constructor (p->value.constructor);
333 gfc_status_char (')');
338 gfc_show_constructor (p->value.constructor);
341 gfc_show_ref (p->ref);
345 gfc_status ("NULL()");
352 mpz_out_str (stdout, 10, p->value.integer);
354 if (p->ts.kind != gfc_default_integer_kind)
355 gfc_status ("_%d", p->ts.kind);
359 if (p->value.logical)
360 gfc_status (".true.");
362 gfc_status (".false.");
366 mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
367 if (p->ts.kind != gfc_default_real_kind)
368 gfc_status ("_%d", p->ts.kind);
372 c = p->value.character.string;
374 gfc_status_char ('\'');
376 for (i = 0; i < p->value.character.length; i++, c++)
381 gfc_status_char (*c);
384 gfc_status_char ('\'');
389 gfc_status ("(complex ");
391 mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE);
392 if (p->ts.kind != gfc_default_complex_kind)
393 gfc_status ("_%d", p->ts.kind);
397 mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE);
398 if (p->ts.kind != gfc_default_complex_kind)
399 gfc_status ("_%d", p->ts.kind);
412 gfc_status ("%s", p->symtree->n.sym->name);
413 gfc_show_ref (p->ref);
418 switch (p->value.op.operator)
420 case INTRINSIC_UPLUS:
423 case INTRINSIC_UMINUS:
429 case INTRINSIC_MINUS:
432 case INTRINSIC_TIMES:
435 case INTRINSIC_DIVIDE:
438 case INTRINSIC_POWER:
441 case INTRINSIC_CONCAT:
454 gfc_status ("NEQV ");
480 ("gfc_show_expr(): Bad intrinsic in expression!");
483 gfc_show_expr (p->value.op.op1);
488 gfc_show_expr (p->value.op.op2);
495 if (p->value.function.name == NULL)
497 gfc_status ("%s[", p->symtree->n.sym->name);
498 gfc_show_actual_arglist (p->value.function.actual);
499 gfc_status_char (']');
503 gfc_status ("%s[[", p->value.function.name);
504 gfc_show_actual_arglist (p->value.function.actual);
505 gfc_status_char (']');
506 gfc_status_char (']');
512 gfc_internal_error ("gfc_show_expr(): Don't know how to show expr");
517 /* Show symbol attributes. The flavor and intent are followed by
518 whatever single bit attributes are present. */
521 gfc_show_attr (symbol_attribute * attr)
524 gfc_status ("(%s %s %s %s", gfc_code2string (flavors, attr->flavor),
525 gfc_intent_string (attr->intent),
526 gfc_code2string (access_types, attr->access),
527 gfc_code2string (procedures, attr->proc));
529 if (attr->allocatable)
530 gfc_status (" ALLOCATABLE");
532 gfc_status (" DIMENSION");
534 gfc_status (" EXTERNAL");
536 gfc_status (" INTRINSIC");
538 gfc_status (" OPTIONAL");
540 gfc_status (" POINTER");
542 gfc_status (" SAVE");
544 gfc_status (" TARGET");
546 gfc_status (" DUMMY");
548 gfc_status (" RESULT");
550 gfc_status (" ENTRY");
553 gfc_status (" DATA");
555 gfc_status (" USE-ASSOC");
556 if (attr->in_namelist)
557 gfc_status (" IN-NAMELIST");
559 gfc_status (" IN-COMMON");
562 gfc_status (" FUNCTION");
563 if (attr->subroutine)
564 gfc_status (" SUBROUTINE");
565 if (attr->implicit_type)
566 gfc_status (" IMPLICIT-TYPE");
569 gfc_status (" SEQUENCE");
571 gfc_status (" ELEMENTAL");
573 gfc_status (" PURE");
575 gfc_status (" RECURSIVE");
581 /* Show components of a derived type. */
584 gfc_show_components (gfc_symbol * sym)
588 for (c = sym->components; c; c = c->next)
590 gfc_status ("(%s ", c->name);
591 gfc_show_typespec (&c->ts);
593 gfc_status (" POINTER");
595 gfc_status (" DIMENSION");
596 gfc_status_char (' ');
597 gfc_show_array_spec (c->as);
600 gfc_status_char (' ');
605 /* Show a symbol. If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
606 show the interface. Information needed to reconstruct the list of
607 specific interfaces associated with a generic symbol is done within
611 gfc_show_symbol (gfc_symbol * sym)
613 gfc_formal_arglist *formal;
621 gfc_status ("symbol %s ", sym->name);
622 gfc_show_typespec (&sym->ts);
623 gfc_show_attr (&sym->attr);
628 gfc_status ("value: ");
629 gfc_show_expr (sym->value);
635 gfc_status ("Array spec:");
636 gfc_show_array_spec (sym->as);
642 gfc_status ("Generic interfaces:");
643 for (intr = sym->generic; intr; intr = intr->next)
644 gfc_status (" %s", intr->sym->name);
650 gfc_status ("result: %s", sym->result->name);
656 gfc_status ("components: ");
657 gfc_show_components (sym);
663 gfc_status ("Formal arglist:");
665 for (formal = sym->formal; formal; formal = formal->next)
666 gfc_status (" %s", formal->sym->name);
672 gfc_status ("Formal namespace");
673 gfc_show_namespace (sym->formal_ns);
676 gfc_status_char ('\n');
680 /* Show a user-defined operator. Just prints an operator
681 and the name of the associated subroutine, really. */
683 show_uop (gfc_user_op * uop)
688 gfc_status ("%s:", uop->name);
690 for (intr = uop->operator; intr; intr = intr->next)
691 gfc_status (" %s", intr->sym->name);
695 /* Workhorse function for traversing the user operator symtree. */
698 traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
706 traverse_uop (st->left, func);
707 traverse_uop (st->right, func);
711 /* Traverse the tree of user operator nodes. */
714 gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
717 traverse_uop (ns->uop_root, func);
721 /* Function to display a common block. */
724 show_common (gfc_symtree * st)
729 gfc_status ("common: /%s/ ", st->name);
731 s = st->n.common->head;
734 gfc_status ("%s", s->name);
739 gfc_status_char ('\n');
742 /* Worker function to display the symbol tree. */
745 show_symtree (gfc_symtree * st)
749 gfc_status ("symtree: %s Ambig %d", st->name, st->ambiguous);
751 if (st->n.sym->ns != gfc_current_ns)
752 gfc_status (" from namespace %s", st->n.sym->ns->proc_name->name);
754 gfc_show_symbol (st->n.sym);
758 /******************* Show gfc_code structures **************/
762 static void gfc_show_code_node (int level, gfc_code * c);
764 /* Show a list of code structures. Mutually recursive with
765 gfc_show_code_node(). */
768 gfc_show_code (int level, gfc_code * c)
771 for (; c; c = c->next)
772 gfc_show_code_node (level, c);
776 /* Show a single code node and everything underneath it if necessary. */
779 gfc_show_code_node (int level, gfc_code * c)
781 gfc_forall_iterator *fa;
791 code_indent (level, c->here);
800 gfc_status ("CONTINUE");
804 gfc_status ("ENTRY %s", c->ext.entry->sym->name);
808 gfc_status ("ASSIGN ");
809 gfc_show_expr (c->expr);
810 gfc_status_char (' ');
811 gfc_show_expr (c->expr2);
814 case EXEC_LABEL_ASSIGN:
815 gfc_status ("LABEL ASSIGN ");
816 gfc_show_expr (c->expr);
817 gfc_status (" %d", c->label->value);
820 case EXEC_POINTER_ASSIGN:
821 gfc_status ("POINTER ASSIGN ");
822 gfc_show_expr (c->expr);
823 gfc_status_char (' ');
824 gfc_show_expr (c->expr2);
828 gfc_status ("GOTO ");
830 gfc_status ("%d", c->label->value);
833 gfc_show_expr (c->expr);
838 for (; d; d = d ->block)
840 code_indent (level, d->label);
841 if (d->block != NULL)
842 gfc_status_char (',');
844 gfc_status_char (')');
851 gfc_status ("CALL %s ", c->resolved_sym->name);
852 gfc_show_actual_arglist (c->ext.actual);
856 gfc_status ("RETURN ");
858 gfc_show_expr (c->expr);
862 gfc_status ("PAUSE ");
865 gfc_show_expr (c->expr);
867 gfc_status ("%d", c->ext.stop_code);
872 gfc_status ("STOP ");
875 gfc_show_expr (c->expr);
877 gfc_status ("%d", c->ext.stop_code);
881 case EXEC_ARITHMETIC_IF:
883 gfc_show_expr (c->expr);
884 gfc_status (" %d, %d, %d",
885 c->label->value, c->label2->value, c->label3->value);
891 gfc_show_expr (d->expr);
892 gfc_status_char ('\n');
893 gfc_show_code (level + 1, d->next);
896 for (; d; d = d->block)
898 code_indent (level, 0);
901 gfc_status ("ELSE\n");
904 gfc_status ("ELSE IF ");
905 gfc_show_expr (d->expr);
906 gfc_status_char ('\n');
909 gfc_show_code (level + 1, d->next);
912 code_indent (level, c->label);
914 gfc_status ("ENDIF");
919 gfc_status ("SELECT CASE ");
920 gfc_show_expr (c->expr);
921 gfc_status_char ('\n');
923 for (; d; d = d->block)
925 code_indent (level, 0);
927 gfc_status ("CASE ");
928 for (cp = d->ext.case_list; cp; cp = cp->next)
930 gfc_status_char ('(');
931 gfc_show_expr (cp->low);
932 gfc_status_char (' ');
933 gfc_show_expr (cp->high);
934 gfc_status_char (')');
935 gfc_status_char (' ');
937 gfc_status_char ('\n');
939 gfc_show_code (level + 1, d->next);
942 code_indent (level, c->label);
943 gfc_status ("END SELECT");
947 gfc_status ("WHERE ");
950 gfc_show_expr (d->expr);
951 gfc_status_char ('\n');
953 gfc_show_code (level + 1, d->next);
955 for (d = d->block; d; d = d->block)
957 code_indent (level, 0);
958 gfc_status ("ELSE WHERE ");
959 gfc_show_expr (d->expr);
960 gfc_status_char ('\n');
961 gfc_show_code (level + 1, d->next);
964 code_indent (level, 0);
965 gfc_status ("END WHERE");
970 gfc_status ("FORALL ");
971 for (fa = c->ext.forall_iterator; fa; fa = fa->next)
973 gfc_show_expr (fa->var);
974 gfc_status_char (' ');
975 gfc_show_expr (fa->start);
976 gfc_status_char (':');
977 gfc_show_expr (fa->end);
978 gfc_status_char (':');
979 gfc_show_expr (fa->stride);
981 if (fa->next != NULL)
982 gfc_status_char (',');
987 gfc_status_char (',');
988 gfc_show_expr (c->expr);
990 gfc_status_char ('\n');
992 gfc_show_code (level + 1, c->block->next);
994 code_indent (level, 0);
995 gfc_status ("END FORALL");
1001 gfc_show_expr (c->ext.iterator->var);
1002 gfc_status_char ('=');
1003 gfc_show_expr (c->ext.iterator->start);
1004 gfc_status_char (' ');
1005 gfc_show_expr (c->ext.iterator->end);
1006 gfc_status_char (' ');
1007 gfc_show_expr (c->ext.iterator->step);
1008 gfc_status_char ('\n');
1010 gfc_show_code (level + 1, c->block->next);
1012 code_indent (level, 0);
1013 gfc_status ("END DO");
1017 gfc_status ("DO WHILE ");
1018 gfc_show_expr (c->expr);
1019 gfc_status_char ('\n');
1021 gfc_show_code (level + 1, c->block->next);
1023 code_indent (level, c->label);
1024 gfc_status ("END DO");
1028 gfc_status ("CYCLE");
1030 gfc_status (" %s", c->symtree->n.sym->name);
1034 gfc_status ("EXIT");
1036 gfc_status (" %s", c->symtree->n.sym->name);
1040 gfc_status ("ALLOCATE ");
1043 gfc_status (" STAT=");
1044 gfc_show_expr (c->expr);
1047 for (a = c->ext.alloc_list; a; a = a->next)
1049 gfc_status_char (' ');
1050 gfc_show_expr (a->expr);
1055 case EXEC_DEALLOCATE:
1056 gfc_status ("DEALLOCATE ");
1059 gfc_status (" STAT=");
1060 gfc_show_expr (c->expr);
1063 for (a = c->ext.alloc_list; a; a = a->next)
1065 gfc_status_char (' ');
1066 gfc_show_expr (a->expr);
1072 gfc_status ("OPEN");
1077 gfc_status (" UNIT=");
1078 gfc_show_expr (open->unit);
1082 gfc_status (" IOSTAT=");
1083 gfc_show_expr (open->iostat);
1087 gfc_status (" FILE=");
1088 gfc_show_expr (open->file);
1092 gfc_status (" STATUS=");
1093 gfc_show_expr (open->status);
1097 gfc_status (" ACCESS=");
1098 gfc_show_expr (open->access);
1102 gfc_status (" FORM=");
1103 gfc_show_expr (open->form);
1107 gfc_status (" RECL=");
1108 gfc_show_expr (open->recl);
1112 gfc_status (" BLANK=");
1113 gfc_show_expr (open->blank);
1117 gfc_status (" POSITION=");
1118 gfc_show_expr (open->position);
1122 gfc_status (" ACTION=");
1123 gfc_show_expr (open->action);
1127 gfc_status (" DELIM=");
1128 gfc_show_expr (open->delim);
1132 gfc_status (" PAD=");
1133 gfc_show_expr (open->pad);
1135 if (open->err != NULL)
1136 gfc_status (" ERR=%d", open->err->value);
1141 gfc_status ("CLOSE");
1142 close = c->ext.close;
1146 gfc_status (" UNIT=");
1147 gfc_show_expr (close->unit);
1151 gfc_status (" IOSTAT=");
1152 gfc_show_expr (close->iostat);
1156 gfc_status (" STATUS=");
1157 gfc_show_expr (close->status);
1159 if (close->err != NULL)
1160 gfc_status (" ERR=%d", close->err->value);
1163 case EXEC_BACKSPACE:
1164 gfc_status ("BACKSPACE");
1168 gfc_status ("ENDFILE");
1172 gfc_status ("REWIND");
1175 fp = c->ext.filepos;
1179 gfc_status (" UNIT=");
1180 gfc_show_expr (fp->unit);
1184 gfc_status (" IOSTAT=");
1185 gfc_show_expr (fp->iostat);
1187 if (fp->err != NULL)
1188 gfc_status (" ERR=%d", fp->err->value);
1192 gfc_status ("INQUIRE");
1197 gfc_status (" UNIT=");
1198 gfc_show_expr (i->unit);
1202 gfc_status (" FILE=");
1203 gfc_show_expr (i->file);
1208 gfc_status (" IOSTAT=");
1209 gfc_show_expr (i->iostat);
1213 gfc_status (" EXIST=");
1214 gfc_show_expr (i->exist);
1218 gfc_status (" OPENED=");
1219 gfc_show_expr (i->opened);
1223 gfc_status (" NUMBER=");
1224 gfc_show_expr (i->number);
1228 gfc_status (" NAMED=");
1229 gfc_show_expr (i->named);
1233 gfc_status (" NAME=");
1234 gfc_show_expr (i->name);
1238 gfc_status (" ACCESS=");
1239 gfc_show_expr (i->access);
1243 gfc_status (" SEQUENTIAL=");
1244 gfc_show_expr (i->sequential);
1249 gfc_status (" DIRECT=");
1250 gfc_show_expr (i->direct);
1254 gfc_status (" FORM=");
1255 gfc_show_expr (i->form);
1259 gfc_status (" FORMATTED");
1260 gfc_show_expr (i->formatted);
1264 gfc_status (" UNFORMATTED=");
1265 gfc_show_expr (i->unformatted);
1269 gfc_status (" RECL=");
1270 gfc_show_expr (i->recl);
1274 gfc_status (" NEXTREC=");
1275 gfc_show_expr (i->nextrec);
1279 gfc_status (" BLANK=");
1280 gfc_show_expr (i->blank);
1284 gfc_status (" POSITION=");
1285 gfc_show_expr (i->position);
1289 gfc_status (" ACTION=");
1290 gfc_show_expr (i->action);
1294 gfc_status (" READ=");
1295 gfc_show_expr (i->read);
1299 gfc_status (" WRITE=");
1300 gfc_show_expr (i->write);
1304 gfc_status (" READWRITE=");
1305 gfc_show_expr (i->readwrite);
1309 gfc_status (" DELIM=");
1310 gfc_show_expr (i->delim);
1314 gfc_status (" PAD=");
1315 gfc_show_expr (i->pad);
1319 gfc_status (" ERR=%d", i->err->value);
1323 gfc_status ("IOLENGTH ");
1324 gfc_show_expr (c->expr);
1328 gfc_status ("READ");
1332 gfc_status ("WRITE");
1338 gfc_status (" UNIT=");
1339 gfc_show_expr (dt->io_unit);
1342 if (dt->format_expr)
1344 gfc_status (" FMT=");
1345 gfc_show_expr (dt->format_expr);
1348 if (dt->format_label != NULL)
1349 gfc_status (" FMT=%d", dt->format_label->value);
1351 gfc_status (" NML=%s", dt->namelist->name);
1354 gfc_status (" IOSTAT=");
1355 gfc_show_expr (dt->iostat);
1359 gfc_status (" SIZE=");
1360 gfc_show_expr (dt->size);
1364 gfc_status (" REC=");
1365 gfc_show_expr (dt->rec);
1369 gfc_status (" ADVANCE=");
1370 gfc_show_expr (dt->advance);
1376 gfc_status ("TRANSFER ");
1377 gfc_show_expr (c->expr);
1381 gfc_status ("DT_END");
1384 if (dt->err != NULL)
1385 gfc_status (" ERR=%d", dt->err->value);
1386 if (dt->end != NULL)
1387 gfc_status (" END=%d", dt->end->value);
1388 if (dt->eor != NULL)
1389 gfc_status (" EOR=%d", dt->eor->value);
1393 gfc_internal_error ("gfc_show_code_node(): Bad statement code");
1396 gfc_status_char ('\n');
1400 /* Show and equivalence chain. */
1403 gfc_show_equiv (gfc_equiv *eq)
1406 gfc_status ("Equivalence: ");
1409 gfc_show_expr (eq->expr);
1417 /* Show a freakin' whole namespace. */
1420 gfc_show_namespace (gfc_namespace * ns)
1422 gfc_interface *intr;
1423 gfc_namespace *save;
1424 gfc_intrinsic_op op;
1428 save = gfc_current_ns;
1432 gfc_status ("Namespace:");
1440 while (i < GFC_LETTERS - 1
1441 && gfc_compare_types(&ns->default_type[i+1],
1442 &ns->default_type[l]))
1446 gfc_status(" %c-%c: ", l+'A', i+'A');
1448 gfc_status(" %c: ", l+'A');
1450 gfc_show_typespec(&ns->default_type[l]);
1452 } while (i < GFC_LETTERS);
1454 if (ns->proc_name != NULL)
1457 gfc_status ("procedure name = %s", ns->proc_name->name);
1460 gfc_current_ns = ns;
1461 gfc_traverse_symtree (ns->common_root, show_common);
1463 gfc_traverse_symtree (ns->sym_root, show_symtree);
1465 for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
1467 /* User operator interfaces */
1468 intr = ns->operator[op];
1473 gfc_status ("Operator interfaces for %s:", gfc_op2string (op));
1475 for (; intr; intr = intr->next)
1476 gfc_status (" %s", intr->sym->name);
1479 if (ns->uop_root != NULL)
1482 gfc_status ("User operators:\n");
1483 gfc_traverse_user_op (ns, show_uop);
1487 for (eq = ns->equiv; eq; eq = eq->next)
1488 gfc_show_equiv (eq);
1490 gfc_status_char ('\n');
1491 gfc_status_char ('\n');
1493 gfc_show_code (0, ns->code);
1495 for (ns = ns->contained; ns; ns = ns->sibling)
1498 gfc_status ("CONTAINS\n");
1499 gfc_show_namespace (ns);
1503 gfc_status_char ('\n');
1504 gfc_current_ns = save;