1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
5 Free Software Foundation, Inc.
6 Contributed by Andy Vaught & Katherine Holcomb
8 This file is part of GCC.
10 GCC is free software; you can redistribute it and/or modify it under
11 the terms of the GNU General Public License as published by the Free
12 Software Foundation; either version 3, or (at your option) any later
15 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
16 WARRANTY; without even the implied warranty of MERCHANTABILITY or
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
20 You should have received a copy of the GNU General Public License
21 along with GCC; see the file COPYING3. If not see
22 <http://www.gnu.org/licenses/>. */
28 #include "intrinsic.h"
30 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
31 static gfc_namespace
*gfc_intrinsic_namespace
;
33 bool gfc_init_expr_flag
= false;
35 /* Pointers to an intrinsic function and its argument names that are being
38 const char *gfc_current_intrinsic
;
39 gfc_intrinsic_arg
*gfc_current_intrinsic_arg
[MAX_INTRINSIC_ARGS
];
40 locus
*gfc_current_intrinsic_where
;
42 static gfc_intrinsic_sym
*functions
, *subroutines
, *conversion
, *next_sym
;
43 static gfc_intrinsic_sym
*char_conversions
;
44 static gfc_intrinsic_arg
*next_arg
;
46 static int nfunc
, nsub
, nargs
, nconv
, ncharconv
;
49 { SZ_NOTHING
= 0, SZ_SUBS
, SZ_FUNCS
, SZ_CONVS
}
53 { CLASS_IMPURE
= 0, CLASS_PURE
, CLASS_ELEMENTAL
,
54 CLASS_INQUIRY
, CLASS_TRANSFORMATIONAL
};
63 /* Return a letter based on the passed type. Used to construct the
64 name of a type-dependent subroutine. */
67 gfc_type_letter (bt type
)
102 /* Get a symbol for a resolved name. Note, if needed be, the elemental
103 attribute has be added afterwards. */
106 gfc_get_intrinsic_sub_symbol (const char *name
)
110 gfc_get_symbol (name
, gfc_intrinsic_namespace
, &sym
);
111 sym
->attr
.always_explicit
= 1;
112 sym
->attr
.subroutine
= 1;
113 sym
->attr
.flavor
= FL_PROCEDURE
;
114 sym
->attr
.proc
= PROC_INTRINSIC
;
116 gfc_commit_symbol (sym
);
122 /* Return a pointer to the name of a conversion function given two
126 conv_name (gfc_typespec
*from
, gfc_typespec
*to
)
128 return gfc_get_string ("__convert_%c%d_%c%d",
129 gfc_type_letter (from
->type
), from
->kind
,
130 gfc_type_letter (to
->type
), to
->kind
);
134 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
135 corresponds to the conversion. Returns NULL if the conversion
138 static gfc_intrinsic_sym
*
139 find_conv (gfc_typespec
*from
, gfc_typespec
*to
)
141 gfc_intrinsic_sym
*sym
;
145 target
= conv_name (from
, to
);
148 for (i
= 0; i
< nconv
; i
++, sym
++)
149 if (target
== sym
->name
)
156 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
157 that corresponds to the conversion. Returns NULL if the conversion
160 static gfc_intrinsic_sym
*
161 find_char_conv (gfc_typespec
*from
, gfc_typespec
*to
)
163 gfc_intrinsic_sym
*sym
;
167 target
= conv_name (from
, to
);
168 sym
= char_conversions
;
170 for (i
= 0; i
< ncharconv
; i
++, sym
++)
171 if (target
== sym
->name
)
178 /* Interface to the check functions. We break apart an argument list
179 and call the proper check function rather than forcing each
180 function to manipulate the argument list. */
183 do_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
185 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
188 return (*specific
->check
.f0
) ();
193 return (*specific
->check
.f1
) (a1
);
198 return (*specific
->check
.f2
) (a1
, a2
);
203 return (*specific
->check
.f3
) (a1
, a2
, a3
);
208 return (*specific
->check
.f4
) (a1
, a2
, a3
, a4
);
213 return (*specific
->check
.f5
) (a1
, a2
, a3
, a4
, a5
);
215 gfc_internal_error ("do_check(): too many args");
219 /*********** Subroutines to build the intrinsic list ****************/
221 /* Add a single intrinsic symbol to the current list.
224 char * name of function
225 int whether function is elemental
226 int If the function can be used as an actual argument [1]
227 bt return type of function
228 int kind of return type of function
229 int Fortran standard version
230 check pointer to check function
231 simplify pointer to simplification function
232 resolve pointer to resolution function
234 Optional arguments come in multiples of five:
235 char * name of argument
238 int arg optional flag (1=optional, 0=required)
239 sym_intent intent of argument
241 The sequence is terminated by a NULL name.
244 [1] Whether a function can or cannot be used as an actual argument is
245 determined by its presence on the 13.6 list in Fortran 2003. The
246 following intrinsics, which are GNU extensions, are considered allowed
247 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
248 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
251 add_sym (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
, int kind
,
252 int standard
, gfc_check_f check
, gfc_simplify_f simplify
,
253 gfc_resolve_f resolve
, ...)
255 char buf
[GFC_MAX_SYMBOL_LEN
+ 11]; /* 10 for '_gfortran_', 1 for '\0' */
256 int optional
, first_flag
;
271 next_sym
->name
= gfc_get_string (name
);
273 strcpy (buf
, "_gfortran_");
275 next_sym
->lib_name
= gfc_get_string (buf
);
277 /* There are no IMPURE ELEMENTAL intrinsics, thus the ELEMENTAL class
278 also implies PURE. Additionally, there's the PURE class itself. */
279 next_sym
->pure
= (cl
== CLASS_ELEMENTAL
|| cl
== CLASS_PURE
);
281 next_sym
->elemental
= (cl
== CLASS_ELEMENTAL
);
282 next_sym
->inquiry
= (cl
== CLASS_INQUIRY
);
283 next_sym
->transformational
= (cl
== CLASS_TRANSFORMATIONAL
);
284 next_sym
->actual_ok
= actual_ok
;
285 next_sym
->ts
.type
= type
;
286 next_sym
->ts
.kind
= kind
;
287 next_sym
->standard
= standard
;
288 next_sym
->simplify
= simplify
;
289 next_sym
->check
= check
;
290 next_sym
->resolve
= resolve
;
291 next_sym
->specific
= 0;
292 next_sym
->generic
= 0;
293 next_sym
->conversion
= 0;
298 gfc_internal_error ("add_sym(): Bad sizing mode");
301 va_start (argp
, resolve
);
307 name
= va_arg (argp
, char *);
311 type
= (bt
) va_arg (argp
, int);
312 kind
= va_arg (argp
, int);
313 optional
= va_arg (argp
, int);
314 intent
= (sym_intent
) va_arg (argp
, int);
316 if (sizing
!= SZ_NOTHING
)
323 next_sym
->formal
= next_arg
;
325 (next_arg
- 1)->next
= next_arg
;
329 strcpy (next_arg
->name
, name
);
330 next_arg
->ts
.type
= type
;
331 next_arg
->ts
.kind
= kind
;
332 next_arg
->optional
= optional
;
334 next_arg
->intent
= intent
;
344 /* Add a symbol to the function list where the function takes
348 add_sym_0 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
349 int kind
, int standard
,
350 gfc_try (*check
) (void),
351 gfc_expr
*(*simplify
) (void),
352 void (*resolve
) (gfc_expr
*))
362 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
367 /* Add a symbol to the subroutine list where the subroutine takes
371 add_sym_0s (const char *name
, gfc_isym_id id
, int standard
,
372 void (*resolve
) (gfc_code
*))
382 add_sym (name
, id
, CLASS_IMPURE
, ACTUAL_NO
, BT_UNKNOWN
, 0, standard
, cf
, sf
,
387 /* Add a symbol to the function list where the function takes
391 add_sym_1 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
392 int kind
, int standard
,
393 gfc_try (*check
) (gfc_expr
*),
394 gfc_expr
*(*simplify
) (gfc_expr
*),
395 void (*resolve
) (gfc_expr
*, gfc_expr
*),
396 const char *a1
, bt type1
, int kind1
, int optional1
)
406 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
407 a1
, type1
, kind1
, optional1
, INTENT_IN
,
412 /* Add a symbol to the subroutine list where the subroutine takes
416 add_sym_1s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
, int standard
,
417 gfc_try (*check
) (gfc_expr
*),
418 gfc_expr
*(*simplify
) (gfc_expr
*),
419 void (*resolve
) (gfc_code
*),
420 const char *a1
, bt type1
, int kind1
, int optional1
)
430 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
431 a1
, type1
, kind1
, optional1
, INTENT_IN
,
436 /* Add a symbol to the function list where the function takes
437 1 arguments, specifying the intent of the argument. */
440 add_sym_1_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
441 int actual_ok
, bt type
, int kind
, int standard
,
442 gfc_try (*check
) (gfc_expr
*),
443 gfc_expr
*(*simplify
) (gfc_expr
*),
444 void (*resolve
) (gfc_expr
*, gfc_expr
*),
445 const char *a1
, bt type1
, int kind1
, int optional1
,
456 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
457 a1
, type1
, kind1
, optional1
, intent1
,
462 /* Add a symbol to the subroutine list where the subroutine takes
463 1 arguments, specifying the intent of the argument. */
466 add_sym_1s_intent (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
467 int kind
, int standard
,
468 gfc_try (*check
) (gfc_expr
*),
469 gfc_expr
*(*simplify
) (gfc_expr
*),
470 void (*resolve
) (gfc_code
*),
471 const char *a1
, bt type1
, int kind1
, int optional1
,
482 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
483 a1
, type1
, kind1
, optional1
, intent1
,
488 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
489 function. MAX et al take 2 or more arguments. */
492 add_sym_1m (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
493 int kind
, int standard
,
494 gfc_try (*check
) (gfc_actual_arglist
*),
495 gfc_expr
*(*simplify
) (gfc_expr
*),
496 void (*resolve
) (gfc_expr
*, gfc_actual_arglist
*),
497 const char *a1
, bt type1
, int kind1
, int optional1
,
498 const char *a2
, bt type2
, int kind2
, int optional2
)
508 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
509 a1
, type1
, kind1
, optional1
, INTENT_IN
,
510 a2
, type2
, kind2
, optional2
, INTENT_IN
,
515 /* Add a symbol to the function list where the function takes
519 add_sym_2 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
520 int kind
, int standard
,
521 gfc_try (*check
) (gfc_expr
*, gfc_expr
*),
522 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
523 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
524 const char *a1
, bt type1
, int kind1
, int optional1
,
525 const char *a2
, bt type2
, int kind2
, int optional2
)
535 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
536 a1
, type1
, kind1
, optional1
, INTENT_IN
,
537 a2
, type2
, kind2
, optional2
, INTENT_IN
,
542 /* Add a symbol to the subroutine list where the subroutine takes
546 add_sym_2s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
, int standard
,
547 gfc_try (*check
) (gfc_expr
*, gfc_expr
*),
548 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
549 void (*resolve
) (gfc_code
*),
550 const char *a1
, bt type1
, int kind1
, int optional1
,
551 const char *a2
, bt type2
, int kind2
, int optional2
)
561 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
562 a1
, type1
, kind1
, optional1
, INTENT_IN
,
563 a2
, type2
, kind2
, optional2
, INTENT_IN
,
568 /* Add a symbol to the subroutine list where the subroutine takes
569 2 arguments, specifying the intent of the arguments. */
572 add_sym_2s_intent (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
573 int kind
, int standard
,
574 gfc_try (*check
) (gfc_expr
*, gfc_expr
*),
575 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
576 void (*resolve
) (gfc_code
*),
577 const char *a1
, bt type1
, int kind1
, int optional1
,
578 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
579 int optional2
, sym_intent intent2
)
589 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
590 a1
, type1
, kind1
, optional1
, intent1
,
591 a2
, type2
, kind2
, optional2
, intent2
,
596 /* Add a symbol to the function list where the function takes
600 add_sym_3 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
601 int kind
, int standard
,
602 gfc_try (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
603 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
604 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
605 const char *a1
, bt type1
, int kind1
, int optional1
,
606 const char *a2
, bt type2
, int kind2
, int optional2
,
607 const char *a3
, bt type3
, int kind3
, int optional3
)
617 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
618 a1
, type1
, kind1
, optional1
, INTENT_IN
,
619 a2
, type2
, kind2
, optional2
, INTENT_IN
,
620 a3
, type3
, kind3
, optional3
, INTENT_IN
,
625 /* MINLOC and MAXLOC get special treatment because their argument
626 might have to be reordered. */
629 add_sym_3ml (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
630 int kind
, int standard
,
631 gfc_try (*check
) (gfc_actual_arglist
*),
632 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
633 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
634 const char *a1
, bt type1
, int kind1
, int optional1
,
635 const char *a2
, bt type2
, int kind2
, int optional2
,
636 const char *a3
, bt type3
, int kind3
, int optional3
)
646 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
647 a1
, type1
, kind1
, optional1
, INTENT_IN
,
648 a2
, type2
, kind2
, optional2
, INTENT_IN
,
649 a3
, type3
, kind3
, optional3
, INTENT_IN
,
654 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
655 their argument also might have to be reordered. */
658 add_sym_3red (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
659 int kind
, int standard
,
660 gfc_try (*check
) (gfc_actual_arglist
*),
661 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
662 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
663 const char *a1
, bt type1
, int kind1
, int optional1
,
664 const char *a2
, bt type2
, int kind2
, int optional2
,
665 const char *a3
, bt type3
, int kind3
, int optional3
)
675 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
676 a1
, type1
, kind1
, optional1
, INTENT_IN
,
677 a2
, type2
, kind2
, optional2
, INTENT_IN
,
678 a3
, type3
, kind3
, optional3
, INTENT_IN
,
683 /* Add a symbol to the subroutine list where the subroutine takes
687 add_sym_3s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
, int standard
,
688 gfc_try (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
689 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
690 void (*resolve
) (gfc_code
*),
691 const char *a1
, bt type1
, int kind1
, int optional1
,
692 const char *a2
, bt type2
, int kind2
, int optional2
,
693 const char *a3
, bt type3
, int kind3
, int optional3
)
703 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
704 a1
, type1
, kind1
, optional1
, INTENT_IN
,
705 a2
, type2
, kind2
, optional2
, INTENT_IN
,
706 a3
, type3
, kind3
, optional3
, INTENT_IN
,
711 /* Add a symbol to the subroutine list where the subroutine takes
712 3 arguments, specifying the intent of the arguments. */
715 add_sym_3s_intent (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
716 int kind
, int standard
,
717 gfc_try (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
718 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
719 void (*resolve
) (gfc_code
*),
720 const char *a1
, bt type1
, int kind1
, int optional1
,
721 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
722 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
723 int kind3
, int optional3
, sym_intent intent3
)
733 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
734 a1
, type1
, kind1
, optional1
, intent1
,
735 a2
, type2
, kind2
, optional2
, intent2
,
736 a3
, type3
, kind3
, optional3
, intent3
,
741 /* Add a symbol to the function list where the function takes
745 add_sym_4 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
746 int kind
, int standard
,
747 gfc_try (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
748 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
750 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
752 const char *a1
, bt type1
, int kind1
, int optional1
,
753 const char *a2
, bt type2
, int kind2
, int optional2
,
754 const char *a3
, bt type3
, int kind3
, int optional3
,
755 const char *a4
, bt type4
, int kind4
, int optional4
)
765 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
766 a1
, type1
, kind1
, optional1
, INTENT_IN
,
767 a2
, type2
, kind2
, optional2
, INTENT_IN
,
768 a3
, type3
, kind3
, optional3
, INTENT_IN
,
769 a4
, type4
, kind4
, optional4
, INTENT_IN
,
774 /* Add a symbol to the subroutine list where the subroutine takes
778 add_sym_4s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
780 gfc_try (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
781 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
783 void (*resolve
) (gfc_code
*),
784 const char *a1
, bt type1
, int kind1
, int optional1
,
785 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
786 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
787 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
788 bt type4
, int kind4
, int optional4
, sym_intent intent4
)
798 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
799 a1
, type1
, kind1
, optional1
, intent1
,
800 a2
, type2
, kind2
, optional2
, intent2
,
801 a3
, type3
, kind3
, optional3
, intent3
,
802 a4
, type4
, kind4
, optional4
, intent4
,
807 /* Add a symbol to the subroutine list where the subroutine takes
811 add_sym_5s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
813 gfc_try (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
815 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
816 gfc_expr
*, gfc_expr
*),
817 void (*resolve
) (gfc_code
*),
818 const char *a1
, bt type1
, int kind1
, int optional1
,
819 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
820 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
821 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
822 bt type4
, int kind4
, int optional4
, sym_intent intent4
,
823 const char *a5
, bt type5
, int kind5
, int optional5
,
834 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
835 a1
, type1
, kind1
, optional1
, intent1
,
836 a2
, type2
, kind2
, optional2
, intent2
,
837 a3
, type3
, kind3
, optional3
, intent3
,
838 a4
, type4
, kind4
, optional4
, intent4
,
839 a5
, type5
, kind5
, optional5
, intent5
,
844 /* Locate an intrinsic symbol given a base pointer, number of elements
845 in the table and a pointer to a name. Returns the NULL pointer if
846 a name is not found. */
848 static gfc_intrinsic_sym
*
849 find_sym (gfc_intrinsic_sym
*start
, int n
, const char *name
)
851 /* name may be a user-supplied string, so we must first make sure
852 that we're comparing against a pointer into the global string
854 const char *p
= gfc_get_string (name
);
858 if (p
== start
->name
)
869 /* Given a name, find a function in the intrinsic function table.
870 Returns NULL if not found. */
873 gfc_find_function (const char *name
)
875 gfc_intrinsic_sym
*sym
;
877 sym
= find_sym (functions
, nfunc
, name
);
879 sym
= find_sym (conversion
, nconv
, name
);
885 /* Given a name, find a function in the intrinsic subroutine table.
886 Returns NULL if not found. */
889 gfc_find_subroutine (const char *name
)
891 return find_sym (subroutines
, nsub
, name
);
895 /* Given a string, figure out if it is the name of a generic intrinsic
899 gfc_generic_intrinsic (const char *name
)
901 gfc_intrinsic_sym
*sym
;
903 sym
= gfc_find_function (name
);
904 return (sym
== NULL
) ? 0 : sym
->generic
;
908 /* Given a string, figure out if it is the name of a specific
909 intrinsic function or not. */
912 gfc_specific_intrinsic (const char *name
)
914 gfc_intrinsic_sym
*sym
;
916 sym
= gfc_find_function (name
);
917 return (sym
== NULL
) ? 0 : sym
->specific
;
921 /* Given a string, figure out if it is the name of an intrinsic function
922 or subroutine allowed as an actual argument or not. */
924 gfc_intrinsic_actual_ok (const char *name
, const bool subroutine_flag
)
926 gfc_intrinsic_sym
*sym
;
928 /* Intrinsic subroutines are not allowed as actual arguments. */
933 sym
= gfc_find_function (name
);
934 return (sym
== NULL
) ? 0 : sym
->actual_ok
;
939 /* Given a symbol, find out if it is (and is to be treated) an intrinsic. If
940 it's name refers to an intrinsic but this intrinsic is not included in the
941 selected standard, this returns FALSE and sets the symbol's external
945 gfc_is_intrinsic (gfc_symbol
* sym
, int subroutine_flag
, locus loc
)
947 gfc_intrinsic_sym
* isym
;
950 /* If INTRINSIC/EXTERNAL state is already known, return. */
951 if (sym
->attr
.intrinsic
)
953 if (sym
->attr
.external
)
957 isym
= gfc_find_subroutine (sym
->name
);
959 isym
= gfc_find_function (sym
->name
);
961 /* No such intrinsic available at all? */
965 /* See if this intrinsic is allowed in the current standard. */
966 if (gfc_check_intrinsic_standard (isym
, &symstd
, false, loc
) == FAILURE
)
968 if (sym
->attr
.proc
== PROC_UNKNOWN
969 && gfc_option
.warn_intrinsics_std
)
970 gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
971 " selected standard but %s and '%s' will be"
972 " treated as if declared EXTERNAL. Use an"
973 " appropriate -std=* option or define"
974 " -fall-intrinsics to allow this intrinsic.",
975 sym
->name
, &loc
, symstd
, sym
->name
);
984 /* Collect a set of intrinsic functions into a generic collection.
985 The first argument is the name of the generic function, which is
986 also the name of a specific function. The rest of the specifics
987 currently in the table are placed into the list of specific
988 functions associated with that generic.
991 FIXME: Remove the argument STANDARD if no regressions are
992 encountered. Change all callers (approx. 360).
996 make_generic (const char *name
, gfc_isym_id id
, int standard ATTRIBUTE_UNUSED
)
998 gfc_intrinsic_sym
*g
;
1000 if (sizing
!= SZ_NOTHING
)
1003 g
= gfc_find_function (name
);
1005 gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
1008 gcc_assert (g
->id
== id
);
1012 if ((g
+ 1)->name
!= NULL
)
1013 g
->specific_head
= g
+ 1;
1016 while (g
->name
!= NULL
)
1028 /* Create a duplicate intrinsic function entry for the current
1029 function, the only differences being the alternate name and
1030 a different standard if necessary. Note that we use argument
1031 lists more than once, but all argument lists are freed as a
1035 make_alias (const char *name
, int standard
)
1048 next_sym
[0] = next_sym
[-1];
1049 next_sym
->name
= gfc_get_string (name
);
1050 next_sym
->standard
= standard
;
1060 /* Make the current subroutine noreturn. */
1063 make_noreturn (void)
1065 if (sizing
== SZ_NOTHING
)
1066 next_sym
[-1].noreturn
= 1;
1069 /* Set the attr.value of the current procedure. */
1072 set_attr_value (int n
, ...)
1074 gfc_intrinsic_arg
*arg
;
1078 if (sizing
!= SZ_NOTHING
)
1082 arg
= next_sym
[-1].formal
;
1084 for (i
= 0; i
< n
; i
++)
1086 gcc_assert (arg
!= NULL
);
1087 arg
->value
= va_arg (argp
, int);
1094 /* Add intrinsic functions. */
1097 add_functions (void)
1099 /* Argument names as in the standard (to be used as argument keywords). */
1101 *a
= "a", *f
= "field", *pt
= "pointer", *tg
= "target",
1102 *b
= "b", *m
= "matrix", *ma
= "matrix_a", *mb
= "matrix_b",
1103 *c
= "c", *n
= "n", *ncopies
= "ncopies", *pos
= "pos", *bck
= "back",
1104 *i
= "i", *v
= "vector", *va
= "vector_a", *vb
= "vector_b",
1105 *j
= "j", *a1
= "a1", *fs
= "fsource", *ts
= "tsource",
1106 *l
= "l", *a2
= "a2", *mo
= "mold", *ord
= "order",
1107 *p
= "p", *ar
= "array", *shp
= "shape", *src
= "source",
1108 *r
= "r", *bd
= "boundary", *pad
= "pad", *set
= "set",
1109 *s
= "s", *dm
= "dim", *kind
= "kind", *msk
= "mask",
1110 *x
= "x", *sh
= "shift", *stg
= "string", *ssg
= "substring",
1111 *y
= "y", *sz
= "size", *sta
= "string_a", *stb
= "string_b",
1112 *z
= "z", *ln
= "len", *ut
= "unit", *han
= "handler",
1113 *num
= "number", *tm
= "time", *nm
= "name", *md
= "mode",
1114 *vl
= "values", *p1
= "path1", *p2
= "path2", *com
= "command",
1115 *ca
= "coarray", *sub
= "sub";
1117 int di
, dr
, dd
, dl
, dc
, dz
, ii
;
1119 di
= gfc_default_integer_kind
;
1120 dr
= gfc_default_real_kind
;
1121 dd
= gfc_default_double_kind
;
1122 dl
= gfc_default_logical_kind
;
1123 dc
= gfc_default_character_kind
;
1124 dz
= gfc_default_complex_kind
;
1125 ii
= gfc_index_integer_kind
;
1127 add_sym_1 ("abs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1128 gfc_check_abs
, gfc_simplify_abs
, gfc_resolve_abs
,
1129 a
, BT_REAL
, dr
, REQUIRED
);
1131 add_sym_1 ("iabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1132 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1133 a
, BT_INTEGER
, di
, REQUIRED
);
1135 add_sym_1 ("dabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1136 gfc_check_fn_d
, gfc_simplify_abs
, gfc_resolve_abs
,
1137 a
, BT_REAL
, dd
, REQUIRED
);
1139 add_sym_1 ("cabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1140 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1141 a
, BT_COMPLEX
, dz
, REQUIRED
);
1143 add_sym_1 ("zabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1144 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1145 a
, BT_COMPLEX
, dd
, REQUIRED
);
1147 make_alias ("cdabs", GFC_STD_GNU
);
1149 make_generic ("abs", GFC_ISYM_ABS
, GFC_STD_F77
);
1151 /* The checking function for ACCESS is called gfc_check_access_func
1152 because the name gfc_check_access is already used in module.c. */
1153 add_sym_2 ("access", GFC_ISYM_ACCESS
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1154 di
, GFC_STD_GNU
, gfc_check_access_func
, NULL
, gfc_resolve_access
,
1155 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1157 make_generic ("access", GFC_ISYM_ACCESS
, GFC_STD_GNU
);
1159 add_sym_2 ("achar", GFC_ISYM_ACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1160 BT_CHARACTER
, dc
, GFC_STD_F95
,
1161 gfc_check_achar
, gfc_simplify_achar
, gfc_resolve_achar
,
1162 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1164 make_generic ("achar", GFC_ISYM_ACHAR
, GFC_STD_F95
);
1166 add_sym_1 ("acos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1167 gfc_check_fn_rc2008
, gfc_simplify_acos
, gfc_resolve_acos
,
1168 x
, BT_REAL
, dr
, REQUIRED
);
1170 add_sym_1 ("dacos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1171 gfc_check_fn_d
, gfc_simplify_acos
, gfc_resolve_acos
,
1172 x
, BT_REAL
, dd
, REQUIRED
);
1174 make_generic ("acos", GFC_ISYM_ACOS
, GFC_STD_F77
);
1176 add_sym_1 ("acosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1177 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_acosh
,
1178 gfc_resolve_acosh
, x
, BT_REAL
, dr
, REQUIRED
);
1180 add_sym_1 ("dacosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1181 gfc_check_fn_d
, gfc_simplify_acosh
, gfc_resolve_acosh
,
1182 x
, BT_REAL
, dd
, REQUIRED
);
1184 make_generic ("acosh", GFC_ISYM_ACOSH
, GFC_STD_F2008
);
1186 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1187 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustl
,
1188 gfc_resolve_adjustl
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1190 make_generic ("adjustl", GFC_ISYM_ADJUSTL
, GFC_STD_F95
);
1192 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1193 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustr
,
1194 gfc_resolve_adjustr
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1196 make_generic ("adjustr", GFC_ISYM_ADJUSTR
, GFC_STD_F95
);
1198 add_sym_1 ("aimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1199 gfc_check_fn_c
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1200 z
, BT_COMPLEX
, dz
, REQUIRED
);
1202 make_alias ("imag", GFC_STD_GNU
);
1203 make_alias ("imagpart", GFC_STD_GNU
);
1205 add_sym_1 ("dimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1206 NULL
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1207 z
, BT_COMPLEX
, dd
, REQUIRED
);
1209 make_generic ("aimag", GFC_ISYM_AIMAG
, GFC_STD_F77
);
1211 add_sym_2 ("aint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1212 gfc_check_a_xkind
, gfc_simplify_aint
, gfc_resolve_aint
,
1213 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1215 add_sym_1 ("dint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1216 NULL
, gfc_simplify_dint
, gfc_resolve_dint
,
1217 a
, BT_REAL
, dd
, REQUIRED
);
1219 make_generic ("aint", GFC_ISYM_AINT
, GFC_STD_F77
);
1221 add_sym_2 ("all", GFC_ISYM_ALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1222 gfc_check_all_any
, gfc_simplify_all
, gfc_resolve_all
,
1223 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1225 make_generic ("all", GFC_ISYM_ALL
, GFC_STD_F95
);
1227 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1228 gfc_check_allocated
, NULL
, NULL
,
1229 ar
, BT_UNKNOWN
, 0, REQUIRED
);
1231 make_generic ("allocated", GFC_ISYM_ALLOCATED
, GFC_STD_F95
);
1233 add_sym_2 ("anint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1234 gfc_check_a_xkind
, gfc_simplify_anint
, gfc_resolve_anint
,
1235 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1237 add_sym_1 ("dnint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1238 NULL
, gfc_simplify_dnint
, gfc_resolve_dnint
,
1239 a
, BT_REAL
, dd
, REQUIRED
);
1241 make_generic ("anint", GFC_ISYM_ANINT
, GFC_STD_F77
);
1243 add_sym_2 ("any", GFC_ISYM_ANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1244 gfc_check_all_any
, gfc_simplify_any
, gfc_resolve_any
,
1245 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1247 make_generic ("any", GFC_ISYM_ANY
, GFC_STD_F95
);
1249 add_sym_1 ("asin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1250 gfc_check_fn_rc2008
, gfc_simplify_asin
, gfc_resolve_asin
,
1251 x
, BT_REAL
, dr
, REQUIRED
);
1253 add_sym_1 ("dasin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1254 gfc_check_fn_d
, gfc_simplify_asin
, gfc_resolve_asin
,
1255 x
, BT_REAL
, dd
, REQUIRED
);
1257 make_generic ("asin", GFC_ISYM_ASIN
, GFC_STD_F77
);
1259 add_sym_1 ("asinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1260 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_asinh
,
1261 gfc_resolve_asinh
, x
, BT_REAL
, dr
, REQUIRED
);
1263 add_sym_1 ("dasinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1264 gfc_check_fn_d
, gfc_simplify_asinh
, gfc_resolve_asinh
,
1265 x
, BT_REAL
, dd
, REQUIRED
);
1267 make_generic ("asinh", GFC_ISYM_ASINH
, GFC_STD_F2008
);
1269 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
,
1270 GFC_STD_F95
, gfc_check_associated
, NULL
, NULL
,
1271 pt
, BT_UNKNOWN
, 0, REQUIRED
, tg
, BT_UNKNOWN
, 0, OPTIONAL
);
1273 make_generic ("associated", GFC_ISYM_ASSOCIATED
, GFC_STD_F95
);
1275 add_sym_1 ("atan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1276 gfc_check_fn_rc2008
, gfc_simplify_atan
, gfc_resolve_atan
,
1277 x
, BT_REAL
, dr
, REQUIRED
);
1279 add_sym_1 ("datan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1280 gfc_check_fn_d
, gfc_simplify_atan
, gfc_resolve_atan
,
1281 x
, BT_REAL
, dd
, REQUIRED
);
1283 /* Two-argument version of atan, equivalent to atan2. */
1284 add_sym_2 ("atan", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F2008
,
1285 gfc_check_atan_2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1286 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1288 make_generic ("atan", GFC_ISYM_ATAN
, GFC_STD_F77
);
1290 add_sym_1 ("atanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1291 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_atanh
,
1292 gfc_resolve_atanh
, x
, BT_REAL
, dr
, REQUIRED
);
1294 add_sym_1 ("datanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1295 gfc_check_fn_d
, gfc_simplify_atanh
, gfc_resolve_atanh
,
1296 x
, BT_REAL
, dd
, REQUIRED
);
1298 make_generic ("atanh", GFC_ISYM_ATANH
, GFC_STD_F2008
);
1300 add_sym_2 ("atan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1301 gfc_check_atan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1302 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1304 add_sym_2 ("datan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1305 gfc_check_datan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1306 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1308 make_generic ("atan2", GFC_ISYM_ATAN2
, GFC_STD_F77
);
1310 /* Bessel and Neumann functions for G77 compatibility. */
1311 add_sym_1 ("besj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1312 gfc_check_fn_r
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1313 x
, BT_REAL
, dr
, REQUIRED
);
1315 make_alias ("bessel_j0", GFC_STD_F2008
);
1317 add_sym_1 ("dbesj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1318 gfc_check_fn_d
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1319 x
, BT_REAL
, dd
, REQUIRED
);
1321 make_generic ("bessel_j0", GFC_ISYM_J0
, GFC_STD_F2008
);
1323 add_sym_1 ("besj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1324 gfc_check_fn_r
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1325 x
, BT_REAL
, dr
, REQUIRED
);
1327 make_alias ("bessel_j1", GFC_STD_F2008
);
1329 add_sym_1 ("dbesj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1330 gfc_check_fn_d
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1331 x
, BT_REAL
, dd
, REQUIRED
);
1333 make_generic ("bessel_j1", GFC_ISYM_J1
, GFC_STD_F2008
);
1335 add_sym_2 ("besjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1336 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1337 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1339 make_alias ("bessel_jn", GFC_STD_F2008
);
1341 add_sym_2 ("dbesjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1342 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1343 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1345 add_sym_3 ("bessel_jn", GFC_ISYM_JN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1346 gfc_check_bessel_n2
, gfc_simplify_bessel_jn2
, gfc_resolve_bessel_n2
,
1347 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1348 x
, BT_REAL
, dr
, REQUIRED
);
1349 set_attr_value (3, true, true, true);
1351 make_generic ("bessel_jn", GFC_ISYM_JN
, GFC_STD_F2008
);
1353 add_sym_1 ("besy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1354 gfc_check_fn_r
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1355 x
, BT_REAL
, dr
, REQUIRED
);
1357 make_alias ("bessel_y0", GFC_STD_F2008
);
1359 add_sym_1 ("dbesy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1360 gfc_check_fn_d
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1361 x
, BT_REAL
, dd
, REQUIRED
);
1363 make_generic ("bessel_y0", GFC_ISYM_Y0
, GFC_STD_F2008
);
1365 add_sym_1 ("besy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1366 gfc_check_fn_r
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1367 x
, BT_REAL
, dr
, REQUIRED
);
1369 make_alias ("bessel_y1", GFC_STD_F2008
);
1371 add_sym_1 ("dbesy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1372 gfc_check_fn_d
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1373 x
, BT_REAL
, dd
, REQUIRED
);
1375 make_generic ("bessel_y1", GFC_ISYM_Y1
, GFC_STD_F2008
);
1377 add_sym_2 ("besyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1378 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1379 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1381 make_alias ("bessel_yn", GFC_STD_F2008
);
1383 add_sym_2 ("dbesyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1384 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1385 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1387 add_sym_3 ("bessel_yn", GFC_ISYM_YN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1388 gfc_check_bessel_n2
, gfc_simplify_bessel_yn2
, gfc_resolve_bessel_n2
,
1389 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1390 x
, BT_REAL
, dr
, REQUIRED
);
1391 set_attr_value (3, true, true, true);
1393 make_generic ("bessel_yn", GFC_ISYM_YN
, GFC_STD_F2008
);
1395 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1396 gfc_check_i
, gfc_simplify_bit_size
, NULL
,
1397 i
, BT_INTEGER
, di
, REQUIRED
);
1399 make_generic ("bit_size", GFC_ISYM_BIT_SIZE
, GFC_STD_F95
);
1401 add_sym_2 ("btest", GFC_ISYM_BTEST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1402 gfc_check_bitfcn
, gfc_simplify_btest
, gfc_resolve_btest
,
1403 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1405 make_generic ("btest", GFC_ISYM_BTEST
, GFC_STD_F95
);
1407 add_sym_2 ("ceiling", GFC_ISYM_CEILING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1408 gfc_check_a_ikind
, gfc_simplify_ceiling
, gfc_resolve_ceiling
,
1409 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1411 make_generic ("ceiling", GFC_ISYM_CEILING
, GFC_STD_F95
);
1413 add_sym_2 ("char", GFC_ISYM_CHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F77
,
1414 gfc_check_char
, gfc_simplify_char
, gfc_resolve_char
,
1415 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1417 make_generic ("char", GFC_ISYM_CHAR
, GFC_STD_F77
);
1419 add_sym_1 ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
1420 GFC_STD_GNU
, gfc_check_chdir
, NULL
, gfc_resolve_chdir
,
1421 nm
, BT_CHARACTER
, dc
, REQUIRED
);
1423 make_generic ("chdir", GFC_ISYM_CHDIR
, GFC_STD_GNU
);
1425 add_sym_2 ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1426 di
, GFC_STD_GNU
, gfc_check_chmod
, NULL
, gfc_resolve_chmod
,
1427 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1429 make_generic ("chmod", GFC_ISYM_CHMOD
, GFC_STD_GNU
);
1431 add_sym_3 ("cmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1432 gfc_check_cmplx
, gfc_simplify_cmplx
, gfc_resolve_cmplx
,
1433 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, OPTIONAL
,
1434 kind
, BT_INTEGER
, di
, OPTIONAL
);
1436 make_generic ("cmplx", GFC_ISYM_CMPLX
, GFC_STD_F77
);
1438 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
, CLASS_INQUIRY
,
1439 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
, NULL
, NULL
, NULL
);
1441 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
,
1444 add_sym_2 ("complex", GFC_ISYM_COMPLEX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_GNU
,
1445 gfc_check_complex
, gfc_simplify_complex
, gfc_resolve_complex
,
1446 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, REQUIRED
);
1448 make_generic ("complex", GFC_ISYM_COMPLEX
, GFC_STD_GNU
);
1450 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1451 complex instead of the default complex. */
1453 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1454 gfc_check_dcmplx
, gfc_simplify_dcmplx
, gfc_resolve_dcmplx
,
1455 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, OPTIONAL
);
1457 make_generic ("dcmplx", GFC_ISYM_CMPLX
, GFC_STD_GNU
);
1459 add_sym_1 ("conjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1460 gfc_check_fn_c
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1461 z
, BT_COMPLEX
, dz
, REQUIRED
);
1463 add_sym_1 ("dconjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1464 NULL
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1465 z
, BT_COMPLEX
, dd
, REQUIRED
);
1467 make_generic ("conjg", GFC_ISYM_CONJG
, GFC_STD_F77
);
1469 add_sym_1 ("cos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1470 gfc_check_fn_rc
, gfc_simplify_cos
, gfc_resolve_cos
,
1471 x
, BT_REAL
, dr
, REQUIRED
);
1473 add_sym_1 ("dcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1474 gfc_check_fn_d
, gfc_simplify_cos
, gfc_resolve_cos
,
1475 x
, BT_REAL
, dd
, REQUIRED
);
1477 add_sym_1 ("ccos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1478 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1479 x
, BT_COMPLEX
, dz
, REQUIRED
);
1481 add_sym_1 ("zcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1482 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1483 x
, BT_COMPLEX
, dd
, REQUIRED
);
1485 make_alias ("cdcos", GFC_STD_GNU
);
1487 make_generic ("cos", GFC_ISYM_COS
, GFC_STD_F77
);
1489 add_sym_1 ("cosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1490 gfc_check_fn_rc2008
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1491 x
, BT_REAL
, dr
, REQUIRED
);
1493 add_sym_1 ("dcosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1494 gfc_check_fn_d
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1495 x
, BT_REAL
, dd
, REQUIRED
);
1497 make_generic ("cosh", GFC_ISYM_COSH
, GFC_STD_F77
);
1499 add_sym_3 ("count", GFC_ISYM_COUNT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1500 BT_INTEGER
, di
, GFC_STD_F95
,
1501 gfc_check_count
, gfc_simplify_count
, gfc_resolve_count
,
1502 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1503 kind
, BT_INTEGER
, di
, OPTIONAL
);
1505 make_generic ("count", GFC_ISYM_COUNT
, GFC_STD_F95
);
1507 add_sym_3 ("cshift", GFC_ISYM_CSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1508 gfc_check_cshift
, NULL
, gfc_resolve_cshift
,
1509 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
1510 dm
, BT_INTEGER
, ii
, OPTIONAL
);
1512 make_generic ("cshift", GFC_ISYM_CSHIFT
, GFC_STD_F95
);
1514 add_sym_1 ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1515 0, GFC_STD_GNU
, gfc_check_ctime
, NULL
, gfc_resolve_ctime
,
1516 tm
, BT_INTEGER
, di
, REQUIRED
);
1518 make_generic ("ctime", GFC_ISYM_CTIME
, GFC_STD_GNU
);
1520 add_sym_1 ("dble", GFC_ISYM_DBLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
1521 gfc_check_dble
, gfc_simplify_dble
, gfc_resolve_dble
,
1522 a
, BT_REAL
, dr
, REQUIRED
);
1524 make_generic ("dble", GFC_ISYM_DBLE
, GFC_STD_F77
);
1526 add_sym_1 ("digits", GFC_ISYM_DIGITS
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1527 gfc_check_digits
, gfc_simplify_digits
, NULL
,
1528 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1530 make_generic ("digits", GFC_ISYM_DIGITS
, GFC_STD_F95
);
1532 add_sym_2 ("dim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1533 gfc_check_a_p
, gfc_simplify_dim
, gfc_resolve_dim
,
1534 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1536 add_sym_2 ("idim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1537 NULL
, gfc_simplify_dim
, gfc_resolve_dim
,
1538 x
, BT_INTEGER
, di
, REQUIRED
, y
, BT_INTEGER
, di
, REQUIRED
);
1540 add_sym_2 ("ddim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1541 gfc_check_x_yd
, gfc_simplify_dim
, gfc_resolve_dim
,
1542 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, REQUIRED
);
1544 make_generic ("dim", GFC_ISYM_DIM
, GFC_STD_F77
);
1546 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
1547 GFC_STD_F95
, gfc_check_dot_product
, gfc_simplify_dot_product
, gfc_resolve_dot_product
,
1548 va
, BT_REAL
, dr
, REQUIRED
, vb
, BT_REAL
, dr
, REQUIRED
);
1550 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT
, GFC_STD_F95
);
1552 add_sym_2 ("dprod", GFC_ISYM_DPROD
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1553 gfc_check_dprod
, gfc_simplify_dprod
, gfc_resolve_dprod
,
1554 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1556 make_generic ("dprod", GFC_ISYM_DPROD
, GFC_STD_F77
);
1558 add_sym_1 ("dreal", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1560 a
, BT_COMPLEX
, dd
, REQUIRED
);
1562 make_generic ("dreal", GFC_ISYM_REAL
, GFC_STD_GNU
);
1564 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1565 gfc_check_eoshift
, NULL
, gfc_resolve_eoshift
,
1566 ar
, BT_REAL
, dr
, 0, sh
, BT_INTEGER
, ii
, REQUIRED
,
1567 bd
, BT_REAL
, dr
, 1, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1569 make_generic ("eoshift", GFC_ISYM_EOSHIFT
, GFC_STD_F95
);
1571 add_sym_1 ("epsilon", GFC_ISYM_EPSILON
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1572 gfc_check_x
, gfc_simplify_epsilon
, NULL
,
1573 x
, BT_REAL
, dr
, REQUIRED
);
1575 make_generic ("epsilon", GFC_ISYM_EPSILON
, GFC_STD_F95
);
1577 /* G77 compatibility for the ERF() and ERFC() functions. */
1578 add_sym_1 ("erf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1579 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erf
,
1580 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1582 add_sym_1 ("derf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1583 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erf
,
1584 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1586 make_generic ("erf", GFC_ISYM_ERF
, GFC_STD_F2008
);
1588 add_sym_1 ("erfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1589 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erfc
,
1590 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1592 add_sym_1 ("derfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1593 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erfc
,
1594 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1596 make_generic ("erfc", GFC_ISYM_ERFC
, GFC_STD_F2008
);
1598 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1599 BT_REAL
, dr
, GFC_STD_F2008
, gfc_check_fn_r
,
1600 gfc_simplify_erfc_scaled
, gfc_resolve_g77_math1
, x
, BT_REAL
,
1603 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, GFC_STD_F2008
);
1605 /* G77 compatibility */
1606 add_sym_1 ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1607 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1608 x
, BT_REAL
, 4, REQUIRED
);
1610 make_generic ("dtime", GFC_ISYM_DTIME
, GFC_STD_GNU
);
1612 add_sym_1 ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1613 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1614 x
, BT_REAL
, 4, REQUIRED
);
1616 make_generic ("etime", GFC_ISYM_ETIME
, GFC_STD_GNU
);
1618 add_sym_1 ("exp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1619 gfc_check_fn_rc
, gfc_simplify_exp
, gfc_resolve_exp
,
1620 x
, BT_REAL
, dr
, REQUIRED
);
1622 add_sym_1 ("dexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1623 gfc_check_fn_d
, gfc_simplify_exp
, gfc_resolve_exp
,
1624 x
, BT_REAL
, dd
, REQUIRED
);
1626 add_sym_1 ("cexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1627 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1628 x
, BT_COMPLEX
, dz
, REQUIRED
);
1630 add_sym_1 ("zexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1631 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1632 x
, BT_COMPLEX
, dd
, REQUIRED
);
1634 make_alias ("cdexp", GFC_STD_GNU
);
1636 make_generic ("exp", GFC_ISYM_EXP
, GFC_STD_F77
);
1638 add_sym_1 ("exponent", GFC_ISYM_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1639 gfc_check_x
, gfc_simplify_exponent
, gfc_resolve_exponent
,
1640 x
, BT_REAL
, dr
, REQUIRED
);
1642 make_generic ("exponent", GFC_ISYM_EXPONENT
, GFC_STD_F95
);
1644 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF
, CLASS_INQUIRY
,
1645 ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1646 gfc_check_same_type_as
, NULL
, gfc_resolve_extends_type_of
,
1647 a
, BT_UNKNOWN
, 0, REQUIRED
,
1648 mo
, BT_UNKNOWN
, 0, REQUIRED
);
1650 add_sym_0 ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1651 dc
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_fdate
);
1653 make_generic ("fdate", GFC_ISYM_FDATE
, GFC_STD_GNU
);
1655 add_sym_2 ("floor", GFC_ISYM_FLOOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1656 gfc_check_a_ikind
, gfc_simplify_floor
, gfc_resolve_floor
,
1657 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1659 make_generic ("floor", GFC_ISYM_FLOOR
, GFC_STD_F95
);
1661 /* G77 compatible fnum */
1662 add_sym_1 ("fnum", GFC_ISYM_FNUM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1663 di
, GFC_STD_GNU
, gfc_check_fnum
, NULL
, gfc_resolve_fnum
,
1664 ut
, BT_INTEGER
, di
, REQUIRED
);
1666 make_generic ("fnum", GFC_ISYM_FNUM
, GFC_STD_GNU
);
1668 add_sym_1 ("fraction", GFC_ISYM_FRACTION
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1669 gfc_check_x
, gfc_simplify_fraction
, gfc_resolve_fraction
,
1670 x
, BT_REAL
, dr
, REQUIRED
);
1672 make_generic ("fraction", GFC_ISYM_FRACTION
, GFC_STD_F95
);
1674 add_sym_2 ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
1675 GFC_STD_GNU
, gfc_check_fstat
, NULL
, gfc_resolve_fstat
,
1676 ut
, BT_INTEGER
, di
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
);
1678 make_generic ("fstat", GFC_ISYM_FSTAT
, GFC_STD_GNU
);
1680 add_sym_1 ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1681 ii
, GFC_STD_GNU
, gfc_check_ftell
, NULL
, gfc_resolve_ftell
,
1682 ut
, BT_INTEGER
, di
, REQUIRED
);
1684 make_generic ("ftell", GFC_ISYM_FTELL
, GFC_STD_GNU
);
1686 add_sym_2 ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1687 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fgetc
,
1688 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
1690 make_generic ("fgetc", GFC_ISYM_FGETC
, GFC_STD_GNU
);
1692 add_sym_1 ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1693 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fget
,
1694 c
, BT_CHARACTER
, dc
, REQUIRED
);
1696 make_generic ("fget", GFC_ISYM_FGET
, GFC_STD_GNU
);
1698 add_sym_2 ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1699 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fputc
,
1700 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
1702 make_generic ("fputc", GFC_ISYM_FPUTC
, GFC_STD_GNU
);
1704 add_sym_1 ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1705 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fput
,
1706 c
, BT_CHARACTER
, dc
, REQUIRED
);
1708 make_generic ("fput", GFC_ISYM_FPUT
, GFC_STD_GNU
);
1710 add_sym_1 ("gamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1711 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_gamma
,
1712 gfc_resolve_gamma
, x
, BT_REAL
, dr
, REQUIRED
);
1714 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1715 gfc_check_fn_d
, gfc_simplify_gamma
, gfc_resolve_gamma
,
1716 x
, BT_REAL
, dr
, REQUIRED
);
1718 make_generic ("gamma", GFC_ISYM_TGAMMA
, GFC_STD_F2008
);
1720 /* Unix IDs (g77 compatibility) */
1721 add_sym_1 ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1722 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getcwd
,
1723 c
, BT_CHARACTER
, dc
, REQUIRED
);
1725 make_generic ("getcwd", GFC_ISYM_GETCWD
, GFC_STD_GNU
);
1727 add_sym_0 ("getgid", GFC_ISYM_GETGID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1728 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getgid
);
1730 make_generic ("getgid", GFC_ISYM_GETGID
, GFC_STD_GNU
);
1732 add_sym_0 ("getpid", GFC_ISYM_GETPID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1733 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getpid
);
1735 make_generic ("getpid", GFC_ISYM_GETPID
, GFC_STD_GNU
);
1737 add_sym_0 ("getuid", GFC_ISYM_GETUID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1738 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getuid
);
1740 make_generic ("getuid", GFC_ISYM_GETUID
, GFC_STD_GNU
);
1742 add_sym_1 ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1743 di
, GFC_STD_GNU
, gfc_check_hostnm
, NULL
, gfc_resolve_hostnm
,
1744 a
, BT_CHARACTER
, dc
, REQUIRED
);
1746 make_generic ("hostnm", GFC_ISYM_HOSTNM
, GFC_STD_GNU
);
1748 add_sym_1 ("huge", GFC_ISYM_HUGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1749 gfc_check_huge
, gfc_simplify_huge
, NULL
,
1750 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1752 make_generic ("huge", GFC_ISYM_HUGE
, GFC_STD_F95
);
1754 add_sym_2 ("hypot", GFC_ISYM_HYPOT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1755 BT_REAL
, dr
, GFC_STD_F2008
,
1756 gfc_check_hypot
, gfc_simplify_hypot
, gfc_resolve_hypot
,
1757 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1759 make_generic ("hypot", GFC_ISYM_HYPOT
, GFC_STD_F2008
);
1761 add_sym_2 ("iachar", GFC_ISYM_IACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1762 BT_INTEGER
, di
, GFC_STD_F95
,
1763 gfc_check_ichar_iachar
, gfc_simplify_iachar
, gfc_resolve_iachar
,
1764 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1766 make_generic ("iachar", GFC_ISYM_IACHAR
, GFC_STD_F95
);
1768 add_sym_2 ("iand", GFC_ISYM_IAND
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1769 gfc_check_iand
, gfc_simplify_iand
, gfc_resolve_iand
,
1770 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1772 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
1774 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
1775 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
1776 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
1778 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
1780 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1781 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
1783 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
1785 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1786 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
1787 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1789 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
1791 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1792 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
1793 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
1794 ln
, BT_INTEGER
, di
, REQUIRED
);
1796 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
1798 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1799 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
1800 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1802 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
1804 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1805 BT_INTEGER
, di
, GFC_STD_F77
,
1806 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
1807 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1809 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
1811 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1812 gfc_check_ieor
, gfc_simplify_ieor
, gfc_resolve_ieor
,
1813 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1815 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
1817 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
1818 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
1819 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
1821 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
1823 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1824 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
1826 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
1828 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
1829 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
1830 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
1832 /* The resolution function for INDEX is called gfc_resolve_index_func
1833 because the name gfc_resolve_index is already used in resolve.c. */
1834 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
1835 BT_INTEGER
, di
, GFC_STD_F77
,
1836 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
1837 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
1838 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1840 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
1842 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
1843 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
1844 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1846 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
1847 NULL
, gfc_simplify_ifix
, NULL
,
1848 a
, BT_REAL
, dr
, REQUIRED
);
1850 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
1851 NULL
, gfc_simplify_idint
, NULL
,
1852 a
, BT_REAL
, dd
, REQUIRED
);
1854 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
1856 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
1857 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
1858 a
, BT_REAL
, dr
, REQUIRED
);
1860 make_alias ("short", GFC_STD_GNU
);
1862 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
1864 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
1865 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
1866 a
, BT_REAL
, dr
, REQUIRED
);
1868 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
1870 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
1871 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
1872 a
, BT_REAL
, dr
, REQUIRED
);
1874 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
1876 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1877 gfc_check_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
1878 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1880 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
1882 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
1883 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
1884 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
1886 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
1888 /* The following function is for G77 compatibility. */
1889 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1890 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
1891 i
, BT_INTEGER
, 4, OPTIONAL
);
1893 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
1895 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
1896 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
1897 ut
, BT_INTEGER
, di
, REQUIRED
);
1899 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
1901 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
1902 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1903 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
1904 i
, BT_INTEGER
, 0, REQUIRED
);
1906 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
1908 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
1909 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1910 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
1911 i
, BT_INTEGER
, 0, REQUIRED
);
1913 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
1915 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1916 BT_LOGICAL
, dl
, GFC_STD_GNU
,
1917 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
1918 x
, BT_REAL
, 0, REQUIRED
);
1920 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
1922 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
1923 gfc_check_ishft
, NULL
, gfc_resolve_rshift
,
1924 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
1926 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
1928 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
1929 gfc_check_ishft
, NULL
, gfc_resolve_lshift
,
1930 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
1932 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
1934 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1935 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
1936 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
1938 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
1940 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1941 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
1942 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
1943 sz
, BT_INTEGER
, di
, OPTIONAL
);
1945 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
1947 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1948 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, gfc_resolve_kill
,
1949 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
1951 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
1953 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1954 gfc_check_kind
, gfc_simplify_kind
, NULL
,
1955 x
, BT_REAL
, dr
, REQUIRED
);
1957 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
1959 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
1960 BT_INTEGER
, di
, GFC_STD_F95
,
1961 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
1962 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
1963 kind
, BT_INTEGER
, di
, OPTIONAL
);
1965 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
1967 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
1968 BT_INTEGER
, di
, GFC_STD_F2008
,
1969 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
1970 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1971 kind
, BT_INTEGER
, di
, OPTIONAL
);
1973 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
1975 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1976 BT_INTEGER
, di
, GFC_STD_F2008
,
1977 gfc_check_i
, gfc_simplify_leadz
, NULL
,
1978 i
, BT_INTEGER
, di
, REQUIRED
);
1980 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
1982 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
1983 BT_INTEGER
, di
, GFC_STD_F77
,
1984 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
1985 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1987 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
1989 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1990 BT_INTEGER
, di
, GFC_STD_F95
,
1991 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
1992 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1994 make_alias ("lnblnk", GFC_STD_GNU
);
1996 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
1998 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2000 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2001 x
, BT_REAL
, dr
, REQUIRED
);
2003 make_alias ("log_gamma", GFC_STD_F2008
);
2005 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2006 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2007 x
, BT_REAL
, dr
, REQUIRED
);
2009 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2010 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2011 x
, BT_REAL
, dr
, REQUIRED
);
2013 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2016 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2017 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2018 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2020 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2022 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2023 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2024 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2026 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2028 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2029 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2030 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2032 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2034 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2035 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2036 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2038 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2040 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2041 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2042 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2044 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2046 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2047 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2048 x
, BT_REAL
, dr
, REQUIRED
);
2050 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2051 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2052 x
, BT_REAL
, dr
, REQUIRED
);
2054 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2055 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2056 x
, BT_REAL
, dd
, REQUIRED
);
2058 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2059 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2060 x
, BT_COMPLEX
, dz
, REQUIRED
);
2062 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2063 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2064 x
, BT_COMPLEX
, dd
, REQUIRED
);
2066 make_alias ("cdlog", GFC_STD_GNU
);
2068 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2070 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2071 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2072 x
, BT_REAL
, dr
, REQUIRED
);
2074 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2075 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2076 x
, BT_REAL
, dr
, REQUIRED
);
2078 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2079 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2080 x
, BT_REAL
, dd
, REQUIRED
);
2082 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2084 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2085 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2086 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2088 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2090 add_sym_2 ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2091 GFC_STD_GNU
, gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2092 nm
, BT_CHARACTER
, dc
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
);
2094 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2096 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2097 GFC_STD_GNU
, gfc_check_malloc
, NULL
, gfc_resolve_malloc
,
2098 sz
, BT_INTEGER
, di
, REQUIRED
);
2100 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2102 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2103 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2104 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2106 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2108 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2109 int(max). The max function must take at least two arguments. */
2111 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2112 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2113 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2115 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2116 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2117 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2119 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2120 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2121 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2123 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2124 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2125 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2127 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2128 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2129 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2131 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2132 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2133 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2135 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2137 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2138 GFC_STD_F95
, gfc_check_x
, gfc_simplify_maxexponent
, NULL
,
2139 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2141 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2143 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2144 gfc_check_minloc_maxloc
, NULL
, gfc_resolve_maxloc
,
2145 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2146 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2148 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2150 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2151 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2152 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2153 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2155 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2157 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2158 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2160 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2162 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2163 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2165 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2167 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2168 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2169 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2170 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2172 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2174 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2177 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2178 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2179 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2181 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2182 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2183 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2185 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2186 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2187 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2189 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2190 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2191 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2193 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2194 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2195 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2197 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2198 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2199 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2201 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2203 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2204 GFC_STD_F95
, gfc_check_x
, gfc_simplify_minexponent
, NULL
,
2205 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2207 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2209 add_sym_3ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2210 gfc_check_minloc_maxloc
, NULL
, gfc_resolve_minloc
,
2211 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2212 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2214 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2216 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2217 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2218 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2219 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2221 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2223 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2224 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2225 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2227 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2228 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2229 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2231 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2232 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2233 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2235 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2237 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2238 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2239 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2241 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2243 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2244 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2245 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2247 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2249 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2250 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2251 a
, BT_CHARACTER
, dc
, REQUIRED
);
2253 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2255 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2256 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2257 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2259 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2260 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2261 a
, BT_REAL
, dd
, REQUIRED
);
2263 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2265 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2266 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2267 i
, BT_INTEGER
, di
, REQUIRED
);
2269 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2271 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2272 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2273 x
, BT_REAL
, dr
, REQUIRED
,
2274 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2276 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2278 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2279 gfc_check_null
, gfc_simplify_null
, NULL
,
2280 mo
, BT_INTEGER
, di
, OPTIONAL
);
2282 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2284 add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2285 NULL
, gfc_simplify_num_images
, NULL
);
2287 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2288 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2289 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2290 v
, BT_REAL
, dr
, OPTIONAL
);
2292 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2295 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2296 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2297 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2298 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2300 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2302 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2303 BT_INTEGER
, di
, GFC_STD_F2008
,
2304 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2305 i
, BT_INTEGER
, di
, REQUIRED
);
2307 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2309 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2310 BT_INTEGER
, di
, GFC_STD_F2008
,
2311 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2312 i
, BT_INTEGER
, di
, REQUIRED
);
2314 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2316 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2317 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2318 x
, BT_UNKNOWN
, 0, REQUIRED
);
2320 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2322 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2323 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2324 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2326 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2328 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2329 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2330 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2331 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2333 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2335 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2336 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2337 x
, BT_UNKNOWN
, 0, REQUIRED
);
2339 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2341 /* The following function is for G77 compatibility. */
2342 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2343 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2344 i
, BT_INTEGER
, 4, OPTIONAL
);
2346 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2347 use slightly different shoddy multiplicative congruential PRNG. */
2348 make_alias ("ran", GFC_STD_GNU
);
2350 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2352 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2353 gfc_check_range
, gfc_simplify_range
, NULL
,
2354 x
, BT_REAL
, dr
, REQUIRED
);
2356 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2358 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2359 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2360 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2362 /* This provides compatibility with g77. */
2363 add_sym_1 ("realpart", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2364 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2365 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2367 add_sym_1 ("float", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2368 gfc_check_float
, gfc_simplify_float
, NULL
,
2369 a
, BT_INTEGER
, di
, REQUIRED
);
2371 add_sym_1 ("dfloat", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2372 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2373 a
, BT_REAL
, dr
, REQUIRED
);
2375 add_sym_1 ("sngl", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2376 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2377 a
, BT_REAL
, dd
, REQUIRED
);
2379 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2381 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2382 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2383 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2385 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2387 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2388 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2389 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2391 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2393 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2394 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2395 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2396 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2398 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2400 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2401 gfc_check_x
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2402 x
, BT_REAL
, dr
, REQUIRED
);
2404 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2406 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2407 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2408 gfc_check_same_type_as
, NULL
, NULL
,
2409 a
, BT_UNKNOWN
, 0, REQUIRED
,
2410 b
, BT_UNKNOWN
, 0, REQUIRED
);
2412 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2413 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2414 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2416 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2418 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2419 BT_INTEGER
, di
, GFC_STD_F95
,
2420 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2421 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2422 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2424 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2426 /* Added for G77 compatibility garbage. */
2427 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2428 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2430 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2432 /* Added for G77 compatibility. */
2433 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2434 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2435 x
, BT_REAL
, dr
, REQUIRED
);
2437 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2439 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2440 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2441 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2442 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2444 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2446 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2447 GFC_STD_F95
, gfc_check_selected_int_kind
,
2448 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2450 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2452 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2453 GFC_STD_F95
, gfc_check_selected_real_kind
,
2454 gfc_simplify_selected_real_kind
, NULL
,
2455 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2456 "radix", BT_INTEGER
, di
, OPTIONAL
);
2458 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2460 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2461 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2462 gfc_resolve_set_exponent
,
2463 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2465 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2467 add_sym_1 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2468 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2469 src
, BT_REAL
, dr
, REQUIRED
);
2471 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2473 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2474 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
2475 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
2477 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2478 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
2479 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2481 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2482 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
2483 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
2485 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
2487 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2488 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
2489 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_UNKNOWN
, 0, REQUIRED
);
2491 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
2493 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2494 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
2495 x
, BT_REAL
, dr
, REQUIRED
);
2497 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2498 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
2499 x
, BT_REAL
, dd
, REQUIRED
);
2501 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2502 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2503 x
, BT_COMPLEX
, dz
, REQUIRED
);
2505 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2506 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2507 x
, BT_COMPLEX
, dd
, REQUIRED
);
2509 make_alias ("cdsin", GFC_STD_GNU
);
2511 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
2513 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2514 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2515 x
, BT_REAL
, dr
, REQUIRED
);
2517 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2518 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2519 x
, BT_REAL
, dd
, REQUIRED
);
2521 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
2523 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2524 BT_INTEGER
, di
, GFC_STD_F95
,
2525 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
2526 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2527 kind
, BT_INTEGER
, di
, OPTIONAL
);
2529 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
2531 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2532 GFC_STD_GNU
, gfc_check_sizeof
, NULL
, NULL
,
2533 x
, BT_UNKNOWN
, 0, REQUIRED
);
2535 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
2537 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2538 BT_INTEGER
, ii
, GFC_STD_F2008
, gfc_check_c_sizeof
, NULL
, NULL
,
2539 x
, BT_UNKNOWN
, 0, REQUIRED
);
2541 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2542 gfc_check_x
, gfc_simplify_spacing
, gfc_resolve_spacing
,
2543 x
, BT_REAL
, dr
, REQUIRED
);
2545 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
2547 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2548 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
2549 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
2550 ncopies
, BT_INTEGER
, di
, REQUIRED
);
2552 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
2554 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2555 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2556 x
, BT_REAL
, dr
, REQUIRED
);
2558 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2559 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2560 x
, BT_REAL
, dd
, REQUIRED
);
2562 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2563 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2564 x
, BT_COMPLEX
, dz
, REQUIRED
);
2566 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2567 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2568 x
, BT_COMPLEX
, dd
, REQUIRED
);
2570 make_alias ("cdsqrt", GFC_STD_GNU
);
2572 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
2574 add_sym_2 ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2575 GFC_STD_GNU
, gfc_check_stat
, NULL
, gfc_resolve_stat
,
2576 nm
, BT_CHARACTER
, dc
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
);
2578 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
2580 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2581 BT_INTEGER
, di
, GFC_STD_F2008
,
2582 gfc_check_storage_size
, NULL
, gfc_resolve_storage_size
,
2583 a
, BT_UNKNOWN
, 0, REQUIRED
,
2584 kind
, BT_INTEGER
, di
, OPTIONAL
);
2586 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2587 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
2588 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2589 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2591 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
2593 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2594 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
2595 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2597 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
2599 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2600 GFC_STD_GNU
, NULL
, NULL
, NULL
,
2601 com
, BT_CHARACTER
, dc
, REQUIRED
);
2603 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
2605 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2606 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
2607 x
, BT_REAL
, dr
, REQUIRED
);
2609 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2610 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
2611 x
, BT_REAL
, dd
, REQUIRED
);
2613 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
2615 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2616 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
2617 x
, BT_REAL
, dr
, REQUIRED
);
2619 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2620 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
2621 x
, BT_REAL
, dd
, REQUIRED
);
2623 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
2625 add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2626 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
2627 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
2629 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2630 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
2632 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
2634 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2635 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
2637 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
2639 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2640 gfc_check_x
, gfc_simplify_tiny
, NULL
,
2641 x
, BT_REAL
, dr
, REQUIRED
);
2643 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
2645 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2646 BT_INTEGER
, di
, GFC_STD_F2008
,
2647 gfc_check_i
, gfc_simplify_trailz
, NULL
,
2648 i
, BT_INTEGER
, di
, REQUIRED
);
2650 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
2652 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2653 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
2654 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
2655 sz
, BT_INTEGER
, di
, OPTIONAL
);
2657 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
2659 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2660 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
2661 m
, BT_REAL
, dr
, REQUIRED
);
2663 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
2665 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2666 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
2667 stg
, BT_CHARACTER
, dc
, REQUIRED
);
2669 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
2671 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
2672 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
2673 ut
, BT_INTEGER
, di
, REQUIRED
);
2675 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
2677 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2678 BT_INTEGER
, di
, GFC_STD_F95
,
2679 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
2680 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2681 kind
, BT_INTEGER
, di
, OPTIONAL
);
2683 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
2685 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2686 BT_INTEGER
, di
, GFC_STD_F2008
,
2687 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
2688 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2689 kind
, BT_INTEGER
, di
, OPTIONAL
);
2691 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
2693 /* g77 compatibility for UMASK. */
2694 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2695 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
2696 msk
, BT_INTEGER
, di
, REQUIRED
);
2698 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
2700 /* g77 compatibility for UNLINK. */
2701 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2702 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
2703 "path", BT_CHARACTER
, dc
, REQUIRED
);
2705 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
2707 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2708 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
2709 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2710 f
, BT_REAL
, dr
, REQUIRED
);
2712 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
2714 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2715 BT_INTEGER
, di
, GFC_STD_F95
,
2716 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
2717 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2718 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2720 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
2722 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2723 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
2724 x
, BT_UNKNOWN
, 0, REQUIRED
);
2726 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
2730 /* Add intrinsic subroutines. */
2733 add_subroutines (void)
2735 /* Argument names as in the standard (to be used as argument keywords). */
2737 *h
= "harvest", *dt
= "date", *vl
= "values", *pt
= "put",
2738 *c
= "count", *tm
= "time", *tp
= "topos", *gt
= "get",
2739 *t
= "to", *zn
= "zone", *fp
= "frompos", *cm
= "count_max",
2740 *f
= "from", *sz
= "size", *ln
= "len", *cr
= "count_rate",
2741 *com
= "command", *length
= "length", *st
= "status",
2742 *val
= "value", *num
= "number", *name
= "name",
2743 *trim_name
= "trim_name", *ut
= "unit", *han
= "handler",
2744 *sec
= "seconds", *res
= "result", *of
= "offset", *md
= "mode",
2745 *whence
= "whence", *pos
= "pos", *ptr
= "ptr", *p1
= "path1",
2746 *p2
= "path2", *msk
= "mask", *old
= "old";
2748 int di
, dr
, dc
, dl
, ii
;
2750 di
= gfc_default_integer_kind
;
2751 dr
= gfc_default_real_kind
;
2752 dc
= gfc_default_character_kind
;
2753 dl
= gfc_default_logical_kind
;
2754 ii
= gfc_index_integer_kind
;
2756 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
2760 add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
2761 GFC_STD_F95
, gfc_check_cpu_time
, NULL
,
2762 gfc_resolve_cpu_time
,
2763 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
2765 /* More G77 compatibility garbage. */
2766 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2767 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
2768 tm
, BT_INTEGER
, di
, REQUIRED
, res
, BT_CHARACTER
, dc
, REQUIRED
);
2770 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2771 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
2772 vl
, BT_INTEGER
, 4, REQUIRED
);
2774 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2775 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
2776 vl
, BT_INTEGER
, 4, REQUIRED
);
2778 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2779 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
2780 tm
, BT_INTEGER
, di
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
);
2782 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
,
2783 0, GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
2784 tm
, BT_INTEGER
, di
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
);
2786 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
2787 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
2788 tm
, BT_REAL
, dr
, REQUIRED
);
2790 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2791 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
2792 name
, BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2794 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2795 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
2796 name
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
,
2797 st
, BT_INTEGER
, di
, OPTIONAL
);
2799 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
2800 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
2801 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
2802 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
2803 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
2804 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
2806 /* More G77 compatibility garbage. */
2807 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2808 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
2809 vl
, BT_REAL
, 4, REQUIRED
, tm
, BT_REAL
, 4, REQUIRED
);
2811 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2812 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
2813 vl
, BT_REAL
, 4, REQUIRED
, tm
, BT_REAL
, 4, REQUIRED
);
2815 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
2816 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
2817 NULL
, NULL
, gfc_resolve_execute_command_line
,
2818 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2819 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
2820 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
2821 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
2822 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
2824 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2825 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
2826 dt
, BT_CHARACTER
, dc
, REQUIRED
);
2828 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
2829 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
2830 res
, BT_CHARACTER
, dc
, REQUIRED
);
2832 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
2833 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
2834 c
, BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2836 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
2837 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
2838 name
, BT_CHARACTER
, dc
, REQUIRED
,
2839 val
, BT_CHARACTER
, dc
, REQUIRED
);
2841 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
2842 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
2843 pos
, BT_INTEGER
, di
, REQUIRED
, val
, BT_CHARACTER
, dc
, REQUIRED
);
2845 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
2846 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
2847 c
, BT_CHARACTER
, dc
, REQUIRED
);
2849 /* F2003 commandline routines. */
2851 add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
2852 BT_UNKNOWN
, 0, GFC_STD_F2003
,
2853 NULL
, NULL
, gfc_resolve_get_command
,
2854 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
2855 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
2856 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
2858 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
2859 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
2860 gfc_resolve_get_command_argument
,
2861 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2862 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
2863 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
2864 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
2866 /* F2003 subroutine to get environment variables. */
2868 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
2869 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
2870 NULL
, NULL
, gfc_resolve_get_environment_variable
,
2871 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2872 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
2873 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
2874 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
2875 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
2877 add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
,
2878 BT_UNKNOWN
, 0, GFC_STD_F2003
,
2879 gfc_check_move_alloc
, NULL
, NULL
,
2880 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
2881 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
2883 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
2884 GFC_STD_F95
, gfc_check_mvbits
, gfc_simplify_mvbits
,
2886 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2887 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2888 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2889 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
2890 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
2892 add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
2893 BT_UNKNOWN
, 0, GFC_STD_F95
, gfc_check_random_number
, NULL
,
2894 gfc_resolve_random_number
,
2895 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
2897 add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
2898 BT_UNKNOWN
, 0, GFC_STD_F95
,
2899 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
2900 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
2901 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
2902 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
2904 /* More G77 compatibility garbage. */
2905 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2906 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
2907 sec
, BT_INTEGER
, di
, REQUIRED
, han
, BT_UNKNOWN
, 0, REQUIRED
,
2908 st
, BT_INTEGER
, di
, OPTIONAL
);
2910 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
2911 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
2912 "seed", BT_INTEGER
, 4, REQUIRED
);
2914 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2915 gfc_check_exit
, NULL
, gfc_resolve_exit
,
2916 st
, BT_INTEGER
, di
, OPTIONAL
);
2920 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2921 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
2922 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
,
2923 st
, BT_INTEGER
, di
, OPTIONAL
);
2925 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2926 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
2927 c
, BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2929 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2930 gfc_check_flush
, NULL
, gfc_resolve_flush
,
2931 ut
, BT_INTEGER
, di
, OPTIONAL
);
2933 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2934 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
2935 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
,
2936 st
, BT_INTEGER
, di
, OPTIONAL
);
2938 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2939 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
2940 c
, BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2942 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2943 gfc_check_free
, NULL
, gfc_resolve_free
,
2944 ptr
, BT_INTEGER
, ii
, REQUIRED
);
2946 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2947 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
2948 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2949 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2950 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2951 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
2953 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2954 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
2955 ut
, BT_INTEGER
, di
, REQUIRED
, of
, BT_INTEGER
, ii
, REQUIRED
);
2957 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
2958 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
2959 c
, BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2961 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
,
2962 0, GFC_STD_GNU
, gfc_check_kill_sub
,
2963 NULL
, gfc_resolve_kill_sub
, c
, BT_INTEGER
, di
, REQUIRED
,
2964 val
, BT_INTEGER
, di
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2966 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2967 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
2968 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
,
2969 dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2971 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
2972 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
2973 "string", BT_CHARACTER
, dc
, REQUIRED
);
2975 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
2976 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
2977 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
,
2978 dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
2980 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2981 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
2982 sec
, BT_INTEGER
, di
, REQUIRED
);
2984 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2985 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
2986 ut
, BT_INTEGER
, di
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
,
2987 st
, BT_INTEGER
, di
, OPTIONAL
);
2989 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2990 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
2991 name
, BT_CHARACTER
, dc
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
,
2992 st
, BT_INTEGER
, di
, OPTIONAL
);
2994 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
2995 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
2996 name
, BT_CHARACTER
, dc
, REQUIRED
, vl
, BT_INTEGER
, di
, REQUIRED
,
2997 st
, BT_INTEGER
, di
, OPTIONAL
);
2999 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3000 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3001 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_UNKNOWN
, 0, REQUIRED
,
3002 st
, BT_INTEGER
, di
, OPTIONAL
);
3004 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3005 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3006 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
,
3007 dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
3009 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3010 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3011 com
, BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
3013 add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3014 BT_UNKNOWN
, 0, GFC_STD_F95
,
3015 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3016 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3017 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3018 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3020 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3021 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3022 ut
, BT_INTEGER
, di
, REQUIRED
, name
, BT_CHARACTER
, dc
, REQUIRED
);
3024 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3025 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3026 msk
, BT_INTEGER
, di
, REQUIRED
, old
, BT_INTEGER
, di
, OPTIONAL
);
3028 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3029 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3030 "path", BT_CHARACTER
, dc
, REQUIRED
, st
, BT_INTEGER
, di
, OPTIONAL
);
3034 /* Add a function to the list of conversion symbols. */
3037 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3039 gfc_typespec from
, to
;
3040 gfc_intrinsic_sym
*sym
;
3042 if (sizing
== SZ_CONVS
)
3048 gfc_clear_ts (&from
);
3049 from
.type
= from_type
;
3050 from
.kind
= from_kind
;
3056 sym
= conversion
+ nconv
;
3058 sym
->name
= conv_name (&from
, &to
);
3059 sym
->lib_name
= sym
->name
;
3060 sym
->simplify
.cc
= gfc_convert_constant
;
3061 sym
->standard
= standard
;
3064 sym
->conversion
= 1;
3066 sym
->id
= GFC_ISYM_CONVERSION
;
3072 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3073 functions by looping over the kind tables. */
3076 add_conversions (void)
3080 /* Integer-Integer conversions. */
3081 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3082 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
3087 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3088 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
3091 /* Integer-Real/Complex conversions. */
3092 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3093 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3095 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3096 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3098 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
3099 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3101 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3102 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3104 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
3105 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3108 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3110 /* Hollerith-Integer conversions. */
3111 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3112 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3113 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3114 /* Hollerith-Real conversions. */
3115 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3116 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3117 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3118 /* Hollerith-Complex conversions. */
3119 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3120 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3121 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3123 /* Hollerith-Character conversions. */
3124 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
3125 gfc_default_character_kind
, GFC_STD_LEGACY
);
3127 /* Hollerith-Logical conversions. */
3128 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
3129 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3130 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
3133 /* Real/Complex - Real/Complex conversions. */
3134 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3135 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3139 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3140 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3142 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3143 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3146 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3147 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3149 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3150 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3153 /* Logical/Logical kind conversion. */
3154 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
3155 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
3160 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
3161 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
3164 /* Integer-Logical and Logical-Integer conversions. */
3165 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3166 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
3167 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
3169 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3170 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
3171 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
3172 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3178 add_char_conversions (void)
3182 /* Count possible conversions. */
3183 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
3184 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
3188 /* Allocate memory. */
3189 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
3191 /* Add the conversions themselves. */
3193 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
3194 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
3196 gfc_typespec from
, to
;
3201 gfc_clear_ts (&from
);
3202 from
.type
= BT_CHARACTER
;
3203 from
.kind
= gfc_character_kinds
[i
].kind
;
3206 to
.type
= BT_CHARACTER
;
3207 to
.kind
= gfc_character_kinds
[j
].kind
;
3209 char_conversions
[n
].name
= conv_name (&from
, &to
);
3210 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
3211 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
3212 char_conversions
[n
].standard
= GFC_STD_F2003
;
3213 char_conversions
[n
].elemental
= 1;
3214 char_conversions
[n
].pure
= 1;
3215 char_conversions
[n
].conversion
= 0;
3216 char_conversions
[n
].ts
= to
;
3217 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
3224 /* Initialize the table of intrinsics. */
3226 gfc_intrinsic_init_1 (void)
3230 nargs
= nfunc
= nsub
= nconv
= 0;
3232 /* Create a namespace to hold the resolved intrinsic symbols. */
3233 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
3242 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
3243 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
3244 + sizeof (gfc_intrinsic_arg
) * nargs
);
3246 next_sym
= functions
;
3247 subroutines
= functions
+ nfunc
;
3249 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
3251 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
3253 sizing
= SZ_NOTHING
;
3260 /* Character conversion intrinsics need to be treated separately. */
3261 add_char_conversions ();
3263 /* Set the pure flag. All intrinsic functions are pure, and
3264 intrinsic subroutines are pure if they are elemental. */
3266 for (i
= 0; i
< nfunc
; i
++)
3267 functions
[i
].pure
= 1;
3269 for (i
= 0; i
< nsub
; i
++)
3270 subroutines
[i
].pure
= subroutines
[i
].elemental
;
3275 gfc_intrinsic_done_1 (void)
3277 gfc_free (functions
);
3278 gfc_free (conversion
);
3279 gfc_free (char_conversions
);
3280 gfc_free_namespace (gfc_intrinsic_namespace
);
3284 /******** Subroutines to check intrinsic interfaces ***********/
3286 /* Given a formal argument list, remove any NULL arguments that may
3287 have been left behind by a sort against some formal argument list. */
3290 remove_nullargs (gfc_actual_arglist
**ap
)
3292 gfc_actual_arglist
*head
, *tail
, *next
;
3296 for (head
= *ap
; head
; head
= next
)
3300 if (head
->expr
== NULL
&& !head
->label
)
3303 gfc_free_actual_arglist (head
);
3322 /* Given an actual arglist and a formal arglist, sort the actual
3323 arglist so that its arguments are in a one-to-one correspondence
3324 with the format arglist. Arguments that are not present are given
3325 a blank gfc_actual_arglist structure. If something is obviously
3326 wrong (say, a missing required argument) we abort sorting and
3330 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
3331 gfc_intrinsic_arg
*formal
, locus
*where
)
3333 gfc_actual_arglist
*actual
, *a
;
3334 gfc_intrinsic_arg
*f
;
3336 remove_nullargs (ap
);
3339 for (f
= formal
; f
; f
= f
->next
)
3345 if (f
== NULL
&& a
== NULL
) /* No arguments */
3349 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3355 if (a
->name
!= NULL
)
3367 gfc_error ("Too many arguments in call to '%s' at %L", name
, where
);
3371 /* Associate the remaining actual arguments, all of which have
3372 to be keyword arguments. */
3373 for (; a
; a
= a
->next
)
3375 for (f
= formal
; f
; f
= f
->next
)
3376 if (strcmp (a
->name
, f
->name
) == 0)
3381 if (a
->name
[0] == '%')
3382 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3383 "are not allowed in this context at %L", where
);
3385 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
3386 a
->name
, name
, where
);
3390 if (f
->actual
!= NULL
)
3392 gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
3393 f
->name
, name
, where
);
3401 /* At this point, all unmatched formal args must be optional. */
3402 for (f
= formal
; f
; f
= f
->next
)
3404 if (f
->actual
== NULL
&& f
->optional
== 0)
3406 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3407 f
->name
, name
, where
);
3413 /* Using the formal argument list, string the actual argument list
3414 together in a way that corresponds with the formal list. */
3417 for (f
= formal
; f
; f
= f
->next
)
3419 if (f
->actual
&& f
->actual
->label
!= NULL
&& f
->ts
.type
)
3421 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
3425 if (f
->actual
== NULL
)
3427 a
= gfc_get_actual_arglist ();
3428 a
->missing_arg_type
= f
->ts
.type
;
3440 actual
->next
= NULL
; /* End the sorted argument list. */
3446 /* Compare an actual argument list with an intrinsic's formal argument
3447 list. The lists are checked for agreement of type. We don't check
3448 for arrayness here. */
3451 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
3454 gfc_actual_arglist
*actual
;
3455 gfc_intrinsic_arg
*formal
;
3458 formal
= sym
->formal
;
3462 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
3466 if (actual
->expr
== NULL
)
3471 /* A kind of 0 means we don't check for kind. */
3473 ts
.kind
= actual
->expr
->ts
.kind
;
3475 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
3478 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3479 "be %s, not %s", gfc_current_intrinsic_arg
[i
]->name
,
3480 gfc_current_intrinsic
, &actual
->expr
->where
,
3481 gfc_typename (&formal
->ts
),
3482 gfc_typename (&actual
->expr
->ts
));
3491 /* Given a pointer to an intrinsic symbol and an expression node that
3492 represent the function call to that subroutine, figure out the type
3493 of the result. This may involve calling a resolution subroutine. */
3496 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
3498 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
3499 gfc_actual_arglist
*arg
;
3501 if (specific
->resolve
.f1
== NULL
)
3503 if (e
->value
.function
.name
== NULL
)
3504 e
->value
.function
.name
= specific
->lib_name
;
3506 if (e
->ts
.type
== BT_UNKNOWN
)
3507 e
->ts
= specific
->ts
;
3511 arg
= e
->value
.function
.actual
;
3513 /* Special case hacks for MIN and MAX. */
3514 if (specific
->resolve
.f1m
== gfc_resolve_max
3515 || specific
->resolve
.f1m
== gfc_resolve_min
)
3517 (*specific
->resolve
.f1m
) (e
, arg
);
3523 (*specific
->resolve
.f0
) (e
);
3532 (*specific
->resolve
.f1
) (e
, a1
);
3541 (*specific
->resolve
.f2
) (e
, a1
, a2
);
3550 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
3559 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
3568 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
3572 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3576 /* Given an intrinsic symbol node and an expression node, call the
3577 simplification function (if there is one), perhaps replacing the
3578 expression with something simpler. We return FAILURE on an error
3579 of the simplification, SUCCESS if the simplification worked, even
3580 if nothing has changed in the expression itself. */
3583 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
3585 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
;
3586 gfc_actual_arglist
*arg
;
3588 /* Max and min require special handling due to the variable number
3590 if (specific
->simplify
.f1
== gfc_simplify_min
)
3592 result
= gfc_simplify_min (e
);
3596 if (specific
->simplify
.f1
== gfc_simplify_max
)
3598 result
= gfc_simplify_max (e
);
3602 if (specific
->simplify
.f1
== NULL
)
3608 arg
= e
->value
.function
.actual
;
3612 result
= (*specific
->simplify
.f0
) ();
3619 if (specific
->simplify
.cc
== gfc_convert_constant
3620 || specific
->simplify
.cc
== gfc_convert_char_constant
)
3622 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
3627 result
= (*specific
->simplify
.f1
) (a1
);
3634 result
= (*specific
->simplify
.f2
) (a1
, a2
);
3641 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
3648 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
3655 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
3658 ("do_simplify(): Too many args for intrinsic");
3665 if (result
== &gfc_bad_expr
)
3669 resolve_intrinsic (specific
, e
); /* Must call at run-time */
3672 result
->where
= e
->where
;
3673 gfc_replace_expr (e
, result
);
3680 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3681 error messages. This subroutine returns FAILURE if a subroutine
3682 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3683 list cannot match any intrinsic. */
3686 init_arglist (gfc_intrinsic_sym
*isym
)
3688 gfc_intrinsic_arg
*formal
;
3691 gfc_current_intrinsic
= isym
->name
;
3694 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
3696 if (i
>= MAX_INTRINSIC_ARGS
)
3697 gfc_internal_error ("init_arglist(): too many arguments");
3698 gfc_current_intrinsic_arg
[i
++] = formal
;
3703 /* Given a pointer to an intrinsic symbol and an expression consisting
3704 of a function call, see if the function call is consistent with the
3705 intrinsic's formal argument list. Return SUCCESS if the expression
3706 and intrinsic match, FAILURE otherwise. */
3709 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
3711 gfc_actual_arglist
*arg
, **ap
;
3714 ap
= &expr
->value
.function
.actual
;
3716 init_arglist (specific
);
3718 /* Don't attempt to sort the argument list for min or max. */
3719 if (specific
->check
.f1m
== gfc_check_min_max
3720 || specific
->check
.f1m
== gfc_check_min_max_integer
3721 || specific
->check
.f1m
== gfc_check_min_max_real
3722 || specific
->check
.f1m
== gfc_check_min_max_double
)
3723 return (*specific
->check
.f1m
) (*ap
);
3725 if (sort_actual (specific
->name
, ap
, specific
->formal
,
3726 &expr
->where
) == FAILURE
)
3729 if (specific
->check
.f3ml
== gfc_check_minloc_maxloc
)
3730 /* This is special because we might have to reorder the argument list. */
3731 t
= gfc_check_minloc_maxloc (*ap
);
3732 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
3733 /* This is also special because we also might have to reorder the
3735 t
= gfc_check_minval_maxval (*ap
);
3736 else if (specific
->check
.f3red
== gfc_check_product_sum
)
3737 /* Same here. The difference to the previous case is that we allow a
3738 general numeric type. */
3739 t
= gfc_check_product_sum (*ap
);
3742 if (specific
->check
.f1
== NULL
)
3744 t
= check_arglist (ap
, specific
, error_flag
);
3746 expr
->ts
= specific
->ts
;
3749 t
= do_check (specific
, *ap
);
3752 /* Check conformance of elemental intrinsics. */
3753 if (t
== SUCCESS
&& specific
->elemental
)
3756 gfc_expr
*first_expr
;
3757 arg
= expr
->value
.function
.actual
;
3759 /* There is no elemental intrinsic without arguments. */
3760 gcc_assert(arg
!= NULL
);
3761 first_expr
= arg
->expr
;
3763 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
3764 if (gfc_check_conformance (first_expr
, arg
->expr
,
3765 "arguments '%s' and '%s' for "
3767 gfc_current_intrinsic_arg
[0]->name
,
3768 gfc_current_intrinsic_arg
[n
]->name
,
3769 gfc_current_intrinsic
) == FAILURE
)
3774 remove_nullargs (ap
);
3780 /* Check whether an intrinsic belongs to whatever standard the user
3781 has chosen, taking also into account -fall-intrinsics. Here, no
3782 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3783 textual representation of the symbols standard status (like
3784 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3785 can be used to construct a detailed warning/error message in case of
3789 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
3790 const char** symstd
, bool silent
, locus where
)
3792 const char* symstd_msg
;
3794 /* For -fall-intrinsics, just succeed. */
3795 if (gfc_option
.flag_all_intrinsics
)
3798 /* Find the symbol's standard message for later usage. */
3799 switch (isym
->standard
)
3802 symstd_msg
= "available since Fortran 77";
3805 case GFC_STD_F95_OBS
:
3806 symstd_msg
= "obsolescent in Fortran 95";
3809 case GFC_STD_F95_DEL
:
3810 symstd_msg
= "deleted in Fortran 95";
3814 symstd_msg
= "new in Fortran 95";
3818 symstd_msg
= "new in Fortran 2003";
3822 symstd_msg
= "new in Fortran 2008";
3826 symstd_msg
= "a GNU Fortran extension";
3829 case GFC_STD_LEGACY
:
3830 symstd_msg
= "for backward compatibility";
3834 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3835 isym
->name
, isym
->standard
);
3838 /* If warning about the standard, warn and succeed. */
3839 if (gfc_option
.warn_std
& isym
->standard
)
3841 /* Do only print a warning if not a GNU extension. */
3842 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
3843 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3844 isym
->name
, _(symstd_msg
), &where
);
3849 /* If allowing the symbol's standard, succeed, too. */
3850 if (gfc_option
.allow_std
& isym
->standard
)
3853 /* Otherwise, fail. */
3855 *symstd
= _(symstd_msg
);
3860 /* See if a function call corresponds to an intrinsic function call.
3863 MATCH_YES if the call corresponds to an intrinsic, simplification
3864 is done if possible.
3866 MATCH_NO if the call does not correspond to an intrinsic
3868 MATCH_ERROR if the call corresponds to an intrinsic but there was an
3869 error during the simplification process.
3871 The error_flag parameter enables an error reporting. */
3874 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
3876 gfc_intrinsic_sym
*isym
, *specific
;
3877 gfc_actual_arglist
*actual
;
3881 if (expr
->value
.function
.isym
!= NULL
)
3882 return (do_simplify (expr
->value
.function
.isym
, expr
) == FAILURE
)
3883 ? MATCH_ERROR
: MATCH_YES
;
3886 gfc_push_suppress_errors ();
3889 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
3890 if (actual
->expr
!= NULL
)
3891 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
3892 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
3894 name
= expr
->symtree
->n
.sym
->name
;
3896 isym
= specific
= gfc_find_function (name
);
3900 gfc_pop_suppress_errors ();
3904 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
3905 || isym
->id
== GFC_ISYM_CMPLX
)
3906 && gfc_init_expr_flag
3907 && gfc_notify_std (GFC_STD_F2003
, "Fortran 2003: Function '%s' "
3908 "as initialization expression at %L", name
,
3909 &expr
->where
) == FAILURE
)
3912 gfc_pop_suppress_errors ();
3916 gfc_current_intrinsic_where
= &expr
->where
;
3918 /* Bypass the generic list for min and max. */
3919 if (isym
->check
.f1m
== gfc_check_min_max
)
3921 init_arglist (isym
);
3923 if (gfc_check_min_max (expr
->value
.function
.actual
) == SUCCESS
)
3927 gfc_pop_suppress_errors ();
3931 /* If the function is generic, check all of its specific
3932 incarnations. If the generic name is also a specific, we check
3933 that name last, so that any error message will correspond to the
3935 gfc_push_suppress_errors ();
3939 for (specific
= isym
->specific_head
; specific
;
3940 specific
= specific
->next
)
3942 if (specific
== isym
)
3944 if (check_specific (specific
, expr
, 0) == SUCCESS
)
3946 gfc_pop_suppress_errors ();
3952 gfc_pop_suppress_errors ();
3954 if (check_specific (isym
, expr
, error_flag
) == FAILURE
)
3957 gfc_pop_suppress_errors ();
3964 expr
->value
.function
.isym
= specific
;
3965 gfc_intrinsic_symbol (expr
->symtree
->n
.sym
);
3968 gfc_pop_suppress_errors ();
3970 if (do_simplify (specific
, expr
) == FAILURE
)
3973 /* F95, 7.1.6.1, Initialization expressions
3974 (4) An elemental intrinsic function reference of type integer or
3975 character where each argument is an initialization expression
3976 of type integer or character
3978 F2003, 7.1.7 Initialization expression
3979 (4) A reference to an elemental standard intrinsic function,
3980 where each argument is an initialization expression */
3982 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
3983 && gfc_notify_std (GFC_STD_F2003
, "Fortran 2003: Elemental function "
3984 "as initialization expression with non-integer/non-"
3985 "character arguments at %L", &expr
->where
) == FAILURE
)
3992 /* See if a CALL statement corresponds to an intrinsic subroutine.
3993 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3994 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3998 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
4000 gfc_intrinsic_sym
*isym
;
4003 name
= c
->symtree
->n
.sym
->name
;
4005 isym
= gfc_find_subroutine (name
);
4010 gfc_push_suppress_errors ();
4012 init_arglist (isym
);
4014 if (sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
) == FAILURE
)
4017 if (isym
->check
.f1
!= NULL
)
4019 if (do_check (isym
, c
->ext
.actual
) == FAILURE
)
4024 if (check_arglist (&c
->ext
.actual
, isym
, 1) == FAILURE
)
4028 /* The subroutine corresponds to an intrinsic. Allow errors to be
4029 seen at this point. */
4031 gfc_pop_suppress_errors ();
4033 c
->resolved_isym
= isym
;
4034 if (isym
->resolve
.s1
!= NULL
)
4035 isym
->resolve
.s1 (c
);
4038 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
4039 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
4042 if (gfc_pure (NULL
) && !isym
->elemental
)
4044 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name
,
4049 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
4055 gfc_pop_suppress_errors ();
4060 /* Call gfc_convert_type() with warning enabled. */
4063 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
4065 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
4069 /* Try to convert an expression (in place) from one type to another.
4070 'eflag' controls the behavior on error.
4072 The possible values are:
4074 1 Generate a gfc_error()
4075 2 Generate a gfc_internal_error().
4077 'wflag' controls the warning related to conversion. */
4080 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
)
4082 gfc_intrinsic_sym
*sym
;
4083 gfc_typespec from_ts
;
4089 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
4091 if (ts
->type
== BT_UNKNOWN
)
4094 /* NULL and zero size arrays get their type here. */
4095 if (expr
->expr_type
== EXPR_NULL
4096 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
4098 /* Sometimes the RHS acquire the type. */
4103 if (expr
->ts
.type
== BT_UNKNOWN
)
4106 if (expr
->ts
.type
== BT_DERIVED
&& ts
->type
== BT_DERIVED
4107 && gfc_compare_types (&expr
->ts
, ts
))
4110 sym
= find_conv (&expr
->ts
, ts
);
4114 /* At this point, a conversion is necessary. A warning may be needed. */
4115 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
4117 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4118 gfc_typename (&from_ts
), gfc_typename (ts
),
4123 if (gfc_option
.flag_range_check
4124 && expr
->expr_type
== EXPR_CONSTANT
4125 && from_ts
.type
== ts
->type
)
4127 /* Do nothing. Constants of the same type are range-checked
4128 elsewhere. If a value too large for the target type is
4129 assigned, an error is generated. Not checking here avoids
4130 duplications of warnings/errors.
4131 If range checking was disabled, but -Wconversion enabled,
4132 a non range checked warning is generated below. */
4134 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
4136 /* Do nothing. This block exists only to simplify the other
4137 else-if expressions.
4138 LOGICAL <> LOGICAL no warning, independent of kind values
4139 LOGICAL <> INTEGER extension, warned elsewhere
4140 LOGICAL <> REAL invalid, error generated elsewhere
4141 LOGICAL <> COMPLEX invalid, error generated elsewhere */
4143 else if (from_ts
.type
== ts
->type
4144 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
4145 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
4146 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
4148 /* Larger kinds can hold values of smaller kinds without problems.
4149 Hence, only warn if target kind is smaller than the source
4150 kind - or if -Wconversion-extra is specified. */
4151 if (gfc_option
.warn_conversion_extra
)
4152 gfc_warning_now ("Conversion from %s to %s at %L",
4153 gfc_typename (&from_ts
), gfc_typename (ts
),
4155 else if (gfc_option
.warn_conversion
4156 && from_ts
.kind
> ts
->kind
)
4157 gfc_warning_now ("Possible change of value in conversion "
4158 "from %s to %s at %L", gfc_typename (&from_ts
),
4159 gfc_typename (ts
), &expr
->where
);
4161 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
4162 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
4163 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
4165 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4166 usually comes with a loss of information, regardless of kinds. */
4167 if (gfc_option
.warn_conversion_extra
4168 || gfc_option
.warn_conversion
)
4169 gfc_warning_now ("Possible change of value in conversion "
4170 "from %s to %s at %L", gfc_typename (&from_ts
),
4171 gfc_typename (ts
), &expr
->where
);
4173 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
4175 /* If HOLLERITH is involved, all bets are off. */
4176 if (gfc_option
.warn_conversion_extra
4177 || gfc_option
.warn_conversion
)
4178 gfc_warning_now ("Conversion from %s to %s at %L",
4179 gfc_typename (&from_ts
), gfc_typename (ts
),
4186 /* Insert a pre-resolved function call to the right function. */
4187 old_where
= expr
->where
;
4189 shape
= expr
->shape
;
4191 new_expr
= gfc_get_expr ();
4194 new_expr
= gfc_build_conversion (new_expr
);
4195 new_expr
->value
.function
.name
= sym
->lib_name
;
4196 new_expr
->value
.function
.isym
= sym
;
4197 new_expr
->where
= old_where
;
4198 new_expr
->rank
= rank
;
4199 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
4201 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
4202 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
4203 new_expr
->symtree
->n
.sym
->ts
= *ts
;
4204 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
4205 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
4206 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
4207 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
4208 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
4209 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
4210 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
4214 gfc_free (new_expr
);
4217 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
4218 && do_simplify (sym
, expr
) == FAILURE
)
4223 return FAILURE
; /* Error already generated in do_simplify() */
4231 gfc_error ("Can't convert %s to %s at %L",
4232 gfc_typename (&from_ts
), gfc_typename (ts
), &expr
->where
);
4236 gfc_internal_error ("Can't convert %s to %s at %L",
4237 gfc_typename (&from_ts
), gfc_typename (ts
),
4244 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
4246 gfc_intrinsic_sym
*sym
;
4252 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
4254 sym
= find_char_conv (&expr
->ts
, ts
);
4257 /* Insert a pre-resolved function call to the right function. */
4258 old_where
= expr
->where
;
4260 shape
= expr
->shape
;
4262 new_expr
= gfc_get_expr ();
4265 new_expr
= gfc_build_conversion (new_expr
);
4266 new_expr
->value
.function
.name
= sym
->lib_name
;
4267 new_expr
->value
.function
.isym
= sym
;
4268 new_expr
->where
= old_where
;
4269 new_expr
->rank
= rank
;
4270 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
4272 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
4273 new_expr
->symtree
->n
.sym
->ts
= *ts
;
4274 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
4275 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
4276 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
4277 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
4278 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
4279 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
4283 gfc_free (new_expr
);
4286 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
4287 && do_simplify (sym
, expr
) == FAILURE
)
4289 /* Error already generated in do_simplify() */
4297 /* Check if the passed name is name of an intrinsic (taking into account the
4298 current -std=* and -fall-intrinsic settings). If it is, see if we should
4299 warn about this as a user-procedure having the same name as an intrinsic
4300 (-Wintrinsic-shadow enabled) and do so if we should. */
4303 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
4305 gfc_intrinsic_sym
* isym
;
4307 /* If the warning is disabled, do nothing at all. */
4308 if (!gfc_option
.warn_intrinsic_shadow
)
4311 /* Try to find an intrinsic of the same name. */
4313 isym
= gfc_find_function (sym
->name
);
4315 isym
= gfc_find_subroutine (sym
->name
);
4317 /* If no intrinsic was found with this name or it's not included in the
4318 selected standard, everything's fine. */
4319 if (!isym
|| gfc_check_intrinsic_standard (isym
, NULL
, true,
4320 sym
->declared_at
) == FAILURE
)
4323 /* Emit the warning. */
4325 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4326 " name. In order to call the intrinsic, explicit INTRINSIC"
4327 " declarations may be required.",
4328 sym
->name
, &sym
->declared_at
);
4330 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4331 " only be called via an explicit interface or if declared"
4332 " EXTERNAL.", sym
->name
, &sym
->declared_at
);