1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
4 Free Software Foundation, Inc.
5 Contributed by Andy Vaught & Katherine Holcomb
7 This file is part of GCC.
9 GCC is free software; you can redistribute it and/or modify it under
10 the terms of the GNU General Public License as published by the Free
11 Software Foundation; either version 3, or (at your option) any later
14 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
15 WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with GCC; see the file COPYING3. If not see
21 <http://www.gnu.org/licenses/>. */
27 #include "intrinsic.h"
29 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
30 static gfc_namespace *gfc_intrinsic_namespace;
32 int gfc_init_expr = 0;
34 /* Pointers to an intrinsic function and its argument names that are being
37 const char *gfc_current_intrinsic;
38 const char *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
39 locus *gfc_current_intrinsic_where;
41 static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
42 static gfc_intrinsic_sym *char_conversions;
43 static gfc_intrinsic_arg *next_arg;
45 static int nfunc, nsub, nargs, nconv, ncharconv;
48 { SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
52 { NO_CLASS = 0, CLASS_ELEMENTAL, CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
61 /* Return a letter based on the passed type. Used to construct the
62 name of a type-dependent subroutine. */
65 gfc_type_letter (bt type)
100 /* Get a symbol for a resolved name. Note, if needed be, the elemental
101 attribute has be added afterwards. */
104 gfc_get_intrinsic_sub_symbol (const char *name)
108 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
109 sym->attr.always_explicit = 1;
110 sym->attr.subroutine = 1;
111 sym->attr.flavor = FL_PROCEDURE;
112 sym->attr.proc = PROC_INTRINSIC;
118 /* Return a pointer to the name of a conversion function given two
122 conv_name (gfc_typespec *from, gfc_typespec *to)
124 return gfc_get_string ("__convert_%c%d_%c%d",
125 gfc_type_letter (from->type), from->kind,
126 gfc_type_letter (to->type), to->kind);
130 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
131 corresponds to the conversion. Returns NULL if the conversion
134 static gfc_intrinsic_sym *
135 find_conv (gfc_typespec *from, gfc_typespec *to)
137 gfc_intrinsic_sym *sym;
141 target = conv_name (from, to);
144 for (i = 0; i < nconv; i++, sym++)
145 if (target == sym->name)
152 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
153 that corresponds to the conversion. Returns NULL if the conversion
156 static gfc_intrinsic_sym *
157 find_char_conv (gfc_typespec *from, gfc_typespec *to)
159 gfc_intrinsic_sym *sym;
163 target = conv_name (from, to);
164 sym = char_conversions;
166 for (i = 0; i < ncharconv; i++, sym++)
167 if (target == sym->name)
174 /* Interface to the check functions. We break apart an argument list
175 and call the proper check function rather than forcing each
176 function to manipulate the argument list. */
179 do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
181 gfc_expr *a1, *a2, *a3, *a4, *a5;
184 return (*specific->check.f0) ();
189 return (*specific->check.f1) (a1);
194 return (*specific->check.f2) (a1, a2);
199 return (*specific->check.f3) (a1, a2, a3);
204 return (*specific->check.f4) (a1, a2, a3, a4);
209 return (*specific->check.f5) (a1, a2, a3, a4, a5);
211 gfc_internal_error ("do_check(): too many args");
215 /*********** Subroutines to build the intrinsic list ****************/
217 /* Add a single intrinsic symbol to the current list.
220 char * name of function
221 int whether function is elemental
222 int If the function can be used as an actual argument [1]
223 bt return type of function
224 int kind of return type of function
225 int Fortran standard version
226 check pointer to check function
227 simplify pointer to simplification function
228 resolve pointer to resolution function
230 Optional arguments come in multiples of five:
231 char * name of argument
234 int arg optional flag (1=optional, 0=required)
235 sym_intent intent of argument
237 The sequence is terminated by a NULL name.
240 [1] Whether a function can or cannot be used as an actual argument is
241 determined by its presence on the 13.6 list in Fortran 2003. The
242 following intrinsics, which are GNU extensions, are considered allowed
243 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
244 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
247 add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
248 int standard, gfc_check_f check, gfc_simplify_f simplify,
249 gfc_resolve_f resolve, ...)
251 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
252 int optional, first_flag;
267 next_sym->name = gfc_get_string (name);
269 strcpy (buf, "_gfortran_");
271 next_sym->lib_name = gfc_get_string (buf);
273 next_sym->elemental = (cl == CLASS_ELEMENTAL);
274 next_sym->inquiry = (cl == CLASS_INQUIRY);
275 next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
276 next_sym->actual_ok = actual_ok;
277 next_sym->ts.type = type;
278 next_sym->ts.kind = kind;
279 next_sym->standard = standard;
280 next_sym->simplify = simplify;
281 next_sym->check = check;
282 next_sym->resolve = resolve;
283 next_sym->specific = 0;
284 next_sym->generic = 0;
285 next_sym->conversion = 0;
290 gfc_internal_error ("add_sym(): Bad sizing mode");
293 va_start (argp, resolve);
299 name = va_arg (argp, char *);
303 type = (bt) va_arg (argp, int);
304 kind = va_arg (argp, int);
305 optional = va_arg (argp, int);
306 intent = (sym_intent) va_arg (argp, int);
308 if (sizing != SZ_NOTHING)
315 next_sym->formal = next_arg;
317 (next_arg - 1)->next = next_arg;
321 strcpy (next_arg->name, name);
322 next_arg->ts.type = type;
323 next_arg->ts.kind = kind;
324 next_arg->optional = optional;
325 next_arg->intent = intent;
335 /* Add a symbol to the function list where the function takes
339 add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
340 int kind, int standard,
341 gfc_try (*check) (void),
342 gfc_expr *(*simplify) (void),
343 void (*resolve) (gfc_expr *))
353 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
358 /* Add a symbol to the subroutine list where the subroutine takes
362 add_sym_0s (const char *name, gfc_isym_id id, int standard, void (*resolve) (gfc_code *))
372 add_sym (name, id, NO_CLASS, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf, rf,
377 /* Add a symbol to the function list where the function takes
381 add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
382 int kind, int standard,
383 gfc_try (*check) (gfc_expr *),
384 gfc_expr *(*simplify) (gfc_expr *),
385 void (*resolve) (gfc_expr *, gfc_expr *),
386 const char *a1, bt type1, int kind1, int optional1)
396 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
397 a1, type1, kind1, optional1, INTENT_IN,
402 /* Add a symbol to the subroutine list where the subroutine takes
406 add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
407 gfc_try (*check) (gfc_expr *),
408 gfc_expr *(*simplify) (gfc_expr *),
409 void (*resolve) (gfc_code *),
410 const char *a1, bt type1, int kind1, int optional1)
420 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
421 a1, type1, kind1, optional1, INTENT_IN,
426 /* Add a symbol to the function list where the function takes
427 1 arguments, specifying the intent of the argument. */
430 add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
431 int actual_ok, bt type, int kind, int standard,
432 gfc_try (*check) (gfc_expr *),
433 gfc_expr *(*simplify) (gfc_expr *),
434 void (*resolve) (gfc_expr *, gfc_expr *),
435 const char *a1, bt type1, int kind1, int optional1,
446 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
447 a1, type1, kind1, optional1, intent1,
452 /* Add a symbol to the subroutine list where the subroutine takes
453 1 arguments, specifying the intent of the argument. */
456 add_sym_1s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
457 int kind, int standard,
458 gfc_try (*check) (gfc_expr *),
459 gfc_expr *(*simplify) (gfc_expr *),
460 void (*resolve) (gfc_code *),
461 const char *a1, bt type1, int kind1, int optional1,
472 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
473 a1, type1, kind1, optional1, intent1,
478 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
479 function. MAX et al take 2 or more arguments. */
482 add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
483 int kind, int standard,
484 gfc_try (*check) (gfc_actual_arglist *),
485 gfc_expr *(*simplify) (gfc_expr *),
486 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
487 const char *a1, bt type1, int kind1, int optional1,
488 const char *a2, bt type2, int kind2, int optional2)
498 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
499 a1, type1, kind1, optional1, INTENT_IN,
500 a2, type2, kind2, optional2, INTENT_IN,
505 /* Add a symbol to the function list where the function takes
509 add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
510 int kind, int standard,
511 gfc_try (*check) (gfc_expr *, gfc_expr *),
512 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
513 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
514 const char *a1, bt type1, int kind1, int optional1,
515 const char *a2, bt type2, int kind2, int optional2)
525 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
526 a1, type1, kind1, optional1, INTENT_IN,
527 a2, type2, kind2, optional2, INTENT_IN,
532 /* Add a symbol to the subroutine list where the subroutine takes
536 add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
537 gfc_try (*check) (gfc_expr *, gfc_expr *),
538 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
539 void (*resolve) (gfc_code *),
540 const char *a1, bt type1, int kind1, int optional1,
541 const char *a2, bt type2, int kind2, int optional2)
551 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
552 a1, type1, kind1, optional1, INTENT_IN,
553 a2, type2, kind2, optional2, INTENT_IN,
558 /* Add a symbol to the subroutine list where the subroutine takes
559 2 arguments, specifying the intent of the arguments. */
562 add_sym_2s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
563 int kind, int standard,
564 gfc_try (*check) (gfc_expr *, gfc_expr *),
565 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
566 void (*resolve) (gfc_code *),
567 const char *a1, bt type1, int kind1, int optional1,
568 sym_intent intent1, const char *a2, bt type2, int kind2,
569 int optional2, sym_intent intent2)
579 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
580 a1, type1, kind1, optional1, intent1,
581 a2, type2, kind2, optional2, intent2,
586 /* Add a symbol to the function list where the function takes
590 add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
591 int kind, int standard,
592 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
593 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
594 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
595 const char *a1, bt type1, int kind1, int optional1,
596 const char *a2, bt type2, int kind2, int optional2,
597 const char *a3, bt type3, int kind3, int optional3)
607 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
608 a1, type1, kind1, optional1, INTENT_IN,
609 a2, type2, kind2, optional2, INTENT_IN,
610 a3, type3, kind3, optional3, INTENT_IN,
615 /* MINLOC and MAXLOC get special treatment because their argument
616 might have to be reordered. */
619 add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
620 int kind, int standard,
621 gfc_try (*check) (gfc_actual_arglist *),
622 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
623 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
624 const char *a1, bt type1, int kind1, int optional1,
625 const char *a2, bt type2, int kind2, int optional2,
626 const char *a3, bt type3, int kind3, int optional3)
636 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
637 a1, type1, kind1, optional1, INTENT_IN,
638 a2, type2, kind2, optional2, INTENT_IN,
639 a3, type3, kind3, optional3, INTENT_IN,
644 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
645 their argument also might have to be reordered. */
648 add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
649 int kind, int standard,
650 gfc_try (*check) (gfc_actual_arglist *),
651 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
652 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
653 const char *a1, bt type1, int kind1, int optional1,
654 const char *a2, bt type2, int kind2, int optional2,
655 const char *a3, bt type3, int kind3, int optional3)
665 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
666 a1, type1, kind1, optional1, INTENT_IN,
667 a2, type2, kind2, optional2, INTENT_IN,
668 a3, type3, kind3, optional3, INTENT_IN,
673 /* Add a symbol to the subroutine list where the subroutine takes
677 add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind, int standard,
678 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
679 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
680 void (*resolve) (gfc_code *),
681 const char *a1, bt type1, int kind1, int optional1,
682 const char *a2, bt type2, int kind2, int optional2,
683 const char *a3, bt type3, int kind3, int optional3)
693 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
694 a1, type1, kind1, optional1, INTENT_IN,
695 a2, type2, kind2, optional2, INTENT_IN,
696 a3, type3, kind3, optional3, INTENT_IN,
701 /* Add a symbol to the subroutine list where the subroutine takes
702 3 arguments, specifying the intent of the arguments. */
705 add_sym_3s_intent (const char *name, gfc_isym_id id, enum klass cl, bt type,
706 int kind, int standard,
707 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
708 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
709 void (*resolve) (gfc_code *),
710 const char *a1, bt type1, int kind1, int optional1,
711 sym_intent intent1, const char *a2, bt type2, int kind2,
712 int optional2, sym_intent intent2, const char *a3, bt type3,
713 int kind3, int optional3, sym_intent intent3)
723 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
724 a1, type1, kind1, optional1, intent1,
725 a2, type2, kind2, optional2, intent2,
726 a3, type3, kind3, optional3, intent3,
731 /* Add a symbol to the function list where the function takes
735 add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
736 int kind, int standard,
737 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
738 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
740 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
742 const char *a1, bt type1, int kind1, int optional1,
743 const char *a2, bt type2, int kind2, int optional2,
744 const char *a3, bt type3, int kind3, int optional3,
745 const char *a4, bt type4, int kind4, int optional4 )
755 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
756 a1, type1, kind1, optional1, INTENT_IN,
757 a2, type2, kind2, optional2, INTENT_IN,
758 a3, type3, kind3, optional3, INTENT_IN,
759 a4, type4, kind4, optional4, INTENT_IN,
764 /* Add a symbol to the subroutine list where the subroutine takes
768 add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
770 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
771 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
773 void (*resolve) (gfc_code *),
774 const char *a1, bt type1, int kind1, int optional1,
775 sym_intent intent1, const char *a2, bt type2, int kind2,
776 int optional2, sym_intent intent2, const char *a3, bt type3,
777 int kind3, int optional3, sym_intent intent3, const char *a4,
778 bt type4, int kind4, int optional4, sym_intent intent4)
788 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
789 a1, type1, kind1, optional1, intent1,
790 a2, type2, kind2, optional2, intent2,
791 a3, type3, kind3, optional3, intent3,
792 a4, type4, kind4, optional4, intent4,
797 /* Add a symbol to the subroutine list where the subroutine takes
801 add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
803 gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
805 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
806 gfc_expr *, gfc_expr *),
807 void (*resolve) (gfc_code *),
808 const char *a1, bt type1, int kind1, int optional1,
809 sym_intent intent1, const char *a2, bt type2, int kind2,
810 int optional2, sym_intent intent2, const char *a3, bt type3,
811 int kind3, int optional3, sym_intent intent3, const char *a4,
812 bt type4, int kind4, int optional4, sym_intent intent4,
813 const char *a5, bt type5, int kind5, int optional5,
824 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
825 a1, type1, kind1, optional1, intent1,
826 a2, type2, kind2, optional2, intent2,
827 a3, type3, kind3, optional3, intent3,
828 a4, type4, kind4, optional4, intent4,
829 a5, type5, kind5, optional5, intent5,
834 /* Locate an intrinsic symbol given a base pointer, number of elements
835 in the table and a pointer to a name. Returns the NULL pointer if
836 a name is not found. */
838 static gfc_intrinsic_sym *
839 find_sym (gfc_intrinsic_sym *start, int n, const char *name)
841 /* name may be a user-supplied string, so we must first make sure
842 that we're comparing against a pointer into the global string
844 const char *p = gfc_get_string (name);
848 if (p == start->name)
859 /* Given a name, find a function in the intrinsic function table.
860 Returns NULL if not found. */
863 gfc_find_function (const char *name)
865 gfc_intrinsic_sym *sym;
867 sym = find_sym (functions, nfunc, name);
869 sym = find_sym (conversion, nconv, name);
875 /* Given a name, find a function in the intrinsic subroutine table.
876 Returns NULL if not found. */
879 gfc_find_subroutine (const char *name)
881 return find_sym (subroutines, nsub, name);
885 /* Given a string, figure out if it is the name of a generic intrinsic
889 gfc_generic_intrinsic (const char *name)
891 gfc_intrinsic_sym *sym;
893 sym = gfc_find_function (name);
894 return (sym == NULL) ? 0 : sym->generic;
898 /* Given a string, figure out if it is the name of a specific
899 intrinsic function or not. */
902 gfc_specific_intrinsic (const char *name)
904 gfc_intrinsic_sym *sym;
906 sym = gfc_find_function (name);
907 return (sym == NULL) ? 0 : sym->specific;
911 /* Given a string, figure out if it is the name of an intrinsic function
912 or subroutine allowed as an actual argument or not. */
914 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
916 gfc_intrinsic_sym *sym;
918 /* Intrinsic subroutines are not allowed as actual arguments. */
923 sym = gfc_find_function (name);
924 return (sym == NULL) ? 0 : sym->actual_ok;
929 /* Given a symbol, find out if it is (and is to be treated) an intrinsic. If
930 it's name refers to an intrinsic but this intrinsic is not included in the
931 selected standard, this returns FALSE and sets the symbol's external
935 gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
937 gfc_intrinsic_sym* isym;
940 /* If INTRINSIC/EXTERNAL state is already known, return. */
941 if (sym->attr.intrinsic)
943 if (sym->attr.external)
947 isym = gfc_find_subroutine (sym->name);
949 isym = gfc_find_function (sym->name);
951 /* No such intrinsic available at all? */
955 /* See if this intrinsic is allowed in the current standard. */
956 if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
958 if (sym->attr.proc == PROC_UNKNOWN)
960 if (gfc_option.warn_intrinsics_std)
961 gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
962 " selected standard but %s and '%s' will be"
963 " treated as if declared EXTERNAL. Use an"
964 " appropriate -std=* option or define"
965 " -fall-intrinsics to allow this intrinsic.",
966 sym->name, &loc, symstd, sym->name);
967 gfc_add_external (&sym->attr, &loc);
977 /* Collect a set of intrinsic functions into a generic collection.
978 The first argument is the name of the generic function, which is
979 also the name of a specific function. The rest of the specifics
980 currently in the table are placed into the list of specific
981 functions associated with that generic.
984 FIXME: Remove the argument STANDARD if no regressions are
985 encountered. Change all callers (approx. 360).
989 make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
991 gfc_intrinsic_sym *g;
993 if (sizing != SZ_NOTHING)
996 g = gfc_find_function (name);
998 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
1001 gcc_assert (g->id == id);
1005 if ((g + 1)->name != NULL)
1006 g->specific_head = g + 1;
1009 while (g->name != NULL)
1021 /* Create a duplicate intrinsic function entry for the current
1022 function, the only differences being the alternate name and
1023 a different standard if necessary. Note that we use argument
1024 lists more than once, but all argument lists are freed as a
1028 make_alias (const char *name, int standard)
1041 next_sym[0] = next_sym[-1];
1042 next_sym->name = gfc_get_string (name);
1043 next_sym->standard = standard;
1053 /* Make the current subroutine noreturn. */
1056 make_noreturn (void)
1058 if (sizing == SZ_NOTHING)
1059 next_sym[-1].noreturn = 1;
1063 /* Add intrinsic functions. */
1066 add_functions (void)
1068 /* Argument names as in the standard (to be used as argument keywords). */
1070 *a = "a", *f = "field", *pt = "pointer", *tg = "target",
1071 *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
1072 *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
1073 *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
1074 *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
1075 *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
1076 *p = "p", *ar = "array", *shp = "shape", *src = "source",
1077 *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
1078 *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
1079 *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
1080 *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
1081 *z = "z", *ln = "len", *ut = "unit", *han = "handler",
1082 *num = "number", *tm = "time", *nm = "name", *md = "mode",
1083 *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command";
1085 int di, dr, dd, dl, dc, dz, ii;
1087 di = gfc_default_integer_kind;
1088 dr = gfc_default_real_kind;
1089 dd = gfc_default_double_kind;
1090 dl = gfc_default_logical_kind;
1091 dc = gfc_default_character_kind;
1092 dz = gfc_default_complex_kind;
1093 ii = gfc_index_integer_kind;
1095 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1096 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1097 a, BT_REAL, dr, REQUIRED);
1099 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1100 NULL, gfc_simplify_abs, gfc_resolve_abs,
1101 a, BT_INTEGER, di, REQUIRED);
1103 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1104 gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1105 a, BT_REAL, dd, REQUIRED);
1107 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1108 NULL, gfc_simplify_abs, gfc_resolve_abs,
1109 a, BT_COMPLEX, dz, REQUIRED);
1111 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1112 NULL, gfc_simplify_abs, gfc_resolve_abs,
1113 a, BT_COMPLEX, dd, REQUIRED);
1115 make_alias ("cdabs", GFC_STD_GNU);
1117 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
1119 /* The checking function for ACCESS is called gfc_check_access_func
1120 because the name gfc_check_access is already used in module.c. */
1121 add_sym_2 ("access", GFC_ISYM_ACCESS, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1122 gfc_check_access_func, NULL, gfc_resolve_access,
1123 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1125 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1127 add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1128 BT_CHARACTER, dc, GFC_STD_F95,
1129 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
1130 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1132 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
1134 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1135 gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1136 x, BT_REAL, dr, REQUIRED);
1138 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1139 gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1140 x, BT_REAL, dd, REQUIRED);
1142 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
1144 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1145 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
1146 gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1148 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1149 gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1150 x, BT_REAL, dd, REQUIRED);
1152 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1154 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1155 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1156 gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
1158 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
1160 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1161 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1162 gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
1164 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
1166 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1167 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1168 z, BT_COMPLEX, dz, REQUIRED);
1170 make_alias ("imag", GFC_STD_GNU);
1171 make_alias ("imagpart", GFC_STD_GNU);
1173 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1174 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1175 z, BT_COMPLEX, dd, REQUIRED);
1177 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
1179 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1180 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1181 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1183 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1184 NULL, gfc_simplify_dint, gfc_resolve_dint,
1185 a, BT_REAL, dd, REQUIRED);
1187 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
1189 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1190 gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1191 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1193 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
1195 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1196 gfc_check_allocated, NULL, NULL,
1197 ar, BT_UNKNOWN, 0, REQUIRED);
1199 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
1201 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1202 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1203 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1205 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1206 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1207 a, BT_REAL, dd, REQUIRED);
1209 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
1211 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1212 gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1213 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
1215 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
1217 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1218 gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1219 x, BT_REAL, dr, REQUIRED);
1221 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1222 gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1223 x, BT_REAL, dd, REQUIRED);
1225 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
1227 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1228 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
1229 gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1231 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1232 gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1233 x, BT_REAL, dd, REQUIRED);
1235 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
1237 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
1238 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1239 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
1241 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
1243 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1244 gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1245 x, BT_REAL, dr, REQUIRED);
1247 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1248 gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1249 x, BT_REAL, dd, REQUIRED);
1251 /* Two-argument version of atan, equivalent to atan2. */
1252 add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1253 gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1254 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1256 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
1258 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
1259 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
1260 gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1262 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1263 gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1264 x, BT_REAL, dd, REQUIRED);
1266 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
1268 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1269 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1270 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1272 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1273 gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1274 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
1276 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
1278 /* Bessel and Neumann functions for G77 compatibility. */
1279 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1280 gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1281 x, BT_REAL, dr, REQUIRED);
1283 make_alias ("bessel_j0", GFC_STD_F2008);
1285 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1286 gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1287 x, BT_REAL, dd, REQUIRED);
1289 make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
1291 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1292 gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1293 x, BT_REAL, dr, REQUIRED);
1295 make_alias ("bessel_j1", GFC_STD_F2008);
1297 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1298 gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1299 x, BT_REAL, dd, REQUIRED);
1301 make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
1303 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1304 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1305 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1307 make_alias ("bessel_jn", GFC_STD_F2008);
1309 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1310 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1311 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1313 make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
1315 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1316 gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1317 x, BT_REAL, dr, REQUIRED);
1319 make_alias ("bessel_y0", GFC_STD_F2008);
1321 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1322 gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1323 x, BT_REAL, dd, REQUIRED);
1325 make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
1327 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1328 gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1329 x, BT_REAL, dr, REQUIRED);
1331 make_alias ("bessel_y1", GFC_STD_F2008);
1333 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1334 gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1335 x, BT_REAL, dd, REQUIRED);
1337 make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
1339 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1340 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1341 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
1343 make_alias ("bessel_yn", GFC_STD_F2008);
1345 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1346 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1347 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
1349 make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
1351 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1352 gfc_check_i, gfc_simplify_bit_size, NULL,
1353 i, BT_INTEGER, di, REQUIRED);
1355 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
1357 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1358 gfc_check_btest, gfc_simplify_btest, gfc_resolve_btest,
1359 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1361 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
1363 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1364 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1365 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1367 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
1369 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
1370 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1371 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1373 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
1375 add_sym_1 ("chdir", GFC_ISYM_CHDIR, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1376 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1377 nm, BT_CHARACTER, dc, REQUIRED);
1379 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
1381 add_sym_2 ("chmod", GFC_ISYM_CHMOD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1382 gfc_check_chmod, NULL, gfc_resolve_chmod,
1383 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1385 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1387 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
1388 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1389 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1390 kind, BT_INTEGER, di, OPTIONAL);
1392 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
1394 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
1395 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
1397 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
1400 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
1401 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1402 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1404 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1406 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1407 complex instead of the default complex. */
1409 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
1410 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1411 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
1413 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
1415 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1416 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1417 z, BT_COMPLEX, dz, REQUIRED);
1419 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1420 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1421 z, BT_COMPLEX, dd, REQUIRED);
1423 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
1425 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1426 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1427 x, BT_REAL, dr, REQUIRED);
1429 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1430 gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1431 x, BT_REAL, dd, REQUIRED);
1433 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1434 NULL, gfc_simplify_cos, gfc_resolve_cos,
1435 x, BT_COMPLEX, dz, REQUIRED);
1437 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1438 NULL, gfc_simplify_cos, gfc_resolve_cos,
1439 x, BT_COMPLEX, dd, REQUIRED);
1441 make_alias ("cdcos", GFC_STD_GNU);
1443 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
1445 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1446 gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1447 x, BT_REAL, dr, REQUIRED);
1449 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1450 gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1451 x, BT_REAL, dd, REQUIRED);
1453 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
1455 add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1456 BT_INTEGER, di, GFC_STD_F95,
1457 gfc_check_count, gfc_simplify_count, gfc_resolve_count,
1458 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1459 kind, BT_INTEGER, di, OPTIONAL);
1461 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
1463 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1464 gfc_check_cshift, NULL, gfc_resolve_cshift,
1465 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1466 dm, BT_INTEGER, ii, OPTIONAL);
1468 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
1470 add_sym_1 ("ctime", GFC_ISYM_CTIME, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
1471 gfc_check_ctime, NULL, gfc_resolve_ctime,
1472 tm, BT_INTEGER, di, REQUIRED);
1474 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1476 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
1477 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1478 a, BT_REAL, dr, REQUIRED);
1480 make_alias ("dfloat", GFC_STD_GNU);
1482 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
1484 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1485 gfc_check_digits, gfc_simplify_digits, NULL,
1486 x, BT_UNKNOWN, dr, REQUIRED);
1488 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
1490 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1491 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
1492 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1494 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
1495 NULL, gfc_simplify_dim, gfc_resolve_dim,
1496 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
1498 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1499 gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1500 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
1502 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
1504 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
1505 GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1506 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
1508 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
1510 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1511 gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1512 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1514 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
1516 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
1518 a, BT_COMPLEX, dd, REQUIRED);
1520 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
1522 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1523 gfc_check_eoshift, NULL, gfc_resolve_eoshift,
1524 ar, BT_REAL, dr, 0, sh, BT_INTEGER, ii, REQUIRED,
1525 bd, BT_REAL, dr, 1, dm, BT_INTEGER, ii, OPTIONAL);
1527 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
1529 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1530 gfc_check_x, gfc_simplify_epsilon, NULL,
1531 x, BT_REAL, dr, REQUIRED);
1533 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
1535 /* G77 compatibility for the ERF() and ERFC() functions. */
1536 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1537 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1538 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1540 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1541 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1542 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1544 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
1546 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1547 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1548 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
1550 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1551 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1552 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
1554 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1556 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
1557 BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1558 gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1561 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
1563 /* G77 compatibility */
1564 add_sym_1 ("dtime", GFC_ISYM_DTIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1565 gfc_check_dtime_etime, NULL, NULL,
1566 x, BT_REAL, 4, REQUIRED);
1568 make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1570 add_sym_1 ("etime", GFC_ISYM_ETIME, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1571 gfc_check_dtime_etime, NULL, NULL,
1572 x, BT_REAL, 4, REQUIRED);
1574 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
1576 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1577 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1578 x, BT_REAL, dr, REQUIRED);
1580 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
1581 gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1582 x, BT_REAL, dd, REQUIRED);
1584 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
1585 NULL, gfc_simplify_exp, gfc_resolve_exp,
1586 x, BT_COMPLEX, dz, REQUIRED);
1588 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1589 NULL, gfc_simplify_exp, gfc_resolve_exp,
1590 x, BT_COMPLEX, dd, REQUIRED);
1592 make_alias ("cdexp", GFC_STD_GNU);
1594 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
1596 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1597 gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
1598 x, BT_REAL, dr, REQUIRED);
1600 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
1602 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1603 ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1604 gfc_check_same_type_as, NULL, gfc_resolve_extends_type_of,
1605 a, BT_UNKNOWN, 0, REQUIRED,
1606 mo, BT_UNKNOWN, 0, REQUIRED);
1608 add_sym_0 ("fdate", GFC_ISYM_FDATE, NO_CLASS, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_GNU,
1609 NULL, NULL, gfc_resolve_fdate);
1611 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1613 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1614 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1615 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1617 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
1619 /* G77 compatible fnum */
1620 add_sym_1 ("fnum", GFC_ISYM_FNUM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1621 gfc_check_fnum, NULL, gfc_resolve_fnum,
1622 ut, BT_INTEGER, di, REQUIRED);
1624 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1626 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1627 gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
1628 x, BT_REAL, dr, REQUIRED);
1630 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
1632 add_sym_2 ("fstat", GFC_ISYM_FSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1633 GFC_STD_GNU, gfc_check_fstat, NULL, gfc_resolve_fstat,
1634 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
1636 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1638 add_sym_1 ("ftell", GFC_ISYM_FTELL, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii, GFC_STD_GNU,
1639 gfc_check_ftell, NULL, gfc_resolve_ftell,
1640 ut, BT_INTEGER, di, REQUIRED);
1642 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1644 add_sym_2 ("fgetc", GFC_ISYM_FGETC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1645 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1646 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1648 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1650 add_sym_1 ("fget", GFC_ISYM_FGET, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1651 gfc_check_fgetput, NULL, gfc_resolve_fget,
1652 c, BT_CHARACTER, dc, REQUIRED);
1654 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1656 add_sym_2 ("fputc", GFC_ISYM_FPUTC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1657 gfc_check_fgetputc, NULL, gfc_resolve_fputc,
1658 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1660 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1662 add_sym_1 ("fput", GFC_ISYM_FPUT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1663 gfc_check_fgetput, NULL, gfc_resolve_fput,
1664 c, BT_CHARACTER, dc, REQUIRED);
1666 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
1668 add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1669 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
1670 gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
1672 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1673 gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
1674 x, BT_REAL, dr, REQUIRED);
1676 make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
1678 /* Unix IDs (g77 compatibility) */
1679 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1680 NULL, NULL, gfc_resolve_getcwd,
1681 c, BT_CHARACTER, dc, REQUIRED);
1683 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
1685 add_sym_0 ("getgid", GFC_ISYM_GETGID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1686 NULL, NULL, gfc_resolve_getgid);
1688 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
1690 add_sym_0 ("getpid", GFC_ISYM_GETPID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1691 NULL, NULL, gfc_resolve_getpid);
1693 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
1695 add_sym_0 ("getuid", GFC_ISYM_GETUID, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1696 NULL, NULL, gfc_resolve_getuid);
1698 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
1700 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1701 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
1702 a, BT_CHARACTER, dc, REQUIRED);
1704 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
1706 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1707 gfc_check_huge, gfc_simplify_huge, NULL,
1708 x, BT_UNKNOWN, dr, REQUIRED);
1710 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
1712 add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
1713 BT_REAL, dr, GFC_STD_F2008,
1714 gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
1715 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
1717 make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
1719 add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1720 BT_INTEGER, di, GFC_STD_F95,
1721 gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
1722 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1724 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
1726 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1727 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1728 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1730 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
1732 add_sym_2 ("and", GFC_ISYM_AND, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1733 gfc_check_and, gfc_simplify_and, gfc_resolve_and,
1734 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1736 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
1738 add_sym_0 ("iargc", GFC_ISYM_IARGC, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1741 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
1743 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1744 gfc_check_ibclr, gfc_simplify_ibclr, gfc_resolve_ibclr,
1745 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1747 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
1749 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1750 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1751 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
1752 ln, BT_INTEGER, di, REQUIRED);
1754 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
1756 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1757 gfc_check_ibset, gfc_simplify_ibset, gfc_resolve_ibset,
1758 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
1760 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
1762 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1763 BT_INTEGER, di, GFC_STD_F77,
1764 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
1765 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1767 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
1769 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1770 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1771 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1773 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
1775 add_sym_2 ("xor", GFC_ISYM_XOR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1776 gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
1777 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1779 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
1781 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1782 NULL, NULL, gfc_resolve_ierrno);
1784 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
1786 /* The resolution function for INDEX is called gfc_resolve_index_func
1787 because the name gfc_resolve_index is already used in resolve.c. */
1788 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
1789 BT_INTEGER, di, GFC_STD_F77,
1790 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1791 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
1792 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
1794 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
1796 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1797 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1798 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1800 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1801 NULL, gfc_simplify_ifix, NULL,
1802 a, BT_REAL, dr, REQUIRED);
1804 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1805 NULL, gfc_simplify_idint, NULL,
1806 a, BT_REAL, dd, REQUIRED);
1808 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
1810 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1811 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
1812 a, BT_REAL, dr, REQUIRED);
1814 make_alias ("short", GFC_STD_GNU);
1816 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
1818 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1819 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
1820 a, BT_REAL, dr, REQUIRED);
1822 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
1824 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1825 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
1826 a, BT_REAL, dr, REQUIRED);
1828 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
1830 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1831 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1832 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1834 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
1836 add_sym_2 ("or", GFC_ISYM_OR, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1837 gfc_check_and, gfc_simplify_or, gfc_resolve_or,
1838 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
1840 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
1842 /* The following function is for G77 compatibility. */
1843 add_sym_1 ("irand", GFC_ISYM_IRAND, NO_CLASS, ACTUAL_NO, BT_INTEGER, 4, GFC_STD_GNU,
1844 gfc_check_irand, NULL, NULL,
1845 i, BT_INTEGER, 4, OPTIONAL);
1847 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
1849 add_sym_1 ("isatty", GFC_ISYM_ISATTY, NO_CLASS, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_GNU,
1850 gfc_check_isatty, NULL, gfc_resolve_isatty,
1851 ut, BT_INTEGER, di, REQUIRED);
1853 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
1855 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
1856 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1857 gfc_check_i, gfc_simplify_is_iostat_end, NULL,
1858 i, BT_INTEGER, 0, REQUIRED);
1860 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1862 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1863 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1864 gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
1865 i, BT_INTEGER, 0, REQUIRED);
1867 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1869 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
1870 BT_LOGICAL, dl, GFC_STD_GNU,
1871 gfc_check_isnan, gfc_simplify_isnan, NULL,
1872 x, BT_REAL, 0, REQUIRED);
1874 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1876 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1877 gfc_check_ishft, NULL, gfc_resolve_rshift,
1878 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1880 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1882 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1883 gfc_check_ishft, NULL, gfc_resolve_lshift,
1884 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1886 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1888 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1889 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1890 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1892 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
1894 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1895 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1896 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1897 sz, BT_INTEGER, di, OPTIONAL);
1899 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
1901 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
1902 gfc_check_kill, NULL, gfc_resolve_kill,
1903 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1905 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1907 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1908 gfc_check_kind, gfc_simplify_kind, NULL,
1909 x, BT_REAL, dr, REQUIRED);
1911 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
1913 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1914 BT_INTEGER, di, GFC_STD_F95,
1915 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
1916 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1917 kind, BT_INTEGER, di, OPTIONAL);
1919 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
1921 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1922 BT_INTEGER, di, GFC_STD_F2008,
1923 gfc_check_i, gfc_simplify_leadz, NULL,
1924 i, BT_INTEGER, di, REQUIRED);
1926 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1928 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1929 BT_INTEGER, di, GFC_STD_F77,
1930 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1931 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1933 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
1935 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1936 BT_INTEGER, di, GFC_STD_F95,
1937 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1938 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
1940 make_alias ("lnblnk", GFC_STD_GNU);
1942 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
1944 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1946 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1947 x, BT_REAL, dr, REQUIRED);
1949 make_alias ("log_gamma", GFC_STD_F2008);
1951 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1952 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1953 x, BT_REAL, dr, REQUIRED);
1955 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1956 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
1957 x, BT_REAL, dr, REQUIRED);
1959 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
1962 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1963 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1964 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1966 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
1968 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1969 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1970 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1972 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
1974 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1975 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1976 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1978 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
1980 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1981 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1982 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
1984 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
1986 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1987 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1988 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
1990 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1992 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1993 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1994 x, BT_REAL, dr, REQUIRED);
1996 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1997 NULL, gfc_simplify_log, gfc_resolve_log,
1998 x, BT_REAL, dr, REQUIRED);
2000 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2001 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
2002 x, BT_REAL, dd, REQUIRED);
2004 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2005 NULL, gfc_simplify_log, gfc_resolve_log,
2006 x, BT_COMPLEX, dz, REQUIRED);
2008 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2009 NULL, gfc_simplify_log, gfc_resolve_log,
2010 x, BT_COMPLEX, dd, REQUIRED);
2012 make_alias ("cdlog", GFC_STD_GNU);
2014 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
2016 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2017 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
2018 x, BT_REAL, dr, REQUIRED);
2020 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2021 NULL, gfc_simplify_log10, gfc_resolve_log10,
2022 x, BT_REAL, dr, REQUIRED);
2024 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2025 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
2026 x, BT_REAL, dd, REQUIRED);
2028 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
2030 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
2031 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
2032 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2034 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
2036 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2037 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2038 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2040 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2042 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2043 GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2044 sz, BT_INTEGER, di, REQUIRED);
2046 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2048 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2049 gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
2050 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
2052 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
2054 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2055 int(max). The max function must take at least two arguments. */
2057 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2058 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
2059 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
2061 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2062 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2063 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2065 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2066 gfc_check_min_max_integer, gfc_simplify_max, NULL,
2067 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2069 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2070 gfc_check_min_max_real, gfc_simplify_max, NULL,
2071 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2073 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2074 gfc_check_min_max_real, gfc_simplify_max, NULL,
2075 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2077 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2078 gfc_check_min_max_double, gfc_simplify_max, NULL,
2079 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2081 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
2083 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2084 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
2085 x, BT_UNKNOWN, dr, REQUIRED);
2087 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
2089 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2090 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
2091 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2092 msk, BT_LOGICAL, dl, OPTIONAL);
2094 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
2096 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2097 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
2098 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2099 msk, BT_LOGICAL, dl, OPTIONAL);
2101 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
2103 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2104 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
2106 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2108 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2109 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
2111 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2113 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2114 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
2115 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2116 msk, BT_LOGICAL, dl, REQUIRED);
2118 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
2120 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2123 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
2124 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
2125 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2127 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2128 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2129 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2131 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2132 gfc_check_min_max_integer, gfc_simplify_min, NULL,
2133 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
2135 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2136 gfc_check_min_max_real, gfc_simplify_min, NULL,
2137 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2139 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
2140 gfc_check_min_max_real, gfc_simplify_min, NULL,
2141 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
2143 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
2144 gfc_check_min_max_double, gfc_simplify_min, NULL,
2145 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
2147 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
2149 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
2150 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
2151 x, BT_UNKNOWN, dr, REQUIRED);
2153 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
2155 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2156 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
2157 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2158 msk, BT_LOGICAL, dl, OPTIONAL);
2160 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
2162 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2163 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
2164 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2165 msk, BT_LOGICAL, dl, OPTIONAL);
2167 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
2169 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2170 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
2171 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
2173 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2174 NULL, gfc_simplify_mod, gfc_resolve_mod,
2175 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
2177 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2178 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
2179 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
2181 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
2183 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
2184 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
2185 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
2187 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
2189 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2190 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
2191 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
2193 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
2195 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
2196 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
2197 a, BT_CHARACTER, dc, REQUIRED);
2199 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2201 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2202 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
2203 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2205 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2206 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
2207 a, BT_REAL, dd, REQUIRED);
2209 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
2211 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2212 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
2213 i, BT_INTEGER, di, REQUIRED);
2215 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
2217 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2218 gfc_check_null, gfc_simplify_null, NULL,
2219 mo, BT_INTEGER, di, OPTIONAL);
2221 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
2223 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2224 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
2225 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2226 v, BT_REAL, dr, OPTIONAL);
2228 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
2230 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2231 gfc_check_precision, gfc_simplify_precision, NULL,
2232 x, BT_UNKNOWN, 0, REQUIRED);
2234 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
2236 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2237 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2238 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
2240 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
2242 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2243 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
2244 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2245 msk, BT_LOGICAL, dl, OPTIONAL);
2247 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
2249 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2250 gfc_check_radix, gfc_simplify_radix, NULL,
2251 x, BT_UNKNOWN, 0, REQUIRED);
2253 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
2255 /* The following function is for G77 compatibility. */
2256 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2257 gfc_check_rand, NULL, NULL,
2258 i, BT_INTEGER, 4, OPTIONAL);
2260 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2261 use slightly different shoddy multiplicative congruential PRNG. */
2262 make_alias ("ran", GFC_STD_GNU);
2264 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2266 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2267 gfc_check_range, gfc_simplify_range, NULL,
2268 x, BT_REAL, dr, REQUIRED);
2270 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
2272 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2273 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
2274 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
2276 /* This provides compatibility with g77. */
2277 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2278 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2279 a, BT_UNKNOWN, dr, REQUIRED);
2281 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2282 gfc_check_i, gfc_simplify_float, NULL,
2283 a, BT_INTEGER, di, REQUIRED);
2285 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
2286 NULL, gfc_simplify_sngl, NULL,
2287 a, BT_REAL, dd, REQUIRED);
2289 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2291 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2292 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2293 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2295 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2297 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2298 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
2299 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
2301 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
2303 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2304 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
2305 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2306 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
2308 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
2310 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2311 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
2312 x, BT_REAL, dr, REQUIRED);
2314 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
2316 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2317 BT_LOGICAL, dl, GFC_STD_F2003,
2318 gfc_check_same_type_as, NULL, NULL,
2319 a, BT_UNKNOWN, 0, REQUIRED,
2320 b, BT_UNKNOWN, 0, REQUIRED);
2322 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2323 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
2324 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2326 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
2328 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2329 BT_INTEGER, di, GFC_STD_F95,
2330 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
2331 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2332 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2334 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
2336 /* Added for G77 compatibility garbage. */
2337 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
2340 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2342 /* Added for G77 compatibility. */
2343 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2344 gfc_check_secnds, NULL, gfc_resolve_secnds,
2345 x, BT_REAL, dr, REQUIRED);
2347 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2349 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2350 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2351 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2352 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2354 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2356 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2357 GFC_STD_F95, gfc_check_selected_int_kind,
2358 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
2360 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
2362 add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
2363 GFC_STD_F95, gfc_check_selected_real_kind,
2364 gfc_simplify_selected_real_kind, NULL,
2365 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
2367 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
2369 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2370 gfc_check_set_exponent, gfc_simplify_set_exponent,
2371 gfc_resolve_set_exponent,
2372 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
2374 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
2376 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
2377 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
2378 src, BT_REAL, dr, REQUIRED);
2380 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
2382 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2383 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
2384 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
2386 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
2387 NULL, gfc_simplify_sign, gfc_resolve_sign,
2388 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
2390 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2391 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
2392 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
2394 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
2396 add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2397 gfc_check_signal, NULL, gfc_resolve_signal,
2398 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2400 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2402 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2403 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
2404 x, BT_REAL, dr, REQUIRED);
2406 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2407 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
2408 x, BT_REAL, dd, REQUIRED);
2410 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2411 NULL, gfc_simplify_sin, gfc_resolve_sin,
2412 x, BT_COMPLEX, dz, REQUIRED);
2414 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2415 NULL, gfc_simplify_sin, gfc_resolve_sin,
2416 x, BT_COMPLEX, dd, REQUIRED);
2418 make_alias ("cdsin", GFC_STD_GNU);
2420 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
2422 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2423 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
2424 x, BT_REAL, dr, REQUIRED);
2426 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2427 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
2428 x, BT_REAL, dd, REQUIRED);
2430 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
2432 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2433 BT_INTEGER, di, GFC_STD_F95,
2434 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2435 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2436 kind, BT_INTEGER, di, OPTIONAL);
2438 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
2440 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2441 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
2442 x, BT_UNKNOWN, 0, REQUIRED);
2444 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
2445 make_alias ("c_sizeof", GFC_STD_F2008);
2447 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2448 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
2449 x, BT_REAL, dr, REQUIRED);
2451 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
2453 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2454 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
2455 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
2456 ncopies, BT_INTEGER, di, REQUIRED);
2458 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
2460 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2461 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
2462 x, BT_REAL, dr, REQUIRED);
2464 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2465 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
2466 x, BT_REAL, dd, REQUIRED);
2468 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
2469 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2470 x, BT_COMPLEX, dz, REQUIRED);
2472 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
2473 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2474 x, BT_COMPLEX, dd, REQUIRED);
2476 make_alias ("cdsqrt", GFC_STD_GNU);
2478 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
2480 add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2481 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2482 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2484 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2486 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2487 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
2488 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2489 msk, BT_LOGICAL, dl, OPTIONAL);
2491 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
2493 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2494 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2495 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
2497 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2499 add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2500 GFC_STD_GNU, NULL, NULL, NULL,
2501 com, BT_CHARACTER, dc, REQUIRED);
2503 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
2505 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2506 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
2507 x, BT_REAL, dr, REQUIRED);
2509 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2510 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
2511 x, BT_REAL, dd, REQUIRED);
2513 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
2515 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
2516 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
2517 x, BT_REAL, dr, REQUIRED);
2519 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
2520 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
2521 x, BT_REAL, dd, REQUIRED);
2523 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
2525 add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2526 NULL, NULL, gfc_resolve_time);
2528 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2530 add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2531 NULL, NULL, gfc_resolve_time8);
2533 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2535 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2536 gfc_check_x, gfc_simplify_tiny, NULL,
2537 x, BT_REAL, dr, REQUIRED);
2539 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
2541 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2542 BT_INTEGER, di, GFC_STD_F2008,
2543 gfc_check_i, gfc_simplify_trailz, NULL,
2544 i, BT_INTEGER, di, REQUIRED);
2546 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2548 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2549 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
2550 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2551 sz, BT_INTEGER, di, OPTIONAL);
2553 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
2555 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2556 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
2557 m, BT_REAL, dr, REQUIRED);
2559 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
2561 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
2562 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
2563 stg, BT_CHARACTER, dc, REQUIRED);
2565 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
2567 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
2568 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2569 ut, BT_INTEGER, di, REQUIRED);
2571 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2573 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2574 BT_INTEGER, di, GFC_STD_F95,
2575 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
2576 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2577 kind, BT_INTEGER, di, OPTIONAL);
2579 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
2581 /* g77 compatibility for UMASK. */
2582 add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2583 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2584 msk, BT_INTEGER, di, REQUIRED);
2586 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2588 /* g77 compatibility for UNLINK. */
2589 add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
2590 gfc_check_unlink, NULL, gfc_resolve_unlink,
2591 "path", BT_CHARACTER, dc, REQUIRED);
2593 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2595 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
2596 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
2597 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2598 f, BT_REAL, dr, REQUIRED);
2600 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
2602 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2603 BT_INTEGER, di, GFC_STD_F95,
2604 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
2605 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
2606 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
2608 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
2610 add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2611 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2612 x, BT_UNKNOWN, 0, REQUIRED);
2614 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
2618 /* Add intrinsic subroutines. */
2621 add_subroutines (void)
2623 /* Argument names as in the standard (to be used as argument keywords). */
2625 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2626 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2627 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
2628 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2629 *com = "command", *length = "length", *st = "status",
2630 *val = "value", *num = "number", *name = "name",
2631 *trim_name = "trim_name", *ut = "unit", *han = "handler",
2632 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2633 *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2634 *p2 = "path2", *msk = "mask", *old = "old";
2636 int di, dr, dc, dl, ii;
2638 di = gfc_default_integer_kind;
2639 dr = gfc_default_real_kind;
2640 dc = gfc_default_character_kind;
2641 dl = gfc_default_logical_kind;
2642 ii = gfc_index_integer_kind;
2644 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
2648 add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2649 GFC_STD_F95, gfc_check_cpu_time, NULL,
2650 gfc_resolve_cpu_time,
2651 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2653 /* More G77 compatibility garbage. */
2654 add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2655 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2656 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2658 add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2659 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2660 vl, BT_INTEGER, 4, REQUIRED);
2662 add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2663 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2664 vl, BT_INTEGER, 4, REQUIRED);
2666 add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2667 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2668 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2670 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2671 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2672 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2674 add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2675 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
2676 tm, BT_REAL, dr, REQUIRED);
2678 add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2679 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
2680 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2682 add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2683 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
2684 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2685 st, BT_INTEGER, di, OPTIONAL);
2687 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2688 GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2689 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2690 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2691 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2692 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2694 /* More G77 compatibility garbage. */
2695 add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2696 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
2697 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2699 add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2700 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
2701 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2703 add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2704 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2705 dt, BT_CHARACTER, dc, REQUIRED);
2707 add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2708 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
2711 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2712 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
2713 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2715 add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2717 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2720 add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2721 gfc_check_getarg, NULL, gfc_resolve_getarg,
2722 pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
2724 add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2725 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
2728 /* F2003 commandline routines. */
2730 add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2731 0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2732 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2733 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2734 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2736 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2737 BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2738 gfc_resolve_get_command_argument,
2739 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2740 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2741 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2742 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2744 /* F2003 subroutine to get environment variables. */
2746 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2747 NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
2748 NULL, NULL, gfc_resolve_get_environment_variable,
2749 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2750 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2751 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2752 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2753 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2755 add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2756 GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2757 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2758 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2760 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2761 GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2763 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2764 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2765 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2766 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2767 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2769 add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2770 BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2771 gfc_resolve_random_number,
2772 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2774 add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2775 BT_UNKNOWN, 0, GFC_STD_F95,
2776 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2777 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2778 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2779 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2781 /* More G77 compatibility garbage. */
2782 add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2783 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2784 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2785 st, BT_INTEGER, di, OPTIONAL);
2787 add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
2788 gfc_check_srand, NULL, gfc_resolve_srand,
2789 "seed", BT_INTEGER, 4, REQUIRED);
2791 add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2792 gfc_check_exit, NULL, gfc_resolve_exit,
2793 st, BT_INTEGER, di, OPTIONAL);
2797 add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2798 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2799 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2800 st, BT_INTEGER, di, OPTIONAL);
2802 add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2803 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2804 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2806 add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2807 gfc_check_flush, NULL, gfc_resolve_flush,
2808 ut, BT_INTEGER, di, OPTIONAL);
2810 add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2811 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2812 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2813 st, BT_INTEGER, di, OPTIONAL);
2815 add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2816 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2817 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2819 add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2820 gfc_check_free, NULL, gfc_resolve_free,
2821 ptr, BT_INTEGER, ii, REQUIRED);
2823 add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2824 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2825 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2826 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2827 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2828 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2830 add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2831 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2832 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2834 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2835 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
2836 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2838 add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
2839 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2840 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2842 add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2843 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2844 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2845 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2847 add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2848 gfc_check_perror, NULL, gfc_resolve_perror,
2849 "string", BT_CHARACTER, dc, REQUIRED);
2851 add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2852 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2853 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2854 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2856 add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2857 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2858 sec, BT_INTEGER, di, REQUIRED);
2860 add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2861 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2862 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2863 st, BT_INTEGER, di, OPTIONAL);
2865 add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2866 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2867 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2868 st, BT_INTEGER, di, OPTIONAL);
2870 add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2871 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2872 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2873 st, BT_INTEGER, di, OPTIONAL);
2875 add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2876 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2877 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2878 st, BT_INTEGER, di, OPTIONAL);
2880 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2881 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2882 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
2883 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2885 add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2886 NULL, NULL, gfc_resolve_system_sub,
2887 com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2889 add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2890 BT_UNKNOWN, 0, GFC_STD_F95,
2891 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2892 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2893 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2894 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
2896 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2897 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
2898 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
2900 add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2901 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2902 msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
2904 add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2905 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2906 "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2910 /* Add a function to the list of conversion symbols. */
2913 add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
2915 gfc_typespec from, to;
2916 gfc_intrinsic_sym *sym;
2918 if (sizing == SZ_CONVS)
2924 gfc_clear_ts (&from);
2925 from.type = from_type;
2926 from.kind = from_kind;
2932 sym = conversion + nconv;
2934 sym->name = conv_name (&from, &to);
2935 sym->lib_name = sym->name;
2936 sym->simplify.cc = gfc_convert_constant;
2937 sym->standard = standard;
2939 sym->conversion = 1;
2941 sym->id = GFC_ISYM_CONVERSION;
2947 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2948 functions by looping over the kind tables. */
2951 add_conversions (void)
2955 /* Integer-Integer conversions. */
2956 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2957 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2962 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2963 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
2966 /* Integer-Real/Complex conversions. */
2967 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2968 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2970 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2971 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
2973 add_conv (BT_REAL, gfc_real_kinds[j].kind,
2974 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2976 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
2977 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
2979 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
2980 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
2983 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2985 /* Hollerith-Integer conversions. */
2986 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2987 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2988 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2989 /* Hollerith-Real conversions. */
2990 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2991 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2992 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2993 /* Hollerith-Complex conversions. */
2994 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2995 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2996 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2998 /* Hollerith-Character conversions. */
2999 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3000 gfc_default_character_kind, GFC_STD_LEGACY);
3002 /* Hollerith-Logical conversions. */
3003 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3004 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3005 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3008 /* Real/Complex - Real/Complex conversions. */
3009 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3010 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3014 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3015 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3017 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3018 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3021 add_conv (BT_REAL, gfc_real_kinds[i].kind,
3022 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
3024 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
3025 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
3028 /* Logical/Logical kind conversion. */
3029 for (i = 0; gfc_logical_kinds[i].kind; i++)
3030 for (j = 0; gfc_logical_kinds[j].kind; j++)
3035 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
3036 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
3039 /* Integer-Logical and Logical-Integer conversions. */
3040 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3041 for (i=0; gfc_integer_kinds[i].kind; i++)
3042 for (j=0; gfc_logical_kinds[j].kind; j++)
3044 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3045 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3046 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3047 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3053 add_char_conversions (void)
3057 /* Count possible conversions. */
3058 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3059 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3063 /* Allocate memory. */
3064 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
3066 /* Add the conversions themselves. */
3068 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3069 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3071 gfc_typespec from, to;
3076 gfc_clear_ts (&from);
3077 from.type = BT_CHARACTER;
3078 from.kind = gfc_character_kinds[i].kind;
3081 to.type = BT_CHARACTER;
3082 to.kind = gfc_character_kinds[j].kind;
3084 char_conversions[n].name = conv_name (&from, &to);
3085 char_conversions[n].lib_name = char_conversions[n].name;
3086 char_conversions[n].simplify.cc = gfc_convert_char_constant;
3087 char_conversions[n].standard = GFC_STD_F2003;
3088 char_conversions[n].elemental = 1;
3089 char_conversions[n].conversion = 0;
3090 char_conversions[n].ts = to;
3091 char_conversions[n].id = GFC_ISYM_CONVERSION;
3098 /* Initialize the table of intrinsics. */
3100 gfc_intrinsic_init_1 (void)
3104 nargs = nfunc = nsub = nconv = 0;
3106 /* Create a namespace to hold the resolved intrinsic symbols. */
3107 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
3116 functions = XCNEWVAR (struct gfc_intrinsic_sym,
3117 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3118 + sizeof (gfc_intrinsic_arg) * nargs);
3120 next_sym = functions;
3121 subroutines = functions + nfunc;
3123 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
3125 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3127 sizing = SZ_NOTHING;
3134 /* Character conversion intrinsics need to be treated separately. */
3135 add_char_conversions ();
3137 /* Set the pure flag. All intrinsic functions are pure, and
3138 intrinsic subroutines are pure if they are elemental. */
3140 for (i = 0; i < nfunc; i++)
3141 functions[i].pure = 1;
3143 for (i = 0; i < nsub; i++)
3144 subroutines[i].pure = subroutines[i].elemental;
3149 gfc_intrinsic_done_1 (void)
3151 gfc_free (functions);
3152 gfc_free (conversion);
3153 gfc_free (char_conversions);
3154 gfc_free_namespace (gfc_intrinsic_namespace);
3158 /******** Subroutines to check intrinsic interfaces ***********/
3160 /* Given a formal argument list, remove any NULL arguments that may
3161 have been left behind by a sort against some formal argument list. */
3164 remove_nullargs (gfc_actual_arglist **ap)
3166 gfc_actual_arglist *head, *tail, *next;
3170 for (head = *ap; head; head = next)
3174 if (head->expr == NULL && !head->label)
3177 gfc_free_actual_arglist (head);
3196 /* Given an actual arglist and a formal arglist, sort the actual
3197 arglist so that its arguments are in a one-to-one correspondence
3198 with the format arglist. Arguments that are not present are given
3199 a blank gfc_actual_arglist structure. If something is obviously
3200 wrong (say, a missing required argument) we abort sorting and
3204 sort_actual (const char *name, gfc_actual_arglist **ap,
3205 gfc_intrinsic_arg *formal, locus *where)
3207 gfc_actual_arglist *actual, *a;
3208 gfc_intrinsic_arg *f;
3210 remove_nullargs (ap);
3213 for (f = formal; f; f = f->next)
3219 if (f == NULL && a == NULL) /* No arguments */
3223 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3229 if (a->name != NULL)
3241 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3245 /* Associate the remaining actual arguments, all of which have
3246 to be keyword arguments. */
3247 for (; a; a = a->next)
3249 for (f = formal; f; f = f->next)
3250 if (strcmp (a->name, f->name) == 0)
3255 if (a->name[0] == '%')
3256 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3257 "are not allowed in this context at %L", where);
3259 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3260 a->name, name, where);
3264 if (f->actual != NULL)
3266 gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3267 f->name, name, where);
3275 /* At this point, all unmatched formal args must be optional. */
3276 for (f = formal; f; f = f->next)
3278 if (f->actual == NULL && f->optional == 0)
3280 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3281 f->name, name, where);
3287 /* Using the formal argument list, string the actual argument list
3288 together in a way that corresponds with the formal list. */
3291 for (f = formal; f; f = f->next)
3293 if (f->actual && f->actual->label != NULL && f->ts.type)
3295 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3299 if (f->actual == NULL)
3301 a = gfc_get_actual_arglist ();
3302 a->missing_arg_type = f->ts.type;
3314 actual->next = NULL; /* End the sorted argument list. */
3320 /* Compare an actual argument list with an intrinsic's formal argument
3321 list. The lists are checked for agreement of type. We don't check
3322 for arrayness here. */
3325 check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
3328 gfc_actual_arglist *actual;
3329 gfc_intrinsic_arg *formal;
3332 formal = sym->formal;
3336 for (; formal; formal = formal->next, actual = actual->next, i++)
3340 if (actual->expr == NULL)
3345 /* A kind of 0 means we don't check for kind. */
3347 ts.kind = actual->expr->ts.kind;
3349 if (!gfc_compare_types (&ts, &actual->expr->ts))
3352 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3353 "be %s, not %s", gfc_current_intrinsic_arg[i],
3354 gfc_current_intrinsic, &actual->expr->where,
3355 gfc_typename (&formal->ts),
3356 gfc_typename (&actual->expr->ts));
3365 /* Given a pointer to an intrinsic symbol and an expression node that
3366 represent the function call to that subroutine, figure out the type
3367 of the result. This may involve calling a resolution subroutine. */
3370 resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
3372 gfc_expr *a1, *a2, *a3, *a4, *a5;
3373 gfc_actual_arglist *arg;
3375 if (specific->resolve.f1 == NULL)
3377 if (e->value.function.name == NULL)
3378 e->value.function.name = specific->lib_name;
3380 if (e->ts.type == BT_UNKNOWN)
3381 e->ts = specific->ts;
3385 arg = e->value.function.actual;
3387 /* Special case hacks for MIN and MAX. */
3388 if (specific->resolve.f1m == gfc_resolve_max
3389 || specific->resolve.f1m == gfc_resolve_min)
3391 (*specific->resolve.f1m) (e, arg);
3397 (*specific->resolve.f0) (e);
3406 (*specific->resolve.f1) (e, a1);
3415 (*specific->resolve.f2) (e, a1, a2);
3424 (*specific->resolve.f3) (e, a1, a2, a3);
3433 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3442 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3446 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3450 /* Given an intrinsic symbol node and an expression node, call the
3451 simplification function (if there is one), perhaps replacing the
3452 expression with something simpler. We return FAILURE on an error
3453 of the simplification, SUCCESS if the simplification worked, even
3454 if nothing has changed in the expression itself. */
3457 do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
3459 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3460 gfc_actual_arglist *arg;
3462 /* Max and min require special handling due to the variable number
3464 if (specific->simplify.f1 == gfc_simplify_min)
3466 result = gfc_simplify_min (e);
3470 if (specific->simplify.f1 == gfc_simplify_max)
3472 result = gfc_simplify_max (e);
3476 if (specific->simplify.f1 == NULL)
3482 arg = e->value.function.actual;
3486 result = (*specific->simplify.f0) ();
3493 if (specific->simplify.cc == gfc_convert_constant
3494 || specific->simplify.cc == gfc_convert_char_constant)
3496 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
3501 result = (*specific->simplify.f1) (a1);
3508 result = (*specific->simplify.f2) (a1, a2);
3515 result = (*specific->simplify.f3) (a1, a2, a3);
3522 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3529 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3532 ("do_simplify(): Too many args for intrinsic");
3539 if (result == &gfc_bad_expr)
3543 resolve_intrinsic (specific, e); /* Must call at run-time */
3546 result->where = e->where;
3547 gfc_replace_expr (e, result);
3554 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3555 error messages. This subroutine returns FAILURE if a subroutine
3556 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3557 list cannot match any intrinsic. */
3560 init_arglist (gfc_intrinsic_sym *isym)
3562 gfc_intrinsic_arg *formal;
3565 gfc_current_intrinsic = isym->name;
3568 for (formal = isym->formal; formal; formal = formal->next)
3570 if (i >= MAX_INTRINSIC_ARGS)
3571 gfc_internal_error ("init_arglist(): too many arguments");
3572 gfc_current_intrinsic_arg[i++] = formal->name;
3577 /* Given a pointer to an intrinsic symbol and an expression consisting
3578 of a function call, see if the function call is consistent with the
3579 intrinsic's formal argument list. Return SUCCESS if the expression
3580 and intrinsic match, FAILURE otherwise. */
3583 check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
3585 gfc_actual_arglist *arg, **ap;
3588 ap = &expr->value.function.actual;
3590 init_arglist (specific);
3592 /* Don't attempt to sort the argument list for min or max. */
3593 if (specific->check.f1m == gfc_check_min_max
3594 || specific->check.f1m == gfc_check_min_max_integer
3595 || specific->check.f1m == gfc_check_min_max_real
3596 || specific->check.f1m == gfc_check_min_max_double)
3597 return (*specific->check.f1m) (*ap);
3599 if (sort_actual (specific->name, ap, specific->formal,
3600 &expr->where) == FAILURE)
3603 if (specific->check.f3ml == gfc_check_minloc_maxloc)
3604 /* This is special because we might have to reorder the argument list. */
3605 t = gfc_check_minloc_maxloc (*ap);
3606 else if (specific->check.f3red == gfc_check_minval_maxval)
3607 /* This is also special because we also might have to reorder the
3609 t = gfc_check_minval_maxval (*ap);
3610 else if (specific->check.f3red == gfc_check_product_sum)
3611 /* Same here. The difference to the previous case is that we allow a
3612 general numeric type. */
3613 t = gfc_check_product_sum (*ap);
3616 if (specific->check.f1 == NULL)
3618 t = check_arglist (ap, specific, error_flag);
3620 expr->ts = specific->ts;
3623 t = do_check (specific, *ap);
3626 /* Check conformance of elemental intrinsics. */
3627 if (t == SUCCESS && specific->elemental)
3630 gfc_expr *first_expr;
3631 arg = expr->value.function.actual;
3633 /* There is no elemental intrinsic without arguments. */
3634 gcc_assert(arg != NULL);
3635 first_expr = arg->expr;
3637 for ( ; arg && arg->expr; arg = arg->next, n++)
3638 if (gfc_check_conformance (first_expr, arg->expr,
3639 "arguments '%s' and '%s' for "
3641 gfc_current_intrinsic_arg[0],
3642 gfc_current_intrinsic_arg[n],
3643 gfc_current_intrinsic) == FAILURE)
3648 remove_nullargs (ap);
3654 /* Check whether an intrinsic belongs to whatever standard the user
3655 has chosen, taking also into account -fall-intrinsics. Here, no
3656 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3657 textual representation of the symbols standard status (like
3658 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3659 can be used to construct a detailed warning/error message in case of
3663 gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3664 const char** symstd, bool silent, locus where)
3666 const char* symstd_msg;
3668 /* For -fall-intrinsics, just succeed. */
3669 if (gfc_option.flag_all_intrinsics)
3672 /* Find the symbol's standard message for later usage. */
3673 switch (isym->standard)
3676 symstd_msg = "available since Fortran 77";
3679 case GFC_STD_F95_OBS:
3680 symstd_msg = "obsolescent in Fortran 95";
3683 case GFC_STD_F95_DEL:
3684 symstd_msg = "deleted in Fortran 95";
3688 symstd_msg = "new in Fortran 95";
3692 symstd_msg = "new in Fortran 2003";
3696 symstd_msg = "new in Fortran 2008";
3700 symstd_msg = "a GNU Fortran extension";
3703 case GFC_STD_LEGACY:
3704 symstd_msg = "for backward compatibility";
3708 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3709 isym->name, isym->standard);
3712 /* If warning about the standard, warn and succeed. */
3713 if (gfc_option.warn_std & isym->standard)
3715 /* Do only print a warning if not a GNU extension. */
3716 if (!silent && isym->standard != GFC_STD_GNU)
3717 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3718 isym->name, _(symstd_msg), &where);
3723 /* If allowing the symbol's standard, succeed, too. */
3724 if (gfc_option.allow_std & isym->standard)
3727 /* Otherwise, fail. */
3729 *symstd = _(symstd_msg);
3734 /* See if a function call corresponds to an intrinsic function call.
3737 MATCH_YES if the call corresponds to an intrinsic, simplification
3738 is done if possible.
3740 MATCH_NO if the call does not correspond to an intrinsic
3742 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3743 error during the simplification process.
3745 The error_flag parameter enables an error reporting. */
3748 gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
3750 gfc_intrinsic_sym *isym, *specific;
3751 gfc_actual_arglist *actual;
3755 if (expr->value.function.isym != NULL)
3756 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
3757 ? MATCH_ERROR : MATCH_YES;
3760 gfc_push_suppress_errors ();
3763 for (actual = expr->value.function.actual; actual; actual = actual->next)
3764 if (actual->expr != NULL)
3765 flag |= (actual->expr->ts.type != BT_INTEGER
3766 && actual->expr->ts.type != BT_CHARACTER);
3768 name = expr->symtree->n.sym->name;
3770 isym = specific = gfc_find_function (name);
3774 gfc_pop_suppress_errors ();
3778 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3779 || isym->id == GFC_ISYM_CMPLX)
3781 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3782 "as initialization expression at %L", name,
3783 &expr->where) == FAILURE)
3786 gfc_pop_suppress_errors ();
3790 gfc_current_intrinsic_where = &expr->where;
3792 /* Bypass the generic list for min and max. */
3793 if (isym->check.f1m == gfc_check_min_max)
3795 init_arglist (isym);
3797 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3801 gfc_pop_suppress_errors ();
3805 /* If the function is generic, check all of its specific
3806 incarnations. If the generic name is also a specific, we check
3807 that name last, so that any error message will correspond to the
3809 gfc_push_suppress_errors ();
3813 for (specific = isym->specific_head; specific;
3814 specific = specific->next)
3816 if (specific == isym)
3818 if (check_specific (specific, expr, 0) == SUCCESS)
3820 gfc_pop_suppress_errors ();
3826 gfc_pop_suppress_errors ();
3828 if (check_specific (isym, expr, error_flag) == FAILURE)
3831 gfc_pop_suppress_errors ();
3838 expr->value.function.isym = specific;
3839 gfc_intrinsic_symbol (expr->symtree->n.sym);
3842 gfc_pop_suppress_errors ();
3844 if (do_simplify (specific, expr) == FAILURE)
3847 /* F95, 7.1.6.1, Initialization expressions
3848 (4) An elemental intrinsic function reference of type integer or
3849 character where each argument is an initialization expression
3850 of type integer or character
3852 F2003, 7.1.7 Initialization expression
3853 (4) A reference to an elemental standard intrinsic function,
3854 where each argument is an initialization expression */
3856 if (gfc_init_expr && isym->elemental && flag
3857 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3858 "as initialization expression with non-integer/non-"
3859 "character arguments at %L", &expr->where) == FAILURE)
3866 /* See if a CALL statement corresponds to an intrinsic subroutine.
3867 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3868 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3872 gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
3874 gfc_intrinsic_sym *isym;
3877 name = c->symtree->n.sym->name;
3879 isym = gfc_find_subroutine (name);
3884 gfc_push_suppress_errors ();
3886 init_arglist (isym);
3888 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3891 if (isym->check.f1 != NULL)
3893 if (do_check (isym, c->ext.actual) == FAILURE)
3898 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3902 /* The subroutine corresponds to an intrinsic. Allow errors to be
3903 seen at this point. */
3905 gfc_pop_suppress_errors ();
3907 c->resolved_isym = isym;
3908 if (isym->resolve.s1 != NULL)
3909 isym->resolve.s1 (c);
3912 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3913 c->resolved_sym->attr.elemental = isym->elemental;
3916 if (gfc_pure (NULL) && !isym->elemental)
3918 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3923 c->resolved_sym->attr.noreturn = isym->noreturn;
3929 gfc_pop_suppress_errors ();
3934 /* Call gfc_convert_type() with warning enabled. */
3937 gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
3939 return gfc_convert_type_warn (expr, ts, eflag, 1);
3943 /* Try to convert an expression (in place) from one type to another.
3944 'eflag' controls the behavior on error.
3946 The possible values are:
3948 1 Generate a gfc_error()
3949 2 Generate a gfc_internal_error().
3951 'wflag' controls the warning related to conversion. */
3954 gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
3956 gfc_intrinsic_sym *sym;
3957 gfc_typespec from_ts;
3963 from_ts = expr->ts; /* expr->ts gets clobbered */
3965 if (ts->type == BT_UNKNOWN)
3968 /* NULL and zero size arrays get their type here. */
3969 if (expr->expr_type == EXPR_NULL
3970 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
3972 /* Sometimes the RHS acquire the type. */
3977 if (expr->ts.type == BT_UNKNOWN)
3980 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
3981 && gfc_compare_types (&expr->ts, ts))
3984 sym = find_conv (&expr->ts, ts);
3988 /* At this point, a conversion is necessary. A warning may be needed. */
3989 if ((gfc_option.warn_std & sym->standard) != 0)
3990 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3991 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3992 else if (wflag && gfc_option.warn_conversion)
3993 gfc_warning_now ("Conversion from %s to %s at %L",
3994 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3996 /* Insert a pre-resolved function call to the right function. */
3997 old_where = expr->where;
3999 shape = expr->shape;
4001 new_expr = gfc_get_expr ();
4004 new_expr = gfc_build_conversion (new_expr);
4005 new_expr->value.function.name = sym->lib_name;
4006 new_expr->value.function.isym = sym;
4007 new_expr->where = old_where;
4008 new_expr->rank = rank;
4009 new_expr->shape = gfc_copy_shape (shape, rank);
4011 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4012 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
4013 new_expr->symtree->n.sym->ts = *ts;
4014 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4015 new_expr->symtree->n.sym->attr.function = 1;
4016 new_expr->symtree->n.sym->attr.elemental = 1;
4017 new_expr->symtree->n.sym->attr.pure = 1;
4018 new_expr->symtree->n.sym->attr.referenced = 1;
4019 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4020 gfc_commit_symbol (new_expr->symtree->n.sym);
4024 gfc_free (new_expr);
4027 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4028 && do_simplify (sym, expr) == FAILURE)
4033 return FAILURE; /* Error already generated in do_simplify() */
4041 gfc_error ("Can't convert %s to %s at %L",
4042 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4046 gfc_internal_error ("Can't convert %s to %s at %L",
4047 gfc_typename (&from_ts), gfc_typename (ts),
4054 gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4056 gfc_intrinsic_sym *sym;
4062 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4064 sym = find_char_conv (&expr->ts, ts);
4067 /* Insert a pre-resolved function call to the right function. */
4068 old_where = expr->where;
4070 shape = expr->shape;
4072 new_expr = gfc_get_expr ();
4075 new_expr = gfc_build_conversion (new_expr);
4076 new_expr->value.function.name = sym->lib_name;
4077 new_expr->value.function.isym = sym;
4078 new_expr->where = old_where;
4079 new_expr->rank = rank;
4080 new_expr->shape = gfc_copy_shape (shape, rank);
4082 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4083 new_expr->symtree->n.sym->ts = *ts;
4084 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4085 new_expr->symtree->n.sym->attr.function = 1;
4086 new_expr->symtree->n.sym->attr.elemental = 1;
4087 new_expr->symtree->n.sym->attr.referenced = 1;
4088 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4089 gfc_commit_symbol (new_expr->symtree->n.sym);
4093 gfc_free (new_expr);
4096 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4097 && do_simplify (sym, expr) == FAILURE)
4099 /* Error already generated in do_simplify() */
4107 /* Check if the passed name is name of an intrinsic (taking into account the
4108 current -std=* and -fall-intrinsic settings). If it is, see if we should
4109 warn about this as a user-procedure having the same name as an intrinsic
4110 (-Wintrinsic-shadow enabled) and do so if we should. */
4113 gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4115 gfc_intrinsic_sym* isym;
4117 /* If the warning is disabled, do nothing at all. */
4118 if (!gfc_option.warn_intrinsic_shadow)
4121 /* Try to find an intrinsic of the same name. */
4123 isym = gfc_find_function (sym->name);
4125 isym = gfc_find_subroutine (sym->name);
4127 /* If no intrinsic was found with this name or it's not included in the
4128 selected standard, everything's fine. */
4129 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4130 sym->declared_at) == FAILURE)
4133 /* Emit the warning. */
4135 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4136 " name. In order to call the intrinsic, explicit INTRINSIC"
4137 " declarations may be required.",
4138 sym->name, &sym->declared_at);
4140 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4141 " only be called via an explicit interface or if declared"
4142 " EXTERNAL.", sym->name, &sym->declared_at);