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 int gfc_init_expr = 0;
35 /* Pointers to an intrinsic function and its argument names that are being
38 const char *gfc_current_intrinsic;
39 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
40 locus *gfc_current_intrinsic_where;
42 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
43 static gfc_intrinsic_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)
961 if (gfc_option.warn_intrinsics_std)
962 gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
963 " selected standard but %s and '%s' will be"
964 " treated as if declared EXTERNAL. Use an"
965 " appropriate -std=* option or define"
966 " -fall-intrinsics to allow this intrinsic.",
967 sym->name, &loc, symstd, sym->name);
968 gfc_add_external (&sym->attr, &loc);
978 /* Collect a set of intrinsic functions into a generic collection.
979 The first argument is the name of the generic function, which is
980 also the name of a specific function. The rest of the specifics
981 currently in the table are placed into the list of specific
982 functions associated with that generic.
985 FIXME: Remove the argument STANDARD if no regressions are
986 encountered. Change all callers (approx. 360).
990 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
992 gfc_intrinsic_sym *g;
994 if (sizing != SZ_NOTHING)
997 g = gfc_find_function (name);
999 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
1002 gcc_assert (g->id == id);
1006 if ((g + 1)->name != NULL)
1007 g->specific_head = g + 1;
1010 while (g->name != NULL)
1022 /* Create a duplicate intrinsic function entry for the current
1023 function, the only differences being the alternate name and
1024 a different standard if necessary. Note that we use argument
1025 lists more than once, but all argument lists are freed as a
1029 make_alias (const char *name, int standard)
1042 next_sym[0] = next_sym[-1];
1043 next_sym->name = gfc_get_string (name);
1044 next_sym->standard = standard;
1054 /* Make the current subroutine noreturn. */
1057 make_noreturn (void)
1059 if (sizing == SZ_NOTHING)
1060 next_sym[-1].noreturn = 1;
1064 /* Add intrinsic functions. */
1067 add_functions (void)
1069 /* Argument names as in the standard (to be used as argument keywords). */
1071 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1072 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1073 *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1074 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1075 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1076 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1077 *p = "p", *ar = "array", *shp = "shape", *src = "source",
1078 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1079 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1080 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1081 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1082 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1083 *num = "number", *tm = "time", *nm = "name", *md = "mode",
1084 *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command";
1086 int di, dr, dd, dl, dc, dz, ii;
1088 di = gfc_default_integer_kind;
1089 dr = gfc_default_real_kind;
1090 dd = gfc_default_double_kind;
1091 dl = gfc_default_logical_kind;
1092 dc = gfc_default_character_kind;
1093 dz = gfc_default_complex_kind;
1094 ii = gfc_index_integer_kind;
1096 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1097 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1098 a, BT_REAL, dr, REQUIRED);
1100 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1101 NULL, gfc_simplify_abs, gfc_resolve_abs,
1102 a, BT_INTEGER, di, REQUIRED);
1104 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1105 gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1106 a, BT_REAL, dd, REQUIRED);
1108 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1109 NULL, gfc_simplify_abs, gfc_resolve_abs,
1110 a, BT_COMPLEX, dz, REQUIRED);
1112 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1113 NULL, gfc_simplify_abs, gfc_resolve_abs,
1114 a, BT_COMPLEX, dd, REQUIRED);
1116 make_alias ("cdabs", GFC_STD_GNU);
1118 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1120 /* The checking function for ACCESS is called gfc_check_access_func
1121 because the name gfc_check_access is already used in module.c. */
1122 add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1123 gfc_check_access_func, NULL, gfc_resolve_access,
1124 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1126 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1128 add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1129 BT_CHARACTER, dc, GFC_STD_F95,
1130 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1131 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1133 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1135 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1136 gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1137 x, BT_REAL, dr, REQUIRED);
1139 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1140 gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1141 x, BT_REAL, dd, REQUIRED);
1143 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1145 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1146 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1147 gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1149 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1150 gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1151 x, BT_REAL, dd, REQUIRED);
1153 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1155 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1156 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1157 gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1159 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1161 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1162 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1163 gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1165 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1167 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1168 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1169 z, BT_COMPLEX, dz, REQUIRED);
1171 make_alias ("imag", GFC_STD_GNU);
1172 make_alias ("imagpart", GFC_STD_GNU);
1174 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1175 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1176 z, BT_COMPLEX, dd, REQUIRED);
1178 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1180 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1181 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1182 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1184 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1185 NULL, gfc_simplify_dint, gfc_resolve_dint,
1186 a, BT_REAL, dd, REQUIRED);
1188 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1190 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1191 gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1192 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1194 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1196 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1197 gfc_check_allocated, NULL, NULL,
1198 ar, BT_UNKNOWN, 0, REQUIRED);
1200 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1202 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1203 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1204 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1206 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1207 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1208 a, BT_REAL, dd, REQUIRED);
1210 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1212 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1213 gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1214 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1216 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1218 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1219 gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1220 x, BT_REAL, dr, REQUIRED);
1222 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1223 gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1224 x, BT_REAL, dd, REQUIRED);
1226 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1228 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1229 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1230 gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1232 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1233 gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1234 x, BT_REAL, dd, REQUIRED);
1236 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1238 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1239 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1240 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1242 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1244 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1245 gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1246 x, BT_REAL, dr, REQUIRED);
1248 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1249 gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1250 x, BT_REAL, dd, REQUIRED);
1252 /* Two-argument version of atan, equivalent to atan2. */
1253 add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1254 gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1255 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1257 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1259 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1260 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1261 gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1263 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1264 gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1265 x, BT_REAL, dd, REQUIRED);
1267 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1269 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1270 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1271 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1273 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1274 gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1275 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1277 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1279 /* Bessel and Neumann functions for G77 compatibility. */
1280 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1281 gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1282 x, BT_REAL, dr, REQUIRED);
1284 make_alias ("bessel_j0", GFC_STD_F2008);
1286 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1287 gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1288 x, BT_REAL, dd, REQUIRED);
1290 make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1292 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1293 gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1294 x, BT_REAL, dr, REQUIRED);
1296 make_alias ("bessel_j1", GFC_STD_F2008);
1298 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1299 gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1300 x, BT_REAL, dd, REQUIRED);
1302 make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1304 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1305 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1306 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1308 make_alias ("bessel_jn", GFC_STD_F2008);
1310 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1311 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1312 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1314 make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1316 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1317 gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1318 x, BT_REAL, dr, REQUIRED);
1320 make_alias ("bessel_y0", GFC_STD_F2008);
1322 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1323 gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1324 x, BT_REAL, dd, REQUIRED);
1326 make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1328 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1329 gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1330 x, BT_REAL, dr, REQUIRED);
1332 make_alias ("bessel_y1", GFC_STD_F2008);
1334 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1335 gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1336 x, BT_REAL, dd, REQUIRED);
1338 make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1340 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1341 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1342 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1344 make_alias ("bessel_yn", GFC_STD_F2008);
1346 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1347 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1348 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1350 make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1352 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1353 gfc_check_i, gfc_simplify_bit_size, NULL,
1354 i, BT_INTEGER, di, REQUIRED);
1356 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1358 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1359 gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1360 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1362 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1364 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1365 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1366 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1368 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1370 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1371 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1372 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1374 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1376 add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1377 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1378 nm, BT_CHARACTER, dc, REQUIRED);
1380 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1382 add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1383 gfc_check_chmod, NULL, gfc_resolve_chmod,
1384 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1386 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1388 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1389 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1390 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1391 kind, BT_INTEGER, di, OPTIONAL);
1393 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1395 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1396 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1398 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1401 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1402 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1403 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1405 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1407 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1408 complex instead of the default complex. */
1410 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1411 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1412 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1414 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1416 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1417 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1418 z, BT_COMPLEX, dz, REQUIRED);
1420 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1421 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1422 z, BT_COMPLEX, dd, REQUIRED);
1424 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1426 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1427 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1428 x, BT_REAL, dr, REQUIRED);
1430 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1431 gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1432 x, BT_REAL, dd, REQUIRED);
1434 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1435 NULL, gfc_simplify_cos, gfc_resolve_cos,
1436 x, BT_COMPLEX, dz, REQUIRED);
1438 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1439 NULL, gfc_simplify_cos, gfc_resolve_cos,
1440 x, BT_COMPLEX, dd, REQUIRED);
1442 make_alias ("cdcos", GFC_STD_GNU);
1444 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1446 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1447 gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1448 x, BT_REAL, dr, REQUIRED);
1450 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1451 gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1452 x, BT_REAL, dd, REQUIRED);
1454 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1456 add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1457 BT_INTEGER, di, GFC_STD_F95,
1458 gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1459 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1460 kind, BT_INTEGER, di, OPTIONAL);
1462 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1464 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1465 gfc_check_cshift, NULL, gfc_resolve_cshift,
1466 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1467 dm, BT_INTEGER, ii, OPTIONAL);
1469 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1471 add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1472 gfc_check_ctime, NULL, gfc_resolve_ctime,
1473 tm, BT_INTEGER, di, REQUIRED);
1475 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1477 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1478 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1479 a, BT_REAL, dr, REQUIRED);
1481 make_alias ("dfloat", GFC_STD_GNU);
1483 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1485 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1486 gfc_check_digits, gfc_simplify_digits, NULL,
1487 x, BT_UNKNOWN, dr, REQUIRED);
1489 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1491 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1492 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1493 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1495 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1496 NULL, gfc_simplify_dim, gfc_resolve_dim,
1497 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1499 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1500 gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1501 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1503 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1505 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1506 GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1507 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1509 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1511 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1512 gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1513 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1515 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1517 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1519 a, BT_COMPLEX, dd, REQUIRED);
1521 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1523 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1524 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1525 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1526 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1528 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1530 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1531 gfc_check_x, gfc_simplify_epsilon, NULL,
1532 x, BT_REAL, dr, REQUIRED);
1534 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1536 /* G77 compatibility for the ERF() and ERFC() functions. */
1537 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1538 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1539 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1541 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1542 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1543 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1545 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1547 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1548 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1549 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1551 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1552 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1553 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1555 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1557 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1558 BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1559 gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1562 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1564 /* G77 compatibility */
1565 add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1566 gfc_check_dtime_etime, NULL, NULL,
1567 x, BT_REAL, 4, REQUIRED);
1569 make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1571 add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1572 gfc_check_dtime_etime, NULL, NULL,
1573 x, BT_REAL, 4, REQUIRED);
1575 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1577 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1578 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1579 x, BT_REAL, dr, REQUIRED);
1581 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1582 gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1583 x, BT_REAL, dd, REQUIRED);
1585 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1586 NULL, gfc_simplify_exp, gfc_resolve_exp,
1587 x, BT_COMPLEX, dz, REQUIRED);
1589 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1590 NULL, gfc_simplify_exp, gfc_resolve_exp,
1591 x, BT_COMPLEX, dd, REQUIRED);
1593 make_alias ("cdexp", GFC_STD_GNU);
1595 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1597 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1598 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1599 x, BT_REAL, dr, REQUIRED);
1601 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1603 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1604 ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1605 gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1606 a, BT_UNKNOWN, 0, REQUIRED,
1607 mo, BT_UNKNOWN, 0, REQUIRED);
1609 add_sym_0 ("fdate", GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1610 NULL, NULL, gfc_resolve_fdate);
1612 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1614 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1615 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1616 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1618 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1620 /* G77 compatible fnum */
1621 add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1622 gfc_check_fnum, NULL, gfc_resolve_fnum,
1623 ut, BT_INTEGER, di, REQUIRED);
1625 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1627 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1628 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1629 x, BT_REAL, dr, REQUIRED);
1631 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1633 add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1634 GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1635 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1637 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1639 add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1640 gfc_check_ftell, NULL, gfc_resolve_ftell,
1641 ut, BT_INTEGER, di, REQUIRED);
1643 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1645 add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1646 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1647 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1649 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1651 add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1652 gfc_check_fgetput, NULL, gfc_resolve_fget,
1653 c, BT_CHARACTER, dc, REQUIRED);
1655 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1657 add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1658 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1659 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1661 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1663 add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1664 gfc_check_fgetput, NULL, gfc_resolve_fput,
1665 c, BT_CHARACTER, dc, REQUIRED);
1667 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1669 add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1670 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1671 gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1673 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1674 gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1675 x, BT_REAL, dr, REQUIRED);
1677 make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1679 /* Unix IDs (g77 compatibility) */
1680 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1681 NULL, NULL, gfc_resolve_getcwd,
1682 c, BT_CHARACTER, dc, REQUIRED);
1684 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1686 add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1687 NULL, NULL, gfc_resolve_getgid);
1689 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1691 add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1692 NULL, NULL, gfc_resolve_getpid);
1694 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1696 add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1697 NULL, NULL, gfc_resolve_getuid);
1699 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1701 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1702 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1703 a, BT_CHARACTER, dc, REQUIRED);
1705 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1707 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1708 gfc_check_huge, gfc_simplify_huge, NULL,
1709 x, BT_UNKNOWN, dr, REQUIRED);
1711 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1713 add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1714 BT_REAL, dr, GFC_STD_F2008,
1715 gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1716 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1718 make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1720 add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1721 BT_INTEGER, di, GFC_STD_F95,
1722 gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1723 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1725 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1727 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1728 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1729 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1731 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1733 add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1734 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1735 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1737 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1739 add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1742 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1744 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1745 gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1746 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1748 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1750 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1751 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1752 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1753 ln, BT_INTEGER, di, REQUIRED);
1755 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1757 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1758 gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1759 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1761 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1763 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1764 BT_INTEGER, di, GFC_STD_F77,
1765 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1766 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1768 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1770 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1771 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1772 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1774 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1776 add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1777 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1778 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1780 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1782 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1783 NULL, NULL, gfc_resolve_ierrno);
1785 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1787 /* The resolution function for INDEX is called gfc_resolve_index_func
1788 because the name gfc_resolve_index is already used in resolve.c. */
1789 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1790 BT_INTEGER, di, GFC_STD_F77,
1791 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1792 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1793 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1795 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1797 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1798 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1799 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1801 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1802 NULL, gfc_simplify_ifix, NULL,
1803 a, BT_REAL, dr, REQUIRED);
1805 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1806 NULL, gfc_simplify_idint, NULL,
1807 a, BT_REAL, dd, REQUIRED);
1809 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1811 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1812 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1813 a, BT_REAL, dr, REQUIRED);
1815 make_alias ("short", GFC_STD_GNU);
1817 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1819 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1820 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1821 a, BT_REAL, dr, REQUIRED);
1823 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1825 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1826 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1827 a, BT_REAL, dr, REQUIRED);
1829 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1831 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1832 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1833 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1835 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1837 add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1838 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1839 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1841 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1843 /* The following function is for G77 compatibility. */
1844 add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1845 gfc_check_irand, NULL, NULL,
1846 i, BT_INTEGER, 4, OPTIONAL);
1848 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1850 add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1851 gfc_check_isatty, NULL, gfc_resolve_isatty,
1852 ut, BT_INTEGER, di, REQUIRED);
1854 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1856 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1857 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1858 gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1859 i, BT_INTEGER, 0, REQUIRED);
1861 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1863 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1864 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1865 gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1866 i, BT_INTEGER, 0, REQUIRED);
1868 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1870 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1871 BT_LOGICAL, dl, GFC_STD_GNU,
1872 gfc_check_isnan, gfc_simplify_isnan, NULL,
1873 x, BT_REAL, 0, REQUIRED);
1875 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1877 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1878 gfc_check_ishft, NULL, gfc_resolve_rshift,
1879 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1881 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1883 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1884 gfc_check_ishft, NULL, gfc_resolve_lshift,
1885 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1887 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1889 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1890 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1891 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1893 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1895 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1896 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1897 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1898 sz, BT_INTEGER, di, OPTIONAL);
1900 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1902 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1903 gfc_check_kill, NULL, gfc_resolve_kill,
1904 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1906 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1908 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1909 gfc_check_kind, gfc_simplify_kind, NULL,
1910 x, BT_REAL, dr, REQUIRED);
1912 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1914 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1915 BT_INTEGER, di, GFC_STD_F95,
1916 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1917 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1918 kind, BT_INTEGER, di, OPTIONAL);
1920 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1922 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1923 BT_INTEGER, di, GFC_STD_F2008,
1924 gfc_check_i, gfc_simplify_leadz, NULL,
1925 i, BT_INTEGER, di, REQUIRED);
1927 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1929 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1930 BT_INTEGER, di, GFC_STD_F77,
1931 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1932 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1934 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1936 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1937 BT_INTEGER, di, GFC_STD_F95,
1938 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1939 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1941 make_alias ("lnblnk", GFC_STD_GNU);
1943 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1945 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1947 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1948 x, BT_REAL, dr, REQUIRED);
1950 make_alias ("log_gamma", GFC_STD_F2008);
1952 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1953 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1954 x, BT_REAL, dr, REQUIRED);
1956 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1957 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1958 x, BT_REAL, dr, REQUIRED);
1960 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1963 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1964 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1965 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1967 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1969 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1970 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1971 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1973 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1975 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1976 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1977 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1979 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1981 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1982 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1983 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1985 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1987 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1988 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1989 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
1991 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1993 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1994 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1995 x, BT_REAL, dr, REQUIRED);
1997 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1998 NULL, gfc_simplify_log, gfc_resolve_log,
1999 x, BT_REAL, dr, REQUIRED);
2001 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2002 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2003 x, BT_REAL, dd, REQUIRED);
2005 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2006 NULL, gfc_simplify_log, gfc_resolve_log,
2007 x, BT_COMPLEX, dz, REQUIRED);
2009 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2010 NULL, gfc_simplify_log, gfc_resolve_log,
2011 x, BT_COMPLEX, dd, REQUIRED);
2013 make_alias ("cdlog", GFC_STD_GNU);
2015 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2017 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2018 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2019 x, BT_REAL, dr, REQUIRED);
2021 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2022 NULL, gfc_simplify_log10, gfc_resolve_log10,
2023 x, BT_REAL, dr, REQUIRED);
2025 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2026 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2027 x, BT_REAL, dd, REQUIRED);
2029 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2031 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2032 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2033 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2035 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2037 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2038 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2039 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2041 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2043 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2044 GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2045 sz, BT_INTEGER, di, REQUIRED);
2047 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2049 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2050 gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2051 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2053 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2055 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2056 int(max). The max function must take at least two arguments. */
2058 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2059 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2060 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2062 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2063 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2064 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2066 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2067 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2068 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2070 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2071 gfc_check_min_max_real, gfc_simplify_max, NULL,
2072 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2074 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2075 gfc_check_min_max_real, gfc_simplify_max, NULL,
2076 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2078 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2079 gfc_check_min_max_double, gfc_simplify_max, NULL,
2080 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2082 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2084 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2085 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2086 x, BT_UNKNOWN, dr, REQUIRED);
2088 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2090 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2091 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2092 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2093 msk, BT_LOGICAL, dl, OPTIONAL);
2095 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2097 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2098 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2099 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2100 msk, BT_LOGICAL, dl, OPTIONAL);
2102 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2104 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2105 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2107 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2109 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2110 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2112 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2114 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2115 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2116 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2117 msk, BT_LOGICAL, dl, REQUIRED);
2119 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2121 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2124 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2125 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2126 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2128 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2129 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2130 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2132 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2133 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2134 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2136 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2137 gfc_check_min_max_real, gfc_simplify_min, NULL,
2138 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2140 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2141 gfc_check_min_max_real, gfc_simplify_min, NULL,
2142 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2144 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2145 gfc_check_min_max_double, gfc_simplify_min, NULL,
2146 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2148 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2150 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2151 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2152 x, BT_UNKNOWN, dr, REQUIRED);
2154 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2156 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2157 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2158 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2159 msk, BT_LOGICAL, dl, OPTIONAL);
2161 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2163 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2164 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2165 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2166 msk, BT_LOGICAL, dl, OPTIONAL);
2168 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2170 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2171 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2172 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2174 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2175 NULL, gfc_simplify_mod, gfc_resolve_mod,
2176 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2178 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2179 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2180 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2182 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2184 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2185 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2186 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2188 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2190 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2191 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2192 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2194 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2196 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2197 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2198 a, BT_CHARACTER, dc, REQUIRED);
2200 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2202 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2203 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2204 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2206 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2207 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2208 a, BT_REAL, dd, REQUIRED);
2210 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2212 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2213 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2214 i, BT_INTEGER, di, REQUIRED);
2216 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2218 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2219 gfc_check_null, gfc_simplify_null, NULL,
2220 mo, BT_INTEGER, di, OPTIONAL);
2222 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2224 add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2225 NULL, gfc_simplify_num_images, NULL);
2227 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2228 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2229 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2230 v, BT_REAL, dr, OPTIONAL);
2232 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2234 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2235 gfc_check_precision, gfc_simplify_precision, NULL,
2236 x, BT_UNKNOWN, 0, REQUIRED);
2238 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2240 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2241 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2242 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2244 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2246 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2247 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2248 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2249 msk, BT_LOGICAL, dl, OPTIONAL);
2251 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2253 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2254 gfc_check_radix, gfc_simplify_radix, NULL,
2255 x, BT_UNKNOWN, 0, REQUIRED);
2257 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2259 /* The following function is for G77 compatibility. */
2260 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2261 gfc_check_rand, NULL, NULL,
2262 i, BT_INTEGER, 4, OPTIONAL);
2264 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2265 use slightly different shoddy multiplicative congruential PRNG. */
2266 make_alias ("ran", GFC_STD_GNU);
2268 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2270 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2271 gfc_check_range, gfc_simplify_range, NULL,
2272 x, BT_REAL, dr, REQUIRED);
2274 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2276 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2277 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2278 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2280 /* This provides compatibility with g77. */
2281 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2282 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2283 a, BT_UNKNOWN, dr, REQUIRED);
2285 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2286 gfc_check_i, gfc_simplify_float, NULL,
2287 a, BT_INTEGER, di, REQUIRED);
2289 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2290 NULL, gfc_simplify_sngl, NULL,
2291 a, BT_REAL, dd, REQUIRED);
2293 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2295 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2296 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2297 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2299 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2301 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2302 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2303 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2305 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2307 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2308 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2309 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2310 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2312 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2314 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2315 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2316 x, BT_REAL, dr, REQUIRED);
2318 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2320 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2321 BT_LOGICAL, dl, GFC_STD_F2003,
2322 gfc_check_same_type_as, NULL, NULL,
2323 a, BT_UNKNOWN, 0, REQUIRED,
2324 b, BT_UNKNOWN, 0, REQUIRED);
2326 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2327 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2328 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2330 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2332 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2333 BT_INTEGER, di, GFC_STD_F95,
2334 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2335 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2336 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2338 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2340 /* Added for G77 compatibility garbage. */
2341 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2344 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2346 /* Added for G77 compatibility. */
2347 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2348 gfc_check_secnds, NULL, gfc_resolve_secnds,
2349 x, BT_REAL, dr, REQUIRED);
2351 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2353 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2354 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2355 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2356 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2358 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2360 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2361 GFC_STD_F95, gfc_check_selected_int_kind,
2362 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2364 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2366 add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2367 GFC_STD_F95, gfc_check_selected_real_kind,
2368 gfc_simplify_selected_real_kind, NULL,
2369 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2371 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2373 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2374 gfc_check_set_exponent, gfc_simplify_set_exponent,
2375 gfc_resolve_set_exponent,
2376 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2378 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2380 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2381 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2382 src, BT_REAL, dr, REQUIRED);
2384 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2386 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2387 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2388 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2390 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2391 NULL, gfc_simplify_sign, gfc_resolve_sign,
2392 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2394 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2395 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2396 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2398 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2400 add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2401 gfc_check_signal, NULL, gfc_resolve_signal,
2402 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2404 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2406 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2407 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2408 x, BT_REAL, dr, REQUIRED);
2410 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2411 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2412 x, BT_REAL, dd, REQUIRED);
2414 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2415 NULL, gfc_simplify_sin, gfc_resolve_sin,
2416 x, BT_COMPLEX, dz, REQUIRED);
2418 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2419 NULL, gfc_simplify_sin, gfc_resolve_sin,
2420 x, BT_COMPLEX, dd, REQUIRED);
2422 make_alias ("cdsin", GFC_STD_GNU);
2424 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2426 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2427 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2428 x, BT_REAL, dr, REQUIRED);
2430 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2431 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2432 x, BT_REAL, dd, REQUIRED);
2434 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2436 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2437 BT_INTEGER, di, GFC_STD_F95,
2438 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2439 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2440 kind, BT_INTEGER, di, OPTIONAL);
2442 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2444 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2445 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2446 x, BT_UNKNOWN, 0, REQUIRED);
2448 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2449 make_alias ("c_sizeof", GFC_STD_F2008);
2451 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2452 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2453 x, BT_REAL, dr, REQUIRED);
2455 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2457 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2458 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2459 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2460 ncopies, BT_INTEGER, di, REQUIRED);
2462 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2464 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2465 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2466 x, BT_REAL, dr, REQUIRED);
2468 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2469 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2470 x, BT_REAL, dd, REQUIRED);
2472 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2473 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2474 x, BT_COMPLEX, dz, REQUIRED);
2476 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2477 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2478 x, BT_COMPLEX, dd, REQUIRED);
2480 make_alias ("cdsqrt", GFC_STD_GNU);
2482 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2484 add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2485 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2486 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2488 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2490 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2491 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2492 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2493 msk, BT_LOGICAL, dl, OPTIONAL);
2495 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2497 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2498 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2499 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2501 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2503 add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2504 GFC_STD_GNU, NULL, NULL, NULL,
2505 com, BT_CHARACTER, dc, REQUIRED);
2507 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2509 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2510 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2511 x, BT_REAL, dr, REQUIRED);
2513 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2514 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2515 x, BT_REAL, dd, REQUIRED);
2517 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2519 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2520 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2521 x, BT_REAL, dr, REQUIRED);
2523 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2524 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2525 x, BT_REAL, dd, REQUIRED);
2527 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2529 add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2530 NULL, NULL, gfc_resolve_time);
2532 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2534 add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2535 NULL, NULL, gfc_resolve_time8);
2537 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2539 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2540 gfc_check_x, gfc_simplify_tiny, NULL,
2541 x, BT_REAL, dr, REQUIRED);
2543 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2545 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2546 BT_INTEGER, di, GFC_STD_F2008,
2547 gfc_check_i, gfc_simplify_trailz, NULL,
2548 i, BT_INTEGER, di, REQUIRED);
2550 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2552 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2553 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2554 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2555 sz, BT_INTEGER, di, OPTIONAL);
2557 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2559 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2560 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2561 m, BT_REAL, dr, REQUIRED);
2563 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2565 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2566 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2567 stg, BT_CHARACTER, dc, REQUIRED);
2569 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2571 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2572 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2573 ut, BT_INTEGER, di, REQUIRED);
2575 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2577 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2578 BT_INTEGER, di, GFC_STD_F95,
2579 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2580 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2581 kind, BT_INTEGER, di, OPTIONAL);
2583 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2585 /* g77 compatibility for UMASK. */
2586 add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2587 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2588 msk, BT_INTEGER, di, REQUIRED);
2590 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2592 /* g77 compatibility for UNLINK. */
2593 add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2594 gfc_check_unlink, NULL, gfc_resolve_unlink,
2595 "path", BT_CHARACTER, dc, REQUIRED);
2597 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2599 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2600 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2601 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2602 f, BT_REAL, dr, REQUIRED);
2604 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2606 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2607 BT_INTEGER, di, GFC_STD_F95,
2608 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2609 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2610 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2612 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2614 add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2615 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2616 x, BT_UNKNOWN, 0, REQUIRED);
2618 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2622 /* Add intrinsic subroutines. */
2625 add_subroutines (void)
2627 /* Argument names as in the standard (to be used as argument keywords). */
2629 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2630 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2631 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2632 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2633 *com = "command", *length = "length", *st = "status",
2634 *val = "value", *num = "number", *name = "name",
2635 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2636 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2637 *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2638 *p2 = "path2", *msk = "mask", *old = "old";
2640 int di, dr, dc, dl, ii;
2642 di = gfc_default_integer_kind;
2643 dr = gfc_default_real_kind;
2644 dc = gfc_default_character_kind;
2645 dl = gfc_default_logical_kind;
2646 ii = gfc_index_integer_kind;
2648 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2652 add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2653 GFC_STD_F95, gfc_check_cpu_time, NULL,
2654 gfc_resolve_cpu_time,
2655 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2657 /* More G77 compatibility garbage. */
2658 add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2659 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2660 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2662 add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2663 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2664 vl, BT_INTEGER, 4, REQUIRED);
2666 add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2667 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2668 vl, BT_INTEGER, 4, REQUIRED);
2670 add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2671 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2672 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2674 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2675 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2676 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2678 add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2679 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2680 tm, BT_REAL, dr, REQUIRED);
2682 add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2683 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2684 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2686 add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2687 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2688 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2689 st, BT_INTEGER, di, OPTIONAL);
2691 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2692 GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2693 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2694 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2695 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2696 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2698 /* More G77 compatibility garbage. */
2699 add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2700 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2701 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2703 add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2704 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2705 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2707 add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2708 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2709 dt, BT_CHARACTER, dc, REQUIRED);
2711 add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2712 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2715 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2716 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2717 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2719 add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2721 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2724 add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2725 gfc_check_getarg, NULL, gfc_resolve_getarg,
2726 pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2728 add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2729 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2732 /* F2003 commandline routines. */
2734 add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2735 0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2736 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2737 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2738 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2740 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2741 BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2742 gfc_resolve_get_command_argument,
2743 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2744 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2745 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2746 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2748 /* F2003 subroutine to get environment variables. */
2750 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2751 NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2752 NULL, NULL, gfc_resolve_get_environment_variable,
2753 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2754 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2755 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2756 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2757 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2759 add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2760 GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2761 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2762 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2764 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2765 GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2767 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2768 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2769 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2770 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2771 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2773 add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2774 BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2775 gfc_resolve_random_number,
2776 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2778 add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2779 BT_UNKNOWN, 0, GFC_STD_F95,
2780 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2781 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2782 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2783 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2785 /* More G77 compatibility garbage. */
2786 add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2787 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2788 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2789 st, BT_INTEGER, di, OPTIONAL);
2791 add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2792 gfc_check_srand, NULL, gfc_resolve_srand,
2793 "seed", BT_INTEGER, 4, REQUIRED);
2795 add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2796 gfc_check_exit, NULL, gfc_resolve_exit,
2797 st, BT_INTEGER, di, OPTIONAL);
2801 add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2802 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2803 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2804 st, BT_INTEGER, di, OPTIONAL);
2806 add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2807 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2808 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2810 add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2811 gfc_check_flush, NULL, gfc_resolve_flush,
2812 ut, BT_INTEGER, di, OPTIONAL);
2814 add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2815 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2816 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2817 st, BT_INTEGER, di, OPTIONAL);
2819 add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2820 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2821 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2823 add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2824 gfc_check_free, NULL, gfc_resolve_free,
2825 ptr, BT_INTEGER, ii, REQUIRED);
2827 add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2828 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2829 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2830 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2831 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2832 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2834 add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2835 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2836 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2838 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2839 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2840 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2842 add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2843 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2844 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2846 add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2847 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2848 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2849 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2851 add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2852 gfc_check_perror, NULL, gfc_resolve_perror,
2853 "string", BT_CHARACTER, dc, REQUIRED);
2855 add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2856 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2857 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2858 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2860 add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2861 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2862 sec, BT_INTEGER, di, REQUIRED);
2864 add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2865 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2866 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2867 st, BT_INTEGER, di, OPTIONAL);
2869 add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2870 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2871 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2872 st, BT_INTEGER, di, OPTIONAL);
2874 add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2875 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2876 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2877 st, BT_INTEGER, di, OPTIONAL);
2879 add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2880 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2881 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2882 st, BT_INTEGER, di, OPTIONAL);
2884 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2885 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2886 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2887 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2889 add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2890 NULL, NULL, gfc_resolve_system_sub,
2891 com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2893 add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2894 BT_UNKNOWN, 0, GFC_STD_F95,
2895 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2896 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2897 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2898 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2900 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2901 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2902 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2904 add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2905 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2906 msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2908 add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2909 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2910 "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2914 /* Add a function to the list of conversion symbols. */
2917 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2919 gfc_typespec from, to;
2920 gfc_intrinsic_sym *sym;
2922 if (sizing == SZ_CONVS)
2928 gfc_clear_ts (&from);
2929 from.type = from_type;
2930 from.kind = from_kind;
2936 sym = conversion + nconv;
2938 sym->name = conv_name (&from, &to);
2939 sym->lib_name = sym->name;
2940 sym->simplify.cc = gfc_convert_constant;
2941 sym->standard = standard;
2943 sym->conversion = 1;
2945 sym->id = GFC_ISYM_CONVERSION;
2951 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2952 functions by looping over the kind tables. */
2955 add_conversions (void)
2959 /* Integer-Integer conversions. */
2960 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2961 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2966 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2967 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2970 /* Integer-Real/Complex conversions. */
2971 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2972 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2974 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2975 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2977 add_conv (BT_REAL, gfc_real_kinds[j].kind,
2978 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2980 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2981 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2983 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2984 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2987 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2989 /* Hollerith-Integer conversions. */
2990 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2991 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2992 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2993 /* Hollerith-Real conversions. */
2994 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2995 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2996 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2997 /* Hollerith-Complex conversions. */
2998 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2999 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3000 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3002 /* Hollerith-Character conversions. */
3003 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3004 gfc_default_character_kind, GFC_STD_LEGACY);
3006 /* Hollerith-Logical conversions. */
3007 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3008 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3009 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3012 /* Real/Complex - Real/Complex conversions. */
3013 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3014 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3018 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3019 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3021 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3022 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3025 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3026 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3028 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3029 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3032 /* Logical/Logical kind conversion. */
3033 for (i = 0; gfc_logical_kinds[i].kind; i++)
3034 for (j = 0; gfc_logical_kinds[j].kind; j++)
3039 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3040 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3043 /* Integer-Logical and Logical-Integer conversions. */
3044 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3045 for (i=0; gfc_integer_kinds[i].kind; i++)
3046 for (j=0; gfc_logical_kinds[j].kind; j++)
3048 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3049 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3050 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3051 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3057 add_char_conversions (void)
3061 /* Count possible conversions. */
3062 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3063 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3067 /* Allocate memory. */
3068 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3070 /* Add the conversions themselves. */
3072 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3073 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3075 gfc_typespec from, to;
3080 gfc_clear_ts (&from);
3081 from.type = BT_CHARACTER;
3082 from.kind = gfc_character_kinds[i].kind;
3085 to.type = BT_CHARACTER;
3086 to.kind = gfc_character_kinds[j].kind;
3088 char_conversions[n].name = conv_name (&from, &to);
3089 char_conversions[n].lib_name = char_conversions[n].name;
3090 char_conversions[n].simplify.cc = gfc_convert_char_constant;
3091 char_conversions[n].standard = GFC_STD_F2003;
3092 char_conversions[n].elemental = 1;
3093 char_conversions[n].conversion = 0;
3094 char_conversions[n].ts = to;
3095 char_conversions[n].id = GFC_ISYM_CONVERSION;
3102 /* Initialize the table of intrinsics. */
3104 gfc_intrinsic_init_1 (void)
3108 nargs = nfunc = nsub = nconv = 0;
3110 /* Create a namespace to hold the resolved intrinsic symbols. */
3111 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3120 functions = XCNEWVAR (struct gfc_intrinsic_sym,
3121 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3122 + sizeof (gfc_intrinsic_arg) * nargs);
3124 next_sym = functions;
3125 subroutines = functions + nfunc;
3127 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3129 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3131 sizing = SZ_NOTHING;
3138 /* Character conversion intrinsics need to be treated separately. */
3139 add_char_conversions ();
3141 /* Set the pure flag. All intrinsic functions are pure, and
3142 intrinsic subroutines are pure if they are elemental. */
3144 for (i = 0; i < nfunc; i++)
3145 functions[i].pure = 1;
3147 for (i = 0; i < nsub; i++)
3148 subroutines[i].pure = subroutines[i].elemental;
3153 gfc_intrinsic_done_1 (void)
3155 gfc_free (functions);
3156 gfc_free (conversion);
3157 gfc_free (char_conversions);
3158 gfc_free_namespace (gfc_intrinsic_namespace);
3162 /******** Subroutines to check intrinsic interfaces ***********/
3164 /* Given a formal argument list, remove any NULL arguments that may
3165 have been left behind by a sort against some formal argument list. */
3168 remove_nullargs (gfc_actual_arglist **ap)
3170 gfc_actual_arglist *head, *tail, *next;
3174 for (head = *ap; head; head = next)
3178 if (head->expr == NULL && !head->label)
3181 gfc_free_actual_arglist (head);
3200 /* Given an actual arglist and a formal arglist, sort the actual
3201 arglist so that its arguments are in a one-to-one correspondence
3202 with the format arglist. Arguments that are not present are given
3203 a blank gfc_actual_arglist structure. If something is obviously
3204 wrong (say, a missing required argument) we abort sorting and
3208 sort_actual (const char *name, gfc_actual_arglist **ap,
3209 gfc_intrinsic_arg *formal, locus *where)
3211 gfc_actual_arglist *actual, *a;
3212 gfc_intrinsic_arg *f;
3214 remove_nullargs (ap);
3217 for (f = formal; f; f = f->next)
3223 if (f == NULL && a == NULL) /* No arguments */
3227 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3233 if (a->name != NULL)
3245 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3249 /* Associate the remaining actual arguments, all of which have
3250 to be keyword arguments. */
3251 for (; a; a = a->next)
3253 for (f = formal; f; f = f->next)
3254 if (strcmp (a->name, f->name) == 0)
3259 if (a->name[0] == '%')
3260 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3261 "are not allowed in this context at %L", where);
3263 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3264 a->name, name, where);
3268 if (f->actual != NULL)
3270 gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3271 f->name, name, where);
3279 /* At this point, all unmatched formal args must be optional. */
3280 for (f = formal; f; f = f->next)
3282 if (f->actual == NULL && f->optional == 0)
3284 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3285 f->name, name, where);
3291 /* Using the formal argument list, string the actual argument list
3292 together in a way that corresponds with the formal list. */
3295 for (f = formal; f; f = f->next)
3297 if (f->actual && f->actual->label != NULL && f->ts.type)
3299 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3303 if (f->actual == NULL)
3305 a = gfc_get_actual_arglist ();
3306 a->missing_arg_type = f->ts.type;
3318 actual->next = NULL; /* End the sorted argument list. */
3324 /* Compare an actual argument list with an intrinsic's formal argument
3325 list. The lists are checked for agreement of type. We don't check
3326 for arrayness here. */
3329 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3332 gfc_actual_arglist *actual;
3333 gfc_intrinsic_arg *formal;
3336 formal = sym->formal;
3340 for (; formal; formal = formal->next, actual = actual->next, i++)
3344 if (actual->expr == NULL)
3349 /* A kind of 0 means we don't check for kind. */
3351 ts.kind = actual->expr->ts.kind;
3353 if (!gfc_compare_types (&ts, &actual->expr->ts))
3356 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3357 "be %s, not %s", gfc_current_intrinsic_arg[i],
3358 gfc_current_intrinsic, &actual->expr->where,
3359 gfc_typename (&formal->ts),
3360 gfc_typename (&actual->expr->ts));
3369 /* Given a pointer to an intrinsic symbol and an expression node that
3370 represent the function call to that subroutine, figure out the type
3371 of the result. This may involve calling a resolution subroutine. */
3374 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3376 gfc_expr *a1, *a2, *a3, *a4, *a5;
3377 gfc_actual_arglist *arg;
3379 if (specific->resolve.f1 == NULL)
3381 if (e->value.function.name == NULL)
3382 e->value.function.name = specific->lib_name;
3384 if (e->ts.type == BT_UNKNOWN)
3385 e->ts = specific->ts;
3389 arg = e->value.function.actual;
3391 /* Special case hacks for MIN and MAX. */
3392 if (specific->resolve.f1m == gfc_resolve_max
3393 || specific->resolve.f1m == gfc_resolve_min)
3395 (*specific->resolve.f1m) (e, arg);
3401 (*specific->resolve.f0) (e);
3410 (*specific->resolve.f1) (e, a1);
3419 (*specific->resolve.f2) (e, a1, a2);
3428 (*specific->resolve.f3) (e, a1, a2, a3);
3437 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3446 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3450 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3454 /* Given an intrinsic symbol node and an expression node, call the
3455 simplification function (if there is one), perhaps replacing the
3456 expression with something simpler. We return FAILURE on an error
3457 of the simplification, SUCCESS if the simplification worked, even
3458 if nothing has changed in the expression itself. */
3461 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3463 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3464 gfc_actual_arglist *arg;
3466 /* Max and min require special handling due to the variable number
3468 if (specific->simplify.f1 == gfc_simplify_min)
3470 result = gfc_simplify_min (e);
3474 if (specific->simplify.f1 == gfc_simplify_max)
3476 result = gfc_simplify_max (e);
3480 if (specific->simplify.f1 == NULL)
3486 arg = e->value.function.actual;
3490 result = (*specific->simplify.f0) ();
3497 if (specific->simplify.cc == gfc_convert_constant
3498 || specific->simplify.cc == gfc_convert_char_constant)
3500 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3505 result = (*specific->simplify.f1) (a1);
3512 result = (*specific->simplify.f2) (a1, a2);
3519 result = (*specific->simplify.f3) (a1, a2, a3);
3526 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3533 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3536 ("do_simplify(): Too many args for intrinsic");
3543 if (result == &gfc_bad_expr)
3547 resolve_intrinsic (specific, e); /* Must call at run-time */
3550 result->where = e->where;
3551 gfc_replace_expr (e, result);
3558 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3559 error messages. This subroutine returns FAILURE if a subroutine
3560 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3561 list cannot match any intrinsic. */
3564 init_arglist (gfc_intrinsic_sym *isym)
3566 gfc_intrinsic_arg *formal;
3569 gfc_current_intrinsic = isym->name;
3572 for (formal = isym->formal; formal; formal = formal->next)
3574 if (i >= MAX_INTRINSIC_ARGS)
3575 gfc_internal_error ("init_arglist(): too many arguments");
3576 gfc_current_intrinsic_arg[i++] = formal->name;
3581 /* Given a pointer to an intrinsic symbol and an expression consisting
3582 of a function call, see if the function call is consistent with the
3583 intrinsic's formal argument list. Return SUCCESS if the expression
3584 and intrinsic match, FAILURE otherwise. */
3587 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3589 gfc_actual_arglist *arg, **ap;
3592 ap = &expr->value.function.actual;
3594 init_arglist (specific);
3596 /* Don't attempt to sort the argument list for min or max. */
3597 if (specific->check.f1m == gfc_check_min_max
3598 || specific->check.f1m == gfc_check_min_max_integer
3599 || specific->check.f1m == gfc_check_min_max_real
3600 || specific->check.f1m == gfc_check_min_max_double)
3601 return (*specific->check.f1m) (*ap);
3603 if (sort_actual (specific->name, ap, specific->formal,
3604 &expr->where) == FAILURE)
3607 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3608 /* This is special because we might have to reorder the argument list. */
3609 t = gfc_check_minloc_maxloc (*ap);
3610 else if (specific->check.f3red == gfc_check_minval_maxval)
3611 /* This is also special because we also might have to reorder the
3613 t = gfc_check_minval_maxval (*ap);
3614 else if (specific->check.f3red == gfc_check_product_sum)
3615 /* Same here. The difference to the previous case is that we allow a
3616 general numeric type. */
3617 t = gfc_check_product_sum (*ap);
3620 if (specific->check.f1 == NULL)
3622 t = check_arglist (ap, specific, error_flag);
3624 expr->ts = specific->ts;
3627 t = do_check (specific, *ap);
3630 /* Check conformance of elemental intrinsics. */
3631 if (t == SUCCESS && specific->elemental)
3634 gfc_expr *first_expr;
3635 arg = expr->value.function.actual;
3637 /* There is no elemental intrinsic without arguments. */
3638 gcc_assert(arg != NULL);
3639 first_expr = arg->expr;
3641 for ( ; arg && arg->expr; arg = arg->next, n++)
3642 if (gfc_check_conformance (first_expr, arg->expr,
3643 "arguments '%s' and '%s' for "
3645 gfc_current_intrinsic_arg[0],
3646 gfc_current_intrinsic_arg[n],
3647 gfc_current_intrinsic) == FAILURE)
3652 remove_nullargs (ap);
3658 /* Check whether an intrinsic belongs to whatever standard the user
3659 has chosen, taking also into account -fall-intrinsics. Here, no
3660 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3661 textual representation of the symbols standard status (like
3662 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3663 can be used to construct a detailed warning/error message in case of
3667 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3668 const char** symstd, bool silent, locus where)
3670 const char* symstd_msg;
3672 /* For -fall-intrinsics, just succeed. */
3673 if (gfc_option.flag_all_intrinsics)
3676 /* Find the symbol's standard message for later usage. */
3677 switch (isym->standard)
3680 symstd_msg = "available since Fortran 77";
3683 case GFC_STD_F95_OBS:
3684 symstd_msg = "obsolescent in Fortran 95";
3687 case GFC_STD_F95_DEL:
3688 symstd_msg = "deleted in Fortran 95";
3692 symstd_msg = "new in Fortran 95";
3696 symstd_msg = "new in Fortran 2003";
3700 symstd_msg = "new in Fortran 2008";
3704 symstd_msg = "a GNU Fortran extension";
3707 case GFC_STD_LEGACY:
3708 symstd_msg = "for backward compatibility";
3712 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3713 isym->name, isym->standard);
3716 /* If warning about the standard, warn and succeed. */
3717 if (gfc_option.warn_std & isym->standard)
3719 /* Do only print a warning if not a GNU extension. */
3720 if (!silent && isym->standard != GFC_STD_GNU)
3721 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3722 isym->name, _(symstd_msg), &where);
3727 /* If allowing the symbol's standard, succeed, too. */
3728 if (gfc_option.allow_std & isym->standard)
3731 /* Otherwise, fail. */
3733 *symstd = _(symstd_msg);
3738 /* See if a function call corresponds to an intrinsic function call.
3741 MATCH_YES if the call corresponds to an intrinsic, simplification
3742 is done if possible.
3744 MATCH_NO if the call does not correspond to an intrinsic
3746 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3747 error during the simplification process.
3749 The error_flag parameter enables an error reporting. */
3752 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3754 gfc_intrinsic_sym *isym, *specific;
3755 gfc_actual_arglist *actual;
3759 if (expr->value.function.isym != NULL)
3760 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3761 ? MATCH_ERROR : MATCH_YES;
3764 gfc_push_suppress_errors ();
3767 for (actual = expr->value.function.actual; actual; actual = actual->next)
3768 if (actual->expr != NULL)
3769 flag |= (actual->expr->ts.type != BT_INTEGER
3770 && actual->expr->ts.type != BT_CHARACTER);
3772 name = expr->symtree->n.sym->name;
3774 isym = specific = gfc_find_function (name);
3778 gfc_pop_suppress_errors ();
3782 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3783 || isym->id == GFC_ISYM_CMPLX)
3785 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3786 "as initialization expression at %L", name,
3787 &expr->where) == FAILURE)
3790 gfc_pop_suppress_errors ();
3794 gfc_current_intrinsic_where = &expr->where;
3796 /* Bypass the generic list for min and max. */
3797 if (isym->check.f1m == gfc_check_min_max)
3799 init_arglist (isym);
3801 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3805 gfc_pop_suppress_errors ();
3809 /* If the function is generic, check all of its specific
3810 incarnations. If the generic name is also a specific, we check
3811 that name last, so that any error message will correspond to the
3813 gfc_push_suppress_errors ();
3817 for (specific = isym->specific_head; specific;
3818 specific = specific->next)
3820 if (specific == isym)
3822 if (check_specific (specific, expr, 0) == SUCCESS)
3824 gfc_pop_suppress_errors ();
3830 gfc_pop_suppress_errors ();
3832 if (check_specific (isym, expr, error_flag) == FAILURE)
3835 gfc_pop_suppress_errors ();
3842 expr->value.function.isym = specific;
3843 gfc_intrinsic_symbol (expr->symtree->n.sym);
3846 gfc_pop_suppress_errors ();
3848 if (do_simplify (specific, expr) == FAILURE)
3851 /* F95, 7.1.6.1, Initialization expressions
3852 (4) An elemental intrinsic function reference of type integer or
3853 character where each argument is an initialization expression
3854 of type integer or character
3856 F2003, 7.1.7 Initialization expression
3857 (4) A reference to an elemental standard intrinsic function,
3858 where each argument is an initialization expression */
3860 if (gfc_init_expr && isym->elemental && flag
3861 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3862 "as initialization expression with non-integer/non-"
3863 "character arguments at %L", &expr->where) == FAILURE)
3870 /* See if a CALL statement corresponds to an intrinsic subroutine.
3871 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3872 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3876 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3878 gfc_intrinsic_sym *isym;
3881 name = c->symtree->n.sym->name;
3883 isym = gfc_find_subroutine (name);
3888 gfc_push_suppress_errors ();
3890 init_arglist (isym);
3892 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3895 if (isym->check.f1 != NULL)
3897 if (do_check (isym, c->ext.actual) == FAILURE)
3902 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3906 /* The subroutine corresponds to an intrinsic. Allow errors to be
3907 seen at this point. */
3909 gfc_pop_suppress_errors ();
3911 c->resolved_isym = isym;
3912 if (isym->resolve.s1 != NULL)
3913 isym->resolve.s1 (c);
3916 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3917 c->resolved_sym->attr.elemental = isym->elemental;
3920 if (gfc_pure (NULL) && !isym->elemental)
3922 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3927 c->resolved_sym->attr.noreturn = isym->noreturn;
3933 gfc_pop_suppress_errors ();
3938 /* Call gfc_convert_type() with warning enabled. */
3941 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3943 return gfc_convert_type_warn (expr, ts, eflag, 1);
3947 /* Try to convert an expression (in place) from one type to another.
3948 'eflag' controls the behavior on error.
3950 The possible values are:
3952 1 Generate a gfc_error()
3953 2 Generate a gfc_internal_error().
3955 'wflag' controls the warning related to conversion. */
3958 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3960 gfc_intrinsic_sym *sym;
3961 gfc_typespec from_ts;
3967 from_ts = expr->ts; /* expr->ts gets clobbered */
3969 if (ts->type == BT_UNKNOWN)
3972 /* NULL and zero size arrays get their type here. */
3973 if (expr->expr_type == EXPR_NULL
3974 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3976 /* Sometimes the RHS acquire the type. */
3981 if (expr->ts.type == BT_UNKNOWN)
3984 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3985 && gfc_compare_types (&expr->ts, ts))
3988 sym = find_conv (&expr->ts, ts);
3992 /* At this point, a conversion is necessary. A warning may be needed. */
3993 if ((gfc_option.warn_std & sym->standard) != 0)
3994 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3995 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3996 else if (wflag && gfc_option.warn_conversion)
3997 gfc_warning_now ("Conversion from %s to %s at %L",
3998 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4000 /* Insert a pre-resolved function call to the right function. */
4001 old_where = expr->where;
4003 shape = expr->shape;
4005 new_expr = gfc_get_expr ();
4008 new_expr = gfc_build_conversion (new_expr);
4009 new_expr->value.function.name = sym->lib_name;
4010 new_expr->value.function.isym = sym;
4011 new_expr->where = old_where;
4012 new_expr->rank = rank;
4013 new_expr->shape = gfc_copy_shape (shape, rank);
4015 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4016 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4017 new_expr->symtree->n.sym->ts = *ts;
4018 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4019 new_expr->symtree->n.sym->attr.function = 1;
4020 new_expr->symtree->n.sym->attr.elemental = 1;
4021 new_expr->symtree->n.sym->attr.pure = 1;
4022 new_expr->symtree->n.sym->attr.referenced = 1;
4023 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4024 gfc_commit_symbol (new_expr->symtree->n.sym);
4028 gfc_free (new_expr);
4031 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4032 && do_simplify (sym, expr) == FAILURE)
4037 return FAILURE; /* Error already generated in do_simplify() */
4045 gfc_error ("Can't convert %s to %s at %L",
4046 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4050 gfc_internal_error ("Can't convert %s to %s at %L",
4051 gfc_typename (&from_ts), gfc_typename (ts),
4058 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4060 gfc_intrinsic_sym *sym;
4066 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4068 sym = find_char_conv (&expr->ts, ts);
4071 /* Insert a pre-resolved function call to the right function. */
4072 old_where = expr->where;
4074 shape = expr->shape;
4076 new_expr = gfc_get_expr ();
4079 new_expr = gfc_build_conversion (new_expr);
4080 new_expr->value.function.name = sym->lib_name;
4081 new_expr->value.function.isym = sym;
4082 new_expr->where = old_where;
4083 new_expr->rank = rank;
4084 new_expr->shape = gfc_copy_shape (shape, rank);
4086 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4087 new_expr->symtree->n.sym->ts = *ts;
4088 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4089 new_expr->symtree->n.sym->attr.function = 1;
4090 new_expr->symtree->n.sym->attr.elemental = 1;
4091 new_expr->symtree->n.sym->attr.referenced = 1;
4092 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4093 gfc_commit_symbol (new_expr->symtree->n.sym);
4097 gfc_free (new_expr);
4100 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4101 && do_simplify (sym, expr) == FAILURE)
4103 /* Error already generated in do_simplify() */
4111 /* Check if the passed name is name of an intrinsic (taking into account the
4112 current -std=* and -fall-intrinsic settings). If it is, see if we should
4113 warn about this as a user-procedure having the same name as an intrinsic
4114 (-Wintrinsic-shadow enabled) and do so if we should. */
4117 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4119 gfc_intrinsic_sym* isym;
4121 /* If the warning is disabled, do nothing at all. */
4122 if (!gfc_option.warn_intrinsic_shadow)
4125 /* Try to find an intrinsic of the same name. */
4127 isym = gfc_find_function (sym->name);
4129 isym = gfc_find_subroutine (sym->name);
4131 /* If no intrinsic was found with this name or it's not included in the
4132 selected standard, everything's fine. */
4133 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4134 sym->declared_at) == FAILURE)
4137 /* Emit the warning. */
4139 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4140 " name. In order to call the intrinsic, explicit INTRINSIC"
4141 " declarations may be required.",
4142 sym->name, &sym->declared_at);
4144 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4145 " only be called via an explicit interface or if declared"
4146 " EXTERNAL.", sym->name, &sym->declared_at);