1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 Free Software Foundation, Inc.
6 Contributed by Andy Vaught & Katherine Holcomb
8 This file is part of GCC.
10 GCC is free software; you can redistribute it and/or modify it under
11 the terms of the GNU General Public License as published by the Free
12 Software Foundation; either version 3, or (at your option) any later
15 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
16 WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
20 You should have received a copy of the GNU General Public License
21 along with GCC; see the file COPYING3. If not see
22 <http://www.gnu.org/licenses/>. */
28 #include "intrinsic.h"
30 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
31 static gfc_namespace *gfc_intrinsic_namespace;
33 bool gfc_init_expr_flag = false;
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_sym *char_conversions;
44 static gfc_intrinsic_arg *next_arg;
46 static int nfunc, nsub, nargs, nconv, ncharconv;
49 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
53 { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
62 /* Return a letter based on the passed type. Used to construct the
63 name of a type-dependent subroutine. */
66 gfc_type_letter (bt type)
101 /* Get a symbol for a resolved name. Note, if needed be, the elemental
102 attribute has be added afterwards. */
105 gfc_get_intrinsic_sub_symbol (const char *name)
109 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
110 sym->attr.always_explicit = 1;
111 sym->attr.subroutine = 1;
112 sym->attr.flavor = FL_PROCEDURE;
113 sym->attr.proc = PROC_INTRINSIC;
119 /* Return a pointer to the name of a conversion function given two
123 conv_name (gfc_typespec *from, gfc_typespec *to)
125 return gfc_get_string ("__convert_%c%d_%c%d",
126 gfc_type_letter (from->type), from->kind,
127 gfc_type_letter (to->type), to->kind);
131 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
132 corresponds to the conversion. Returns NULL if the conversion
135 static gfc_intrinsic_sym *
136 find_conv (gfc_typespec *from, gfc_typespec *to)
138 gfc_intrinsic_sym *sym;
142 target = conv_name (from, to);
145 for (i = 0; i < nconv; i++, sym++)
146 if (target == sym->name)
153 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
154 that corresponds to the conversion. Returns NULL if the conversion
157 static gfc_intrinsic_sym *
158 find_char_conv (gfc_typespec *from, gfc_typespec *to)
160 gfc_intrinsic_sym *sym;
164 target = conv_name (from, to);
165 sym = char_conversions;
167 for (i = 0; i < ncharconv; i++, sym++)
168 if (target == sym->name)
175 /* Interface to the check functions. We break apart an argument list
176 and call the proper check function rather than forcing each
177 function to manipulate the argument list. */
180 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
182 gfc_expr *a1, *a2, *a3, *a4, *a5;
185 return (*specific->check.f0) ();
190 return (*specific->check.f1) (a1);
195 return (*specific->check.f2) (a1, a2);
200 return (*specific->check.f3) (a1, a2, a3);
205 return (*specific->check.f4) (a1, a2, a3, a4);
210 return (*specific->check.f5) (a1, a2, a3, a4, a5);
212 gfc_internal_error ("do_check(): too many args");
216 /*********** Subroutines to build the intrinsic list ****************/
218 /* Add a single intrinsic symbol to the current list.
221 char * name of function
222 int whether function is elemental
223 int If the function can be used as an actual argument [1]
224 bt return type of function
225 int kind of return type of function
226 int Fortran standard version
227 check pointer to check function
228 simplify pointer to simplification function
229 resolve pointer to resolution function
231 Optional arguments come in multiples of five:
232 char * name of argument
235 int arg optional flag (1=optional, 0=required)
236 sym_intent intent of argument
238 The sequence is terminated by a NULL name.
241 [1] Whether a function can or cannot be used as an actual argument is
242 determined by its presence on the 13.6 list in Fortran 2003. The
243 following intrinsics, which are GNU extensions, are considered allowed
244 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
245 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
248 add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
249 int standard, gfc_check_f check, gfc_simplify_f simplify,
250 gfc_resolve_f resolve, ...)
252 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
253 int optional, first_flag;
268 next_sym->name = gfc_get_string (name);
270 strcpy (buf, "_gfortran_");
272 next_sym->lib_name = gfc_get_string (buf);
274 next_sym->elemental = (cl == CLASS_ELEMENTAL);
275 next_sym->inquiry = (cl == CLASS_INQUIRY);
276 next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
277 next_sym->actual_ok = actual_ok;
278 next_sym->ts.type = type;
279 next_sym->ts.kind = kind;
280 next_sym->standard = standard;
281 next_sym->simplify = simplify;
282 next_sym->check = check;
283 next_sym->resolve = resolve;
284 next_sym->specific = 0;
285 next_sym->generic = 0;
286 next_sym->conversion = 0;
291 gfc_internal_error ("add_sym(): Bad sizing mode");
294 va_start (argp, resolve);
300 name = va_arg (argp, char *);
304 type = (bt) va_arg (argp, int);
305 kind = va_arg (argp, int);
306 optional = va_arg (argp, int);
307 intent = (sym_intent) va_arg (argp, int);
309 if (sizing != SZ_NOTHING)
316 next_sym->formal = next_arg;
318 (next_arg - 1)->next = next_arg;
322 strcpy (next_arg->name, name);
323 next_arg->ts.type = type;
324 next_arg->ts.kind = kind;
325 next_arg->optional = optional;
326 next_arg->intent = intent;
336 /* Add a symbol to the function list where the function takes
340 add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
341 int kind, int standard,
342 gfc_try (*check) (void),
343 gfc_expr *(*simplify) (void),
344 void (*resolve) (gfc_expr *))
354 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
359 /* Add a symbol to the subroutine list where the subroutine takes
363 add_sym_0s (const char *name, gfc_isym_id id, int standard, void (*resolve) (gfc_code *))
373 add_sym (name, id, NO_CLASS, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
378 /* Add a symbol to the function list where the function takes
382 add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
383 int kind, int standard,
384 gfc_try (*check) (gfc_expr *),
385 gfc_expr *(*simplify) (gfc_expr *),
386 void (*resolve) (gfc_expr *, gfc_expr *),
387 const char *a1, bt type1, int kind1, int optional1)
397 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
398 a1, type1, kind1, optional1, INTENT_IN,
403 /* Add a symbol to the subroutine list where the subroutine takes
407 add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
408 gfc_try (*check) (gfc_expr *),
409 gfc_expr *(*simplify) (gfc_expr *),
410 void (*resolve) (gfc_code *),
411 const char *a1, bt type1, int kind1, int optional1)
421 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
422 a1, type1, kind1, optional1, INTENT_IN,
427 /* Add a symbol to the function list where the function takes
428 1 arguments, specifying the intent of the argument. */
431 add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
432 int actual_ok, bt type, int kind, int standard,
433 gfc_try (*check) (gfc_expr *),
434 gfc_expr *(*simplify) (gfc_expr *),
435 void (*resolve) (gfc_expr *, gfc_expr *),
436 const char *a1, bt type1, int kind1, int optional1,
447 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
448 a1, type1, kind1, optional1, intent1,
453 /* Add a symbol to the subroutine list where the subroutine takes
454 1 arguments, specifying the intent of the argument. */
457 add_sym_1s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
458 int kind, int standard,
459 gfc_try (*check) (gfc_expr *),
460 gfc_expr *(*simplify) (gfc_expr *),
461 void (*resolve) (gfc_code *),
462 const char *a1, bt type1, int kind1, int optional1,
473 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
474 a1, type1, kind1, optional1, intent1,
479 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
480 function. MAX et al take 2 or more arguments. */
483 add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
484 int kind, int standard,
485 gfc_try (*check) (gfc_actual_arglist *),
486 gfc_expr *(*simplify) (gfc_expr *),
487 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
488 const char *a1, bt type1, int kind1, int optional1,
489 const char *a2, bt type2, int kind2, int optional2)
499 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
500 a1, type1, kind1, optional1, INTENT_IN,
501 a2, type2, kind2, optional2, INTENT_IN,
506 /* Add a symbol to the function list where the function takes
510 add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
511 int kind, int standard,
512 gfc_try (*check) (gfc_expr *, gfc_expr *),
513 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
514 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
515 const char *a1, bt type1, int kind1, int optional1,
516 const char *a2, bt type2, int kind2, int optional2)
526 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
527 a1, type1, kind1, optional1, INTENT_IN,
528 a2, type2, kind2, optional2, INTENT_IN,
533 /* Add a symbol to the subroutine list where the subroutine takes
537 add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
538 gfc_try (*check) (gfc_expr *, gfc_expr *),
539 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
540 void (*resolve) (gfc_code *),
541 const char *a1, bt type1, int kind1, int optional1,
542 const char *a2, bt type2, int kind2, int optional2)
552 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
553 a1, type1, kind1, optional1, INTENT_IN,
554 a2, type2, kind2, optional2, INTENT_IN,
559 /* Add a symbol to the subroutine list where the subroutine takes
560 2 arguments, specifying the intent of the arguments. */
563 add_sym_2s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
564 int kind, int standard,
565 gfc_try (*check) (gfc_expr *, gfc_expr *),
566 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
567 void (*resolve) (gfc_code *),
568 const char *a1, bt type1, int kind1, int optional1,
569 sym_intent intent1, const char *a2, bt type2, int kind2,
570 int optional2, sym_intent intent2)
580 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
581 a1, type1, kind1, optional1, intent1,
582 a2, type2, kind2, optional2, intent2,
587 /* Add a symbol to the function list where the function takes
591 add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
592 int kind, int standard,
593 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
594 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
595 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
596 const char *a1, bt type1, int kind1, int optional1,
597 const char *a2, bt type2, int kind2, int optional2,
598 const char *a3, bt type3, int kind3, int optional3)
608 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
609 a1, type1, kind1, optional1, INTENT_IN,
610 a2, type2, kind2, optional2, INTENT_IN,
611 a3, type3, kind3, optional3, INTENT_IN,
616 /* MINLOC and MAXLOC get special treatment because their argument
617 might have to be reordered. */
620 add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
621 int kind, int standard,
622 gfc_try (*check) (gfc_actual_arglist *),
623 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
624 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
625 const char *a1, bt type1, int kind1, int optional1,
626 const char *a2, bt type2, int kind2, int optional2,
627 const char *a3, bt type3, int kind3, int optional3)
637 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
638 a1, type1, kind1, optional1, INTENT_IN,
639 a2, type2, kind2, optional2, INTENT_IN,
640 a3, type3, kind3, optional3, INTENT_IN,
645 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
646 their argument also might have to be reordered. */
649 add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
650 int kind, int standard,
651 gfc_try (*check) (gfc_actual_arglist *),
652 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
653 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
654 const char *a1, bt type1, int kind1, int optional1,
655 const char *a2, bt type2, int kind2, int optional2,
656 const char *a3, bt type3, int kind3, int optional3)
666 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
667 a1, type1, kind1, optional1, INTENT_IN,
668 a2, type2, kind2, optional2, INTENT_IN,
669 a3, type3, kind3, optional3, INTENT_IN,
674 /* Add a symbol to the subroutine list where the subroutine takes
678 add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
679 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
680 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
681 void (*resolve) (gfc_code *),
682 const char *a1, bt type1, int kind1, int optional1,
683 const char *a2, bt type2, int kind2, int optional2,
684 const char *a3, bt type3, int kind3, int optional3)
694 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
695 a1, type1, kind1, optional1, INTENT_IN,
696 a2, type2, kind2, optional2, INTENT_IN,
697 a3, type3, kind3, optional3, INTENT_IN,
702 /* Add a symbol to the subroutine list where the subroutine takes
703 3 arguments, specifying the intent of the arguments. */
706 add_sym_3s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
707 int kind, int standard,
708 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
709 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
710 void (*resolve) (gfc_code *),
711 const char *a1, bt type1, int kind1, int optional1,
712 sym_intent intent1, const char *a2, bt type2, int kind2,
713 int optional2, sym_intent intent2, const char *a3, bt type3,
714 int kind3, int optional3, sym_intent intent3)
724 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
725 a1, type1, kind1, optional1, intent1,
726 a2, type2, kind2, optional2, intent2,
727 a3, type3, kind3, optional3, intent3,
732 /* Add a symbol to the function list where the function takes
736 add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
737 int kind, int standard,
738 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
739 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
741 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
743 const char *a1, bt type1, int kind1, int optional1,
744 const char *a2, bt type2, int kind2, int optional2,
745 const char *a3, bt type3, int kind3, int optional3,
746 const char *a4, bt type4, int kind4, int optional4 )
756 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
757 a1, type1, kind1, optional1, INTENT_IN,
758 a2, type2, kind2, optional2, INTENT_IN,
759 a3, type3, kind3, optional3, INTENT_IN,
760 a4, type4, kind4, optional4, INTENT_IN,
765 /* Add a symbol to the subroutine list where the subroutine takes
769 add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
771 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
772 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
774 void (*resolve) (gfc_code *),
775 const char *a1, bt type1, int kind1, int optional1,
776 sym_intent intent1, const char *a2, bt type2, int kind2,
777 int optional2, sym_intent intent2, const char *a3, bt type3,
778 int kind3, int optional3, sym_intent intent3, const char *a4,
779 bt type4, int kind4, int optional4, sym_intent intent4)
789 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
790 a1, type1, kind1, optional1, intent1,
791 a2, type2, kind2, optional2, intent2,
792 a3, type3, kind3, optional3, intent3,
793 a4, type4, kind4, optional4, intent4,
798 /* Add a symbol to the subroutine list where the subroutine takes
802 add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
804 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
806 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
807 gfc_expr *, gfc_expr *),
808 void (*resolve) (gfc_code *),
809 const char *a1, bt type1, int kind1, int optional1,
810 sym_intent intent1, const char *a2, bt type2, int kind2,
811 int optional2, sym_intent intent2, const char *a3, bt type3,
812 int kind3, int optional3, sym_intent intent3, const char *a4,
813 bt type4, int kind4, int optional4, sym_intent intent4,
814 const char *a5, bt type5, int kind5, int optional5,
825 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
826 a1, type1, kind1, optional1, intent1,
827 a2, type2, kind2, optional2, intent2,
828 a3, type3, kind3, optional3, intent3,
829 a4, type4, kind4, optional4, intent4,
830 a5, type5, kind5, optional5, intent5,
835 /* Locate an intrinsic symbol given a base pointer, number of elements
836 in the table and a pointer to a name. Returns the NULL pointer if
837 a name is not found. */
839 static gfc_intrinsic_sym *
840 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
842 /* name may be a user-supplied string, so we must first make sure
843 that we're comparing against a pointer into the global string
845 const char *p = gfc_get_string (name);
849 if (p == start->name)
860 /* Given a name, find a function in the intrinsic function table.
861 Returns NULL if not found. */
864 gfc_find_function (const char *name)
866 gfc_intrinsic_sym *sym;
868 sym = find_sym (functions, nfunc, name);
870 sym = find_sym (conversion, nconv, name);
876 /* Given a name, find a function in the intrinsic subroutine table.
877 Returns NULL if not found. */
880 gfc_find_subroutine (const char *name)
882 return find_sym (subroutines, nsub, name);
886 /* Given a string, figure out if it is the name of a generic intrinsic
890 gfc_generic_intrinsic (const char *name)
892 gfc_intrinsic_sym *sym;
894 sym = gfc_find_function (name);
895 return (sym == NULL) ? 0 : sym->generic;
899 /* Given a string, figure out if it is the name of a specific
900 intrinsic function or not. */
903 gfc_specific_intrinsic (const char *name)
905 gfc_intrinsic_sym *sym;
907 sym = gfc_find_function (name);
908 return (sym == NULL) ? 0 : sym->specific;
912 /* Given a string, figure out if it is the name of an intrinsic function
913 or subroutine allowed as an actual argument or not. */
915 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
917 gfc_intrinsic_sym *sym;
919 /* Intrinsic subroutines are not allowed as actual arguments. */
924 sym = gfc_find_function (name);
925 return (sym == NULL) ? 0 : sym->actual_ok;
930 /* Given a symbol, find out if it is (and is to be treated) an intrinsic. If
931 it's name refers to an intrinsic but this intrinsic is not included in the
932 selected standard, this returns FALSE and sets the symbol's external
936 gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
938 gfc_intrinsic_sym* isym;
941 /* If INTRINSIC/EXTERNAL state is already known, return. */
942 if (sym->attr.intrinsic)
944 if (sym->attr.external)
948 isym = gfc_find_subroutine (sym->name);
950 isym = gfc_find_function (sym->name);
952 /* No such intrinsic available at all? */
956 /* See if this intrinsic is allowed in the current standard. */
957 if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
959 if (sym->attr.proc == PROC_UNKNOWN
960 && gfc_option.warn_intrinsics_std)
961 gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
962 " selected standard but %s and '%s' will be"
963 " treated as if declared EXTERNAL. Use an"
964 " appropriate -std=* option or define"
965 " -fall-intrinsics to allow this intrinsic.",
966 sym->name, &loc, symstd, sym->name);
975 /* Collect a set of intrinsic functions into a generic collection.
976 The first argument is the name of the generic function, which is
977 also the name of a specific function. The rest of the specifics
978 currently in the table are placed into the list of specific
979 functions associated with that generic.
982 FIXME: Remove the argument STANDARD if no regressions are
983 encountered. Change all callers (approx. 360).
987 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
989 gfc_intrinsic_sym *g;
991 if (sizing != SZ_NOTHING)
994 g = gfc_find_function (name);
996 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
999 gcc_assert (g->id == id);
1003 if ((g + 1)->name != NULL)
1004 g->specific_head = g + 1;
1007 while (g->name != NULL)
1019 /* Create a duplicate intrinsic function entry for the current
1020 function, the only differences being the alternate name and
1021 a different standard if necessary. Note that we use argument
1022 lists more than once, but all argument lists are freed as a
1026 make_alias (const char *name, int standard)
1039 next_sym[0] = next_sym[-1];
1040 next_sym->name = gfc_get_string (name);
1041 next_sym->standard = standard;
1051 /* Make the current subroutine noreturn. */
1054 make_noreturn (void)
1056 if (sizing == SZ_NOTHING)
1057 next_sym[-1].noreturn = 1;
1061 /* Add intrinsic functions. */
1064 add_functions (void)
1066 /* Argument names as in the standard (to be used as argument keywords). */
1068 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1069 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1070 *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1071 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1072 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1073 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1074 *p = "p", *ar = "array", *shp = "shape", *src = "source",
1075 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1076 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1077 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1078 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1079 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1080 *num = "number", *tm = "time", *nm = "name", *md = "mode",
1081 *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
1082 *ca = "coarray", *sub = "sub";
1084 int di, dr, dd, dl, dc, dz, ii;
1086 di = gfc_default_integer_kind;
1087 dr = gfc_default_real_kind;
1088 dd = gfc_default_double_kind;
1089 dl = gfc_default_logical_kind;
1090 dc = gfc_default_character_kind;
1091 dz = gfc_default_complex_kind;
1092 ii = gfc_index_integer_kind;
1094 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1095 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1096 a, BT_REAL, dr, REQUIRED);
1098 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1099 NULL, gfc_simplify_abs, gfc_resolve_abs,
1100 a, BT_INTEGER, di, REQUIRED);
1102 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1103 gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1104 a, BT_REAL, dd, REQUIRED);
1106 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1107 NULL, gfc_simplify_abs, gfc_resolve_abs,
1108 a, BT_COMPLEX, dz, REQUIRED);
1110 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1111 NULL, gfc_simplify_abs, gfc_resolve_abs,
1112 a, BT_COMPLEX, dd, REQUIRED);
1114 make_alias ("cdabs", GFC_STD_GNU);
1116 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1118 /* The checking function for ACCESS is called gfc_check_access_func
1119 because the name gfc_check_access is already used in module.c. */
1120 add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1121 gfc_check_access_func, NULL, gfc_resolve_access,
1122 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1124 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1126 add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1127 BT_CHARACTER, dc, GFC_STD_F95,
1128 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1129 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1131 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1133 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1134 gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1135 x, BT_REAL, dr, REQUIRED);
1137 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1138 gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1139 x, BT_REAL, dd, REQUIRED);
1141 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1143 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1144 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1145 gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1147 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1148 gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1149 x, BT_REAL, dd, REQUIRED);
1151 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1153 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1154 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1155 gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1157 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1159 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1160 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1161 gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1163 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1165 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1166 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1167 z, BT_COMPLEX, dz, REQUIRED);
1169 make_alias ("imag", GFC_STD_GNU);
1170 make_alias ("imagpart", GFC_STD_GNU);
1172 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1173 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1174 z, BT_COMPLEX, dd, REQUIRED);
1176 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1178 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1179 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1180 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1182 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1183 NULL, gfc_simplify_dint, gfc_resolve_dint,
1184 a, BT_REAL, dd, REQUIRED);
1186 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1188 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1189 gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1190 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1192 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1194 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1195 gfc_check_allocated, NULL, NULL,
1196 ar, BT_UNKNOWN, 0, REQUIRED);
1198 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1200 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1201 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1202 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1204 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1205 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1206 a, BT_REAL, dd, REQUIRED);
1208 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1210 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1211 gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1212 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1214 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1216 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1217 gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1218 x, BT_REAL, dr, REQUIRED);
1220 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1221 gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1222 x, BT_REAL, dd, REQUIRED);
1224 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1226 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1227 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1228 gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1230 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1231 gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1232 x, BT_REAL, dd, REQUIRED);
1234 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1236 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1237 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1238 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1240 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1242 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1243 gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1244 x, BT_REAL, dr, REQUIRED);
1246 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1247 gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1248 x, BT_REAL, dd, REQUIRED);
1250 /* Two-argument version of atan, equivalent to atan2. */
1251 add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1252 gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1253 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1255 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1257 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1258 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1259 gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1261 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1262 gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1263 x, BT_REAL, dd, REQUIRED);
1265 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1267 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1268 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1269 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1271 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1272 gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1273 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1275 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1277 /* Bessel and Neumann functions for G77 compatibility. */
1278 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1279 gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1280 x, BT_REAL, dr, REQUIRED);
1282 make_alias ("bessel_j0", GFC_STD_F2008);
1284 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1285 gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1286 x, BT_REAL, dd, REQUIRED);
1288 make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1290 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1291 gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1292 x, BT_REAL, dr, REQUIRED);
1294 make_alias ("bessel_j1", GFC_STD_F2008);
1296 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1297 gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1298 x, BT_REAL, dd, REQUIRED);
1300 make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1302 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1303 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1304 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1306 make_alias ("bessel_jn", GFC_STD_F2008);
1308 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1309 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1310 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1312 make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1314 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1315 gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1316 x, BT_REAL, dr, REQUIRED);
1318 make_alias ("bessel_y0", GFC_STD_F2008);
1320 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1321 gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1322 x, BT_REAL, dd, REQUIRED);
1324 make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1326 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1327 gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1328 x, BT_REAL, dr, REQUIRED);
1330 make_alias ("bessel_y1", GFC_STD_F2008);
1332 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1333 gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1334 x, BT_REAL, dd, REQUIRED);
1336 make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1338 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1339 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1340 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1342 make_alias ("bessel_yn", GFC_STD_F2008);
1344 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1345 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1346 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1348 make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1350 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1351 gfc_check_i, gfc_simplify_bit_size, NULL,
1352 i, BT_INTEGER, di, REQUIRED);
1354 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1356 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1357 gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1358 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1360 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1362 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1363 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1364 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1366 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1368 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1369 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1370 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1372 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1374 add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1375 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1376 nm, BT_CHARACTER, dc, REQUIRED);
1378 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1380 add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1381 gfc_check_chmod, NULL, gfc_resolve_chmod,
1382 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1384 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1386 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1387 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1388 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1389 kind, BT_INTEGER, di, OPTIONAL);
1391 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1393 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1394 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1396 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1399 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1400 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1401 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1403 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1405 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1406 complex instead of the default complex. */
1408 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1409 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1410 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1412 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1414 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1415 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1416 z, BT_COMPLEX, dz, REQUIRED);
1418 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1419 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1420 z, BT_COMPLEX, dd, REQUIRED);
1422 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1424 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1425 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1426 x, BT_REAL, dr, REQUIRED);
1428 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1429 gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1430 x, BT_REAL, dd, REQUIRED);
1432 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1433 NULL, gfc_simplify_cos, gfc_resolve_cos,
1434 x, BT_COMPLEX, dz, REQUIRED);
1436 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1437 NULL, gfc_simplify_cos, gfc_resolve_cos,
1438 x, BT_COMPLEX, dd, REQUIRED);
1440 make_alias ("cdcos", GFC_STD_GNU);
1442 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1444 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1445 gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1446 x, BT_REAL, dr, REQUIRED);
1448 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1449 gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1450 x, BT_REAL, dd, REQUIRED);
1452 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1454 add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1455 BT_INTEGER, di, GFC_STD_F95,
1456 gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1457 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1458 kind, BT_INTEGER, di, OPTIONAL);
1460 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1462 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1463 gfc_check_cshift, NULL, gfc_resolve_cshift,
1464 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1465 dm, BT_INTEGER, ii, OPTIONAL);
1467 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1469 add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1470 gfc_check_ctime, NULL, gfc_resolve_ctime,
1471 tm, BT_INTEGER, di, REQUIRED);
1473 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1475 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1476 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1477 a, BT_REAL, dr, REQUIRED);
1479 make_alias ("dfloat", GFC_STD_GNU);
1481 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1483 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1484 gfc_check_digits, gfc_simplify_digits, NULL,
1485 x, BT_UNKNOWN, dr, REQUIRED);
1487 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1489 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1490 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1491 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1493 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1494 NULL, gfc_simplify_dim, gfc_resolve_dim,
1495 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1497 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1498 gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1499 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1501 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1503 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1504 GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1505 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1507 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1509 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1510 gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1511 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1513 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1515 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1517 a, BT_COMPLEX, dd, REQUIRED);
1519 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1521 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1522 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1523 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1524 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1526 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1528 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1529 gfc_check_x, gfc_simplify_epsilon, NULL,
1530 x, BT_REAL, dr, REQUIRED);
1532 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1534 /* G77 compatibility for the ERF() and ERFC() functions. */
1535 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1536 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1537 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1539 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1540 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1541 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1543 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1545 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1546 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1547 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1549 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1550 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1551 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1553 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1555 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1556 BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1557 gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1560 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1562 /* G77 compatibility */
1563 add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1564 gfc_check_dtime_etime, NULL, NULL,
1565 x, BT_REAL, 4, REQUIRED);
1567 make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1569 add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1570 gfc_check_dtime_etime, NULL, NULL,
1571 x, BT_REAL, 4, REQUIRED);
1573 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1575 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1576 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1577 x, BT_REAL, dr, REQUIRED);
1579 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1580 gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1581 x, BT_REAL, dd, REQUIRED);
1583 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1584 NULL, gfc_simplify_exp, gfc_resolve_exp,
1585 x, BT_COMPLEX, dz, REQUIRED);
1587 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1588 NULL, gfc_simplify_exp, gfc_resolve_exp,
1589 x, BT_COMPLEX, dd, REQUIRED);
1591 make_alias ("cdexp", GFC_STD_GNU);
1593 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1595 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1596 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1597 x, BT_REAL, dr, REQUIRED);
1599 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1601 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1602 ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1603 gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1604 a, BT_UNKNOWN, 0, REQUIRED,
1605 mo, BT_UNKNOWN, 0, REQUIRED);
1607 add_sym_0 ("fdate", GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1608 NULL, NULL, gfc_resolve_fdate);
1610 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1612 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1613 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1614 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1616 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1618 /* G77 compatible fnum */
1619 add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1620 gfc_check_fnum, NULL, gfc_resolve_fnum,
1621 ut, BT_INTEGER, di, REQUIRED);
1623 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1625 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1626 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1627 x, BT_REAL, dr, REQUIRED);
1629 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1631 add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1632 GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1633 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1635 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1637 add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1638 gfc_check_ftell, NULL, gfc_resolve_ftell,
1639 ut, BT_INTEGER, di, REQUIRED);
1641 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1643 add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1644 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1645 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1647 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1649 add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1650 gfc_check_fgetput, NULL, gfc_resolve_fget,
1651 c, BT_CHARACTER, dc, REQUIRED);
1653 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1655 add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1656 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1657 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1659 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1661 add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1662 gfc_check_fgetput, NULL, gfc_resolve_fput,
1663 c, BT_CHARACTER, dc, REQUIRED);
1665 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1667 add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1668 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1669 gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1671 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1672 gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1673 x, BT_REAL, dr, REQUIRED);
1675 make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1677 /* Unix IDs (g77 compatibility) */
1678 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1679 NULL, NULL, gfc_resolve_getcwd,
1680 c, BT_CHARACTER, dc, REQUIRED);
1682 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1684 add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1685 NULL, NULL, gfc_resolve_getgid);
1687 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1689 add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1690 NULL, NULL, gfc_resolve_getpid);
1692 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1694 add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1695 NULL, NULL, gfc_resolve_getuid);
1697 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1699 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1700 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1701 a, BT_CHARACTER, dc, REQUIRED);
1703 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1705 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1706 gfc_check_huge, gfc_simplify_huge, NULL,
1707 x, BT_UNKNOWN, dr, REQUIRED);
1709 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1711 add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1712 BT_REAL, dr, GFC_STD_F2008,
1713 gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1714 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1716 make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1718 add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1719 BT_INTEGER, di, GFC_STD_F95,
1720 gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1721 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1723 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1725 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1726 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1727 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1729 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1731 add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1732 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1733 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1735 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1737 add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1740 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1742 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1743 gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1744 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1746 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1748 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1749 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1750 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1751 ln, BT_INTEGER, di, REQUIRED);
1753 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1755 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1756 gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1757 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1759 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1761 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1762 BT_INTEGER, di, GFC_STD_F77,
1763 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1764 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1766 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1768 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1769 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1770 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1772 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1774 add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1775 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1776 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1778 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1780 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1781 NULL, NULL, gfc_resolve_ierrno);
1783 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1785 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
1786 gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
1787 ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
1789 /* The resolution function for INDEX is called gfc_resolve_index_func
1790 because the name gfc_resolve_index is already used in resolve.c. */
1791 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1792 BT_INTEGER, di, GFC_STD_F77,
1793 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1794 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1795 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1797 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1799 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1800 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1801 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1803 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1804 NULL, gfc_simplify_ifix, NULL,
1805 a, BT_REAL, dr, REQUIRED);
1807 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1808 NULL, gfc_simplify_idint, NULL,
1809 a, BT_REAL, dd, REQUIRED);
1811 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1813 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1814 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1815 a, BT_REAL, dr, REQUIRED);
1817 make_alias ("short", GFC_STD_GNU);
1819 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1821 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1822 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1823 a, BT_REAL, dr, REQUIRED);
1825 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1827 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1828 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1829 a, BT_REAL, dr, REQUIRED);
1831 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1833 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1834 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1835 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1837 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1839 add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1840 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1841 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1843 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1845 /* The following function is for G77 compatibility. */
1846 add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1847 gfc_check_irand, NULL, NULL,
1848 i, BT_INTEGER, 4, OPTIONAL);
1850 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1852 add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1853 gfc_check_isatty, NULL, gfc_resolve_isatty,
1854 ut, BT_INTEGER, di, REQUIRED);
1856 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1858 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1859 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1860 gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1861 i, BT_INTEGER, 0, REQUIRED);
1863 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1865 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1866 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1867 gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1868 i, BT_INTEGER, 0, REQUIRED);
1870 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1872 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1873 BT_LOGICAL, dl, GFC_STD_GNU,
1874 gfc_check_isnan, gfc_simplify_isnan, NULL,
1875 x, BT_REAL, 0, REQUIRED);
1877 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1879 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1880 gfc_check_ishft, NULL, gfc_resolve_rshift,
1881 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1883 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1885 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1886 gfc_check_ishft, NULL, gfc_resolve_lshift,
1887 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1889 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1891 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1892 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1893 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1895 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1897 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1898 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1899 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1900 sz, BT_INTEGER, di, OPTIONAL);
1902 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1904 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1905 gfc_check_kill, NULL, gfc_resolve_kill,
1906 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1908 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1910 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1911 gfc_check_kind, gfc_simplify_kind, NULL,
1912 x, BT_REAL, dr, REQUIRED);
1914 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1916 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1917 BT_INTEGER, di, GFC_STD_F95,
1918 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1919 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1920 kind, BT_INTEGER, di, OPTIONAL);
1922 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1924 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
1925 BT_INTEGER, di, GFC_STD_F2008,
1926 gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
1927 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1928 kind, BT_INTEGER, di, OPTIONAL);
1930 make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
1932 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1933 BT_INTEGER, di, GFC_STD_F2008,
1934 gfc_check_i, gfc_simplify_leadz, NULL,
1935 i, BT_INTEGER, di, REQUIRED);
1937 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1939 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1940 BT_INTEGER, di, GFC_STD_F77,
1941 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1942 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1944 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1946 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1947 BT_INTEGER, di, GFC_STD_F95,
1948 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1949 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1951 make_alias ("lnblnk", GFC_STD_GNU);
1953 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1955 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1957 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1958 x, BT_REAL, dr, REQUIRED);
1960 make_alias ("log_gamma", GFC_STD_F2008);
1962 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1963 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1964 x, BT_REAL, dr, REQUIRED);
1966 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1967 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1968 x, BT_REAL, dr, REQUIRED);
1970 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1973 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1974 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1975 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1977 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1979 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1980 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1981 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1983 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1985 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1986 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1987 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1989 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1991 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1992 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1993 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1995 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1997 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1998 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1999 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2001 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
2003 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2004 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
2005 x, BT_REAL, dr, REQUIRED);
2007 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2008 NULL, gfc_simplify_log, gfc_resolve_log,
2009 x, BT_REAL, dr, REQUIRED);
2011 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2012 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2013 x, BT_REAL, dd, REQUIRED);
2015 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2016 NULL, gfc_simplify_log, gfc_resolve_log,
2017 x, BT_COMPLEX, dz, REQUIRED);
2019 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2020 NULL, gfc_simplify_log, gfc_resolve_log,
2021 x, BT_COMPLEX, dd, REQUIRED);
2023 make_alias ("cdlog", GFC_STD_GNU);
2025 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2027 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2028 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2029 x, BT_REAL, dr, REQUIRED);
2031 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2032 NULL, gfc_simplify_log10, gfc_resolve_log10,
2033 x, BT_REAL, dr, REQUIRED);
2035 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2036 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2037 x, BT_REAL, dd, REQUIRED);
2039 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2041 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2042 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2043 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2045 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2047 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2048 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2049 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2051 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2053 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2054 GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2055 sz, BT_INTEGER, di, REQUIRED);
2057 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2059 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2060 gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2061 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2063 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2065 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2066 int(max). The max function must take at least two arguments. */
2068 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2069 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2070 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2072 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2073 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2074 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2076 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2077 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2078 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2080 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2081 gfc_check_min_max_real, gfc_simplify_max, NULL,
2082 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2084 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2085 gfc_check_min_max_real, gfc_simplify_max, NULL,
2086 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2088 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2089 gfc_check_min_max_double, gfc_simplify_max, NULL,
2090 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2092 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2094 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2095 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2096 x, BT_UNKNOWN, dr, REQUIRED);
2098 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2100 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2101 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2102 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2103 msk, BT_LOGICAL, dl, OPTIONAL);
2105 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2107 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2108 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2109 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2110 msk, BT_LOGICAL, dl, OPTIONAL);
2112 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2114 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2115 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2117 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2119 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2120 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2122 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2124 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2125 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2126 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2127 msk, BT_LOGICAL, dl, REQUIRED);
2129 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2131 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2134 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2135 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2136 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2138 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2139 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2140 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2142 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2143 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2144 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2146 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2147 gfc_check_min_max_real, gfc_simplify_min, NULL,
2148 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2150 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2151 gfc_check_min_max_real, gfc_simplify_min, NULL,
2152 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2154 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2155 gfc_check_min_max_double, gfc_simplify_min, NULL,
2156 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2158 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2160 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2161 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2162 x, BT_UNKNOWN, dr, REQUIRED);
2164 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2166 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2167 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2168 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2169 msk, BT_LOGICAL, dl, OPTIONAL);
2171 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2173 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2174 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2175 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2176 msk, BT_LOGICAL, dl, OPTIONAL);
2178 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2180 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2181 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2182 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2184 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2185 NULL, gfc_simplify_mod, gfc_resolve_mod,
2186 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2188 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2189 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2190 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2192 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2194 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2195 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2196 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2198 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2200 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2201 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2202 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2204 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2206 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2207 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2208 a, BT_CHARACTER, dc, REQUIRED);
2210 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2212 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2213 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2214 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2216 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2217 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2218 a, BT_REAL, dd, REQUIRED);
2220 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2222 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2223 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2224 i, BT_INTEGER, di, REQUIRED);
2226 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2228 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2229 gfc_check_null, gfc_simplify_null, NULL,
2230 mo, BT_INTEGER, di, OPTIONAL);
2232 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2234 add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2235 NULL, gfc_simplify_num_images, NULL);
2237 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2238 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2239 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2240 v, BT_REAL, dr, OPTIONAL);
2242 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2244 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2245 gfc_check_precision, gfc_simplify_precision, NULL,
2246 x, BT_UNKNOWN, 0, REQUIRED);
2248 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2250 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2251 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2252 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2254 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2256 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2257 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2258 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2259 msk, BT_LOGICAL, dl, OPTIONAL);
2261 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2263 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2264 gfc_check_radix, gfc_simplify_radix, NULL,
2265 x, BT_UNKNOWN, 0, REQUIRED);
2267 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2269 /* The following function is for G77 compatibility. */
2270 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2271 gfc_check_rand, NULL, NULL,
2272 i, BT_INTEGER, 4, OPTIONAL);
2274 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2275 use slightly different shoddy multiplicative congruential PRNG. */
2276 make_alias ("ran", GFC_STD_GNU);
2278 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2280 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2281 gfc_check_range, gfc_simplify_range, NULL,
2282 x, BT_REAL, dr, REQUIRED);
2284 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2286 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2287 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2288 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2290 /* This provides compatibility with g77. */
2291 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2292 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2293 a, BT_UNKNOWN, dr, REQUIRED);
2295 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2296 gfc_check_i, gfc_simplify_float, NULL,
2297 a, BT_INTEGER, di, REQUIRED);
2299 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2300 NULL, gfc_simplify_sngl, NULL,
2301 a, BT_REAL, dd, REQUIRED);
2303 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2305 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2306 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2307 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2309 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2311 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2312 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2313 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2315 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2317 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2318 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2319 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2320 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2322 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2324 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2325 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2326 x, BT_REAL, dr, REQUIRED);
2328 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2330 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2331 BT_LOGICAL, dl, GFC_STD_F2003,
2332 gfc_check_same_type_as, NULL, NULL,
2333 a, BT_UNKNOWN, 0, REQUIRED,
2334 b, BT_UNKNOWN, 0, REQUIRED);
2336 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2337 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2338 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2340 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2342 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2343 BT_INTEGER, di, GFC_STD_F95,
2344 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2345 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2346 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2348 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2350 /* Added for G77 compatibility garbage. */
2351 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2354 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2356 /* Added for G77 compatibility. */
2357 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2358 gfc_check_secnds, NULL, gfc_resolve_secnds,
2359 x, BT_REAL, dr, REQUIRED);
2361 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2363 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2364 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2365 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2366 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2368 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2370 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2371 GFC_STD_F95, gfc_check_selected_int_kind,
2372 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2374 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2376 add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2377 GFC_STD_F95, gfc_check_selected_real_kind,
2378 gfc_simplify_selected_real_kind, NULL,
2379 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2381 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2383 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2384 gfc_check_set_exponent, gfc_simplify_set_exponent,
2385 gfc_resolve_set_exponent,
2386 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2388 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2390 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2391 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2392 src, BT_REAL, dr, REQUIRED);
2394 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2396 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2397 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2398 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2400 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2401 NULL, gfc_simplify_sign, gfc_resolve_sign,
2402 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2404 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2405 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2406 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2408 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2410 add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2411 gfc_check_signal, NULL, gfc_resolve_signal,
2412 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2414 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2416 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2417 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2418 x, BT_REAL, dr, REQUIRED);
2420 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2421 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2422 x, BT_REAL, dd, REQUIRED);
2424 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2425 NULL, gfc_simplify_sin, gfc_resolve_sin,
2426 x, BT_COMPLEX, dz, REQUIRED);
2428 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2429 NULL, gfc_simplify_sin, gfc_resolve_sin,
2430 x, BT_COMPLEX, dd, REQUIRED);
2432 make_alias ("cdsin", GFC_STD_GNU);
2434 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2436 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2437 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2438 x, BT_REAL, dr, REQUIRED);
2440 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2441 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2442 x, BT_REAL, dd, REQUIRED);
2444 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2446 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2447 BT_INTEGER, di, GFC_STD_F95,
2448 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2449 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2450 kind, BT_INTEGER, di, OPTIONAL);
2452 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2454 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2455 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2456 x, BT_UNKNOWN, 0, REQUIRED);
2458 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2459 make_alias ("c_sizeof", GFC_STD_F2008);
2461 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2462 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2463 x, BT_REAL, dr, REQUIRED);
2465 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2467 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2468 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2469 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2470 ncopies, BT_INTEGER, di, REQUIRED);
2472 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2474 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2475 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2476 x, BT_REAL, dr, REQUIRED);
2478 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2479 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2480 x, BT_REAL, dd, REQUIRED);
2482 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2483 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2484 x, BT_COMPLEX, dz, REQUIRED);
2486 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2487 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2488 x, BT_COMPLEX, dd, REQUIRED);
2490 make_alias ("cdsqrt", GFC_STD_GNU);
2492 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2494 add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2495 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2496 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2498 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2500 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2501 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2502 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2503 msk, BT_LOGICAL, dl, OPTIONAL);
2505 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2507 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2508 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2509 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2511 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2513 add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2514 GFC_STD_GNU, NULL, NULL, NULL,
2515 com, BT_CHARACTER, dc, REQUIRED);
2517 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2519 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2520 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2521 x, BT_REAL, dr, REQUIRED);
2523 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2524 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2525 x, BT_REAL, dd, REQUIRED);
2527 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2529 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2530 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2531 x, BT_REAL, dr, REQUIRED);
2533 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2534 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2535 x, BT_REAL, dd, REQUIRED);
2537 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2539 add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2540 gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
2541 ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2543 add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2544 NULL, NULL, gfc_resolve_time);
2546 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2548 add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2549 NULL, NULL, gfc_resolve_time8);
2551 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2553 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2554 gfc_check_x, gfc_simplify_tiny, NULL,
2555 x, BT_REAL, dr, REQUIRED);
2557 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2559 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2560 BT_INTEGER, di, GFC_STD_F2008,
2561 gfc_check_i, gfc_simplify_trailz, NULL,
2562 i, BT_INTEGER, di, REQUIRED);
2564 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2566 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2567 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2568 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2569 sz, BT_INTEGER, di, OPTIONAL);
2571 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2573 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2574 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2575 m, BT_REAL, dr, REQUIRED);
2577 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2579 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2580 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2581 stg, BT_CHARACTER, dc, REQUIRED);
2583 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2585 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2586 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2587 ut, BT_INTEGER, di, REQUIRED);
2589 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2591 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2592 BT_INTEGER, di, GFC_STD_F95,
2593 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2594 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2595 kind, BT_INTEGER, di, OPTIONAL);
2597 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2599 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
2600 BT_INTEGER, di, GFC_STD_F2008,
2601 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
2602 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2603 kind, BT_INTEGER, di, OPTIONAL);
2605 make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
2607 /* g77 compatibility for UMASK. */
2608 add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2609 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2610 msk, BT_INTEGER, di, REQUIRED);
2612 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2614 /* g77 compatibility for UNLINK. */
2615 add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2616 gfc_check_unlink, NULL, gfc_resolve_unlink,
2617 "path", BT_CHARACTER, dc, REQUIRED);
2619 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2621 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2622 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2623 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2624 f, BT_REAL, dr, REQUIRED);
2626 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2628 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2629 BT_INTEGER, di, GFC_STD_F95,
2630 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2631 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2632 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2634 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2636 add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2637 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2638 x, BT_UNKNOWN, 0, REQUIRED);
2640 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2644 /* Add intrinsic subroutines. */
2647 add_subroutines (void)
2649 /* Argument names as in the standard (to be used as argument keywords). */
2651 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2652 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2653 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2654 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2655 *com = "command", *length = "length", *st = "status",
2656 *val = "value", *num = "number", *name = "name",
2657 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2658 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2659 *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2660 *p2 = "path2", *msk = "mask", *old = "old";
2662 int di, dr, dc, dl, ii;
2664 di = gfc_default_integer_kind;
2665 dr = gfc_default_real_kind;
2666 dc = gfc_default_character_kind;
2667 dl = gfc_default_logical_kind;
2668 ii = gfc_index_integer_kind;
2670 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2674 add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2675 GFC_STD_F95, gfc_check_cpu_time, NULL,
2676 gfc_resolve_cpu_time,
2677 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2679 /* More G77 compatibility garbage. */
2680 add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2681 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2682 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2684 add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2685 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2686 vl, BT_INTEGER, 4, REQUIRED);
2688 add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2689 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2690 vl, BT_INTEGER, 4, REQUIRED);
2692 add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2693 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2694 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2696 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2697 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2698 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2700 add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2701 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2702 tm, BT_REAL, dr, REQUIRED);
2704 add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2705 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2706 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2708 add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2709 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2710 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2711 st, BT_INTEGER, di, OPTIONAL);
2713 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2714 GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2715 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2716 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2717 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2718 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2720 /* More G77 compatibility garbage. */
2721 add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2722 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2723 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2725 add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2726 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2727 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2729 add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2730 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2731 dt, BT_CHARACTER, dc, REQUIRED);
2733 add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2734 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2737 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2738 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2739 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2741 add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2743 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2746 add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2747 gfc_check_getarg, NULL, gfc_resolve_getarg,
2748 pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2750 add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2751 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2754 /* F2003 commandline routines. */
2756 add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2757 0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2758 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2759 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2760 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2762 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2763 BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2764 gfc_resolve_get_command_argument,
2765 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2766 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2767 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2768 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2770 /* F2003 subroutine to get environment variables. */
2772 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2773 NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2774 NULL, NULL, gfc_resolve_get_environment_variable,
2775 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2776 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2777 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2778 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2779 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2781 add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2782 GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2783 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2784 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2786 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2787 GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2789 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2790 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2791 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2792 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2793 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2795 add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2796 BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2797 gfc_resolve_random_number,
2798 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2800 add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2801 BT_UNKNOWN, 0, GFC_STD_F95,
2802 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2803 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2804 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2805 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2807 /* More G77 compatibility garbage. */
2808 add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2809 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2810 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2811 st, BT_INTEGER, di, OPTIONAL);
2813 add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2814 gfc_check_srand, NULL, gfc_resolve_srand,
2815 "seed", BT_INTEGER, 4, REQUIRED);
2817 add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2818 gfc_check_exit, NULL, gfc_resolve_exit,
2819 st, BT_INTEGER, di, OPTIONAL);
2823 add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2824 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2825 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2826 st, BT_INTEGER, di, OPTIONAL);
2828 add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2829 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2830 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2832 add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2833 gfc_check_flush, NULL, gfc_resolve_flush,
2834 ut, BT_INTEGER, di, OPTIONAL);
2836 add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2837 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2838 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2839 st, BT_INTEGER, di, OPTIONAL);
2841 add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2842 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2843 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2845 add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2846 gfc_check_free, NULL, gfc_resolve_free,
2847 ptr, BT_INTEGER, ii, REQUIRED);
2849 add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2850 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2851 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2852 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2853 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2854 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2856 add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2857 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2858 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2860 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2861 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2862 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2864 add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2865 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2866 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2868 add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2869 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2870 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2871 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2873 add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2874 gfc_check_perror, NULL, gfc_resolve_perror,
2875 "string", BT_CHARACTER, dc, REQUIRED);
2877 add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2878 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2879 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2880 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2882 add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2883 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2884 sec, BT_INTEGER, di, REQUIRED);
2886 add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2887 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2888 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2889 st, BT_INTEGER, di, OPTIONAL);
2891 add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2892 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2893 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2894 st, BT_INTEGER, di, OPTIONAL);
2896 add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2897 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2898 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2899 st, BT_INTEGER, di, OPTIONAL);
2901 add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2902 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2903 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2904 st, BT_INTEGER, di, OPTIONAL);
2906 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2907 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2908 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2909 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2911 add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2912 NULL, NULL, gfc_resolve_system_sub,
2913 com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2915 add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2916 BT_UNKNOWN, 0, GFC_STD_F95,
2917 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2918 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2919 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2920 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2922 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2923 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2924 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2926 add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2927 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2928 msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2930 add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2931 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2932 "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2936 /* Add a function to the list of conversion symbols. */
2939 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2941 gfc_typespec from, to;
2942 gfc_intrinsic_sym *sym;
2944 if (sizing == SZ_CONVS)
2950 gfc_clear_ts (&from);
2951 from.type = from_type;
2952 from.kind = from_kind;
2958 sym = conversion + nconv;
2960 sym->name = conv_name (&from, &to);
2961 sym->lib_name = sym->name;
2962 sym->simplify.cc = gfc_convert_constant;
2963 sym->standard = standard;
2965 sym->conversion = 1;
2967 sym->id = GFC_ISYM_CONVERSION;
2973 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2974 functions by looping over the kind tables. */
2977 add_conversions (void)
2981 /* Integer-Integer conversions. */
2982 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2983 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2988 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2989 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2992 /* Integer-Real/Complex conversions. */
2993 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2994 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2996 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2997 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2999 add_conv (BT_REAL, gfc_real_kinds[j].kind,
3000 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3002 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3003 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3005 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
3006 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
3009 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3011 /* Hollerith-Integer conversions. */
3012 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3013 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3014 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3015 /* Hollerith-Real conversions. */
3016 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3017 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3018 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3019 /* Hollerith-Complex conversions. */
3020 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3021 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3022 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3024 /* Hollerith-Character conversions. */
3025 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3026 gfc_default_character_kind, GFC_STD_LEGACY);
3028 /* Hollerith-Logical conversions. */
3029 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3030 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3031 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3034 /* Real/Complex - Real/Complex conversions. */
3035 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3036 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3040 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3041 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3043 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3044 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3047 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3048 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3050 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3051 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3054 /* Logical/Logical kind conversion. */
3055 for (i = 0; gfc_logical_kinds[i].kind; i++)
3056 for (j = 0; gfc_logical_kinds[j].kind; j++)
3061 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3062 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3065 /* Integer-Logical and Logical-Integer conversions. */
3066 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3067 for (i=0; gfc_integer_kinds[i].kind; i++)
3068 for (j=0; gfc_logical_kinds[j].kind; j++)
3070 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3071 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3072 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3073 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3079 add_char_conversions (void)
3083 /* Count possible conversions. */
3084 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3085 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3089 /* Allocate memory. */
3090 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3092 /* Add the conversions themselves. */
3094 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3095 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3097 gfc_typespec from, to;
3102 gfc_clear_ts (&from);
3103 from.type = BT_CHARACTER;
3104 from.kind = gfc_character_kinds[i].kind;
3107 to.type = BT_CHARACTER;
3108 to.kind = gfc_character_kinds[j].kind;
3110 char_conversions[n].name = conv_name (&from, &to);
3111 char_conversions[n].lib_name = char_conversions[n].name;
3112 char_conversions[n].simplify.cc = gfc_convert_char_constant;
3113 char_conversions[n].standard = GFC_STD_F2003;
3114 char_conversions[n].elemental = 1;
3115 char_conversions[n].conversion = 0;
3116 char_conversions[n].ts = to;
3117 char_conversions[n].id = GFC_ISYM_CONVERSION;
3124 /* Initialize the table of intrinsics. */
3126 gfc_intrinsic_init_1 (void)
3130 nargs = nfunc = nsub = nconv = 0;
3132 /* Create a namespace to hold the resolved intrinsic symbols. */
3133 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3142 functions = XCNEWVAR (struct gfc_intrinsic_sym,
3143 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3144 + sizeof (gfc_intrinsic_arg) * nargs);
3146 next_sym = functions;
3147 subroutines = functions + nfunc;
3149 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3151 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3153 sizing = SZ_NOTHING;
3160 /* Character conversion intrinsics need to be treated separately. */
3161 add_char_conversions ();
3163 /* Set the pure flag. All intrinsic functions are pure, and
3164 intrinsic subroutines are pure if they are elemental. */
3166 for (i = 0; i < nfunc; i++)
3167 functions[i].pure = 1;
3169 for (i = 0; i < nsub; i++)
3170 subroutines[i].pure = subroutines[i].elemental;
3175 gfc_intrinsic_done_1 (void)
3177 gfc_free (functions);
3178 gfc_free (conversion);
3179 gfc_free (char_conversions);
3180 gfc_free_namespace (gfc_intrinsic_namespace);
3184 /******** Subroutines to check intrinsic interfaces ***********/
3186 /* Given a formal argument list, remove any NULL arguments that may
3187 have been left behind by a sort against some formal argument list. */
3190 remove_nullargs (gfc_actual_arglist **ap)
3192 gfc_actual_arglist *head, *tail, *next;
3196 for (head = *ap; head; head = next)
3200 if (head->expr == NULL && !head->label)
3203 gfc_free_actual_arglist (head);
3222 /* Given an actual arglist and a formal arglist, sort the actual
3223 arglist so that its arguments are in a one-to-one correspondence
3224 with the format arglist. Arguments that are not present are given
3225 a blank gfc_actual_arglist structure. If something is obviously
3226 wrong (say, a missing required argument) we abort sorting and
3230 sort_actual (const char *name, gfc_actual_arglist **ap,
3231 gfc_intrinsic_arg *formal, locus *where)
3233 gfc_actual_arglist *actual, *a;
3234 gfc_intrinsic_arg *f;
3236 remove_nullargs (ap);
3239 for (f = formal; f; f = f->next)
3245 if (f == NULL && a == NULL) /* No arguments */
3249 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3255 if (a->name != NULL)
3267 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3271 /* Associate the remaining actual arguments, all of which have
3272 to be keyword arguments. */
3273 for (; a; a = a->next)
3275 for (f = formal; f; f = f->next)
3276 if (strcmp (a->name, f->name) == 0)
3281 if (a->name[0] == '%')
3282 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3283 "are not allowed in this context at %L", where);
3285 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3286 a->name, name, where);
3290 if (f->actual != NULL)
3292 gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3293 f->name, name, where);
3301 /* At this point, all unmatched formal args must be optional. */
3302 for (f = formal; f; f = f->next)
3304 if (f->actual == NULL && f->optional == 0)
3306 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3307 f->name, name, where);
3313 /* Using the formal argument list, string the actual argument list
3314 together in a way that corresponds with the formal list. */
3317 for (f = formal; f; f = f->next)
3319 if (f->actual && f->actual->label != NULL && f->ts.type)
3321 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3325 if (f->actual == NULL)
3327 a = gfc_get_actual_arglist ();
3328 a->missing_arg_type = f->ts.type;
3340 actual->next = NULL; /* End the sorted argument list. */
3346 /* Compare an actual argument list with an intrinsic's formal argument
3347 list. The lists are checked for agreement of type. We don't check
3348 for arrayness here. */
3351 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3354 gfc_actual_arglist *actual;
3355 gfc_intrinsic_arg *formal;
3358 formal = sym->formal;
3362 for (; formal; formal = formal->next, actual = actual->next, i++)
3366 if (actual->expr == NULL)
3371 /* A kind of 0 means we don't check for kind. */
3373 ts.kind = actual->expr->ts.kind;
3375 if (!gfc_compare_types (&ts, &actual->expr->ts))
3378 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3379 "be %s, not %s", gfc_current_intrinsic_arg[i],
3380 gfc_current_intrinsic, &actual->expr->where,
3381 gfc_typename (&formal->ts),
3382 gfc_typename (&actual->expr->ts));
3391 /* Given a pointer to an intrinsic symbol and an expression node that
3392 represent the function call to that subroutine, figure out the type
3393 of the result. This may involve calling a resolution subroutine. */
3396 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3398 gfc_expr *a1, *a2, *a3, *a4, *a5;
3399 gfc_actual_arglist *arg;
3401 if (specific->resolve.f1 == NULL)
3403 if (e->value.function.name == NULL)
3404 e->value.function.name = specific->lib_name;
3406 if (e->ts.type == BT_UNKNOWN)
3407 e->ts = specific->ts;
3411 arg = e->value.function.actual;
3413 /* Special case hacks for MIN and MAX. */
3414 if (specific->resolve.f1m == gfc_resolve_max
3415 || specific->resolve.f1m == gfc_resolve_min)
3417 (*specific->resolve.f1m) (e, arg);
3423 (*specific->resolve.f0) (e);
3432 (*specific->resolve.f1) (e, a1);
3441 (*specific->resolve.f2) (e, a1, a2);
3450 (*specific->resolve.f3) (e, a1, a2, a3);
3459 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3468 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3472 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3476 /* Given an intrinsic symbol node and an expression node, call the
3477 simplification function (if there is one), perhaps replacing the
3478 expression with something simpler. We return FAILURE on an error
3479 of the simplification, SUCCESS if the simplification worked, even
3480 if nothing has changed in the expression itself. */
3483 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3485 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3486 gfc_actual_arglist *arg;
3488 /* Max and min require special handling due to the variable number
3490 if (specific->simplify.f1 == gfc_simplify_min)
3492 result = gfc_simplify_min (e);
3496 if (specific->simplify.f1 == gfc_simplify_max)
3498 result = gfc_simplify_max (e);
3502 if (specific->simplify.f1 == NULL)
3508 arg = e->value.function.actual;
3512 result = (*specific->simplify.f0) ();
3519 if (specific->simplify.cc == gfc_convert_constant
3520 || specific->simplify.cc == gfc_convert_char_constant)
3522 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3527 result = (*specific->simplify.f1) (a1);
3534 result = (*specific->simplify.f2) (a1, a2);
3541 result = (*specific->simplify.f3) (a1, a2, a3);
3548 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3555 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3558 ("do_simplify(): Too many args for intrinsic");
3565 if (result == &gfc_bad_expr)
3569 resolve_intrinsic (specific, e); /* Must call at run-time */
3572 result->where = e->where;
3573 gfc_replace_expr (e, result);
3580 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3581 error messages. This subroutine returns FAILURE if a subroutine
3582 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3583 list cannot match any intrinsic. */
3586 init_arglist (gfc_intrinsic_sym *isym)
3588 gfc_intrinsic_arg *formal;
3591 gfc_current_intrinsic = isym->name;
3594 for (formal = isym->formal; formal; formal = formal->next)
3596 if (i >= MAX_INTRINSIC_ARGS)
3597 gfc_internal_error ("init_arglist(): too many arguments");
3598 gfc_current_intrinsic_arg[i++] = formal->name;
3603 /* Given a pointer to an intrinsic symbol and an expression consisting
3604 of a function call, see if the function call is consistent with the
3605 intrinsic's formal argument list. Return SUCCESS if the expression
3606 and intrinsic match, FAILURE otherwise. */
3609 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3611 gfc_actual_arglist *arg, **ap;
3614 ap = &expr->value.function.actual;
3616 init_arglist (specific);
3618 /* Don't attempt to sort the argument list for min or max. */
3619 if (specific->check.f1m == gfc_check_min_max
3620 || specific->check.f1m == gfc_check_min_max_integer
3621 || specific->check.f1m == gfc_check_min_max_real
3622 || specific->check.f1m == gfc_check_min_max_double)
3623 return (*specific->check.f1m) (*ap);
3625 if (sort_actual (specific->name, ap, specific->formal,
3626 &expr->where) == FAILURE)
3629 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3630 /* This is special because we might have to reorder the argument list. */
3631 t = gfc_check_minloc_maxloc (*ap);
3632 else if (specific->check.f3red == gfc_check_minval_maxval)
3633 /* This is also special because we also might have to reorder the
3635 t = gfc_check_minval_maxval (*ap);
3636 else if (specific->check.f3red == gfc_check_product_sum)
3637 /* Same here. The difference to the previous case is that we allow a
3638 general numeric type. */
3639 t = gfc_check_product_sum (*ap);
3642 if (specific->check.f1 == NULL)
3644 t = check_arglist (ap, specific, error_flag);
3646 expr->ts = specific->ts;
3649 t = do_check (specific, *ap);
3652 /* Check conformance of elemental intrinsics. */
3653 if (t == SUCCESS && specific->elemental)
3656 gfc_expr *first_expr;
3657 arg = expr->value.function.actual;
3659 /* There is no elemental intrinsic without arguments. */
3660 gcc_assert(arg != NULL);
3661 first_expr = arg->expr;
3663 for ( ; arg && arg->expr; arg = arg->next, n++)
3664 if (gfc_check_conformance (first_expr, arg->expr,
3665 "arguments '%s' and '%s' for "
3667 gfc_current_intrinsic_arg[0],
3668 gfc_current_intrinsic_arg[n],
3669 gfc_current_intrinsic) == FAILURE)
3674 remove_nullargs (ap);
3680 /* Check whether an intrinsic belongs to whatever standard the user
3681 has chosen, taking also into account -fall-intrinsics. Here, no
3682 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3683 textual representation of the symbols standard status (like
3684 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3685 can be used to construct a detailed warning/error message in case of
3689 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3690 const char** symstd, bool silent, locus where)
3692 const char* symstd_msg;
3694 /* For -fall-intrinsics, just succeed. */
3695 if (gfc_option.flag_all_intrinsics)
3698 /* Find the symbol's standard message for later usage. */
3699 switch (isym->standard)
3702 symstd_msg = "available since Fortran 77";
3705 case GFC_STD_F95_OBS:
3706 symstd_msg = "obsolescent in Fortran 95";
3709 case GFC_STD_F95_DEL:
3710 symstd_msg = "deleted in Fortran 95";
3714 symstd_msg = "new in Fortran 95";
3718 symstd_msg = "new in Fortran 2003";
3722 symstd_msg = "new in Fortran 2008";
3726 symstd_msg = "a GNU Fortran extension";
3729 case GFC_STD_LEGACY:
3730 symstd_msg = "for backward compatibility";
3734 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3735 isym->name, isym->standard);
3738 /* If warning about the standard, warn and succeed. */
3739 if (gfc_option.warn_std & isym->standard)
3741 /* Do only print a warning if not a GNU extension. */
3742 if (!silent && isym->standard != GFC_STD_GNU)
3743 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3744 isym->name, _(symstd_msg), &where);
3749 /* If allowing the symbol's standard, succeed, too. */
3750 if (gfc_option.allow_std & isym->standard)
3753 /* Otherwise, fail. */
3755 *symstd = _(symstd_msg);
3760 /* See if a function call corresponds to an intrinsic function call.
3763 MATCH_YES if the call corresponds to an intrinsic, simplification
3764 is done if possible.
3766 MATCH_NO if the call does not correspond to an intrinsic
3768 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3769 error during the simplification process.
3771 The error_flag parameter enables an error reporting. */
3774 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3776 gfc_intrinsic_sym *isym, *specific;
3777 gfc_actual_arglist *actual;
3781 if (expr->value.function.isym != NULL)
3782 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3783 ? MATCH_ERROR : MATCH_YES;
3786 gfc_push_suppress_errors ();
3789 for (actual = expr->value.function.actual; actual; actual = actual->next)
3790 if (actual->expr != NULL)
3791 flag |= (actual->expr->ts.type != BT_INTEGER
3792 && actual->expr->ts.type != BT_CHARACTER);
3794 name = expr->symtree->n.sym->name;
3796 isym = specific = gfc_find_function (name);
3800 gfc_pop_suppress_errors ();
3804 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3805 || isym->id == GFC_ISYM_CMPLX)
3806 && gfc_init_expr_flag
3807 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3808 "as initialization expression at %L", name,
3809 &expr->where) == FAILURE)
3812 gfc_pop_suppress_errors ();
3816 gfc_current_intrinsic_where = &expr->where;
3818 /* Bypass the generic list for min and max. */
3819 if (isym->check.f1m == gfc_check_min_max)
3821 init_arglist (isym);
3823 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3827 gfc_pop_suppress_errors ();
3831 /* If the function is generic, check all of its specific
3832 incarnations. If the generic name is also a specific, we check
3833 that name last, so that any error message will correspond to the
3835 gfc_push_suppress_errors ();
3839 for (specific = isym->specific_head; specific;
3840 specific = specific->next)
3842 if (specific == isym)
3844 if (check_specific (specific, expr, 0) == SUCCESS)
3846 gfc_pop_suppress_errors ();
3852 gfc_pop_suppress_errors ();
3854 if (check_specific (isym, expr, error_flag) == FAILURE)
3857 gfc_pop_suppress_errors ();
3864 expr->value.function.isym = specific;
3865 gfc_intrinsic_symbol (expr->symtree->n.sym);
3868 gfc_pop_suppress_errors ();
3870 if (do_simplify (specific, expr) == FAILURE)
3873 /* F95, 7.1.6.1, Initialization expressions
3874 (4) An elemental intrinsic function reference of type integer or
3875 character where each argument is an initialization expression
3876 of type integer or character
3878 F2003, 7.1.7 Initialization expression
3879 (4) A reference to an elemental standard intrinsic function,
3880 where each argument is an initialization expression */
3882 if (gfc_init_expr_flag && isym->elemental && flag
3883 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3884 "as initialization expression with non-integer/non-"
3885 "character arguments at %L", &expr->where) == FAILURE)
3892 /* See if a CALL statement corresponds to an intrinsic subroutine.
3893 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3894 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3898 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3900 gfc_intrinsic_sym *isym;
3903 name = c->symtree->n.sym->name;
3905 isym = gfc_find_subroutine (name);
3910 gfc_push_suppress_errors ();
3912 init_arglist (isym);
3914 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3917 if (isym->check.f1 != NULL)
3919 if (do_check (isym, c->ext.actual) == FAILURE)
3924 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3928 /* The subroutine corresponds to an intrinsic. Allow errors to be
3929 seen at this point. */
3931 gfc_pop_suppress_errors ();
3933 c->resolved_isym = isym;
3934 if (isym->resolve.s1 != NULL)
3935 isym->resolve.s1 (c);
3938 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3939 c->resolved_sym->attr.elemental = isym->elemental;
3942 if (gfc_pure (NULL) && !isym->elemental)
3944 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3949 c->resolved_sym->attr.noreturn = isym->noreturn;
3955 gfc_pop_suppress_errors ();
3960 /* Call gfc_convert_type() with warning enabled. */
3963 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3965 return gfc_convert_type_warn (expr, ts, eflag, 1);
3969 /* Try to convert an expression (in place) from one type to another.
3970 'eflag' controls the behavior on error.
3972 The possible values are:
3974 1 Generate a gfc_error()
3975 2 Generate a gfc_internal_error().
3977 'wflag' controls the warning related to conversion. */
3980 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3982 gfc_intrinsic_sym *sym;
3983 gfc_typespec from_ts;
3989 from_ts = expr->ts; /* expr->ts gets clobbered */
3991 if (ts->type == BT_UNKNOWN)
3994 /* NULL and zero size arrays get their type here. */
3995 if (expr->expr_type == EXPR_NULL
3996 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3998 /* Sometimes the RHS acquire the type. */
4003 if (expr->ts.type == BT_UNKNOWN)
4006 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
4007 && gfc_compare_types (&expr->ts, ts))
4010 sym = find_conv (&expr->ts, ts);
4014 /* At this point, a conversion is necessary. A warning may be needed. */
4015 if ((gfc_option.warn_std & sym->standard) != 0)
4016 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4017 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4018 else if (wflag && gfc_option.warn_conversion)
4020 /* If the types are the same (but not LOGICAL), and if from-kind
4021 is larger than to-kind, this may indicate a loss of precision.
4022 The same holds for conversions from REAL to COMPLEX. */
4023 if (((from_ts.type == ts->type && from_ts.type != BT_LOGICAL)
4024 && from_ts.kind > ts->kind)
4025 || ((from_ts.type == BT_REAL && ts->type == BT_COMPLEX)
4026 && from_ts.kind > ts->kind))
4027 gfc_warning_now ("Possible loss of precision in conversion "
4028 "from %s to %s at %L", gfc_typename (&from_ts),
4029 gfc_typename (ts), &expr->where);
4031 /* If INTEGER is converted to REAL/COMPLEX, this is generally ok if
4032 the kind of the INTEGER value is less or equal to the kind of the
4033 REAL/COMPLEX one. Otherwise the value may not fit.
4034 Assignment of an overly large integer constant also generates
4035 an overflow error with range checking. */
4036 else if (from_ts.type == BT_INTEGER
4037 && (ts->type == BT_REAL || ts->type == BT_COMPLEX)
4038 && from_ts.kind > ts->kind)
4039 gfc_warning_now ("Possible loss of digits in conversion "
4040 "from %s to %s at %L", gfc_typename (&from_ts),
4041 gfc_typename (ts), &expr->where);
4043 /* If REAL/COMPLEX is converted to INTEGER, or COMPLEX is converted
4044 to REAL we almost certainly have a loss of digits, regardless of
4045 the respective kinds. */
4046 else if (((from_ts.type == BT_REAL || from_ts.type == BT_COMPLEX)
4047 && ts->type == BT_INTEGER)
4048 || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4049 gfc_warning_now ("Likely loss of digits in conversion from"
4050 "%s to %s at %L", gfc_typename (&from_ts),
4051 gfc_typename (ts), &expr->where);
4054 /* Insert a pre-resolved function call to the right function. */
4055 old_where = expr->where;
4057 shape = expr->shape;
4059 new_expr = gfc_get_expr ();
4062 new_expr = gfc_build_conversion (new_expr);
4063 new_expr->value.function.name = sym->lib_name;
4064 new_expr->value.function.isym = sym;
4065 new_expr->where = old_where;
4066 new_expr->rank = rank;
4067 new_expr->shape = gfc_copy_shape (shape, rank);
4069 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4070 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4071 new_expr->symtree->n.sym->ts = *ts;
4072 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4073 new_expr->symtree->n.sym->attr.function = 1;
4074 new_expr->symtree->n.sym->attr.elemental = 1;
4075 new_expr->symtree->n.sym->attr.pure = 1;
4076 new_expr->symtree->n.sym->attr.referenced = 1;
4077 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4078 gfc_commit_symbol (new_expr->symtree->n.sym);
4082 gfc_free (new_expr);
4085 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4086 && do_simplify (sym, expr) == FAILURE)
4091 return FAILURE; /* Error already generated in do_simplify() */
4099 gfc_error ("Can't convert %s to %s at %L",
4100 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4104 gfc_internal_error ("Can't convert %s to %s at %L",
4105 gfc_typename (&from_ts), gfc_typename (ts),
4112 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4114 gfc_intrinsic_sym *sym;
4120 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4122 sym = find_char_conv (&expr->ts, ts);
4125 /* Insert a pre-resolved function call to the right function. */
4126 old_where = expr->where;
4128 shape = expr->shape;
4130 new_expr = gfc_get_expr ();
4133 new_expr = gfc_build_conversion (new_expr);
4134 new_expr->value.function.name = sym->lib_name;
4135 new_expr->value.function.isym = sym;
4136 new_expr->where = old_where;
4137 new_expr->rank = rank;
4138 new_expr->shape = gfc_copy_shape (shape, rank);
4140 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4141 new_expr->symtree->n.sym->ts = *ts;
4142 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4143 new_expr->symtree->n.sym->attr.function = 1;
4144 new_expr->symtree->n.sym->attr.elemental = 1;
4145 new_expr->symtree->n.sym->attr.referenced = 1;
4146 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4147 gfc_commit_symbol (new_expr->symtree->n.sym);
4151 gfc_free (new_expr);
4154 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4155 && do_simplify (sym, expr) == FAILURE)
4157 /* Error already generated in do_simplify() */
4165 /* Check if the passed name is name of an intrinsic (taking into account the
4166 current -std=* and -fall-intrinsic settings). If it is, see if we should
4167 warn about this as a user-procedure having the same name as an intrinsic
4168 (-Wintrinsic-shadow enabled) and do so if we should. */
4171 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4173 gfc_intrinsic_sym* isym;
4175 /* If the warning is disabled, do nothing at all. */
4176 if (!gfc_option.warn_intrinsic_shadow)
4179 /* Try to find an intrinsic of the same name. */
4181 isym = gfc_find_function (sym->name);
4183 isym = gfc_find_subroutine (sym->name);
4185 /* If no intrinsic was found with this name or it's not included in the
4186 selected standard, everything's fine. */
4187 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4188 sym->declared_at) == FAILURE)
4191 /* Emit the warning. */
4193 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4194 " name. In order to call the intrinsic, explicit INTRINSIC"
4195 " declarations may be required.",
4196 sym->name, &sym->declared_at);
4198 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4199 " only be called via an explicit interface or if declared"
4200 " EXTERNAL.", sym->name, &sym->declared_at);