/* intdoc.c
- Copyright (C) 1997 Free Software Foundation, Inc.
- Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
+ Copyright (C) 1997, 2000, 2001 Free Software Foundation, Inc.
+ Contributed by James Craig Burley.
This file is part of GNU Fortran.
02111-1307, USA. */
/* From f/proj.h, which uses #error -- not all C compilers
- support that, and we want _this_ program to be compilable
+ support that, and we want *this* program to be compilable
by pretty much any C compiler. */
+#include "bconfig.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "assert.h"
-#include "assert.j" /* Use gcc's assert.h. */
-#include <stdio.h>
-#include <stddef.h>
-#include <stdlib.h>
-#include <string.h>
+/* Pull in the intrinsics info, but only the doc parts. */
#define FFEINTRIN_DOC 1
#include "intrin.h"
-typedef enum
- {
-#if !defined(false) || !defined(true)
- false = 0, true = 1,
-#endif
-#if !defined(FALSE) || !defined(TRUE)
- FALSE = 0, TRUE = 1,
-#endif
- Doggone_Trailing_Comma_Dont_Work = 1
- } bool;
-
-#define ARRAY_SIZE(a) (sizeof(a)/sizeof(a[0]))
-
-char *family_name (ffeintrinFamily family);
+const char *family_name (ffeintrinFamily family);
static void dumpif (ffeintrinFamily fam);
static void dumpendif (void);
static void dumpclearif (void);
static void dumpem (void);
-static void dumpgen (int menu, char *name, char *name_uc,
+static void dumpgen (int menu, const char *name, const char *name_uc,
ffeintrinGen gen);
-static void dumpspec (int menu, char *name, char *name_uc,
+static void dumpspec (int menu, const char *name, const char *name_uc,
ffeintrinSpec spec);
-static void dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family,
+static void dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ffeintrinFamily family,
ffeintrinImp imp, ffeintrinSpec spec);
-static char *argument_info_ptr (ffeintrinImp imp, int argno);
-static char *argument_info_string (ffeintrinImp imp, int argno);
-static char *argument_name_ptr (ffeintrinImp imp, int argno);
-static char *argument_name_string (ffeintrinImp imp, int argno);
+static const char *argument_info_ptr (ffeintrinImp imp, int argno);
+static const char *argument_info_string (ffeintrinImp imp, int argno);
+static const char *argument_name_ptr (ffeintrinImp imp, int argno);
+static const char *argument_name_string (ffeintrinImp imp, int argno);
#if 0
-static char *elaborate_if_complex (ffeintrinImp imp, int argno);
-static char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
-static char *elaborate_if_real (ffeintrinImp imp, int argno);
+static const char *elaborate_if_complex (ffeintrinImp imp, int argno);
+static const char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
+static const char *elaborate_if_real (ffeintrinImp imp, int argno);
#endif
-static void print_type_string (char *c);
+static void print_type_string (const char *c);
int
-main (int argc, char **argv __attribute__ ((unused)))
+main (int argc, char **argv ATTRIBUTE_UNUSED)
{
if (argc != 1)
{
fprintf (stderr, "\
-Usage: intdoc > intdoc.texi
- Collects and dumps documentation on g77 intrinsics
+Usage: intdoc > intdoc.texi\n\
+ Collects and dumps documentation on g77 intrinsics\n\
to the file named intdoc.texi.\n");
exit (1);
}
struct _ffeintrin_name_
{
- char *name_uc;
- char *name_lc;
- char *name_ic;
- ffeintrinGen generic;
- ffeintrinSpec specific;
+ const char *const name_uc;
+ const char *const name_lc;
+ const char *const name_ic;
+ const ffeintrinGen generic;
+ const ffeintrinSpec specific;
};
struct _ffeintrin_gen_
{
- char *name; /* Name as seen in program. */
- ffeintrinSpec specs[2];
+ const char *const name; /* Name as seen in program. */
+ const ffeintrinSpec specs[2];
};
struct _ffeintrin_spec_
{
- char *name; /* Uppercase name as seen in source code,
+ const char *const name; /* Uppercase name as seen in source code,
lowercase if no source name, "none" if no
name at all (NONE case). */
- bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
- ffeintrinFamily family;
- ffeintrinImp implementation;
+ const bool is_actualarg; /* Ok to pass as actual arg if -pedantic. */
+ const ffeintrinFamily family;
+ const ffeintrinImp implementation;
};
struct _ffeintrin_imp_
{
- char *name; /* Name of implementation. */
-#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
- ffecomGfrt gfrt; /* gfrt index in library. */
-#endif /* FFECOM_targetCURRENT == FFECOM_targetGCC */
- char *control;
+ const char *const name; /* Name of implementation. */
+ const char *const control;
};
-static struct _ffeintrin_name_ names[] = {
+static const struct _ffeintrin_name_ names[] = {
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
{ UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
-static struct _ffeintrin_gen_ gens[] = {
+static const struct _ffeintrin_gen_ gens[] = {
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
{ NAME, { SPEC1, SPEC2, }, },
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
-static struct _ffeintrin_imp_ imps[] = {
+static const struct _ffeintrin_imp_ imps[] = {
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#if 0 /* FFECOM_targetCURRENT == FFECOM_targetGCC */
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
- { NAME, FFECOM_gfrt ## GFRT, CONTROL },
-#elif 1 /* FFECOM_targetCURRENT == FFECOM_targetFFE */
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
{ NAME, CONTROL },
-#else
-#error
-#endif
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
+ { NAME, CONTROL },
#include "intrin.def"
#undef DEFNAME
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
-static struct _ffeintrin_spec_ specs[] = {
+static const struct _ffeintrin_spec_ specs[] = {
#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
{ NAME, CALLABLE, FAMILY, IMP, },
#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
+#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
#include "intrin.def"
#undef DEFGEN
#undef DEFSPEC
#undef DEFIMP
+#undef DEFIMPY
};
-struct cc_pair { ffeintrinImp imp; char *text; };
+struct cc_pair { const ffeintrinImp imp; const char *const text; };
-static char *descriptions[FFEINTRIN_imp] = { 0 };
-static struct cc_pair cc_descriptions[] = {
+static const char *descriptions[FFEINTRIN_imp] = { 0 };
+static const struct cc_pair cc_descriptions[] = {
#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
-#include "intdoc.h"
+#include "intdoc.h0"
#undef DEFDOC
};
-static char *summaries[FFEINTRIN_imp] = { 0 };
-static struct cc_pair cc_summaries[] = {
+static const char *summaries[FFEINTRIN_imp] = { 0 };
+static const struct cc_pair cc_summaries[] = {
#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
-#include "intdoc.h"
+#include "intdoc.h0"
#undef DEFDOC
};
-char *
+const char *
family_name (ffeintrinFamily family)
{
switch (family)
summaries[cc_summaries[i].imp] = cc_summaries[i].text;
}
+ printf ("@c This file is automatically derived from intdoc.c, intdoc.in,\n");
+ printf ("@c ansify.c, intrin.def, and intrin.h. Edit those files instead.\n");
printf ("@menu\n");
for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
{
}
static void
-dumpgen (int menu, char *name, char *name_uc, ffeintrinGen gen)
+dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen)
{
size_t i;
- int total;
+ int total = 0;
if (!menu)
{
- for (total = 0, i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
+ for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
{
if (gens[gen].specs[i] != FFEINTRIN_specNONE)
++total;
}
static void
-dumpspec (int menu, char *name, char *name_uc, ffeintrinSpec spec)
+dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec)
{
dumpif (specs[spec].family);
dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation,
}
static void
-dumpimp (int menu, char *name, char *name_uc, size_t genno, ffeintrinFamily family, ffeintrinImp imp,
- ffeintrinSpec spec)
+dumpimp (int menu, const char *name, const char *name_uc, size_t genno,
+ ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec)
{
- char *c;
+ const char *c;
bool subr;
- char *argc;
- char *argi;
+ const char *argc;
+ const char *argi;
int colon;
int argno;
|| (summaries[imp] != NULL))
{
int spaces = INDENT_SUMMARY - 14 - strlen (name);
- char *c;
+ const char *c;
if (spec != FFEINTRIN_specNONE)
spaces -= (3 + strlen (specs[spec].name)); /* See XYZZY1 above */
for (c = summaries[imp]; c[0] != '\0'; ++c)
{
- if ((c[0] == '@')
- && (c[1] >= '0')
- && (c[1] <= '9'))
+ if (c[0] == '@' && ISDIGIT (c[1]))
{
int argno = c[1] - '0';
c += 2;
- while ((c[0] >= '0')
- && (c[0] <= '9'))
+ while (ISDIGIT (c[0]))
{
argno = 10 * argno + (c[0] - '0');
++c;
if (imp == FFEINTRIN_impNONE)
{
- printf ("
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL %s} to use this name for an
-external procedure.
-
+ printf ("\n\
+This intrinsic is not yet implemented.\n\
+The name is, however, reserved as an intrinsic.\n\
+Use @samp{EXTERNAL %s} to use this name for an\n\
+external procedure.\n\
+\n\
",
name);
return;
subr = (c[0] == '-');
colon = (c[2] == ':') ? 2 : 3;
- printf ("
-@noindent
-@example
+ printf ("\n\
+@noindent\n\
+@example\n\
%s%s(",
(subr ? "CALL " : ""), name);
if ((argi[0] == '*')
|| (argi[0] == 'n')
|| (argi[0] == '+')
- || (argi[0] == 'p'))
+ || (argi[0] == 'p'))
printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
argc, argc);
}
- printf (")
-@end example\n
+ printf (")\n\
+@end example\n\
+\n\
");
if (!subr)
{
int other_arg;
- char *arg_string;
- char *arg_info;
+ const char *arg_string;
+ const char *arg_info;
- if ((c[colon + 1] >= '0')
- && (c[colon + 1] <= '9'))
+ if (ISDIGIT (c[colon + 1]))
{
other_arg = c[colon + 1] - '0';
arg_string = argument_name_string (imp, other_arg);
}
printf ("\
-@noindent
+@noindent\n\
%s: ", name);
print_type_string (c);
printf (" function");
|| (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
++arg_info;
if ((arg_info[0] == 'F') || (arg_info[0] == 'N'))
- printf (".
-The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is
-any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.
-When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
-this intrinsic is valid only when used as the argument to
+ printf (".\n\
+The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is\n\
+any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.\n\
+When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},\n\
+this intrinsic is valid only when used as the argument to\n\
@code{REAL()}, as explained below.\n\n",
arg_string,
arg_string);
else
- printf (".
-This intrinsic is valid when argument @var{%s} is
-@code{COMPLEX(KIND=1)}.
-When @var{%s} is any other @code{COMPLEX} type,
-this intrinsic is valid only when used as the argument to
+ printf (".\n\
+This intrinsic is valid when argument @var{%s} is\n\
+@code{COMPLEX(KIND=1)}.\n\
+When @var{%s} is any other @code{COMPLEX} type,\n\
+this intrinsic is valid only when used as the argument to\n\
@code{REAL()}, as explained below.\n\n",
arg_string,
arg_string);
}
#if 0
else if ((c[0] == 'I')
- && (c[1] == 'p'))
- printf (", the exact type being wide enough to hold a pointer
+ && (c[1] == '7'))
+ printf (", the exact type being wide enough to hold a pointer\n\
on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
#endif
- else if ((c[1] == '=')
- && (c[colon + 1] >= '0')
- && (c[colon + 1] <= '9'))
+ else if (c[1] == '=' && ISDIGIT (c[colon + 1]))
{
assert (other_arg >= 0);
&& ((arg_info[0] == 'C')
|| (arg_info[0] == 'F')
|| (arg_info[0] == 'N')))
- printf (".
-The exact type depends on that of argument @var{%s}---if @var{%s} is
-@code{COMPLEX}, this function's type is @code{REAL}
-with the same @samp{KIND=} value as the type of @var{%s}.
+ printf (".\n\
+The exact type depends on that of argument @var{%s}---if @var{%s} is\n\
+@code{COMPLEX}, this function's type is @code{REAL}\n\
+with the same @samp{KIND=} value as the type of @var{%s}.\n\
Otherwise, this function's type is the same as that of @var{%s}.\n\n",
arg_string, arg_string, arg_string, arg_string);
else
}
else if ((c[1] == '=')
&& (c[colon + 1] == '*'))
- printf (", the exact type being the result of cross-promoting the
+ printf (", the exact type being the result of cross-promoting the\n\
types of all the arguments.\n\n");
else if (c[1] == '=')
assert ("?0:?:" == NULL);
int elements;
printf ("\
-@noindent
+@noindent\n\
@var{");
for (; ; ++argc)
{
argument_name_string (imp, 0));
break;
- case 'p':
- printf ("@code{INTEGER} wide enough to hold a pointer");
+ case 'N':
+ printf ("@code{INTEGER} not wider than the default kind");
break;
default:
argument_name_string (imp, 0));
break;
+ case 'N':
+ printf ("@code{LOGICAL} not wider than the default kind");
+ break;
+
default:
assert ("La" == NULL);
break;
argument_name_string (imp, 0));
break;
+ case 'N':
+ printf ("@code{INTEGER} or @code{LOGICAL} not wider than the default kind");
+ break;
+
default:
assert ("Ba" == NULL);
break;
break;
case 'g':
- printf ("@samp{*@var{label}}, where @var{label} is the label
+ printf ("@samp{*@var{label}}, where @var{label} is the label\n\
of an executable statement");
break;
case 's':
- printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
+ printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})\n\
or dummy/global @code{INTEGER(KIND=1)} scalar");
break;
}
printf ("\
-@noindent
+@noindent\n\
Intrinsic groups: ");
switch (family)
{
if (descriptions[imp] != NULL)
{
- char *c = descriptions[imp];
+ const char *c = descriptions[imp];
printf ("\
-@noindent
-Description:
+@noindent\n\
+Description:\n\
\n");
while (c[0] != '\0')
{
- if ((c[0] == '@')
- && (c[1] >= '0')
- && (c[1] <= '9'))
+ if (c[0] == '@' && ISDIGIT (c[1]))
{
int argno = c[1] - '0';
c += 2;
- while ((c[0] >= '0')
- && (c[0] <= '9'))
+ while (ISDIGIT (c[0]))
{
argno = 10 * argno + (c[0] - '0');
++c;
}
}
-static char *
+static const char *
argument_info_ptr (ffeintrinImp imp, int argno)
{
- char *c = imps[imp].control;
+ const char *c = imps[imp].control;
static char arginfos[8][32];
static int argx = 0;
int i;
return c;
}
-static char *
+static const char *
argument_info_string (ffeintrinImp imp, int argno)
{
- char *p;
+ const char *p;
p = argument_info_ptr (imp, argno);
assert (p != NULL);
return p;
}
-static char *
+static const char *
argument_name_ptr (ffeintrinImp imp, int argno)
{
- char *c = imps[imp].control;
+ const char *c = imps[imp].control;
static char argnames[8][32];
static int argx = 0;
int i;
return c;
}
-static char *
+static const char *
argument_name_string (ffeintrinImp imp, int argno)
{
- char *p;
+ const char *p;
p = argument_name_ptr (imp, argno);
assert (p != NULL);
}
static void
-print_type_string (char *c)
+print_type_string (const char *c)
{
char basic = c[0];
char kind = c[1];
printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
break;
- case 'p':
- printf ("@code{INTEGER(KIND=0)}");
- break;
-
default:
assert ("Ia" == NULL);
break;
break;
default:
- assert ("arg type?" == NULL);
+ assert ("type?" == NULL);
break;
}
}
OSDN Git Service
