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 2, 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 COPYING. If not, write to the Free
21 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
28 #include "intrinsic.h"
30 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
31 static gfc_namespace *gfc_intrinsic_namespace;
33 int gfc_init_expr = 0;
35 /* Pointers to an intrinsic function and its argument names that are being
38 const char *gfc_current_intrinsic;
39 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
40 locus *gfc_current_intrinsic_where;
42 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
43 static gfc_intrinsic_arg *next_arg;
45 static int nfunc, nsub, nargs, nconv;
48 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
51 #define NOT_ELEMENTAL 0
61 /* Return a letter based on the passed type. Used to construct the
62 name of a type-dependent subroutine. */
65 gfc_type_letter (bt type)
100 /* Get a symbol for a resolved name. */
103 gfc_get_intrinsic_sub_symbol (const char *name)
107 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
108 sym->attr.always_explicit = 1;
109 sym->attr.subroutine = 1;
110 sym->attr.flavor = FL_PROCEDURE;
111 sym->attr.proc = PROC_INTRINSIC;
117 /* Return a pointer to the name of a conversion function given two
121 conv_name (gfc_typespec *from, gfc_typespec *to)
123 return gfc_get_string ("__convert_%c%d_%c%d",
124 gfc_type_letter (from->type), from->kind,
125 gfc_type_letter (to->type), to->kind);
129 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
130 corresponds to the conversion. Returns NULL if the conversion
133 static gfc_intrinsic_sym *
134 find_conv (gfc_typespec *from, gfc_typespec *to)
136 gfc_intrinsic_sym *sym;
140 target = conv_name (from, to);
143 for (i = 0; i < nconv; i++, sym++)
144 if (target == sym->name)
151 /* Interface to the check functions. We break apart an argument list
152 and call the proper check function rather than forcing each
153 function to manipulate the argument list. */
156 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
158 gfc_expr *a1, *a2, *a3, *a4, *a5;
161 return (*specific->check.f0) ();
166 return (*specific->check.f1) (a1);
171 return (*specific->check.f2) (a1, a2);
176 return (*specific->check.f3) (a1, a2, a3);
181 return (*specific->check.f4) (a1, a2, a3, a4);
186 return (*specific->check.f5) (a1, a2, a3, a4, a5);
188 gfc_internal_error ("do_check(): too many args");
192 /*********** Subroutines to build the intrinsic list ****************/
194 /* Add a single intrinsic symbol to the current list.
197 char * name of function
198 int whether function is elemental
199 int If the function can be used as an actual argument [1]
200 bt return type of function
201 int kind of return type of function
202 int Fortran standard version
203 check pointer to check function
204 simplify pointer to simplification function
205 resolve pointer to resolution function
207 Optional arguments come in multiples of four:
208 char * name of argument
211 int arg optional flag (1=optional, 0=required)
213 The sequence is terminated by a NULL name.
216 [1] Whether a function can or cannot be used as an actual argument is
217 determined by its presence on the 13.6 list in Fortran 2003. The
218 following intrinsics, which are GNU extensions, are considered allowed
219 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
220 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
223 add_sym (const char *name, int elemental, int actual_ok, bt type, int kind,
224 int standard, gfc_check_f check, gfc_simplify_f simplify,
225 gfc_resolve_f resolve, ...)
227 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
228 int optional, first_flag;
231 /* First check that the intrinsic belongs to the selected standard.
232 If not, don't add it to the symbol list. */
233 if (!(gfc_option.allow_std & standard)
234 && gfc_option.flag_all_intrinsics == 0)
248 next_sym->name = gfc_get_string (name);
250 strcpy (buf, "_gfortran_");
252 next_sym->lib_name = gfc_get_string (buf);
254 next_sym->elemental = elemental;
255 next_sym->actual_ok = actual_ok;
256 next_sym->ts.type = type;
257 next_sym->ts.kind = kind;
258 next_sym->standard = standard;
259 next_sym->simplify = simplify;
260 next_sym->check = check;
261 next_sym->resolve = resolve;
262 next_sym->specific = 0;
263 next_sym->generic = 0;
267 gfc_internal_error ("add_sym(): Bad sizing mode");
270 va_start (argp, resolve);
276 name = va_arg (argp, char *);
280 type = (bt) va_arg (argp, int);
281 kind = va_arg (argp, int);
282 optional = va_arg (argp, int);
284 if (sizing != SZ_NOTHING)
291 next_sym->formal = next_arg;
293 (next_arg - 1)->next = next_arg;
297 strcpy (next_arg->name, name);
298 next_arg->ts.type = type;
299 next_arg->ts.kind = kind;
300 next_arg->optional = optional;
310 /* Add a symbol to the function list where the function takes
314 add_sym_0 (const char *name, int elemental, int actual_ok, bt type,
315 int kind, int standard,
317 gfc_expr *(*simplify) (void),
318 void (*resolve) (gfc_expr *))
328 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
333 /* Add a symbol to the subroutine list where the subroutine takes
337 add_sym_0s (const char *name, int standard, void (*resolve) (gfc_code *))
347 add_sym (name, ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
352 /* Add a symbol to the function list where the function takes
356 add_sym_1 (const char *name, int elemental, int actual_ok, bt type,
357 int kind, int standard,
358 try (*check) (gfc_expr *),
359 gfc_expr *(*simplify) (gfc_expr *),
360 void (*resolve) (gfc_expr *, gfc_expr *),
361 const char *a1, bt type1, int kind1, int optional1)
371 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
372 a1, type1, kind1, optional1,
377 /* Add a symbol to the subroutine list where the subroutine takes
381 add_sym_1s (const char *name, int elemental, bt type, int kind, int standard,
382 try (*check) (gfc_expr *),
383 gfc_expr *(*simplify) (gfc_expr *),
384 void (*resolve) (gfc_code *),
385 const char *a1, bt type1, int kind1, int optional1)
395 add_sym (name, elemental, ACTUAL_NO, type, kind, standard, cf, sf, rf,
396 a1, type1, kind1, optional1,
401 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
402 function. MAX et al take 2 or more arguments. */
405 add_sym_1m (const char *name, int elemental, int actual_ok, bt type,
406 int kind, int standard,
407 try (*check) (gfc_actual_arglist *),
408 gfc_expr *(*simplify) (gfc_expr *),
409 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
410 const char *a1, bt type1, int kind1, int optional1,
411 const char *a2, bt type2, int kind2, int optional2)
421 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
422 a1, type1, kind1, optional1,
423 a2, type2, kind2, optional2,
428 /* Add a symbol to the function list where the function takes
432 add_sym_2 (const char *name, int elemental, int actual_ok, bt type,
433 int kind, int standard,
434 try (*check) (gfc_expr *, gfc_expr *),
435 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
436 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
437 const char *a1, bt type1, int kind1, int optional1,
438 const char *a2, bt type2, int kind2, int optional2)
448 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
449 a1, type1, kind1, optional1,
450 a2, type2, kind2, optional2,
455 /* Add a symbol to the subroutine list where the subroutine takes
459 add_sym_2s (const char *name, int elemental, bt type, int kind, int standard,
460 try (*check) (gfc_expr *, gfc_expr *),
461 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
462 void (*resolve) (gfc_code *),
463 const char *a1, bt type1, int kind1, int optional1,
464 const char *a2, bt type2, int kind2, int optional2)
474 add_sym (name, elemental, ACTUAL_NO, type, kind, standard, cf, sf, rf,
475 a1, type1, kind1, optional1,
476 a2, type2, kind2, optional2,
481 /* Add a symbol to the function list where the function takes
485 add_sym_3 (const char *name, int elemental, int actual_ok, bt type,
486 int kind, int standard,
487 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
488 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
489 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
490 const char *a1, bt type1, int kind1, int optional1,
491 const char *a2, bt type2, int kind2, int optional2,
492 const char *a3, bt type3, int kind3, int optional3)
502 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
503 a1, type1, kind1, optional1,
504 a2, type2, kind2, optional2,
505 a3, type3, kind3, optional3,
510 /* MINLOC and MAXLOC get special treatment because their argument
511 might have to be reordered. */
514 add_sym_3ml (const char *name, int elemental, int actual_ok, bt type,
515 int kind, int standard,
516 try (*check) (gfc_actual_arglist *),
517 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
518 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
519 const char *a1, bt type1, int kind1, int optional1,
520 const char *a2, bt type2, int kind2, int optional2,
521 const char *a3, bt type3, int kind3, int optional3)
531 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
532 a1, type1, kind1, optional1,
533 a2, type2, kind2, optional2,
534 a3, type3, kind3, optional3,
539 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
540 their argument also might have to be reordered. */
543 add_sym_3red (const char *name, int elemental, int actual_ok, bt type,
544 int kind, int standard,
545 try (*check) (gfc_actual_arglist *),
546 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
547 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
548 const char *a1, bt type1, int kind1, int optional1,
549 const char *a2, bt type2, int kind2, int optional2,
550 const char *a3, bt type3, int kind3, int optional3)
560 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
561 a1, type1, kind1, optional1,
562 a2, type2, kind2, optional2,
563 a3, type3, kind3, optional3,
568 /* Add a symbol to the subroutine list where the subroutine takes
572 add_sym_3s (const char *name, int elemental, bt type, int kind, int standard,
573 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
574 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
575 void (*resolve) (gfc_code *),
576 const char *a1, bt type1, int kind1, int optional1,
577 const char *a2, bt type2, int kind2, int optional2,
578 const char *a3, bt type3, int kind3, int optional3)
588 add_sym (name, elemental, ACTUAL_NO, type, kind, standard, cf, sf, rf,
589 a1, type1, kind1, optional1,
590 a2, type2, kind2, optional2,
591 a3, type3, kind3, optional3,
596 /* Add a symbol to the function list where the function takes
600 add_sym_4 (const char *name, int elemental, int actual_ok, bt type,
601 int kind, int standard,
602 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
603 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
605 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
607 const char *a1, bt type1, int kind1, int optional1,
608 const char *a2, bt type2, int kind2, int optional2,
609 const char *a3, bt type3, int kind3, int optional3,
610 const char *a4, bt type4, int kind4, int optional4 )
620 add_sym (name, elemental, actual_ok, type, kind, standard, cf, sf, rf,
621 a1, type1, kind1, optional1,
622 a2, type2, kind2, optional2,
623 a3, type3, kind3, optional3,
624 a4, type4, kind4, optional4,
629 /* Add a symbol to the subroutine list where the subroutine takes
633 add_sym_4s (const char *name, int elemental, bt type, int kind, int standard,
634 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
635 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
637 void (*resolve) (gfc_code *),
638 const char *a1, bt type1, int kind1, int optional1,
639 const char *a2, bt type2, int kind2, int optional2,
640 const char *a3, bt type3, int kind3, int optional3,
641 const char *a4, bt type4, int kind4, int optional4)
651 add_sym (name, elemental, ACTUAL_NO, type, kind, standard, cf, sf, rf,
652 a1, type1, kind1, optional1,
653 a2, type2, kind2, optional2,
654 a3, type3, kind3, optional3,
655 a4, type4, kind4, optional4,
660 /* Add a symbol to the subroutine list where the subroutine takes
664 add_sym_5s (const char *name, int elemental, bt type, int kind, int standard,
665 try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
667 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
668 gfc_expr *, gfc_expr *),
669 void (*resolve) (gfc_code *),
670 const char *a1, bt type1, int kind1, int optional1,
671 const char *a2, bt type2, int kind2, int optional2,
672 const char *a3, bt type3, int kind3, int optional3,
673 const char *a4, bt type4, int kind4, int optional4,
674 const char *a5, bt type5, int kind5, int optional5)
684 add_sym (name, elemental, ACTUAL_NO, type, kind, standard, cf, sf, rf,
685 a1, type1, kind1, optional1,
686 a2, type2, kind2, optional2,
687 a3, type3, kind3, optional3,
688 a4, type4, kind4, optional4,
689 a5, type5, kind5, optional5,
694 /* Locate an intrinsic symbol given a base pointer, number of elements
695 in the table and a pointer to a name. Returns the NULL pointer if
696 a name is not found. */
698 static gfc_intrinsic_sym *
699 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
701 /* name may be a user-supplied string, so we must first make sure
702 that we're comparing against a pointer into the global string
704 const char *p = gfc_get_string (name);
708 if (p == start->name)
719 /* Given a name, find a function in the intrinsic function table.
720 Returns NULL if not found. */
723 gfc_find_function (const char *name)
725 gfc_intrinsic_sym *sym;
727 sym = find_sym (functions, nfunc, name);
729 sym = find_sym (conversion, nconv, name);
735 /* Given a name, find a function in the intrinsic subroutine table.
736 Returns NULL if not found. */
738 static gfc_intrinsic_sym *
739 find_subroutine (const char *name)
741 return find_sym (subroutines, nsub, name);
745 /* Given a string, figure out if it is the name of a generic intrinsic
749 gfc_generic_intrinsic (const char *name)
751 gfc_intrinsic_sym *sym;
753 sym = gfc_find_function (name);
754 return (sym == NULL) ? 0 : sym->generic;
758 /* Given a string, figure out if it is the name of a specific
759 intrinsic function or not. */
762 gfc_specific_intrinsic (const char *name)
764 gfc_intrinsic_sym *sym;
766 sym = gfc_find_function (name);
767 return (sym == NULL) ? 0 : sym->specific;
771 /* Given a string, figure out if it is the name of an intrinsic function
772 or subroutine allowed as an actual argument or not. */
774 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
776 gfc_intrinsic_sym *sym;
778 /* Intrinsic subroutines are not allowed as actual arguments. */
783 sym = gfc_find_function (name);
784 return (sym == NULL) ? 0 : sym->actual_ok;
789 /* Given a string, figure out if it is the name of an intrinsic
790 subroutine or function. There are no generic intrinsic
791 subroutines, they are all specific. */
794 gfc_intrinsic_name (const char *name, int subroutine_flag)
796 return subroutine_flag ? find_subroutine (name) != NULL
797 : gfc_find_function (name) != NULL;
801 /* Collect a set of intrinsic functions into a generic collection.
802 The first argument is the name of the generic function, which is
803 also the name of a specific function. The rest of the specifics
804 currently in the table are placed into the list of specific
805 functions associated with that generic. */
808 make_generic (const char *name, gfc_generic_isym_id generic_id, int standard)
810 gfc_intrinsic_sym *g;
812 if (!(gfc_option.allow_std & standard)
813 && gfc_option.flag_all_intrinsics == 0)
816 if (sizing != SZ_NOTHING)
819 g = gfc_find_function (name);
821 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
826 g->generic_id = generic_id;
827 if ((g + 1)->name != NULL)
828 g->specific_head = g + 1;
831 while (g->name != NULL)
835 g->generic_id = generic_id;
844 /* Create a duplicate intrinsic function entry for the current
845 function, the only difference being the alternate name. Note that
846 we use argument lists more than once, but all argument lists are
847 freed as a single block. */
850 make_alias (const char *name, int standard)
852 /* First check that the intrinsic belongs to the selected standard.
853 If not, don't add it to the symbol list. */
854 if (!(gfc_option.allow_std & standard)
855 && gfc_option.flag_all_intrinsics == 0)
869 next_sym[0] = next_sym[-1];
870 next_sym->name = gfc_get_string (name);
880 /* Make the current subroutine noreturn. */
885 if (sizing == SZ_NOTHING)
886 next_sym[-1].noreturn = 1;
890 /* Add intrinsic functions. */
895 /* Argument names as in the standard (to be used as argument keywords). */
897 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
898 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
899 *c = "c", *n = "ncopies", *pos = "pos", *bck = "back",
900 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
901 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
902 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
903 *p = "p", *ar = "array", *shp = "shape", *src = "source",
904 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
905 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
906 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
907 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
908 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
909 *num = "number", *tm = "time", *nm = "name", *md = "mode";
911 int di, dr, dd, dl, dc, dz, ii;
913 di = gfc_default_integer_kind;
914 dr = gfc_default_real_kind;
915 dd = gfc_default_double_kind;
916 dl = gfc_default_logical_kind;
917 dc = gfc_default_character_kind;
918 dz = gfc_default_complex_kind;
919 ii = gfc_index_integer_kind;
921 add_sym_1 ("abs", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
922 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
923 a, BT_REAL, dr, REQUIRED);
925 add_sym_1 ("iabs", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
926 NULL, gfc_simplify_abs, gfc_resolve_abs,
927 a, BT_INTEGER, di, REQUIRED);
929 add_sym_1 ("dabs", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
930 NULL, gfc_simplify_abs, gfc_resolve_abs,
931 a, BT_REAL, dd, REQUIRED);
933 add_sym_1 ("cabs", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
934 NULL, gfc_simplify_abs, gfc_resolve_abs,
935 a, BT_COMPLEX, dz, REQUIRED);
937 add_sym_1 ("zabs", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
938 NULL, gfc_simplify_abs, gfc_resolve_abs,
939 a, BT_COMPLEX, dd, REQUIRED);
941 make_alias ("cdabs", GFC_STD_GNU);
943 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
945 /* The checking function for ACCESS is called gfc_check_access_func
946 because the name gfc_check_access is already used in module.c. */
947 add_sym_2 ("access", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
948 gfc_check_access_func, NULL, gfc_resolve_access,
949 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
951 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
953 add_sym_1 ("achar", ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
954 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
955 i, BT_INTEGER, di, REQUIRED);
957 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
959 add_sym_1 ("acos", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
960 gfc_check_fn_r, gfc_simplify_acos, gfc_resolve_acos,
961 x, BT_REAL, dr, REQUIRED);
963 add_sym_1 ("dacos", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
964 NULL, gfc_simplify_acos, gfc_resolve_acos,
965 x, BT_REAL, dd, REQUIRED);
967 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
969 add_sym_1 ("acosh", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
970 gfc_check_fn_r, gfc_simplify_acosh, gfc_resolve_acosh,
971 x, BT_REAL, dr, REQUIRED);
973 add_sym_1 ("dacosh", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
974 NULL, gfc_simplify_acosh, gfc_resolve_acosh,
975 x, BT_REAL, dd, REQUIRED);
977 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_GNU);
979 add_sym_1 ("adjustl", ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
980 NULL, gfc_simplify_adjustl, NULL,
981 stg, BT_CHARACTER, dc, REQUIRED);
983 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
985 add_sym_1 ("adjustr", ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
986 NULL, gfc_simplify_adjustr, NULL,
987 stg, BT_CHARACTER, dc, REQUIRED);
989 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
991 add_sym_1 ("aimag", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
992 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
993 z, BT_COMPLEX, dz, REQUIRED);
995 make_alias ("imag", GFC_STD_GNU);
996 make_alias ("imagpart", GFC_STD_GNU);
998 add_sym_1 ("dimag", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
999 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1000 z, BT_COMPLEX, dd, REQUIRED);
1002 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1004 add_sym_2 ("aint", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1005 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1006 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1008 add_sym_1 ("dint", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1009 NULL, gfc_simplify_dint, gfc_resolve_dint,
1010 a, BT_REAL, dd, REQUIRED);
1012 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1014 add_sym_2 ("all", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F95,
1015 gfc_check_all_any, NULL, gfc_resolve_all,
1016 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1018 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1020 add_sym_1 ("allocated", NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1021 gfc_check_allocated, NULL, NULL,
1022 ar, BT_UNKNOWN, 0, REQUIRED);
1024 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1026 add_sym_2 ("anint", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1027 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1028 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1030 add_sym_1 ("dnint", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1031 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1032 a, BT_REAL, dd, REQUIRED);
1034 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1036 add_sym_2 ("any", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F95,
1037 gfc_check_all_any, NULL, gfc_resolve_any,
1038 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1040 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1042 add_sym_1 ("asin", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1043 gfc_check_fn_r, gfc_simplify_asin, gfc_resolve_asin,
1044 x, BT_REAL, dr, REQUIRED);
1046 add_sym_1 ("dasin", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1047 NULL, gfc_simplify_asin, gfc_resolve_asin,
1048 x, BT_REAL, dd, REQUIRED);
1050 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1052 add_sym_1 ("asinh", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
1053 gfc_check_fn_r, gfc_simplify_asinh, gfc_resolve_asinh,
1054 x, BT_REAL, dr, REQUIRED);
1056 add_sym_1 ("dasinh", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1057 NULL, gfc_simplify_asinh, gfc_resolve_asinh,
1058 x, BT_REAL, dd, REQUIRED);
1060 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_GNU);
1062 add_sym_2 ("associated", NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1063 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1064 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1066 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1068 add_sym_1 ("atan", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1069 gfc_check_fn_r, gfc_simplify_atan, gfc_resolve_atan,
1070 x, BT_REAL, dr, REQUIRED);
1072 add_sym_1 ("datan", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1073 NULL, gfc_simplify_atan, gfc_resolve_atan,
1074 x, BT_REAL, dd, REQUIRED);
1076 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1078 add_sym_1 ("atanh", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_GNU,
1079 gfc_check_fn_r, gfc_simplify_atanh, gfc_resolve_atanh,
1080 x, BT_REAL, dr, REQUIRED);
1082 add_sym_1 ("datanh", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1083 NULL, gfc_simplify_atanh, gfc_resolve_atanh,
1084 x, BT_REAL, dd, REQUIRED);
1086 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_GNU);
1088 add_sym_2 ("atan2", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1089 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1090 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1092 add_sym_2 ("datan2", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1093 NULL, gfc_simplify_atan2, gfc_resolve_atan2,
1094 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1096 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1098 /* Bessel and Neumann functions for G77 compatibility. */
1099 add_sym_1 ("besj0", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1100 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1101 x, BT_REAL, dr, REQUIRED);
1103 add_sym_1 ("dbesj0", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1104 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1105 x, BT_REAL, dd, REQUIRED);
1107 make_generic ("besj0", GFC_ISYM_J0, GFC_STD_GNU);
1109 add_sym_1 ("besj1", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1110 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1111 x, BT_REAL, dr, REQUIRED);
1113 add_sym_1 ("dbesj1", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1114 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1115 x, BT_REAL, dd, REQUIRED);
1117 make_generic ("besj1", GFC_ISYM_J1, GFC_STD_GNU);
1119 add_sym_2 ("besjn", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1120 gfc_check_besn, NULL, gfc_resolve_besn,
1121 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1123 add_sym_2 ("dbesjn", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1124 gfc_check_besn, NULL, gfc_resolve_besn,
1125 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1127 make_generic ("besjn", GFC_ISYM_JN, GFC_STD_GNU);
1129 add_sym_1 ("besy0", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1130 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1131 x, BT_REAL, dr, REQUIRED);
1133 add_sym_1 ("dbesy0", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1134 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1135 x, BT_REAL, dd, REQUIRED);
1137 make_generic ("besy0", GFC_ISYM_Y0, GFC_STD_GNU);
1139 add_sym_1 ("besy1", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1140 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1141 x, BT_REAL, dr, REQUIRED);
1143 add_sym_1 ("dbesy1", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1144 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1145 x, BT_REAL, dd, REQUIRED);
1147 make_generic ("besy1", GFC_ISYM_Y1, GFC_STD_GNU);
1149 add_sym_2 ("besyn", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1150 gfc_check_besn, NULL, gfc_resolve_besn,
1151 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1153 add_sym_2 ("dbesyn", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1154 gfc_check_besn, NULL, gfc_resolve_besn,
1155 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1157 make_generic ("besyn", GFC_ISYM_YN, GFC_STD_GNU);
1159 add_sym_1 ("bit_size", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1160 gfc_check_i, gfc_simplify_bit_size, NULL,
1161 i, BT_INTEGER, di, REQUIRED);
1163 make_generic ("bit_size", GFC_ISYM_NONE, GFC_STD_F95);
1165 add_sym_2 ("btest", ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1166 gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1167 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1169 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1171 add_sym_2 ("ceiling", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1172 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1173 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1175 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1177 add_sym_2 ("char", ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1178 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1179 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1181 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1183 add_sym_1 ("chdir", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1184 gfc_check_chdir, NULL, gfc_resolve_chdir,
1185 a, BT_CHARACTER, dc, REQUIRED);
1187 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1189 add_sym_2 ("chmod", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1190 gfc_check_chmod, NULL, gfc_resolve_chmod,
1191 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1193 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1195 add_sym_3 ("cmplx", ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1196 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1197 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1198 kind, BT_INTEGER, di, OPTIONAL);
1200 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1202 add_sym_0 ("command_argument_count", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
1203 GFC_STD_F2003, NULL, NULL, NULL);
1205 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1208 add_sym_2 ("complex", ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1209 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1210 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1212 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1214 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1215 complex instead of the default complex. */
1217 add_sym_2 ("dcmplx", ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1218 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1219 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1221 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1223 add_sym_1 ("conjg", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1224 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1225 z, BT_COMPLEX, dz, REQUIRED);
1227 add_sym_1 ("dconjg", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1228 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1229 z, BT_COMPLEX, dd, REQUIRED);
1231 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1233 add_sym_1 ("cos", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1234 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1235 x, BT_REAL, dr, REQUIRED);
1237 add_sym_1 ("dcos", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1238 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1239 x, BT_REAL, dd, REQUIRED);
1241 add_sym_1 ("ccos", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1242 NULL, gfc_simplify_cos, gfc_resolve_cos,
1243 x, BT_COMPLEX, dz, REQUIRED);
1245 add_sym_1 ("zcos", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1246 NULL, gfc_simplify_cos, gfc_resolve_cos,
1247 x, BT_COMPLEX, dd, REQUIRED);
1249 make_alias ("cdcos", GFC_STD_GNU);
1251 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1253 add_sym_1 ("cosh", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1254 gfc_check_fn_r, gfc_simplify_cosh, gfc_resolve_cosh,
1255 x, BT_REAL, dr, REQUIRED);
1257 add_sym_1 ("dcosh", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1258 NULL, gfc_simplify_cosh, gfc_resolve_cosh,
1259 x, BT_REAL, dd, REQUIRED);
1261 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1263 add_sym_2 ("count", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1264 gfc_check_count, NULL, gfc_resolve_count,
1265 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1267 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1269 add_sym_3 ("cshift", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1270 gfc_check_cshift, NULL, gfc_resolve_cshift,
1271 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1272 dm, BT_INTEGER, ii, OPTIONAL);
1274 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1276 add_sym_1 ("ctime", NOT_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1277 gfc_check_ctime, NULL, gfc_resolve_ctime,
1278 tm, BT_INTEGER, di, REQUIRED);
1280 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1282 add_sym_1 ("dble", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1283 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1284 a, BT_REAL, dr, REQUIRED);
1286 make_alias ("dfloat", GFC_STD_GNU);
1288 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1290 add_sym_1 ("digits", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1291 gfc_check_digits, gfc_simplify_digits, NULL,
1292 x, BT_UNKNOWN, dr, REQUIRED);
1294 make_generic ("digits", GFC_ISYM_NONE, GFC_STD_F95);
1296 add_sym_2 ("dim", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1297 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1298 x, BT_REAL, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1300 add_sym_2 ("idim", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1301 NULL, gfc_simplify_dim, gfc_resolve_dim,
1302 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1304 add_sym_2 ("ddim", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1305 NULL, gfc_simplify_dim, gfc_resolve_dim,
1306 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1308 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1310 add_sym_2 ("dot_product", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0,
1311 GFC_STD_F95, gfc_check_dot_product, NULL, gfc_resolve_dot_product,
1312 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1314 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1316 add_sym_2 ("dprod", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1317 NULL, gfc_simplify_dprod, gfc_resolve_dprod,
1318 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1320 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1322 add_sym_1 ("dreal", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1324 a, BT_COMPLEX, dd, REQUIRED);
1326 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1328 add_sym_4 ("eoshift", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1329 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1330 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1331 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1333 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1335 add_sym_1 ("epsilon", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1336 gfc_check_x, gfc_simplify_epsilon, NULL,
1337 x, BT_REAL, dr, REQUIRED);
1339 make_generic ("epsilon", GFC_ISYM_NONE, GFC_STD_F95);
1341 /* G77 compatibility for the ERF() and ERFC() functions. */
1342 add_sym_1 ("erf", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1343 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1344 x, BT_REAL, dr, REQUIRED);
1346 add_sym_1 ("derf", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1347 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1348 x, BT_REAL, dd, REQUIRED);
1350 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_GNU);
1352 add_sym_1 ("erfc", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1353 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1354 x, BT_REAL, dr, REQUIRED);
1356 add_sym_1 ("derfc", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1357 gfc_check_g77_math1, NULL, gfc_resolve_g77_math1,
1358 x, BT_REAL, dd, REQUIRED);
1360 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_GNU);
1362 /* G77 compatibility */
1363 add_sym_1 ("etime", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1364 gfc_check_etime, NULL, NULL,
1365 x, BT_REAL, 4, REQUIRED);
1367 make_alias ("dtime", GFC_STD_GNU);
1369 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1371 add_sym_1 ("exp", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1372 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1373 x, BT_REAL, dr, REQUIRED);
1375 add_sym_1 ("dexp", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1376 NULL, gfc_simplify_exp, gfc_resolve_exp,
1377 x, BT_REAL, dd, REQUIRED);
1379 add_sym_1 ("cexp", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1380 NULL, gfc_simplify_exp, gfc_resolve_exp,
1381 x, BT_COMPLEX, dz, REQUIRED);
1383 add_sym_1 ("zexp", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1384 NULL, gfc_simplify_exp, gfc_resolve_exp,
1385 x, BT_COMPLEX, dd, REQUIRED);
1387 make_alias ("cdexp", GFC_STD_GNU);
1389 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1391 add_sym_1 ("exponent", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1392 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1393 x, BT_REAL, dr, REQUIRED);
1395 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1397 add_sym_0 ("fdate", NOT_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1398 NULL, NULL, gfc_resolve_fdate);
1400 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1402 add_sym_2 ("floor", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1403 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1404 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1406 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1408 /* G77 compatible fnum */
1409 add_sym_1 ("fnum", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1410 gfc_check_fnum, NULL, gfc_resolve_fnum,
1411 ut, BT_INTEGER, di, REQUIRED);
1413 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1415 add_sym_1 ("fraction", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1416 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1417 x, BT_REAL, dr, REQUIRED);
1419 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1421 add_sym_2 ("fstat", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1422 gfc_check_fstat, NULL, gfc_resolve_fstat,
1423 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1425 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1427 add_sym_1 ("ftell", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1428 gfc_check_ftell, NULL, gfc_resolve_ftell,
1429 ut, BT_INTEGER, di, REQUIRED);
1431 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1433 add_sym_2 ("fgetc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1434 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1435 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1437 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1439 add_sym_1 ("fget", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1440 gfc_check_fgetput, NULL, gfc_resolve_fget,
1441 c, BT_CHARACTER, dc, REQUIRED);
1443 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1445 add_sym_2 ("fputc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1446 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1447 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1449 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1451 add_sym_1 ("fput", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1452 gfc_check_fgetput, NULL, gfc_resolve_fput,
1453 c, BT_CHARACTER, dc, REQUIRED);
1455 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1457 /* Unix IDs (g77 compatibility) */
1458 add_sym_1 ("getcwd", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1459 NULL, NULL, gfc_resolve_getcwd,
1460 c, BT_CHARACTER, dc, REQUIRED);
1462 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1464 add_sym_0 ("getgid", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1465 NULL, NULL, gfc_resolve_getgid);
1467 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1469 add_sym_0 ("getpid", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1470 NULL, NULL, gfc_resolve_getpid);
1472 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1474 add_sym_0 ("getuid", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1475 NULL, NULL, gfc_resolve_getuid);
1477 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1479 add_sym_1 ("hostnm", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1480 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1481 a, BT_CHARACTER, dc, REQUIRED);
1483 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1485 add_sym_1 ("huge", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1486 gfc_check_huge, gfc_simplify_huge, NULL,
1487 x, BT_UNKNOWN, dr, REQUIRED);
1489 make_generic ("huge", GFC_ISYM_NONE, GFC_STD_F95);
1491 add_sym_1 ("iachar", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1492 gfc_check_ichar_iachar, gfc_simplify_iachar, NULL,
1493 c, BT_CHARACTER, dc, REQUIRED);
1495 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1497 add_sym_2 ("iand", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1498 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1499 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1501 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1503 add_sym_2 ("and", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_GNU,
1504 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1505 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1507 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1509 add_sym_0 ("iargc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1512 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1514 add_sym_2 ("ibclr", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1515 gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1516 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1518 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1520 add_sym_3 ("ibits", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1521 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1522 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1523 ln, BT_INTEGER, di, REQUIRED);
1525 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1527 add_sym_2 ("ibset", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1528 gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1529 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1531 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1533 add_sym_1 ("ichar", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1534 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1535 c, BT_CHARACTER, dc, REQUIRED);
1537 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1539 add_sym_2 ("ieor", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1540 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1541 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1543 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1545 add_sym_2 ("xor", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_GNU,
1546 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1547 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1549 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1551 add_sym_0 ("ierrno", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1552 NULL, NULL, gfc_resolve_ierrno);
1554 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1556 /* The resolution function for INDEX is called gfc_resolve_index_func
1557 because the name gfc_resolve_index is already used in resolve.c. */
1558 add_sym_3 ("index", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1559 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1560 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1561 bck, BT_LOGICAL, dl, OPTIONAL);
1563 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1565 add_sym_2 ("int", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1566 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1567 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1569 add_sym_1 ("ifix", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1570 NULL, gfc_simplify_ifix, NULL,
1571 a, BT_REAL, dr, REQUIRED);
1573 add_sym_1 ("idint", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1574 NULL, gfc_simplify_idint, NULL,
1575 a, BT_REAL, dd, REQUIRED);
1577 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1579 add_sym_1 ("int2", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1580 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1581 a, BT_REAL, dr, REQUIRED);
1583 make_alias ("short", GFC_STD_GNU);
1585 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1587 add_sym_1 ("int8", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1588 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1589 a, BT_REAL, dr, REQUIRED);
1591 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1593 add_sym_1 ("long", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1594 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1595 a, BT_REAL, dr, REQUIRED);
1597 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1599 add_sym_2 ("ior", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1600 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1601 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1603 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1605 add_sym_2 ("or", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_GNU,
1606 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1607 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1609 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1611 /* The following function is for G77 compatibility. */
1612 add_sym_1 ("irand", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1613 gfc_check_irand, NULL, NULL,
1614 i, BT_INTEGER, 4, OPTIONAL);
1616 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1618 add_sym_1 ("isatty", NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1619 gfc_check_isatty, NULL, gfc_resolve_isatty,
1620 ut, BT_INTEGER, di, REQUIRED);
1622 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1624 add_sym_2 ("rshift", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1625 gfc_check_ishft, NULL, gfc_resolve_rshift,
1626 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1628 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1630 add_sym_2 ("lshift", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1631 gfc_check_ishft, NULL, gfc_resolve_lshift,
1632 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1634 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1636 add_sym_2 ("ishft", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1637 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1638 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1640 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1642 add_sym_3 ("ishftc", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1643 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1644 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1645 sz, BT_INTEGER, di, OPTIONAL);
1647 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1649 add_sym_2 ("kill", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1650 gfc_check_kill, NULL, gfc_resolve_kill,
1651 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1653 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1655 add_sym_1 ("kind", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1656 gfc_check_kind, gfc_simplify_kind, NULL,
1657 x, BT_REAL, dr, REQUIRED);
1659 make_generic ("kind", GFC_ISYM_NONE, GFC_STD_F95);
1661 add_sym_2 ("lbound", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1662 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1663 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL);
1665 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1667 add_sym_1 ("len", NOT_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1668 NULL, gfc_simplify_len, gfc_resolve_len,
1669 stg, BT_CHARACTER, dc, REQUIRED);
1671 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1673 add_sym_1 ("len_trim", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1674 NULL, gfc_simplify_len_trim, gfc_resolve_len_trim,
1675 stg, BT_CHARACTER, dc, REQUIRED);
1677 make_alias ("lnblnk", GFC_STD_GNU);
1679 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1681 add_sym_2 ("lge", ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1682 NULL, gfc_simplify_lge, NULL,
1683 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1685 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1687 add_sym_2 ("lgt", ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1688 NULL, gfc_simplify_lgt, NULL,
1689 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1691 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1693 add_sym_2 ("lle", ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1694 NULL, gfc_simplify_lle, NULL,
1695 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1697 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1699 add_sym_2 ("llt", ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F77,
1700 NULL, gfc_simplify_llt, NULL,
1701 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1703 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1705 add_sym_2 ("link", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1706 gfc_check_link, NULL, gfc_resolve_link,
1707 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
1709 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1711 add_sym_1 ("log", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1712 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1713 x, BT_REAL, dr, REQUIRED);
1715 add_sym_1 ("alog", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1716 NULL, gfc_simplify_log, gfc_resolve_log,
1717 x, BT_REAL, dr, REQUIRED);
1719 add_sym_1 ("dlog", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1720 NULL, gfc_simplify_log, gfc_resolve_log,
1721 x, BT_REAL, dd, REQUIRED);
1723 add_sym_1 ("clog", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1724 NULL, gfc_simplify_log, gfc_resolve_log,
1725 x, BT_COMPLEX, dz, REQUIRED);
1727 add_sym_1 ("zlog", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1728 NULL, gfc_simplify_log, gfc_resolve_log,
1729 x, BT_COMPLEX, dd, REQUIRED);
1731 make_alias ("cdlog", GFC_STD_GNU);
1733 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
1735 add_sym_1 ("log10", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1736 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1737 x, BT_REAL, dr, REQUIRED);
1739 add_sym_1 ("alog10", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1740 NULL, gfc_simplify_log10, gfc_resolve_log10,
1741 x, BT_REAL, dr, REQUIRED);
1743 add_sym_1 ("dlog10", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1744 NULL, gfc_simplify_log10, gfc_resolve_log10,
1745 x, BT_REAL, dd, REQUIRED);
1747 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
1749 add_sym_2 ("logical", ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1750 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1751 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1753 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
1755 add_sym_2 ("lstat", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1756 gfc_check_stat, NULL, gfc_resolve_lstat,
1757 a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1759 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
1761 add_sym_1 ("malloc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1762 gfc_check_malloc, NULL, gfc_resolve_malloc, a, BT_INTEGER, di,
1765 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
1767 add_sym_2 ("matmul", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1768 gfc_check_matmul, NULL, gfc_resolve_matmul,
1769 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
1771 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
1773 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
1774 int(max). The max function must take at least two arguments. */
1776 add_sym_1m ("max", ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1777 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1778 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
1780 add_sym_1m ("max0", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1781 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1782 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1784 add_sym_1m ("amax0", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1785 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1786 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1788 add_sym_1m ("amax1", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1789 gfc_check_min_max_real, gfc_simplify_max, NULL,
1790 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1792 add_sym_1m ("max1", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1793 gfc_check_min_max_real, gfc_simplify_max, NULL,
1794 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1796 add_sym_1m ("dmax1", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1797 gfc_check_min_max_double, gfc_simplify_max, NULL,
1798 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1800 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
1802 add_sym_1 ("maxexponent", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
1803 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
1804 x, BT_UNKNOWN, dr, REQUIRED);
1806 make_generic ("maxexponent", GFC_ISYM_NONE, GFC_STD_F95);
1808 add_sym_3ml ("maxloc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1809 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1810 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1811 msk, BT_LOGICAL, dl, OPTIONAL);
1813 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
1815 add_sym_3red ("maxval", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1816 gfc_check_minval_maxval, NULL, gfc_resolve_maxval,
1817 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1818 msk, BT_LOGICAL, dl, OPTIONAL);
1820 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
1822 add_sym_0 ("mclock", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1823 NULL, NULL, gfc_resolve_mclock);
1825 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
1827 add_sym_0 ("mclock8", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1828 NULL, NULL, gfc_resolve_mclock8);
1830 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
1832 add_sym_3 ("merge", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1833 gfc_check_merge, NULL, gfc_resolve_merge,
1834 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
1835 msk, BT_LOGICAL, dl, REQUIRED);
1837 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
1839 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
1842 add_sym_1m ("min", ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
1843 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
1844 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1846 add_sym_1m ("min0", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1847 gfc_check_min_max_integer, gfc_simplify_min, NULL,
1848 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1850 add_sym_1m ("amin0", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1851 gfc_check_min_max_integer, gfc_simplify_min, NULL,
1852 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
1854 add_sym_1m ("amin1", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1855 gfc_check_min_max_real, gfc_simplify_min, NULL,
1856 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1858 add_sym_1m ("min1", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1859 gfc_check_min_max_real, gfc_simplify_min, NULL,
1860 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
1862 add_sym_1m ("dmin1", ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1863 gfc_check_min_max_double, gfc_simplify_min, NULL,
1864 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
1866 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
1868 add_sym_1 ("minexponent", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
1869 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
1870 x, BT_UNKNOWN, dr, REQUIRED);
1872 make_generic ("minexponent", GFC_ISYM_NONE, GFC_STD_F95);
1874 add_sym_3ml ("minloc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1875 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
1876 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1877 msk, BT_LOGICAL, dl, OPTIONAL);
1879 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
1881 add_sym_3red ("minval", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1882 gfc_check_minval_maxval, NULL, gfc_resolve_minval,
1883 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1884 msk, BT_LOGICAL, dl, OPTIONAL);
1886 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
1888 add_sym_2 ("mod", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1889 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1890 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
1892 add_sym_2 ("amod", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1893 NULL, gfc_simplify_mod, gfc_resolve_mod,
1894 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
1896 add_sym_2 ("dmod", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1897 NULL, gfc_simplify_mod, gfc_resolve_mod,
1898 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
1900 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
1902 add_sym_2 ("modulo", ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
1903 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1904 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
1906 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
1908 add_sym_2 ("nearest", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1909 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1910 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
1912 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
1914 add_sym_1 ("new_line", NOT_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc,
1915 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
1916 a, BT_CHARACTER, dc, REQUIRED);
1918 add_sym_2 ("nint", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1919 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1920 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1922 add_sym_1 ("idnint", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1923 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1924 a, BT_REAL, dd, REQUIRED);
1926 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
1928 add_sym_1 ("not", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1929 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1930 i, BT_INTEGER, di, REQUIRED);
1932 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
1934 add_sym_1 ("null", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1935 gfc_check_null, gfc_simplify_null, NULL,
1936 mo, BT_INTEGER, di, OPTIONAL);
1938 make_generic ("null", GFC_ISYM_NONE, GFC_STD_F95);
1940 add_sym_3 ("pack", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1941 gfc_check_pack, NULL, gfc_resolve_pack,
1942 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
1943 v, BT_REAL, dr, OPTIONAL);
1945 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
1947 add_sym_1 ("precision", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1948 gfc_check_precision, gfc_simplify_precision, NULL,
1949 x, BT_UNKNOWN, 0, REQUIRED);
1951 make_generic ("precision", GFC_ISYM_NONE, GFC_STD_F95);
1953 add_sym_1 ("present", NOT_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1954 gfc_check_present, NULL, NULL,
1955 a, BT_REAL, dr, REQUIRED);
1957 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
1959 add_sym_3red ("product", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1960 gfc_check_product_sum, NULL, gfc_resolve_product,
1961 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1962 msk, BT_LOGICAL, dl, OPTIONAL);
1964 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
1966 add_sym_1 ("radix", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1967 gfc_check_radix, gfc_simplify_radix, NULL,
1968 x, BT_UNKNOWN, 0, REQUIRED);
1970 make_generic ("radix", GFC_ISYM_NONE, GFC_STD_F95);
1972 /* The following function is for G77 compatibility. */
1973 add_sym_1 ("rand", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1974 gfc_check_rand, NULL, NULL,
1975 i, BT_INTEGER, 4, OPTIONAL);
1977 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
1978 use slightly different shoddy multiplicative congruential PRNG. */
1979 make_alias ("ran", GFC_STD_GNU);
1981 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
1983 add_sym_1 ("range", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1984 gfc_check_range, gfc_simplify_range, NULL,
1985 x, BT_REAL, dr, REQUIRED);
1987 make_generic ("range", GFC_ISYM_NONE, GFC_STD_F95);
1989 add_sym_2 ("real", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1990 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1991 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1993 /* This provides compatibility with g77. */
1994 add_sym_1 ("realpart", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1995 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
1996 a, BT_UNKNOWN, dr, REQUIRED);
1998 add_sym_1 ("float", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1999 gfc_check_i, gfc_simplify_float, NULL,
2000 a, BT_INTEGER, di, REQUIRED);
2002 add_sym_1 ("sngl", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2003 NULL, gfc_simplify_sngl, NULL,
2004 a, BT_REAL, dd, REQUIRED);
2006 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2008 add_sym_2 ("rename", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2009 gfc_check_rename, NULL, gfc_resolve_rename,
2010 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2012 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2014 add_sym_2 ("repeat", NOT_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2015 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2016 stg, BT_CHARACTER, dc, REQUIRED, n, BT_INTEGER, di, REQUIRED);
2018 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2020 add_sym_4 ("reshape", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2021 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2022 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2023 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2025 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2027 add_sym_1 ("rrspacing", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2028 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2029 x, BT_REAL, dr, REQUIRED);
2031 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2033 add_sym_2 ("scale", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2034 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2035 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2037 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2039 add_sym_3 ("scan", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2040 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2041 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2042 bck, BT_LOGICAL, dl, OPTIONAL);
2044 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2046 /* Added for G77 compatibility garbage. */
2047 add_sym_0 ("second", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2050 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2052 /* Added for G77 compatibility. */
2053 add_sym_1 ("secnds", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2054 gfc_check_secnds, NULL, gfc_resolve_secnds,
2055 x, BT_REAL, dr, REQUIRED);
2057 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2059 add_sym_1 ("selected_int_kind", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
2060 GFC_STD_F95, gfc_check_selected_int_kind,
2061 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2063 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2065 add_sym_2 ("selected_real_kind", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
2066 GFC_STD_F95, gfc_check_selected_real_kind,
2067 gfc_simplify_selected_real_kind, NULL,
2068 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2070 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2072 add_sym_2 ("set_exponent", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2073 gfc_check_set_exponent, gfc_simplify_set_exponent,
2074 gfc_resolve_set_exponent,
2075 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2077 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2079 add_sym_1 ("shape", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2080 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2081 src, BT_REAL, dr, REQUIRED);
2083 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2085 add_sym_2 ("sign", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2086 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2087 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2089 add_sym_2 ("isign", ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2090 NULL, gfc_simplify_sign, gfc_resolve_sign,
2091 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2093 add_sym_2 ("dsign", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2094 NULL, gfc_simplify_sign, gfc_resolve_sign,
2095 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2097 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2099 add_sym_2 ("signal", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2100 gfc_check_signal, NULL, gfc_resolve_signal,
2101 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2103 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2105 add_sym_1 ("sin", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2106 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2107 x, BT_REAL, dr, REQUIRED);
2109 add_sym_1 ("dsin", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2110 NULL, gfc_simplify_sin, gfc_resolve_sin,
2111 x, BT_REAL, dd, REQUIRED);
2113 add_sym_1 ("csin", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2114 NULL, gfc_simplify_sin, gfc_resolve_sin,
2115 x, BT_COMPLEX, dz, REQUIRED);
2117 add_sym_1 ("zsin", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2118 NULL, gfc_simplify_sin, gfc_resolve_sin,
2119 x, BT_COMPLEX, dd, REQUIRED);
2121 make_alias ("cdsin", GFC_STD_GNU);
2123 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2125 add_sym_1 ("sinh", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2126 gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
2127 x, BT_REAL, dr, REQUIRED);
2129 add_sym_1 ("dsinh", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2130 NULL, gfc_simplify_sinh, gfc_resolve_sinh,
2131 x, BT_REAL, dd, REQUIRED);
2133 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2135 add_sym_2 ("size", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2136 gfc_check_size, gfc_simplify_size, NULL,
2137 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2139 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2141 add_sym_1 ("spacing", ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2142 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2143 x, BT_REAL, dr, REQUIRED);
2145 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2147 add_sym_3 ("spread", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2148 gfc_check_spread, NULL, gfc_resolve_spread,
2149 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2150 n, BT_INTEGER, di, REQUIRED);
2152 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2154 add_sym_1 ("sqrt", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2155 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2156 x, BT_REAL, dr, REQUIRED);
2158 add_sym_1 ("dsqrt", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2159 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2160 x, BT_REAL, dd, REQUIRED);
2162 add_sym_1 ("csqrt", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2163 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2164 x, BT_COMPLEX, dz, REQUIRED);
2166 add_sym_1 ("zsqrt", ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2167 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2168 x, BT_COMPLEX, dd, REQUIRED);
2170 make_alias ("cdsqrt", GFC_STD_GNU);
2172 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2174 add_sym_2 ("stat", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2175 gfc_check_stat, NULL, gfc_resolve_stat,
2176 a, BT_CHARACTER, dc, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2178 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2180 add_sym_3red ("sum", NOT_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F95,
2181 gfc_check_product_sum, NULL, gfc_resolve_sum,
2182 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2183 msk, BT_LOGICAL, dl, OPTIONAL);
2185 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2187 add_sym_2 ("symlnk", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2188 gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2189 a, BT_CHARACTER, dc, REQUIRED, b, BT_CHARACTER, dc, REQUIRED);
2191 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2193 add_sym_1 ("system", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2195 c, BT_CHARACTER, dc, REQUIRED);
2197 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2199 add_sym_1 ("tan", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2200 gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
2201 x, BT_REAL, dr, REQUIRED);
2203 add_sym_1 ("dtan", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2204 NULL, gfc_simplify_tan, gfc_resolve_tan,
2205 x, BT_REAL, dd, REQUIRED);
2207 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2209 add_sym_1 ("tanh", ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2210 gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
2211 x, BT_REAL, dr, REQUIRED);
2213 add_sym_1 ("dtanh", ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2214 NULL, gfc_simplify_tanh, gfc_resolve_tanh,
2215 x, BT_REAL, dd, REQUIRED);
2217 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2219 add_sym_0 ("time", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2220 NULL, NULL, gfc_resolve_time);
2222 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2224 add_sym_0 ("time8", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2225 NULL, NULL, gfc_resolve_time8);
2227 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2229 add_sym_1 ("tiny", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2230 gfc_check_x, gfc_simplify_tiny, NULL,
2231 x, BT_REAL, dr, REQUIRED);
2233 make_generic ("tiny", GFC_ISYM_NONE, GFC_STD_F95);
2235 add_sym_3 ("transfer", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2236 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2237 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2238 sz, BT_INTEGER, di, OPTIONAL);
2240 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2242 add_sym_1 ("transpose", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2243 gfc_check_transpose, NULL, gfc_resolve_transpose,
2244 m, BT_REAL, dr, REQUIRED);
2246 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2248 add_sym_1 ("trim", NOT_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2249 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2250 stg, BT_CHARACTER, dc, REQUIRED);
2252 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2254 add_sym_1 ("ttynam", NOT_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2255 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2256 ut, BT_INTEGER, di, REQUIRED);
2258 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2260 add_sym_2 ("ubound", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2261 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2262 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2264 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2266 /* g77 compatibility for UMASK. */
2267 add_sym_1 ("umask", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2268 gfc_check_umask, NULL, gfc_resolve_umask,
2269 a, BT_INTEGER, di, REQUIRED);
2271 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2273 /* g77 compatibility for UNLINK. */
2274 add_sym_1 ("unlink", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2275 gfc_check_unlink, NULL, gfc_resolve_unlink,
2276 a, BT_CHARACTER, dc, REQUIRED);
2278 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2280 add_sym_3 ("unpack", NOT_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2281 gfc_check_unpack, NULL, gfc_resolve_unpack,
2282 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2283 f, BT_REAL, dr, REQUIRED);
2285 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2287 add_sym_3 ("verify", ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2288 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2289 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2290 bck, BT_LOGICAL, dl, OPTIONAL);
2292 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2294 add_sym_1 ("loc", NOT_ELEMENTAL, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
2295 gfc_check_loc, NULL, gfc_resolve_loc,
2296 ar, BT_UNKNOWN, 0, REQUIRED);
2298 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2302 /* Add intrinsic subroutines. */
2305 add_subroutines (void)
2307 /* Argument names as in the standard (to be used as argument keywords). */
2309 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2310 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2311 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2312 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2313 *com = "command", *length = "length", *st = "status",
2314 *val = "value", *num = "number", *name = "name",
2315 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2316 *sec = "seconds", *res = "result", *of = "offset", *md = "mode";
2318 int di, dr, dc, dl, ii;
2320 di = gfc_default_integer_kind;
2321 dr = gfc_default_real_kind;
2322 dc = gfc_default_character_kind;
2323 dl = gfc_default_logical_kind;
2324 ii = gfc_index_integer_kind;
2326 add_sym_0s ("abort", GFC_STD_GNU, NULL);
2328 if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2331 add_sym_1s ("cpu_time", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2332 gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
2333 tm, BT_REAL, dr, REQUIRED);
2335 /* More G77 compatibility garbage. */
2336 add_sym_2s ("ctime", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2337 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2338 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2340 add_sym_1s ("idate", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2341 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2342 vl, BT_INTEGER, 4, REQUIRED);
2344 add_sym_1s ("itime", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2345 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2346 vl, BT_INTEGER, 4, REQUIRED);
2348 add_sym_2s ("ltime", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2349 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2350 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2352 add_sym_2s ("gmtime", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2353 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2354 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2356 add_sym_1s ("second", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2357 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2358 tm, BT_REAL, dr, REQUIRED);
2360 add_sym_2s ("chdir", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2361 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2362 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2364 add_sym_3s ("chmod", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2365 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2366 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2367 st, BT_INTEGER, di, OPTIONAL);
2369 add_sym_4s ("date_and_time", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2370 gfc_check_date_and_time, NULL, NULL,
2371 dt, BT_CHARACTER, dc, OPTIONAL, tm, BT_CHARACTER, dc, OPTIONAL,
2372 zn, BT_CHARACTER, dc, OPTIONAL, vl, BT_INTEGER, di, OPTIONAL);
2374 /* More G77 compatibility garbage. */
2375 add_sym_2s ("etime", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2376 gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2377 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2379 add_sym_2s ("dtime", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2380 gfc_check_etime_sub, NULL, gfc_resolve_etime_sub,
2381 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2383 add_sym_1s ("fdate", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2384 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2385 dt, BT_CHARACTER, dc, REQUIRED);
2387 add_sym_1s ("gerror", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2388 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2391 add_sym_2s ("getcwd", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2392 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2393 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2395 add_sym_2s ("getenv", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2397 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2400 add_sym_2s ("getarg", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2401 NULL, NULL, gfc_resolve_getarg,
2402 c, BT_INTEGER, di, REQUIRED, vl, BT_CHARACTER, dc, REQUIRED);
2404 add_sym_1s ("getlog", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2405 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2408 /* F2003 commandline routines. */
2410 add_sym_3s ("get_command", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F2003,
2411 NULL, NULL, gfc_resolve_get_command,
2412 com, BT_CHARACTER, dc, OPTIONAL,
2413 length, BT_INTEGER, di, OPTIONAL,
2414 st, BT_INTEGER, di, OPTIONAL);
2416 add_sym_4s ("get_command_argument", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F2003,
2417 NULL, NULL, gfc_resolve_get_command_argument,
2418 num, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, OPTIONAL,
2419 length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL);
2421 /* F2003 subroutine to get environment variables. */
2423 add_sym_5s ("get_environment_variable", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F2003,
2424 NULL, NULL, gfc_resolve_get_environment_variable,
2425 name, BT_CHARACTER, dc, REQUIRED,
2426 val, BT_CHARACTER, dc, OPTIONAL,
2427 length, BT_INTEGER, di, OPTIONAL, st, BT_INTEGER, di, OPTIONAL,
2428 trim_name, BT_LOGICAL, dl, OPTIONAL);
2430 add_sym_2s ("move_alloc", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F2003,
2431 gfc_check_move_alloc, NULL, NULL,
2432 f, BT_UNKNOWN, 0, REQUIRED,
2433 t, BT_UNKNOWN, 0, REQUIRED);
2435 add_sym_5s ("mvbits", ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2436 gfc_check_mvbits, gfc_simplify_mvbits, gfc_resolve_mvbits,
2437 f, BT_INTEGER, di, REQUIRED, fp, BT_INTEGER, di, REQUIRED,
2438 ln, BT_INTEGER, di, REQUIRED, t, BT_INTEGER, di, REQUIRED,
2439 tp, BT_INTEGER, di, REQUIRED);
2441 add_sym_1s ("random_number", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2442 gfc_check_random_number, NULL, gfc_resolve_random_number,
2443 h, BT_REAL, dr, REQUIRED);
2445 add_sym_3s ("random_seed", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2446 gfc_check_random_seed, NULL, NULL,
2447 sz, BT_INTEGER, di, OPTIONAL, pt, BT_INTEGER, di, OPTIONAL,
2448 gt, BT_INTEGER, di, OPTIONAL);
2450 /* More G77 compatibility garbage. */
2451 add_sym_3s ("alarm", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2452 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2453 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2454 st, BT_INTEGER, di, OPTIONAL);
2456 add_sym_1s ("srand", NOT_ELEMENTAL, BT_UNKNOWN, di, GFC_STD_GNU,
2457 gfc_check_srand, NULL, gfc_resolve_srand,
2458 c, BT_INTEGER, 4, REQUIRED);
2460 add_sym_1s ("exit", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2461 gfc_check_exit, NULL, gfc_resolve_exit,
2462 st, BT_INTEGER, di, OPTIONAL);
2464 if ((gfc_option.allow_std & GFC_STD_GNU) || gfc_option.flag_all_intrinsics)
2467 add_sym_3s ("fgetc", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2468 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2469 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2470 st, BT_INTEGER, di, OPTIONAL);
2472 add_sym_2s ("fget", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2473 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2474 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2476 add_sym_1s ("flush", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2477 gfc_check_flush, NULL, gfc_resolve_flush,
2478 c, BT_INTEGER, di, OPTIONAL);
2480 add_sym_3s ("fputc", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2481 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2482 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2483 st, BT_INTEGER, di, OPTIONAL);
2485 add_sym_2s ("fput", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2486 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2487 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2489 add_sym_1s ("free", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_free,
2490 NULL, gfc_resolve_free, c, BT_INTEGER, ii, REQUIRED);
2492 add_sym_2s ("ftell", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2493 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2494 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2496 add_sym_2s ("hostnm", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2497 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2498 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2500 add_sym_3s ("kill", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2501 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2502 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2504 add_sym_3s ("link", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2505 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2506 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2507 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2509 add_sym_1s ("perror", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2510 gfc_check_perror, NULL, gfc_resolve_perror,
2511 c, BT_CHARACTER, dc, REQUIRED);
2513 add_sym_3s ("rename", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2514 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2515 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2516 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2518 add_sym_1s ("sleep", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2519 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2520 val, BT_CHARACTER, dc, REQUIRED);
2522 add_sym_3s ("fstat", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2523 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2524 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2525 st, BT_INTEGER, di, OPTIONAL);
2527 add_sym_3s ("lstat", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2528 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2529 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2530 st, BT_INTEGER, di, OPTIONAL);
2532 add_sym_3s ("stat", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2533 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2534 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2535 st, BT_INTEGER, di, OPTIONAL);
2537 add_sym_3s ("signal", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2538 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2539 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2540 st, BT_INTEGER, di, OPTIONAL);
2542 add_sym_3s ("symlnk", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2543 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2544 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER,
2545 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2547 add_sym_2s ("system", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2548 NULL, NULL, gfc_resolve_system_sub,
2549 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2551 add_sym_3s ("system_clock", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_F95,
2552 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2553 c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL,
2554 cm, BT_INTEGER, di, OPTIONAL);
2556 add_sym_2s ("ttynam", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2557 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2558 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2560 add_sym_2s ("umask", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2561 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2562 val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL);
2564 add_sym_2s ("unlink", NOT_ELEMENTAL, BT_UNKNOWN, 0, GFC_STD_GNU,
2565 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2566 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2570 /* Add a function to the list of conversion symbols. */
2573 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2575 gfc_typespec from, to;
2576 gfc_intrinsic_sym *sym;
2578 if (sizing == SZ_CONVS)
2584 gfc_clear_ts (&from);
2585 from.type = from_type;
2586 from.kind = from_kind;
2592 sym = conversion + nconv;
2594 sym->name = conv_name (&from, &to);
2595 sym->lib_name = sym->name;
2596 sym->simplify.cc = gfc_convert_constant;
2597 sym->standard = standard;
2600 sym->generic_id = GFC_ISYM_CONVERSION;
2606 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2607 functions by looping over the kind tables. */
2610 add_conversions (void)
2614 /* Integer-Integer conversions. */
2615 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2616 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2621 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2622 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2625 /* Integer-Real/Complex conversions. */
2626 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2627 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2629 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2630 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2632 add_conv (BT_REAL, gfc_real_kinds[j].kind,
2633 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2635 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2636 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2638 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2639 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2642 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2644 /* Hollerith-Integer conversions. */
2645 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2646 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2647 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2648 /* Hollerith-Real conversions. */
2649 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2650 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2651 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2652 /* Hollerith-Complex conversions. */
2653 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2654 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2655 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2657 /* Hollerith-Character conversions. */
2658 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2659 gfc_default_character_kind, GFC_STD_LEGACY);
2661 /* Hollerith-Logical conversions. */
2662 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2663 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2664 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2667 /* Real/Complex - Real/Complex conversions. */
2668 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2669 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2673 add_conv (BT_REAL, gfc_real_kinds[i].kind,
2674 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2676 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2677 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2680 add_conv (BT_REAL, gfc_real_kinds[i].kind,
2681 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2683 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
2684 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2687 /* Logical/Logical kind conversion. */
2688 for (i = 0; gfc_logical_kinds[i].kind; i++)
2689 for (j = 0; gfc_logical_kinds[j].kind; j++)
2694 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
2695 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
2698 /* Integer-Logical and Logical-Integer conversions. */
2699 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2700 for (i=0; gfc_integer_kinds[i].kind; i++)
2701 for (j=0; gfc_logical_kinds[j].kind; j++)
2703 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2704 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
2705 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
2706 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2711 /* Initialize the table of intrinsics. */
2713 gfc_intrinsic_init_1 (void)
2717 nargs = nfunc = nsub = nconv = 0;
2719 /* Create a namespace to hold the resolved intrinsic symbols. */
2720 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
2729 functions = gfc_getmem (sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
2730 + sizeof (gfc_intrinsic_arg) * nargs);
2732 next_sym = functions;
2733 subroutines = functions + nfunc;
2735 conversion = gfc_getmem (sizeof (gfc_intrinsic_sym) * nconv);
2737 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
2739 sizing = SZ_NOTHING;
2746 /* Set the pure flag. All intrinsic functions are pure, and
2747 intrinsic subroutines are pure if they are elemental. */
2749 for (i = 0; i < nfunc; i++)
2750 functions[i].pure = 1;
2752 for (i = 0; i < nsub; i++)
2753 subroutines[i].pure = subroutines[i].elemental;
2758 gfc_intrinsic_done_1 (void)
2760 gfc_free (functions);
2761 gfc_free (conversion);
2762 gfc_free_namespace (gfc_intrinsic_namespace);
2766 /******** Subroutines to check intrinsic interfaces ***********/
2768 /* Given a formal argument list, remove any NULL arguments that may
2769 have been left behind by a sort against some formal argument list. */
2772 remove_nullargs (gfc_actual_arglist **ap)
2774 gfc_actual_arglist *head, *tail, *next;
2778 for (head = *ap; head; head = next)
2782 if (head->expr == NULL && !head->label)
2785 gfc_free_actual_arglist (head);
2804 /* Given an actual arglist and a formal arglist, sort the actual
2805 arglist so that its arguments are in a one-to-one correspondence
2806 with the format arglist. Arguments that are not present are given
2807 a blank gfc_actual_arglist structure. If something is obviously
2808 wrong (say, a missing required argument) we abort sorting and
2812 sort_actual (const char *name, gfc_actual_arglist **ap,
2813 gfc_intrinsic_arg *formal, locus *where)
2815 gfc_actual_arglist *actual, *a;
2816 gfc_intrinsic_arg *f;
2818 remove_nullargs (ap);
2821 for (f = formal; f; f = f->next)
2827 if (f == NULL && a == NULL) /* No arguments */
2831 { /* Put the nonkeyword arguments in a 1:1 correspondence */
2837 if (a->name != NULL)
2849 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
2853 /* Associate the remaining actual arguments, all of which have
2854 to be keyword arguments. */
2855 for (; a; a = a->next)
2857 for (f = formal; f; f = f->next)
2858 if (strcmp (a->name, f->name) == 0)
2863 if (a->name[0] == '%')
2864 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
2865 "are not allowed in this context at %L", where);
2867 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
2868 a->name, name, where);
2872 if (f->actual != NULL)
2874 gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
2875 f->name, name, where);
2883 /* At this point, all unmatched formal args must be optional. */
2884 for (f = formal; f; f = f->next)
2886 if (f->actual == NULL && f->optional == 0)
2888 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
2889 f->name, name, where);
2895 /* Using the formal argument list, string the actual argument list
2896 together in a way that corresponds with the formal list. */
2899 for (f = formal; f; f = f->next)
2901 if (f->actual && f->actual->label != NULL && f->ts.type)
2903 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
2907 if (f->actual == NULL)
2909 a = gfc_get_actual_arglist ();
2910 a->missing_arg_type = f->ts.type;
2922 actual->next = NULL; /* End the sorted argument list. */
2928 /* Compare an actual argument list with an intrinsic's formal argument
2929 list. The lists are checked for agreement of type. We don't check
2930 for arrayness here. */
2933 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
2936 gfc_actual_arglist *actual;
2937 gfc_intrinsic_arg *formal;
2940 formal = sym->formal;
2944 for (; formal; formal = formal->next, actual = actual->next, i++)
2946 if (actual->expr == NULL)
2949 if (!gfc_compare_types (&formal->ts, &actual->expr->ts))
2952 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
2953 "be %s, not %s", gfc_current_intrinsic_arg[i],
2954 gfc_current_intrinsic, &actual->expr->where,
2955 gfc_typename (&formal->ts),
2956 gfc_typename (&actual->expr->ts));
2965 /* Given a pointer to an intrinsic symbol and an expression node that
2966 represent the function call to that subroutine, figure out the type
2967 of the result. This may involve calling a resolution subroutine. */
2970 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
2972 gfc_expr *a1, *a2, *a3, *a4, *a5;
2973 gfc_actual_arglist *arg;
2975 if (specific->resolve.f1 == NULL)
2977 if (e->value.function.name == NULL)
2978 e->value.function.name = specific->lib_name;
2980 if (e->ts.type == BT_UNKNOWN)
2981 e->ts = specific->ts;
2985 arg = e->value.function.actual;
2987 /* Special case hacks for MIN and MAX. */
2988 if (specific->resolve.f1m == gfc_resolve_max
2989 || specific->resolve.f1m == gfc_resolve_min)
2991 (*specific->resolve.f1m) (e, arg);
2997 (*specific->resolve.f0) (e);
3006 (*specific->resolve.f1) (e, a1);
3015 (*specific->resolve.f2) (e, a1, a2);
3024 (*specific->resolve.f3) (e, a1, a2, a3);
3033 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3042 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3046 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3050 /* Given an intrinsic symbol node and an expression node, call the
3051 simplification function (if there is one), perhaps replacing the
3052 expression with something simpler. We return FAILURE on an error
3053 of the simplification, SUCCESS if the simplification worked, even
3054 if nothing has changed in the expression itself. */
3057 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3059 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3060 gfc_actual_arglist *arg;
3062 /* Check the arguments if there are Hollerith constants. We deal with
3063 them at run-time. */
3064 for (arg = e->value.function.actual; arg != NULL; arg = arg->next)
3066 if (arg->expr && arg->expr->from_H)
3072 /* Max and min require special handling due to the variable number
3074 if (specific->simplify.f1 == gfc_simplify_min)
3076 result = gfc_simplify_min (e);
3080 if (specific->simplify.f1 == gfc_simplify_max)
3082 result = gfc_simplify_max (e);
3086 if (specific->simplify.f1 == NULL)
3092 arg = e->value.function.actual;
3096 result = (*specific->simplify.f0) ();
3103 if (specific->simplify.cc == gfc_convert_constant)
3105 result = gfc_convert_constant (a1, specific->ts.type, specific->ts.kind);
3109 /* TODO: Warn if -pedantic and initialization expression and arg
3110 types not integer or character */
3113 result = (*specific->simplify.f1) (a1);
3120 result = (*specific->simplify.f2) (a1, a2);
3127 result = (*specific->simplify.f3) (a1, a2, a3);
3134 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3141 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3144 ("do_simplify(): Too many args for intrinsic");
3151 if (result == &gfc_bad_expr)
3155 resolve_intrinsic (specific, e); /* Must call at run-time */
3158 result->where = e->where;
3159 gfc_replace_expr (e, result);
3166 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3167 error messages. This subroutine returns FAILURE if a subroutine
3168 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3169 list cannot match any intrinsic. */
3172 init_arglist (gfc_intrinsic_sym *isym)
3174 gfc_intrinsic_arg *formal;
3177 gfc_current_intrinsic = isym->name;
3180 for (formal = isym->formal; formal; formal = formal->next)
3182 if (i >= MAX_INTRINSIC_ARGS)
3183 gfc_internal_error ("init_arglist(): too many arguments");
3184 gfc_current_intrinsic_arg[i++] = formal->name;
3189 /* Given a pointer to an intrinsic symbol and an expression consisting
3190 of a function call, see if the function call is consistent with the
3191 intrinsic's formal argument list. Return SUCCESS if the expression
3192 and intrinsic match, FAILURE otherwise. */
3195 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3197 gfc_actual_arglist *arg, **ap;
3201 ap = &expr->value.function.actual;
3203 init_arglist (specific);
3205 /* Don't attempt to sort the argument list for min or max. */
3206 if (specific->check.f1m == gfc_check_min_max
3207 || specific->check.f1m == gfc_check_min_max_integer
3208 || specific->check.f1m == gfc_check_min_max_real
3209 || specific->check.f1m == gfc_check_min_max_double)
3210 return (*specific->check.f1m) (*ap);
3212 if (sort_actual (specific->name, ap, specific->formal,
3213 &expr->where) == FAILURE)
3216 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3217 /* This is special because we might have to reorder the argument list. */
3218 t = gfc_check_minloc_maxloc (*ap);
3219 else if (specific->check.f3red == gfc_check_minval_maxval)
3220 /* This is also special because we also might have to reorder the
3222 t = gfc_check_minval_maxval (*ap);
3223 else if (specific->check.f3red == gfc_check_product_sum)
3224 /* Same here. The difference to the previous case is that we allow a
3225 general numeric type. */
3226 t = gfc_check_product_sum (*ap);
3229 if (specific->check.f1 == NULL)
3231 t = check_arglist (ap, specific, error_flag);
3233 expr->ts = specific->ts;
3236 t = do_check (specific, *ap);
3239 /* Check ranks for elemental intrinsics. */
3240 if (t == SUCCESS && specific->elemental)
3243 for (arg = expr->value.function.actual; arg; arg = arg->next)
3245 if (arg->expr == NULL || arg->expr->rank == 0)
3249 r = arg->expr->rank;
3253 if (arg->expr->rank != r)
3255 gfc_error ("Ranks of arguments to elemental intrinsic '%s' "
3256 "differ at %L", specific->name, &arg->expr->where);
3263 remove_nullargs (ap);
3269 /* See if an intrinsic is one of the intrinsics we evaluate
3273 gfc_init_expr_extensions (gfc_intrinsic_sym *isym)
3275 /* FIXME: This should be moved into the intrinsic definitions. */
3276 static const char * const init_expr_extensions[] = {
3277 "digits", "epsilon", "huge", "kind", "maxexponent", "minexponent",
3278 "precision", "present", "radix", "range", "selected_real_kind",
3284 for (i = 0; init_expr_extensions[i]; i++)
3285 if (strcmp (init_expr_extensions[i], isym->name) == 0)
3292 /* Check whether an intrinsic belongs to whatever standard the user
3296 check_intrinsic_standard (const char *name, int standard, locus *where)
3298 if (!gfc_option.warn_nonstd_intrinsics)
3301 gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
3302 "in the selected standard", name, where);
3306 /* See if a function call corresponds to an intrinsic function call.
3309 MATCH_YES if the call corresponds to an intrinsic, simplification
3310 is done if possible.
3312 MATCH_NO if the call does not correspond to an intrinsic
3314 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3315 error during the simplification process.
3317 The error_flag parameter enables an error reporting. */
3320 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3322 gfc_intrinsic_sym *isym, *specific;
3323 gfc_actual_arglist *actual;
3327 if (expr->value.function.isym != NULL)
3328 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3329 ? MATCH_ERROR : MATCH_YES;
3331 gfc_suppress_error = !error_flag;
3334 for (actual = expr->value.function.actual; actual; actual = actual->next)
3335 if (actual->expr != NULL)
3336 flag |= (actual->expr->ts.type != BT_INTEGER
3337 && actual->expr->ts.type != BT_CHARACTER);
3339 name = expr->symtree->n.sym->name;
3341 isym = specific = gfc_find_function (name);
3344 gfc_suppress_error = 0;
3348 gfc_current_intrinsic_where = &expr->where;
3350 /* Bypass the generic list for min and max. */
3351 if (isym->check.f1m == gfc_check_min_max)
3353 init_arglist (isym);
3355 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3358 gfc_suppress_error = 0;
3362 /* If the function is generic, check all of its specific
3363 incarnations. If the generic name is also a specific, we check
3364 that name last, so that any error message will correspond to the
3366 gfc_suppress_error = 1;
3370 for (specific = isym->specific_head; specific;
3371 specific = specific->next)
3373 if (specific == isym)
3375 if (check_specific (specific, expr, 0) == SUCCESS)
3380 gfc_suppress_error = !error_flag;
3382 if (check_specific (isym, expr, error_flag) == FAILURE)
3384 gfc_suppress_error = 0;
3391 expr->value.function.isym = specific;
3392 gfc_intrinsic_symbol (expr->symtree->n.sym);
3394 gfc_suppress_error = 0;
3395 if (do_simplify (specific, expr) == FAILURE)
3398 /* TODO: We should probably only allow elemental functions here. */
3399 flag |= (expr->ts.type != BT_INTEGER && expr->ts.type != BT_CHARACTER);
3401 if (gfc_init_expr && flag && gfc_init_expr_extensions (specific))
3403 if (gfc_notify_std (GFC_STD_GNU, "Extension: Evaluation of "
3404 "nonstandard initialization expression at %L",
3405 &expr->where) == FAILURE)
3411 check_intrinsic_standard (name, isym->standard, &expr->where);
3417 /* See if a CALL statement corresponds to an intrinsic subroutine.
3418 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3419 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3423 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3425 gfc_intrinsic_sym *isym;
3428 name = c->symtree->n.sym->name;
3430 isym = find_subroutine (name);
3434 gfc_suppress_error = !error_flag;
3436 init_arglist (isym);
3438 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3441 if (isym->check.f1 != NULL)
3443 if (do_check (isym, c->ext.actual) == FAILURE)
3448 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3452 /* The subroutine corresponds to an intrinsic. Allow errors to be
3453 seen at this point. */
3454 gfc_suppress_error = 0;
3456 if (isym->resolve.s1 != NULL)
3457 isym->resolve.s1 (c);
3459 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3461 if (gfc_pure (NULL) && !isym->elemental)
3463 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3468 c->resolved_sym->attr.noreturn = isym->noreturn;
3469 check_intrinsic_standard (name, isym->standard, &c->loc);
3474 gfc_suppress_error = 0;
3479 /* Call gfc_convert_type() with warning enabled. */
3482 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3484 return gfc_convert_type_warn (expr, ts, eflag, 1);
3488 /* Try to convert an expression (in place) from one type to another.
3489 'eflag' controls the behavior on error.
3491 The possible values are:
3493 1 Generate a gfc_error()
3494 2 Generate a gfc_internal_error().
3496 'wflag' controls the warning related to conversion. */
3499 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3501 gfc_intrinsic_sym *sym;
3502 gfc_typespec from_ts;
3508 from_ts = expr->ts; /* expr->ts gets clobbered */
3510 if (ts->type == BT_UNKNOWN)
3513 /* NULL and zero size arrays get their type here. */
3514 if (expr->expr_type == EXPR_NULL
3515 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3517 /* Sometimes the RHS acquire the type. */
3522 if (expr->ts.type == BT_UNKNOWN)
3525 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3526 && gfc_compare_types (&expr->ts, ts))
3529 sym = find_conv (&expr->ts, ts);
3533 /* At this point, a conversion is necessary. A warning may be needed. */
3534 if ((gfc_option.warn_std & sym->standard) != 0)
3535 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3536 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3537 else if (wflag && gfc_option.warn_conversion)
3538 gfc_warning_now ("Conversion from %s to %s at %L",
3539 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3541 /* Insert a pre-resolved function call to the right function. */
3542 old_where = expr->where;
3544 shape = expr->shape;
3546 new = gfc_get_expr ();
3549 new = gfc_build_conversion (new);
3550 new->value.function.name = sym->lib_name;
3551 new->value.function.isym = sym;
3552 new->where = old_where;
3554 new->shape = gfc_copy_shape (shape, rank);
3556 gfc_get_ha_sym_tree (sym->name, &new->symtree);
3557 new->symtree->n.sym->ts = *ts;
3558 new->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3559 new->symtree->n.sym->attr.function = 1;
3560 new->symtree->n.sym->attr.intrinsic = 1;
3561 new->symtree->n.sym->attr.elemental = 1;
3562 new->symtree->n.sym->attr.pure = 1;
3563 new->symtree->n.sym->attr.referenced = 1;
3564 gfc_intrinsic_symbol(new->symtree->n.sym);
3565 gfc_commit_symbol (new->symtree->n.sym);
3572 if (gfc_is_constant_expr (expr->value.function.actual->expr)
3573 && do_simplify (sym, expr) == FAILURE)
3578 return FAILURE; /* Error already generated in do_simplify() */
3586 gfc_error ("Can't convert %s to %s at %L",
3587 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3591 gfc_internal_error ("Can't convert %s to %s at %L",
3592 gfc_typename (&from_ts), gfc_typename (ts),