2 Copyright (C) 1997 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. */
34 #if !defined(false) || !defined(true)
37 #if !defined(FALSE) || !defined(TRUE)
40 Doggone_Trailing_Comma_Dont_Work = 1
43 #define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0]))
45 /* Pull in the intrinsics info, but only the doc parts. */
46 #define FFEINTRIN_DOC 1
49 const char *family_name (ffeintrinFamily family);
50 static void dumpif (ffeintrinFamily fam);
51 static void dumpendif (void);
52 static void dumpclearif (void);
53 static void dumpem (void);
54 static void dumpgen (int menu, const char *name, const char *name_uc,
56 static void dumpspec (int menu, const char *name, const char *name_uc,
58 static void dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ffeintrinFamily family,
59 ffeintrinImp imp, ffeintrinSpec spec);
60 static const char *argument_info_ptr (ffeintrinImp imp, int argno);
61 static const char *argument_info_string (ffeintrinImp imp, int argno);
62 static const char *argument_name_ptr (ffeintrinImp imp, int argno);
63 static const char *argument_name_string (ffeintrinImp imp, int argno);
65 static const char *elaborate_if_complex (ffeintrinImp imp, int argno);
66 static const char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
67 static const char *elaborate_if_real (ffeintrinImp imp, int argno);
69 static void print_type_string (const char *c);
72 main (int argc, char **argv ATTRIBUTE_UNUSED)
77 Usage: intdoc > intdoc.texi\n\
78 Collects and dumps documentation on g77 intrinsics\n\
79 to the file named intdoc.texi.\n");
87 struct _ffeintrin_name_
93 ffeintrinSpec specific;
96 struct _ffeintrin_gen_
98 const char *name; /* Name as seen in program. */
99 ffeintrinSpec specs[2];
102 struct _ffeintrin_spec_
104 const char *name; /* Uppercase name as seen in source code,
105 lowercase if no source name, "none" if no
106 name at all (NONE case). */
107 bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
108 ffeintrinFamily family;
109 ffeintrinImp implementation;
112 struct _ffeintrin_imp_
114 const char *name; /* Name of implementation. */
115 #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
116 ffecomGfrt gfrt; /* gfrt index in library. */
117 #endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
121 static struct _ffeintrin_name_ names[] = {
122 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
123 { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
124 #define DEFGEN(CODE,NAME,SPEC1,SPEC2)
125 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
126 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
127 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
128 #include "intrin.def"
136 static struct _ffeintrin_gen_ gens[] = {
137 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
138 #define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
139 { NAME, { SPEC1, SPEC2, }, },
140 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
141 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
142 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
143 #include "intrin.def"
151 static struct _ffeintrin_imp_ imps[] = {
152 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
153 #define DEFGEN(CODE,NAME,SPEC1,SPEC2)
154 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
155 #if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
156 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
157 { NAME, FFECOM_gfrt ## GFRT, CONTROL },
158 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
159 { NAME, FFECOM_gfrt ## GFRT, CONTROL },
160 #elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */
161 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
163 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
168 #include "intrin.def"
176 static struct _ffeintrin_spec_ specs[] = {
177 #define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
178 #define DEFGEN(CODE,NAME,SPEC1,SPEC2)
179 #define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
180 { NAME, CALLABLE, FAMILY, IMP, },
181 #define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
182 #define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
183 #include "intrin.def"
190 struct cc_pair { ffeintrinImp imp; const char *text; };
192 static const char *descriptions[FFEINTRIN_imp] = { 0 };
193 static struct cc_pair cc_descriptions[] = {
194 #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
199 static const char *summaries[FFEINTRIN_imp] = { 0 };
200 static struct cc_pair cc_summaries[] = {
201 #define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
207 family_name (ffeintrinFamily family)
211 case FFEINTRIN_familyF77:
214 case FFEINTRIN_familyASC:
217 case FFEINTRIN_familyMIL:
220 case FFEINTRIN_familyGNU:
223 case FFEINTRIN_familyF90:
226 case FFEINTRIN_familyVXT:
229 case FFEINTRIN_familyFVZ:
232 case FFEINTRIN_familyF2C:
235 case FFEINTRIN_familyF2U:
238 case FFEINTRIN_familyBADU77:
239 return "familyBADU77";
242 assert ("bad family" == NULL);
247 static int in_ifset = 0;
248 static ffeintrinFamily latest_family = FFEINTRIN_familyNONE;
251 dumpif (ffeintrinFamily fam)
253 assert (fam != FFEINTRIN_familyNONE);
255 || (fam != latest_family))
258 printf ("@end ifset\n");
260 printf ("@ifset %s\n", family_name (fam));
275 || (latest_family != FFEINTRIN_familyNONE))
276 printf ("@end ifset\n");
277 latest_family = FFEINTRIN_familyNONE;
286 for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_descriptions); ++i)
288 assert (descriptions[cc_descriptions[i].imp] == NULL);
289 descriptions[cc_descriptions[i].imp] = cc_descriptions[i].text;
292 for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_summaries); ++i)
294 assert (summaries[cc_summaries[i].imp] == NULL);
295 summaries[cc_summaries[i].imp] = cc_summaries[i].text;
298 printf ("@c This file is automatically derived from intdoc.c, intdoc.in,\n");
299 printf ("@c ansify.c, intrin.def, and intrin.h. Edit those files instead.\n");
301 for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
303 if (names[i].generic != FFEINTRIN_genNONE)
304 dumpgen (1, names[i].name_ic, names[i].name_uc,
306 if (names[i].specific != FFEINTRIN_specNONE)
307 dumpspec (1, names[i].name_ic, names[i].name_uc,
312 printf ("@end menu\n\n");
314 for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
316 if (names[i].generic != FFEINTRIN_genNONE)
317 dumpgen (0, names[i].name_ic, names[i].name_uc,
319 if (names[i].specific != FFEINTRIN_specNONE)
320 dumpspec (0, names[i].name_ic, names[i].name_uc,
327 dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen)
334 for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
336 if (gens[gen].specs[i] != FFEINTRIN_specNONE)
341 for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
346 if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE)
349 dumpif (specs[spec].family);
350 dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation,
352 if (!menu && (total > 0))
357 For information on another intrinsic with the same name:\n");
362 For information on other intrinsics with the same name:\n");
364 for (j = 0; j < ARRAY_SIZE (gens[gen].specs); ++j)
368 if ((spec = gens[gen].specs[j]) == FFEINTRIN_specNONE)
370 printf ("@xref{%s Intrinsic (%s)}.\n",
371 name, specs[spec].name);
380 dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec)
382 dumpif (specs[spec].family);
383 dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation,
389 dumpimp (int menu, const char *name, const char *name_uc, size_t genno,
390 ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec)
399 assert ((imp != FFEINTRIN_impNONE) || !genno);
403 printf ("* %s Intrinsic",
405 if (spec != FFEINTRIN_specNONE)
406 printf (" (%s)", specs[spec].name); /* See XYZZY1 below */
408 #define INDENT_SUMMARY 24
409 if ((imp == FFEINTRIN_impNONE)
410 || (summaries[imp] != NULL))
412 int spaces = INDENT_SUMMARY - 14 - strlen (name);
415 if (spec != FFEINTRIN_specNONE)
416 spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */
422 if (imp == FFEINTRIN_impNONE)
424 printf ("(Reserved for future use.)\n");
428 for (c = summaries[imp]; c[0] != '\0'; ++c)
434 int argno = c[1] - '0';
440 argno = 10 * argno + (c[0] - '0');
443 assert (c[0] == '@');
446 else if (argno == 99)
447 { /* Yeah, this is a major kludge. */
449 spaces = INDENT_SUMMARY + 1;
454 printf ("%s", argument_name_string (imp, argno - 1));
457 fputc (c[0], stdout);
464 printf ("@node %s Intrinsic", name);
465 if (spec != FFEINTRIN_specNONE)
466 printf (" (%s)", specs[spec].name);
467 printf ("\n@subsubsection %s Intrinsic", name);
468 if (spec != FFEINTRIN_specNONE)
469 printf (" (%s)", specs[spec].name);
470 printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n",
473 if (imp == FFEINTRIN_impNONE)
476 This intrinsic is not yet implemented.\n\
477 The name is, however, reserved as an intrinsic.\n\
478 Use @samp{EXTERNAL %s} to use this name for an\n\
479 external procedure.\n\
486 c = imps[imp].control;
487 subr = (c[0] == '-');
488 colon = (c[2] == ':') ? 2 : 3;
494 (subr ? "CALL " : ""), name);
498 for (argno = 0; ; ++argno)
500 argc = argument_name_ptr (imp, argno);
505 printf ("@var{%s}", argc);
506 argi = argument_info_string (imp, argno);
511 printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
523 const char *arg_string;
524 const char *arg_info;
526 if ((c[colon + 1] >= '0')
527 && (c[colon + 1] <= '9'))
529 other_arg = c[colon + 1] - '0';
530 arg_string = argument_name_string (imp, other_arg);
531 arg_info = argument_info_string (imp, other_arg);
543 print_type_string (c);
544 printf (" function");
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'))
554 if ((arg_info[0] == 'F') || (arg_info[0] == 'N'))
556 The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is\n\
557 any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.\n\
558 When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},\n\
559 this intrinsic is valid only when used as the argument to\n\
560 @code{REAL()}, as explained below.\n\n",
565 This intrinsic is valid when argument @var{%s} is\n\
566 @code{COMPLEX(KIND=1)}.\n\
567 When @var{%s} is any other @code{COMPLEX} type,\n\
568 this intrinsic is valid only when used as the argument to\n\
569 @code{REAL()}, as explained below.\n\n",
574 else if ((c[0] == 'I')
576 printf (", the exact type being wide enough to hold a pointer\n\
577 on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
579 else if ((c[1] == '=')
580 && (c[colon + 1] >= '0')
581 && (c[colon + 1] <= '9'))
583 assert (other_arg >= 0);
585 if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
586 || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
589 if (((c[0] == arg_info[0])
590 && ((c[0] == 'A') || (c[0] == 'C') || (c[0] == 'I')
591 || (c[0] == 'L') || (c[0] == 'R')))
593 && (arg_info[0] == 'C'))
595 && (arg_info[0] == 'R')))
596 printf (", the @samp{KIND=} value of the type being that of argument @var{%s}.\n\n",
598 else if ((c[0] == 'S')
599 && ((arg_info[0] == 'C')
600 || (arg_info[0] == 'F')
601 || (arg_info[0] == 'N')))
603 The exact type depends on that of argument @var{%s}---if @var{%s} is\n\
604 @code{COMPLEX}, this function's type is @code{REAL}\n\
605 with the same @samp{KIND=} value as the type of @var{%s}.\n\
606 Otherwise, this function's type is the same as that of @var{%s}.\n\n",
607 arg_string, arg_string, arg_string, arg_string);
609 printf (", the exact type being that of argument @var{%s}.\n\n",
612 else if ((c[1] == '=')
613 && (c[colon + 1] == '*'))
614 printf (", the exact type being the result of cross-promoting the\n\
615 types of all the arguments.\n\n");
616 else if (c[1] == '=')
617 assert ("?0:?:" == NULL);
622 for (argno = 0, argc = &c[colon + 3]; *argc != '\0'; ++argno)
624 char optionality = '\0';
638 printf ("%c", *argc);
649 optionality = *(argc++);
654 length = *++argc - '0';
656 length = 10 * length + (*(argc++) - '0');
663 elements = *++argc - '0';
665 elements = 10 * elements + (*(argc++) - '0');
668 else if (*argc == '&')
693 assert ("kind arg" == NULL);
699 assert ((kind == '1') || (kind == '*'));
700 printf ("@code{CHARACTER");
702 printf ("*%d", length);
710 printf ("@code{COMPLEX}");
713 case '1': case '2': case '3': case '4': case '5':
714 case '6': case '7': case '8': case '9':
715 printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
719 printf ("Same @samp{KIND=} value as for @var{%s}",
720 argument_name_string (imp, 0));
724 assert ("Ca" == NULL);
733 printf ("@code{INTEGER}");
736 case '1': case '2': case '3': case '4': case '5':
737 case '6': case '7': case '8': case '9':
738 printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
742 printf ("@code{INTEGER} with same @samp{KIND=} value as for @var{%s}",
743 argument_name_string (imp, 0));
747 assert ("Ia" == NULL);
756 printf ("@code{LOGICAL}");
759 case '1': case '2': case '3': case '4': case '5':
760 case '6': case '7': case '8': case '9':
761 printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
765 printf ("@code{LOGICAL} with same @samp{KIND=} value as for @var{%s}",
766 argument_name_string (imp, 0));
770 assert ("La" == NULL);
779 printf ("@code{REAL}");
782 case '1': case '2': case '3': case '4': case '5':
783 case '6': case '7': case '8': case '9':
784 printf ("@code{REAL(KIND=%d)}", (kind - '0'));
788 printf ("@code{REAL} with same @samp{KIND=} value as for @var{%s}",
789 argument_name_string (imp, 0));
793 assert ("Ra" == NULL);
802 printf ("@code{INTEGER} or @code{LOGICAL}");
805 case '1': case '2': case '3': case '4': case '5':
806 case '6': case '7': case '8': case '9':
807 printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
808 (kind - '0'), (kind - '0'));
812 printf ("Same type and @samp{KIND=} value as for @var{%s}",
813 argument_name_string (imp, 0));
817 assert ("Ba" == NULL);
826 printf ("@code{REAL} or @code{COMPLEX}");
829 case '1': case '2': case '3': case '4': case '5':
830 case '6': case '7': case '8': case '9':
831 printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
832 (kind - '0'), (kind - '0'));
836 printf ("Same type as @var{%s}",
837 argument_name_string (imp, 0));
841 assert ("Fa" == NULL);
850 printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
853 case '1': case '2': case '3': case '4': case '5':
854 case '6': case '7': case '8': case '9':
855 printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
856 (kind - '0'), (kind - '0'), (kind - '0'));
860 assert ("N1" == NULL);
869 printf ("@code{INTEGER} or @code{REAL}");
872 case '1': case '2': case '3': case '4': case '5':
873 case '6': case '7': case '8': case '9':
874 printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
875 (kind - '0'), (kind - '0'));
879 printf ("@code{INTEGER} or @code{REAL} with same @samp{KIND=} value as for @var{%s}",
880 argument_name_string (imp, 0));
884 assert ("Sa" == NULL);
890 printf ("@samp{*@var{label}}, where @var{label} is the label\n\
891 of an executable statement");
895 printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})\n\
896 or dummy/global @code{INTEGER(KIND=1)} scalar");
900 assert ("arg type?" == NULL);
910 printf ("; OPTIONAL (must be omitted if @var{%s} is @code{COMPLEX})",
911 argument_name_string (imp, argno-1));
915 printf ("; OPTIONAL");
919 printf ("; OPTIONAL");
927 printf ("; at least two such arguments must be provided");
931 assert ("optionality!" == NULL);
947 assert (extra != '\0');
948 printf ("; DIMENSION(%d)", elements);
957 printf ("; INTENT(IN)");
964 printf ("; cannot be a constant or expression");
968 printf ("; INTENT(OUT)");
972 printf ("; INTENT(INOUT)");
981 Intrinsic groups: ");
984 case FFEINTRIN_familyF77:
985 printf ("(standard FORTRAN 77).");
988 case FFEINTRIN_familyGNU:
989 printf ("@code{gnu}.");
992 case FFEINTRIN_familyASC:
993 printf ("@code{f2c}, @code{f90}.");
996 case FFEINTRIN_familyMIL:
997 printf ("@code{mil}, @code{f90}, @code{vxt}.");
1000 case FFEINTRIN_familyF90:
1001 printf ("@code{f90}.");
1004 case FFEINTRIN_familyVXT:
1005 printf ("@code{vxt}.");
1008 case FFEINTRIN_familyFVZ:
1009 printf ("@code{f2c}, @code{vxt}.");
1012 case FFEINTRIN_familyF2C:
1013 printf ("@code{f2c}.");
1016 case FFEINTRIN_familyF2U:
1017 printf ("@code{unix}.");
1020 case FFEINTRIN_familyBADU77:
1021 printf ("@code{badu77}.");
1025 assert ("bad family" == NULL);
1026 printf ("@code{???}.");
1031 if (descriptions[imp] != NULL)
1033 const char *c = descriptions[imp];
1040 while (c[0] != '\0')
1046 int argno = c[1] - '0';
1049 while ((c[0] >= '0')
1052 argno = 10 * argno + (c[0] - '0');
1055 assert (c[0] == '@');
1057 printf ("%s", name_uc);
1059 printf ("%s", argument_name_string (imp, argno - 1));
1062 fputc (c[0], stdout);
1071 argument_info_ptr (ffeintrinImp imp, int argno)
1073 const char *c = imps[imp].control;
1074 static char arginfos[8][32];
1075 static int argx = 0;
1085 while ((c[0] != ',') && (c[0] != '\0'))
1095 for (; (c[0] != '=') && (c[0] != '\0'); ++c)
1098 assert (c[0] == '=');
1100 for (i = 0, ++c; (c[0] != ',') && (c[0] != '\0'); ++c, ++i)
1101 arginfos[argx][i] = c[0];
1103 arginfos[argx][i] = '\0';
1105 c = &arginfos[argx][0];
1107 if (((size_t) argx) >= ARRAY_SIZE (arginfos))
1114 argument_info_string (ffeintrinImp imp, int argno)
1118 p = argument_info_ptr (imp, argno);
1124 argument_name_ptr (ffeintrinImp imp, int argno)
1126 const char *c = imps[imp].control;
1127 static char argnames[8][32];
1128 static int argx = 0;
1138 while ((c[0] != ',') && (c[0] != '\0'))
1148 for (i = 0; (c[0] != '=') && (c[0] != '\0'); ++c, ++i)
1149 argnames[argx][i] = c[0];
1151 assert (c[0] == '=');
1152 argnames[argx][i] = '\0';
1154 c = &argnames[argx][0];
1156 if (((size_t) argx) >= ARRAY_SIZE (argnames))
1163 argument_name_string (ffeintrinImp imp, int argno)
1167 p = argument_name_ptr (imp, argno);
1173 print_type_string (const char *c)
1181 assert ((kind == '1') || (kind == '='));
1183 printf ("@code{CHARACTER*1}");
1186 assert (c[2] == '*');
1187 printf ("@code{CHARACTER*(*)}");
1195 printf ("@code{COMPLEX}");
1198 case '1': case '2': case '3': case '4': case '5':
1199 case '6': case '7': case '8': case '9':
1200 printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
1204 assert ("Ca" == NULL);
1213 printf ("@code{INTEGER}");
1216 case '1': case '2': case '3': case '4': case '5':
1217 case '6': case '7': case '8': case '9':
1218 printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
1222 assert ("Ia" == NULL);
1231 printf ("@code{LOGICAL}");
1234 case '1': case '2': case '3': case '4': case '5':
1235 case '6': case '7': case '8': case '9':
1236 printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
1240 assert ("La" == NULL);
1249 printf ("@code{REAL}");
1252 case '1': case '2': case '3': case '4': case '5':
1253 case '6': case '7': case '8': case '9':
1254 printf ("@code{REAL(KIND=%d)}", (kind - '0'));
1258 printf ("@code{REAL}");
1262 assert ("Ra" == NULL);
1271 printf ("@code{INTEGER} or @code{LOGICAL}");
1274 case '1': case '2': case '3': case '4': case '5':
1275 case '6': case '7': case '8': case '9':
1276 printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
1277 (kind - '0'), (kind - '0'));
1281 assert ("Ba" == NULL);
1290 printf ("@code{REAL} or @code{COMPLEX}");
1293 case '1': case '2': case '3': case '4': case '5':
1294 case '6': case '7': case '8': case '9':
1295 printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
1296 (kind - '0'), (kind - '0'));
1300 assert ("Fa" == NULL);
1309 printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
1312 case '1': case '2': case '3': case '4': case '5':
1313 case '6': case '7': case '8': case '9':
1314 printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
1315 (kind - '0'), (kind - '0'), (kind - '0'));
1319 assert ("N1" == NULL);
1328 printf ("@code{INTEGER} or @code{REAL}");
1331 case '1': case '2': case '3': case '4': case '5':
1332 case '6': case '7': case '8': case '9':
1333 printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
1334 (kind - '0'), (kind - '0'));
1338 assert ("Sa" == NULL);
1344 assert ("type?" == NULL);