2 Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
5 This file is part of GNU Fortran.
7 GNU Fortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Fortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
22 /* From f/proj.h, which uses #error -- not all C compilers
23 support that, and we want *this* program to be compilable
24 by pretty much any C compiler. */
29 /* Pull in the intrinsics info, but only the doc parts. */
30 #define FFEINTRIN_DOC 1
33 const char *family_name (ffeintrinFamily family);
34 static void dumpif (ffeintrinFamily fam);
35 static void dumpendif (void);
36 static void dumpclearif (void);
37 static void dumpem (void);
38 static void dumpgen (int menu, const char *name, const char *name_uc,
40 static void dumpspec (int menu, const char *name, const char *name_uc,
42 static void dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ffeintrinFamily family,
43 ffeintrinImp imp, ffeintrinSpec spec);
44 static const char *argument_info_ptr (ffeintrinImp imp, int argno);
45 static const char *argument_info_string (ffeintrinImp imp, int argno);
46 static const char *argument_name_ptr (ffeintrinImp imp, int argno);
47 static const char *argument_name_string (ffeintrinImp imp, int argno);
49 static const char *elaborate_if_complex (ffeintrinImp imp, int argno);
50 static const char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
51 static const char *elaborate_if_real (ffeintrinImp imp, int argno);
53 static void print_type_string (const char *c);
56 main (int argc, char **argv ATTRIBUTE_UNUSED)
61 Usage: intdoc > intdoc.texi\n\
62 Collects and dumps documentation on g77 intrinsics\n\
63 to the file named intdoc.texi.\n");
71 struct _ffeintrin_name_
73 const char *const name_uc;
74 const char *const name_lc;
75 const char *const name_ic;
76 const ffeintrinGen generic;
77 const ffeintrinSpec specific;
80 struct _ffeintrin_gen_
82 const char *const name; /* Name as seen in program. */
83 const ffeintrinSpec specs[2];
86 struct _ffeintrin_spec_
88 const char *const name; /* Uppercase name as seen in source code,
89 lowercase if no source name, "none" if no
90 name at all (NONE case). */
91 const bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
92 const ffeintrinFamily family;
93 const ffeintrinImp implementation;
96 struct _ffeintrin_imp_
98 const char *const name; /* Name of implementation. */
99 const char *const control;
102 static const struct _ffeintrin_name_ names[] = {
103 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
104 { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
105 #define DEFGEN(CODE,NAME,SPEC1,SPEC2)
106 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
107 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
108 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
109 #include "intrin.def"
117 static const struct _ffeintrin_gen_ gens[] = {
118 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
119 #define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
120 { NAME, { SPEC1, SPEC2, }, },
121 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
122 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
123 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
124 #include "intrin.def"
132 static const struct _ffeintrin_imp_ imps[] = {
133 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
134 #define DEFGEN(CODE,NAME,SPEC1,SPEC2)
135 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
136 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
138 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
140 #include "intrin.def"
148 static const struct _ffeintrin_spec_ specs[] = {
149 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
150 #define DEFGEN(CODE,NAME,SPEC1,SPEC2)
151 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
152 { NAME, CALLABLE, FAMILY, IMP, },
153 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
154 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
155 #include "intrin.def"
162 struct cc_pair { const ffeintrinImp imp; const char *const text; };
164 static const char *descriptions[FFEINTRIN_imp] = { 0 };
165 static const struct cc_pair cc_descriptions[] = {
166 #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
171 static const char *summaries[FFEINTRIN_imp] = { 0 };
172 static const struct cc_pair cc_summaries[] = {
173 #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
179 family_name (ffeintrinFamily family)
183 case FFEINTRIN_familyF77:
186 case FFEINTRIN_familyASC:
189 case FFEINTRIN_familyMIL:
192 case FFEINTRIN_familyGNU:
195 case FFEINTRIN_familyF90:
198 case FFEINTRIN_familyVXT:
201 case FFEINTRIN_familyFVZ:
204 case FFEINTRIN_familyF2C:
207 case FFEINTRIN_familyF2U:
210 case FFEINTRIN_familyBADU77:
211 return "familyBADU77";
214 assert ("bad family" == NULL);
219 static int in_ifset = 0;
220 static ffeintrinFamily latest_family = FFEINTRIN_familyNONE;
223 dumpif (ffeintrinFamily fam)
225 assert (fam != FFEINTRIN_familyNONE);
227 || (fam != latest_family))
230 printf ("@end ifset\n");
232 printf ("@ifset %s\n", family_name (fam));
247 || (latest_family != FFEINTRIN_familyNONE))
248 printf ("@end ifset\n");
249 latest_family = FFEINTRIN_familyNONE;
258 for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_descriptions); ++i)
260 assert (descriptions[cc_descriptions[i].imp] == NULL);
261 descriptions[cc_descriptions[i].imp] = cc_descriptions[i].text;
264 for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_summaries); ++i)
266 assert (summaries[cc_summaries[i].imp] == NULL);
267 summaries[cc_summaries[i].imp] = cc_summaries[i].text;
270 printf ("@c This file is automatically derived from intdoc.c, intdoc.in,\n");
271 printf ("@c ansify.c, intrin.def, and intrin.h. Edit those files instead.\n");
273 for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
275 if (names[i].generic != FFEINTRIN_genNONE)
276 dumpgen (1, names[i].name_ic, names[i].name_uc,
278 if (names[i].specific != FFEINTRIN_specNONE)
279 dumpspec (1, names[i].name_ic, names[i].name_uc,
284 printf ("@end menu\n\n");
286 for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
288 if (names[i].generic != FFEINTRIN_genNONE)
289 dumpgen (0, names[i].name_ic, names[i].name_uc,
291 if (names[i].specific != FFEINTRIN_specNONE)
292 dumpspec (0, names[i].name_ic, names[i].name_uc,
299 dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen)
306 for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
308 if (gens[gen].specs[i] != FFEINTRIN_specNONE)
313 for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
318 if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE)
321 dumpif (specs[spec].family);
322 dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation,
324 if (!menu && (total > 0))
329 For information on another intrinsic with the same name:\n");
334 For information on other intrinsics with the same name:\n");
336 for (j = 0; j < ARRAY_SIZE (gens[gen].specs); ++j)
340 if ((spec = gens[gen].specs[j]) == FFEINTRIN_specNONE)
342 printf ("@xref{%s Intrinsic (%s)}.\n",
343 name, specs[spec].name);
352 dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec)
354 dumpif (specs[spec].family);
355 dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation,
361 dumpimp (int menu, const char *name, const char *name_uc, size_t genno,
362 ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec)
371 assert ((imp != FFEINTRIN_impNONE) || !genno);
375 printf ("* %s Intrinsic",
377 if (spec != FFEINTRIN_specNONE)
378 printf (" (%s)", specs[spec].name); /* See XYZZY1 below */
380 #define INDENT_SUMMARY 24
381 if ((imp == FFEINTRIN_impNONE)
382 || (summaries[imp] != NULL))
384 int spaces = INDENT_SUMMARY - 14 - strlen (name);
387 if (spec != FFEINTRIN_specNONE)
388 spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */
394 if (imp == FFEINTRIN_impNONE)
396 printf ("(Reserved for future use.)\n");
400 for (c = summaries[imp]; c[0] != '\0'; ++c)
402 if (c[0] == '@' && ISDIGIT (c[1]))
404 int argno = c[1] - '0';
407 while (ISDIGIT (c[0]))
409 argno = 10 * argno + (c[0] - '0');
412 assert (c[0] == '@');
415 else if (argno == 99)
416 { /* Yeah, this is a major kludge. */
418 spaces = INDENT_SUMMARY + 1;
423 printf ("%s", argument_name_string (imp, argno - 1));
426 fputc (c[0], stdout);
433 printf ("@node %s Intrinsic", name);
434 if (spec != FFEINTRIN_specNONE)
435 printf (" (%s)", specs[spec].name);
436 printf ("\n@subsubsection %s Intrinsic", name);
437 if (spec != FFEINTRIN_specNONE)
438 printf (" (%s)", specs[spec].name);
439 printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n",
442 if (imp == FFEINTRIN_impNONE)
445 This intrinsic is not yet implemented.\n\
446 The name is, however, reserved as an intrinsic.\n\
447 Use @samp{EXTERNAL %s} to use this name for an\n\
448 external procedure.\n\
455 c = imps[imp].control;
456 subr = (c[0] == '-');
457 colon = (c[2] == ':') ? 2 : 3;
463 (subr ? "CALL " : ""), name);
467 for (argno = 0; ; ++argno)
469 argc = argument_name_ptr (imp, argno);
474 printf ("@var{%s}", argc);
475 argi = argument_info_string (imp, argno);
480 printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
492 const char *arg_string;
493 const char *arg_info;
495 if (ISDIGIT (c[colon + 1]))
497 other_arg = c[colon + 1] - '0';
498 arg_string = argument_name_string (imp, other_arg);
499 arg_info = argument_info_string (imp, other_arg);
511 print_type_string (c);
512 printf (" function");
517 assert (other_arg >= 0);
519 if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
520 || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
522 if ((arg_info[0] == 'F') || (arg_info[0] == 'N'))
524 The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is\n\
525 any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.\n\
526 When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},\n\
527 this intrinsic is valid only when used as the argument to\n\
528 @code{REAL()}, as explained below.\n\n",
533 This intrinsic is valid when argument @var{%s} is\n\
534 @code{COMPLEX(KIND=1)}.\n\
535 When @var{%s} is any other @code{COMPLEX} type,\n\
536 this intrinsic is valid only when used as the argument to\n\
537 @code{REAL()}, as explained below.\n\n",
542 else if ((c[0] == 'I')
544 printf (", the exact type being wide enough to hold a pointer\n\
545 on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
547 else if (c[1] == '=' && ISDIGIT (c[colon + 1]))
549 assert (other_arg >= 0);
551 if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
552 || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
555 if (((c[0] == arg_info[0])
556 && ((c[0] == 'A') || (c[0] == 'C') || (c[0] == 'I')
557 || (c[0] == 'L') || (c[0] == 'R')))
559 && (arg_info[0] == 'C'))
561 && (arg_info[0] == 'R')))
562 printf (", the @samp{KIND=} value of the type being that of argument @var{%s}.\n\n",
564 else if ((c[0] == 'S')
565 && ((arg_info[0] == 'C')
566 || (arg_info[0] == 'F')
567 || (arg_info[0] == 'N')))
569 The exact type depends on that of argument @var{%s}---if @var{%s} is\n\
570 @code{COMPLEX}, this function's type is @code{REAL}\n\
571 with the same @samp{KIND=} value as the type of @var{%s}.\n\
572 Otherwise, this function's type is the same as that of @var{%s}.\n\n",
573 arg_string, arg_string, arg_string, arg_string);
575 printf (", the exact type being that of argument @var{%s}.\n\n",
578 else if ((c[1] == '=')
579 && (c[colon + 1] == '*'))
580 printf (", the exact type being the result of cross-promoting the\n\
581 types of all the arguments.\n\n");
582 else if (c[1] == '=')
583 assert ("?0:?:" == NULL);
588 for (argno = 0, argc = &c[colon + 3]; *argc != '\0'; ++argno)
590 char optionality = '\0';
604 printf ("%c", *argc);
615 optionality = *(argc++);
620 length = *++argc - '0';
622 length = 10 * length + (*(argc++) - '0');
629 elements = *++argc - '0';
631 elements = 10 * elements + (*(argc++) - '0');
634 else if (*argc == '&')
659 assert ("kind arg" == NULL);
665 assert ((kind == '1') || (kind == '*'));
666 printf ("@code{CHARACTER");
668 printf ("*%d", length);
676 printf ("@code{COMPLEX}");
679 case '1': case '2': case '3': case '4': case '5':
680 case '6': case '7': case '8': case '9':
681 printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
685 printf ("Same @samp{KIND=} value as for @var{%s}",
686 argument_name_string (imp, 0));
690 assert ("Ca" == NULL);
699 printf ("@code{INTEGER}");
702 case '1': case '2': case '3': case '4': case '5':
703 case '6': case '7': case '8': case '9':
704 printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
708 printf ("@code{INTEGER} with same @samp{KIND=} value as for @var{%s}",
709 argument_name_string (imp, 0));
713 assert ("Ia" == NULL);
722 printf ("@code{LOGICAL}");
725 case '1': case '2': case '3': case '4': case '5':
726 case '6': case '7': case '8': case '9':
727 printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
731 printf ("@code{LOGICAL} with same @samp{KIND=} value as for @var{%s}",
732 argument_name_string (imp, 0));
736 assert ("La" == NULL);
745 printf ("@code{REAL}");
748 case '1': case '2': case '3': case '4': case '5':
749 case '6': case '7': case '8': case '9':
750 printf ("@code{REAL(KIND=%d)}", (kind - '0'));
754 printf ("@code{REAL} with same @samp{KIND=} value as for @var{%s}",
755 argument_name_string (imp, 0));
759 assert ("Ra" == NULL);
768 printf ("@code{INTEGER} or @code{LOGICAL}");
771 case '1': case '2': case '3': case '4': case '5':
772 case '6': case '7': case '8': case '9':
773 printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
774 (kind - '0'), (kind - '0'));
778 printf ("Same type and @samp{KIND=} value as for @var{%s}",
779 argument_name_string (imp, 0));
783 assert ("Ba" == NULL);
792 printf ("@code{REAL} or @code{COMPLEX}");
795 case '1': case '2': case '3': case '4': case '5':
796 case '6': case '7': case '8': case '9':
797 printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
798 (kind - '0'), (kind - '0'));
802 printf ("Same type as @var{%s}",
803 argument_name_string (imp, 0));
807 assert ("Fa" == NULL);
816 printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
819 case '1': case '2': case '3': case '4': case '5':
820 case '6': case '7': case '8': case '9':
821 printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
822 (kind - '0'), (kind - '0'), (kind - '0'));
826 assert ("N1" == NULL);
835 printf ("@code{INTEGER} or @code{REAL}");
838 case '1': case '2': case '3': case '4': case '5':
839 case '6': case '7': case '8': case '9':
840 printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
841 (kind - '0'), (kind - '0'));
845 printf ("@code{INTEGER} or @code{REAL} with same @samp{KIND=} value as for @var{%s}",
846 argument_name_string (imp, 0));
850 assert ("Sa" == NULL);
856 printf ("@samp{*@var{label}}, where @var{label} is the label\n\
857 of an executable statement");
861 printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})\n\
862 or dummy/global @code{INTEGER(KIND=1)} scalar");
866 assert ("arg type?" == NULL);
876 printf ("; OPTIONAL (must be omitted if @var{%s} is @code{COMPLEX})",
877 argument_name_string (imp, argno-1));
881 printf ("; OPTIONAL");
885 printf ("; OPTIONAL");
893 printf ("; at least two such arguments must be provided");
897 assert ("optionality!" == NULL);
913 assert (extra != '\0');
914 printf ("; DIMENSION(%d)", elements);
923 printf ("; INTENT(IN)");
930 printf ("; cannot be a constant or expression");
934 printf ("; INTENT(OUT)");
938 printf ("; INTENT(INOUT)");
947 Intrinsic groups: ");
950 case FFEINTRIN_familyF77:
951 printf ("(standard FORTRAN 77).");
954 case FFEINTRIN_familyGNU:
955 printf ("@code{gnu}.");
958 case FFEINTRIN_familyASC:
959 printf ("@code{f2c}, @code{f90}.");
962 case FFEINTRIN_familyMIL:
963 printf ("@code{mil}, @code{f90}, @code{vxt}.");
966 case FFEINTRIN_familyF90:
967 printf ("@code{f90}.");
970 case FFEINTRIN_familyVXT:
971 printf ("@code{vxt}.");
974 case FFEINTRIN_familyFVZ:
975 printf ("@code{f2c}, @code{vxt}.");
978 case FFEINTRIN_familyF2C:
979 printf ("@code{f2c}.");
982 case FFEINTRIN_familyF2U:
983 printf ("@code{unix}.");
986 case FFEINTRIN_familyBADU77:
987 printf ("@code{badu77}.");
991 assert ("bad family" == NULL);
992 printf ("@code{???}.");
997 if (descriptions[imp] != NULL)
999 const char *c = descriptions[imp];
1006 while (c[0] != '\0')
1008 if (c[0] == '@' && ISDIGIT (c[1]))
1010 int argno = c[1] - '0';
1013 while (ISDIGIT (c[0]))
1015 argno = 10 * argno + (c[0] - '0');
1018 assert (c[0] == '@');
1020 printf ("%s", name_uc);
1022 printf ("%s", argument_name_string (imp, argno - 1));
1025 fputc (c[0], stdout);
1034 argument_info_ptr (ffeintrinImp imp, int argno)
1036 const char *c = imps[imp].control;
1037 static char arginfos[8][32];
1038 static int argx = 0;
1048 while ((c[0] != ',') && (c[0] != '\0'))
1058 for (; (c[0] != '=') && (c[0] != '\0'); ++c)
1061 assert (c[0] == '=');
1063 for (i = 0, ++c; (c[0] != ',') && (c[0] != '\0'); ++c, ++i)
1064 arginfos[argx][i] = c[0];
1066 arginfos[argx][i] = '\0';
1068 c = &arginfos[argx][0];
1070 if (((size_t) argx) >= ARRAY_SIZE (arginfos))
1077 argument_info_string (ffeintrinImp imp, int argno)
1081 p = argument_info_ptr (imp, argno);
1087 argument_name_ptr (ffeintrinImp imp, int argno)
1089 const char *c = imps[imp].control;
1090 static char argnames[8][32];
1091 static int argx = 0;
1101 while ((c[0] != ',') && (c[0] != '\0'))
1111 for (i = 0; (c[0] != '=') && (c[0] != '\0'); ++c, ++i)
1112 argnames[argx][i] = c[0];
1114 assert (c[0] == '=');
1115 argnames[argx][i] = '\0';
1117 c = &argnames[argx][0];
1119 if (((size_t) argx) >= ARRAY_SIZE (argnames))
1126 argument_name_string (ffeintrinImp imp, int argno)
1130 p = argument_name_ptr (imp, argno);
1136 print_type_string (const char *c)
1144 assert ((kind == '1') || (kind == '='));
1146 printf ("@code{CHARACTER*1}");
1149 assert (c[2] == '*');
1150 printf ("@code{CHARACTER*(*)}");
1158 printf ("@code{COMPLEX}");
1161 case '1': case '2': case '3': case '4': case '5':
1162 case '6': case '7': case '8': case '9':
1163 printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
1167 assert ("Ca" == NULL);
1176 printf ("@code{INTEGER}");
1179 case '1': case '2': case '3': case '4': case '5':
1180 case '6': case '7': case '8': case '9':
1181 printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
1185 assert ("Ia" == NULL);
1194 printf ("@code{LOGICAL}");
1197 case '1': case '2': case '3': case '4': case '5':
1198 case '6': case '7': case '8': case '9':
1199 printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
1203 assert ("La" == NULL);
1212 printf ("@code{REAL}");
1215 case '1': case '2': case '3': case '4': case '5':
1216 case '6': case '7': case '8': case '9':
1217 printf ("@code{REAL(KIND=%d)}", (kind - '0'));
1221 printf ("@code{REAL}");
1225 assert ("Ra" == NULL);
1234 printf ("@code{INTEGER} or @code{LOGICAL}");
1237 case '1': case '2': case '3': case '4': case '5':
1238 case '6': case '7': case '8': case '9':
1239 printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
1240 (kind - '0'), (kind - '0'));
1244 assert ("Ba" == NULL);
1253 printf ("@code{REAL} or @code{COMPLEX}");
1256 case '1': case '2': case '3': case '4': case '5':
1257 case '6': case '7': case '8': case '9':
1258 printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
1259 (kind - '0'), (kind - '0'));
1263 assert ("Fa" == NULL);
1272 printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
1275 case '1': case '2': case '3': case '4': case '5':
1276 case '6': case '7': case '8': case '9':
1277 printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
1278 (kind - '0'), (kind - '0'), (kind - '0'));
1282 assert ("N1" == NULL);
1291 printf ("@code{INTEGER} or @code{REAL}");
1294 case '1': case '2': case '3': case '4': case '5':
1295 case '6': case '7': case '8': case '9':
1296 printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
1297 (kind - '0'), (kind - '0'));
1301 assert ("Sa" == NULL);
1307 assert ("type?" == NULL);