1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
5 Contributed by Andy Vaught & Katherine Holcomb
7 This file is part of GCC.
9 GCC is free software; you can redistribute it and/or modify it under
10 the terms of the GNU General Public License as published by the Free
11 Software Foundation; either version 3, or (at your option) any later
14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with GCC; see the file COPYING3. If not see
21 <http://www.gnu.org/licenses/>. */
27 #include "intrinsic.h"
29 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
30 static gfc_namespace *gfc_intrinsic_namespace;
32 int gfc_init_expr = 0;
34 /* Pointers to an intrinsic function and its argument names that are being
37 const char *gfc_current_intrinsic;
38 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
39 locus *gfc_current_intrinsic_where;
41 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
42 static gfc_intrinsic_sym *char_conversions;
43 static gfc_intrinsic_arg *next_arg;
45 static int nfunc, nsub, nargs, nconv, ncharconv;
48 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
52 { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
61 /* Return a letter based on the passed type. Used to construct the
62 name of a type-dependent subroutine. */
65 gfc_type_letter (bt type)
100 /* Get a symbol for a resolved name. Note, if needed be, the elemental
101 attribute has be added afterwards. */
104 gfc_get_intrinsic_sub_symbol (const char *name)
108 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
109 sym->attr.always_explicit = 1;
110 sym->attr.subroutine = 1;
111 sym->attr.flavor = FL_PROCEDURE;
112 sym->attr.proc = PROC_INTRINSIC;
118 /* Return a pointer to the name of a conversion function given two
122 conv_name (gfc_typespec *from, gfc_typespec *to)
124 return gfc_get_string ("__convert_%c%d_%c%d",
125 gfc_type_letter (from->type), from->kind,
126 gfc_type_letter (to->type), to->kind);
130 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
131 corresponds to the conversion. Returns NULL if the conversion
134 static gfc_intrinsic_sym *
135 find_conv (gfc_typespec *from, gfc_typespec *to)
137 gfc_intrinsic_sym *sym;
141 target = conv_name (from, to);
144 for (i = 0; i < nconv; i++, sym++)
145 if (target == sym->name)
152 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
153 that corresponds to the conversion. Returns NULL if the conversion
156 static gfc_intrinsic_sym *
157 find_char_conv (gfc_typespec *from, gfc_typespec *to)
159 gfc_intrinsic_sym *sym;
163 target = conv_name (from, to);
164 sym = char_conversions;
166 for (i = 0; i < ncharconv; i++, sym++)
167 if (target == sym->name)
174 /* Interface to the check functions. We break apart an argument list
175 and call the proper check function rather than forcing each
176 function to manipulate the argument list. */
179 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
181 gfc_expr *a1, *a2, *a3, *a4, *a5;
184 return (*specific->check.f0) ();
189 return (*specific->check.f1) (a1);
194 return (*specific->check.f2) (a1, a2);
199 return (*specific->check.f3) (a1, a2, a3);
204 return (*specific->check.f4) (a1, a2, a3, a4);
209 return (*specific->check.f5) (a1, a2, a3, a4, a5);
211 gfc_internal_error ("do_check(): too many args");
215 /*********** Subroutines to build the intrinsic list ****************/
217 /* Add a single intrinsic symbol to the current list.
220 char * name of function
221 int whether function is elemental
222 int If the function can be used as an actual argument [1]
223 bt return type of function
224 int kind of return type of function
225 int Fortran standard version
226 check pointer to check function
227 simplify pointer to simplification function
228 resolve pointer to resolution function
230 Optional arguments come in multiples of four:
231 char * name of argument
234 int arg optional flag (1=optional, 0=required)
236 The sequence is terminated by a NULL name.
239 [1] Whether a function can or cannot be used as an actual argument is
240 determined by its presence on the 13.6 list in Fortran 2003. The
241 following intrinsics, which are GNU extensions, are considered allowed
242 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
243 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
246 add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
247 int standard, gfc_check_f check, gfc_simplify_f simplify,
248 gfc_resolve_f resolve, ...)
250 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
251 int optional, first_flag;
265 next_sym->name = gfc_get_string (name);
267 strcpy (buf, "_gfortran_");
269 next_sym->lib_name = gfc_get_string (buf);
271 next_sym->elemental = (cl == CLASS_ELEMENTAL);
272 next_sym->inquiry = (cl == CLASS_INQUIRY);
273 next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
274 next_sym->actual_ok = actual_ok;
275 next_sym->ts.type = type;
276 next_sym->ts.kind = kind;
277 next_sym->standard = standard;
278 next_sym->simplify = simplify;
279 next_sym->check = check;
280 next_sym->resolve = resolve;
281 next_sym->specific = 0;
282 next_sym->generic = 0;
283 next_sym->conversion = 0;
288 gfc_internal_error ("add_sym(): Bad sizing mode");
291 va_start (argp, resolve);
297 name = va_arg (argp, char *);
301 type = (bt) va_arg (argp, int);
302 kind = va_arg (argp, int);
303 optional = va_arg (argp, int);
305 if (sizing != SZ_NOTHING)
312 next_sym->formal = next_arg;
314 (next_arg - 1)->next = next_arg;
318 strcpy (next_arg->name, name);
319 next_arg->ts.type = type;
320 next_arg->ts.kind = kind;
321 next_arg->optional = optional;
331 /* Add a symbol to the function list where the function takes
335 add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
336 int kind, int standard,
337 gfc_try (*check) (void),
338 gfc_expr *(*simplify) (void),
339 void (*resolve) (gfc_expr *))
349 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
354 /* Add a symbol to the subroutine list where the subroutine takes
358 add_sym_0s (const char *name, gfc_isym_id id, int standard, void (*resolve) (gfc_code *))
368 add_sym (name, id, NO_CLASS, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
373 /* Add a symbol to the function list where the function takes
377 add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
378 int kind, int standard,
379 gfc_try (*check) (gfc_expr *),
380 gfc_expr *(*simplify) (gfc_expr *),
381 void (*resolve) (gfc_expr *, gfc_expr *),
382 const char *a1, bt type1, int kind1, int optional1)
392 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
393 a1, type1, kind1, optional1,
398 /* Add a symbol to the subroutine list where the subroutine takes
402 add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
403 gfc_try (*check) (gfc_expr *),
404 gfc_expr *(*simplify) (gfc_expr *),
405 void (*resolve) (gfc_code *),
406 const char *a1, bt type1, int kind1, int optional1)
416 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
417 a1, type1, kind1, optional1,
422 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
423 function. MAX et al take 2 or more arguments. */
426 add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
427 int kind, int standard,
428 gfc_try (*check) (gfc_actual_arglist *),
429 gfc_expr *(*simplify) (gfc_expr *),
430 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
431 const char *a1, bt type1, int kind1, int optional1,
432 const char *a2, bt type2, int kind2, int optional2)
442 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
443 a1, type1, kind1, optional1,
444 a2, type2, kind2, optional2,
449 /* Add a symbol to the function list where the function takes
453 add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
454 int kind, int standard,
455 gfc_try (*check) (gfc_expr *, gfc_expr *),
456 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
457 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
458 const char *a1, bt type1, int kind1, int optional1,
459 const char *a2, bt type2, int kind2, int optional2)
469 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
470 a1, type1, kind1, optional1,
471 a2, type2, kind2, optional2,
476 /* Add a symbol to the subroutine list where the subroutine takes
480 add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
481 gfc_try (*check) (gfc_expr *, gfc_expr *),
482 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
483 void (*resolve) (gfc_code *),
484 const char *a1, bt type1, int kind1, int optional1,
485 const char *a2, bt type2, int kind2, int optional2)
495 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
496 a1, type1, kind1, optional1,
497 a2, type2, kind2, optional2,
502 /* Add a symbol to the function list where the function takes
506 add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
507 int kind, int standard,
508 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
509 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
510 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
511 const char *a1, bt type1, int kind1, int optional1,
512 const char *a2, bt type2, int kind2, int optional2,
513 const char *a3, bt type3, int kind3, int optional3)
523 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
524 a1, type1, kind1, optional1,
525 a2, type2, kind2, optional2,
526 a3, type3, kind3, optional3,
531 /* MINLOC and MAXLOC get special treatment because their argument
532 might have to be reordered. */
535 add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
536 int kind, int standard,
537 gfc_try (*check) (gfc_actual_arglist *),
538 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
539 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
540 const char *a1, bt type1, int kind1, int optional1,
541 const char *a2, bt type2, int kind2, int optional2,
542 const char *a3, bt type3, int kind3, int optional3)
552 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
553 a1, type1, kind1, optional1,
554 a2, type2, kind2, optional2,
555 a3, type3, kind3, optional3,
560 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
561 their argument also might have to be reordered. */
564 add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
565 int kind, int standard,
566 gfc_try (*check) (gfc_actual_arglist *),
567 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
568 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
569 const char *a1, bt type1, int kind1, int optional1,
570 const char *a2, bt type2, int kind2, int optional2,
571 const char *a3, bt type3, int kind3, int optional3)
581 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
582 a1, type1, kind1, optional1,
583 a2, type2, kind2, optional2,
584 a3, type3, kind3, optional3,
589 /* Add a symbol to the subroutine list where the subroutine takes
593 add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
594 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
595 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
596 void (*resolve) (gfc_code *),
597 const char *a1, bt type1, int kind1, int optional1,
598 const char *a2, bt type2, int kind2, int optional2,
599 const char *a3, bt type3, int kind3, int optional3)
609 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
610 a1, type1, kind1, optional1,
611 a2, type2, kind2, optional2,
612 a3, type3, kind3, optional3,
617 /* Add a symbol to the function list where the function takes
621 add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
622 int kind, int standard,
623 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
624 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
626 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
628 const char *a1, bt type1, int kind1, int optional1,
629 const char *a2, bt type2, int kind2, int optional2,
630 const char *a3, bt type3, int kind3, int optional3,
631 const char *a4, bt type4, int kind4, int optional4 )
641 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
642 a1, type1, kind1, optional1,
643 a2, type2, kind2, optional2,
644 a3, type3, kind3, optional3,
645 a4, type4, kind4, optional4,
650 /* Add a symbol to the subroutine list where the subroutine takes
654 add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
655 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
656 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
658 void (*resolve) (gfc_code *),
659 const char *a1, bt type1, int kind1, int optional1,
660 const char *a2, bt type2, int kind2, int optional2,
661 const char *a3, bt type3, int kind3, int optional3,
662 const char *a4, bt type4, int kind4, int optional4)
672 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
673 a1, type1, kind1, optional1,
674 a2, type2, kind2, optional2,
675 a3, type3, kind3, optional3,
676 a4, type4, kind4, optional4,
681 /* Add a symbol to the subroutine list where the subroutine takes
685 add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
686 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
688 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
689 gfc_expr *, gfc_expr *),
690 void (*resolve) (gfc_code *),
691 const char *a1, bt type1, int kind1, int optional1,
692 const char *a2, bt type2, int kind2, int optional2,
693 const char *a3, bt type3, int kind3, int optional3,
694 const char *a4, bt type4, int kind4, int optional4,
695 const char *a5, bt type5, int kind5, int optional5)
705 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
706 a1, type1, kind1, optional1,
707 a2, type2, kind2, optional2,
708 a3, type3, kind3, optional3,
709 a4, type4, kind4, optional4,
710 a5, type5, kind5, optional5,
715 /* Locate an intrinsic symbol given a base pointer, number of elements
716 in the table and a pointer to a name. Returns the NULL pointer if
717 a name is not found. */
719 static gfc_intrinsic_sym *
720 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
722 /* name may be a user-supplied string, so we must first make sure
723 that we're comparing against a pointer into the global string
725 const char *p = gfc_get_string (name);
729 if (p == start->name)
740 /* Given a name, find a function in the intrinsic function table.
741 Returns NULL if not found. */
744 gfc_find_function (const char *name)
746 gfc_intrinsic_sym *sym;
748 sym = find_sym (functions, nfunc, name);
750 sym = find_sym (conversion, nconv, name);
756 /* Given a name, find a function in the intrinsic subroutine table.
757 Returns NULL if not found. */
760 gfc_find_subroutine (const char *name)
762 return find_sym (subroutines, nsub, name);
766 /* Given a string, figure out if it is the name of a generic intrinsic
770 gfc_generic_intrinsic (const char *name)
772 gfc_intrinsic_sym *sym;
774 sym = gfc_find_function (name);
775 return (sym == NULL) ? 0 : sym->generic;
779 /* Given a string, figure out if it is the name of a specific
780 intrinsic function or not. */
783 gfc_specific_intrinsic (const char *name)
785 gfc_intrinsic_sym *sym;
787 sym = gfc_find_function (name);
788 return (sym == NULL) ? 0 : sym->specific;
792 /* Given a string, figure out if it is the name of an intrinsic function
793 or subroutine allowed as an actual argument or not. */
795 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
797 gfc_intrinsic_sym *sym;
799 /* Intrinsic subroutines are not allowed as actual arguments. */
804 sym = gfc_find_function (name);
805 return (sym == NULL) ? 0 : sym->actual_ok;
810 /* Given a symbol, find out if it is (and is to be treated) an intrinsic. If
811 it's name refers to an intrinsic but this intrinsic is not included in the
812 selected standard, this returns FALSE and sets the symbol's external
816 gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
818 gfc_intrinsic_sym* isym;
821 /* If INTRINSIC/EXTERNAL state is already known, return. */
822 if (sym->attr.intrinsic)
824 if (sym->attr.external)
828 isym = gfc_find_subroutine (sym->name);
830 isym = gfc_find_function (sym->name);
832 /* No such intrinsic available at all? */
836 /* See if this intrinsic is allowed in the current standard. */
837 if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
839 if (gfc_option.warn_intrinsics_std)
840 gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
841 " selected standard but %s and '%s' will be treated as"
842 " if declared EXTERNAL. Use an appropriate -std=*"
843 " option or define -fall-intrinsics to allow this"
844 " intrinsic.", sym->name, &loc, symstd, sym->name);
845 sym->attr.external = 1;
854 /* Collect a set of intrinsic functions into a generic collection.
855 The first argument is the name of the generic function, which is
856 also the name of a specific function. The rest of the specifics
857 currently in the table are placed into the list of specific
858 functions associated with that generic.
861 FIXME: Remove the argument STANDARD if no regressions are
862 encountered. Change all callers (approx. 360).
866 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
868 gfc_intrinsic_sym *g;
870 if (sizing != SZ_NOTHING)
873 g = gfc_find_function (name);
875 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
878 gcc_assert (g->id == id);
882 if ((g + 1)->name != NULL)
883 g->specific_head = g + 1;
886 while (g->name != NULL)
888 gcc_assert (g->id == id);
900 /* Create a duplicate intrinsic function entry for the current
901 function, the only differences being the alternate name and
902 a different standard if necessary. Note that we use argument
903 lists more than once, but all argument lists are freed as a
907 make_alias (const char *name, int standard)
920 next_sym[0] = next_sym[-1];
921 next_sym->name = gfc_get_string (name);
922 next_sym->standard = standard;
932 /* Make the current subroutine noreturn. */
937 if (sizing == SZ_NOTHING)
938 next_sym[-1].noreturn = 1;
942 /* Add intrinsic functions. */
947 /* Argument names as in the standard (to be used as argument keywords). */
949 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
950 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
951 *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
952 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
953 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
954 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
955 *p = "p", *ar = "array", *shp = "shape", *src = "source",
956 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
957 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
958 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
959 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
960 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
961 *num = "number", *tm = "time", *nm = "name", *md = "mode";
963 int di, dr, dd, dl, dc, dz, ii;
965 di = gfc_default_integer_kind;
966 dr = gfc_default_real_kind;
967 dd = gfc_default_double_kind;
968 dl = gfc_default_logical_kind;
969 dc = gfc_default_character_kind;
970 dz = gfc_default_complex_kind;
971 ii = gfc_index_integer_kind;
973 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
974 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
975 a, BT_REAL, dr, REQUIRED);
977 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
978 NULL, gfc_simplify_abs, gfc_resolve_abs,
979 a, BT_INTEGER, di, REQUIRED);
981 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
982 gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
983 a, BT_REAL, dd, REQUIRED);
985 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
986 NULL, gfc_simplify_abs, gfc_resolve_abs,
987 a, BT_COMPLEX, dz, REQUIRED);
989 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
990 NULL, gfc_simplify_abs, gfc_resolve_abs,
991 a, BT_COMPLEX, dd, REQUIRED);
993 make_alias ("cdabs", GFC_STD_GNU);
995 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
997 /* The checking function for ACCESS is called gfc_check_access_func
998 because the name gfc_check_access is already used in module.c. */
999 add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1000 gfc_check_access_func, NULL, gfc_resolve_access,
1001 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1003 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1005 add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1006 BT_CHARACTER, dc, GFC_STD_F95,
1007 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1008 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1010 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1012 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1013 gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
1014 x, BT_REAL, dr, REQUIRED);
1016 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1017 gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1018 x, BT_REAL, dd, REQUIRED);
1020 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1022 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1023 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_acosh,
1024 gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1026 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1027 gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1028 x, BT_REAL, dd, REQUIRED);
1030 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1032 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1033 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1034 gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1036 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1038 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1039 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1040 gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1042 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1044 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1045 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1046 z, BT_COMPLEX, dz, REQUIRED);
1048 make_alias ("imag", GFC_STD_GNU);
1049 make_alias ("imagpart", GFC_STD_GNU);
1051 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1052 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1053 z, BT_COMPLEX, dd, REQUIRED);
1055 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1057 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1058 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1059 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1061 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1062 NULL, gfc_simplify_dint, gfc_resolve_dint,
1063 a, BT_REAL, dd, REQUIRED);
1065 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1067 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1068 gfc_check_all_any, NULL, gfc_resolve_all,
1069 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1071 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1073 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1074 gfc_check_allocated, NULL, NULL,
1075 ar, BT_UNKNOWN, 0, REQUIRED);
1077 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1079 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1080 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1081 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1083 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1084 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1085 a, BT_REAL, dd, REQUIRED);
1087 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1089 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1090 gfc_check_all_any, NULL, gfc_resolve_any,
1091 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1093 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1095 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1096 gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
1097 x, BT_REAL, dr, REQUIRED);
1099 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1100 gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1101 x, BT_REAL, dd, REQUIRED);
1103 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1105 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1106 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_asinh,
1107 gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1109 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1110 gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1111 x, BT_REAL, dd, REQUIRED);
1113 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1115 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1116 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1117 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1119 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1121 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1122 gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
1123 x, BT_REAL, dr, REQUIRED);
1125 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1126 gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1127 x, BT_REAL, dd, REQUIRED);
1129 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1131 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1132 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_atanh,
1133 gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1135 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1136 gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1137 x, BT_REAL, dd, REQUIRED);
1139 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1141 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1142 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1143 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1145 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1146 gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1147 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1149 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1151 /* Bessel and Neumann functions for G77 compatibility. */
1152 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1153 gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1154 x, BT_REAL, dr, REQUIRED);
1156 make_alias ("bessel_j0", GFC_STD_F2008);
1158 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1159 gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1160 x, BT_REAL, dd, REQUIRED);
1162 make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1164 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1165 gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1166 x, BT_REAL, dr, REQUIRED);
1168 make_alias ("bessel_j1", GFC_STD_F2008);
1170 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1171 gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1172 x, BT_REAL, dd, REQUIRED);
1174 make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1176 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1177 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1178 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1180 make_alias ("bessel_jn", GFC_STD_F2008);
1182 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1183 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1184 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1186 make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1188 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1189 gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1190 x, BT_REAL, dr, REQUIRED);
1192 make_alias ("bessel_y0", GFC_STD_F2008);
1194 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1195 gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1196 x, BT_REAL, dd, REQUIRED);
1198 make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1200 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1201 gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1202 x, BT_REAL, dr, REQUIRED);
1204 make_alias ("bessel_y1", GFC_STD_F2008);
1206 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1207 gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1208 x, BT_REAL, dd, REQUIRED);
1210 make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1212 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1213 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1214 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1216 make_alias ("bessel_yn", GFC_STD_F2008);
1218 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1219 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1220 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1222 make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1224 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1225 gfc_check_i, gfc_simplify_bit_size, NULL,
1226 i, BT_INTEGER, di, REQUIRED);
1228 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1230 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1231 gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1232 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1234 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1236 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1237 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1238 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1240 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1242 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1243 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1244 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1246 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1248 add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1249 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1250 nm, BT_CHARACTER, dc, REQUIRED);
1252 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1254 add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1255 gfc_check_chmod, NULL, gfc_resolve_chmod,
1256 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1258 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1260 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1261 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1262 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1263 kind, BT_INTEGER, di, OPTIONAL);
1265 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1267 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1268 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1270 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1273 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1274 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1275 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1277 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1279 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1280 complex instead of the default complex. */
1282 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1283 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1284 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1286 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1288 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1289 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1290 z, BT_COMPLEX, dz, REQUIRED);
1292 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1293 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1294 z, BT_COMPLEX, dd, REQUIRED);
1296 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1298 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1299 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1300 x, BT_REAL, dr, REQUIRED);
1302 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1303 gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1304 x, BT_REAL, dd, REQUIRED);
1306 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1307 NULL, gfc_simplify_cos, gfc_resolve_cos,
1308 x, BT_COMPLEX, dz, REQUIRED);
1310 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1311 NULL, gfc_simplify_cos, gfc_resolve_cos,
1312 x, BT_COMPLEX, dd, REQUIRED);
1314 make_alias ("cdcos", GFC_STD_GNU);
1316 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1318 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1319 gfc_check_fn_r, gfc_simplify_cosh, gfc_resolve_cosh,
1320 x, BT_REAL, dr, REQUIRED);
1322 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1323 gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1324 x, BT_REAL, dd, REQUIRED);
1326 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1328 add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1329 BT_INTEGER, di, GFC_STD_F95,
1330 gfc_check_count, NULL, gfc_resolve_count,
1331 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1332 kind, BT_INTEGER, di, OPTIONAL);
1334 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1336 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1337 gfc_check_cshift, NULL, gfc_resolve_cshift,
1338 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1339 dm, BT_INTEGER, ii, OPTIONAL);
1341 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1343 add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1344 gfc_check_ctime, NULL, gfc_resolve_ctime,
1345 tm, BT_INTEGER, di, REQUIRED);
1347 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1349 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1350 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1351 a, BT_REAL, dr, REQUIRED);
1353 make_alias ("dfloat", GFC_STD_GNU);
1355 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1357 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1358 gfc_check_digits, gfc_simplify_digits, NULL,
1359 x, BT_UNKNOWN, dr, REQUIRED);
1361 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1363 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1364 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1365 x, BT_REAL, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1367 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1368 NULL, gfc_simplify_dim, gfc_resolve_dim,
1369 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1371 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1372 gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1373 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1375 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1377 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1378 GFC_STD_F95, gfc_check_dot_product, NULL, gfc_resolve_dot_product,
1379 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1381 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1383 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1384 gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1385 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1387 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1389 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1391 a, BT_COMPLEX, dd, REQUIRED);
1393 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1395 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1396 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1397 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1398 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1400 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1402 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1403 gfc_check_x, gfc_simplify_epsilon, NULL,
1404 x, BT_REAL, dr, REQUIRED);
1406 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1408 /* G77 compatibility for the ERF() and ERFC() functions. */
1409 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1410 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1411 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1413 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1414 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1415 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1417 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1419 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1420 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1421 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1423 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1424 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1425 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1427 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1429 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1430 BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r, NULL,
1431 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1433 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1435 /* G77 compatibility */
1436 add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1437 gfc_check_dtime_etime, NULL, NULL,
1438 x, BT_REAL, 4, REQUIRED);
1440 make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1442 add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1443 gfc_check_dtime_etime, NULL, NULL,
1444 x, BT_REAL, 4, REQUIRED);
1446 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1448 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1449 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1450 x, BT_REAL, dr, REQUIRED);
1452 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1453 gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1454 x, BT_REAL, dd, REQUIRED);
1456 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1457 NULL, gfc_simplify_exp, gfc_resolve_exp,
1458 x, BT_COMPLEX, dz, REQUIRED);
1460 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1461 NULL, gfc_simplify_exp, gfc_resolve_exp,
1462 x, BT_COMPLEX, dd, REQUIRED);
1464 make_alias ("cdexp", GFC_STD_GNU);
1466 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1468 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1469 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1470 x, BT_REAL, dr, REQUIRED);
1472 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1474 add_sym_0 ("fdate", GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1475 NULL, NULL, gfc_resolve_fdate);
1477 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1479 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1480 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1481 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1483 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1485 /* G77 compatible fnum */
1486 add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1487 gfc_check_fnum, NULL, gfc_resolve_fnum,
1488 ut, BT_INTEGER, di, REQUIRED);
1490 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1492 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1493 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1494 x, BT_REAL, dr, REQUIRED);
1496 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1498 add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1499 gfc_check_fstat, NULL, gfc_resolve_fstat,
1500 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1502 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1504 add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1505 gfc_check_ftell, NULL, gfc_resolve_ftell,
1506 ut, BT_INTEGER, di, REQUIRED);
1508 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1510 add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1511 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1512 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1514 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1516 add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1517 gfc_check_fgetput, NULL, gfc_resolve_fget,
1518 c, BT_CHARACTER, dc, REQUIRED);
1520 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1522 add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1523 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1524 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1526 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1528 add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1529 gfc_check_fgetput, NULL, gfc_resolve_fput,
1530 c, BT_CHARACTER, dc, REQUIRED);
1532 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1534 add_sym_1 ("gamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1535 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1536 gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1538 add_sym_1 ("dgamma", GFC_ISYM_GAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1539 gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1540 x, BT_REAL, dr, REQUIRED);
1542 make_generic ("gamma", GFC_ISYM_GAMMA, GFC_STD_F2008);
1544 /* Unix IDs (g77 compatibility) */
1545 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1546 NULL, NULL, gfc_resolve_getcwd,
1547 c, BT_CHARACTER, dc, REQUIRED);
1549 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1551 add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1552 NULL, NULL, gfc_resolve_getgid);
1554 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1556 add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1557 NULL, NULL, gfc_resolve_getpid);
1559 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1561 add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1562 NULL, NULL, gfc_resolve_getuid);
1564 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1566 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1567 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1568 a, BT_CHARACTER, dc, REQUIRED);
1570 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1572 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1573 gfc_check_huge, gfc_simplify_huge, NULL,
1574 x, BT_UNKNOWN, dr, REQUIRED);
1576 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1578 add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1579 BT_REAL, dr, GFC_STD_F2008,
1580 gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1581 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1583 make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1585 add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1586 BT_INTEGER, di, GFC_STD_F95,
1587 gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1588 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1590 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1592 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1593 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1594 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1596 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1598 add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1599 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1600 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1602 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1604 add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1607 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1609 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1610 gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1611 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1613 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1615 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1616 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1617 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1618 ln, BT_INTEGER, di, REQUIRED);
1620 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1622 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1623 gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1624 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1626 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1628 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1629 BT_INTEGER, di, GFC_STD_F77,
1630 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1631 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1633 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1635 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1636 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1637 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1639 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1641 add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1642 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1643 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1645 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1647 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1648 NULL, NULL, gfc_resolve_ierrno);
1650 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1652 /* The resolution function for INDEX is called gfc_resolve_index_func
1653 because the name gfc_resolve_index is already used in resolve.c. */
1654 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1655 BT_INTEGER, di, GFC_STD_F77,
1656 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1657 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1658 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1660 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1662 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1663 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1664 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1666 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1667 NULL, gfc_simplify_ifix, NULL,
1668 a, BT_REAL, dr, REQUIRED);
1670 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1671 NULL, gfc_simplify_idint, NULL,
1672 a, BT_REAL, dd, REQUIRED);
1674 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1676 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1677 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1678 a, BT_REAL, dr, REQUIRED);
1680 make_alias ("short", GFC_STD_GNU);
1682 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1684 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1685 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1686 a, BT_REAL, dr, REQUIRED);
1688 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1690 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1691 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1692 a, BT_REAL, dr, REQUIRED);
1694 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1696 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1697 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1698 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1700 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1702 add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1703 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1704 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1706 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1708 /* The following function is for G77 compatibility. */
1709 add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1710 gfc_check_irand, NULL, NULL,
1711 i, BT_INTEGER, 4, OPTIONAL);
1713 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1715 add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1716 gfc_check_isatty, NULL, gfc_resolve_isatty,
1717 ut, BT_INTEGER, di, REQUIRED);
1719 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1721 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1722 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1723 gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED);
1725 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1727 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1728 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1729 gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED);
1731 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1733 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL,
1734 dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL,
1735 x, BT_REAL, 0, REQUIRED);
1737 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1739 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1740 gfc_check_ishft, NULL, gfc_resolve_rshift,
1741 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1743 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1745 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1746 gfc_check_ishft, NULL, gfc_resolve_lshift,
1747 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1749 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1751 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1752 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1753 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1755 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1757 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1758 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1759 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1760 sz, BT_INTEGER, di, OPTIONAL);
1762 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1764 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1765 gfc_check_kill, NULL, gfc_resolve_kill,
1766 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1768 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1770 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1771 gfc_check_kind, gfc_simplify_kind, NULL,
1772 x, BT_REAL, dr, REQUIRED);
1774 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1776 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1777 BT_INTEGER, di, GFC_STD_F95,
1778 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1779 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1780 kind, BT_INTEGER, di, OPTIONAL);
1782 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1784 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1785 BT_INTEGER, di, GFC_STD_F2008,
1786 gfc_check_i, gfc_simplify_leadz, NULL,
1787 i, BT_INTEGER, di, REQUIRED);
1789 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1791 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1792 BT_INTEGER, di, GFC_STD_F77,
1793 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1794 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1796 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1798 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1799 BT_INTEGER, di, GFC_STD_F95,
1800 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1801 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1803 make_alias ("lnblnk", GFC_STD_GNU);
1805 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1807 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1809 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1810 x, BT_REAL, dr, REQUIRED);
1812 make_alias ("log_gamma", GFC_STD_F2008);
1814 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1815 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1816 x, BT_REAL, dr, REQUIRED);
1818 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1819 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1820 x, BT_REAL, dr, REQUIRED);
1822 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1825 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1826 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1827 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1829 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1831 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1832 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1833 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1835 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1837 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1838 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1839 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1841 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1843 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1844 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1845 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1847 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1849 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1850 gfc_check_link, NULL, gfc_resolve_link,
1851 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
1853 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1855 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1856 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1857 x, BT_REAL, dr, REQUIRED);
1859 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1860 NULL, gfc_simplify_log, gfc_resolve_log,
1861 x, BT_REAL, dr, REQUIRED);
1863 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1864 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
1865 x, BT_REAL, dd, REQUIRED);
1867 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1868 NULL, gfc_simplify_log, gfc_resolve_log,
1869 x, BT_COMPLEX, dz, REQUIRED);
1871 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1872 NULL, gfc_simplify_log, gfc_resolve_log,
1873 x, BT_COMPLEX, dd, REQUIRED);
1875 make_alias ("cdlog", GFC_STD_GNU);
1877 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
1879 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1880 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1881 x, BT_REAL, dr, REQUIRED);
1883 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1884 NULL, gfc_simplify_log10, gfc_resolve_log10,
1885 x, BT_REAL, dr, REQUIRED);
1887 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1888 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
1889 x, BT_REAL, dd, REQUIRED);
1891 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
1893 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1894 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1895 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1897 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
1899 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1900 gfc_check_stat, NULL, gfc_resolve_lstat,
1901 a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1903 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
1905 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1906 gfc_check_malloc, NULL, gfc_resolve_malloc, a, BT_INTEGER, di,
1909 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
1911 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1912 gfc_check_matmul, NULL, gfc_resolve_matmul,
1913 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
1915 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
1917 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
1918 int(max). The max function must take at least two arguments. */
1920 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1921 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1922 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
1924 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1925 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1926 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1928 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1929 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1930 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1932 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1933 gfc_check_min_max_real, gfc_simplify_max, NULL,
1934 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1936 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1937 gfc_check_min_max_real, gfc_simplify_max, NULL,
1938 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1940 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1941 gfc_check_min_max_double, gfc_simplify_max, NULL,
1942 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1944 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
1946 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
1947 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
1948 x, BT_UNKNOWN, dr, REQUIRED);
1950 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
1952 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1953 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1954 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1955 msk, BT_LOGICAL, dl, OPTIONAL);
1957 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
1959 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1960 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
1961 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1962 msk, BT_LOGICAL, dl, OPTIONAL);
1964 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
1966 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1967 NULL, NULL, gfc_resolve_mclock);
1969 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
1971 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1972 NULL, NULL, gfc_resolve_mclock8);
1974 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
1976 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1977 gfc_check_merge, NULL, gfc_resolve_merge,
1978 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
1979 msk, BT_LOGICAL, dl, REQUIRED);
1981 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
1983 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
1986 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1987 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
1988 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1990 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1991 gfc_check_min_max_integer, gfc_simplify_min, NULL,
1992 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1994 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1995 gfc_check_min_max_integer, gfc_simplify_min, NULL,
1996 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1998 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1999 gfc_check_min_max_real, gfc_simplify_min, NULL,
2000 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2002 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2003 gfc_check_min_max_real, gfc_simplify_min, NULL,
2004 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2006 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2007 gfc_check_min_max_double, gfc_simplify_min, NULL,
2008 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2010 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2012 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2013 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2014 x, BT_UNKNOWN, dr, REQUIRED);
2016 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2018 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2019 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2020 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2021 msk, BT_LOGICAL, dl, OPTIONAL);
2023 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2025 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2026 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2027 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2028 msk, BT_LOGICAL, dl, OPTIONAL);
2030 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2032 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2033 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2034 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2036 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2037 NULL, gfc_simplify_mod, gfc_resolve_mod,
2038 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2040 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2041 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2042 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2044 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2046 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2047 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2048 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2050 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2052 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2053 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2054 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2056 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2058 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2059 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2060 a, BT_CHARACTER, dc, REQUIRED);
2062 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2064 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2065 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2066 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2068 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2069 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2070 a, BT_REAL, dd, REQUIRED);
2072 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2074 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2075 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2076 i, BT_INTEGER, di, REQUIRED);
2078 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2080 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2081 gfc_check_null, gfc_simplify_null, NULL,
2082 mo, BT_INTEGER, di, OPTIONAL);
2084 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2086 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2087 gfc_check_pack, NULL, gfc_resolve_pack,
2088 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2089 v, BT_REAL, dr, OPTIONAL);
2091 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2093 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2094 gfc_check_precision, gfc_simplify_precision, NULL,
2095 x, BT_UNKNOWN, 0, REQUIRED);
2097 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2099 add_sym_1 ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2100 gfc_check_present, NULL, NULL,
2101 a, BT_REAL, dr, REQUIRED);
2103 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2105 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2106 gfc_check_product_sum, NULL, gfc_resolve_product,
2107 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2108 msk, BT_LOGICAL, dl, OPTIONAL);
2110 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2112 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2113 gfc_check_radix, gfc_simplify_radix, NULL,
2114 x, BT_UNKNOWN, 0, REQUIRED);
2116 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2118 /* The following function is for G77 compatibility. */
2119 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2120 gfc_check_rand, NULL, NULL,
2121 i, BT_INTEGER, 4, OPTIONAL);
2123 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2124 use slightly different shoddy multiplicative congruential PRNG. */
2125 make_alias ("ran", GFC_STD_GNU);
2127 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2129 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2130 gfc_check_range, gfc_simplify_range, NULL,
2131 x, BT_REAL, dr, REQUIRED);
2133 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2135 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2136 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2137 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2139 /* This provides compatibility with g77. */
2140 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2141 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2142 a, BT_UNKNOWN, dr, REQUIRED);
2144 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2145 gfc_check_i, gfc_simplify_float, NULL,
2146 a, BT_INTEGER, di, REQUIRED);
2148 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2149 NULL, gfc_simplify_sngl, NULL,
2150 a, BT_REAL, dd, REQUIRED);
2152 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2154 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2155 gfc_check_rename, NULL, gfc_resolve_rename,
2156 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2158 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2160 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2161 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2162 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2164 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2166 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2167 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2168 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2169 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2171 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2173 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2174 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2175 x, BT_REAL, dr, REQUIRED);
2177 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2179 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2180 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2181 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2183 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2185 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2186 BT_INTEGER, di, GFC_STD_F95,
2187 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2188 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2189 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2191 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2193 /* Added for G77 compatibility garbage. */
2194 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2197 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2199 /* Added for G77 compatibility. */
2200 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2201 gfc_check_secnds, NULL, gfc_resolve_secnds,
2202 x, BT_REAL, dr, REQUIRED);
2204 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2206 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2207 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2208 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2209 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2211 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2213 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2214 GFC_STD_F95, gfc_check_selected_int_kind,
2215 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2217 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2219 add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2220 GFC_STD_F95, gfc_check_selected_real_kind,
2221 gfc_simplify_selected_real_kind, NULL,
2222 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2224 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2226 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2227 gfc_check_set_exponent, gfc_simplify_set_exponent,
2228 gfc_resolve_set_exponent,
2229 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2231 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2233 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2234 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2235 src, BT_REAL, dr, REQUIRED);
2237 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2239 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2240 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2241 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2243 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2244 NULL, gfc_simplify_sign, gfc_resolve_sign,
2245 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2247 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2248 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2249 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2251 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2253 add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2254 gfc_check_signal, NULL, gfc_resolve_signal,
2255 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2257 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2259 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2260 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2261 x, BT_REAL, dr, REQUIRED);
2263 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2264 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2265 x, BT_REAL, dd, REQUIRED);
2267 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2268 NULL, gfc_simplify_sin, gfc_resolve_sin,
2269 x, BT_COMPLEX, dz, REQUIRED);
2271 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2272 NULL, gfc_simplify_sin, gfc_resolve_sin,
2273 x, BT_COMPLEX, dd, REQUIRED);
2275 make_alias ("cdsin", GFC_STD_GNU);
2277 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2279 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2280 gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2281 x, BT_REAL, dr, REQUIRED);
2283 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2284 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2285 x, BT_REAL, dd, REQUIRED);
2287 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2289 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2290 BT_INTEGER, di, GFC_STD_F95,
2291 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2292 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2293 kind, BT_INTEGER, di, OPTIONAL);
2295 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2297 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2298 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2299 x, BT_UNKNOWN, 0, REQUIRED);
2301 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2302 make_alias ("c_sizeof", GFC_STD_F2008);
2304 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2305 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2306 x, BT_REAL, dr, REQUIRED);
2308 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2310 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2311 gfc_check_spread, NULL, gfc_resolve_spread,
2312 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2313 ncopies, BT_INTEGER, di, REQUIRED);
2315 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2317 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2318 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2319 x, BT_REAL, dr, REQUIRED);
2321 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2322 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2323 x, BT_REAL, dd, REQUIRED);
2325 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2326 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2327 x, BT_COMPLEX, dz, REQUIRED);
2329 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2330 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2331 x, BT_COMPLEX, dd, REQUIRED);
2333 make_alias ("cdsqrt", GFC_STD_GNU);
2335 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2337 add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2338 gfc_check_stat, NULL, gfc_resolve_stat,
2339 a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2341 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2343 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2344 gfc_check_product_sum, NULL, gfc_resolve_sum,
2345 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2346 msk, BT_LOGICAL, dl, OPTIONAL);
2348 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2350 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2351 gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2352 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2354 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2356 add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2358 c, BT_CHARACTER, dc, REQUIRED);
2360 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2362 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2363 gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2364 x, BT_REAL, dr, REQUIRED);
2366 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2367 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2368 x, BT_REAL, dd, REQUIRED);
2370 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2372 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2373 gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2374 x, BT_REAL, dr, REQUIRED);
2376 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2377 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2378 x, BT_REAL, dd, REQUIRED);
2380 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2382 add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2383 NULL, NULL, gfc_resolve_time);
2385 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2387 add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2388 NULL, NULL, gfc_resolve_time8);
2390 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2392 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2393 gfc_check_x, gfc_simplify_tiny, NULL,
2394 x, BT_REAL, dr, REQUIRED);
2396 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2398 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2399 BT_INTEGER, di, GFC_STD_F2008,
2400 gfc_check_i, gfc_simplify_trailz, NULL,
2401 i, BT_INTEGER, di, REQUIRED);
2403 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2405 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2406 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2407 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2408 sz, BT_INTEGER, di, OPTIONAL);
2410 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2412 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2413 gfc_check_transpose, NULL, gfc_resolve_transpose,
2414 m, BT_REAL, dr, REQUIRED);
2416 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2418 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2419 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2420 stg, BT_CHARACTER, dc, REQUIRED);
2422 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2424 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2425 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2426 ut, BT_INTEGER, di, REQUIRED);
2428 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2430 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2431 BT_INTEGER, di, GFC_STD_F95,
2432 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2433 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2434 kind, BT_INTEGER, di, OPTIONAL);
2436 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2438 /* g77 compatibility for UMASK. */
2439 add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2440 gfc_check_umask, NULL, gfc_resolve_umask,
2441 a, BT_INTEGER, di, REQUIRED);
2443 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2445 /* g77 compatibility for UNLINK. */
2446 add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2447 gfc_check_unlink, NULL, gfc_resolve_unlink,
2448 a, BT_CHARACTER, dc, REQUIRED);
2450 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2452 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2453 gfc_check_unpack, NULL, gfc_resolve_unpack,
2454 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2455 f, BT_REAL, dr, REQUIRED);
2457 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2459 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2460 BT_INTEGER, di, GFC_STD_F95,
2461 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2462 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2463 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2465 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2467 add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
2468 gfc_check_loc, NULL, gfc_resolve_loc,
2469 ar, BT_UNKNOWN, 0, REQUIRED);
2471 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2475 /* Add intrinsic subroutines. */
2478 add_subroutines (void)
2480 /* Argument names as in the standard (to be used as argument keywords). */
2482 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2483 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2484 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2485 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2486 *com = "command", *length = "length", *st = "status",
2487 *val = "value", *num = "number", *name = "name",
2488 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2489 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2490 *whence = "whence", *pos = "pos";
2492 int di, dr, dc, dl, ii;
2494 di = gfc_default_integer_kind;
2495 dr = gfc_default_real_kind;
2496 dc = gfc_default_character_kind;
2497 dl = gfc_default_logical_kind;
2498 ii = gfc_index_integer_kind;
2500 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2504 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2505 gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2506 tm, BT_REAL, dr, REQUIRED);
2508 /* More G77 compatibility garbage. */
2509 add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2510 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2511 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2513 add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2514 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2515 vl, BT_INTEGER, 4, REQUIRED);
2517 add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2518 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2519 vl, BT_INTEGER, 4, REQUIRED);
2521 add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2522 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2523 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2525 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2526 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2527 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2529 add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2530 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2531 tm, BT_REAL, dr, REQUIRED);
2533 add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2534 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2535 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2537 add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2538 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2539 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2540 st, BT_INTEGER, di, OPTIONAL);
2542 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2543 gfc_check_date_and_time, NULL, NULL,
2544 dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2545 zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2547 /* More G77 compatibility garbage. */
2548 add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2549 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2550 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2552 add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2553 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2554 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2556 add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2557 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2558 dt, BT_CHARACTER, dc, REQUIRED);
2560 add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2561 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2564 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2565 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2566 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2568 add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2570 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2573 add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2574 gfc_check_getarg, NULL, gfc_resolve_getarg,
2575 pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2577 add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2578 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2581 /* F2003 commandline routines. */
2583 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2584 NULL, NULL, gfc_resolve_get_command,
2585 com, BT_CHARACTER, dc, OPTIONAL,
2586 length, BT_INTEGER, di, OPTIONAL,
2587 st, BT_INTEGER, di, OPTIONAL);
2589 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2590 NULL, NULL, gfc_resolve_get_command_argument,
2591 num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2592 length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2594 /* F2003 subroutine to get environment variables. */
2596 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2597 NULL, NULL, gfc_resolve_get_environment_variable,
2598 name, BT_CHARACTER, dc, REQUIRED,
2599 val, BT_CHARACTER, dc, OPTIONAL,
2600 length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2601 trim_name, BT_LOGICAL, dl, OPTIONAL);
2603 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2604 gfc_check_move_alloc, NULL, NULL,
2605 f, BT_UNKNOWN, 0, REQUIRED,
2606 t, BT_UNKNOWN, 0, REQUIRED);
2608 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2609 gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2610 f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2611 ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2612 tp, BT_INTEGER, di, REQUIRED);
2614 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2615 gfc_check_random_number, NULL, gfc_resolve_random_number,
2616 h, BT_REAL, dr, REQUIRED);
2618 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2619 BT_UNKNOWN, 0, GFC_STD_F95,
2620 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2621 sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2622 gt, BT_INTEGER, di, OPTIONAL);
2624 /* More G77 compatibility garbage. */
2625 add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2626 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2627 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2628 st, BT_INTEGER, di, OPTIONAL);
2630 add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2631 gfc_check_srand, NULL, gfc_resolve_srand,
2632 c, BT_INTEGER, 4, REQUIRED);
2634 add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2635 gfc_check_exit, NULL, gfc_resolve_exit,
2636 st, BT_INTEGER, di, OPTIONAL);
2640 add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2641 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2642 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2643 st, BT_INTEGER, di, OPTIONAL);
2645 add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2646 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2647 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2649 add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2650 gfc_check_flush, NULL, gfc_resolve_flush,
2651 ut, BT_INTEGER, di, OPTIONAL);
2653 add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2654 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2655 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2656 st, BT_INTEGER, di, OPTIONAL);
2658 add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2659 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2660 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2662 add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2663 NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2665 add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2666 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2667 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, di, REQUIRED,
2668 whence, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2670 add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2671 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2672 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2674 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2675 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2676 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2678 add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2679 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2680 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2682 add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2683 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2684 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2685 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2687 add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2688 gfc_check_perror, NULL, gfc_resolve_perror,
2689 c, BT_CHARACTER, dc, REQUIRED);
2691 add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2692 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2693 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2694 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2696 add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2697 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2698 val, BT_INTEGER, di, REQUIRED);
2700 add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2701 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2702 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2703 st, BT_INTEGER, di, OPTIONAL);
2705 add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2706 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2707 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2708 st, BT_INTEGER, di, OPTIONAL);
2710 add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2711 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2712 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2713 st, BT_INTEGER, di, OPTIONAL);
2715 add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2716 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2717 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2718 st, BT_INTEGER, di, OPTIONAL);
2720 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2721 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2722 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2723 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2725 add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2726 NULL, NULL, gfc_resolve_system_sub,
2727 com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2729 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2730 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2731 c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2732 cm, BT_INTEGER, di, OPTIONAL);
2734 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2735 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2736 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2738 add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2739 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2740 val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2742 add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2743 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2744 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2748 /* Add a function to the list of conversion symbols. */
2751 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2753 gfc_typespec from, to;
2754 gfc_intrinsic_sym *sym;
2756 if (sizing == SZ_CONVS)
2762 gfc_clear_ts (&from);
2763 from.type = from_type;
2764 from.kind = from_kind;
2770 sym = conversion + nconv;
2772 sym->name = conv_name (&from, &to);
2773 sym->lib_name = sym->name;
2774 sym->simplify.cc = gfc_convert_constant;
2775 sym->standard = standard;
2777 sym->conversion = 1;
2779 sym->id = GFC_ISYM_CONVERSION;
2785 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2786 functions by looping over the kind tables. */
2789 add_conversions (void)
2793 /* Integer-Integer conversions. */
2794 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2795 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2800 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2801 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2804 /* Integer-Real/Complex conversions. */
2805 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2806 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2808 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2809 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2811 add_conv (BT_REAL, gfc_real_kinds[j].kind,
2812 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2814 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2815 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2817 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2818 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2821 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2823 /* Hollerith-Integer conversions. */
2824 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2825 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2826 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2827 /* Hollerith-Real conversions. */
2828 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2829 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2830 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2831 /* Hollerith-Complex conversions. */
2832 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2833 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2834 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2836 /* Hollerith-Character conversions. */
2837 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2838 gfc_default_character_kind, GFC_STD_LEGACY);
2840 /* Hollerith-Logical conversions. */
2841 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2842 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2843 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2846 /* Real/Complex - Real/Complex conversions. */
2847 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2848 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2852 add_conv (BT_REAL, gfc_real_kinds[i].kind,
2853 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2855 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2856 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2859 add_conv (BT_REAL, gfc_real_kinds[i].kind,
2860 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2862 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2863 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2866 /* Logical/Logical kind conversion. */
2867 for (i = 0; gfc_logical_kinds[i].kind; i++)
2868 for (j = 0; gfc_logical_kinds[j].kind; j++)
2873 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2874 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2877 /* Integer-Logical and Logical-Integer conversions. */
2878 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2879 for (i=0; gfc_integer_kinds[i].kind; i++)
2880 for (j=0; gfc_logical_kinds[j].kind; j++)
2882 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2883 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2884 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2885 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2891 add_char_conversions (void)
2895 /* Count possible conversions. */
2896 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
2897 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
2901 /* Allocate memory. */
2902 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
2904 /* Add the conversions themselves. */
2906 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
2907 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
2909 gfc_typespec from, to;
2914 gfc_clear_ts (&from);
2915 from.type = BT_CHARACTER;
2916 from.kind = gfc_character_kinds[i].kind;
2919 to.type = BT_CHARACTER;
2920 to.kind = gfc_character_kinds[j].kind;
2922 char_conversions[n].name = conv_name (&from, &to);
2923 char_conversions[n].lib_name = char_conversions[n].name;
2924 char_conversions[n].simplify.cc = gfc_convert_char_constant;
2925 char_conversions[n].standard = GFC_STD_F2003;
2926 char_conversions[n].elemental = 1;
2927 char_conversions[n].conversion = 0;
2928 char_conversions[n].ts = to;
2929 char_conversions[n].id = GFC_ISYM_CONVERSION;
2936 /* Initialize the table of intrinsics. */
2938 gfc_intrinsic_init_1 (void)
2942 nargs = nfunc = nsub = nconv = 0;
2944 /* Create a namespace to hold the resolved intrinsic symbols. */
2945 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2954 functions = XCNEWVAR (struct gfc_intrinsic_sym,
2955 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2956 + sizeof (gfc_intrinsic_arg) * nargs);
2958 next_sym = functions;
2959 subroutines = functions + nfunc;
2961 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
2963 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2965 sizing = SZ_NOTHING;
2972 /* Character conversion intrinsics need to be treated separately. */
2973 add_char_conversions ();
2975 /* Set the pure flag. All intrinsic functions are pure, and
2976 intrinsic subroutines are pure if they are elemental. */
2978 for (i = 0; i < nfunc; i++)
2979 functions[i].pure = 1;
2981 for (i = 0; i < nsub; i++)
2982 subroutines[i].pure = subroutines[i].elemental;
2987 gfc_intrinsic_done_1 (void)
2989 gfc_free (functions);
2990 gfc_free (conversion);
2991 gfc_free (char_conversions);
2992 gfc_free_namespace (gfc_intrinsic_namespace);
2996 /******** Subroutines to check intrinsic interfaces ***********/
2998 /* Given a formal argument list, remove any NULL arguments that may
2999 have been left behind by a sort against some formal argument list. */
3002 remove_nullargs (gfc_actual_arglist **ap)
3004 gfc_actual_arglist *head, *tail, *next;
3008 for (head = *ap; head; head = next)
3012 if (head->expr == NULL && !head->label)
3015 gfc_free_actual_arglist (head);
3034 /* Given an actual arglist and a formal arglist, sort the actual
3035 arglist so that its arguments are in a one-to-one correspondence
3036 with the format arglist. Arguments that are not present are given
3037 a blank gfc_actual_arglist structure. If something is obviously
3038 wrong (say, a missing required argument) we abort sorting and
3042 sort_actual (const char *name, gfc_actual_arglist **ap,
3043 gfc_intrinsic_arg *formal, locus *where)
3045 gfc_actual_arglist *actual, *a;
3046 gfc_intrinsic_arg *f;
3048 remove_nullargs (ap);
3051 for (f = formal; f; f = f->next)
3057 if (f == NULL && a == NULL) /* No arguments */
3061 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3067 if (a->name != NULL)
3079 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3083 /* Associate the remaining actual arguments, all of which have
3084 to be keyword arguments. */
3085 for (; a; a = a->next)
3087 for (f = formal; f; f = f->next)
3088 if (strcmp (a->name, f->name) == 0)
3093 if (a->name[0] == '%')
3094 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3095 "are not allowed in this context at %L", where);
3097 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3098 a->name, name, where);
3102 if (f->actual != NULL)
3104 gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3105 f->name, name, where);
3113 /* At this point, all unmatched formal args must be optional. */
3114 for (f = formal; f; f = f->next)
3116 if (f->actual == NULL && f->optional == 0)
3118 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3119 f->name, name, where);
3125 /* Using the formal argument list, string the actual argument list
3126 together in a way that corresponds with the formal list. */
3129 for (f = formal; f; f = f->next)
3131 if (f->actual && f->actual->label != NULL && f->ts.type)
3133 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3137 if (f->actual == NULL)
3139 a = gfc_get_actual_arglist ();
3140 a->missing_arg_type = f->ts.type;
3152 actual->next = NULL; /* End the sorted argument list. */
3158 /* Compare an actual argument list with an intrinsic's formal argument
3159 list. The lists are checked for agreement of type. We don't check
3160 for arrayness here. */
3163 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3166 gfc_actual_arglist *actual;
3167 gfc_intrinsic_arg *formal;
3170 formal = sym->formal;
3174 for (; formal; formal = formal->next, actual = actual->next, i++)
3178 if (actual->expr == NULL)
3183 /* A kind of 0 means we don't check for kind. */
3185 ts.kind = actual->expr->ts.kind;
3187 if (!gfc_compare_types (&ts, &actual->expr->ts))
3190 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3191 "be %s, not %s", gfc_current_intrinsic_arg[i],
3192 gfc_current_intrinsic, &actual->expr->where,
3193 gfc_typename (&formal->ts),
3194 gfc_typename (&actual->expr->ts));
3203 /* Given a pointer to an intrinsic symbol and an expression node that
3204 represent the function call to that subroutine, figure out the type
3205 of the result. This may involve calling a resolution subroutine. */
3208 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3210 gfc_expr *a1, *a2, *a3, *a4, *a5;
3211 gfc_actual_arglist *arg;
3213 if (specific->resolve.f1 == NULL)
3215 if (e->value.function.name == NULL)
3216 e->value.function.name = specific->lib_name;
3218 if (e->ts.type == BT_UNKNOWN)
3219 e->ts = specific->ts;
3223 arg = e->value.function.actual;
3225 /* Special case hacks for MIN and MAX. */
3226 if (specific->resolve.f1m == gfc_resolve_max
3227 || specific->resolve.f1m == gfc_resolve_min)
3229 (*specific->resolve.f1m) (e, arg);
3235 (*specific->resolve.f0) (e);
3244 (*specific->resolve.f1) (e, a1);
3253 (*specific->resolve.f2) (e, a1, a2);
3262 (*specific->resolve.f3) (e, a1, a2, a3);
3271 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3280 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3284 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3288 /* Given an intrinsic symbol node and an expression node, call the
3289 simplification function (if there is one), perhaps replacing the
3290 expression with something simpler. We return FAILURE on an error
3291 of the simplification, SUCCESS if the simplification worked, even
3292 if nothing has changed in the expression itself. */
3295 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3297 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3298 gfc_actual_arglist *arg;
3300 /* Max and min require special handling due to the variable number
3302 if (specific->simplify.f1 == gfc_simplify_min)
3304 result = gfc_simplify_min (e);
3308 if (specific->simplify.f1 == gfc_simplify_max)
3310 result = gfc_simplify_max (e);
3314 if (specific->simplify.f1 == NULL)
3320 arg = e->value.function.actual;
3324 result = (*specific->simplify.f0) ();
3331 if (specific->simplify.cc == gfc_convert_constant
3332 || specific->simplify.cc == gfc_convert_char_constant)
3334 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3338 /* TODO: Warn if -pedantic and initialization expression and arg
3339 types not integer or character */
3342 result = (*specific->simplify.f1) (a1);
3349 result = (*specific->simplify.f2) (a1, a2);
3356 result = (*specific->simplify.f3) (a1, a2, a3);
3363 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3370 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3373 ("do_simplify(): Too many args for intrinsic");
3380 if (result == &gfc_bad_expr)
3384 resolve_intrinsic (specific, e); /* Must call at run-time */
3387 result->where = e->where;
3388 gfc_replace_expr (e, result);
3395 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3396 error messages. This subroutine returns FAILURE if a subroutine
3397 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3398 list cannot match any intrinsic. */
3401 init_arglist (gfc_intrinsic_sym *isym)
3403 gfc_intrinsic_arg *formal;
3406 gfc_current_intrinsic = isym->name;
3409 for (formal = isym->formal; formal; formal = formal->next)
3411 if (i >= MAX_INTRINSIC_ARGS)
3412 gfc_internal_error ("init_arglist(): too many arguments");
3413 gfc_current_intrinsic_arg[i++] = formal->name;
3418 /* Given a pointer to an intrinsic symbol and an expression consisting
3419 of a function call, see if the function call is consistent with the
3420 intrinsic's formal argument list. Return SUCCESS if the expression
3421 and intrinsic match, FAILURE otherwise. */
3424 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3426 gfc_actual_arglist *arg, **ap;
3429 ap = &expr->value.function.actual;
3431 init_arglist (specific);
3433 /* Don't attempt to sort the argument list for min or max. */
3434 if (specific->check.f1m == gfc_check_min_max
3435 || specific->check.f1m == gfc_check_min_max_integer
3436 || specific->check.f1m == gfc_check_min_max_real
3437 || specific->check.f1m == gfc_check_min_max_double)
3438 return (*specific->check.f1m) (*ap);
3440 if (sort_actual (specific->name, ap, specific->formal,
3441 &expr->where) == FAILURE)
3444 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3445 /* This is special because we might have to reorder the argument list. */
3446 t = gfc_check_minloc_maxloc (*ap);
3447 else if (specific->check.f3red == gfc_check_minval_maxval)
3448 /* This is also special because we also might have to reorder the
3450 t = gfc_check_minval_maxval (*ap);
3451 else if (specific->check.f3red == gfc_check_product_sum)
3452 /* Same here. The difference to the previous case is that we allow a
3453 general numeric type. */
3454 t = gfc_check_product_sum (*ap);
3457 if (specific->check.f1 == NULL)
3459 t = check_arglist (ap, specific, error_flag);
3461 expr->ts = specific->ts;
3464 t = do_check (specific, *ap);
3467 /* Check conformance of elemental intrinsics. */
3468 if (t == SUCCESS && specific->elemental)
3471 gfc_expr *first_expr;
3472 arg = expr->value.function.actual;
3474 /* There is no elemental intrinsic without arguments. */
3475 gcc_assert(arg != NULL);
3476 first_expr = arg->expr;
3478 for ( ; arg && arg->expr; arg = arg->next, n++)
3481 snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3482 gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3483 gfc_current_intrinsic);
3484 if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3490 remove_nullargs (ap);
3496 /* Check whether an intrinsic belongs to whatever standard the user
3497 has chosen, taking also into account -fall-intrinsics. Here, no
3498 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3499 textual representation of the symbols standard status (like
3500 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3501 can be used to construct a detailed warning/error message in case of
3505 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3506 const char** symstd, bool silent, locus where)
3508 const char* symstd_msg;
3510 /* For -fall-intrinsics, just succeed. */
3511 if (gfc_option.flag_all_intrinsics)
3514 /* Find the symbol's standard message for later usage. */
3515 switch (isym->standard)
3518 symstd_msg = "available since Fortran 77";
3521 case GFC_STD_F95_OBS:
3522 symstd_msg = "obsolescent in Fortran 95";
3525 case GFC_STD_F95_DEL:
3526 symstd_msg = "deleted in Fortran 95";
3530 symstd_msg = "new in Fortran 95";
3534 symstd_msg = "new in Fortran 2003";
3538 symstd_msg = "new in Fortran 2008";
3542 symstd_msg = "a GNU Fortran extension";
3545 case GFC_STD_LEGACY:
3546 symstd_msg = "for backward compatibility";
3550 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3551 isym->name, isym->standard);
3554 /* If warning about the standard, warn and succeed. */
3555 if (gfc_option.warn_std & isym->standard)
3557 /* Do only print a warning if not a GNU extension. */
3558 if (!silent && isym->standard != GFC_STD_GNU)
3559 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3560 isym->name, _(symstd_msg), &where);
3565 /* If allowing the symbol's standard, succeed, too. */
3566 if (gfc_option.allow_std & isym->standard)
3569 /* Otherwise, fail. */
3571 *symstd = _(symstd_msg);
3576 /* See if a function call corresponds to an intrinsic function call.
3579 MATCH_YES if the call corresponds to an intrinsic, simplification
3580 is done if possible.
3582 MATCH_NO if the call does not correspond to an intrinsic
3584 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3585 error during the simplification process.
3587 The error_flag parameter enables an error reporting. */
3590 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3592 gfc_intrinsic_sym *isym, *specific;
3593 gfc_actual_arglist *actual;
3597 if (expr->value.function.isym != NULL)
3598 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3599 ? MATCH_ERROR : MATCH_YES;
3602 gfc_push_suppress_errors ();
3605 for (actual = expr->value.function.actual; actual; actual = actual->next)
3606 if (actual->expr != NULL)
3607 flag |= (actual->expr->ts.type != BT_INTEGER
3608 && actual->expr->ts.type != BT_CHARACTER);
3610 name = expr->symtree->n.sym->name;
3612 isym = specific = gfc_find_function (name);
3616 gfc_pop_suppress_errors ();
3620 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3621 || isym->id == GFC_ISYM_CMPLX)
3623 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3624 "as initialization expression at %L", name,
3625 &expr->where) == FAILURE)
3628 gfc_pop_suppress_errors ();
3632 gfc_current_intrinsic_where = &expr->where;
3634 /* Bypass the generic list for min and max. */
3635 if (isym->check.f1m == gfc_check_min_max)
3637 init_arglist (isym);
3639 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3643 gfc_pop_suppress_errors ();
3647 /* If the function is generic, check all of its specific
3648 incarnations. If the generic name is also a specific, we check
3649 that name last, so that any error message will correspond to the
3651 gfc_push_suppress_errors ();
3655 for (specific = isym->specific_head; specific;
3656 specific = specific->next)
3658 if (specific == isym)
3660 if (check_specific (specific, expr, 0) == SUCCESS)
3662 gfc_pop_suppress_errors ();
3668 gfc_pop_suppress_errors ();
3670 if (check_specific (isym, expr, error_flag) == FAILURE)
3673 gfc_pop_suppress_errors ();
3680 expr->value.function.isym = specific;
3681 gfc_intrinsic_symbol (expr->symtree->n.sym);
3684 gfc_pop_suppress_errors ();
3686 if (do_simplify (specific, expr) == FAILURE)
3689 /* F95, 7.1.6.1, Initialization expressions
3690 (4) An elemental intrinsic function reference of type integer or
3691 character where each argument is an initialization expression
3692 of type integer or character
3694 F2003, 7.1.7 Initialization expression
3695 (4) A reference to an elemental standard intrinsic function,
3696 where each argument is an initialization expression */
3698 if (gfc_init_expr && isym->elemental && flag
3699 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3700 "as initialization expression with non-integer/non-"
3701 "character arguments at %L", &expr->where) == FAILURE)
3708 /* See if a CALL statement corresponds to an intrinsic subroutine.
3709 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3710 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3714 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3716 gfc_intrinsic_sym *isym;
3719 name = c->symtree->n.sym->name;
3721 isym = gfc_find_subroutine (name);
3726 gfc_push_suppress_errors ();
3728 init_arglist (isym);
3730 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3733 if (isym->check.f1 != NULL)
3735 if (do_check (isym, c->ext.actual) == FAILURE)
3740 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3744 /* The subroutine corresponds to an intrinsic. Allow errors to be
3745 seen at this point. */
3747 gfc_pop_suppress_errors ();
3749 c->resolved_isym = isym;
3750 if (isym->resolve.s1 != NULL)
3751 isym->resolve.s1 (c);
3754 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3755 c->resolved_sym->attr.elemental = isym->elemental;
3758 if (gfc_pure (NULL) && !isym->elemental)
3760 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3765 c->resolved_sym->attr.noreturn = isym->noreturn;
3771 gfc_pop_suppress_errors ();
3776 /* Call gfc_convert_type() with warning enabled. */
3779 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3781 return gfc_convert_type_warn (expr, ts, eflag, 1);
3785 /* Try to convert an expression (in place) from one type to another.
3786 'eflag' controls the behavior on error.
3788 The possible values are:
3790 1 Generate a gfc_error()
3791 2 Generate a gfc_internal_error().
3793 'wflag' controls the warning related to conversion. */
3796 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3798 gfc_intrinsic_sym *sym;
3799 gfc_typespec from_ts;
3805 from_ts = expr->ts; /* expr->ts gets clobbered */
3807 if (ts->type == BT_UNKNOWN)
3810 /* NULL and zero size arrays get their type here. */
3811 if (expr->expr_type == EXPR_NULL
3812 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3814 /* Sometimes the RHS acquire the type. */
3819 if (expr->ts.type == BT_UNKNOWN)
3822 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3823 && gfc_compare_types (&expr->ts, ts))
3826 sym = find_conv (&expr->ts, ts);
3830 /* At this point, a conversion is necessary. A warning may be needed. */
3831 if ((gfc_option.warn_std & sym->standard) != 0)
3832 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3833 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3834 else if (wflag && gfc_option.warn_conversion)
3835 gfc_warning_now ("Conversion from %s to %s at %L",
3836 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3838 /* Insert a pre-resolved function call to the right function. */
3839 old_where = expr->where;
3841 shape = expr->shape;
3843 new_expr = gfc_get_expr ();
3846 new_expr = gfc_build_conversion (new_expr);
3847 new_expr->value.function.name = sym->lib_name;
3848 new_expr->value.function.isym = sym;
3849 new_expr->where = old_where;
3850 new_expr->rank = rank;
3851 new_expr->shape = gfc_copy_shape (shape, rank);
3853 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3854 new_expr->symtree->n.sym->ts = *ts;
3855 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3856 new_expr->symtree->n.sym->attr.function = 1;
3857 new_expr->symtree->n.sym->attr.elemental = 1;
3858 new_expr->symtree->n.sym->attr.pure = 1;
3859 new_expr->symtree->n.sym->attr.referenced = 1;
3860 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
3861 gfc_commit_symbol (new_expr->symtree->n.sym);
3865 gfc_free (new_expr);
3868 if (gfc_is_constant_expr (expr->value.function.actual->expr)
3869 && do_simplify (sym, expr) == FAILURE)
3874 return FAILURE; /* Error already generated in do_simplify() */
3882 gfc_error ("Can't convert %s to %s at %L",
3883 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3887 gfc_internal_error ("Can't convert %s to %s at %L",
3888 gfc_typename (&from_ts), gfc_typename (ts),
3895 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
3897 gfc_intrinsic_sym *sym;
3898 gfc_typespec from_ts;
3904 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
3905 from_ts = expr->ts; /* expr->ts gets clobbered */
3907 sym = find_char_conv (&expr->ts, ts);
3910 /* Insert a pre-resolved function call to the right function. */
3911 old_where = expr->where;
3913 shape = expr->shape;
3915 new_expr = gfc_get_expr ();
3918 new_expr = gfc_build_conversion (new_expr);
3919 new_expr->value.function.name = sym->lib_name;
3920 new_expr->value.function.isym = sym;
3921 new_expr->where = old_where;
3922 new_expr->rank = rank;
3923 new_expr->shape = gfc_copy_shape (shape, rank);
3925 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3926 new_expr->symtree->n.sym->ts = *ts;
3927 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3928 new_expr->symtree->n.sym->attr.function = 1;
3929 new_expr->symtree->n.sym->attr.elemental = 1;
3930 new_expr->symtree->n.sym->attr.referenced = 1;
3931 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
3932 gfc_commit_symbol (new_expr->symtree->n.sym);
3936 gfc_free (new_expr);
3939 if (gfc_is_constant_expr (expr->value.function.actual->expr)
3940 && do_simplify (sym, expr) == FAILURE)
3942 /* Error already generated in do_simplify() */
3950 /* Check if the passed name is name of an intrinsic (taking into account the
3951 current -std=* and -fall-intrinsic settings). If it is, see if we should
3952 warn about this as a user-procedure having the same name as an intrinsic
3953 (-Wintrinsic-shadow enabled) and do so if we should. */
3956 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
3958 gfc_intrinsic_sym* isym;
3960 /* If the warning is disabled, do nothing at all. */
3961 if (!gfc_option.warn_intrinsic_shadow)
3964 /* Try to find an intrinsic of the same name. */
3966 isym = gfc_find_function (sym->name);
3968 isym = gfc_find_subroutine (sym->name);
3970 /* If no intrinsic was found with this name or it's not included in the
3971 selected standard, everything's fine. */
3972 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
3973 sym->declared_at) == FAILURE)
3976 /* Emit the warning. */
3978 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
3979 " name. In order to call the intrinsic, explicit INTRINSIC"
3980 " declarations may be required.",
3981 sym->name, &sym->declared_at);
3983 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
3984 " only be called via an explicit interface or if declared"
3985 " EXTERNAL.", sym->name, &sym->declared_at);