1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
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_arg *next_arg;
44 static int nfunc, nsub, nargs, nconv;
47 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
51 { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
60 /* Return a letter based on the passed type. Used to construct the
61 name of a type-dependent subroutine. */
64 gfc_type_letter (bt type)
99 /* Get a symbol for a resolved name. */
102 gfc_get_intrinsic_sub_symbol (const char *name)
106 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
107 sym->attr.always_explicit = 1;
108 sym->attr.subroutine = 1;
109 sym->attr.flavor = FL_PROCEDURE;
110 sym->attr.proc = PROC_INTRINSIC;
116 /* Return a pointer to the name of a conversion function given two
120 conv_name (gfc_typespec *from, gfc_typespec *to)
122 return gfc_get_string ("__convert_%c%d_%c%d",
123 gfc_type_letter (from->type), from->kind,
124 gfc_type_letter (to->type), to->kind);
128 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
129 corresponds to the conversion. Returns NULL if the conversion
132 static gfc_intrinsic_sym *
133 find_conv (gfc_typespec *from, gfc_typespec *to)
135 gfc_intrinsic_sym *sym;
139 target = conv_name (from, to);
142 for (i = 0; i < nconv; i++, sym++)
143 if (target == sym->name)
150 /* Interface to the check functions. We break apart an argument list
151 and call the proper check function rather than forcing each
152 function to manipulate the argument list. */
155 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
157 gfc_expr *a1, *a2, *a3, *a4, *a5;
160 return (*specific->check.f0) ();
165 return (*specific->check.f1) (a1);
170 return (*specific->check.f2) (a1, a2);
175 return (*specific->check.f3) (a1, a2, a3);
180 return (*specific->check.f4) (a1, a2, a3, a4);
185 return (*specific->check.f5) (a1, a2, a3, a4, a5);
187 gfc_internal_error ("do_check(): too many args");
191 /*********** Subroutines to build the intrinsic list ****************/
193 /* Add a single intrinsic symbol to the current list.
196 char * name of function
197 int whether function is elemental
198 int If the function can be used as an actual argument [1]
199 bt return type of function
200 int kind of return type of function
201 int Fortran standard version
202 check pointer to check function
203 simplify pointer to simplification function
204 resolve pointer to resolution function
206 Optional arguments come in multiples of four:
207 char * name of argument
210 int arg optional flag (1=optional, 0=required)
212 The sequence is terminated by a NULL name.
215 [1] Whether a function can or cannot be used as an actual argument is
216 determined by its presence on the 13.6 list in Fortran 2003. The
217 following intrinsics, which are GNU extensions, are considered allowed
218 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
219 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
222 add_sym (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type, int kind,
223 int standard, gfc_check_f check, gfc_simplify_f simplify,
224 gfc_resolve_f resolve, ...)
226 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
227 int optional, first_flag;
241 next_sym->name = gfc_get_string (name);
243 strcpy (buf, "_gfortran_");
245 next_sym->lib_name = gfc_get_string (buf);
247 next_sym->elemental = (cl == CLASS_ELEMENTAL);
248 next_sym->inquiry = (cl == CLASS_INQUIRY);
249 next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
250 next_sym->actual_ok = actual_ok;
251 next_sym->ts.type = type;
252 next_sym->ts.kind = kind;
253 next_sym->standard = standard;
254 next_sym->simplify = simplify;
255 next_sym->check = check;
256 next_sym->resolve = resolve;
257 next_sym->specific = 0;
258 next_sym->generic = 0;
259 next_sym->conversion = 0;
264 gfc_internal_error ("add_sym(): Bad sizing mode");
267 va_start (argp, resolve);
273 name = va_arg (argp, char *);
277 type = (bt) va_arg (argp, int);
278 kind = va_arg (argp, int);
279 optional = va_arg (argp, int);
281 if (sizing != SZ_NOTHING)
288 next_sym->formal = next_arg;
290 (next_arg - 1)->next = next_arg;
294 strcpy (next_arg->name, name);
295 next_arg->ts.type = type;
296 next_arg->ts.kind = kind;
297 next_arg->optional = optional;
307 /* Add a symbol to the function list where the function takes
311 add_sym_0 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
312 int kind, int standard,
314 gfc_expr *(*simplify) (void),
315 void (*resolve) (gfc_expr *))
325 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
330 /* Add a symbol to the subroutine list where the subroutine takes
334 add_sym_0s (const char *name, gfc_isym_id id, int standard, void (*resolve) (gfc_code *))
344 add_sym (name, id, NO_CLASS, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
349 /* Add a symbol to the function list where the function takes
353 add_sym_1 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
354 int kind, int standard,
355 try (*check) (gfc_expr *),
356 gfc_expr *(*simplify) (gfc_expr *),
357 void (*resolve) (gfc_expr *, gfc_expr *),
358 const char *a1, bt type1, int kind1, int optional1)
368 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
369 a1, type1, kind1, optional1,
374 /* Add a symbol to the subroutine list where the subroutine takes
378 add_sym_1s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard,
379 try (*check) (gfc_expr *),
380 gfc_expr *(*simplify) (gfc_expr *),
381 void (*resolve) (gfc_code *),
382 const char *a1, bt type1, int kind1, int optional1)
392 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
393 a1, type1, kind1, optional1,
398 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
399 function. MAX et al take 2 or more arguments. */
402 add_sym_1m (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
403 int kind, int standard,
404 try (*check) (gfc_actual_arglist *),
405 gfc_expr *(*simplify) (gfc_expr *),
406 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
407 const char *a1, bt type1, int kind1, int optional1,
408 const char *a2, bt type2, int kind2, int optional2)
418 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
419 a1, type1, kind1, optional1,
420 a2, type2, kind2, optional2,
425 /* Add a symbol to the function list where the function takes
429 add_sym_2 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
430 int kind, int standard,
431 try (*check) (gfc_expr *, gfc_expr *),
432 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
433 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
434 const char *a1, bt type1, int kind1, int optional1,
435 const char *a2, bt type2, int kind2, int optional2)
445 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
446 a1, type1, kind1, optional1,
447 a2, type2, kind2, optional2,
452 /* Add a symbol to the subroutine list where the subroutine takes
456 add_sym_2s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard,
457 try (*check) (gfc_expr *, gfc_expr *),
458 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
459 void (*resolve) (gfc_code *),
460 const char *a1, bt type1, int kind1, int optional1,
461 const char *a2, bt type2, int kind2, int optional2)
471 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
472 a1, type1, kind1, optional1,
473 a2, type2, kind2, optional2,
478 /* Add a symbol to the function list where the function takes
482 add_sym_3 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
483 int kind, int standard,
484 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
485 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
486 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
487 const char *a1, bt type1, int kind1, int optional1,
488 const char *a2, bt type2, int kind2, int optional2,
489 const char *a3, bt type3, int kind3, int optional3)
499 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
500 a1, type1, kind1, optional1,
501 a2, type2, kind2, optional2,
502 a3, type3, kind3, optional3,
507 /* MINLOC and MAXLOC get special treatment because their argument
508 might have to be reordered. */
511 add_sym_3ml (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
512 int kind, int standard,
513 try (*check) (gfc_actual_arglist *),
514 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
515 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
516 const char *a1, bt type1, int kind1, int optional1,
517 const char *a2, bt type2, int kind2, int optional2,
518 const char *a3, bt type3, int kind3, int optional3)
528 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
529 a1, type1, kind1, optional1,
530 a2, type2, kind2, optional2,
531 a3, type3, kind3, optional3,
536 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
537 their argument also might have to be reordered. */
540 add_sym_3red (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
541 int kind, int standard,
542 try (*check) (gfc_actual_arglist *),
543 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
544 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
545 const char *a1, bt type1, int kind1, int optional1,
546 const char *a2, bt type2, int kind2, int optional2,
547 const char *a3, bt type3, int kind3, int optional3)
557 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
558 a1, type1, kind1, optional1,
559 a2, type2, kind2, optional2,
560 a3, type3, kind3, optional3,
565 /* Add a symbol to the subroutine list where the subroutine takes
569 add_sym_3s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard,
570 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
571 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
572 void (*resolve) (gfc_code *),
573 const char *a1, bt type1, int kind1, int optional1,
574 const char *a2, bt type2, int kind2, int optional2,
575 const char *a3, bt type3, int kind3, int optional3)
585 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
586 a1, type1, kind1, optional1,
587 a2, type2, kind2, optional2,
588 a3, type3, kind3, optional3,
593 /* Add a symbol to the function list where the function takes
597 add_sym_4 (const char *name, gfc_isym_id id, enum class cl, int actual_ok, bt type,
598 int kind, int standard,
599 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
600 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
602 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
604 const char *a1, bt type1, int kind1, int optional1,
605 const char *a2, bt type2, int kind2, int optional2,
606 const char *a3, bt type3, int kind3, int optional3,
607 const char *a4, bt type4, int kind4, int optional4 )
617 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
618 a1, type1, kind1, optional1,
619 a2, type2, kind2, optional2,
620 a3, type3, kind3, optional3,
621 a4, type4, kind4, optional4,
626 /* Add a symbol to the subroutine list where the subroutine takes
630 add_sym_4s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard,
631 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
632 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
634 void (*resolve) (gfc_code *),
635 const char *a1, bt type1, int kind1, int optional1,
636 const char *a2, bt type2, int kind2, int optional2,
637 const char *a3, bt type3, int kind3, int optional3,
638 const char *a4, bt type4, int kind4, int optional4)
648 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
649 a1, type1, kind1, optional1,
650 a2, type2, kind2, optional2,
651 a3, type3, kind3, optional3,
652 a4, type4, kind4, optional4,
657 /* Add a symbol to the subroutine list where the subroutine takes
661 add_sym_5s (const char *name, gfc_isym_id id, enum class cl, bt type, int kind, int standard,
662 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
664 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
665 gfc_expr *, gfc_expr *),
666 void (*resolve) (gfc_code *),
667 const char *a1, bt type1, int kind1, int optional1,
668 const char *a2, bt type2, int kind2, int optional2,
669 const char *a3, bt type3, int kind3, int optional3,
670 const char *a4, bt type4, int kind4, int optional4,
671 const char *a5, bt type5, int kind5, int optional5)
681 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
682 a1, type1, kind1, optional1,
683 a2, type2, kind2, optional2,
684 a3, type3, kind3, optional3,
685 a4, type4, kind4, optional4,
686 a5, type5, kind5, optional5,
691 /* Locate an intrinsic symbol given a base pointer, number of elements
692 in the table and a pointer to a name. Returns the NULL pointer if
693 a name is not found. */
695 static gfc_intrinsic_sym *
696 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
698 /* name may be a user-supplied string, so we must first make sure
699 that we're comparing against a pointer into the global string
701 const char *p = gfc_get_string (name);
705 if (p == start->name)
716 /* Given a name, find a function in the intrinsic function table.
717 Returns NULL if not found. */
720 gfc_find_function (const char *name)
722 gfc_intrinsic_sym *sym;
724 sym = find_sym (functions, nfunc, name);
726 sym = find_sym (conversion, nconv, name);
732 /* Given a name, find a function in the intrinsic subroutine table.
733 Returns NULL if not found. */
736 gfc_find_subroutine (const char *name)
738 return find_sym (subroutines, nsub, name);
742 /* Given a string, figure out if it is the name of a generic intrinsic
746 gfc_generic_intrinsic (const char *name)
748 gfc_intrinsic_sym *sym;
750 sym = gfc_find_function (name);
751 return (sym == NULL) ? 0 : sym->generic;
755 /* Given a string, figure out if it is the name of a specific
756 intrinsic function or not. */
759 gfc_specific_intrinsic (const char *name)
761 gfc_intrinsic_sym *sym;
763 sym = gfc_find_function (name);
764 return (sym == NULL) ? 0 : sym->specific;
768 /* Given a string, figure out if it is the name of an intrinsic function
769 or subroutine allowed as an actual argument or not. */
771 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
773 gfc_intrinsic_sym *sym;
775 /* Intrinsic subroutines are not allowed as actual arguments. */
780 sym = gfc_find_function (name);
781 return (sym == NULL) ? 0 : sym->actual_ok;
786 /* Given a string, figure out if it is the name of an intrinsic
787 subroutine or function. There are no generic intrinsic
788 subroutines, they are all specific. */
791 gfc_intrinsic_name (const char *name, int subroutine_flag)
793 return subroutine_flag ? gfc_find_subroutine (name) != NULL
794 : gfc_find_function (name) != NULL;
798 /* Collect a set of intrinsic functions into a generic collection.
799 The first argument is the name of the generic function, which is
800 also the name of a specific function. The rest of the specifics
801 currently in the table are placed into the list of specific
802 functions associated with that generic.
805 FIXME: Remove the argument STANDARD if no regressions are
806 encountered. Change all callers (approx. 360).
810 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
812 gfc_intrinsic_sym *g;
814 if (sizing != SZ_NOTHING)
817 g = gfc_find_function (name);
819 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
822 gcc_assert (g->id == id);
826 if ((g + 1)->name != NULL)
827 g->specific_head = g + 1;
830 while (g->name != NULL)
832 gcc_assert (g->id == id);
844 /* Create a duplicate intrinsic function entry for the current
845 function, the only differences being the alternate name and
846 a different standard if necessary. Note that we use argument
847 lists more than once, but all argument lists are freed as a
851 make_alias (const char *name, int standard)
864 next_sym[0] = next_sym[-1];
865 next_sym->name = gfc_get_string (name);
866 next_sym->standard = standard;
876 /* Make the current subroutine noreturn. */
881 if (sizing == SZ_NOTHING)
882 next_sym[-1].noreturn = 1;
886 /* Add intrinsic functions. */
891 /* Argument names as in the standard (to be used as argument keywords). */
893 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
894 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
895 *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
896 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
897 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
898 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
899 *p = "p", *ar = "array", *shp = "shape", *src = "source",
900 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
901 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
902 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
903 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
904 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
905 *num = "number", *tm = "time", *nm = "name", *md = "mode";
907 int di, dr, dd, dl, dc, dz, ii;
909 di = gfc_default_integer_kind;
910 dr = gfc_default_real_kind;
911 dd = gfc_default_double_kind;
912 dl = gfc_default_logical_kind;
913 dc = gfc_default_character_kind;
914 dz = gfc_default_complex_kind;
915 ii = gfc_index_integer_kind;
917 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
918 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
919 a, BT_REAL, dr, REQUIRED);
921 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
922 NULL, gfc_simplify_abs, gfc_resolve_abs,
923 a, BT_INTEGER, di, REQUIRED);
925 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
926 NULL, gfc_simplify_abs, gfc_resolve_abs,
927 a, BT_REAL, dd, REQUIRED);
929 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
930 NULL, gfc_simplify_abs, gfc_resolve_abs,
931 a, BT_COMPLEX, dz, REQUIRED);
933 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
934 NULL, gfc_simplify_abs, gfc_resolve_abs,
935 a, BT_COMPLEX, dd, REQUIRED);
937 make_alias ("cdabs", GFC_STD_GNU);
939 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
941 /* The checking function for ACCESS is called gfc_check_access_func
942 because the name gfc_check_access is already used in module.c. */
943 add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
944 gfc_check_access_func, NULL, gfc_resolve_access,
945 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
947 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
949 add_sym_1 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
950 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
951 i, BT_INTEGER, di, REQUIRED);
953 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
955 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
956 gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
957 x, BT_REAL, dr, REQUIRED);
959 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
960 NULL, gfc_simplify_acos, gfc_resolve_acos,
961 x, BT_REAL, dd, REQUIRED);
963 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
965 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
966 gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh,
967 x, BT_REAL, dr, REQUIRED);
969 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
970 NULL, gfc_simplify_acosh, gfc_resolve_acosh,
971 x, BT_REAL, dd, REQUIRED);
973 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU);
975 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
976 NULL, gfc_simplify_adjustl, NULL,
977 stg, BT_CHARACTER, dc, REQUIRED);
979 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
981 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
982 NULL, gfc_simplify_adjustr, NULL,
983 stg, BT_CHARACTER, dc, REQUIRED);
985 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
987 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
988 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
989 z, BT_COMPLEX, dz, REQUIRED);
991 make_alias ("imag", GFC_STD_GNU);
992 make_alias ("imagpart", GFC_STD_GNU);
994 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
995 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
996 z, BT_COMPLEX, dd, REQUIRED);
998 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1000 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1001 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1002 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1004 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1005 NULL, gfc_simplify_dint, gfc_resolve_dint,
1006 a, BT_REAL, dd, REQUIRED);
1008 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1010 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1011 gfc_check_all_any, NULL, gfc_resolve_all,
1012 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1014 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1016 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1017 gfc_check_allocated, NULL, NULL,
1018 ar, BT_UNKNOWN, 0, REQUIRED);
1020 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1022 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1023 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1024 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1026 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1027 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1028 a, BT_REAL, dd, REQUIRED);
1030 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1032 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1033 gfc_check_all_any, NULL, gfc_resolve_any,
1034 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1036 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1038 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1039 gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
1040 x, BT_REAL, dr, REQUIRED);
1042 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1043 NULL, gfc_simplify_asin, gfc_resolve_asin,
1044 x, BT_REAL, dd, REQUIRED);
1046 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1048 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
1049 gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh,
1050 x, BT_REAL, dr, REQUIRED);
1052 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1053 NULL, gfc_simplify_asinh, gfc_resolve_asinh,
1054 x, BT_REAL, dd, REQUIRED);
1056 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU);
1058 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1059 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1060 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1062 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1064 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1065 gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
1066 x, BT_REAL, dr, REQUIRED);
1068 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1069 NULL, gfc_simplify_atan, gfc_resolve_atan,
1070 x, BT_REAL, dd, REQUIRED);
1072 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1074 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
1075 gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh,
1076 x, BT_REAL, dr, REQUIRED);
1078 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1079 NULL, gfc_simplify_atanh, gfc_resolve_atanh,
1080 x, BT_REAL, dd, REQUIRED);
1082 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU);
1084 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1085 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1086 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1088 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1089 NULL, gfc_simplify_atan2, gfc_resolve_atan2,
1090 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1092 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1094 /* Bessel and Neumann functions for G77 compatibility. */
1095 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1096 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1097 x, BT_REAL, dr, REQUIRED);
1099 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1100 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1101 x, BT_REAL, dd, REQUIRED);
1103 make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
1105 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1106 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1107 x, BT_REAL, dr, REQUIRED);
1109 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1110 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1111 x, BT_REAL, dd, REQUIRED);
1113 make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
1115 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1116 gfc_check_besn, NULL, gfc_resolve_besn,
1117 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1119 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1120 gfc_check_besn, NULL, gfc_resolve_besn,
1121 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1123 make_generic ("besjn", GFC_ISYM_JN, GFC_STD_GNU);
1125 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1126 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1127 x, BT_REAL, dr, REQUIRED);
1129 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1130 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1131 x, BT_REAL, dd, REQUIRED);
1133 make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
1135 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1136 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1137 x, BT_REAL, dr, REQUIRED);
1139 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1140 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1141 x, BT_REAL, dd, REQUIRED);
1143 make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
1145 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1146 gfc_check_besn, NULL, gfc_resolve_besn,
1147 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1149 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1150 gfc_check_besn, NULL, gfc_resolve_besn,
1151 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1153 make_generic ("besyn", GFC_ISYM_YN, GFC_STD_GNU);
1155 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1156 gfc_check_i, gfc_simplify_bit_size, NULL,
1157 i, BT_INTEGER, di, REQUIRED);
1159 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1161 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1162 gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1163 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1165 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1167 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1168 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1169 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1171 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1173 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1174 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1175 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1177 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1179 add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1180 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1181 nm, BT_CHARACTER, dc, REQUIRED);
1183 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1185 add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1186 gfc_check_chmod, NULL, gfc_resolve_chmod,
1187 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1189 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1191 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1192 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1193 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1194 kind, BT_INTEGER, di, OPTIONAL);
1196 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1198 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1199 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1201 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1204 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1205 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1206 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1208 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1210 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1211 complex instead of the default complex. */
1213 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1214 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1215 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1217 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1219 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1220 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1221 z, BT_COMPLEX, dz, REQUIRED);
1223 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1224 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1225 z, BT_COMPLEX, dd, REQUIRED);
1227 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1229 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1230 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1231 x, BT_REAL, dr, REQUIRED);
1233 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1234 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1235 x, BT_REAL, dd, REQUIRED);
1237 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1238 NULL, gfc_simplify_cos, gfc_resolve_cos,
1239 x, BT_COMPLEX, dz, REQUIRED);
1241 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1242 NULL, gfc_simplify_cos, gfc_resolve_cos,
1243 x, BT_COMPLEX, dd, REQUIRED);
1245 make_alias ("cdcos", GFC_STD_GNU);
1247 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1249 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1250 gfc_check_fn_r, gfc_simplify_cosh, gfc_resolve_cosh,
1251 x, BT_REAL, dr, REQUIRED);
1253 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1254 NULL, gfc_simplify_cosh, gfc_resolve_cosh,
1255 x, BT_REAL, dd, REQUIRED);
1257 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1259 add_sym_2 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1260 gfc_check_count, NULL, gfc_resolve_count,
1261 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1263 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1265 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1266 gfc_check_cshift, NULL, gfc_resolve_cshift,
1267 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1268 dm, BT_INTEGER, ii, OPTIONAL);
1270 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1272 add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1273 gfc_check_ctime, NULL, gfc_resolve_ctime,
1274 tm, BT_INTEGER, di, REQUIRED);
1276 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1278 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1279 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1280 a, BT_REAL, dr, REQUIRED);
1282 make_alias ("dfloat", GFC_STD_GNU);
1284 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1286 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1287 gfc_check_digits, gfc_simplify_digits, NULL,
1288 x, BT_UNKNOWN, dr, REQUIRED);
1290 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1292 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1293 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1294 x, BT_REAL, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1296 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1297 NULL, gfc_simplify_dim, gfc_resolve_dim,
1298 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1300 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1301 NULL, gfc_simplify_dim, gfc_resolve_dim,
1302 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1304 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1306 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1307 GFC_STD_F95, gfc_check_dot_product, NULL, gfc_resolve_dot_product,
1308 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1310 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1312 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1313 NULL, gfc_simplify_dprod, gfc_resolve_dprod,
1314 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1316 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1318 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1320 a, BT_COMPLEX, dd, REQUIRED);
1322 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1324 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1325 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1326 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1327 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1329 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1331 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1332 gfc_check_x, gfc_simplify_epsilon, NULL,
1333 x, BT_REAL, dr, REQUIRED);
1335 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1337 /* G77 compatibility for the ERF() and ERFC() functions. */
1338 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1339 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1340 x, BT_REAL, dr, REQUIRED);
1342 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1343 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1344 x, BT_REAL, dd, REQUIRED);
1346 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
1348 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1349 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1350 x, BT_REAL, dr, REQUIRED);
1352 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1353 gfc_check_fn_r, NULL, gfc_resolve_g77_math1,
1354 x, BT_REAL, dd, REQUIRED);
1356 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
1358 /* G77 compatibility */
1359 add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1360 gfc_check_etime, NULL, NULL,
1361 x, BT_REAL, 4, REQUIRED);
1363 make_alias ("dtime", GFC_STD_GNU);
1365 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1367 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1368 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1369 x, BT_REAL, dr, REQUIRED);
1371 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1372 NULL, gfc_simplify_exp, gfc_resolve_exp,
1373 x, BT_REAL, dd, REQUIRED);
1375 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1376 NULL, gfc_simplify_exp, gfc_resolve_exp,
1377 x, BT_COMPLEX, dz, REQUIRED);
1379 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1380 NULL, gfc_simplify_exp, gfc_resolve_exp,
1381 x, BT_COMPLEX, dd, REQUIRED);
1383 make_alias ("cdexp", GFC_STD_GNU);
1385 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1387 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1388 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1389 x, BT_REAL, dr, REQUIRED);
1391 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1393 add_sym_0 ("fdate", GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1394 NULL, NULL, gfc_resolve_fdate);
1396 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1398 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1399 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1400 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1402 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1404 /* G77 compatible fnum */
1405 add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1406 gfc_check_fnum, NULL, gfc_resolve_fnum,
1407 ut, BT_INTEGER, di, REQUIRED);
1409 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1411 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1412 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1413 x, BT_REAL, dr, REQUIRED);
1415 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1417 add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1418 gfc_check_fstat, NULL, gfc_resolve_fstat,
1419 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1421 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1423 add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1424 gfc_check_ftell, NULL, gfc_resolve_ftell,
1425 ut, BT_INTEGER, di, REQUIRED);
1427 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1429 add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1430 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1431 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1433 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1435 add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1436 gfc_check_fgetput, NULL, gfc_resolve_fget,
1437 c, BT_CHARACTER, dc, REQUIRED);
1439 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1441 add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1442 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1443 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1445 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1447 add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1448 gfc_check_fgetput, NULL, gfc_resolve_fput,
1449 c, BT_CHARACTER, dc, REQUIRED);
1451 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1453 /* Unix IDs (g77 compatibility) */
1454 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1455 NULL, NULL, gfc_resolve_getcwd,
1456 c, BT_CHARACTER, dc, REQUIRED);
1458 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1460 add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1461 NULL, NULL, gfc_resolve_getgid);
1463 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1465 add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1466 NULL, NULL, gfc_resolve_getpid);
1468 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1470 add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1471 NULL, NULL, gfc_resolve_getuid);
1473 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1475 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1476 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1477 a, BT_CHARACTER, dc, REQUIRED);
1479 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1481 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1482 gfc_check_huge, gfc_simplify_huge, NULL,
1483 x, BT_UNKNOWN, dr, REQUIRED);
1485 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1487 add_sym_1 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1488 gfc_check_ichar_iachar, gfc_simplify_iachar, NULL,
1489 c, BT_CHARACTER, dc, REQUIRED);
1491 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1493 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1494 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1495 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1497 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1499 add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1500 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1501 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1503 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1505 add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1508 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1510 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1511 gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1512 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1514 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1516 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1517 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1518 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1519 ln, BT_INTEGER, di, REQUIRED);
1521 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1523 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1524 gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1525 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1527 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1529 add_sym_1 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1530 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1531 c, BT_CHARACTER, dc, REQUIRED);
1533 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1535 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1536 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1537 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1539 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1541 add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1542 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1543 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1545 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1547 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1548 NULL, NULL, gfc_resolve_ierrno);
1550 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1552 /* The resolution function for INDEX is called gfc_resolve_index_func
1553 because the name gfc_resolve_index is already used in resolve.c. */
1554 add_sym_3 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1555 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1556 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1557 bck, BT_LOGICAL, dl, OPTIONAL);
1559 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1561 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1562 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1563 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1565 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1566 NULL, gfc_simplify_ifix, NULL,
1567 a, BT_REAL, dr, REQUIRED);
1569 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1570 NULL, gfc_simplify_idint, NULL,
1571 a, BT_REAL, dd, REQUIRED);
1573 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1575 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1576 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1577 a, BT_REAL, dr, REQUIRED);
1579 make_alias ("short", GFC_STD_GNU);
1581 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1583 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1584 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1585 a, BT_REAL, dr, REQUIRED);
1587 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1589 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1590 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1591 a, BT_REAL, dr, REQUIRED);
1593 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1595 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1596 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1597 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1599 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1601 add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1602 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1603 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1605 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1607 /* The following function is for G77 compatibility. */
1608 add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1609 gfc_check_irand, NULL, NULL,
1610 i, BT_INTEGER, 4, OPTIONAL);
1612 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1614 add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1615 gfc_check_isatty, NULL, gfc_resolve_isatty,
1616 ut, BT_INTEGER, di, REQUIRED);
1618 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1620 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL,
1621 dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL,
1622 x, BT_REAL, 0, REQUIRED);
1624 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1626 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1627 gfc_check_ishft, NULL, gfc_resolve_rshift,
1628 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1630 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1632 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1633 gfc_check_ishft, NULL, gfc_resolve_lshift,
1634 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1636 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1638 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1639 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1640 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1642 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1644 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1645 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1646 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1647 sz, BT_INTEGER, di, OPTIONAL);
1649 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1651 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1652 gfc_check_kill, NULL, gfc_resolve_kill,
1653 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1655 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1657 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1658 gfc_check_kind, gfc_simplify_kind, NULL,
1659 x, BT_REAL, dr, REQUIRED);
1661 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1663 add_sym_2 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1664 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1665 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL);
1667 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1669 add_sym_1 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1670 NULL, gfc_simplify_len, gfc_resolve_len,
1671 stg, BT_CHARACTER, dc, REQUIRED);
1673 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1675 add_sym_1 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1676 NULL, gfc_simplify_len_trim, gfc_resolve_len_trim,
1677 stg, BT_CHARACTER, dc, REQUIRED);
1679 make_alias ("lnblnk", GFC_STD_GNU);
1681 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1683 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1684 NULL, gfc_simplify_lge, NULL,
1685 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1687 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1689 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1690 NULL, gfc_simplify_lgt, NULL,
1691 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1693 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1695 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1696 NULL, gfc_simplify_lle, NULL,
1697 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1699 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1701 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1702 NULL, gfc_simplify_llt, NULL,
1703 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1705 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1707 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1708 gfc_check_link, NULL, gfc_resolve_link,
1709 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
1711 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1713 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1714 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1715 x, BT_REAL, dr, REQUIRED);
1717 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1718 NULL, gfc_simplify_log, gfc_resolve_log,
1719 x, BT_REAL, dr, REQUIRED);
1721 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1722 NULL, gfc_simplify_log, gfc_resolve_log,
1723 x, BT_REAL, dd, REQUIRED);
1725 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1726 NULL, gfc_simplify_log, gfc_resolve_log,
1727 x, BT_COMPLEX, dz, REQUIRED);
1729 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1730 NULL, gfc_simplify_log, gfc_resolve_log,
1731 x, BT_COMPLEX, dd, REQUIRED);
1733 make_alias ("cdlog", GFC_STD_GNU);
1735 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
1737 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1738 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1739 x, BT_REAL, dr, REQUIRED);
1741 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1742 NULL, gfc_simplify_log10, gfc_resolve_log10,
1743 x, BT_REAL, dr, REQUIRED);
1745 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1746 NULL, gfc_simplify_log10, gfc_resolve_log10,
1747 x, BT_REAL, dd, REQUIRED);
1749 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
1751 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1752 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1753 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1755 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
1757 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1758 gfc_check_stat, NULL, gfc_resolve_lstat,
1759 a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1761 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
1763 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1764 gfc_check_malloc, NULL, gfc_resolve_malloc, a, BT_INTEGER, di,
1767 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
1769 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1770 gfc_check_matmul, NULL, gfc_resolve_matmul,
1771 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
1773 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
1775 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
1776 int(max). The max function must take at least two arguments. */
1778 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1779 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1780 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
1782 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1783 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1784 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1786 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1787 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1788 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1790 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1791 gfc_check_min_max_real, gfc_simplify_max, NULL,
1792 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1794 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1795 gfc_check_min_max_real, gfc_simplify_max, NULL,
1796 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1798 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1799 gfc_check_min_max_double, gfc_simplify_max, NULL,
1800 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1802 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
1804 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
1805 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
1806 x, BT_UNKNOWN, dr, REQUIRED);
1808 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
1810 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1811 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1812 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1813 msk, BT_LOGICAL, dl, OPTIONAL);
1815 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
1817 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1818 gfc_check_minval_maxval, NULL, gfc_resolve_maxval,
1819 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1820 msk, BT_LOGICAL, dl, OPTIONAL);
1822 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
1824 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1825 NULL, NULL, gfc_resolve_mclock);
1827 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
1829 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1830 NULL, NULL, gfc_resolve_mclock8);
1832 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
1834 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1835 gfc_check_merge, NULL, gfc_resolve_merge,
1836 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
1837 msk, BT_LOGICAL, dl, REQUIRED);
1839 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
1841 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
1844 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1845 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
1846 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1848 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1849 gfc_check_min_max_integer, gfc_simplify_min, NULL,
1850 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1852 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1853 gfc_check_min_max_integer, gfc_simplify_min, NULL,
1854 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1856 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1857 gfc_check_min_max_real, gfc_simplify_min, NULL,
1858 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1860 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1861 gfc_check_min_max_real, gfc_simplify_min, NULL,
1862 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1864 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1865 gfc_check_min_max_double, gfc_simplify_min, NULL,
1866 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1868 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
1870 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
1871 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
1872 x, BT_UNKNOWN, dr, REQUIRED);
1874 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
1876 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1877 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
1878 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1879 msk, BT_LOGICAL, dl, OPTIONAL);
1881 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
1883 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1884 gfc_check_minval_maxval, NULL, gfc_resolve_minval,
1885 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1886 msk, BT_LOGICAL, dl, OPTIONAL);
1888 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
1890 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1891 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1892 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
1894 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1895 NULL, gfc_simplify_mod, gfc_resolve_mod,
1896 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
1898 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1899 NULL, gfc_simplify_mod, gfc_resolve_mod,
1900 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
1902 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
1904 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
1905 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1906 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
1908 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
1910 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1911 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1912 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
1914 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
1916 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
1917 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
1918 a, BT_CHARACTER, dc, REQUIRED);
1920 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
1922 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1923 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1924 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1926 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1927 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1928 a, BT_REAL, dd, REQUIRED);
1930 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
1932 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1933 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1934 i, BT_INTEGER, di, REQUIRED);
1936 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
1938 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1939 gfc_check_null, gfc_simplify_null, NULL,
1940 mo, BT_INTEGER, di, OPTIONAL);
1942 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
1944 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1945 gfc_check_pack, NULL, gfc_resolve_pack,
1946 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
1947 v, BT_REAL, dr, OPTIONAL);
1949 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
1951 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1952 gfc_check_precision, gfc_simplify_precision, NULL,
1953 x, BT_UNKNOWN, 0, REQUIRED);
1955 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
1957 add_sym_1 ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1958 gfc_check_present, NULL, NULL,
1959 a, BT_REAL, dr, REQUIRED);
1961 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
1963 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1964 gfc_check_product_sum, NULL, gfc_resolve_product,
1965 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1966 msk, BT_LOGICAL, dl, OPTIONAL);
1968 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
1970 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1971 gfc_check_radix, gfc_simplify_radix, NULL,
1972 x, BT_UNKNOWN, 0, REQUIRED);
1974 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
1976 /* The following function is for G77 compatibility. */
1977 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1978 gfc_check_rand, NULL, NULL,
1979 i, BT_INTEGER, 4, OPTIONAL);
1981 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
1982 use slightly different shoddy multiplicative congruential PRNG. */
1983 make_alias ("ran", GFC_STD_GNU);
1985 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
1987 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1988 gfc_check_range, gfc_simplify_range, NULL,
1989 x, BT_REAL, dr, REQUIRED);
1991 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
1993 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1994 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1995 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1997 /* This provides compatibility with g77. */
1998 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1999 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2000 a, BT_UNKNOWN, dr, REQUIRED);
2002 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2003 gfc_check_i, gfc_simplify_float, NULL,
2004 a, BT_INTEGER, di, REQUIRED);
2006 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2007 NULL, gfc_simplify_sngl, NULL,
2008 a, BT_REAL, dd, REQUIRED);
2010 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2012 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2013 gfc_check_rename, NULL, gfc_resolve_rename,
2014 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2016 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2018 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2019 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2020 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2022 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2024 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2025 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2026 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2027 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2029 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2031 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2032 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2033 x, BT_REAL, dr, REQUIRED);
2035 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2037 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2038 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2039 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2041 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2043 add_sym_3 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2044 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2045 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2046 bck, BT_LOGICAL, dl, OPTIONAL);
2048 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2050 /* Added for G77 compatibility garbage. */
2051 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2054 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2056 /* Added for G77 compatibility. */
2057 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2058 gfc_check_secnds, NULL, gfc_resolve_secnds,
2059 x, BT_REAL, dr, REQUIRED);
2061 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2063 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2064 GFC_STD_F95, gfc_check_selected_int_kind,
2065 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2067 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2069 add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2070 GFC_STD_F95, gfc_check_selected_real_kind,
2071 gfc_simplify_selected_real_kind, NULL,
2072 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2074 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2076 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2077 gfc_check_set_exponent, gfc_simplify_set_exponent,
2078 gfc_resolve_set_exponent,
2079 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2081 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2083 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2084 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2085 src, BT_REAL, dr, REQUIRED);
2087 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2089 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2090 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2091 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2093 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2094 NULL, gfc_simplify_sign, gfc_resolve_sign,
2095 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2097 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2098 NULL, gfc_simplify_sign, gfc_resolve_sign,
2099 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2101 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2103 add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2104 gfc_check_signal, NULL, gfc_resolve_signal,
2105 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2107 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2109 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2110 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2111 x, BT_REAL, dr, REQUIRED);
2113 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2114 NULL, gfc_simplify_sin, gfc_resolve_sin,
2115 x, BT_REAL, dd, REQUIRED);
2117 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2118 NULL, gfc_simplify_sin, gfc_resolve_sin,
2119 x, BT_COMPLEX, dz, REQUIRED);
2121 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2122 NULL, gfc_simplify_sin, gfc_resolve_sin,
2123 x, BT_COMPLEX, dd, REQUIRED);
2125 make_alias ("cdsin", GFC_STD_GNU);
2127 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2129 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2130 gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2131 x, BT_REAL, dr, REQUIRED);
2133 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2134 NULL, gfc_simplify_sinh, gfc_resolve_sinh,
2135 x, BT_REAL, dd, REQUIRED);
2137 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2139 add_sym_2 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2140 gfc_check_size, gfc_simplify_size, NULL,
2141 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2143 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2145 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2146 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2147 i, BT_UNKNOWN, 0, REQUIRED);
2149 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2151 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2152 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2153 x, BT_REAL, dr, REQUIRED);
2155 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2157 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2158 gfc_check_spread, NULL, gfc_resolve_spread,
2159 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2160 ncopies, BT_INTEGER, di, REQUIRED);
2162 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2164 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2165 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2166 x, BT_REAL, dr, REQUIRED);
2168 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2169 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2170 x, BT_REAL, dd, REQUIRED);
2172 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2173 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2174 x, BT_COMPLEX, dz, REQUIRED);
2176 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2177 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2178 x, BT_COMPLEX, dd, REQUIRED);
2180 make_alias ("cdsqrt", GFC_STD_GNU);
2182 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2184 add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2185 gfc_check_stat, NULL, gfc_resolve_stat,
2186 a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2188 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2190 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2191 gfc_check_product_sum, NULL, gfc_resolve_sum,
2192 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2193 msk, BT_LOGICAL, dl, OPTIONAL);
2195 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2197 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2198 gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2199 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2201 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2203 add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2205 c, BT_CHARACTER, dc, REQUIRED);
2207 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2209 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2210 gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2211 x, BT_REAL, dr, REQUIRED);
2213 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2214 NULL, gfc_simplify_tan, gfc_resolve_tan,
2215 x, BT_REAL, dd, REQUIRED);
2217 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2219 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2220 gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2221 x, BT_REAL, dr, REQUIRED);
2223 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2224 NULL, gfc_simplify_tanh, gfc_resolve_tanh,
2225 x, BT_REAL, dd, REQUIRED);
2227 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2229 add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2230 NULL, NULL, gfc_resolve_time);
2232 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2234 add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2235 NULL, NULL, gfc_resolve_time8);
2237 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2239 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2240 gfc_check_x, gfc_simplify_tiny, NULL,
2241 x, BT_REAL, dr, REQUIRED);
2243 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2245 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2246 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2247 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2248 sz, BT_INTEGER, di, OPTIONAL);
2250 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2252 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2253 gfc_check_transpose, NULL, gfc_resolve_transpose,
2254 m, BT_REAL, dr, REQUIRED);
2256 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2258 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2259 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2260 stg, BT_CHARACTER, dc, REQUIRED);
2262 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2264 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2265 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2266 ut, BT_INTEGER, di, REQUIRED);
2268 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2270 add_sym_2 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2271 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2272 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2274 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2276 /* g77 compatibility for UMASK. */
2277 add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2278 gfc_check_umask, NULL, gfc_resolve_umask,
2279 a, BT_INTEGER, di, REQUIRED);
2281 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2283 /* g77 compatibility for UNLINK. */
2284 add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2285 gfc_check_unlink, NULL, gfc_resolve_unlink,
2286 a, BT_CHARACTER, dc, REQUIRED);
2288 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2290 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2291 gfc_check_unpack, NULL, gfc_resolve_unpack,
2292 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2293 f, BT_REAL, dr, REQUIRED);
2295 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2297 add_sym_3 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2298 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2299 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2300 bck, BT_LOGICAL, dl, OPTIONAL);
2302 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2304 add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
2305 gfc_check_loc, NULL, gfc_resolve_loc,
2306 ar, BT_UNKNOWN, 0, REQUIRED);
2308 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2312 /* Add intrinsic subroutines. */
2315 add_subroutines (void)
2317 /* Argument names as in the standard (to be used as argument keywords). */
2319 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2320 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2321 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2322 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2323 *com = "command", *length = "length", *st = "status",
2324 *val = "value", *num = "number", *name = "name",
2325 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2326 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2329 int di, dr, dc, dl, ii;
2331 di = gfc_default_integer_kind;
2332 dr = gfc_default_real_kind;
2333 dc = gfc_default_character_kind;
2334 dl = gfc_default_logical_kind;
2335 ii = gfc_index_integer_kind;
2337 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2341 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2342 gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2343 tm, BT_REAL, dr, REQUIRED);
2345 /* More G77 compatibility garbage. */
2346 add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2347 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2348 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2350 add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2351 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2352 vl, BT_INTEGER, 4, REQUIRED);
2354 add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2355 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2356 vl, BT_INTEGER, 4, REQUIRED);
2358 add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2359 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2360 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2362 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2363 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2364 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2366 add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2367 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2368 tm, BT_REAL, dr, REQUIRED);
2370 add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2371 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2372 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2374 add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2375 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2376 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2377 st, BT_INTEGER, di, OPTIONAL);
2379 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2380 gfc_check_date_and_time, NULL, NULL,
2381 dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2382 zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2384 /* More G77 compatibility garbage. */
2385 add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2386 gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2387 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2389 add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2390 gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2391 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2393 add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2394 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2395 dt, BT_CHARACTER, dc, REQUIRED);
2397 add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2398 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2401 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2402 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2403 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2405 add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2407 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2410 add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2411 NULL, NULL, gfc_resolve_getarg,
2412 c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
2414 add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2415 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2418 /* F2003 commandline routines. */
2420 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2421 NULL, NULL, gfc_resolve_get_command,
2422 com, BT_CHARACTER, dc, OPTIONAL,
2423 length, BT_INTEGER, di, OPTIONAL,
2424 st, BT_INTEGER, di, OPTIONAL);
2426 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2427 NULL, NULL, gfc_resolve_get_command_argument,
2428 num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2429 length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2431 /* F2003 subroutine to get environment variables. */
2433 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2434 NULL, NULL, gfc_resolve_get_environment_variable,
2435 name, BT_CHARACTER, dc, REQUIRED,
2436 val, BT_CHARACTER, dc, OPTIONAL,
2437 length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2438 trim_name, BT_LOGICAL, dl, OPTIONAL);
2440 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2441 gfc_check_move_alloc, NULL, NULL,
2442 f, BT_UNKNOWN, 0, REQUIRED,
2443 t, BT_UNKNOWN, 0, REQUIRED);
2445 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2446 gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2447 f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2448 ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2449 tp, BT_INTEGER, di, REQUIRED);
2451 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2452 gfc_check_random_number, NULL, gfc_resolve_random_number,
2453 h, BT_REAL, dr, REQUIRED);
2455 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2456 gfc_check_random_seed, NULL, NULL,
2457 sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2458 gt, BT_INTEGER, di, OPTIONAL);
2460 /* More G77 compatibility garbage. */
2461 add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2462 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2463 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2464 st, BT_INTEGER, di, OPTIONAL);
2466 add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2467 gfc_check_srand, NULL, gfc_resolve_srand,
2468 c, BT_INTEGER, 4, REQUIRED);
2470 add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2471 gfc_check_exit, NULL, gfc_resolve_exit,
2472 st, BT_INTEGER, di, OPTIONAL);
2476 add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2477 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2478 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2479 st, BT_INTEGER, di, OPTIONAL);
2481 add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2482 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2483 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2485 add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2486 gfc_check_flush, NULL, gfc_resolve_flush,
2487 c, BT_INTEGER, di, OPTIONAL);
2489 add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2490 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2491 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2492 st, BT_INTEGER, di, OPTIONAL);
2494 add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2495 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2496 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2498 add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2499 NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2501 add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2502 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2503 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, di, REQUIRED,
2504 whence, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2506 add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2507 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2508 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2510 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2511 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2512 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2514 add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2515 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2516 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2518 add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2519 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2520 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2521 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2523 add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2524 gfc_check_perror, NULL, gfc_resolve_perror,
2525 c, BT_CHARACTER, dc, REQUIRED);
2527 add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2528 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2529 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2530 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2532 add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2533 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2534 val, BT_CHARACTER, dc, REQUIRED);
2536 add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2537 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2538 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2539 st, BT_INTEGER, di, OPTIONAL);
2541 add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2542 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2543 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2544 st, BT_INTEGER, di, OPTIONAL);
2546 add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2547 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2548 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2549 st, BT_INTEGER, di, OPTIONAL);
2551 add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2552 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2553 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2554 st, BT_INTEGER, di, OPTIONAL);
2556 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2557 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2558 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2559 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2561 add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2562 NULL, NULL, gfc_resolve_system_sub,
2563 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2565 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F95,
2566 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2567 c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2568 cm, BT_INTEGER, di, OPTIONAL);
2570 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2571 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2572 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2574 add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2575 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2576 val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2578 add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2579 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2580 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2584 /* Add a function to the list of conversion symbols. */
2587 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2589 gfc_typespec from, to;
2590 gfc_intrinsic_sym *sym;
2592 if (sizing == SZ_CONVS)
2598 gfc_clear_ts (&from);
2599 from.type = from_type;
2600 from.kind = from_kind;
2606 sym = conversion + nconv;
2608 sym->name = conv_name (&from, &to);
2609 sym->lib_name = sym->name;
2610 sym->simplify.cc = gfc_convert_constant;
2611 sym->standard = standard;
2613 sym->conversion = 1;
2615 sym->id = GFC_ISYM_CONVERSION;
2621 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2622 functions by looping over the kind tables. */
2625 add_conversions (void)
2629 /* Integer-Integer conversions. */
2630 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2631 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2636 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2637 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2640 /* Integer-Real/Complex conversions. */
2641 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2642 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2644 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2645 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2647 add_conv (BT_REAL, gfc_real_kinds[j].kind,
2648 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2650 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2651 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2653 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2654 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2657 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2659 /* Hollerith-Integer conversions. */
2660 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2661 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2662 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2663 /* Hollerith-Real conversions. */
2664 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2665 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2666 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2667 /* Hollerith-Complex conversions. */
2668 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2669 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2670 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2672 /* Hollerith-Character conversions. */
2673 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2674 gfc_default_character_kind, GFC_STD_LEGACY);
2676 /* Hollerith-Logical conversions. */
2677 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2678 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2679 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2682 /* Real/Complex - Real/Complex conversions. */
2683 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2684 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2688 add_conv (BT_REAL, gfc_real_kinds[i].kind,
2689 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2691 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2692 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2695 add_conv (BT_REAL, gfc_real_kinds[i].kind,
2696 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2698 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2699 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2702 /* Logical/Logical kind conversion. */
2703 for (i = 0; gfc_logical_kinds[i].kind; i++)
2704 for (j = 0; gfc_logical_kinds[j].kind; j++)
2709 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2710 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2713 /* Integer-Logical and Logical-Integer conversions. */
2714 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2715 for (i=0; gfc_integer_kinds[i].kind; i++)
2716 for (j=0; gfc_logical_kinds[j].kind; j++)
2718 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2719 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2720 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2721 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2726 /* Initialize the table of intrinsics. */
2728 gfc_intrinsic_init_1 (void)
2732 nargs = nfunc = nsub = nconv = 0;
2734 /* Create a namespace to hold the resolved intrinsic symbols. */
2735 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2744 functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2745 + sizeof (gfc_intrinsic_arg) * nargs);
2747 next_sym = functions;
2748 subroutines = functions + nfunc;
2750 conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2752 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2754 sizing = SZ_NOTHING;
2761 /* Set the pure flag. All intrinsic functions are pure, and
2762 intrinsic subroutines are pure if they are elemental. */
2764 for (i = 0; i < nfunc; i++)
2765 functions[i].pure = 1;
2767 for (i = 0; i < nsub; i++)
2768 subroutines[i].pure = subroutines[i].elemental;
2773 gfc_intrinsic_done_1 (void)
2775 gfc_free (functions);
2776 gfc_free (conversion);
2777 gfc_free_namespace (gfc_intrinsic_namespace);
2781 /******** Subroutines to check intrinsic interfaces ***********/
2783 /* Given a formal argument list, remove any NULL arguments that may
2784 have been left behind by a sort against some formal argument list. */
2787 remove_nullargs (gfc_actual_arglist **ap)
2789 gfc_actual_arglist *head, *tail, *next;
2793 for (head = *ap; head; head = next)
2797 if (head->expr == NULL && !head->label)
2800 gfc_free_actual_arglist (head);
2819 /* Given an actual arglist and a formal arglist, sort the actual
2820 arglist so that its arguments are in a one-to-one correspondence
2821 with the format arglist. Arguments that are not present are given
2822 a blank gfc_actual_arglist structure. If something is obviously
2823 wrong (say, a missing required argument) we abort sorting and
2827 sort_actual (const char *name, gfc_actual_arglist **ap,
2828 gfc_intrinsic_arg *formal, locus *where)
2830 gfc_actual_arglist *actual, *a;
2831 gfc_intrinsic_arg *f;
2833 remove_nullargs (ap);
2836 for (f = formal; f; f = f->next)
2842 if (f == NULL && a == NULL) /* No arguments */
2846 { /* Put the nonkeyword arguments in a 1:1 correspondence */
2852 if (a->name != NULL)
2864 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2868 /* Associate the remaining actual arguments, all of which have
2869 to be keyword arguments. */
2870 for (; a; a = a->next)
2872 for (f = formal; f; f = f->next)
2873 if (strcmp (a->name, f->name) == 0)
2878 if (a->name[0] == '%')
2879 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
2880 "are not allowed in this context at %L", where);
2882 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2883 a->name, name, where);
2887 if (f->actual != NULL)
2889 gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2890 f->name, name, where);
2898 /* At this point, all unmatched formal args must be optional. */
2899 for (f = formal; f; f = f->next)
2901 if (f->actual == NULL && f->optional == 0)
2903 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2904 f->name, name, where);
2910 /* Using the formal argument list, string the actual argument list
2911 together in a way that corresponds with the formal list. */
2914 for (f = formal; f; f = f->next)
2916 if (f->actual && f->actual->label != NULL && f->ts.type)
2918 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
2922 if (f->actual == NULL)
2924 a = gfc_get_actual_arglist ();
2925 a->missing_arg_type = f->ts.type;
2937 actual->next = NULL; /* End the sorted argument list. */
2943 /* Compare an actual argument list with an intrinsic's formal argument
2944 list. The lists are checked for agreement of type. We don't check
2945 for arrayness here. */
2948 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
2951 gfc_actual_arglist *actual;
2952 gfc_intrinsic_arg *formal;
2955 formal = sym->formal;
2959 for (; formal; formal = formal->next, actual = actual->next, i++)
2961 if (actual->expr == NULL)
2964 if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2967 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
2968 "be %s, not %s", gfc_current_intrinsic_arg[i],
2969 gfc_current_intrinsic, &actual->expr->where,
2970 gfc_typename (&formal->ts),
2971 gfc_typename (&actual->expr->ts));
2980 /* Given a pointer to an intrinsic symbol and an expression node that
2981 represent the function call to that subroutine, figure out the type
2982 of the result. This may involve calling a resolution subroutine. */
2985 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
2987 gfc_expr *a1, *a2, *a3, *a4, *a5;
2988 gfc_actual_arglist *arg;
2990 if (specific->resolve.f1 == NULL)
2992 if (e->value.function.name == NULL)
2993 e->value.function.name = specific->lib_name;
2995 if (e->ts.type == BT_UNKNOWN)
2996 e->ts = specific->ts;
3000 arg = e->value.function.actual;
3002 /* Special case hacks for MIN and MAX. */
3003 if (specific->resolve.f1m == gfc_resolve_max
3004 || specific->resolve.f1m == gfc_resolve_min)
3006 (*specific->resolve.f1m) (e, arg);
3012 (*specific->resolve.f0) (e);
3021 (*specific->resolve.f1) (e, a1);
3030 (*specific->resolve.f2) (e, a1, a2);
3039 (*specific->resolve.f3) (e, a1, a2, a3);
3048 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3057 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3061 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3065 /* Given an intrinsic symbol node and an expression node, call the
3066 simplification function (if there is one), perhaps replacing the
3067 expression with something simpler. We return FAILURE on an error
3068 of the simplification, SUCCESS if the simplification worked, even
3069 if nothing has changed in the expression itself. */
3072 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3074 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3075 gfc_actual_arglist *arg;
3077 /* Max and min require special handling due to the variable number
3079 if (specific->simplify.f1 == gfc_simplify_min)
3081 result = gfc_simplify_min (e);
3085 if (specific->simplify.f1 == gfc_simplify_max)
3087 result = gfc_simplify_max (e);
3091 if (specific->simplify.f1 == NULL)
3097 arg = e->value.function.actual;
3101 result = (*specific->simplify.f0) ();
3108 if (specific->simplify.cc == gfc_convert_constant)
3110 result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3114 /* TODO: Warn if -pedantic and initialization expression and arg
3115 types not integer or character */
3118 result = (*specific->simplify.f1) (a1);
3125 result = (*specific->simplify.f2) (a1, a2);
3132 result = (*specific->simplify.f3) (a1, a2, a3);
3139 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3146 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3149 ("do_simplify(): Too many args for intrinsic");
3156 if (result == &gfc_bad_expr)
3160 resolve_intrinsic (specific, e); /* Must call at run-time */
3163 result->where = e->where;
3164 gfc_replace_expr (e, result);
3171 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3172 error messages. This subroutine returns FAILURE if a subroutine
3173 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3174 list cannot match any intrinsic. */
3177 init_arglist (gfc_intrinsic_sym *isym)
3179 gfc_intrinsic_arg *formal;
3182 gfc_current_intrinsic = isym->name;
3185 for (formal = isym->formal; formal; formal = formal->next)
3187 if (i >= MAX_INTRINSIC_ARGS)
3188 gfc_internal_error ("init_arglist(): too many arguments");
3189 gfc_current_intrinsic_arg[i++] = formal->name;
3194 /* Given a pointer to an intrinsic symbol and an expression consisting
3195 of a function call, see if the function call is consistent with the
3196 intrinsic's formal argument list. Return SUCCESS if the expression
3197 and intrinsic match, FAILURE otherwise. */
3200 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3202 gfc_actual_arglist *arg, **ap;
3205 ap = &expr->value.function.actual;
3207 init_arglist (specific);
3209 /* Don't attempt to sort the argument list for min or max. */
3210 if (specific->check.f1m == gfc_check_min_max
3211 || specific->check.f1m == gfc_check_min_max_integer
3212 || specific->check.f1m == gfc_check_min_max_real
3213 || specific->check.f1m == gfc_check_min_max_double)
3214 return (*specific->check.f1m) (*ap);
3216 if (sort_actual (specific->name, ap, specific->formal,
3217 &expr->where) == FAILURE)
3220 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3221 /* This is special because we might have to reorder the argument list. */
3222 t = gfc_check_minloc_maxloc (*ap);
3223 else if (specific->check.f3red == gfc_check_minval_maxval)
3224 /* This is also special because we also might have to reorder the
3226 t = gfc_check_minval_maxval (*ap);
3227 else if (specific->check.f3red == gfc_check_product_sum)
3228 /* Same here. The difference to the previous case is that we allow a
3229 general numeric type. */
3230 t = gfc_check_product_sum (*ap);
3233 if (specific->check.f1 == NULL)
3235 t = check_arglist (ap, specific, error_flag);
3237 expr->ts = specific->ts;
3240 t = do_check (specific, *ap);
3243 /* Check conformance of elemental intrinsics. */
3244 if (t == SUCCESS && specific->elemental)
3247 gfc_expr *first_expr;
3248 arg = expr->value.function.actual;
3250 /* There is no elemental intrinsic without arguments. */
3251 gcc_assert(arg != NULL);
3252 first_expr = arg->expr;
3254 for ( ; arg && arg->expr; arg = arg->next, n++)
3257 snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3258 gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3259 gfc_current_intrinsic);
3260 if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3266 remove_nullargs (ap);
3272 /* Check whether an intrinsic belongs to whatever standard the user
3276 check_intrinsic_standard (const char *name, int standard, locus *where)
3278 /* Do not warn about GNU-extensions if -std=gnu. */
3279 if (!gfc_option.warn_nonstd_intrinsics
3280 || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU))
3283 if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3284 "in the selected standard", name, where) == FAILURE)
3291 /* See if a function call corresponds to an intrinsic function call.
3294 MATCH_YES if the call corresponds to an intrinsic, simplification
3295 is done if possible.
3297 MATCH_NO if the call does not correspond to an intrinsic
3299 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3300 error during the simplification process.
3302 The error_flag parameter enables an error reporting. */
3305 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3307 gfc_intrinsic_sym *isym, *specific;
3308 gfc_actual_arglist *actual;
3312 if (expr->value.function.isym != NULL)
3313 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3314 ? MATCH_ERROR : MATCH_YES;
3316 gfc_suppress_error = !error_flag;
3319 for (actual = expr->value.function.actual; actual; actual = actual->next)
3320 if (actual->expr != NULL)
3321 flag |= (actual->expr->ts.type != BT_INTEGER
3322 && actual->expr->ts.type != BT_CHARACTER);
3324 name = expr->symtree->n.sym->name;
3326 isym = specific = gfc_find_function (name);
3329 gfc_suppress_error = 0;
3333 if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE)
3336 gfc_current_intrinsic_where = &expr->where;
3338 /* Bypass the generic list for min and max. */
3339 if (isym->check.f1m == gfc_check_min_max)
3341 init_arglist (isym);
3343 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3346 gfc_suppress_error = 0;
3350 /* If the function is generic, check all of its specific
3351 incarnations. If the generic name is also a specific, we check
3352 that name last, so that any error message will correspond to the
3354 gfc_suppress_error = 1;
3358 for (specific = isym->specific_head; specific;
3359 specific = specific->next)
3361 if (specific == isym)
3363 if (check_specific (specific, expr, 0) == SUCCESS)
3368 gfc_suppress_error = !error_flag;
3370 if (check_specific (isym, expr, error_flag) == FAILURE)
3372 gfc_suppress_error = 0;
3379 expr->value.function.isym = specific;
3380 gfc_intrinsic_symbol (expr->symtree->n.sym);
3382 gfc_suppress_error = 0;
3383 if (do_simplify (specific, expr) == FAILURE)
3386 /* F95, 7.1.6.1, Initialization expressions
3387 (4) An elemental intrinsic function reference of type integer or
3388 character where each argument is an initialization expression
3389 of type integer or character
3391 F2003, 7.1.7 Initialization expression
3392 (4) A reference to an elemental standard intrinsic function,
3393 where each argument is an initialization expression */
3397 && (expr->ts.type != BT_INTEGER || expr->ts.type != BT_CHARACTER)
3398 && gfc_notify_std (GFC_STD_F2003, "Extension: Evaluation of "
3399 "nonstandard initialization expression at %L",
3400 &expr->where) == FAILURE)
3407 /* See if a CALL statement corresponds to an intrinsic subroutine.
3408 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3409 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3413 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3415 gfc_intrinsic_sym *isym;
3418 name = c->symtree->n.sym->name;
3420 isym = gfc_find_subroutine (name);
3424 if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE)
3427 gfc_suppress_error = !error_flag;
3429 init_arglist (isym);
3431 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3434 if (isym->check.f1 != NULL)
3436 if (do_check (isym, c->ext.actual) == FAILURE)
3441 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3445 /* The subroutine corresponds to an intrinsic. Allow errors to be
3446 seen at this point. */
3447 gfc_suppress_error = 0;
3449 if (isym->resolve.s1 != NULL)
3450 isym->resolve.s1 (c);
3452 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3454 if (gfc_pure (NULL) && !isym->elemental)
3456 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3461 c->resolved_sym->attr.noreturn = isym->noreturn;
3466 gfc_suppress_error = 0;
3471 /* Call gfc_convert_type() with warning enabled. */
3474 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3476 return gfc_convert_type_warn (expr, ts, eflag, 1);
3480 /* Try to convert an expression (in place) from one type to another.
3481 'eflag' controls the behavior on error.
3483 The possible values are:
3485 1 Generate a gfc_error()
3486 2 Generate a gfc_internal_error().
3488 'wflag' controls the warning related to conversion. */
3491 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3493 gfc_intrinsic_sym *sym;
3494 gfc_typespec from_ts;
3500 from_ts = expr->ts; /* expr->ts gets clobbered */
3502 if (ts->type == BT_UNKNOWN)
3505 /* NULL and zero size arrays get their type here. */
3506 if (expr->expr_type == EXPR_NULL
3507 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3509 /* Sometimes the RHS acquire the type. */
3514 if (expr->ts.type == BT_UNKNOWN)
3517 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3518 && gfc_compare_types (&expr->ts, ts))
3521 sym = find_conv (&expr->ts, ts);
3525 /* At this point, a conversion is necessary. A warning may be needed. */
3526 if ((gfc_option.warn_std & sym->standard) != 0)
3527 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3528 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3529 else if (wflag && gfc_option.warn_conversion)
3530 gfc_warning_now ("Conversion from %s to %s at %L",
3531 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3533 /* Insert a pre-resolved function call to the right function. */
3534 old_where = expr->where;
3536 shape = expr->shape;
3538 new = gfc_get_expr ();
3541 new = gfc_build_conversion (new);
3542 new->value.function.name = sym->lib_name;
3543 new->value.function.isym = sym;
3544 new->where = old_where;
3546 new->shape = gfc_copy_shape (shape, rank);
3548 gfc_get_ha_sym_tree (sym->name, &new->symtree);
3549 new->symtree->n.sym->ts = *ts;
3550 new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3551 new->symtree->n.sym->attr.function = 1;
3552 new->symtree->n.sym->attr.elemental = 1;
3553 new->symtree->n.sym->attr.pure = 1;
3554 new->symtree->n.sym->attr.referenced = 1;
3555 gfc_intrinsic_symbol(new->symtree->n.sym);
3556 gfc_commit_symbol (new->symtree->n.sym);
3563 if (gfc_is_constant_expr (expr->value.function.actual->expr)
3564 && do_simplify (sym, expr) == FAILURE)
3569 return FAILURE; /* Error already generated in do_simplify() */
3577 gfc_error ("Can't convert %s to %s at %L",
3578 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3582 gfc_internal_error ("Can't convert %s to %s at %L",
3583 gfc_typename (&from_ts), gfc_typename (ts),