1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000-2022 Free Software Foundation, Inc.
4 Contributed by Andy Vaught & Katherine Holcomb
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
24 #include "coretypes.h"
27 #include "intrinsic.h"
29 /* Namespace to hold the resolved symbols for intrinsic subroutines. */
30 static gfc_namespace
*gfc_intrinsic_namespace
;
32 bool gfc_init_expr_flag
= false;
34 /* Pointers to an intrinsic function and its argument names that are being
37 const char *gfc_current_intrinsic
;
38 gfc_intrinsic_arg
*gfc_current_intrinsic_arg
[MAX_INTRINSIC_ARGS
];
39 locus
*gfc_current_intrinsic_where
;
41 static gfc_intrinsic_sym
*functions
, *subroutines
, *conversion
, *next_sym
;
42 static gfc_intrinsic_sym
*char_conversions
;
43 static gfc_intrinsic_arg
*next_arg
;
45 static int nfunc
, nsub
, nargs
, nconv
, ncharconv
;
48 { SZ_NOTHING
= 0, SZ_SUBS
, SZ_FUNCS
, SZ_CONVS
}
52 { CLASS_IMPURE
= 0, CLASS_PURE
, CLASS_ELEMENTAL
,
53 CLASS_INQUIRY
, CLASS_TRANSFORMATIONAL
, CLASS_ATOMIC
};
62 /* Return a letter based on the passed type. Used to construct the
63 name of a type-dependent subroutine. If logical_equals_int is
64 true, we can treat a logical like an int. */
67 gfc_type_letter (bt type
, bool logical_equals_int
)
74 if (logical_equals_int
)
106 /* Return kind that should be used for ABI purposes in libgfortran
107 APIs. Usually the same as ts->kind, except for BT_REAL/BT_COMPLEX
108 for IEEE 754 quad format kind 16 where it returns 17. */
111 gfc_type_abi_kind (bt type
, int kind
)
118 for (int i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
119 if (gfc_real_kinds
[i
].kind
== kind
)
120 return gfc_real_kinds
[i
].abi_kind
;
127 /* Get a symbol for a resolved name. Note, if needed be, the elemental
128 attribute has be added afterwards. */
131 gfc_get_intrinsic_sub_symbol (const char *name
)
135 gfc_get_symbol (name
, gfc_intrinsic_namespace
, &sym
);
136 sym
->attr
.always_explicit
= 1;
137 sym
->attr
.subroutine
= 1;
138 sym
->attr
.flavor
= FL_PROCEDURE
;
139 sym
->attr
.proc
= PROC_INTRINSIC
;
141 gfc_commit_symbol (sym
);
146 /* Get a symbol for a resolved function, with its special name. The
147 actual argument list needs to be set by the caller. */
150 gfc_get_intrinsic_function_symbol (gfc_expr
*expr
)
154 gfc_get_symbol (expr
->value
.function
.name
, gfc_intrinsic_namespace
, &sym
);
155 sym
->attr
.external
= 1;
156 sym
->attr
.function
= 1;
157 sym
->attr
.always_explicit
= 1;
158 sym
->attr
.proc
= PROC_INTRINSIC
;
159 sym
->attr
.flavor
= FL_PROCEDURE
;
163 sym
->attr
.dimension
= 1;
164 sym
->as
= gfc_get_array_spec ();
165 sym
->as
->type
= AS_ASSUMED_SHAPE
;
166 sym
->as
->rank
= expr
->rank
;
171 /* Find a symbol for a resolved intrinsic procedure, return NULL if
175 gfc_find_intrinsic_symbol (gfc_expr
*expr
)
178 gfc_find_symbol (expr
->value
.function
.name
, gfc_intrinsic_namespace
,
184 /* Return a pointer to the name of a conversion function given two
188 conv_name (gfc_typespec
*from
, gfc_typespec
*to
)
190 return gfc_get_string ("__convert_%c%d_%c%d",
191 gfc_type_letter (from
->type
), gfc_type_abi_kind (from
),
192 gfc_type_letter (to
->type
), gfc_type_abi_kind (to
));
196 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
197 corresponds to the conversion. Returns NULL if the conversion
200 static gfc_intrinsic_sym
*
201 find_conv (gfc_typespec
*from
, gfc_typespec
*to
)
203 gfc_intrinsic_sym
*sym
;
207 target
= conv_name (from
, to
);
210 for (i
= 0; i
< nconv
; i
++, sym
++)
211 if (target
== sym
->name
)
218 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
219 that corresponds to the conversion. Returns NULL if the conversion
222 static gfc_intrinsic_sym
*
223 find_char_conv (gfc_typespec
*from
, gfc_typespec
*to
)
225 gfc_intrinsic_sym
*sym
;
229 target
= conv_name (from
, to
);
230 sym
= char_conversions
;
232 for (i
= 0; i
< ncharconv
; i
++, sym
++)
233 if (target
== sym
->name
)
240 /* Check TS29113, C407b for assumed type and C535b for assumed-rank,
241 and a likewise check for NO_ARG_CHECK. */
244 do_ts29113_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
246 gfc_actual_arglist
*a
;
249 for (a
= arg
; a
; a
= a
->next
)
254 if (a
->expr
->expr_type
== EXPR_VARIABLE
255 && (a
->expr
->symtree
->n
.sym
->attr
.ext_attr
256 & (1 << EXT_ATTR_NO_ARG_CHECK
))
257 && specific
->id
!= GFC_ISYM_C_LOC
258 && specific
->id
!= GFC_ISYM_PRESENT
)
260 gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
261 "permitted as argument to the intrinsic functions "
262 "C_LOC and PRESENT", &a
->expr
->where
);
265 else if (a
->expr
->ts
.type
== BT_ASSUMED
266 && specific
->id
!= GFC_ISYM_LBOUND
267 && specific
->id
!= GFC_ISYM_PRESENT
268 && specific
->id
!= GFC_ISYM_RANK
269 && specific
->id
!= GFC_ISYM_SHAPE
270 && specific
->id
!= GFC_ISYM_SIZE
271 && specific
->id
!= GFC_ISYM_SIZEOF
272 && specific
->id
!= GFC_ISYM_UBOUND
273 && specific
->id
!= GFC_ISYM_IS_CONTIGUOUS
274 && specific
->id
!= GFC_ISYM_C_LOC
)
276 gfc_error ("Assumed-type argument at %L is not permitted as actual"
277 " argument to the intrinsic %s", &a
->expr
->where
,
278 gfc_current_intrinsic
);
281 else if (a
->expr
->ts
.type
== BT_ASSUMED
&& a
!= arg
)
283 gfc_error ("Assumed-type argument at %L is only permitted as "
284 "first actual argument to the intrinsic %s",
285 &a
->expr
->where
, gfc_current_intrinsic
);
288 else if (a
->expr
->rank
== -1 && !specific
->inquiry
)
290 gfc_error ("Assumed-rank argument at %L is only permitted as actual "
291 "argument to intrinsic inquiry functions",
295 else if (a
->expr
->rank
== -1 && arg
!= a
)
297 gfc_error ("Assumed-rank argument at %L is only permitted as first "
298 "actual argument to the intrinsic inquiry function %s",
299 &a
->expr
->where
, gfc_current_intrinsic
);
308 /* Interface to the check functions. We break apart an argument list
309 and call the proper check function rather than forcing each
310 function to manipulate the argument list. */
313 do_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
315 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
318 return (*specific
->check
.f0
) ();
323 return (*specific
->check
.f1
) (a1
);
328 return (*specific
->check
.f2
) (a1
, a2
);
333 return (*specific
->check
.f3
) (a1
, a2
, a3
);
338 return (*specific
->check
.f4
) (a1
, a2
, a3
, a4
);
343 return (*specific
->check
.f5
) (a1
, a2
, a3
, a4
, a5
);
345 gfc_internal_error ("do_check(): too many args");
349 /*********** Subroutines to build the intrinsic list ****************/
351 /* Add a single intrinsic symbol to the current list.
354 char * name of function
355 int whether function is elemental
356 int If the function can be used as an actual argument [1]
357 bt return type of function
358 int kind of return type of function
359 int Fortran standard version
360 check pointer to check function
361 simplify pointer to simplification function
362 resolve pointer to resolution function
364 Optional arguments come in multiples of five:
365 char * name of argument
368 int arg optional flag (1=optional, 0=required)
369 sym_intent intent of argument
371 The sequence is terminated by a NULL name.
374 [1] Whether a function can or cannot be used as an actual argument is
375 determined by its presence on the 13.6 list in Fortran 2003. The
376 following intrinsics, which are GNU extensions, are considered allowed
377 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
378 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
381 add_sym (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
, int kind
,
382 int standard
, gfc_check_f check
, gfc_simplify_f simplify
,
383 gfc_resolve_f resolve
, ...)
385 char buf
[GFC_MAX_SYMBOL_LEN
+ 11]; /* 10 for '_gfortran_', 1 for '\0' */
386 int optional
, first_flag
;
401 next_sym
->name
= gfc_get_string ("%s", name
);
403 strcpy (buf
, "_gfortran_");
405 next_sym
->lib_name
= gfc_get_string ("%s", buf
);
407 next_sym
->pure
= (cl
!= CLASS_IMPURE
);
408 next_sym
->elemental
= (cl
== CLASS_ELEMENTAL
);
409 next_sym
->inquiry
= (cl
== CLASS_INQUIRY
);
410 next_sym
->transformational
= (cl
== CLASS_TRANSFORMATIONAL
);
411 next_sym
->actual_ok
= actual_ok
;
412 next_sym
->ts
.type
= type
;
413 next_sym
->ts
.kind
= kind
;
414 next_sym
->standard
= standard
;
415 next_sym
->simplify
= simplify
;
416 next_sym
->check
= check
;
417 next_sym
->resolve
= resolve
;
418 next_sym
->specific
= 0;
419 next_sym
->generic
= 0;
420 next_sym
->conversion
= 0;
425 gfc_internal_error ("add_sym(): Bad sizing mode");
428 va_start (argp
, resolve
);
434 name
= va_arg (argp
, char *);
438 type
= (bt
) va_arg (argp
, int);
439 kind
= va_arg (argp
, int);
440 optional
= va_arg (argp
, int);
441 intent
= (sym_intent
) va_arg (argp
, int);
443 if (sizing
!= SZ_NOTHING
)
450 next_sym
->formal
= next_arg
;
452 (next_arg
- 1)->next
= next_arg
;
456 strcpy (next_arg
->name
, name
);
457 next_arg
->ts
.type
= type
;
458 next_arg
->ts
.kind
= kind
;
459 next_arg
->optional
= optional
;
461 next_arg
->intent
= intent
;
471 /* Add a symbol to the function list where the function takes
475 add_sym_0 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
476 int kind
, int standard
,
477 bool (*check
) (void),
478 gfc_expr
*(*simplify
) (void),
479 void (*resolve
) (gfc_expr
*))
489 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
494 /* Add a symbol to the subroutine list where the subroutine takes
498 add_sym_0s (const char *name
, gfc_isym_id id
, int standard
,
499 void (*resolve
) (gfc_code
*))
509 add_sym (name
, id
, CLASS_IMPURE
, ACTUAL_NO
, BT_UNKNOWN
, 0, standard
, cf
, sf
,
514 /* Add a symbol to the function list where the function takes
518 add_sym_1 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
519 int kind
, int standard
,
520 bool (*check
) (gfc_expr
*),
521 gfc_expr
*(*simplify
) (gfc_expr
*),
522 void (*resolve
) (gfc_expr
*, gfc_expr
*),
523 const char *a1
, bt type1
, int kind1
, int optional1
)
533 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
534 a1
, type1
, kind1
, optional1
, INTENT_IN
,
539 /* Add a symbol to the function list where the function takes
540 1 arguments, specifying the intent of the argument. */
543 add_sym_1_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
544 int actual_ok
, bt type
, int kind
, int standard
,
545 bool (*check
) (gfc_expr
*),
546 gfc_expr
*(*simplify
) (gfc_expr
*),
547 void (*resolve
) (gfc_expr
*, gfc_expr
*),
548 const char *a1
, bt type1
, int kind1
, int optional1
,
559 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
560 a1
, type1
, kind1
, optional1
, intent1
,
565 /* Add a symbol to the subroutine list where the subroutine takes
566 1 arguments, specifying the intent of the argument. */
569 add_sym_1s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
570 int standard
, bool (*check
) (gfc_expr
*),
571 gfc_expr
*(*simplify
) (gfc_expr
*), void (*resolve
) (gfc_code
*),
572 const char *a1
, bt type1
, int kind1
, int optional1
,
583 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
584 a1
, type1
, kind1
, optional1
, intent1
,
588 /* Add a symbol to the subroutine ilst where the subroutine takes one
589 printf-style character argument and a variable number of arguments
593 add_sym_1p (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
594 int standard
, bool (*check
) (gfc_actual_arglist
*),
595 gfc_expr
*(*simplify
) (gfc_expr
*), void (*resolve
) (gfc_code
*),
596 const char *a1
, bt type1
, int kind1
, int optional1
, sym_intent intent1
)
606 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
607 a1
, type1
, kind1
, optional1
, intent1
,
612 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
613 function. MAX et al take 2 or more arguments. */
616 add_sym_1m (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
617 int kind
, int standard
,
618 bool (*check
) (gfc_actual_arglist
*),
619 gfc_expr
*(*simplify
) (gfc_expr
*),
620 void (*resolve
) (gfc_expr
*, gfc_actual_arglist
*),
621 const char *a1
, bt type1
, int kind1
, int optional1
,
622 const char *a2
, bt type2
, int kind2
, int optional2
)
632 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
633 a1
, type1
, kind1
, optional1
, INTENT_IN
,
634 a2
, type2
, kind2
, optional2
, INTENT_IN
,
639 /* Add a symbol to the function list where the function takes
643 add_sym_2 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
644 int kind
, int standard
,
645 bool (*check
) (gfc_expr
*, gfc_expr
*),
646 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
647 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
648 const char *a1
, bt type1
, int kind1
, int optional1
,
649 const char *a2
, bt type2
, int kind2
, int optional2
)
659 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
660 a1
, type1
, kind1
, optional1
, INTENT_IN
,
661 a2
, type2
, kind2
, optional2
, INTENT_IN
,
666 /* Add a symbol to the function list where the function takes
667 2 arguments; same as add_sym_2 - but allows to specify the intent. */
670 add_sym_2_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
671 int actual_ok
, bt type
, int kind
, int standard
,
672 bool (*check
) (gfc_expr
*, gfc_expr
*),
673 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
674 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
675 const char *a1
, bt type1
, int kind1
, int optional1
,
676 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
677 int optional2
, sym_intent intent2
)
687 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
688 a1
, type1
, kind1
, optional1
, intent1
,
689 a2
, type2
, kind2
, optional2
, intent2
,
694 /* Add a symbol to the subroutine list where the subroutine takes
695 2 arguments, specifying the intent of the arguments. */
698 add_sym_2s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
699 int kind
, int standard
,
700 bool (*check
) (gfc_expr
*, gfc_expr
*),
701 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
702 void (*resolve
) (gfc_code
*),
703 const char *a1
, bt type1
, int kind1
, int optional1
,
704 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
705 int optional2
, sym_intent intent2
)
715 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
716 a1
, type1
, kind1
, optional1
, intent1
,
717 a2
, type2
, kind2
, optional2
, intent2
,
722 /* Add a symbol to the function list where the function takes
726 add_sym_3 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
727 int kind
, int standard
,
728 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
729 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
730 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
731 const char *a1
, bt type1
, int kind1
, int optional1
,
732 const char *a2
, bt type2
, int kind2
, int optional2
,
733 const char *a3
, bt type3
, int kind3
, int optional3
)
743 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
744 a1
, type1
, kind1
, optional1
, INTENT_IN
,
745 a2
, type2
, kind2
, optional2
, INTENT_IN
,
746 a3
, type3
, kind3
, optional3
, INTENT_IN
,
751 /* MINLOC and MAXLOC get special treatment because their
752 argument might have to be reordered. */
755 add_sym_5ml (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
756 int kind
, int standard
,
757 bool (*check
) (gfc_actual_arglist
*),
758 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
759 gfc_expr
*, gfc_expr
*),
760 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
761 gfc_expr
*, gfc_expr
*),
762 const char *a1
, bt type1
, int kind1
, int optional1
,
763 const char *a2
, bt type2
, int kind2
, int optional2
,
764 const char *a3
, bt type3
, int kind3
, int optional3
,
765 const char *a4
, bt type4
, int kind4
, int optional4
,
766 const char *a5
, bt type5
, int kind5
, int optional5
)
776 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
777 a1
, type1
, kind1
, optional1
, INTENT_IN
,
778 a2
, type2
, kind2
, optional2
, INTENT_IN
,
779 a3
, type3
, kind3
, optional3
, INTENT_IN
,
780 a4
, type4
, kind4
, optional4
, INTENT_IN
,
781 a5
, type5
, kind5
, optional5
, INTENT_IN
,
785 /* Similar for FINDLOC. */
788 add_sym_6fl (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
,
789 bt type
, int kind
, int standard
,
790 bool (*check
) (gfc_actual_arglist
*),
791 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
792 gfc_expr
*, gfc_expr
*, gfc_expr
*),
793 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
794 gfc_expr
*, gfc_expr
*, gfc_expr
*),
795 const char *a1
, bt type1
, int kind1
, int optional1
,
796 const char *a2
, bt type2
, int kind2
, int optional2
,
797 const char *a3
, bt type3
, int kind3
, int optional3
,
798 const char *a4
, bt type4
, int kind4
, int optional4
,
799 const char *a5
, bt type5
, int kind5
, int optional5
,
800 const char *a6
, bt type6
, int kind6
, int optional6
)
811 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
812 a1
, type1
, kind1
, optional1
, INTENT_IN
,
813 a2
, type2
, kind2
, optional2
, INTENT_IN
,
814 a3
, type3
, kind3
, optional3
, INTENT_IN
,
815 a4
, type4
, kind4
, optional4
, INTENT_IN
,
816 a5
, type5
, kind5
, optional5
, INTENT_IN
,
817 a6
, type6
, kind6
, optional6
, INTENT_IN
,
822 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
823 their argument also might have to be reordered. */
826 add_sym_3red (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
827 int kind
, int standard
,
828 bool (*check
) (gfc_actual_arglist
*),
829 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
830 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
831 const char *a1
, bt type1
, int kind1
, int optional1
,
832 const char *a2
, bt type2
, int kind2
, int optional2
,
833 const char *a3
, bt type3
, int kind3
, int optional3
)
843 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
844 a1
, type1
, kind1
, optional1
, INTENT_IN
,
845 a2
, type2
, kind2
, optional2
, INTENT_IN
,
846 a3
, type3
, kind3
, optional3
, INTENT_IN
,
851 /* Add a symbol to the subroutine list where the subroutine takes
852 3 arguments, specifying the intent of the arguments. */
855 add_sym_3s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
856 int kind
, int standard
,
857 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
858 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
859 void (*resolve
) (gfc_code
*),
860 const char *a1
, bt type1
, int kind1
, int optional1
,
861 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
862 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
863 int kind3
, int optional3
, sym_intent intent3
)
873 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
874 a1
, type1
, kind1
, optional1
, intent1
,
875 a2
, type2
, kind2
, optional2
, intent2
,
876 a3
, type3
, kind3
, optional3
, intent3
,
881 /* Add a symbol to the function list where the function takes
885 add_sym_4 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
886 int kind
, int standard
,
887 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
888 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
890 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
892 const char *a1
, bt type1
, int kind1
, int optional1
,
893 const char *a2
, bt type2
, int kind2
, int optional2
,
894 const char *a3
, bt type3
, int kind3
, int optional3
,
895 const char *a4
, bt type4
, int kind4
, int optional4
)
905 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
906 a1
, type1
, kind1
, optional1
, INTENT_IN
,
907 a2
, type2
, kind2
, optional2
, INTENT_IN
,
908 a3
, type3
, kind3
, optional3
, INTENT_IN
,
909 a4
, type4
, kind4
, optional4
, INTENT_IN
,
914 /* Add a symbol to the subroutine list where the subroutine takes
918 add_sym_4s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
920 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
921 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
923 void (*resolve
) (gfc_code
*),
924 const char *a1
, bt type1
, int kind1
, int optional1
,
925 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
926 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
927 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
928 bt type4
, int kind4
, int optional4
, sym_intent intent4
)
938 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
939 a1
, type1
, kind1
, optional1
, intent1
,
940 a2
, type2
, kind2
, optional2
, intent2
,
941 a3
, type3
, kind3
, optional3
, intent3
,
942 a4
, type4
, kind4
, optional4
, intent4
,
947 /* Add a symbol to the subroutine list where the subroutine takes
951 add_sym_5s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
953 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
955 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
956 gfc_expr
*, gfc_expr
*),
957 void (*resolve
) (gfc_code
*),
958 const char *a1
, bt type1
, int kind1
, int optional1
,
959 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
960 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
961 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
962 bt type4
, int kind4
, int optional4
, sym_intent intent4
,
963 const char *a5
, bt type5
, int kind5
, int optional5
,
974 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
975 a1
, type1
, kind1
, optional1
, intent1
,
976 a2
, type2
, kind2
, optional2
, intent2
,
977 a3
, type3
, kind3
, optional3
, intent3
,
978 a4
, type4
, kind4
, optional4
, intent4
,
979 a5
, type5
, kind5
, optional5
, intent5
,
984 /* Locate an intrinsic symbol given a base pointer, number of elements
985 in the table and a pointer to a name. Returns the NULL pointer if
986 a name is not found. */
988 static gfc_intrinsic_sym
*
989 find_sym (gfc_intrinsic_sym
*start
, int n
, const char *name
)
991 /* name may be a user-supplied string, so we must first make sure
992 that we're comparing against a pointer into the global string
994 const char *p
= gfc_get_string ("%s", name
);
998 if (p
== start
->name
)
1010 gfc_isym_id_by_intmod (intmod_id from_intmod
, int intmod_sym_id
)
1012 if (from_intmod
== INTMOD_NONE
)
1013 return (gfc_isym_id
) intmod_sym_id
;
1014 else if (from_intmod
== INTMOD_ISO_C_BINDING
)
1015 return (gfc_isym_id
) c_interop_kinds_table
[intmod_sym_id
].value
;
1016 else if (from_intmod
== INTMOD_ISO_FORTRAN_ENV
)
1017 switch (intmod_sym_id
)
1019 #define NAMED_SUBROUTINE(a,b,c,d) \
1021 return (gfc_isym_id) c;
1022 #define NAMED_FUNCTION(a,b,c,d) \
1024 return (gfc_isym_id) c;
1025 #include "iso-fortran-env.def"
1031 return (gfc_isym_id
) 0;
1036 gfc_isym_id_by_intmod_sym (gfc_symbol
*sym
)
1038 return gfc_isym_id_by_intmod (sym
->from_intmod
, sym
->intmod_sym_id
);
1043 gfc_intrinsic_subroutine_by_id (gfc_isym_id id
)
1045 gfc_intrinsic_sym
*start
= subroutines
;
1051 if (id
== start
->id
)
1061 gfc_intrinsic_function_by_id (gfc_isym_id id
)
1063 gfc_intrinsic_sym
*start
= functions
;
1069 if (id
== start
->id
)
1078 /* Given a name, find a function in the intrinsic function table.
1079 Returns NULL if not found. */
1082 gfc_find_function (const char *name
)
1084 gfc_intrinsic_sym
*sym
;
1086 sym
= find_sym (functions
, nfunc
, name
);
1087 if (!sym
|| sym
->from_module
)
1088 sym
= find_sym (conversion
, nconv
, name
);
1090 return (!sym
|| sym
->from_module
) ? NULL
: sym
;
1094 /* Given a name, find a function in the intrinsic subroutine table.
1095 Returns NULL if not found. */
1098 gfc_find_subroutine (const char *name
)
1100 gfc_intrinsic_sym
*sym
;
1101 sym
= find_sym (subroutines
, nsub
, name
);
1102 return (!sym
|| sym
->from_module
) ? NULL
: sym
;
1106 /* Given a string, figure out if it is the name of a generic intrinsic
1110 gfc_generic_intrinsic (const char *name
)
1112 gfc_intrinsic_sym
*sym
;
1114 sym
= gfc_find_function (name
);
1115 return (!sym
|| sym
->from_module
) ? 0 : sym
->generic
;
1119 /* Given a string, figure out if it is the name of a specific
1120 intrinsic function or not. */
1123 gfc_specific_intrinsic (const char *name
)
1125 gfc_intrinsic_sym
*sym
;
1127 sym
= gfc_find_function (name
);
1128 return (!sym
|| sym
->from_module
) ? 0 : sym
->specific
;
1132 /* Given a string, figure out if it is the name of an intrinsic function
1133 or subroutine allowed as an actual argument or not. */
1135 gfc_intrinsic_actual_ok (const char *name
, const bool subroutine_flag
)
1137 gfc_intrinsic_sym
*sym
;
1139 /* Intrinsic subroutines are not allowed as actual arguments. */
1140 if (subroutine_flag
)
1144 sym
= gfc_find_function (name
);
1145 return (sym
== NULL
) ? 0 : sym
->actual_ok
;
1150 /* Given a symbol, find out if it is (and is to be treated as) an intrinsic.
1151 If its name refers to an intrinsic, but this intrinsic is not included in
1152 the selected standard, this returns FALSE and sets the symbol's external
1156 gfc_is_intrinsic (gfc_symbol
* sym
, int subroutine_flag
, locus loc
)
1158 gfc_intrinsic_sym
* isym
;
1161 /* If INTRINSIC attribute is already known, return. */
1162 if (sym
->attr
.intrinsic
)
1165 /* Check for attributes which prevent the symbol from being INTRINSIC. */
1166 if (sym
->attr
.external
|| sym
->attr
.contained
1167 || sym
->attr
.if_source
== IFSRC_IFBODY
)
1170 if (subroutine_flag
)
1171 isym
= gfc_find_subroutine (sym
->name
);
1173 isym
= gfc_find_function (sym
->name
);
1175 /* No such intrinsic available at all? */
1179 /* See if this intrinsic is allowed in the current standard. */
1180 if (!gfc_check_intrinsic_standard (isym
, &symstd
, false, loc
)
1181 && !sym
->attr
.artificial
)
1183 if (sym
->attr
.proc
== PROC_UNKNOWN
&& warn_intrinsics_std
)
1184 gfc_warning_now (OPT_Wintrinsics_std
, "The intrinsic %qs at %L is not "
1185 "included in the selected standard but %s and %qs will"
1186 " be treated as if declared EXTERNAL. Use an"
1187 " appropriate %<-std=%>* option or define"
1188 " %<-fall-intrinsics%> to allow this intrinsic.",
1189 sym
->name
, &loc
, symstd
, sym
->name
);
1198 /* Collect a set of intrinsic functions into a generic collection.
1199 The first argument is the name of the generic function, which is
1200 also the name of a specific function. The rest of the specifics
1201 currently in the table are placed into the list of specific
1202 functions associated with that generic.
1205 FIXME: Remove the argument STANDARD if no regressions are
1206 encountered. Change all callers (approx. 360).
1210 make_generic (const char *name
, gfc_isym_id id
, int standard ATTRIBUTE_UNUSED
)
1212 gfc_intrinsic_sym
*g
;
1214 if (sizing
!= SZ_NOTHING
)
1217 g
= gfc_find_function (name
);
1219 gfc_internal_error ("make_generic(): Cannot find generic symbol %qs",
1222 gcc_assert (g
->id
== id
);
1226 if ((g
+ 1)->name
!= NULL
)
1227 g
->specific_head
= g
+ 1;
1230 while (g
->name
!= NULL
)
1242 /* Create a duplicate intrinsic function entry for the current
1243 function, the only differences being the alternate name and
1244 a different standard if necessary. Note that we use argument
1245 lists more than once, but all argument lists are freed as a
1249 make_alias (const char *name
, int standard
)
1262 next_sym
[0] = next_sym
[-1];
1263 next_sym
->name
= gfc_get_string ("%s", name
);
1264 next_sym
->standard
= standard
;
1274 /* Make the current subroutine noreturn. */
1277 make_noreturn (void)
1279 if (sizing
== SZ_NOTHING
)
1280 next_sym
[-1].noreturn
= 1;
1284 /* Mark current intrinsic as module intrinsic. */
1286 make_from_module (void)
1288 if (sizing
== SZ_NOTHING
)
1289 next_sym
[-1].from_module
= 1;
1293 /* Mark the current subroutine as having a variable number of
1299 if (sizing
== SZ_NOTHING
)
1300 next_sym
[-1].vararg
= 1;
1303 /* Set the attr.value of the current procedure. */
1306 set_attr_value (int n
, ...)
1308 gfc_intrinsic_arg
*arg
;
1312 if (sizing
!= SZ_NOTHING
)
1316 arg
= next_sym
[-1].formal
;
1318 for (i
= 0; i
< n
; i
++)
1320 gcc_assert (arg
!= NULL
);
1321 arg
->value
= va_arg (argp
, int);
1328 /* Add intrinsic functions. */
1331 add_functions (void)
1333 /* Argument names. These are used as argument keywords and so need to
1334 match the documentation. Please keep this list in sorted order. */
1336 *a
= "a", *a1
= "a1", *a2
= "a2", *ar
= "array", *b
= "b",
1337 *bck
= "back", *bd
= "boundary", *c
= "c", *c_ptr_1
= "c_ptr_1",
1338 *c_ptr_2
= "c_ptr_2", *ca
= "coarray", *com
= "command",
1339 *dist
= "distance", *dm
= "dim", *f
= "field", *failed
="failed",
1340 *fs
= "fsource", *han
= "handler", *i
= "i",
1341 *image
= "image", *j
= "j", *kind
= "kind",
1342 *l
= "l", *ln
= "len", *level
= "level", *m
= "matrix", *ma
= "matrix_a",
1343 *mb
= "matrix_b", *md
= "mode", *mo
= "mold", *msk
= "mask",
1344 *n
= "n", *ncopies
= "ncopies", *nm
= "name", *num
= "number",
1345 *ord
= "order", *p
= "p", *p1
= "path1", *p2
= "path2",
1346 *pad
= "pad", *pid
= "pid", *pos
= "pos", *pt
= "pointer",
1347 *r
= "r", *s
= "s", *set
= "set", *sh
= "shift", *shp
= "shape",
1348 *sig
= "sig", *src
= "source", *ssg
= "substring",
1349 *sta
= "string_a", *stb
= "string_b", *stg
= "string",
1350 *sub
= "sub", *sz
= "size", *tg
= "target", *team
= "team", *tm
= "time",
1351 *ts
= "tsource", *ut
= "unit", *v
= "vector", *va
= "vector_a",
1352 *vb
= "vector_b", *vl
= "values", *val
= "value", *x
= "x", *y
= "y",
1355 int di
, dr
, dd
, dl
, dc
, dz
, ii
;
1357 di
= gfc_default_integer_kind
;
1358 dr
= gfc_default_real_kind
;
1359 dd
= gfc_default_double_kind
;
1360 dl
= gfc_default_logical_kind
;
1361 dc
= gfc_default_character_kind
;
1362 dz
= gfc_default_complex_kind
;
1363 ii
= gfc_index_integer_kind
;
1365 add_sym_1 ("abs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1366 gfc_check_abs
, gfc_simplify_abs
, gfc_resolve_abs
,
1367 a
, BT_REAL
, dr
, REQUIRED
);
1369 if (flag_dec_intrinsic_ints
)
1371 make_alias ("babs", GFC_STD_GNU
);
1372 make_alias ("iiabs", GFC_STD_GNU
);
1373 make_alias ("jiabs", GFC_STD_GNU
);
1374 make_alias ("kiabs", GFC_STD_GNU
);
1377 add_sym_1 ("iabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1378 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1379 a
, BT_INTEGER
, di
, REQUIRED
);
1381 add_sym_1 ("dabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1382 gfc_check_fn_d
, gfc_simplify_abs
, gfc_resolve_abs
,
1383 a
, BT_REAL
, dd
, REQUIRED
);
1385 add_sym_1 ("cabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1386 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1387 a
, BT_COMPLEX
, dz
, REQUIRED
);
1389 add_sym_1 ("zabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1390 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1391 a
, BT_COMPLEX
, dd
, REQUIRED
);
1393 make_alias ("cdabs", GFC_STD_GNU
);
1395 make_generic ("abs", GFC_ISYM_ABS
, GFC_STD_F77
);
1397 /* The checking function for ACCESS is called gfc_check_access_func
1398 because the name gfc_check_access is already used in module.cc. */
1399 add_sym_2 ("access", GFC_ISYM_ACCESS
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1400 di
, GFC_STD_GNU
, gfc_check_access_func
, NULL
, gfc_resolve_access
,
1401 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1403 make_generic ("access", GFC_ISYM_ACCESS
, GFC_STD_GNU
);
1405 add_sym_2 ("achar", GFC_ISYM_ACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1406 BT_CHARACTER
, dc
, GFC_STD_F95
,
1407 gfc_check_achar
, gfc_simplify_achar
, gfc_resolve_achar
,
1408 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1410 make_generic ("achar", GFC_ISYM_ACHAR
, GFC_STD_F95
);
1412 add_sym_1 ("acos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1413 gfc_check_fn_rc2008
, gfc_simplify_acos
, gfc_resolve_acos
,
1414 x
, BT_REAL
, dr
, REQUIRED
);
1416 add_sym_1 ("dacos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1417 gfc_check_fn_d
, gfc_simplify_acos
, gfc_resolve_acos
,
1418 x
, BT_REAL
, dd
, REQUIRED
);
1420 make_generic ("acos", GFC_ISYM_ACOS
, GFC_STD_F77
);
1422 add_sym_1 ("acosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1423 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_acosh
,
1424 gfc_resolve_acosh
, x
, BT_REAL
, dr
, REQUIRED
);
1426 add_sym_1 ("dacosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1427 gfc_check_fn_d
, gfc_simplify_acosh
, gfc_resolve_acosh
,
1428 x
, BT_REAL
, dd
, REQUIRED
);
1430 make_generic ("acosh", GFC_ISYM_ACOSH
, GFC_STD_F2008
);
1432 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1433 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustl
,
1434 gfc_resolve_adjustl
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1436 make_generic ("adjustl", GFC_ISYM_ADJUSTL
, GFC_STD_F95
);
1438 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1439 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustr
,
1440 gfc_resolve_adjustr
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1442 make_generic ("adjustr", GFC_ISYM_ADJUSTR
, GFC_STD_F95
);
1444 add_sym_1 ("aimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1445 gfc_check_fn_c
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1446 z
, BT_COMPLEX
, dz
, REQUIRED
);
1448 make_alias ("imag", GFC_STD_GNU
);
1449 make_alias ("imagpart", GFC_STD_GNU
);
1451 add_sym_1 ("dimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1452 NULL
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1453 z
, BT_COMPLEX
, dd
, REQUIRED
);
1455 make_generic ("aimag", GFC_ISYM_AIMAG
, GFC_STD_F77
);
1457 add_sym_2 ("aint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1458 gfc_check_a_xkind
, gfc_simplify_aint
, gfc_resolve_aint
,
1459 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1461 add_sym_1 ("dint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1462 NULL
, gfc_simplify_dint
, gfc_resolve_dint
,
1463 a
, BT_REAL
, dd
, REQUIRED
);
1465 make_generic ("aint", GFC_ISYM_AINT
, GFC_STD_F77
);
1467 add_sym_2 ("all", GFC_ISYM_ALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1468 gfc_check_all_any
, gfc_simplify_all
, gfc_resolve_all
,
1469 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1471 make_generic ("all", GFC_ISYM_ALL
, GFC_STD_F95
);
1473 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1474 gfc_check_allocated
, NULL
, NULL
,
1475 ar
, BT_UNKNOWN
, 0, REQUIRED
);
1477 make_generic ("allocated", GFC_ISYM_ALLOCATED
, GFC_STD_F95
);
1479 add_sym_2 ("anint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1480 gfc_check_a_xkind
, gfc_simplify_anint
, gfc_resolve_anint
,
1481 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1483 add_sym_1 ("dnint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1484 NULL
, gfc_simplify_dnint
, gfc_resolve_dnint
,
1485 a
, BT_REAL
, dd
, REQUIRED
);
1487 make_generic ("anint", GFC_ISYM_ANINT
, GFC_STD_F77
);
1489 add_sym_2 ("any", GFC_ISYM_ANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1490 gfc_check_all_any
, gfc_simplify_any
, gfc_resolve_any
,
1491 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1493 make_generic ("any", GFC_ISYM_ANY
, GFC_STD_F95
);
1495 add_sym_1 ("asin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1496 gfc_check_fn_rc2008
, gfc_simplify_asin
, gfc_resolve_asin
,
1497 x
, BT_REAL
, dr
, REQUIRED
);
1499 add_sym_1 ("dasin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1500 gfc_check_fn_d
, gfc_simplify_asin
, gfc_resolve_asin
,
1501 x
, BT_REAL
, dd
, REQUIRED
);
1503 make_generic ("asin", GFC_ISYM_ASIN
, GFC_STD_F77
);
1505 add_sym_1 ("asinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1506 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_asinh
,
1507 gfc_resolve_asinh
, x
, BT_REAL
, dr
, REQUIRED
);
1509 add_sym_1 ("dasinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1510 gfc_check_fn_d
, gfc_simplify_asinh
, gfc_resolve_asinh
,
1511 x
, BT_REAL
, dd
, REQUIRED
);
1513 make_generic ("asinh", GFC_ISYM_ASINH
, GFC_STD_F2008
);
1515 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
,
1516 GFC_STD_F95
, gfc_check_associated
, NULL
, NULL
,
1517 pt
, BT_UNKNOWN
, 0, REQUIRED
, tg
, BT_UNKNOWN
, 0, OPTIONAL
);
1519 make_generic ("associated", GFC_ISYM_ASSOCIATED
, GFC_STD_F95
);
1521 add_sym_1 ("atan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1522 gfc_check_fn_rc2008
, gfc_simplify_atan
, gfc_resolve_atan
,
1523 x
, BT_REAL
, dr
, REQUIRED
);
1525 add_sym_1 ("datan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1526 gfc_check_fn_d
, gfc_simplify_atan
, gfc_resolve_atan
,
1527 x
, BT_REAL
, dd
, REQUIRED
);
1529 /* Two-argument version of atan, equivalent to atan2. */
1530 add_sym_2 ("atan", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F2008
,
1531 gfc_check_atan_2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1532 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1534 make_generic ("atan", GFC_ISYM_ATAN
, GFC_STD_F77
);
1536 add_sym_1 ("atanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1537 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_atanh
,
1538 gfc_resolve_atanh
, x
, BT_REAL
, dr
, REQUIRED
);
1540 add_sym_1 ("datanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1541 gfc_check_fn_d
, gfc_simplify_atanh
, gfc_resolve_atanh
,
1542 x
, BT_REAL
, dd
, REQUIRED
);
1544 make_generic ("atanh", GFC_ISYM_ATANH
, GFC_STD_F2008
);
1546 add_sym_2 ("atan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1547 gfc_check_atan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1548 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1550 add_sym_2 ("datan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1551 gfc_check_datan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1552 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1554 make_generic ("atan2", GFC_ISYM_ATAN2
, GFC_STD_F77
);
1556 /* Bessel and Neumann functions for G77 compatibility. */
1557 add_sym_1 ("besj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1558 gfc_check_fn_r
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1559 x
, BT_REAL
, dr
, REQUIRED
);
1561 make_alias ("bessel_j0", GFC_STD_F2008
);
1563 add_sym_1 ("dbesj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1564 gfc_check_fn_d
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1565 x
, BT_REAL
, dd
, REQUIRED
);
1567 make_generic ("bessel_j0", GFC_ISYM_J0
, GFC_STD_F2008
);
1569 add_sym_1 ("besj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1570 gfc_check_fn_r
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1571 x
, BT_REAL
, dr
, REQUIRED
);
1573 make_alias ("bessel_j1", GFC_STD_F2008
);
1575 add_sym_1 ("dbesj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1576 gfc_check_fn_d
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1577 x
, BT_REAL
, dd
, REQUIRED
);
1579 make_generic ("bessel_j1", GFC_ISYM_J1
, GFC_STD_F2008
);
1581 add_sym_2 ("besjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1582 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1583 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1585 make_alias ("bessel_jn", GFC_STD_F2008
);
1587 add_sym_2 ("dbesjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1588 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1589 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1591 add_sym_3 ("bessel_jn", GFC_ISYM_JN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1592 gfc_check_bessel_n2
, gfc_simplify_bessel_jn2
, gfc_resolve_bessel_n2
,
1593 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1594 x
, BT_REAL
, dr
, REQUIRED
);
1595 set_attr_value (3, true, true, true);
1597 make_generic ("bessel_jn", GFC_ISYM_JN
, GFC_STD_F2008
);
1599 add_sym_1 ("besy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1600 gfc_check_fn_r
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1601 x
, BT_REAL
, dr
, REQUIRED
);
1603 make_alias ("bessel_y0", GFC_STD_F2008
);
1605 add_sym_1 ("dbesy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1606 gfc_check_fn_d
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1607 x
, BT_REAL
, dd
, REQUIRED
);
1609 make_generic ("bessel_y0", GFC_ISYM_Y0
, GFC_STD_F2008
);
1611 add_sym_1 ("besy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1612 gfc_check_fn_r
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1613 x
, BT_REAL
, dr
, REQUIRED
);
1615 make_alias ("bessel_y1", GFC_STD_F2008
);
1617 add_sym_1 ("dbesy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1618 gfc_check_fn_d
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1619 x
, BT_REAL
, dd
, REQUIRED
);
1621 make_generic ("bessel_y1", GFC_ISYM_Y1
, GFC_STD_F2008
);
1623 add_sym_2 ("besyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1624 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1625 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1627 make_alias ("bessel_yn", GFC_STD_F2008
);
1629 add_sym_2 ("dbesyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1630 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1631 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1633 add_sym_3 ("bessel_yn", GFC_ISYM_YN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1634 gfc_check_bessel_n2
, gfc_simplify_bessel_yn2
, gfc_resolve_bessel_n2
,
1635 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1636 x
, BT_REAL
, dr
, REQUIRED
);
1637 set_attr_value (3, true, true, true);
1639 make_generic ("bessel_yn", GFC_ISYM_YN
, GFC_STD_F2008
);
1641 add_sym_2 ("bge", GFC_ISYM_BGE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1642 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1643 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bge
, NULL
,
1644 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1646 make_generic ("bge", GFC_ISYM_BGE
, GFC_STD_F2008
);
1648 add_sym_2 ("bgt", GFC_ISYM_BGT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1649 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1650 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bgt
, NULL
,
1651 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1653 make_generic ("bgt", GFC_ISYM_BGT
, GFC_STD_F2008
);
1655 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1656 gfc_check_i
, gfc_simplify_bit_size
, NULL
,
1657 i
, BT_INTEGER
, di
, REQUIRED
);
1659 make_generic ("bit_size", GFC_ISYM_BIT_SIZE
, GFC_STD_F95
);
1661 add_sym_2 ("ble", GFC_ISYM_BLE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1662 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1663 gfc_check_bge_bgt_ble_blt
, gfc_simplify_ble
, NULL
,
1664 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1666 make_generic ("ble", GFC_ISYM_BLE
, GFC_STD_F2008
);
1668 add_sym_2 ("blt", GFC_ISYM_BLT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1669 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1670 gfc_check_bge_bgt_ble_blt
, gfc_simplify_blt
, NULL
,
1671 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1673 make_generic ("blt", GFC_ISYM_BLT
, GFC_STD_F2008
);
1675 add_sym_2 ("btest", GFC_ISYM_BTEST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1676 gfc_check_bitfcn
, gfc_simplify_btest
, gfc_resolve_btest
,
1677 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1679 if (flag_dec_intrinsic_ints
)
1681 make_alias ("bbtest", GFC_STD_GNU
);
1682 make_alias ("bitest", GFC_STD_GNU
);
1683 make_alias ("bjtest", GFC_STD_GNU
);
1684 make_alias ("bktest", GFC_STD_GNU
);
1687 make_generic ("btest", GFC_ISYM_BTEST
, GFC_STD_F95
);
1689 add_sym_2 ("ceiling", GFC_ISYM_CEILING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1690 gfc_check_a_ikind
, gfc_simplify_ceiling
, gfc_resolve_ceiling
,
1691 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1693 make_generic ("ceiling", GFC_ISYM_CEILING
, GFC_STD_F95
);
1695 add_sym_2 ("char", GFC_ISYM_CHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F77
,
1696 gfc_check_char
, gfc_simplify_char
, gfc_resolve_char
,
1697 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1699 make_generic ("char", GFC_ISYM_CHAR
, GFC_STD_F77
);
1701 add_sym_1 ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
1702 GFC_STD_GNU
, gfc_check_chdir
, NULL
, gfc_resolve_chdir
,
1703 nm
, BT_CHARACTER
, dc
, REQUIRED
);
1705 make_generic ("chdir", GFC_ISYM_CHDIR
, GFC_STD_GNU
);
1707 add_sym_2 ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1708 di
, GFC_STD_GNU
, gfc_check_chmod
, NULL
, gfc_resolve_chmod
,
1709 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1711 make_generic ("chmod", GFC_ISYM_CHMOD
, GFC_STD_GNU
);
1713 add_sym_3 ("cmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1714 gfc_check_cmplx
, gfc_simplify_cmplx
, gfc_resolve_cmplx
,
1715 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, OPTIONAL
,
1716 kind
, BT_INTEGER
, di
, OPTIONAL
);
1718 make_generic ("cmplx", GFC_ISYM_CMPLX
, GFC_STD_F77
);
1720 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
, CLASS_INQUIRY
,
1721 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
, NULL
, NULL
, NULL
);
1723 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
,
1726 add_sym_2 ("complex", GFC_ISYM_COMPLEX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_GNU
,
1727 gfc_check_complex
, gfc_simplify_complex
, gfc_resolve_complex
,
1728 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, REQUIRED
);
1730 make_generic ("complex", GFC_ISYM_COMPLEX
, GFC_STD_GNU
);
1732 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1733 complex instead of the default complex. */
1735 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1736 gfc_check_dcmplx
, gfc_simplify_dcmplx
, gfc_resolve_dcmplx
,
1737 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, OPTIONAL
);
1739 make_generic ("dcmplx", GFC_ISYM_CMPLX
, GFC_STD_GNU
);
1741 add_sym_1 ("conjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1742 gfc_check_fn_c
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1743 z
, BT_COMPLEX
, dz
, REQUIRED
);
1745 add_sym_1 ("dconjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1746 NULL
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1747 z
, BT_COMPLEX
, dd
, REQUIRED
);
1749 make_generic ("conjg", GFC_ISYM_CONJG
, GFC_STD_F77
);
1751 add_sym_1 ("cos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1752 gfc_check_fn_rc
, gfc_simplify_cos
, gfc_resolve_cos
,
1753 x
, BT_REAL
, dr
, REQUIRED
);
1755 add_sym_1 ("dcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1756 gfc_check_fn_d
, gfc_simplify_cos
, gfc_resolve_cos
,
1757 x
, BT_REAL
, dd
, REQUIRED
);
1759 add_sym_1 ("ccos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1760 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1761 x
, BT_COMPLEX
, dz
, REQUIRED
);
1763 add_sym_1 ("zcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1764 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1765 x
, BT_COMPLEX
, dd
, REQUIRED
);
1767 make_alias ("cdcos", GFC_STD_GNU
);
1769 make_generic ("cos", GFC_ISYM_COS
, GFC_STD_F77
);
1771 add_sym_1 ("cosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1772 gfc_check_fn_rc2008
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1773 x
, BT_REAL
, dr
, REQUIRED
);
1775 add_sym_1 ("dcosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1776 gfc_check_fn_d
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1777 x
, BT_REAL
, dd
, REQUIRED
);
1779 make_generic ("cosh", GFC_ISYM_COSH
, GFC_STD_F77
);
1781 add_sym_3 ("count", GFC_ISYM_COUNT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1782 BT_INTEGER
, di
, GFC_STD_F95
,
1783 gfc_check_count
, gfc_simplify_count
, gfc_resolve_count
,
1784 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1785 kind
, BT_INTEGER
, di
, OPTIONAL
);
1787 make_generic ("count", GFC_ISYM_COUNT
, GFC_STD_F95
);
1789 add_sym_3 ("cshift", GFC_ISYM_CSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1790 BT_REAL
, dr
, GFC_STD_F95
,
1791 gfc_check_cshift
, gfc_simplify_cshift
, gfc_resolve_cshift
,
1792 ar
, BT_REAL
, dr
, REQUIRED
,
1793 sh
, BT_INTEGER
, di
, REQUIRED
,
1794 dm
, BT_INTEGER
, ii
, OPTIONAL
);
1796 make_generic ("cshift", GFC_ISYM_CSHIFT
, GFC_STD_F95
);
1798 add_sym_1 ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1799 0, GFC_STD_GNU
, gfc_check_ctime
, NULL
, gfc_resolve_ctime
,
1800 tm
, BT_INTEGER
, di
, REQUIRED
);
1802 make_generic ("ctime", GFC_ISYM_CTIME
, GFC_STD_GNU
);
1804 add_sym_1 ("dble", GFC_ISYM_DBLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
1805 gfc_check_dble
, gfc_simplify_dble
, gfc_resolve_dble
,
1806 a
, BT_REAL
, dr
, REQUIRED
);
1808 make_generic ("dble", GFC_ISYM_DBLE
, GFC_STD_F77
);
1810 add_sym_1 ("digits", GFC_ISYM_DIGITS
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1811 gfc_check_digits
, gfc_simplify_digits
, NULL
,
1812 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1814 make_generic ("digits", GFC_ISYM_DIGITS
, GFC_STD_F95
);
1816 add_sym_2 ("dim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1817 gfc_check_a_p
, gfc_simplify_dim
, gfc_resolve_dim
,
1818 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1820 add_sym_2 ("idim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1821 NULL
, gfc_simplify_dim
, gfc_resolve_dim
,
1822 x
, BT_INTEGER
, di
, REQUIRED
, y
, BT_INTEGER
, di
, REQUIRED
);
1824 add_sym_2 ("ddim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1825 gfc_check_x_yd
, gfc_simplify_dim
, gfc_resolve_dim
,
1826 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, REQUIRED
);
1828 make_generic ("dim", GFC_ISYM_DIM
, GFC_STD_F77
);
1830 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
1831 GFC_STD_F95
, gfc_check_dot_product
, gfc_simplify_dot_product
, gfc_resolve_dot_product
,
1832 va
, BT_REAL
, dr
, REQUIRED
, vb
, BT_REAL
, dr
, REQUIRED
);
1834 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT
, GFC_STD_F95
);
1836 add_sym_2 ("dprod", GFC_ISYM_DPROD
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1837 gfc_check_dprod
, gfc_simplify_dprod
, gfc_resolve_dprod
,
1838 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1840 make_generic ("dprod", GFC_ISYM_DPROD
, GFC_STD_F77
);
1842 add_sym_1 ("dreal", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1843 BT_REAL
, dd
, GFC_STD_GNU
, NULL
, gfc_simplify_dreal
, NULL
,
1844 a
, BT_COMPLEX
, dd
, REQUIRED
);
1846 make_generic ("dreal", GFC_ISYM_REAL
, GFC_STD_GNU
);
1848 add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1849 BT_INTEGER
, di
, GFC_STD_F2008
,
1850 gfc_check_dshift
, gfc_simplify_dshiftl
, gfc_resolve_dshift
,
1851 i
, BT_INTEGER
, di
, REQUIRED
,
1852 j
, BT_INTEGER
, di
, REQUIRED
,
1853 sh
, BT_INTEGER
, di
, REQUIRED
);
1855 make_generic ("dshiftl", GFC_ISYM_DSHIFTL
, GFC_STD_F2008
);
1857 add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1858 BT_INTEGER
, di
, GFC_STD_F2008
,
1859 gfc_check_dshift
, gfc_simplify_dshiftr
, gfc_resolve_dshift
,
1860 i
, BT_INTEGER
, di
, REQUIRED
,
1861 j
, BT_INTEGER
, di
, REQUIRED
,
1862 sh
, BT_INTEGER
, di
, REQUIRED
);
1864 make_generic ("dshiftr", GFC_ISYM_DSHIFTR
, GFC_STD_F2008
);
1866 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1867 gfc_check_eoshift
, gfc_simplify_eoshift
, gfc_resolve_eoshift
,
1868 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, ii
, REQUIRED
,
1869 bd
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1871 make_generic ("eoshift", GFC_ISYM_EOSHIFT
, GFC_STD_F95
);
1873 add_sym_1 ("epsilon", GFC_ISYM_EPSILON
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
,
1874 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_epsilon
, NULL
,
1875 x
, BT_REAL
, dr
, REQUIRED
);
1877 make_generic ("epsilon", GFC_ISYM_EPSILON
, GFC_STD_F95
);
1879 /* G77 compatibility for the ERF() and ERFC() functions. */
1880 add_sym_1 ("erf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1881 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erf
,
1882 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1884 add_sym_1 ("derf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1885 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erf
,
1886 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1888 make_generic ("erf", GFC_ISYM_ERF
, GFC_STD_F2008
);
1890 add_sym_1 ("erfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1891 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erfc
,
1892 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1894 add_sym_1 ("derfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1895 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erfc
,
1896 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1898 make_generic ("erfc", GFC_ISYM_ERFC
, GFC_STD_F2008
);
1900 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1901 BT_REAL
, dr
, GFC_STD_F2008
, gfc_check_fn_r
,
1902 gfc_simplify_erfc_scaled
, gfc_resolve_g77_math1
, x
, BT_REAL
,
1905 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, GFC_STD_F2008
);
1907 /* G77 compatibility */
1908 add_sym_1 ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1909 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1910 x
, BT_REAL
, 4, REQUIRED
);
1912 make_generic ("dtime", GFC_ISYM_DTIME
, GFC_STD_GNU
);
1914 add_sym_1 ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1915 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1916 x
, BT_REAL
, 4, REQUIRED
);
1918 make_generic ("etime", GFC_ISYM_ETIME
, GFC_STD_GNU
);
1920 add_sym_1 ("exp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1921 gfc_check_fn_rc
, gfc_simplify_exp
, gfc_resolve_exp
,
1922 x
, BT_REAL
, dr
, REQUIRED
);
1924 add_sym_1 ("dexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1925 gfc_check_fn_d
, gfc_simplify_exp
, gfc_resolve_exp
,
1926 x
, BT_REAL
, dd
, REQUIRED
);
1928 add_sym_1 ("cexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1929 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1930 x
, BT_COMPLEX
, dz
, REQUIRED
);
1932 add_sym_1 ("zexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1933 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1934 x
, BT_COMPLEX
, dd
, REQUIRED
);
1936 make_alias ("cdexp", GFC_STD_GNU
);
1938 make_generic ("exp", GFC_ISYM_EXP
, GFC_STD_F77
);
1940 add_sym_1 ("exponent", GFC_ISYM_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
1941 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_exponent
, gfc_resolve_exponent
,
1942 x
, BT_REAL
, dr
, REQUIRED
);
1944 make_generic ("exponent", GFC_ISYM_EXPONENT
, GFC_STD_F95
);
1946 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF
, CLASS_INQUIRY
,
1947 ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1948 gfc_check_same_type_as
, gfc_simplify_extends_type_of
,
1949 gfc_resolve_extends_type_of
,
1950 a
, BT_UNKNOWN
, 0, REQUIRED
,
1951 mo
, BT_UNKNOWN
, 0, REQUIRED
);
1953 add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES
, CLASS_TRANSFORMATIONAL
,
1954 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
1955 gfc_check_failed_or_stopped_images
,
1956 gfc_simplify_failed_or_stopped_images
,
1957 gfc_resolve_failed_images
, team
, BT_VOID
, di
, OPTIONAL
,
1958 kind
, BT_INTEGER
, di
, OPTIONAL
);
1960 add_sym_0 ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1961 dc
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_fdate
);
1963 make_generic ("fdate", GFC_ISYM_FDATE
, GFC_STD_GNU
);
1965 add_sym_2 ("floor", GFC_ISYM_FLOOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1966 gfc_check_a_ikind
, gfc_simplify_floor
, gfc_resolve_floor
,
1967 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1969 make_generic ("floor", GFC_ISYM_FLOOR
, GFC_STD_F95
);
1971 /* G77 compatible fnum */
1972 add_sym_1 ("fnum", GFC_ISYM_FNUM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1973 di
, GFC_STD_GNU
, gfc_check_fnum
, NULL
, gfc_resolve_fnum
,
1974 ut
, BT_INTEGER
, di
, REQUIRED
);
1976 make_generic ("fnum", GFC_ISYM_FNUM
, GFC_STD_GNU
);
1978 add_sym_1 ("fraction", GFC_ISYM_FRACTION
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1979 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_fraction
, gfc_resolve_fraction
,
1980 x
, BT_REAL
, dr
, REQUIRED
);
1982 make_generic ("fraction", GFC_ISYM_FRACTION
, GFC_STD_F95
);
1984 add_sym_2_intent ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
1985 BT_INTEGER
, di
, GFC_STD_GNU
,
1986 gfc_check_fstat
, NULL
, gfc_resolve_fstat
,
1987 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1988 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
1990 make_generic ("fstat", GFC_ISYM_FSTAT
, GFC_STD_GNU
);
1992 add_sym_1 ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1993 ii
, GFC_STD_GNU
, gfc_check_ftell
, NULL
, gfc_resolve_ftell
,
1994 ut
, BT_INTEGER
, di
, REQUIRED
);
1996 make_generic ("ftell", GFC_ISYM_FTELL
, GFC_STD_GNU
);
1998 add_sym_2_intent ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, ACTUAL_NO
,
1999 BT_INTEGER
, di
, GFC_STD_GNU
,
2000 gfc_check_fgetputc
, NULL
, gfc_resolve_fgetc
,
2001 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2002 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2004 make_generic ("fgetc", GFC_ISYM_FGETC
, GFC_STD_GNU
);
2006 add_sym_1_intent ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2007 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fget
,
2008 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2010 make_generic ("fget", GFC_ISYM_FGET
, GFC_STD_GNU
);
2012 add_sym_2 ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2013 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fputc
,
2014 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
2016 make_generic ("fputc", GFC_ISYM_FPUTC
, GFC_STD_GNU
);
2018 add_sym_1 ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2019 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fput
,
2020 c
, BT_CHARACTER
, dc
, REQUIRED
);
2022 make_generic ("fput", GFC_ISYM_FPUT
, GFC_STD_GNU
);
2024 add_sym_1 ("gamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
2025 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_gamma
,
2026 gfc_resolve_gamma
, x
, BT_REAL
, dr
, REQUIRED
);
2028 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2029 gfc_check_fn_d
, gfc_simplify_gamma
, gfc_resolve_gamma
,
2030 x
, BT_REAL
, dr
, REQUIRED
);
2032 make_generic ("gamma", GFC_ISYM_TGAMMA
, GFC_STD_F2008
);
2034 /* Unix IDs (g77 compatibility) */
2035 add_sym_1 ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2036 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getcwd
,
2037 c
, BT_CHARACTER
, dc
, REQUIRED
);
2039 make_generic ("getcwd", GFC_ISYM_GETCWD
, GFC_STD_GNU
);
2041 add_sym_0 ("getgid", GFC_ISYM_GETGID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2042 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getgid
);
2044 make_generic ("getgid", GFC_ISYM_GETGID
, GFC_STD_GNU
);
2046 add_sym_0 ("getpid", GFC_ISYM_GETPID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2047 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getpid
);
2049 make_generic ("getpid", GFC_ISYM_GETPID
, GFC_STD_GNU
);
2051 add_sym_1 ("get_team", GFC_ISYM_GET_TEAM
, CLASS_TRANSFORMATIONAL
,
2052 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2018
,
2053 gfc_check_get_team
, NULL
, gfc_resolve_get_team
,
2054 level
, BT_INTEGER
, di
, OPTIONAL
);
2056 add_sym_0 ("getuid", GFC_ISYM_GETUID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2057 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getuid
);
2059 make_generic ("getuid", GFC_ISYM_GETUID
, GFC_STD_GNU
);
2061 add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, ACTUAL_NO
,
2062 BT_INTEGER
, di
, GFC_STD_GNU
,
2063 gfc_check_hostnm
, NULL
, gfc_resolve_hostnm
,
2064 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2066 make_generic ("hostnm", GFC_ISYM_HOSTNM
, GFC_STD_GNU
);
2068 add_sym_1 ("huge", GFC_ISYM_HUGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2069 gfc_check_huge
, gfc_simplify_huge
, NULL
,
2070 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2072 make_generic ("huge", GFC_ISYM_HUGE
, GFC_STD_F95
);
2074 add_sym_2 ("hypot", GFC_ISYM_HYPOT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2075 BT_REAL
, dr
, GFC_STD_F2008
,
2076 gfc_check_hypot
, gfc_simplify_hypot
, gfc_resolve_hypot
,
2077 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
2079 make_generic ("hypot", GFC_ISYM_HYPOT
, GFC_STD_F2008
);
2081 add_sym_2 ("iachar", GFC_ISYM_IACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2082 BT_INTEGER
, di
, GFC_STD_F95
,
2083 gfc_check_ichar_iachar
, gfc_simplify_iachar
, gfc_resolve_iachar
,
2084 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2086 make_generic ("iachar", GFC_ISYM_IACHAR
, GFC_STD_F95
);
2088 add_sym_2 ("iand", GFC_ISYM_IAND
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2090 gfc_check_iand_ieor_ior
, gfc_simplify_iand
, gfc_resolve_iand
,
2091 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2093 if (flag_dec_intrinsic_ints
)
2095 make_alias ("biand", GFC_STD_GNU
);
2096 make_alias ("iiand", GFC_STD_GNU
);
2097 make_alias ("jiand", GFC_STD_GNU
);
2098 make_alias ("kiand", GFC_STD_GNU
);
2101 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
2103 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2104 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
2105 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2107 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
2109 add_sym_3red ("iall", GFC_ISYM_IALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2110 gfc_check_transf_bit_intrins
, gfc_simplify_iall
, gfc_resolve_iall
,
2111 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2112 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2114 make_generic ("iall", GFC_ISYM_IALL
, GFC_STD_F2008
);
2116 add_sym_3red ("iany", GFC_ISYM_IANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2117 gfc_check_transf_bit_intrins
, gfc_simplify_iany
, gfc_resolve_iany
,
2118 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2119 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2121 make_generic ("iany", GFC_ISYM_IANY
, GFC_STD_F2008
);
2123 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2124 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2126 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
2128 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2129 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
2130 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2132 if (flag_dec_intrinsic_ints
)
2134 make_alias ("bbclr", GFC_STD_GNU
);
2135 make_alias ("iibclr", GFC_STD_GNU
);
2136 make_alias ("jibclr", GFC_STD_GNU
);
2137 make_alias ("kibclr", GFC_STD_GNU
);
2140 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
2142 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2143 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
2144 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
2145 ln
, BT_INTEGER
, di
, REQUIRED
);
2147 if (flag_dec_intrinsic_ints
)
2149 make_alias ("bbits", GFC_STD_GNU
);
2150 make_alias ("iibits", GFC_STD_GNU
);
2151 make_alias ("jibits", GFC_STD_GNU
);
2152 make_alias ("kibits", GFC_STD_GNU
);
2155 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
2157 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2158 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
2159 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2161 if (flag_dec_intrinsic_ints
)
2163 make_alias ("bbset", GFC_STD_GNU
);
2164 make_alias ("iibset", GFC_STD_GNU
);
2165 make_alias ("jibset", GFC_STD_GNU
);
2166 make_alias ("kibset", GFC_STD_GNU
);
2169 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
2171 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2172 BT_INTEGER
, di
, GFC_STD_F77
,
2173 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
2174 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2176 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
2178 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2180 gfc_check_iand_ieor_ior
, gfc_simplify_ieor
, gfc_resolve_ieor
,
2181 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2183 if (flag_dec_intrinsic_ints
)
2185 make_alias ("bieor", GFC_STD_GNU
);
2186 make_alias ("iieor", GFC_STD_GNU
);
2187 make_alias ("jieor", GFC_STD_GNU
);
2188 make_alias ("kieor", GFC_STD_GNU
);
2191 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
2193 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2194 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
2195 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2197 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
2199 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2200 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
2202 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
2204 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2205 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
2206 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
2208 add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2209 BT_INTEGER
, di
, GFC_STD_F2018
, gfc_check_image_status
,
2210 gfc_simplify_image_status
, gfc_resolve_image_status
, image
,
2211 BT_INTEGER
, di
, REQUIRED
, team
, BT_VOID
, di
, OPTIONAL
);
2213 /* The resolution function for INDEX is called gfc_resolve_index_func
2214 because the name gfc_resolve_index is already used in resolve.cc. */
2215 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
2216 BT_INTEGER
, di
, GFC_STD_F77
,
2217 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
2218 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
2219 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2221 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
2223 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2224 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
2225 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2227 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2228 NULL
, gfc_simplify_ifix
, NULL
,
2229 a
, BT_REAL
, dr
, REQUIRED
);
2231 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2232 NULL
, gfc_simplify_idint
, NULL
,
2233 a
, BT_REAL
, dd
, REQUIRED
);
2235 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
2237 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2238 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
2239 a
, BT_REAL
, dr
, REQUIRED
);
2241 make_alias ("short", GFC_STD_GNU
);
2243 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
2245 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2246 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
2247 a
, BT_REAL
, dr
, REQUIRED
);
2249 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
2251 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2252 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
2253 a
, BT_REAL
, dr
, REQUIRED
);
2255 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
2257 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2259 gfc_check_iand_ieor_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
2260 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2262 if (flag_dec_intrinsic_ints
)
2264 make_alias ("bior", GFC_STD_GNU
);
2265 make_alias ("iior", GFC_STD_GNU
);
2266 make_alias ("jior", GFC_STD_GNU
);
2267 make_alias ("kior", GFC_STD_GNU
);
2270 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
2272 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2273 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
2274 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2276 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
2278 add_sym_3red ("iparity", GFC_ISYM_IPARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2279 gfc_check_transf_bit_intrins
, gfc_simplify_iparity
, gfc_resolve_iparity
,
2280 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2281 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2283 make_generic ("iparity", GFC_ISYM_IPARITY
, GFC_STD_F2008
);
2285 /* The following function is for G77 compatibility. */
2286 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2287 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
2288 i
, BT_INTEGER
, 4, OPTIONAL
);
2290 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
2292 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2293 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
2294 ut
, BT_INTEGER
, di
, REQUIRED
);
2296 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
2298 add_sym_1 ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS
, CLASS_INQUIRY
, ACTUAL_NO
,
2299 BT_LOGICAL
, dl
, GFC_STD_F2008
,
2300 gfc_check_is_contiguous
, gfc_simplify_is_contiguous
,
2301 gfc_resolve_is_contiguous
,
2302 ar
, BT_REAL
, dr
, REQUIRED
);
2304 make_generic ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS
, GFC_STD_F2008
);
2306 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
2307 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2308 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
2309 i
, BT_INTEGER
, 0, REQUIRED
);
2311 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
2313 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
2314 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2315 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
2316 i
, BT_INTEGER
, 0, REQUIRED
);
2318 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
2320 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2321 BT_LOGICAL
, dl
, GFC_STD_GNU
,
2322 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
2323 x
, BT_REAL
, 0, REQUIRED
);
2325 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
2327 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2328 BT_INTEGER
, di
, GFC_STD_GNU
,
2329 gfc_check_ishft
, gfc_simplify_rshift
, gfc_resolve_rshift
,
2330 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2332 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
2334 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2335 BT_INTEGER
, di
, GFC_STD_GNU
,
2336 gfc_check_ishft
, gfc_simplify_lshift
, gfc_resolve_lshift
,
2337 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2339 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
2341 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2342 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
2343 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2345 if (flag_dec_intrinsic_ints
)
2347 make_alias ("bshft", GFC_STD_GNU
);
2348 make_alias ("iishft", GFC_STD_GNU
);
2349 make_alias ("jishft", GFC_STD_GNU
);
2350 make_alias ("kishft", GFC_STD_GNU
);
2353 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
2355 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2356 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
2357 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
2358 sz
, BT_INTEGER
, di
, OPTIONAL
);
2360 if (flag_dec_intrinsic_ints
)
2362 make_alias ("bshftc", GFC_STD_GNU
);
2363 make_alias ("iishftc", GFC_STD_GNU
);
2364 make_alias ("jishftc", GFC_STD_GNU
);
2365 make_alias ("kishftc", GFC_STD_GNU
);
2368 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
2370 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2371 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, NULL
,
2372 pid
, BT_INTEGER
, di
, REQUIRED
, sig
, BT_INTEGER
, di
, REQUIRED
);
2374 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
2376 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2377 gfc_check_kind
, gfc_simplify_kind
, NULL
,
2378 x
, BT_REAL
, dr
, REQUIRED
);
2380 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
2382 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2383 BT_INTEGER
, di
, GFC_STD_F95
,
2384 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
2385 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
2386 kind
, BT_INTEGER
, di
, OPTIONAL
);
2388 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
2390 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2391 BT_INTEGER
, di
, GFC_STD_F2008
,
2392 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
2393 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2394 kind
, BT_INTEGER
, di
, OPTIONAL
);
2396 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
2398 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2399 BT_INTEGER
, di
, GFC_STD_F2008
,
2400 gfc_check_i
, gfc_simplify_leadz
, NULL
,
2401 i
, BT_INTEGER
, di
, REQUIRED
);
2403 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
2405 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
2406 BT_INTEGER
, di
, GFC_STD_F77
,
2407 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
2408 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2410 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
2412 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2413 BT_INTEGER
, di
, GFC_STD_F95
,
2414 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
2415 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2417 make_alias ("lnblnk", GFC_STD_GNU
);
2419 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
2421 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2423 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2424 x
, BT_REAL
, dr
, REQUIRED
);
2426 make_alias ("log_gamma", GFC_STD_F2008
);
2428 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2429 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2430 x
, BT_REAL
, dr
, REQUIRED
);
2432 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2433 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2434 x
, BT_REAL
, dr
, REQUIRED
);
2436 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2439 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2440 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2441 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2443 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2445 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2446 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2447 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2449 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2451 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2452 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2453 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2455 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2457 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2458 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2459 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2461 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2463 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2464 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2465 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2467 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2469 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2470 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2471 x
, BT_REAL
, dr
, REQUIRED
);
2473 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2474 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2475 x
, BT_REAL
, dr
, REQUIRED
);
2477 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2478 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2479 x
, BT_REAL
, dd
, REQUIRED
);
2481 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2482 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2483 x
, BT_COMPLEX
, dz
, REQUIRED
);
2485 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2486 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2487 x
, BT_COMPLEX
, dd
, REQUIRED
);
2489 make_alias ("cdlog", GFC_STD_GNU
);
2491 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2493 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2494 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2495 x
, BT_REAL
, dr
, REQUIRED
);
2497 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2498 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2499 x
, BT_REAL
, dr
, REQUIRED
);
2501 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2502 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2503 x
, BT_REAL
, dd
, REQUIRED
);
2505 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2507 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2508 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2509 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2511 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2513 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
2514 BT_INTEGER
, di
, GFC_STD_GNU
,
2515 gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2516 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2517 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2519 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2521 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2522 GFC_STD_GNU
, gfc_check_malloc
, NULL
, NULL
,
2523 sz
, BT_INTEGER
, di
, REQUIRED
);
2525 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2527 add_sym_2 ("maskl", GFC_ISYM_MASKL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2528 BT_INTEGER
, di
, GFC_STD_F2008
,
2529 gfc_check_mask
, gfc_simplify_maskl
, gfc_resolve_mask
,
2530 i
, BT_INTEGER
, di
, REQUIRED
,
2531 kind
, BT_INTEGER
, di
, OPTIONAL
);
2533 make_generic ("maskl", GFC_ISYM_MASKL
, GFC_STD_F2008
);
2535 add_sym_2 ("maskr", GFC_ISYM_MASKR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2536 BT_INTEGER
, di
, GFC_STD_F2008
,
2537 gfc_check_mask
, gfc_simplify_maskr
, gfc_resolve_mask
,
2538 i
, BT_INTEGER
, di
, REQUIRED
,
2539 kind
, BT_INTEGER
, di
, OPTIONAL
);
2541 make_generic ("maskr", GFC_ISYM_MASKR
, GFC_STD_F2008
);
2543 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2544 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2545 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2547 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2549 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2550 int(max). The max function must take at least two arguments. */
2552 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2553 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2554 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2556 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2557 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2558 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2560 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2561 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2562 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2564 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2565 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2566 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2568 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2569 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2570 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2572 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2573 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2574 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2576 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2578 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2579 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_maxexponent
, NULL
,
2580 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2582 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2584 add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2585 gfc_check_minloc_maxloc
, gfc_simplify_maxloc
, gfc_resolve_maxloc
,
2586 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2587 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2588 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2590 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2592 add_sym_6fl ("findloc", GFC_ISYM_FINDLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
2593 BT_INTEGER
, di
, GFC_STD_F2008
,
2594 gfc_check_findloc
, gfc_simplify_findloc
, gfc_resolve_findloc
,
2595 ar
, BT_REAL
, dr
, REQUIRED
, val
, BT_REAL
, dr
, REQUIRED
,
2596 dm
, BT_INTEGER
, ii
, OPTIONAL
, msk
, BT_LOGICAL
, dl
, OPTIONAL
,
2597 kind
, BT_INTEGER
, di
, OPTIONAL
, bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2599 make_generic ("findloc", GFC_ISYM_FINDLOC
, GFC_STD_F2008
);
2601 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2602 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2603 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2604 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2606 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2608 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2609 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2611 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2613 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2614 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2616 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2618 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2619 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2620 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2621 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2623 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2625 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2626 BT_INTEGER
, di
, GFC_STD_F2008
,
2627 gfc_check_merge_bits
, gfc_simplify_merge_bits
,
2628 gfc_resolve_merge_bits
,
2629 i
, BT_INTEGER
, di
, REQUIRED
,
2630 j
, BT_INTEGER
, di
, REQUIRED
,
2631 msk
, BT_INTEGER
, di
, REQUIRED
);
2633 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS
, GFC_STD_F2008
);
2635 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2638 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2639 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2640 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2642 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2643 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2644 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2646 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2647 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2648 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2650 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2651 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2652 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2654 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2655 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2656 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2658 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2659 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2660 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2662 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2664 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2665 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_minexponent
, NULL
,
2666 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2668 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2670 add_sym_5ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2671 gfc_check_minloc_maxloc
, gfc_simplify_minloc
, gfc_resolve_minloc
,
2672 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2673 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2674 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2676 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2678 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2679 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2680 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2681 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2683 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2685 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2686 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2687 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2689 if (flag_dec_intrinsic_ints
)
2691 make_alias ("bmod", GFC_STD_GNU
);
2692 make_alias ("imod", GFC_STD_GNU
);
2693 make_alias ("jmod", GFC_STD_GNU
);
2694 make_alias ("kmod", GFC_STD_GNU
);
2697 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2698 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2699 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2701 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2702 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2703 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2705 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2707 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2708 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2709 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2711 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2713 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2714 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2715 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2717 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2719 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2720 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2721 a
, BT_CHARACTER
, dc
, REQUIRED
);
2723 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2725 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2726 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2727 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2729 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2730 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2731 a
, BT_REAL
, dd
, REQUIRED
);
2733 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2735 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2736 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2737 i
, BT_INTEGER
, di
, REQUIRED
);
2739 if (flag_dec_intrinsic_ints
)
2741 make_alias ("bnot", GFC_STD_GNU
);
2742 make_alias ("inot", GFC_STD_GNU
);
2743 make_alias ("jnot", GFC_STD_GNU
);
2744 make_alias ("knot", GFC_STD_GNU
);
2747 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2749 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2750 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2751 x
, BT_REAL
, dr
, REQUIRED
,
2752 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2754 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2756 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2757 gfc_check_null
, gfc_simplify_null
, NULL
,
2758 mo
, BT_INTEGER
, di
, OPTIONAL
);
2760 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2762 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES
, CLASS_TRANSFORMATIONAL
,
2763 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2764 gfc_check_num_images
, gfc_simplify_num_images
, NULL
,
2765 dist
, BT_INTEGER
, di
, OPTIONAL
,
2766 failed
, BT_LOGICAL
, dl
, OPTIONAL
);
2768 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2769 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2770 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2771 v
, BT_REAL
, dr
, OPTIONAL
);
2773 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2776 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2777 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2778 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2779 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2781 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2783 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2784 BT_INTEGER
, di
, GFC_STD_F2008
,
2785 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2786 i
, BT_INTEGER
, di
, REQUIRED
);
2788 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2790 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2791 BT_INTEGER
, di
, GFC_STD_F2008
,
2792 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2793 i
, BT_INTEGER
, di
, REQUIRED
);
2795 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2797 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2798 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2799 x
, BT_UNKNOWN
, 0, REQUIRED
);
2801 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2803 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2804 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2805 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2807 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2809 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2810 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2811 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2812 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2814 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2816 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2817 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2818 x
, BT_UNKNOWN
, 0, REQUIRED
);
2820 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2822 /* The following function is for G77 compatibility. */
2823 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2824 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2825 i
, BT_INTEGER
, 4, OPTIONAL
);
2827 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2828 use slightly different shoddy multiplicative congruential PRNG. */
2829 make_alias ("ran", GFC_STD_GNU
);
2831 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2833 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2834 gfc_check_range
, gfc_simplify_range
, NULL
,
2835 x
, BT_REAL
, dr
, REQUIRED
);
2837 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2839 add_sym_1 ("rank", GFC_ISYM_RANK
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2840 GFC_STD_F2018
, gfc_check_rank
, gfc_simplify_rank
, gfc_resolve_rank
,
2841 a
, BT_REAL
, dr
, REQUIRED
);
2842 make_generic ("rank", GFC_ISYM_RANK
, GFC_STD_F2018
);
2844 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2845 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2846 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2848 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2850 /* This provides compatibility with g77. */
2851 add_sym_1 ("realpart", GFC_ISYM_REALPART
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2852 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2853 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2855 make_generic ("realpart", GFC_ISYM_REALPART
, GFC_STD_F77
);
2857 add_sym_1 ("float", GFC_ISYM_FLOAT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2858 gfc_check_float
, gfc_simplify_float
, NULL
,
2859 a
, BT_INTEGER
, di
, REQUIRED
);
2861 if (flag_dec_intrinsic_ints
)
2863 make_alias ("floati", GFC_STD_GNU
);
2864 make_alias ("floatj", GFC_STD_GNU
);
2865 make_alias ("floatk", GFC_STD_GNU
);
2868 make_generic ("float", GFC_ISYM_FLOAT
, GFC_STD_F77
);
2870 add_sym_1 ("dfloat", GFC_ISYM_DFLOAT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2871 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2872 a
, BT_REAL
, dr
, REQUIRED
);
2874 make_generic ("dfloat", GFC_ISYM_DFLOAT
, GFC_STD_F77
);
2876 add_sym_1 ("sngl", GFC_ISYM_SNGL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2877 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2878 a
, BT_REAL
, dd
, REQUIRED
);
2880 make_generic ("sngl", GFC_ISYM_SNGL
, GFC_STD_F77
);
2882 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2883 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2884 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2886 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2888 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2889 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2890 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2892 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2894 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2895 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2896 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2897 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2899 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2901 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
2902 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2903 x
, BT_REAL
, dr
, REQUIRED
);
2905 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2907 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2908 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2909 gfc_check_same_type_as
, gfc_simplify_same_type_as
, NULL
,
2910 a
, BT_UNKNOWN
, 0, REQUIRED
,
2911 b
, BT_UNKNOWN
, 0, REQUIRED
);
2913 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2914 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2915 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2917 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2919 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2920 BT_INTEGER
, di
, GFC_STD_F95
,
2921 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2922 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2923 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2925 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2927 /* Added for G77 compatibility garbage. */
2928 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2929 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2931 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2933 /* Added for G77 compatibility. */
2934 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2935 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2936 x
, BT_REAL
, dr
, REQUIRED
);
2938 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2940 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2941 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2942 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2943 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2945 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2947 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2948 GFC_STD_F95
, gfc_check_selected_int_kind
,
2949 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2951 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2953 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2954 GFC_STD_F95
, gfc_check_selected_real_kind
,
2955 gfc_simplify_selected_real_kind
, NULL
,
2956 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2957 "radix", BT_INTEGER
, di
, OPTIONAL
);
2959 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2961 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2962 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2963 gfc_resolve_set_exponent
,
2964 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2966 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2968 add_sym_2 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2969 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2970 src
, BT_REAL
, dr
, REQUIRED
,
2971 kind
, BT_INTEGER
, di
, OPTIONAL
);
2973 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2975 add_sym_2 ("shifta", GFC_ISYM_SHIFTA
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2976 BT_INTEGER
, di
, GFC_STD_F2008
,
2977 gfc_check_shift
, gfc_simplify_shifta
, gfc_resolve_shift
,
2978 i
, BT_INTEGER
, di
, REQUIRED
,
2979 sh
, BT_INTEGER
, di
, REQUIRED
);
2981 make_generic ("shifta", GFC_ISYM_SHIFTA
, GFC_STD_F2008
);
2983 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2984 BT_INTEGER
, di
, GFC_STD_F2008
,
2985 gfc_check_shift
, gfc_simplify_shiftl
, gfc_resolve_shift
,
2986 i
, BT_INTEGER
, di
, REQUIRED
,
2987 sh
, BT_INTEGER
, di
, REQUIRED
);
2989 make_generic ("shiftl", GFC_ISYM_SHIFTL
, GFC_STD_F2008
);
2991 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2992 BT_INTEGER
, di
, GFC_STD_F2008
,
2993 gfc_check_shift
, gfc_simplify_shiftr
, gfc_resolve_shift
,
2994 i
, BT_INTEGER
, di
, REQUIRED
,
2995 sh
, BT_INTEGER
, di
, REQUIRED
);
2997 make_generic ("shiftr", GFC_ISYM_SHIFTR
, GFC_STD_F2008
);
2999 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3000 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
3001 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
3003 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
3004 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
3005 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
3007 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3008 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
3009 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
3011 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
3013 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3014 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
3015 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_VOID
, 0, REQUIRED
);
3017 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
3019 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3020 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
3021 x
, BT_REAL
, dr
, REQUIRED
);
3023 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3024 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
3025 x
, BT_REAL
, dd
, REQUIRED
);
3027 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
3028 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
3029 x
, BT_COMPLEX
, dz
, REQUIRED
);
3031 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
3032 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
3033 x
, BT_COMPLEX
, dd
, REQUIRED
);
3035 make_alias ("cdsin", GFC_STD_GNU
);
3037 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
3039 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3040 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
3041 x
, BT_REAL
, dr
, REQUIRED
);
3043 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3044 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
3045 x
, BT_REAL
, dd
, REQUIRED
);
3047 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
3049 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
3050 BT_INTEGER
, di
, GFC_STD_F95
,
3051 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
3052 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3053 kind
, BT_INTEGER
, di
, OPTIONAL
);
3055 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
3057 /* Obtain the stride for a given dimensions; to be used only internally.
3058 "make_from_module" makes it inaccessible for external users. */
3059 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE
, CLASS_INQUIRY
, ACTUAL_NO
,
3060 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_GNU
,
3061 NULL
, NULL
, gfc_resolve_stride
,
3062 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
3065 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
3066 BT_INTEGER
, ii
, GFC_STD_GNU
,
3067 gfc_check_sizeof
, gfc_simplify_sizeof
, NULL
,
3068 x
, BT_UNKNOWN
, 0, REQUIRED
);
3070 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
3072 /* The following functions are part of ISO_C_BINDING. */
3073 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
,
3074 BT_LOGICAL
, dl
, GFC_STD_F2003
, gfc_check_c_associated
, NULL
, NULL
,
3075 c_ptr_1
, BT_VOID
, 0, REQUIRED
,
3076 c_ptr_2
, BT_VOID
, 0, OPTIONAL
);
3079 add_sym_1 ("c_loc", GFC_ISYM_C_LOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3080 BT_VOID
, 0, GFC_STD_F2003
,
3081 gfc_check_c_loc
, NULL
, gfc_resolve_c_loc
,
3082 x
, BT_UNKNOWN
, 0, REQUIRED
);
3085 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3086 BT_VOID
, 0, GFC_STD_F2003
,
3087 gfc_check_c_funloc
, NULL
, gfc_resolve_c_funloc
,
3088 x
, BT_UNKNOWN
, 0, REQUIRED
);
3091 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
3092 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_F2008
,
3093 gfc_check_c_sizeof
, gfc_simplify_sizeof
, NULL
,
3094 x
, BT_UNKNOWN
, 0, REQUIRED
);
3097 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
3098 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS
, CLASS_INQUIRY
,
3099 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3100 NULL
, gfc_simplify_compiler_options
, NULL
);
3103 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION
, CLASS_INQUIRY
,
3104 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3105 NULL
, gfc_simplify_compiler_version
, NULL
);
3108 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
3109 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_spacing
, gfc_resolve_spacing
,
3110 x
, BT_REAL
, dr
, REQUIRED
);
3112 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
3114 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3115 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
3116 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
3117 ncopies
, BT_INTEGER
, di
, REQUIRED
);
3119 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
3121 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3122 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3123 x
, BT_REAL
, dr
, REQUIRED
);
3125 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3126 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3127 x
, BT_REAL
, dd
, REQUIRED
);
3129 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
3130 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3131 x
, BT_COMPLEX
, dz
, REQUIRED
);
3133 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
3134 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3135 x
, BT_COMPLEX
, dd
, REQUIRED
);
3137 make_alias ("cdsqrt", GFC_STD_GNU
);
3139 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
3141 add_sym_2_intent ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
,
3142 BT_INTEGER
, di
, GFC_STD_GNU
,
3143 gfc_check_stat
, NULL
, gfc_resolve_stat
,
3144 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3145 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3147 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
3149 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES
, CLASS_TRANSFORMATIONAL
,
3150 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
3151 gfc_check_failed_or_stopped_images
,
3152 gfc_simplify_failed_or_stopped_images
,
3153 gfc_resolve_stopped_images
, team
, BT_VOID
, di
, OPTIONAL
,
3154 kind
, BT_INTEGER
, di
, OPTIONAL
);
3156 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
3157 BT_INTEGER
, di
, GFC_STD_F2008
,
3158 gfc_check_storage_size
, gfc_simplify_storage_size
,
3159 gfc_resolve_storage_size
,
3160 a
, BT_UNKNOWN
, 0, REQUIRED
,
3161 kind
, BT_INTEGER
, di
, OPTIONAL
);
3163 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3164 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
3165 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3166 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
3168 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
3170 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3171 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
3172 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
3174 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
3176 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3177 GFC_STD_GNU
, NULL
, NULL
, NULL
,
3178 com
, BT_CHARACTER
, dc
, REQUIRED
);
3180 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
3182 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3183 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
3184 x
, BT_REAL
, dr
, REQUIRED
);
3186 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3187 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
3188 x
, BT_REAL
, dd
, REQUIRED
);
3190 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
3192 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3193 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3194 x
, BT_REAL
, dr
, REQUIRED
);
3196 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3197 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3198 x
, BT_REAL
, dd
, REQUIRED
);
3200 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
3202 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER
, CLASS_TRANSFORMATIONAL
,
3203 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2018
,
3204 gfc_check_team_number
, NULL
, gfc_resolve_team_number
,
3205 team
, BT_DERIVED
, di
, OPTIONAL
);
3207 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
3208 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
3209 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3210 dist
, BT_INTEGER
, di
, OPTIONAL
);
3212 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3213 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
3215 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
3217 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3218 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
3220 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
3222 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3223 gfc_check_fn_r
, gfc_simplify_tiny
, NULL
, x
, BT_REAL
, dr
, REQUIRED
);
3225 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
3227 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3228 BT_INTEGER
, di
, GFC_STD_F2008
,
3229 gfc_check_i
, gfc_simplify_trailz
, NULL
,
3230 i
, BT_INTEGER
, di
, REQUIRED
);
3232 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
3234 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3235 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
3236 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
3237 sz
, BT_INTEGER
, di
, OPTIONAL
);
3239 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
3241 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3242 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
3243 m
, BT_REAL
, dr
, REQUIRED
);
3245 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
3247 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
3248 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
3249 stg
, BT_CHARACTER
, dc
, REQUIRED
);
3251 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
3253 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
3254 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
3255 ut
, BT_INTEGER
, di
, REQUIRED
);
3257 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
3259 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3260 BT_INTEGER
, di
, GFC_STD_F95
,
3261 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
3262 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3263 kind
, BT_INTEGER
, di
, OPTIONAL
);
3265 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
3267 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3268 BT_INTEGER
, di
, GFC_STD_F2008
,
3269 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
3270 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3271 kind
, BT_INTEGER
, di
, OPTIONAL
);
3273 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
3275 /* g77 compatibility for UMASK. */
3276 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3277 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
3278 msk
, BT_INTEGER
, di
, REQUIRED
);
3280 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
3282 /* g77 compatibility for UNLINK. */
3283 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3284 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
3285 "path", BT_CHARACTER
, dc
, REQUIRED
);
3287 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
3289 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3290 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
3291 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
3292 f
, BT_REAL
, dr
, REQUIRED
);
3294 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
3296 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3297 BT_INTEGER
, di
, GFC_STD_F95
,
3298 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
3299 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
3300 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
3302 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
3304 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
3305 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
3306 x
, BT_UNKNOWN
, 0, REQUIRED
);
3308 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
3311 /* The next of intrinsic subprogram are the degree trignometric functions.
3312 These were hidden behind the -fdec-math option, but are now simply
3313 included as extensions to the set of intrinsic subprograms. */
3315 add_sym_1 ("acosd", GFC_ISYM_ACOSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3316 BT_REAL
, dr
, GFC_STD_GNU
,
3317 gfc_check_fn_r
, gfc_simplify_acosd
, gfc_resolve_trigd
,
3318 x
, BT_REAL
, dr
, REQUIRED
);
3320 add_sym_1 ("dacosd", GFC_ISYM_ACOSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3321 BT_REAL
, dd
, GFC_STD_GNU
,
3322 gfc_check_fn_d
, gfc_simplify_acosd
, gfc_resolve_trigd
,
3323 x
, BT_REAL
, dd
, REQUIRED
);
3325 make_generic ("acosd", GFC_ISYM_ACOSD
, GFC_STD_GNU
);
3327 add_sym_1 ("asind", GFC_ISYM_ASIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3328 BT_REAL
, dr
, GFC_STD_GNU
,
3329 gfc_check_fn_r
, gfc_simplify_asind
, gfc_resolve_trigd
,
3330 x
, BT_REAL
, dr
, REQUIRED
);
3332 add_sym_1 ("dasind", GFC_ISYM_ASIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3333 BT_REAL
, dd
, GFC_STD_GNU
,
3334 gfc_check_fn_d
, gfc_simplify_asind
, gfc_resolve_trigd
,
3335 x
, BT_REAL
, dd
, REQUIRED
);
3337 make_generic ("asind", GFC_ISYM_ASIND
, GFC_STD_GNU
);
3339 add_sym_1 ("atand", GFC_ISYM_ATAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3340 BT_REAL
, dr
, GFC_STD_GNU
,
3341 gfc_check_fn_r
, gfc_simplify_atand
, gfc_resolve_trigd
,
3342 x
, BT_REAL
, dr
, REQUIRED
);
3344 add_sym_1 ("datand", GFC_ISYM_ATAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3345 BT_REAL
, dd
, GFC_STD_GNU
,
3346 gfc_check_fn_d
, gfc_simplify_atand
, gfc_resolve_trigd
,
3347 x
, BT_REAL
, dd
, REQUIRED
);
3349 make_generic ("atand", GFC_ISYM_ATAND
, GFC_STD_GNU
);
3351 add_sym_2 ("atan2d", GFC_ISYM_ATAN2D
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3352 BT_REAL
, dr
, GFC_STD_GNU
,
3353 gfc_check_atan2
, gfc_simplify_atan2d
, gfc_resolve_trigd2
,
3354 y
, BT_REAL
, dr
, REQUIRED
,
3355 x
, BT_REAL
, dr
, REQUIRED
);
3357 add_sym_2 ("datan2d", GFC_ISYM_ATAN2D
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3358 BT_REAL
, dd
, GFC_STD_GNU
,
3359 gfc_check_datan2
, gfc_simplify_atan2d
, gfc_resolve_trigd2
,
3360 y
, BT_REAL
, dd
, REQUIRED
,
3361 x
, BT_REAL
, dd
, REQUIRED
);
3363 make_generic ("atan2d", GFC_ISYM_ATAN2D
, GFC_STD_GNU
);
3365 add_sym_1 ("cosd", GFC_ISYM_COSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3366 BT_REAL
, dr
, GFC_STD_GNU
,
3367 gfc_check_fn_r
, gfc_simplify_cosd
, gfc_resolve_trigd
,
3368 x
, BT_REAL
, dr
, REQUIRED
);
3370 add_sym_1 ("dcosd", GFC_ISYM_COSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3371 BT_REAL
, dd
, GFC_STD_GNU
,
3372 gfc_check_fn_d
, gfc_simplify_cosd
, gfc_resolve_trigd
,
3373 x
, BT_REAL
, dd
, REQUIRED
);
3375 make_generic ("cosd", GFC_ISYM_COSD
, GFC_STD_GNU
);
3377 add_sym_1 ("cotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3378 BT_REAL
, dr
, GFC_STD_GNU
,
3379 gfc_check_fn_rc2008
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3380 x
, BT_REAL
, dr
, REQUIRED
);
3382 add_sym_1 ("dcotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3383 BT_REAL
, dd
, GFC_STD_GNU
,
3384 gfc_check_fn_d
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3385 x
, BT_REAL
, dd
, REQUIRED
);
3387 add_sym_1 ("ccotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3388 BT_COMPLEX
, dz
, GFC_STD_GNU
,
3389 NULL
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3390 x
, BT_COMPLEX
, dz
, REQUIRED
);
3392 add_sym_1 ("zcotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3393 BT_COMPLEX
, dd
, GFC_STD_GNU
,
3394 NULL
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3395 x
, BT_COMPLEX
, dd
, REQUIRED
);
3397 make_generic ("cotan", GFC_ISYM_COTAN
, GFC_STD_GNU
);
3399 add_sym_1 ("cotand", GFC_ISYM_COTAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3400 BT_REAL
, dr
, GFC_STD_GNU
,
3401 gfc_check_fn_r
, gfc_simplify_cotand
, gfc_resolve_trigd
,
3402 x
, BT_REAL
, dr
, REQUIRED
);
3404 add_sym_1 ("dcotand", GFC_ISYM_COTAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3405 BT_REAL
, dd
, GFC_STD_GNU
,
3406 gfc_check_fn_d
, gfc_simplify_cotand
, gfc_resolve_trigd
,
3407 x
, BT_REAL
, dd
, REQUIRED
);
3409 make_generic ("cotand", GFC_ISYM_COTAND
, GFC_STD_GNU
);
3411 add_sym_1 ("sind", GFC_ISYM_SIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3412 BT_REAL
, dr
, GFC_STD_GNU
,
3413 gfc_check_fn_r
, gfc_simplify_sind
, gfc_resolve_trigd
,
3414 x
, BT_REAL
, dr
, REQUIRED
);
3416 add_sym_1 ("dsind", GFC_ISYM_SIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3417 BT_REAL
, dd
, GFC_STD_GNU
,
3418 gfc_check_fn_d
, gfc_simplify_sind
, gfc_resolve_trigd
,
3419 x
, BT_REAL
, dd
, REQUIRED
);
3421 make_generic ("sind", GFC_ISYM_SIND
, GFC_STD_GNU
);
3423 add_sym_1 ("tand", GFC_ISYM_TAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3424 BT_REAL
, dr
, GFC_STD_GNU
,
3425 gfc_check_fn_r
, gfc_simplify_tand
, gfc_resolve_trigd
,
3426 x
, BT_REAL
, dr
, REQUIRED
);
3428 add_sym_1 ("dtand", GFC_ISYM_TAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3429 BT_REAL
, dd
, GFC_STD_GNU
,
3430 gfc_check_fn_d
, gfc_simplify_tand
, gfc_resolve_trigd
,
3431 x
, BT_REAL
, dd
, REQUIRED
);
3433 make_generic ("tand", GFC_ISYM_TAND
, GFC_STD_GNU
);
3435 /* The following function is internally used for coarray libray functions.
3436 "make_from_module" makes it inaccessible for external users. */
3437 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET
, CLASS_IMPURE
, ACTUAL_NO
,
3438 BT_REAL
, dr
, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3439 x
, BT_REAL
, dr
, REQUIRED
);
3444 /* Add intrinsic subroutines. */
3447 add_subroutines (void)
3449 /* Argument names. These are used as argument keywords and so need to
3450 match the documentation. Please keep this list in sorted order. */
3452 *a
= "a", *c_
= "c", *c
= "count", *cm
= "count_max", *com
= "command",
3453 *cr
= "count_rate", *dt
= "date", *errmsg
= "errmsg", *f
= "from",
3454 *fp
= "frompos", *gt
= "get", *h
= "harvest", *han
= "handler",
3455 *length
= "length", *ln
= "len", *md
= "mode", *msk
= "mask",
3456 *name
= "name", *num
= "number", *of
= "offset", *old
= "old",
3457 *p1
= "path1", *p2
= "path2", *pid
= "pid", *pos
= "pos",
3458 *pt
= "put", *ptr
= "ptr", *res
= "result",
3459 *result_image
= "result_image", *sec
= "seconds", *sig
= "sig",
3460 *st
= "status", *stat
= "stat", *sz
= "size", *t
= "to",
3461 *tm
= "time", *tp
= "topos", *trim_name
= "trim_name", *ut
= "unit",
3462 *val
= "value", *vl
= "values", *whence
= "whence", *zn
= "zone";
3464 int di
, dr
, dc
, dl
, ii
;
3466 di
= gfc_default_integer_kind
;
3467 dr
= gfc_default_real_kind
;
3468 dc
= gfc_default_character_kind
;
3469 dl
= gfc_default_logical_kind
;
3470 ii
= gfc_index_integer_kind
;
3472 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
3476 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF
, CLASS_ATOMIC
,
3477 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3478 gfc_check_atomic_def
, NULL
, gfc_resolve_atomic_def
,
3479 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3480 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3481 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3483 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF
, CLASS_ATOMIC
,
3484 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3485 gfc_check_atomic_ref
, NULL
, gfc_resolve_atomic_ref
,
3486 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3487 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3488 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3490 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS
, CLASS_ATOMIC
,
3491 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3492 gfc_check_atomic_cas
, NULL
, NULL
,
3493 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3494 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3495 "compare", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3496 "new", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3497 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3499 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD
, CLASS_ATOMIC
,
3500 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3501 gfc_check_atomic_op
, NULL
, NULL
,
3502 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3503 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3504 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3506 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND
, CLASS_ATOMIC
,
3507 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3508 gfc_check_atomic_op
, NULL
, NULL
,
3509 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3510 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3511 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3513 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR
, CLASS_ATOMIC
,
3514 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3515 gfc_check_atomic_op
, NULL
, NULL
,
3516 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3517 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3518 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3520 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR
, CLASS_ATOMIC
,
3521 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3522 gfc_check_atomic_op
, NULL
, NULL
,
3523 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3524 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3525 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3527 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD
, CLASS_ATOMIC
,
3528 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3529 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3530 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3531 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3532 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3533 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3535 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND
, CLASS_ATOMIC
,
3536 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3537 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3538 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3539 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3540 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3541 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3543 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR
, CLASS_ATOMIC
,
3544 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3545 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3546 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3547 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3548 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3549 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3551 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR
, CLASS_ATOMIC
,
3552 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3553 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3554 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3555 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3556 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3557 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3559 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE
, GFC_STD_GNU
, NULL
);
3561 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3562 GFC_STD_F95
, gfc_check_cpu_time
, NULL
, gfc_resolve_cpu_time
,
3563 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3565 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY
, CLASS_ATOMIC
,
3566 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3567 gfc_check_event_query
, NULL
, gfc_resolve_event_query
,
3568 "event", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3569 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3570 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3572 /* More G77 compatibility garbage. */
3573 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3574 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
3575 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3576 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3578 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3579 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
3580 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3582 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3583 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
3584 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3586 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3587 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
3588 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3589 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3591 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3592 GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
3593 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3594 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3596 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3597 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
3598 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3600 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3601 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
3602 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3603 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3605 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3606 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
3607 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3608 md
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3609 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3611 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
3612 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
3613 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3614 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3615 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3616 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3618 /* More G77 compatibility garbage. */
3619 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3620 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
3621 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3622 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3624 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3625 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
3626 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3627 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3629 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
3630 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
3631 NULL
, NULL
, gfc_resolve_execute_command_line
,
3632 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3633 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
3634 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
3635 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3636 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3638 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3639 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
3640 dt
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3642 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3643 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
3644 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3646 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3647 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
3648 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3649 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3651 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
3652 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3653 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3654 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3656 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
3657 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
3658 pos
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3659 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3661 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
3662 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
3663 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3665 /* F2003 commandline routines. */
3667 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
3668 BT_UNKNOWN
, 0, GFC_STD_F2003
,
3669 NULL
, NULL
, gfc_resolve_get_command
,
3670 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3671 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3672 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3674 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
3675 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
3676 gfc_resolve_get_command_argument
,
3677 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3678 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3679 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3680 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3682 /* F2003 subroutine to get environment variables. */
3684 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
3685 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
3686 NULL
, NULL
, gfc_resolve_get_environment_variable
,
3687 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3688 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3689 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3690 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3691 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
3693 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
, BT_UNKNOWN
, 0,
3695 gfc_check_move_alloc
, NULL
, NULL
,
3696 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
3697 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3699 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
3700 GFC_STD_F95
, gfc_check_mvbits
, NULL
, gfc_resolve_mvbits
,
3701 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3702 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3703 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3704 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3705 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3707 if (flag_dec_intrinsic_ints
)
3709 make_alias ("bmvbits", GFC_STD_GNU
);
3710 make_alias ("imvbits", GFC_STD_GNU
);
3711 make_alias ("jmvbits", GFC_STD_GNU
);
3712 make_alias ("kmvbits", GFC_STD_GNU
);
3715 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT
, CLASS_IMPURE
,
3716 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3717 gfc_check_random_init
, NULL
, gfc_resolve_random_init
,
3718 "repeatable", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
,
3719 "image_distinct", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
);
3721 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
3722 BT_UNKNOWN
, 0, GFC_STD_F95
,
3723 gfc_check_random_number
, NULL
, gfc_resolve_random_number
,
3724 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3726 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
3727 BT_UNKNOWN
, 0, GFC_STD_F95
,
3728 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
3729 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3730 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3731 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3733 /* The following subroutines are part of ISO_C_BINDING. */
3735 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3736 GFC_STD_F2003
, gfc_check_c_f_pointer
, NULL
, NULL
,
3737 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3738 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
,
3739 "shape", BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3742 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER
, CLASS_IMPURE
,
3743 BT_UNKNOWN
, 0, GFC_STD_F2003
, gfc_check_c_f_procpointer
,
3745 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3746 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3749 /* Internal subroutine for emitting a runtime error. */
3751 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR
, CLASS_IMPURE
,
3752 BT_UNKNOWN
, 0, GFC_STD_GNU
,
3753 gfc_check_fe_runtime_error
, NULL
, gfc_resolve_fe_runtime_error
,
3754 "msg", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3758 make_from_module ();
3760 /* Coarray collectives. */
3761 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST
, CLASS_IMPURE
,
3762 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3763 gfc_check_co_broadcast
, NULL
, NULL
,
3764 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3765 "source_image", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3766 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3767 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3769 add_sym_4s ("co_max", GFC_ISYM_CO_MAX
, CLASS_IMPURE
,
3770 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3771 gfc_check_co_minmax
, NULL
, NULL
,
3772 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3773 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3774 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3775 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3777 add_sym_4s ("co_min", GFC_ISYM_CO_MIN
, CLASS_IMPURE
,
3778 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3779 gfc_check_co_minmax
, NULL
, NULL
,
3780 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3781 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3782 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3783 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3785 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM
, CLASS_IMPURE
,
3786 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3787 gfc_check_co_sum
, NULL
, NULL
,
3788 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3789 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3790 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3791 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3793 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE
, CLASS_IMPURE
,
3794 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3795 gfc_check_co_reduce
, NULL
, NULL
,
3796 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3797 "operation", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3798 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3799 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3800 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3803 /* The following subroutine is internally used for coarray libray functions.
3804 "make_from_module" makes it inaccessible for external users. */
3805 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND
, CLASS_IMPURE
,
3806 BT_UNKNOWN
, 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3807 "x", BT_REAL
, dr
, REQUIRED
, INTENT_OUT
,
3808 "y", BT_REAL
, dr
, REQUIRED
, INTENT_IN
);
3812 /* More G77 compatibility garbage. */
3813 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3814 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
3815 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3816 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3817 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3819 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
3820 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
3821 "seed", BT_INTEGER
, 4, REQUIRED
, INTENT_IN
);
3823 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3824 gfc_check_exit
, NULL
, gfc_resolve_exit
,
3825 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3829 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3830 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
3831 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3832 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3833 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3835 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3836 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
3837 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3838 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3840 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3841 gfc_check_flush
, NULL
, gfc_resolve_flush
,
3842 ut
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3844 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3845 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
3846 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3847 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3848 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3850 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3851 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
3852 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3853 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3855 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3856 gfc_check_free
, NULL
, NULL
,
3857 ptr
, BT_INTEGER
, ii
, REQUIRED
, INTENT_INOUT
);
3859 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3860 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
3861 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3862 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3863 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3864 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3866 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3867 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
3868 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3869 of
, BT_INTEGER
, ii
, REQUIRED
, INTENT_OUT
);
3871 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3872 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
3873 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3874 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3876 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3877 gfc_check_kill_sub
, NULL
, NULL
,
3878 pid
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3879 sig
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3880 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3882 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3883 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
3884 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3885 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3886 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3888 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3889 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
3890 "string", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3892 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3893 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
3894 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3895 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3896 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3898 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3899 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
3900 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3902 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3903 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
3904 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3905 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3906 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3908 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3909 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
3910 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3911 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3912 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3914 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3915 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
3916 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3917 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3918 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3920 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3921 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3922 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3923 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3924 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3926 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3927 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3928 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3929 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3930 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3932 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3933 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3934 com
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3935 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3937 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3938 BT_UNKNOWN
, 0, GFC_STD_F95
,
3939 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3940 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3941 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3942 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3944 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3945 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3946 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3947 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3949 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3950 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3951 msk
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3952 old
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3954 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3955 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3956 "path", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3957 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3961 /* Add a function to the list of conversion symbols. */
3964 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3966 gfc_typespec from
, to
;
3967 gfc_intrinsic_sym
*sym
;
3969 if (sizing
== SZ_CONVS
)
3975 gfc_clear_ts (&from
);
3976 from
.type
= from_type
;
3977 from
.kind
= from_kind
;
3983 sym
= conversion
+ nconv
;
3985 sym
->name
= conv_name (&from
, &to
);
3986 sym
->lib_name
= sym
->name
;
3987 sym
->simplify
.cc
= gfc_convert_constant
;
3988 sym
->standard
= standard
;
3991 sym
->conversion
= 1;
3993 sym
->id
= GFC_ISYM_CONVERSION
;
3999 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
4000 functions by looping over the kind tables. */
4003 add_conversions (void)
4007 /* Integer-Integer conversions. */
4008 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4009 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
4014 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4015 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
4018 /* Integer-Real/Complex conversions. */
4019 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4020 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
4022 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4023 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4025 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
4026 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
4028 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4029 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4031 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
4032 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
4035 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
4037 /* Hollerith-Integer conversions. */
4038 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4039 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4040 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4041 /* Hollerith-Real conversions. */
4042 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4043 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4044 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4045 /* Hollerith-Complex conversions. */
4046 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4047 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4048 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4050 /* Hollerith-Character conversions. */
4051 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
4052 gfc_default_character_kind
, GFC_STD_LEGACY
);
4054 /* Hollerith-Logical conversions. */
4055 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
4056 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4057 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
4060 /* Real/Complex - Real/Complex conversions. */
4061 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4062 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
4066 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
4067 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4069 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
4070 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4073 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
4074 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4076 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
4077 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4080 /* Logical/Logical kind conversion. */
4081 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
4082 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
4087 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
4088 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
4091 /* Integer-Logical and Logical-Integer conversions. */
4092 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
4093 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
4094 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
4096 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4097 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
4098 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
4099 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4102 /* DEC legacy feature allows character conversions similar to Hollerith
4103 conversions - the character data will transferred on a byte by byte
4105 if (flag_dec_char_conversions
)
4107 /* Character-Integer conversions. */
4108 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4109 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4110 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4111 /* Character-Real conversions. */
4112 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4113 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4114 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4115 /* Character-Complex conversions. */
4116 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4117 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4118 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4119 /* Character-Logical conversions. */
4120 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
4121 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4122 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
4128 add_char_conversions (void)
4132 /* Count possible conversions. */
4133 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4134 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4138 /* Allocate memory. */
4139 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
4141 /* Add the conversions themselves. */
4143 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4144 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4146 gfc_typespec from
, to
;
4151 gfc_clear_ts (&from
);
4152 from
.type
= BT_CHARACTER
;
4153 from
.kind
= gfc_character_kinds
[i
].kind
;
4156 to
.type
= BT_CHARACTER
;
4157 to
.kind
= gfc_character_kinds
[j
].kind
;
4159 char_conversions
[n
].name
= conv_name (&from
, &to
);
4160 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
4161 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
4162 char_conversions
[n
].standard
= GFC_STD_F2003
;
4163 char_conversions
[n
].elemental
= 1;
4164 char_conversions
[n
].pure
= 1;
4165 char_conversions
[n
].conversion
= 0;
4166 char_conversions
[n
].ts
= to
;
4167 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
4174 /* Initialize the table of intrinsics. */
4176 gfc_intrinsic_init_1 (void)
4178 nargs
= nfunc
= nsub
= nconv
= 0;
4180 /* Create a namespace to hold the resolved intrinsic symbols. */
4181 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
4190 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
4191 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
4192 + sizeof (gfc_intrinsic_arg
) * nargs
);
4194 next_sym
= functions
;
4195 subroutines
= functions
+ nfunc
;
4197 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
4199 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
4201 sizing
= SZ_NOTHING
;
4208 /* Character conversion intrinsics need to be treated separately. */
4209 add_char_conversions ();
4214 gfc_intrinsic_done_1 (void)
4218 free (char_conversions
);
4219 gfc_free_namespace (gfc_intrinsic_namespace
);
4223 /******** Subroutines to check intrinsic interfaces ***********/
4225 /* Given a formal argument list, remove any NULL arguments that may
4226 have been left behind by a sort against some formal argument list. */
4229 remove_nullargs (gfc_actual_arglist
**ap
)
4231 gfc_actual_arglist
*head
, *tail
, *next
;
4235 for (head
= *ap
; head
; head
= next
)
4239 if (head
->expr
== NULL
&& !head
->label
)
4242 gfc_free_actual_arglist (head
);
4261 static gfc_dummy_arg
*
4262 get_intrinsic_dummy_arg (gfc_intrinsic_arg
*intrinsic
)
4264 gfc_dummy_arg
* const dummy_arg
= gfc_get_dummy_arg ();
4266 dummy_arg
->intrinsicness
= GFC_INTRINSIC_DUMMY_ARG
;
4267 dummy_arg
->u
.intrinsic
= intrinsic
;
4273 /* Given an actual arglist and a formal arglist, sort the actual
4274 arglist so that its arguments are in a one-to-one correspondence
4275 with the format arglist. Arguments that are not present are given
4276 a blank gfc_actual_arglist structure. If something is obviously
4277 wrong (say, a missing required argument) we abort sorting and
4281 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
4282 gfc_intrinsic_arg
*formal
, locus
*where
)
4284 gfc_actual_arglist
*actual
, *a
;
4285 gfc_intrinsic_arg
*f
;
4287 remove_nullargs (ap
);
4290 auto_vec
<gfc_intrinsic_arg
*> dummy_args
;
4291 auto_vec
<gfc_actual_arglist
*> ordered_actual_args
;
4293 for (f
= formal
; f
; f
= f
->next
)
4294 dummy_args
.safe_push (f
);
4296 ordered_actual_args
.safe_grow_cleared (dummy_args
.length (),
4302 if (f
== NULL
&& a
== NULL
) /* No arguments */
4305 /* ALLOCATED has two mutually exclusive keywords, but only one
4306 can be present at time and neither is optional. */
4307 if (strcmp (name
, "allocated") == 0)
4311 gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar "
4312 "allocatable entity", where
);
4318 if (strcmp (a
->name
, "scalar") == 0)
4322 if (a
->expr
->rank
!= 0)
4324 gfc_error ("Scalar entity required at %L", &a
->expr
->where
);
4329 else if (strcmp (a
->name
, "array") == 0)
4333 if (a
->expr
->rank
== 0)
4335 gfc_error ("Array entity required at %L", &a
->expr
->where
);
4342 gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
4343 a
->name
, name
, &a
->expr
->where
);
4349 for (int i
= 0;; i
++)
4350 { /* Put the nonkeyword arguments in a 1:1 correspondence */
4356 if (a
->name
!= NULL
)
4359 ordered_actual_args
[i
] = a
;
4369 gfc_error ("Too many arguments in call to %qs at %L", name
, where
);
4373 /* Associate the remaining actual arguments, all of which have
4374 to be keyword arguments. */
4375 for (; a
; a
= a
->next
)
4378 FOR_EACH_VEC_ELT (dummy_args
, idx
, f
)
4379 if (strcmp (a
->name
, f
->name
) == 0)
4384 if (a
->name
[0] == '%')
4385 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4386 "are not allowed in this context at %L", where
);
4388 gfc_error ("Cannot find keyword named %qs in call to %qs at %L",
4389 a
->name
, name
, where
);
4393 if (ordered_actual_args
[idx
] != NULL
)
4395 gfc_error ("Argument %qs appears twice in call to %qs at %L",
4396 f
->name
, name
, where
);
4399 ordered_actual_args
[idx
] = a
;
4403 /* At this point, all unmatched formal args must be optional. */
4405 FOR_EACH_VEC_ELT (dummy_args
, idx
, f
)
4407 if (ordered_actual_args
[idx
] == NULL
&& f
->optional
== 0)
4409 gfc_error ("Missing actual argument %qs in call to %qs at %L",
4410 f
->name
, name
, where
);
4416 /* Using the formal argument list, string the actual argument list
4417 together in a way that corresponds with the formal list. */
4420 FOR_EACH_VEC_ELT (dummy_args
, idx
, f
)
4422 a
= ordered_actual_args
[idx
];
4423 if (a
&& a
->label
!= NULL
)
4425 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
4430 a
= gfc_get_actual_arglist ();
4432 a
->associated_dummy
= get_intrinsic_dummy_arg (f
);
4441 actual
->next
= NULL
; /* End the sorted argument list. */
4447 /* Compare an actual argument list with an intrinsic's formal argument
4448 list. The lists are checked for agreement of type. We don't check
4449 for arrayness here. */
4452 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
4455 gfc_actual_arglist
*actual
;
4456 gfc_intrinsic_arg
*formal
;
4459 formal
= sym
->formal
;
4463 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
4467 if (actual
->expr
== NULL
)
4472 /* A kind of 0 means we don't check for kind. */
4474 ts
.kind
= actual
->expr
->ts
.kind
;
4476 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
4479 gfc_error ("In call to %qs at %L, type mismatch in argument "
4480 "%qs; pass %qs to %qs", gfc_current_intrinsic
,
4481 &actual
->expr
->where
,
4482 gfc_current_intrinsic_arg
[i
]->name
,
4483 gfc_typename (actual
->expr
),
4484 gfc_dummy_typename (&formal
->ts
));
4488 /* F2018, p. 328: An argument to an intrinsic procedure other than
4489 ASSOCIATED, NULL, or PRESENT shall be a data object. An EXPR_NULL
4490 is not a data object. */
4491 if (actual
->expr
->expr_type
== EXPR_NULL
4492 && (!(sym
->id
== GFC_ISYM_ASSOCIATED
4493 || sym
->id
== GFC_ISYM_NULL
4494 || sym
->id
== GFC_ISYM_PRESENT
)))
4496 gfc_invalid_null_arg (actual
->expr
);
4500 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4501 if (formal
->intent
== INTENT_INOUT
|| formal
->intent
== INTENT_OUT
)
4503 const char* context
= (error_flag
4504 ? _("actual argument to INTENT = OUT/INOUT")
4507 /* No pointer arguments for intrinsics. */
4508 if (!gfc_check_vardef_context (actual
->expr
, false, false, false, context
))
4517 /* Given a pointer to an intrinsic symbol and an expression node that
4518 represent the function call to that subroutine, figure out the type
4519 of the result. This may involve calling a resolution subroutine. */
4522 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4524 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4525 gfc_actual_arglist
*arg
;
4527 if (specific
->resolve
.f1
== NULL
)
4529 if (e
->value
.function
.name
== NULL
)
4530 e
->value
.function
.name
= specific
->lib_name
;
4532 if (e
->ts
.type
== BT_UNKNOWN
)
4533 e
->ts
= specific
->ts
;
4537 arg
= e
->value
.function
.actual
;
4539 /* Special case hacks for MIN and MAX. */
4540 if (specific
->resolve
.f1m
== gfc_resolve_max
4541 || specific
->resolve
.f1m
== gfc_resolve_min
)
4543 (*specific
->resolve
.f1m
) (e
, arg
);
4549 (*specific
->resolve
.f0
) (e
);
4558 (*specific
->resolve
.f1
) (e
, a1
);
4567 (*specific
->resolve
.f2
) (e
, a1
, a2
);
4576 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
4585 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
4594 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
4603 (*specific
->resolve
.f6
) (e
, a1
, a2
, a3
, a4
, a5
, a6
);
4607 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4611 /* Given an intrinsic symbol node and an expression node, call the
4612 simplification function (if there is one), perhaps replacing the
4613 expression with something simpler. We return false on an error
4614 of the simplification, true if the simplification worked, even
4615 if nothing has changed in the expression itself. */
4618 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4620 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4621 gfc_actual_arglist
*arg
;
4623 /* Max and min require special handling due to the variable number
4625 if (specific
->simplify
.f1
== gfc_simplify_min
)
4627 result
= gfc_simplify_min (e
);
4631 if (specific
->simplify
.f1
== gfc_simplify_max
)
4633 result
= gfc_simplify_max (e
);
4637 if (specific
->simplify
.f1
== NULL
)
4643 arg
= e
->value
.function
.actual
;
4647 result
= (*specific
->simplify
.f0
) ();
4654 if (specific
->simplify
.cc
== gfc_convert_constant
4655 || specific
->simplify
.cc
== gfc_convert_char_constant
)
4657 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
4662 result
= (*specific
->simplify
.f1
) (a1
);
4669 result
= (*specific
->simplify
.f2
) (a1
, a2
);
4676 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
4683 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
4690 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
4697 result
= (*specific
->simplify
.f6
)
4698 (a1
, a2
, a3
, a4
, a5
, a6
);
4701 ("do_simplify(): Too many args for intrinsic");
4709 if (result
== &gfc_bad_expr
)
4713 resolve_intrinsic (specific
, e
); /* Must call at run-time */
4716 result
->where
= e
->where
;
4717 gfc_replace_expr (e
, result
);
4724 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4725 error messages. This subroutine returns false if a subroutine
4726 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4727 list cannot match any intrinsic. */
4730 init_arglist (gfc_intrinsic_sym
*isym
)
4732 gfc_intrinsic_arg
*formal
;
4735 gfc_current_intrinsic
= isym
->name
;
4738 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
4740 if (i
>= MAX_INTRINSIC_ARGS
)
4741 gfc_internal_error ("init_arglist(): too many arguments");
4742 gfc_current_intrinsic_arg
[i
++] = formal
;
4747 /* Given a pointer to an intrinsic symbol and an expression consisting
4748 of a function call, see if the function call is consistent with the
4749 intrinsic's formal argument list. Return true if the expression
4750 and intrinsic match, false otherwise. */
4753 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
4755 gfc_actual_arglist
*arg
, **ap
;
4758 ap
= &expr
->value
.function
.actual
;
4760 init_arglist (specific
);
4762 /* Don't attempt to sort the argument list for min or max. */
4763 if (specific
->check
.f1m
== gfc_check_min_max
4764 || specific
->check
.f1m
== gfc_check_min_max_integer
4765 || specific
->check
.f1m
== gfc_check_min_max_real
4766 || specific
->check
.f1m
== gfc_check_min_max_double
)
4768 if (!do_ts29113_check (specific
, *ap
))
4770 return (*specific
->check
.f1m
) (*ap
);
4773 if (!sort_actual (specific
->name
, ap
, specific
->formal
, &expr
->where
))
4776 if (!do_ts29113_check (specific
, *ap
))
4779 if (specific
->check
.f5ml
== gfc_check_minloc_maxloc
)
4780 /* This is special because we might have to reorder the argument list. */
4781 t
= gfc_check_minloc_maxloc (*ap
);
4782 else if (specific
->check
.f6fl
== gfc_check_findloc
)
4783 t
= gfc_check_findloc (*ap
);
4784 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
4785 /* This is also special because we also might have to reorder the
4787 t
= gfc_check_minval_maxval (*ap
);
4788 else if (specific
->check
.f3red
== gfc_check_product_sum
)
4789 /* Same here. The difference to the previous case is that we allow a
4790 general numeric type. */
4791 t
= gfc_check_product_sum (*ap
);
4792 else if (specific
->check
.f3red
== gfc_check_transf_bit_intrins
)
4793 /* Same as for PRODUCT and SUM, but different checks. */
4794 t
= gfc_check_transf_bit_intrins (*ap
);
4797 if (specific
->check
.f1
== NULL
)
4799 t
= check_arglist (ap
, specific
, error_flag
);
4801 expr
->ts
= specific
->ts
;
4804 t
= do_check (specific
, *ap
);
4807 /* Check conformance of elemental intrinsics. */
4808 if (t
&& specific
->elemental
)
4811 gfc_expr
*first_expr
;
4812 arg
= expr
->value
.function
.actual
;
4814 /* There is no elemental intrinsic without arguments. */
4815 gcc_assert(arg
!= NULL
);
4816 first_expr
= arg
->expr
;
4818 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
4819 if (!gfc_check_conformance (first_expr
, arg
->expr
,
4820 _("arguments '%s' and '%s' for "
4822 gfc_current_intrinsic_arg
[0]->name
,
4823 gfc_current_intrinsic_arg
[n
]->name
,
4824 gfc_current_intrinsic
))
4829 remove_nullargs (ap
);
4835 /* Check whether an intrinsic belongs to whatever standard the user
4836 has chosen, taking also into account -fall-intrinsics. Here, no
4837 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4838 textual representation of the symbols standard status (like
4839 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4840 can be used to construct a detailed warning/error message in case of
4844 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
4845 const char** symstd
, bool silent
, locus where
)
4847 const char* symstd_msg
;
4849 /* For -fall-intrinsics, just succeed. */
4850 if (flag_all_intrinsics
)
4853 /* Find the symbol's standard message for later usage. */
4854 switch (isym
->standard
)
4857 symstd_msg
= _("available since Fortran 77");
4860 case GFC_STD_F95_OBS
:
4861 symstd_msg
= _("obsolescent in Fortran 95");
4864 case GFC_STD_F95_DEL
:
4865 symstd_msg
= _("deleted in Fortran 95");
4869 symstd_msg
= _("new in Fortran 95");
4873 symstd_msg
= _("new in Fortran 2003");
4877 symstd_msg
= _("new in Fortran 2008");
4881 symstd_msg
= _("new in Fortran 2018");
4885 symstd_msg
= _("a GNU Fortran extension");
4888 case GFC_STD_LEGACY
:
4889 symstd_msg
= _("for backward compatibility");
4893 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
4894 isym
->name
, isym
->standard
);
4897 /* If warning about the standard, warn and succeed. */
4898 if (gfc_option
.warn_std
& isym
->standard
)
4900 /* Do only print a warning if not a GNU extension. */
4901 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
4902 gfc_warning (0, "Intrinsic %qs (%s) used at %L",
4903 isym
->name
, symstd_msg
, &where
);
4908 /* If allowing the symbol's standard, succeed, too. */
4909 if (gfc_option
.allow_std
& isym
->standard
)
4912 /* Otherwise, fail. */
4914 *symstd
= symstd_msg
;
4919 /* See if a function call corresponds to an intrinsic function call.
4922 MATCH_YES if the call corresponds to an intrinsic, simplification
4923 is done if possible.
4925 MATCH_NO if the call does not correspond to an intrinsic
4927 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4928 error during the simplification process.
4930 The error_flag parameter enables an error reporting. */
4933 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
4936 gfc_intrinsic_sym
*isym
, *specific
;
4937 gfc_actual_arglist
*actual
;
4940 if (expr
->value
.function
.isym
!= NULL
)
4941 return (!do_simplify(expr
->value
.function
.isym
, expr
))
4942 ? MATCH_ERROR
: MATCH_YES
;
4945 gfc_push_suppress_errors ();
4948 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
4949 if (actual
->expr
!= NULL
)
4950 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
4951 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
4953 sym
= expr
->symtree
->n
.sym
;
4955 if (sym
->intmod_sym_id
)
4957 gfc_isym_id id
= gfc_isym_id_by_intmod_sym (sym
);
4958 isym
= specific
= gfc_intrinsic_function_by_id (id
);
4961 isym
= specific
= gfc_find_function (sym
->name
);
4966 gfc_pop_suppress_errors ();
4970 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
4971 || isym
->id
== GFC_ISYM_CMPLX
|| isym
->id
== GFC_ISYM_FLOAT
4972 || isym
->id
== GFC_ISYM_SNGL
|| isym
->id
== GFC_ISYM_DFLOAT
)
4973 && gfc_init_expr_flag
4974 && !gfc_notify_std (GFC_STD_F2003
, "Function %qs as initialization "
4975 "expression at %L", sym
->name
, &expr
->where
))
4978 gfc_pop_suppress_errors ();
4982 /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
4983 SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
4984 initialization expressions. */
4986 if (gfc_init_expr_flag
&& isym
->transformational
)
4988 gfc_isym_id id
= isym
->id
;
4989 if (id
!= GFC_ISYM_REPEAT
&& id
!= GFC_ISYM_RESHAPE
4990 && id
!= GFC_ISYM_SI_KIND
&& id
!= GFC_ISYM_SR_KIND
4991 && id
!= GFC_ISYM_TRANSFER
&& id
!= GFC_ISYM_TRIM
4992 && !gfc_notify_std (GFC_STD_F2003
, "Transformational function %qs "
4993 "at %L is invalid in an initialization "
4994 "expression", sym
->name
, &expr
->where
))
4997 gfc_pop_suppress_errors ();
5003 gfc_current_intrinsic_where
= &expr
->where
;
5005 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
5006 if (isym
->check
.f1m
== gfc_check_min_max
)
5008 init_arglist (isym
);
5010 if (isym
->check
.f1m(expr
->value
.function
.actual
))
5014 gfc_pop_suppress_errors ();
5018 /* If the function is generic, check all of its specific
5019 incarnations. If the generic name is also a specific, we check
5020 that name last, so that any error message will correspond to the
5022 gfc_push_suppress_errors ();
5026 for (specific
= isym
->specific_head
; specific
;
5027 specific
= specific
->next
)
5029 if (specific
== isym
)
5031 if (check_specific (specific
, expr
, 0))
5033 gfc_pop_suppress_errors ();
5039 gfc_pop_suppress_errors ();
5041 if (!check_specific (isym
, expr
, error_flag
))
5044 gfc_pop_suppress_errors ();
5051 expr
->value
.function
.isym
= specific
;
5053 gfc_pop_suppress_errors ();
5055 if (!do_simplify (specific
, expr
))
5058 /* F95, 7.1.6.1, Initialization expressions
5059 (4) An elemental intrinsic function reference of type integer or
5060 character where each argument is an initialization expression
5061 of type integer or character
5063 F2003, 7.1.7 Initialization expression
5064 (4) A reference to an elemental standard intrinsic function,
5065 where each argument is an initialization expression */
5067 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
5068 && !gfc_notify_std (GFC_STD_F2003
, "Elemental function as "
5069 "initialization expression with non-integer/non-"
5070 "character arguments at %L", &expr
->where
))
5073 if (sym
->attr
.flavor
== FL_UNKNOWN
)
5075 sym
->attr
.function
= 1;
5076 sym
->attr
.intrinsic
= 1;
5077 sym
->attr
.flavor
= FL_PROCEDURE
;
5079 if (sym
->attr
.flavor
== FL_PROCEDURE
)
5081 sym
->attr
.function
= 1;
5082 sym
->attr
.proc
= PROC_INTRINSIC
;
5086 gfc_intrinsic_symbol (sym
);
5088 /* Have another stab at simplification since elemental intrinsics with array
5089 actual arguments would be missed by the calls above to do_simplify. */
5090 if (isym
->elemental
)
5091 gfc_simplify_expr (expr
, 1);
5097 /* See if a CALL statement corresponds to an intrinsic subroutine.
5098 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
5099 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
5103 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
5105 gfc_intrinsic_sym
*isym
;
5108 name
= c
->symtree
->n
.sym
->name
;
5110 if (c
->symtree
->n
.sym
->intmod_sym_id
)
5113 id
= gfc_isym_id_by_intmod_sym (c
->symtree
->n
.sym
);
5114 isym
= gfc_intrinsic_subroutine_by_id (id
);
5117 isym
= gfc_find_subroutine (name
);
5122 gfc_push_suppress_errors ();
5124 init_arglist (isym
);
5126 if (!isym
->vararg
&& !sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
))
5129 if (!do_ts29113_check (isym
, c
->ext
.actual
))
5132 if (isym
->check
.f1
!= NULL
)
5134 if (!do_check (isym
, c
->ext
.actual
))
5139 if (!check_arglist (&c
->ext
.actual
, isym
, 1))
5143 /* The subroutine corresponds to an intrinsic. Allow errors to be
5144 seen at this point. */
5146 gfc_pop_suppress_errors ();
5148 c
->resolved_isym
= isym
;
5149 if (isym
->resolve
.s1
!= NULL
)
5150 isym
->resolve
.s1 (c
);
5153 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
5154 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
5157 if (gfc_do_concurrent_flag
&& !isym
->pure
)
5159 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
5160 "block at %L is not PURE", name
, &c
->loc
);
5164 if (!isym
->pure
&& gfc_pure (NULL
))
5166 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name
,
5172 gfc_unset_implicit_pure (NULL
);
5174 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
5180 gfc_pop_suppress_errors ();
5185 /* Call gfc_convert_type() with warning enabled. */
5188 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
5190 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
5194 /* Try to convert an expression (in place) from one type to another.
5195 'eflag' controls the behavior on error.
5197 The possible values are:
5199 1 Generate a gfc_error()
5200 2 Generate a gfc_internal_error().
5202 'wflag' controls the warning related to conversion.
5204 'array' indicates whether the conversion is in an array constructor.
5205 Non-standard conversion from character to numeric not allowed if true.
5209 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
,
5212 gfc_intrinsic_sym
*sym
;
5213 gfc_typespec from_ts
;
5218 bool is_char_constant
= (expr
->expr_type
== EXPR_CONSTANT
)
5219 && (expr
->ts
.type
== BT_CHARACTER
);
5221 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
5223 if (ts
->type
== BT_UNKNOWN
)
5226 expr
->do_not_warn
= ! wflag
;
5228 /* NULL and zero size arrays get their type here, unless they already have a
5230 if ((expr
->expr_type
== EXPR_NULL
5231 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
5232 && expr
->ts
.type
== BT_UNKNOWN
)
5234 /* Sometimes the RHS acquire the type. */
5239 if (expr
->ts
.type
== BT_UNKNOWN
)
5242 /* In building an array constructor, gfortran can end up here when no
5243 conversion is required for an intrinsic type. We need to let derived
5244 types drop through. */
5245 if (from_ts
.type
!= BT_DERIVED
&& from_ts
.type
!= BT_CLASS
5246 && (from_ts
.type
== ts
->type
&& from_ts
.kind
== ts
->kind
))
5249 if ((expr
->ts
.type
== BT_DERIVED
|| expr
->ts
.type
== BT_CLASS
)
5250 && (ts
->type
== BT_DERIVED
|| ts
->type
== BT_CLASS
)
5251 && gfc_compare_types (ts
, &expr
->ts
))
5254 /* If array is true then conversion is in an array constructor where
5255 non-standard conversion is not allowed. */
5256 if (array
&& from_ts
.type
== BT_CHARACTER
5257 && (gfc_numeric_ts (ts
) || ts
->type
== BT_LOGICAL
))
5260 sym
= find_conv (&expr
->ts
, ts
);
5264 /* At this point, a conversion is necessary. A warning may be needed. */
5265 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
5267 const char *type_name
= is_char_constant
? gfc_typename (expr
)
5268 : gfc_typename (&from_ts
);
5269 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
5270 type_name
, gfc_dummy_typename (ts
),
5275 if (flag_range_check
&& expr
->expr_type
== EXPR_CONSTANT
5276 && from_ts
.type
== ts
->type
)
5278 /* Do nothing. Constants of the same type are range-checked
5279 elsewhere. If a value too large for the target type is
5280 assigned, an error is generated. Not checking here avoids
5281 duplications of warnings/errors.
5282 If range checking was disabled, but -Wconversion enabled,
5283 a non range checked warning is generated below. */
5285 else if (flag_dec_char_conversions
&& from_ts
.type
== BT_CHARACTER
5286 && (gfc_numeric_ts (ts
) || ts
->type
== BT_LOGICAL
))
5288 const char *type_name
= is_char_constant
? gfc_typename (expr
)
5289 : gfc_typename (&from_ts
);
5290 gfc_warning_now (OPT_Wconversion
, "Nonstandard conversion from %s "
5291 "to %s at %L", type_name
, gfc_typename (ts
),
5294 else if (from_ts
.type
== ts
->type
5295 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
5296 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
5297 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
5299 /* Larger kinds can hold values of smaller kinds without problems.
5300 Hence, only warn if target kind is smaller than the source
5301 kind - or if -Wconversion-extra is specified. LOGICAL values
5302 will always fit regardless of kind so ignore conversion. */
5303 if (expr
->expr_type
!= EXPR_CONSTANT
5304 && ts
->type
!= BT_LOGICAL
)
5306 if (warn_conversion
&& from_ts
.kind
> ts
->kind
)
5307 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5308 "conversion from %s to %s at %L",
5309 gfc_typename (&from_ts
), gfc_typename (ts
),
5312 gfc_warning_now (OPT_Wconversion_extra
, "Conversion from %s to %s "
5313 "at %L", gfc_typename (&from_ts
),
5314 gfc_typename (ts
), &expr
->where
);
5317 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
5318 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
5319 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
5321 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
5322 usually comes with a loss of information, regardless of kinds. */
5323 if (expr
->expr_type
!= EXPR_CONSTANT
)
5324 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5325 "conversion from %s to %s at %L",
5326 gfc_typename (&from_ts
), gfc_typename (ts
),
5329 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
5331 /* If HOLLERITH is involved, all bets are off. */
5332 gfc_warning_now (OPT_Wconversion
, "Conversion from %s to %s at %L",
5333 gfc_typename (&from_ts
), gfc_dummy_typename (ts
),
5336 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
5338 /* Do nothing. This block exists only to simplify the other
5339 else-if expressions.
5340 LOGICAL <> LOGICAL no warning, independent of kind values
5341 LOGICAL <> INTEGER extension, warned elsewhere
5342 LOGICAL <> REAL invalid, error generated elsewhere
5343 LOGICAL <> COMPLEX invalid, error generated elsewhere */
5349 /* Insert a pre-resolved function call to the right function. */
5350 old_where
= expr
->where
;
5352 shape
= expr
->shape
;
5354 new_expr
= gfc_get_expr ();
5357 new_expr
= gfc_build_conversion (new_expr
);
5358 new_expr
->value
.function
.name
= sym
->lib_name
;
5359 new_expr
->value
.function
.isym
= sym
;
5360 new_expr
->where
= old_where
;
5362 new_expr
->rank
= rank
;
5363 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5365 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5366 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
5367 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5368 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5369 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5370 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5371 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5372 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
5373 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5374 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5375 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5382 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5383 && !do_simplify (sym
, expr
))
5388 return false; /* Error already generated in do_simplify() */
5394 const char *type_name
= is_char_constant
? gfc_typename (expr
)
5395 : gfc_typename (&from_ts
);
5398 gfc_error ("Cannot convert %s to %s at %L", type_name
, gfc_typename (ts
),
5403 gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name
,
5404 gfc_typename (ts
), &expr
->where
);
5410 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
5412 gfc_intrinsic_sym
*sym
;
5418 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
5420 sym
= find_char_conv (&expr
->ts
, ts
);
5423 /* Insert a pre-resolved function call to the right function. */
5424 old_where
= expr
->where
;
5426 shape
= expr
->shape
;
5428 new_expr
= gfc_get_expr ();
5431 new_expr
= gfc_build_conversion (new_expr
);
5432 new_expr
->value
.function
.name
= sym
->lib_name
;
5433 new_expr
->value
.function
.isym
= sym
;
5434 new_expr
->where
= old_where
;
5436 new_expr
->rank
= rank
;
5437 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5439 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5440 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5441 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5442 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5443 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5444 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5445 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5446 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5447 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5454 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5455 && !do_simplify (sym
, expr
))
5457 /* Error already generated in do_simplify() */
5465 /* Check if the passed name is name of an intrinsic (taking into account the
5466 current -std=* and -fall-intrinsic settings). If it is, see if we should
5467 warn about this as a user-procedure having the same name as an intrinsic
5468 (-Wintrinsic-shadow enabled) and do so if we should. */
5471 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
5473 gfc_intrinsic_sym
* isym
;
5475 /* If the warning is disabled, do nothing at all. */
5476 if (!warn_intrinsic_shadow
)
5479 /* Try to find an intrinsic of the same name. */
5481 isym
= gfc_find_function (sym
->name
);
5483 isym
= gfc_find_subroutine (sym
->name
);
5485 /* If no intrinsic was found with this name or it's not included in the
5486 selected standard, everything's fine. */
5487 if (!isym
|| !gfc_check_intrinsic_standard (isym
, NULL
, true,
5491 /* Emit the warning. */
5492 if (in_module
|| sym
->ns
->proc_name
)
5493 gfc_warning (OPT_Wintrinsic_shadow
,
5494 "%qs declared at %L may shadow the intrinsic of the same"
5495 " name. In order to call the intrinsic, explicit INTRINSIC"
5496 " declarations may be required.",
5497 sym
->name
, &sym
->declared_at
);
5499 gfc_warning (OPT_Wintrinsic_shadow
,
5500 "%qs declared at %L is also the name of an intrinsic. It can"
5501 " only be called via an explicit interface or if declared"
5502 " EXTERNAL.", sym
->name
, &sym
->declared_at
);