1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000-2023 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
.recursive
1168 || sym
->attr
.if_source
== IFSRC_IFBODY
)
1171 if (subroutine_flag
)
1172 isym
= gfc_find_subroutine (sym
->name
);
1174 isym
= gfc_find_function (sym
->name
);
1176 /* No such intrinsic available at all? */
1180 /* See if this intrinsic is allowed in the current standard. */
1181 if (!gfc_check_intrinsic_standard (isym
, &symstd
, false, loc
)
1182 && !sym
->attr
.artificial
)
1184 if (sym
->attr
.proc
== PROC_UNKNOWN
&& warn_intrinsics_std
)
1185 gfc_warning_now (OPT_Wintrinsics_std
, "The intrinsic %qs at %L is not "
1186 "included in the selected standard but %s and %qs will"
1187 " be treated as if declared EXTERNAL. Use an"
1188 " appropriate %<-std=%> option or define"
1189 " %<-fall-intrinsics%> to allow this intrinsic.",
1190 sym
->name
, &loc
, symstd
, sym
->name
);
1199 /* Collect a set of intrinsic functions into a generic collection.
1200 The first argument is the name of the generic function, which is
1201 also the name of a specific function. The rest of the specifics
1202 currently in the table are placed into the list of specific
1203 functions associated with that generic.
1206 FIXME: Remove the argument STANDARD if no regressions are
1207 encountered. Change all callers (approx. 360).
1211 make_generic (const char *name
, gfc_isym_id id
, int standard ATTRIBUTE_UNUSED
)
1213 gfc_intrinsic_sym
*g
;
1215 if (sizing
!= SZ_NOTHING
)
1218 g
= gfc_find_function (name
);
1220 gfc_internal_error ("make_generic(): Cannot find generic symbol %qs",
1223 gcc_assert (g
->id
== id
);
1227 if ((g
+ 1)->name
!= NULL
)
1228 g
->specific_head
= g
+ 1;
1231 while (g
->name
!= NULL
)
1243 /* Create a duplicate intrinsic function entry for the current
1244 function, the only differences being the alternate name and
1245 a different standard if necessary. Note that we use argument
1246 lists more than once, but all argument lists are freed as a
1250 make_alias (const char *name
, int standard
)
1263 next_sym
[0] = next_sym
[-1];
1264 next_sym
->name
= gfc_get_string ("%s", name
);
1265 next_sym
->standard
= standard
;
1275 /* Make the current subroutine noreturn. */
1278 make_noreturn (void)
1280 if (sizing
== SZ_NOTHING
)
1281 next_sym
[-1].noreturn
= 1;
1285 /* Mark current intrinsic as module intrinsic. */
1287 make_from_module (void)
1289 if (sizing
== SZ_NOTHING
)
1290 next_sym
[-1].from_module
= 1;
1294 /* Mark the current subroutine as having a variable number of
1300 if (sizing
== SZ_NOTHING
)
1301 next_sym
[-1].vararg
= 1;
1304 /* Set the attr.value of the current procedure. */
1307 set_attr_value (int n
, ...)
1309 gfc_intrinsic_arg
*arg
;
1313 if (sizing
!= SZ_NOTHING
)
1317 arg
= next_sym
[-1].formal
;
1319 for (i
= 0; i
< n
; i
++)
1321 gcc_assert (arg
!= NULL
);
1322 arg
->value
= va_arg (argp
, int);
1329 /* Add intrinsic functions. */
1332 add_functions (void)
1334 /* Argument names. These are used as argument keywords and so need to
1335 match the documentation. Please keep this list in sorted order. */
1337 *a
= "a", *a1
= "a1", *a2
= "a2", *ar
= "array", *b
= "b",
1338 *bck
= "back", *bd
= "boundary", *c
= "c", *c_ptr_1
= "c_ptr_1",
1339 *c_ptr_2
= "c_ptr_2", *ca
= "coarray", *com
= "command",
1340 *dist
= "distance", *dm
= "dim", *f
= "field", *failed
="failed",
1341 *fs
= "fsource", *han
= "handler", *i
= "i",
1342 *image
= "image", *j
= "j", *kind
= "kind",
1343 *l
= "l", *ln
= "len", *level
= "level", *m
= "matrix", *ma
= "matrix_a",
1344 *mb
= "matrix_b", *md
= "mode", *mo
= "mold", *msk
= "mask",
1345 *n
= "n", *ncopies
= "ncopies", *nm
= "name", *num
= "number",
1346 *ord
= "order", *p
= "p", *p1
= "path1", *p2
= "path2",
1347 *pad
= "pad", *pid
= "pid", *pos
= "pos", *pt
= "pointer",
1348 *r
= "r", *s
= "s", *set
= "set", *sh
= "shift", *shp
= "shape",
1349 *sig
= "sig", *src
= "source", *ssg
= "substring",
1350 *sta
= "string_a", *stb
= "string_b", *stg
= "string",
1351 *sub
= "sub", *sz
= "size", *tg
= "target", *team
= "team", *tm
= "time",
1352 *ts
= "tsource", *ut
= "unit", *v
= "vector", *va
= "vector_a",
1353 *vb
= "vector_b", *vl
= "values", *val
= "value", *x
= "x", *y
= "y",
1356 int di
, dr
, dd
, dl
, dc
, dz
, ii
;
1358 di
= gfc_default_integer_kind
;
1359 dr
= gfc_default_real_kind
;
1360 dd
= gfc_default_double_kind
;
1361 dl
= gfc_default_logical_kind
;
1362 dc
= gfc_default_character_kind
;
1363 dz
= gfc_default_complex_kind
;
1364 ii
= gfc_index_integer_kind
;
1366 add_sym_1 ("abs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1367 gfc_check_abs
, gfc_simplify_abs
, gfc_resolve_abs
,
1368 a
, BT_REAL
, dr
, REQUIRED
);
1370 if (flag_dec_intrinsic_ints
)
1372 make_alias ("babs", GFC_STD_GNU
);
1373 make_alias ("iiabs", GFC_STD_GNU
);
1374 make_alias ("jiabs", GFC_STD_GNU
);
1375 make_alias ("kiabs", GFC_STD_GNU
);
1378 add_sym_1 ("iabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1379 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1380 a
, BT_INTEGER
, di
, REQUIRED
);
1382 add_sym_1 ("dabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1383 gfc_check_fn_d
, gfc_simplify_abs
, gfc_resolve_abs
,
1384 a
, BT_REAL
, dd
, REQUIRED
);
1386 add_sym_1 ("cabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1387 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1388 a
, BT_COMPLEX
, dz
, REQUIRED
);
1390 add_sym_1 ("zabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1391 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1392 a
, BT_COMPLEX
, dd
, REQUIRED
);
1394 make_alias ("cdabs", GFC_STD_GNU
);
1396 make_generic ("abs", GFC_ISYM_ABS
, GFC_STD_F77
);
1398 /* The checking function for ACCESS is called gfc_check_access_func
1399 because the name gfc_check_access is already used in module.cc. */
1400 add_sym_2 ("access", GFC_ISYM_ACCESS
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1401 di
, GFC_STD_GNU
, gfc_check_access_func
, NULL
, gfc_resolve_access
,
1402 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1404 make_generic ("access", GFC_ISYM_ACCESS
, GFC_STD_GNU
);
1406 add_sym_2 ("achar", GFC_ISYM_ACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1407 BT_CHARACTER
, dc
, GFC_STD_F95
,
1408 gfc_check_achar
, gfc_simplify_achar
, gfc_resolve_achar
,
1409 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1411 make_generic ("achar", GFC_ISYM_ACHAR
, GFC_STD_F95
);
1413 add_sym_1 ("acos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1414 gfc_check_fn_rc2008
, gfc_simplify_acos
, gfc_resolve_acos
,
1415 x
, BT_REAL
, dr
, REQUIRED
);
1417 add_sym_1 ("dacos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1418 gfc_check_fn_d
, gfc_simplify_acos
, gfc_resolve_acos
,
1419 x
, BT_REAL
, dd
, REQUIRED
);
1421 make_generic ("acos", GFC_ISYM_ACOS
, GFC_STD_F77
);
1423 add_sym_1 ("acosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1424 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_acosh
,
1425 gfc_resolve_acosh
, x
, BT_REAL
, dr
, REQUIRED
);
1427 add_sym_1 ("dacosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1428 gfc_check_fn_d
, gfc_simplify_acosh
, gfc_resolve_acosh
,
1429 x
, BT_REAL
, dd
, REQUIRED
);
1431 make_generic ("acosh", GFC_ISYM_ACOSH
, GFC_STD_F2008
);
1433 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1434 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustl
,
1435 gfc_resolve_adjustl
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1437 make_generic ("adjustl", GFC_ISYM_ADJUSTL
, GFC_STD_F95
);
1439 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1440 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustr
,
1441 gfc_resolve_adjustr
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1443 make_generic ("adjustr", GFC_ISYM_ADJUSTR
, GFC_STD_F95
);
1445 add_sym_1 ("aimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1446 gfc_check_fn_c
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1447 z
, BT_COMPLEX
, dz
, REQUIRED
);
1449 make_alias ("imag", GFC_STD_GNU
);
1450 make_alias ("imagpart", GFC_STD_GNU
);
1452 add_sym_1 ("dimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1453 NULL
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1454 z
, BT_COMPLEX
, dd
, REQUIRED
);
1456 make_generic ("aimag", GFC_ISYM_AIMAG
, GFC_STD_F77
);
1458 add_sym_2 ("aint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1459 gfc_check_a_xkind
, gfc_simplify_aint
, gfc_resolve_aint
,
1460 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1462 add_sym_1 ("dint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1463 NULL
, gfc_simplify_dint
, gfc_resolve_dint
,
1464 a
, BT_REAL
, dd
, REQUIRED
);
1466 make_generic ("aint", GFC_ISYM_AINT
, GFC_STD_F77
);
1468 add_sym_2 ("all", GFC_ISYM_ALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1469 gfc_check_all_any
, gfc_simplify_all
, gfc_resolve_all
,
1470 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1472 make_generic ("all", GFC_ISYM_ALL
, GFC_STD_F95
);
1474 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1475 gfc_check_allocated
, NULL
, NULL
,
1476 ar
, BT_UNKNOWN
, 0, REQUIRED
);
1478 make_generic ("allocated", GFC_ISYM_ALLOCATED
, GFC_STD_F95
);
1480 add_sym_2 ("anint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1481 gfc_check_a_xkind
, gfc_simplify_anint
, gfc_resolve_anint
,
1482 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1484 add_sym_1 ("dnint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1485 NULL
, gfc_simplify_dnint
, gfc_resolve_dnint
,
1486 a
, BT_REAL
, dd
, REQUIRED
);
1488 make_generic ("anint", GFC_ISYM_ANINT
, GFC_STD_F77
);
1490 add_sym_2 ("any", GFC_ISYM_ANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1491 gfc_check_all_any
, gfc_simplify_any
, gfc_resolve_any
,
1492 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1494 make_generic ("any", GFC_ISYM_ANY
, GFC_STD_F95
);
1496 add_sym_1 ("asin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1497 gfc_check_fn_rc2008
, gfc_simplify_asin
, gfc_resolve_asin
,
1498 x
, BT_REAL
, dr
, REQUIRED
);
1500 add_sym_1 ("dasin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1501 gfc_check_fn_d
, gfc_simplify_asin
, gfc_resolve_asin
,
1502 x
, BT_REAL
, dd
, REQUIRED
);
1504 make_generic ("asin", GFC_ISYM_ASIN
, GFC_STD_F77
);
1506 add_sym_1 ("asinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1507 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_asinh
,
1508 gfc_resolve_asinh
, x
, BT_REAL
, dr
, REQUIRED
);
1510 add_sym_1 ("dasinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1511 gfc_check_fn_d
, gfc_simplify_asinh
, gfc_resolve_asinh
,
1512 x
, BT_REAL
, dd
, REQUIRED
);
1514 make_generic ("asinh", GFC_ISYM_ASINH
, GFC_STD_F2008
);
1516 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
,
1517 GFC_STD_F95
, gfc_check_associated
, NULL
, NULL
,
1518 pt
, BT_UNKNOWN
, 0, REQUIRED
, tg
, BT_UNKNOWN
, 0, OPTIONAL
);
1520 make_generic ("associated", GFC_ISYM_ASSOCIATED
, GFC_STD_F95
);
1522 add_sym_1 ("atan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1523 gfc_check_fn_rc2008
, gfc_simplify_atan
, gfc_resolve_atan
,
1524 x
, BT_REAL
, dr
, REQUIRED
);
1526 add_sym_1 ("datan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1527 gfc_check_fn_d
, gfc_simplify_atan
, gfc_resolve_atan
,
1528 x
, BT_REAL
, dd
, REQUIRED
);
1530 /* Two-argument version of atan, equivalent to atan2. */
1531 add_sym_2 ("atan", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F2008
,
1532 gfc_check_atan_2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1533 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1535 make_generic ("atan", GFC_ISYM_ATAN
, GFC_STD_F77
);
1537 add_sym_1 ("atanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1538 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_atanh
,
1539 gfc_resolve_atanh
, x
, BT_REAL
, dr
, REQUIRED
);
1541 add_sym_1 ("datanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1542 gfc_check_fn_d
, gfc_simplify_atanh
, gfc_resolve_atanh
,
1543 x
, BT_REAL
, dd
, REQUIRED
);
1545 make_generic ("atanh", GFC_ISYM_ATANH
, GFC_STD_F2008
);
1547 add_sym_2 ("atan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1548 gfc_check_atan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1549 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1551 add_sym_2 ("datan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1552 gfc_check_datan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1553 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1555 make_generic ("atan2", GFC_ISYM_ATAN2
, GFC_STD_F77
);
1557 /* Bessel and Neumann functions for G77 compatibility. */
1558 add_sym_1 ("besj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1559 gfc_check_fn_r
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1560 x
, BT_REAL
, dr
, REQUIRED
);
1562 make_alias ("bessel_j0", GFC_STD_F2008
);
1564 add_sym_1 ("dbesj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1565 gfc_check_fn_d
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1566 x
, BT_REAL
, dd
, REQUIRED
);
1568 make_generic ("bessel_j0", GFC_ISYM_J0
, GFC_STD_F2008
);
1570 add_sym_1 ("besj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1571 gfc_check_fn_r
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1572 x
, BT_REAL
, dr
, REQUIRED
);
1574 make_alias ("bessel_j1", GFC_STD_F2008
);
1576 add_sym_1 ("dbesj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1577 gfc_check_fn_d
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1578 x
, BT_REAL
, dd
, REQUIRED
);
1580 make_generic ("bessel_j1", GFC_ISYM_J1
, GFC_STD_F2008
);
1582 add_sym_2 ("besjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1583 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1584 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1586 make_alias ("bessel_jn", GFC_STD_F2008
);
1588 add_sym_2 ("dbesjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1589 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1590 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1592 add_sym_3 ("bessel_jn", GFC_ISYM_JN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1593 gfc_check_bessel_n2
, gfc_simplify_bessel_jn2
, gfc_resolve_bessel_n2
,
1594 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1595 x
, BT_REAL
, dr
, REQUIRED
);
1596 set_attr_value (3, true, true, true);
1598 make_generic ("bessel_jn", GFC_ISYM_JN
, GFC_STD_F2008
);
1600 add_sym_1 ("besy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1601 gfc_check_fn_r
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1602 x
, BT_REAL
, dr
, REQUIRED
);
1604 make_alias ("bessel_y0", GFC_STD_F2008
);
1606 add_sym_1 ("dbesy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1607 gfc_check_fn_d
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1608 x
, BT_REAL
, dd
, REQUIRED
);
1610 make_generic ("bessel_y0", GFC_ISYM_Y0
, GFC_STD_F2008
);
1612 add_sym_1 ("besy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1613 gfc_check_fn_r
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1614 x
, BT_REAL
, dr
, REQUIRED
);
1616 make_alias ("bessel_y1", GFC_STD_F2008
);
1618 add_sym_1 ("dbesy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1619 gfc_check_fn_d
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1620 x
, BT_REAL
, dd
, REQUIRED
);
1622 make_generic ("bessel_y1", GFC_ISYM_Y1
, GFC_STD_F2008
);
1624 add_sym_2 ("besyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1625 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1626 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1628 make_alias ("bessel_yn", GFC_STD_F2008
);
1630 add_sym_2 ("dbesyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1631 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1632 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1634 add_sym_3 ("bessel_yn", GFC_ISYM_YN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1635 gfc_check_bessel_n2
, gfc_simplify_bessel_yn2
, gfc_resolve_bessel_n2
,
1636 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1637 x
, BT_REAL
, dr
, REQUIRED
);
1638 set_attr_value (3, true, true, true);
1640 make_generic ("bessel_yn", GFC_ISYM_YN
, GFC_STD_F2008
);
1642 add_sym_2 ("bge", GFC_ISYM_BGE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1643 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1644 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bge
, NULL
,
1645 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1647 make_generic ("bge", GFC_ISYM_BGE
, GFC_STD_F2008
);
1649 add_sym_2 ("bgt", GFC_ISYM_BGT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1650 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1651 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bgt
, NULL
,
1652 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1654 make_generic ("bgt", GFC_ISYM_BGT
, GFC_STD_F2008
);
1656 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1657 gfc_check_i
, gfc_simplify_bit_size
, NULL
,
1658 i
, BT_INTEGER
, di
, REQUIRED
);
1660 make_generic ("bit_size", GFC_ISYM_BIT_SIZE
, GFC_STD_F95
);
1662 add_sym_2 ("ble", GFC_ISYM_BLE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1663 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1664 gfc_check_bge_bgt_ble_blt
, gfc_simplify_ble
, NULL
,
1665 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1667 make_generic ("ble", GFC_ISYM_BLE
, GFC_STD_F2008
);
1669 add_sym_2 ("blt", GFC_ISYM_BLT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1670 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1671 gfc_check_bge_bgt_ble_blt
, gfc_simplify_blt
, NULL
,
1672 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1674 make_generic ("blt", GFC_ISYM_BLT
, GFC_STD_F2008
);
1676 add_sym_2 ("btest", GFC_ISYM_BTEST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1677 gfc_check_bitfcn
, gfc_simplify_btest
, gfc_resolve_btest
,
1678 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1680 if (flag_dec_intrinsic_ints
)
1682 make_alias ("bbtest", GFC_STD_GNU
);
1683 make_alias ("bitest", GFC_STD_GNU
);
1684 make_alias ("bjtest", GFC_STD_GNU
);
1685 make_alias ("bktest", GFC_STD_GNU
);
1688 make_generic ("btest", GFC_ISYM_BTEST
, GFC_STD_F95
);
1690 add_sym_2 ("ceiling", GFC_ISYM_CEILING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1691 gfc_check_a_ikind
, gfc_simplify_ceiling
, gfc_resolve_ceiling
,
1692 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1694 make_generic ("ceiling", GFC_ISYM_CEILING
, GFC_STD_F95
);
1696 add_sym_2 ("char", GFC_ISYM_CHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F77
,
1697 gfc_check_char
, gfc_simplify_char
, gfc_resolve_char
,
1698 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1700 make_generic ("char", GFC_ISYM_CHAR
, GFC_STD_F77
);
1702 add_sym_1 ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
1703 GFC_STD_GNU
, gfc_check_chdir
, NULL
, gfc_resolve_chdir
,
1704 nm
, BT_CHARACTER
, dc
, REQUIRED
);
1706 make_generic ("chdir", GFC_ISYM_CHDIR
, GFC_STD_GNU
);
1708 add_sym_2 ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1709 di
, GFC_STD_GNU
, gfc_check_chmod
, NULL
, gfc_resolve_chmod
,
1710 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1712 make_generic ("chmod", GFC_ISYM_CHMOD
, GFC_STD_GNU
);
1714 add_sym_3 ("cmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1715 gfc_check_cmplx
, gfc_simplify_cmplx
, gfc_resolve_cmplx
,
1716 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, OPTIONAL
,
1717 kind
, BT_INTEGER
, di
, OPTIONAL
);
1719 make_generic ("cmplx", GFC_ISYM_CMPLX
, GFC_STD_F77
);
1721 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
, CLASS_INQUIRY
,
1722 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
, NULL
, NULL
, NULL
);
1724 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
,
1727 add_sym_2 ("complex", GFC_ISYM_COMPLEX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_GNU
,
1728 gfc_check_complex
, gfc_simplify_complex
, gfc_resolve_complex
,
1729 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, REQUIRED
);
1731 make_generic ("complex", GFC_ISYM_COMPLEX
, GFC_STD_GNU
);
1733 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1734 complex instead of the default complex. */
1736 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1737 gfc_check_dcmplx
, gfc_simplify_dcmplx
, gfc_resolve_dcmplx
,
1738 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, OPTIONAL
);
1740 make_generic ("dcmplx", GFC_ISYM_CMPLX
, GFC_STD_GNU
);
1742 add_sym_1 ("conjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1743 gfc_check_fn_c
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1744 z
, BT_COMPLEX
, dz
, REQUIRED
);
1746 add_sym_1 ("dconjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1747 NULL
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1748 z
, BT_COMPLEX
, dd
, REQUIRED
);
1750 make_generic ("conjg", GFC_ISYM_CONJG
, GFC_STD_F77
);
1752 add_sym_1 ("cos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1753 gfc_check_fn_rc
, gfc_simplify_cos
, gfc_resolve_cos
,
1754 x
, BT_REAL
, dr
, REQUIRED
);
1756 add_sym_1 ("dcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1757 gfc_check_fn_d
, gfc_simplify_cos
, gfc_resolve_cos
,
1758 x
, BT_REAL
, dd
, REQUIRED
);
1760 add_sym_1 ("ccos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1761 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1762 x
, BT_COMPLEX
, dz
, REQUIRED
);
1764 add_sym_1 ("zcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1765 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1766 x
, BT_COMPLEX
, dd
, REQUIRED
);
1768 make_alias ("cdcos", GFC_STD_GNU
);
1770 make_generic ("cos", GFC_ISYM_COS
, GFC_STD_F77
);
1772 add_sym_1 ("cosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1773 gfc_check_fn_rc2008
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1774 x
, BT_REAL
, dr
, REQUIRED
);
1776 add_sym_1 ("dcosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1777 gfc_check_fn_d
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1778 x
, BT_REAL
, dd
, REQUIRED
);
1780 make_generic ("cosh", GFC_ISYM_COSH
, GFC_STD_F77
);
1782 add_sym_3 ("count", GFC_ISYM_COUNT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1783 BT_INTEGER
, di
, GFC_STD_F95
,
1784 gfc_check_count
, gfc_simplify_count
, gfc_resolve_count
,
1785 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1786 kind
, BT_INTEGER
, di
, OPTIONAL
);
1788 make_generic ("count", GFC_ISYM_COUNT
, GFC_STD_F95
);
1790 add_sym_3 ("cshift", GFC_ISYM_CSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1791 BT_REAL
, dr
, GFC_STD_F95
,
1792 gfc_check_cshift
, gfc_simplify_cshift
, gfc_resolve_cshift
,
1793 ar
, BT_REAL
, dr
, REQUIRED
,
1794 sh
, BT_INTEGER
, di
, REQUIRED
,
1795 dm
, BT_INTEGER
, ii
, OPTIONAL
);
1797 make_generic ("cshift", GFC_ISYM_CSHIFT
, GFC_STD_F95
);
1799 add_sym_1 ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1800 0, GFC_STD_GNU
, gfc_check_ctime
, NULL
, gfc_resolve_ctime
,
1801 tm
, BT_INTEGER
, di
, REQUIRED
);
1803 make_generic ("ctime", GFC_ISYM_CTIME
, GFC_STD_GNU
);
1805 add_sym_1 ("dble", GFC_ISYM_DBLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
1806 gfc_check_dble
, gfc_simplify_dble
, gfc_resolve_dble
,
1807 a
, BT_REAL
, dr
, REQUIRED
);
1809 make_generic ("dble", GFC_ISYM_DBLE
, GFC_STD_F77
);
1811 add_sym_1 ("digits", GFC_ISYM_DIGITS
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1812 gfc_check_digits
, gfc_simplify_digits
, NULL
,
1813 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1815 make_generic ("digits", GFC_ISYM_DIGITS
, GFC_STD_F95
);
1817 add_sym_2 ("dim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1818 gfc_check_a_p
, gfc_simplify_dim
, gfc_resolve_dim
,
1819 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1821 add_sym_2 ("idim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1822 NULL
, gfc_simplify_dim
, gfc_resolve_dim
,
1823 x
, BT_INTEGER
, di
, REQUIRED
, y
, BT_INTEGER
, di
, REQUIRED
);
1825 add_sym_2 ("ddim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1826 gfc_check_x_yd
, gfc_simplify_dim
, gfc_resolve_dim
,
1827 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, REQUIRED
);
1829 make_generic ("dim", GFC_ISYM_DIM
, GFC_STD_F77
);
1831 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
1832 GFC_STD_F95
, gfc_check_dot_product
, gfc_simplify_dot_product
, gfc_resolve_dot_product
,
1833 va
, BT_REAL
, dr
, REQUIRED
, vb
, BT_REAL
, dr
, REQUIRED
);
1835 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT
, GFC_STD_F95
);
1837 add_sym_2 ("dprod", GFC_ISYM_DPROD
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1838 gfc_check_dprod
, gfc_simplify_dprod
, gfc_resolve_dprod
,
1839 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1841 make_generic ("dprod", GFC_ISYM_DPROD
, GFC_STD_F77
);
1843 add_sym_1 ("dreal", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1844 BT_REAL
, dd
, GFC_STD_GNU
, NULL
, gfc_simplify_dreal
, NULL
,
1845 a
, BT_COMPLEX
, dd
, REQUIRED
);
1847 make_generic ("dreal", GFC_ISYM_REAL
, GFC_STD_GNU
);
1849 add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1850 BT_INTEGER
, di
, GFC_STD_F2008
,
1851 gfc_check_dshift
, gfc_simplify_dshiftl
, gfc_resolve_dshift
,
1852 i
, BT_INTEGER
, di
, REQUIRED
,
1853 j
, BT_INTEGER
, di
, REQUIRED
,
1854 sh
, BT_INTEGER
, di
, REQUIRED
);
1856 make_generic ("dshiftl", GFC_ISYM_DSHIFTL
, GFC_STD_F2008
);
1858 add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1859 BT_INTEGER
, di
, GFC_STD_F2008
,
1860 gfc_check_dshift
, gfc_simplify_dshiftr
, gfc_resolve_dshift
,
1861 i
, BT_INTEGER
, di
, REQUIRED
,
1862 j
, BT_INTEGER
, di
, REQUIRED
,
1863 sh
, BT_INTEGER
, di
, REQUIRED
);
1865 make_generic ("dshiftr", GFC_ISYM_DSHIFTR
, GFC_STD_F2008
);
1867 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1868 gfc_check_eoshift
, gfc_simplify_eoshift
, gfc_resolve_eoshift
,
1869 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, ii
, REQUIRED
,
1870 bd
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1872 make_generic ("eoshift", GFC_ISYM_EOSHIFT
, GFC_STD_F95
);
1874 add_sym_1 ("epsilon", GFC_ISYM_EPSILON
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
,
1875 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_epsilon
, NULL
,
1876 x
, BT_REAL
, dr
, REQUIRED
);
1878 make_generic ("epsilon", GFC_ISYM_EPSILON
, GFC_STD_F95
);
1880 /* G77 compatibility for the ERF() and ERFC() functions. */
1881 add_sym_1 ("erf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1882 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erf
,
1883 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1885 add_sym_1 ("derf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1886 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erf
,
1887 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1889 make_generic ("erf", GFC_ISYM_ERF
, GFC_STD_F2008
);
1891 add_sym_1 ("erfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1892 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erfc
,
1893 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1895 add_sym_1 ("derfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1896 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erfc
,
1897 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1899 make_generic ("erfc", GFC_ISYM_ERFC
, GFC_STD_F2008
);
1901 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1902 BT_REAL
, dr
, GFC_STD_F2008
, gfc_check_fn_r
,
1903 gfc_simplify_erfc_scaled
, gfc_resolve_g77_math1
, x
, BT_REAL
,
1906 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, GFC_STD_F2008
);
1908 /* G77 compatibility */
1909 add_sym_1 ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1910 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1911 x
, BT_REAL
, 4, REQUIRED
);
1913 make_generic ("dtime", GFC_ISYM_DTIME
, GFC_STD_GNU
);
1915 add_sym_1 ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1916 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1917 x
, BT_REAL
, 4, REQUIRED
);
1919 make_generic ("etime", GFC_ISYM_ETIME
, GFC_STD_GNU
);
1921 add_sym_1 ("exp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1922 gfc_check_fn_rc
, gfc_simplify_exp
, gfc_resolve_exp
,
1923 x
, BT_REAL
, dr
, REQUIRED
);
1925 add_sym_1 ("dexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1926 gfc_check_fn_d
, gfc_simplify_exp
, gfc_resolve_exp
,
1927 x
, BT_REAL
, dd
, REQUIRED
);
1929 add_sym_1 ("cexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1930 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1931 x
, BT_COMPLEX
, dz
, REQUIRED
);
1933 add_sym_1 ("zexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1934 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1935 x
, BT_COMPLEX
, dd
, REQUIRED
);
1937 make_alias ("cdexp", GFC_STD_GNU
);
1939 make_generic ("exp", GFC_ISYM_EXP
, GFC_STD_F77
);
1941 add_sym_1 ("exponent", GFC_ISYM_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
1942 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_exponent
, gfc_resolve_exponent
,
1943 x
, BT_REAL
, dr
, REQUIRED
);
1945 make_generic ("exponent", GFC_ISYM_EXPONENT
, GFC_STD_F95
);
1947 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF
, CLASS_INQUIRY
,
1948 ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1949 gfc_check_same_type_as
, gfc_simplify_extends_type_of
,
1950 gfc_resolve_extends_type_of
,
1951 a
, BT_UNKNOWN
, 0, REQUIRED
,
1952 mo
, BT_UNKNOWN
, 0, REQUIRED
);
1954 add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES
, CLASS_TRANSFORMATIONAL
,
1955 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
1956 gfc_check_failed_or_stopped_images
,
1957 gfc_simplify_failed_or_stopped_images
,
1958 gfc_resolve_failed_images
, team
, BT_VOID
, di
, OPTIONAL
,
1959 kind
, BT_INTEGER
, di
, OPTIONAL
);
1961 add_sym_0 ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1962 dc
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_fdate
);
1964 make_generic ("fdate", GFC_ISYM_FDATE
, GFC_STD_GNU
);
1966 add_sym_2 ("floor", GFC_ISYM_FLOOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1967 gfc_check_a_ikind
, gfc_simplify_floor
, gfc_resolve_floor
,
1968 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1970 make_generic ("floor", GFC_ISYM_FLOOR
, GFC_STD_F95
);
1972 /* G77 compatible fnum */
1973 add_sym_1 ("fnum", GFC_ISYM_FNUM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1974 di
, GFC_STD_GNU
, gfc_check_fnum
, NULL
, gfc_resolve_fnum
,
1975 ut
, BT_INTEGER
, di
, REQUIRED
);
1977 make_generic ("fnum", GFC_ISYM_FNUM
, GFC_STD_GNU
);
1979 add_sym_1 ("fraction", GFC_ISYM_FRACTION
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1980 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_fraction
, gfc_resolve_fraction
,
1981 x
, BT_REAL
, dr
, REQUIRED
);
1983 make_generic ("fraction", GFC_ISYM_FRACTION
, GFC_STD_F95
);
1985 add_sym_2_intent ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
1986 BT_INTEGER
, di
, GFC_STD_GNU
,
1987 gfc_check_fstat
, NULL
, gfc_resolve_fstat
,
1988 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1989 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
1991 make_generic ("fstat", GFC_ISYM_FSTAT
, GFC_STD_GNU
);
1993 add_sym_1 ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1994 ii
, GFC_STD_GNU
, gfc_check_ftell
, NULL
, gfc_resolve_ftell
,
1995 ut
, BT_INTEGER
, di
, REQUIRED
);
1997 make_generic ("ftell", GFC_ISYM_FTELL
, GFC_STD_GNU
);
1999 add_sym_2_intent ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, ACTUAL_NO
,
2000 BT_INTEGER
, di
, GFC_STD_GNU
,
2001 gfc_check_fgetputc
, NULL
, gfc_resolve_fgetc
,
2002 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
2003 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2005 make_generic ("fgetc", GFC_ISYM_FGETC
, GFC_STD_GNU
);
2007 add_sym_1_intent ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2008 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fget
,
2009 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2011 make_generic ("fget", GFC_ISYM_FGET
, GFC_STD_GNU
);
2013 add_sym_2 ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2014 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fputc
,
2015 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
2017 make_generic ("fputc", GFC_ISYM_FPUTC
, GFC_STD_GNU
);
2019 add_sym_1 ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2020 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fput
,
2021 c
, BT_CHARACTER
, dc
, REQUIRED
);
2023 make_generic ("fput", GFC_ISYM_FPUT
, GFC_STD_GNU
);
2025 add_sym_1 ("gamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
2026 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_gamma
,
2027 gfc_resolve_gamma
, x
, BT_REAL
, dr
, REQUIRED
);
2029 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2030 gfc_check_fn_d
, gfc_simplify_gamma
, gfc_resolve_gamma
,
2031 x
, BT_REAL
, dr
, REQUIRED
);
2033 make_generic ("gamma", GFC_ISYM_TGAMMA
, GFC_STD_F2008
);
2035 /* Unix IDs (g77 compatibility) */
2036 add_sym_1 ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2037 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getcwd
,
2038 c
, BT_CHARACTER
, dc
, REQUIRED
);
2040 make_generic ("getcwd", GFC_ISYM_GETCWD
, GFC_STD_GNU
);
2042 add_sym_0 ("getgid", GFC_ISYM_GETGID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2043 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getgid
);
2045 make_generic ("getgid", GFC_ISYM_GETGID
, GFC_STD_GNU
);
2047 add_sym_0 ("getpid", GFC_ISYM_GETPID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2048 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getpid
);
2050 make_generic ("getpid", GFC_ISYM_GETPID
, GFC_STD_GNU
);
2052 add_sym_1 ("get_team", GFC_ISYM_GET_TEAM
, CLASS_TRANSFORMATIONAL
,
2053 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2018
,
2054 gfc_check_get_team
, NULL
, gfc_resolve_get_team
,
2055 level
, BT_INTEGER
, di
, OPTIONAL
);
2057 add_sym_0 ("getuid", GFC_ISYM_GETUID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2058 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getuid
);
2060 make_generic ("getuid", GFC_ISYM_GETUID
, GFC_STD_GNU
);
2062 add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, ACTUAL_NO
,
2063 BT_INTEGER
, di
, GFC_STD_GNU
,
2064 gfc_check_hostnm
, NULL
, gfc_resolve_hostnm
,
2065 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2067 make_generic ("hostnm", GFC_ISYM_HOSTNM
, GFC_STD_GNU
);
2069 add_sym_1 ("huge", GFC_ISYM_HUGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2070 gfc_check_huge
, gfc_simplify_huge
, NULL
,
2071 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2073 make_generic ("huge", GFC_ISYM_HUGE
, GFC_STD_F95
);
2075 add_sym_2 ("hypot", GFC_ISYM_HYPOT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2076 BT_REAL
, dr
, GFC_STD_F2008
,
2077 gfc_check_hypot
, gfc_simplify_hypot
, gfc_resolve_hypot
,
2078 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
2080 make_generic ("hypot", GFC_ISYM_HYPOT
, GFC_STD_F2008
);
2082 add_sym_2 ("iachar", GFC_ISYM_IACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2083 BT_INTEGER
, di
, GFC_STD_F95
,
2084 gfc_check_ichar_iachar
, gfc_simplify_iachar
, gfc_resolve_iachar
,
2085 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2087 make_generic ("iachar", GFC_ISYM_IACHAR
, GFC_STD_F95
);
2089 add_sym_2 ("iand", GFC_ISYM_IAND
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2091 gfc_check_iand_ieor_ior
, gfc_simplify_iand
, gfc_resolve_iand
,
2092 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2094 if (flag_dec_intrinsic_ints
)
2096 make_alias ("biand", GFC_STD_GNU
);
2097 make_alias ("iiand", GFC_STD_GNU
);
2098 make_alias ("jiand", GFC_STD_GNU
);
2099 make_alias ("kiand", GFC_STD_GNU
);
2102 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
2104 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2105 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
2106 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2108 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
2110 add_sym_3red ("iall", GFC_ISYM_IALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2111 gfc_check_transf_bit_intrins
, gfc_simplify_iall
, gfc_resolve_iall
,
2112 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2113 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2115 make_generic ("iall", GFC_ISYM_IALL
, GFC_STD_F2008
);
2117 add_sym_3red ("iany", GFC_ISYM_IANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2118 gfc_check_transf_bit_intrins
, gfc_simplify_iany
, gfc_resolve_iany
,
2119 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2120 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2122 make_generic ("iany", GFC_ISYM_IANY
, GFC_STD_F2008
);
2124 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2125 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2127 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
2129 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2130 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
2131 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2133 if (flag_dec_intrinsic_ints
)
2135 make_alias ("bbclr", GFC_STD_GNU
);
2136 make_alias ("iibclr", GFC_STD_GNU
);
2137 make_alias ("jibclr", GFC_STD_GNU
);
2138 make_alias ("kibclr", GFC_STD_GNU
);
2141 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
2143 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2144 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
2145 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
2146 ln
, BT_INTEGER
, di
, REQUIRED
);
2148 if (flag_dec_intrinsic_ints
)
2150 make_alias ("bbits", GFC_STD_GNU
);
2151 make_alias ("iibits", GFC_STD_GNU
);
2152 make_alias ("jibits", GFC_STD_GNU
);
2153 make_alias ("kibits", GFC_STD_GNU
);
2156 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
2158 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2159 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
2160 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2162 if (flag_dec_intrinsic_ints
)
2164 make_alias ("bbset", GFC_STD_GNU
);
2165 make_alias ("iibset", GFC_STD_GNU
);
2166 make_alias ("jibset", GFC_STD_GNU
);
2167 make_alias ("kibset", GFC_STD_GNU
);
2170 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
2172 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2173 BT_INTEGER
, di
, GFC_STD_F77
,
2174 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
2175 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2177 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
2179 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2181 gfc_check_iand_ieor_ior
, gfc_simplify_ieor
, gfc_resolve_ieor
,
2182 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2184 if (flag_dec_intrinsic_ints
)
2186 make_alias ("bieor", GFC_STD_GNU
);
2187 make_alias ("iieor", GFC_STD_GNU
);
2188 make_alias ("jieor", GFC_STD_GNU
);
2189 make_alias ("kieor", GFC_STD_GNU
);
2192 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
2194 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2195 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
2196 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2198 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
2200 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2201 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
2203 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
2205 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2206 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
2207 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
2209 add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2210 BT_INTEGER
, di
, GFC_STD_F2018
, gfc_check_image_status
,
2211 gfc_simplify_image_status
, gfc_resolve_image_status
, image
,
2212 BT_INTEGER
, di
, REQUIRED
, team
, BT_VOID
, di
, OPTIONAL
);
2214 /* The resolution function for INDEX is called gfc_resolve_index_func
2215 because the name gfc_resolve_index is already used in resolve.cc. */
2216 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
2217 BT_INTEGER
, di
, GFC_STD_F77
,
2218 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
2219 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
2220 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2222 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
2224 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2225 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
2226 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2228 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2229 NULL
, gfc_simplify_ifix
, NULL
,
2230 a
, BT_REAL
, dr
, REQUIRED
);
2232 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2233 NULL
, gfc_simplify_idint
, NULL
,
2234 a
, BT_REAL
, dd
, REQUIRED
);
2236 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
2238 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2239 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
2240 a
, BT_REAL
, dr
, REQUIRED
);
2242 make_alias ("short", GFC_STD_GNU
);
2244 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
2246 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2247 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
2248 a
, BT_REAL
, dr
, REQUIRED
);
2250 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
2252 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2253 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
2254 a
, BT_REAL
, dr
, REQUIRED
);
2256 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
2258 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2260 gfc_check_iand_ieor_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
2261 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2263 if (flag_dec_intrinsic_ints
)
2265 make_alias ("bior", GFC_STD_GNU
);
2266 make_alias ("iior", GFC_STD_GNU
);
2267 make_alias ("jior", GFC_STD_GNU
);
2268 make_alias ("kior", GFC_STD_GNU
);
2271 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
2273 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2274 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
2275 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2277 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
2279 add_sym_3red ("iparity", GFC_ISYM_IPARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2280 gfc_check_transf_bit_intrins
, gfc_simplify_iparity
, gfc_resolve_iparity
,
2281 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2282 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2284 make_generic ("iparity", GFC_ISYM_IPARITY
, GFC_STD_F2008
);
2286 /* The following function is for G77 compatibility. */
2287 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2288 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
2289 i
, BT_INTEGER
, 4, OPTIONAL
);
2291 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
2293 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2294 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
2295 ut
, BT_INTEGER
, di
, REQUIRED
);
2297 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
2299 add_sym_1 ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS
, CLASS_INQUIRY
, ACTUAL_NO
,
2300 BT_LOGICAL
, dl
, GFC_STD_F2008
,
2301 gfc_check_is_contiguous
, gfc_simplify_is_contiguous
,
2302 gfc_resolve_is_contiguous
,
2303 ar
, BT_REAL
, dr
, REQUIRED
);
2305 make_generic ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS
, GFC_STD_F2008
);
2307 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
2308 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2309 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
2310 i
, BT_INTEGER
, 0, REQUIRED
);
2312 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
2314 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
2315 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2316 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
2317 i
, BT_INTEGER
, 0, REQUIRED
);
2319 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
2321 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2322 BT_LOGICAL
, dl
, GFC_STD_GNU
,
2323 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
2324 x
, BT_REAL
, 0, REQUIRED
);
2326 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
2328 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2329 BT_INTEGER
, di
, GFC_STD_GNU
,
2330 gfc_check_ishft
, gfc_simplify_rshift
, gfc_resolve_rshift
,
2331 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2333 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
2335 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2336 BT_INTEGER
, di
, GFC_STD_GNU
,
2337 gfc_check_ishft
, gfc_simplify_lshift
, gfc_resolve_lshift
,
2338 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2340 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
2342 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2343 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
2344 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2346 if (flag_dec_intrinsic_ints
)
2348 make_alias ("bshft", GFC_STD_GNU
);
2349 make_alias ("iishft", GFC_STD_GNU
);
2350 make_alias ("jishft", GFC_STD_GNU
);
2351 make_alias ("kishft", GFC_STD_GNU
);
2354 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
2356 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2357 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
2358 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
2359 sz
, BT_INTEGER
, di
, OPTIONAL
);
2361 if (flag_dec_intrinsic_ints
)
2363 make_alias ("bshftc", GFC_STD_GNU
);
2364 make_alias ("iishftc", GFC_STD_GNU
);
2365 make_alias ("jishftc", GFC_STD_GNU
);
2366 make_alias ("kishftc", GFC_STD_GNU
);
2369 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
2371 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2372 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, NULL
,
2373 pid
, BT_INTEGER
, di
, REQUIRED
, sig
, BT_INTEGER
, di
, REQUIRED
);
2375 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
2377 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2378 gfc_check_kind
, gfc_simplify_kind
, NULL
,
2379 x
, BT_REAL
, dr
, REQUIRED
);
2381 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
2383 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2384 BT_INTEGER
, di
, GFC_STD_F95
,
2385 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
2386 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
2387 kind
, BT_INTEGER
, di
, OPTIONAL
);
2389 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
2391 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2392 BT_INTEGER
, di
, GFC_STD_F2008
,
2393 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
2394 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2395 kind
, BT_INTEGER
, di
, OPTIONAL
);
2397 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
2399 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2400 BT_INTEGER
, di
, GFC_STD_F2008
,
2401 gfc_check_i
, gfc_simplify_leadz
, NULL
,
2402 i
, BT_INTEGER
, di
, REQUIRED
);
2404 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
2406 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
2407 BT_INTEGER
, di
, GFC_STD_F77
,
2408 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
2409 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2411 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
2413 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2414 BT_INTEGER
, di
, GFC_STD_F95
,
2415 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
2416 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2418 make_alias ("lnblnk", GFC_STD_GNU
);
2420 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
2422 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2424 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2425 x
, BT_REAL
, dr
, REQUIRED
);
2427 make_alias ("log_gamma", GFC_STD_F2008
);
2429 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2430 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2431 x
, BT_REAL
, dr
, REQUIRED
);
2433 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2434 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2435 x
, BT_REAL
, dr
, REQUIRED
);
2437 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2440 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2441 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2442 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2444 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2446 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2447 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2448 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2450 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2452 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2453 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2454 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2456 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2458 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2459 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2460 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2462 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2464 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2465 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2466 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2468 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2470 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2471 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2472 x
, BT_REAL
, dr
, REQUIRED
);
2474 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2475 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2476 x
, BT_REAL
, dr
, REQUIRED
);
2478 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2479 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2480 x
, BT_REAL
, dd
, REQUIRED
);
2482 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2483 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2484 x
, BT_COMPLEX
, dz
, REQUIRED
);
2486 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2487 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2488 x
, BT_COMPLEX
, dd
, REQUIRED
);
2490 make_alias ("cdlog", GFC_STD_GNU
);
2492 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2494 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2495 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2496 x
, BT_REAL
, dr
, REQUIRED
);
2498 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2499 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2500 x
, BT_REAL
, dr
, REQUIRED
);
2502 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2503 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2504 x
, BT_REAL
, dd
, REQUIRED
);
2506 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2508 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2509 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2510 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2512 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2514 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
2515 BT_INTEGER
, di
, GFC_STD_GNU
,
2516 gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2517 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2518 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2520 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2522 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2523 GFC_STD_GNU
, gfc_check_malloc
, NULL
, NULL
,
2524 sz
, BT_INTEGER
, di
, REQUIRED
);
2526 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2528 add_sym_2 ("maskl", GFC_ISYM_MASKL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2529 BT_INTEGER
, di
, GFC_STD_F2008
,
2530 gfc_check_mask
, gfc_simplify_maskl
, gfc_resolve_mask
,
2531 i
, BT_INTEGER
, di
, REQUIRED
,
2532 kind
, BT_INTEGER
, di
, OPTIONAL
);
2534 make_generic ("maskl", GFC_ISYM_MASKL
, GFC_STD_F2008
);
2536 add_sym_2 ("maskr", GFC_ISYM_MASKR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2537 BT_INTEGER
, di
, GFC_STD_F2008
,
2538 gfc_check_mask
, gfc_simplify_maskr
, gfc_resolve_mask
,
2539 i
, BT_INTEGER
, di
, REQUIRED
,
2540 kind
, BT_INTEGER
, di
, OPTIONAL
);
2542 make_generic ("maskr", GFC_ISYM_MASKR
, GFC_STD_F2008
);
2544 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2545 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2546 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2548 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2550 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2551 int(max). The max function must take at least two arguments. */
2553 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2554 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2555 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2557 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2558 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2559 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2561 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2562 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2563 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2565 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2566 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2567 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2569 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2570 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2571 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2573 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2574 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2575 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2577 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2579 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2580 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_maxexponent
, NULL
,
2581 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2583 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2585 add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2586 gfc_check_minloc_maxloc
, gfc_simplify_maxloc
, gfc_resolve_maxloc
,
2587 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2588 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2589 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2591 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2593 add_sym_6fl ("findloc", GFC_ISYM_FINDLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
2594 BT_INTEGER
, di
, GFC_STD_F2008
,
2595 gfc_check_findloc
, gfc_simplify_findloc
, gfc_resolve_findloc
,
2596 ar
, BT_REAL
, dr
, REQUIRED
, val
, BT_REAL
, dr
, REQUIRED
,
2597 dm
, BT_INTEGER
, ii
, OPTIONAL
, msk
, BT_LOGICAL
, dl
, OPTIONAL
,
2598 kind
, BT_INTEGER
, di
, OPTIONAL
, bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2600 make_generic ("findloc", GFC_ISYM_FINDLOC
, GFC_STD_F2008
);
2602 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2603 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2604 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2605 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2607 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2609 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2610 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2612 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2614 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2615 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2617 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2619 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2620 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2621 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2622 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2624 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2626 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2627 BT_INTEGER
, di
, GFC_STD_F2008
,
2628 gfc_check_merge_bits
, gfc_simplify_merge_bits
,
2629 gfc_resolve_merge_bits
,
2630 i
, BT_INTEGER
, di
, REQUIRED
,
2631 j
, BT_INTEGER
, di
, REQUIRED
,
2632 msk
, BT_INTEGER
, di
, REQUIRED
);
2634 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS
, GFC_STD_F2008
);
2636 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2639 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2640 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2641 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2643 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2644 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2645 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2647 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2648 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2649 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2651 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2652 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2653 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2655 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2656 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2657 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2659 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2660 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2661 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2663 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2665 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2666 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_minexponent
, NULL
,
2667 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2669 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2671 add_sym_5ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2672 gfc_check_minloc_maxloc
, gfc_simplify_minloc
, gfc_resolve_minloc
,
2673 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2674 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2675 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2677 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2679 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2680 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2681 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2682 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2684 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2686 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2687 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2688 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2690 if (flag_dec_intrinsic_ints
)
2692 make_alias ("bmod", GFC_STD_GNU
);
2693 make_alias ("imod", GFC_STD_GNU
);
2694 make_alias ("jmod", GFC_STD_GNU
);
2695 make_alias ("kmod", GFC_STD_GNU
);
2698 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2699 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2700 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2702 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2703 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2704 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2706 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2708 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2709 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2710 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2712 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2714 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2715 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2716 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2718 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2720 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2721 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2722 a
, BT_CHARACTER
, dc
, REQUIRED
);
2724 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2726 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2727 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2728 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2730 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2731 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2732 a
, BT_REAL
, dd
, REQUIRED
);
2734 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2736 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2737 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2738 i
, BT_INTEGER
, di
, REQUIRED
);
2740 if (flag_dec_intrinsic_ints
)
2742 make_alias ("bnot", GFC_STD_GNU
);
2743 make_alias ("inot", GFC_STD_GNU
);
2744 make_alias ("jnot", GFC_STD_GNU
);
2745 make_alias ("knot", GFC_STD_GNU
);
2748 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2750 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2751 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2752 x
, BT_REAL
, dr
, REQUIRED
,
2753 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2755 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2757 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2758 gfc_check_null
, gfc_simplify_null
, NULL
,
2759 mo
, BT_INTEGER
, di
, OPTIONAL
);
2761 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2763 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES
, CLASS_TRANSFORMATIONAL
,
2764 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2765 gfc_check_num_images
, gfc_simplify_num_images
, NULL
,
2766 dist
, BT_INTEGER
, di
, OPTIONAL
,
2767 failed
, BT_LOGICAL
, dl
, OPTIONAL
);
2769 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2770 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2771 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2772 v
, BT_REAL
, dr
, OPTIONAL
);
2774 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2777 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2778 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2779 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2780 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2782 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2784 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2785 BT_INTEGER
, di
, GFC_STD_F2008
,
2786 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2787 i
, BT_INTEGER
, di
, REQUIRED
);
2789 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2791 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2792 BT_INTEGER
, di
, GFC_STD_F2008
,
2793 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2794 i
, BT_INTEGER
, di
, REQUIRED
);
2796 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2798 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2799 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2800 x
, BT_UNKNOWN
, 0, REQUIRED
);
2802 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2804 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2805 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2806 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2808 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2810 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2811 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2812 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2813 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2815 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2817 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2818 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2819 x
, BT_UNKNOWN
, 0, REQUIRED
);
2821 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2823 /* The following function is for G77 compatibility. */
2824 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2825 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2826 i
, BT_INTEGER
, 4, OPTIONAL
);
2828 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2829 use slightly different shoddy multiplicative congruential PRNG. */
2830 make_alias ("ran", GFC_STD_GNU
);
2832 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2834 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2835 gfc_check_range
, gfc_simplify_range
, NULL
,
2836 x
, BT_REAL
, dr
, REQUIRED
);
2838 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2840 add_sym_1 ("rank", GFC_ISYM_RANK
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2841 GFC_STD_F2018
, gfc_check_rank
, gfc_simplify_rank
, gfc_resolve_rank
,
2842 a
, BT_REAL
, dr
, REQUIRED
);
2843 make_generic ("rank", GFC_ISYM_RANK
, GFC_STD_F2018
);
2845 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2846 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2847 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2849 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2851 /* This provides compatibility with g77. */
2852 add_sym_1 ("realpart", GFC_ISYM_REALPART
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2853 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2854 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2856 make_generic ("realpart", GFC_ISYM_REALPART
, GFC_STD_F77
);
2858 add_sym_1 ("float", GFC_ISYM_FLOAT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2859 gfc_check_float
, gfc_simplify_float
, NULL
,
2860 a
, BT_INTEGER
, di
, REQUIRED
);
2862 if (flag_dec_intrinsic_ints
)
2864 make_alias ("floati", GFC_STD_GNU
);
2865 make_alias ("floatj", GFC_STD_GNU
);
2866 make_alias ("floatk", GFC_STD_GNU
);
2869 make_generic ("float", GFC_ISYM_FLOAT
, GFC_STD_F77
);
2871 add_sym_1 ("dfloat", GFC_ISYM_DFLOAT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2872 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2873 a
, BT_REAL
, dr
, REQUIRED
);
2875 make_generic ("dfloat", GFC_ISYM_DFLOAT
, GFC_STD_F77
);
2877 add_sym_1 ("sngl", GFC_ISYM_SNGL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2878 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2879 a
, BT_REAL
, dd
, REQUIRED
);
2881 make_generic ("sngl", GFC_ISYM_SNGL
, GFC_STD_F77
);
2883 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2884 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2885 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2887 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2889 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2890 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2891 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2893 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2895 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2896 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2897 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2898 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2900 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2902 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
2903 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2904 x
, BT_REAL
, dr
, REQUIRED
);
2906 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2908 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2909 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2910 gfc_check_same_type_as
, gfc_simplify_same_type_as
, NULL
,
2911 a
, BT_UNKNOWN
, 0, REQUIRED
,
2912 b
, BT_UNKNOWN
, 0, REQUIRED
);
2914 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2915 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2916 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2918 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2920 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2921 BT_INTEGER
, di
, GFC_STD_F95
,
2922 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2923 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2924 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2926 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2928 /* Added for G77 compatibility garbage. */
2929 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2930 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2932 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2934 /* Added for G77 compatibility. */
2935 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2936 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2937 x
, BT_REAL
, dr
, REQUIRED
);
2939 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2941 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2942 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2943 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2944 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2946 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2948 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2949 GFC_STD_F95
, gfc_check_selected_int_kind
,
2950 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2952 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2954 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2955 GFC_STD_F95
, gfc_check_selected_real_kind
,
2956 gfc_simplify_selected_real_kind
, NULL
,
2957 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2958 "radix", BT_INTEGER
, di
, OPTIONAL
);
2960 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2962 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2963 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2964 gfc_resolve_set_exponent
,
2965 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2967 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2969 add_sym_2 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2970 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2971 src
, BT_REAL
, dr
, REQUIRED
,
2972 kind
, BT_INTEGER
, di
, OPTIONAL
);
2974 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2976 add_sym_2 ("shifta", GFC_ISYM_SHIFTA
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2977 BT_INTEGER
, di
, GFC_STD_F2008
,
2978 gfc_check_shift
, gfc_simplify_shifta
, gfc_resolve_shift
,
2979 i
, BT_INTEGER
, di
, REQUIRED
,
2980 sh
, BT_INTEGER
, di
, REQUIRED
);
2982 make_generic ("shifta", GFC_ISYM_SHIFTA
, GFC_STD_F2008
);
2984 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2985 BT_INTEGER
, di
, GFC_STD_F2008
,
2986 gfc_check_shift
, gfc_simplify_shiftl
, gfc_resolve_shift
,
2987 i
, BT_INTEGER
, di
, REQUIRED
,
2988 sh
, BT_INTEGER
, di
, REQUIRED
);
2990 make_generic ("shiftl", GFC_ISYM_SHIFTL
, GFC_STD_F2008
);
2992 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2993 BT_INTEGER
, di
, GFC_STD_F2008
,
2994 gfc_check_shift
, gfc_simplify_shiftr
, gfc_resolve_shift
,
2995 i
, BT_INTEGER
, di
, REQUIRED
,
2996 sh
, BT_INTEGER
, di
, REQUIRED
);
2998 make_generic ("shiftr", GFC_ISYM_SHIFTR
, GFC_STD_F2008
);
3000 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3001 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
3002 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
3004 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
3005 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
3006 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
3008 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3009 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
3010 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
3012 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
3014 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3015 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
3016 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_VOID
, 0, REQUIRED
);
3018 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
3020 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3021 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
3022 x
, BT_REAL
, dr
, REQUIRED
);
3024 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3025 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
3026 x
, BT_REAL
, dd
, REQUIRED
);
3028 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
3029 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
3030 x
, BT_COMPLEX
, dz
, REQUIRED
);
3032 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
3033 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
3034 x
, BT_COMPLEX
, dd
, REQUIRED
);
3036 make_alias ("cdsin", GFC_STD_GNU
);
3038 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
3040 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3041 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
3042 x
, BT_REAL
, dr
, REQUIRED
);
3044 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3045 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
3046 x
, BT_REAL
, dd
, REQUIRED
);
3048 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
3050 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
3051 BT_INTEGER
, di
, GFC_STD_F95
,
3052 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
3053 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3054 kind
, BT_INTEGER
, di
, OPTIONAL
);
3056 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
3058 /* Obtain the stride for a given dimensions; to be used only internally.
3059 "make_from_module" makes it inaccessible for external users. */
3060 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE
, CLASS_INQUIRY
, ACTUAL_NO
,
3061 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_GNU
,
3062 NULL
, NULL
, gfc_resolve_stride
,
3063 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
3066 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
3067 BT_INTEGER
, ii
, GFC_STD_GNU
,
3068 gfc_check_sizeof
, gfc_simplify_sizeof
, NULL
,
3069 x
, BT_UNKNOWN
, 0, REQUIRED
);
3071 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
3073 /* The following functions are part of ISO_C_BINDING. */
3074 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
,
3075 BT_LOGICAL
, dl
, GFC_STD_F2003
, gfc_check_c_associated
, NULL
, NULL
,
3076 c_ptr_1
, BT_VOID
, 0, REQUIRED
,
3077 c_ptr_2
, BT_VOID
, 0, OPTIONAL
);
3080 add_sym_1 ("c_loc", GFC_ISYM_C_LOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3081 BT_VOID
, 0, GFC_STD_F2003
,
3082 gfc_check_c_loc
, NULL
, gfc_resolve_c_loc
,
3083 x
, BT_UNKNOWN
, 0, REQUIRED
);
3086 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3087 BT_VOID
, 0, GFC_STD_F2003
,
3088 gfc_check_c_funloc
, NULL
, gfc_resolve_c_funloc
,
3089 x
, BT_UNKNOWN
, 0, REQUIRED
);
3092 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
3093 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_F2008
,
3094 gfc_check_c_sizeof
, gfc_simplify_sizeof
, NULL
,
3095 x
, BT_UNKNOWN
, 0, REQUIRED
);
3098 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
3099 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS
, CLASS_INQUIRY
,
3100 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3101 NULL
, gfc_simplify_compiler_options
, NULL
);
3104 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION
, CLASS_INQUIRY
,
3105 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3106 NULL
, gfc_simplify_compiler_version
, NULL
);
3109 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
3110 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_spacing
, gfc_resolve_spacing
,
3111 x
, BT_REAL
, dr
, REQUIRED
);
3113 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
3115 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3116 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
3117 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
3118 ncopies
, BT_INTEGER
, di
, REQUIRED
);
3120 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
3122 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3123 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3124 x
, BT_REAL
, dr
, REQUIRED
);
3126 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3127 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3128 x
, BT_REAL
, dd
, REQUIRED
);
3130 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
3131 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3132 x
, BT_COMPLEX
, dz
, REQUIRED
);
3134 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
3135 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3136 x
, BT_COMPLEX
, dd
, REQUIRED
);
3138 make_alias ("cdsqrt", GFC_STD_GNU
);
3140 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
3142 add_sym_2_intent ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
,
3143 BT_INTEGER
, di
, GFC_STD_GNU
,
3144 gfc_check_stat
, NULL
, gfc_resolve_stat
,
3145 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3146 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3148 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
3150 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES
, CLASS_TRANSFORMATIONAL
,
3151 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
3152 gfc_check_failed_or_stopped_images
,
3153 gfc_simplify_failed_or_stopped_images
,
3154 gfc_resolve_stopped_images
, team
, BT_VOID
, di
, OPTIONAL
,
3155 kind
, BT_INTEGER
, di
, OPTIONAL
);
3157 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
3158 BT_INTEGER
, di
, GFC_STD_F2008
,
3159 gfc_check_storage_size
, gfc_simplify_storage_size
,
3160 gfc_resolve_storage_size
,
3161 a
, BT_UNKNOWN
, 0, REQUIRED
,
3162 kind
, BT_INTEGER
, di
, OPTIONAL
);
3164 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3165 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
3166 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3167 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
3169 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
3171 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3172 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
3173 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
3175 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
3177 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3178 GFC_STD_GNU
, NULL
, NULL
, NULL
,
3179 com
, BT_CHARACTER
, dc
, REQUIRED
);
3181 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
3183 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3184 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
3185 x
, BT_REAL
, dr
, REQUIRED
);
3187 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3188 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
3189 x
, BT_REAL
, dd
, REQUIRED
);
3191 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
3193 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3194 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3195 x
, BT_REAL
, dr
, REQUIRED
);
3197 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3198 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3199 x
, BT_REAL
, dd
, REQUIRED
);
3201 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
3203 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER
, CLASS_TRANSFORMATIONAL
,
3204 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2018
,
3205 gfc_check_team_number
, NULL
, gfc_resolve_team_number
,
3206 team
, BT_DERIVED
, di
, OPTIONAL
);
3208 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
3209 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
3210 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3211 dist
, BT_INTEGER
, di
, OPTIONAL
);
3213 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3214 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
3216 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
3218 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3219 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
3221 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
3223 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3224 gfc_check_fn_r
, gfc_simplify_tiny
, NULL
, x
, BT_REAL
, dr
, REQUIRED
);
3226 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
3228 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3229 BT_INTEGER
, di
, GFC_STD_F2008
,
3230 gfc_check_i
, gfc_simplify_trailz
, NULL
,
3231 i
, BT_INTEGER
, di
, REQUIRED
);
3233 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
3235 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3236 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
3237 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
3238 sz
, BT_INTEGER
, di
, OPTIONAL
);
3240 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
3242 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3243 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
3244 m
, BT_REAL
, dr
, REQUIRED
);
3246 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
3248 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
3249 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
3250 stg
, BT_CHARACTER
, dc
, REQUIRED
);
3252 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
3254 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
3255 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
3256 ut
, BT_INTEGER
, di
, REQUIRED
);
3258 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
3260 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3261 BT_INTEGER
, di
, GFC_STD_F95
,
3262 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
3263 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3264 kind
, BT_INTEGER
, di
, OPTIONAL
);
3266 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
3268 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3269 BT_INTEGER
, di
, GFC_STD_F2008
,
3270 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
3271 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3272 kind
, BT_INTEGER
, di
, OPTIONAL
);
3274 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
3276 /* g77 compatibility for UMASK. */
3277 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3278 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
3279 msk
, BT_INTEGER
, di
, REQUIRED
);
3281 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
3283 /* g77 compatibility for UNLINK. */
3284 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3285 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
3286 "path", BT_CHARACTER
, dc
, REQUIRED
);
3288 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
3290 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3291 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
3292 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
3293 f
, BT_REAL
, dr
, REQUIRED
);
3295 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
3297 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3298 BT_INTEGER
, di
, GFC_STD_F95
,
3299 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
3300 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
3301 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
3303 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
3305 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
3306 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
3307 x
, BT_UNKNOWN
, 0, REQUIRED
);
3309 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
3312 /* The next of intrinsic subprogram are the degree trignometric functions.
3313 These were hidden behind the -fdec-math option, but are now simply
3314 included as extensions to the set of intrinsic subprograms. */
3316 add_sym_1 ("acosd", GFC_ISYM_ACOSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3317 BT_REAL
, dr
, GFC_STD_GNU
,
3318 gfc_check_fn_r
, gfc_simplify_acosd
, gfc_resolve_trigd
,
3319 x
, BT_REAL
, dr
, REQUIRED
);
3321 add_sym_1 ("dacosd", GFC_ISYM_ACOSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3322 BT_REAL
, dd
, GFC_STD_GNU
,
3323 gfc_check_fn_d
, gfc_simplify_acosd
, gfc_resolve_trigd
,
3324 x
, BT_REAL
, dd
, REQUIRED
);
3326 make_generic ("acosd", GFC_ISYM_ACOSD
, GFC_STD_GNU
);
3328 add_sym_1 ("asind", GFC_ISYM_ASIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3329 BT_REAL
, dr
, GFC_STD_GNU
,
3330 gfc_check_fn_r
, gfc_simplify_asind
, gfc_resolve_trigd
,
3331 x
, BT_REAL
, dr
, REQUIRED
);
3333 add_sym_1 ("dasind", GFC_ISYM_ASIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3334 BT_REAL
, dd
, GFC_STD_GNU
,
3335 gfc_check_fn_d
, gfc_simplify_asind
, gfc_resolve_trigd
,
3336 x
, BT_REAL
, dd
, REQUIRED
);
3338 make_generic ("asind", GFC_ISYM_ASIND
, GFC_STD_GNU
);
3340 add_sym_1 ("atand", GFC_ISYM_ATAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3341 BT_REAL
, dr
, GFC_STD_GNU
,
3342 gfc_check_fn_r
, gfc_simplify_atand
, gfc_resolve_trigd
,
3343 x
, BT_REAL
, dr
, REQUIRED
);
3345 add_sym_1 ("datand", GFC_ISYM_ATAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3346 BT_REAL
, dd
, GFC_STD_GNU
,
3347 gfc_check_fn_d
, gfc_simplify_atand
, gfc_resolve_trigd
,
3348 x
, BT_REAL
, dd
, REQUIRED
);
3350 make_generic ("atand", GFC_ISYM_ATAND
, GFC_STD_GNU
);
3352 add_sym_2 ("atan2d", GFC_ISYM_ATAN2D
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3353 BT_REAL
, dr
, GFC_STD_GNU
,
3354 gfc_check_atan2
, gfc_simplify_atan2d
, gfc_resolve_trigd2
,
3355 y
, BT_REAL
, dr
, REQUIRED
,
3356 x
, BT_REAL
, dr
, REQUIRED
);
3358 add_sym_2 ("datan2d", GFC_ISYM_ATAN2D
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3359 BT_REAL
, dd
, GFC_STD_GNU
,
3360 gfc_check_datan2
, gfc_simplify_atan2d
, gfc_resolve_trigd2
,
3361 y
, BT_REAL
, dd
, REQUIRED
,
3362 x
, BT_REAL
, dd
, REQUIRED
);
3364 make_generic ("atan2d", GFC_ISYM_ATAN2D
, GFC_STD_GNU
);
3366 add_sym_1 ("cosd", GFC_ISYM_COSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3367 BT_REAL
, dr
, GFC_STD_GNU
,
3368 gfc_check_fn_r
, gfc_simplify_cosd
, gfc_resolve_trigd
,
3369 x
, BT_REAL
, dr
, REQUIRED
);
3371 add_sym_1 ("dcosd", GFC_ISYM_COSD
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3372 BT_REAL
, dd
, GFC_STD_GNU
,
3373 gfc_check_fn_d
, gfc_simplify_cosd
, gfc_resolve_trigd
,
3374 x
, BT_REAL
, dd
, REQUIRED
);
3376 make_generic ("cosd", GFC_ISYM_COSD
, GFC_STD_GNU
);
3378 add_sym_1 ("cotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3379 BT_REAL
, dr
, GFC_STD_GNU
,
3380 gfc_check_fn_rc2008
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3381 x
, BT_REAL
, dr
, REQUIRED
);
3383 add_sym_1 ("dcotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3384 BT_REAL
, dd
, GFC_STD_GNU
,
3385 gfc_check_fn_d
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3386 x
, BT_REAL
, dd
, REQUIRED
);
3388 add_sym_1 ("ccotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3389 BT_COMPLEX
, dz
, GFC_STD_GNU
,
3390 NULL
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3391 x
, BT_COMPLEX
, dz
, REQUIRED
);
3393 add_sym_1 ("zcotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3394 BT_COMPLEX
, dd
, GFC_STD_GNU
,
3395 NULL
, gfc_simplify_cotan
, gfc_resolve_trigd
,
3396 x
, BT_COMPLEX
, dd
, REQUIRED
);
3398 make_generic ("cotan", GFC_ISYM_COTAN
, GFC_STD_GNU
);
3400 add_sym_1 ("cotand", GFC_ISYM_COTAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3401 BT_REAL
, dr
, GFC_STD_GNU
,
3402 gfc_check_fn_r
, gfc_simplify_cotand
, gfc_resolve_trigd
,
3403 x
, BT_REAL
, dr
, REQUIRED
);
3405 add_sym_1 ("dcotand", GFC_ISYM_COTAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3406 BT_REAL
, dd
, GFC_STD_GNU
,
3407 gfc_check_fn_d
, gfc_simplify_cotand
, gfc_resolve_trigd
,
3408 x
, BT_REAL
, dd
, REQUIRED
);
3410 make_generic ("cotand", GFC_ISYM_COTAND
, GFC_STD_GNU
);
3412 add_sym_1 ("sind", GFC_ISYM_SIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3413 BT_REAL
, dr
, GFC_STD_GNU
,
3414 gfc_check_fn_r
, gfc_simplify_sind
, gfc_resolve_trigd
,
3415 x
, BT_REAL
, dr
, REQUIRED
);
3417 add_sym_1 ("dsind", GFC_ISYM_SIND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3418 BT_REAL
, dd
, GFC_STD_GNU
,
3419 gfc_check_fn_d
, gfc_simplify_sind
, gfc_resolve_trigd
,
3420 x
, BT_REAL
, dd
, REQUIRED
);
3422 make_generic ("sind", GFC_ISYM_SIND
, GFC_STD_GNU
);
3424 add_sym_1 ("tand", GFC_ISYM_TAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3425 BT_REAL
, dr
, GFC_STD_GNU
,
3426 gfc_check_fn_r
, gfc_simplify_tand
, gfc_resolve_trigd
,
3427 x
, BT_REAL
, dr
, REQUIRED
);
3429 add_sym_1 ("dtand", GFC_ISYM_TAND
, CLASS_ELEMENTAL
, ACTUAL_YES
,
3430 BT_REAL
, dd
, GFC_STD_GNU
,
3431 gfc_check_fn_d
, gfc_simplify_tand
, gfc_resolve_trigd
,
3432 x
, BT_REAL
, dd
, REQUIRED
);
3434 make_generic ("tand", GFC_ISYM_TAND
, GFC_STD_GNU
);
3436 /* The following function is internally used for coarray libray functions.
3437 "make_from_module" makes it inaccessible for external users. */
3438 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET
, CLASS_IMPURE
, ACTUAL_NO
,
3439 BT_REAL
, dr
, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3440 x
, BT_REAL
, dr
, REQUIRED
);
3445 /* Add intrinsic subroutines. */
3448 add_subroutines (void)
3450 /* Argument names. These are used as argument keywords and so need to
3451 match the documentation. Please keep this list in sorted order. */
3453 *a
= "a", *c_
= "c", *c
= "count", *cm
= "count_max", *com
= "command",
3454 *cr
= "count_rate", *dt
= "date", *errmsg
= "errmsg", *f
= "from",
3455 *fp
= "frompos", *gt
= "get", *h
= "harvest", *han
= "handler",
3456 *length
= "length", *ln
= "len", *md
= "mode", *msk
= "mask",
3457 *name
= "name", *num
= "number", *of
= "offset", *old
= "old",
3458 *p1
= "path1", *p2
= "path2", *pid
= "pid", *pos
= "pos",
3459 *pt
= "put", *ptr
= "ptr", *res
= "result",
3460 *result_image
= "result_image", *sec
= "seconds", *sig
= "sig",
3461 *st
= "status", *stat
= "stat", *sz
= "size", *t
= "to",
3462 *tm
= "time", *tp
= "topos", *trim_name
= "trim_name", *ut
= "unit",
3463 *val
= "value", *vl
= "values", *whence
= "whence", *zn
= "zone";
3465 int di
, dr
, dc
, dl
, ii
;
3467 di
= gfc_default_integer_kind
;
3468 dr
= gfc_default_real_kind
;
3469 dc
= gfc_default_character_kind
;
3470 dl
= gfc_default_logical_kind
;
3471 ii
= gfc_index_integer_kind
;
3473 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
3477 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF
, CLASS_ATOMIC
,
3478 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3479 gfc_check_atomic_def
, NULL
, gfc_resolve_atomic_def
,
3480 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3481 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3482 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3484 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF
, CLASS_ATOMIC
,
3485 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3486 gfc_check_atomic_ref
, NULL
, gfc_resolve_atomic_ref
,
3487 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3488 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3489 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3491 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS
, CLASS_ATOMIC
,
3492 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3493 gfc_check_atomic_cas
, NULL
, NULL
,
3494 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3495 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3496 "compare", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3497 "new", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3498 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3500 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD
, CLASS_ATOMIC
,
3501 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3502 gfc_check_atomic_op
, NULL
, NULL
,
3503 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3504 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3505 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3507 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND
, CLASS_ATOMIC
,
3508 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3509 gfc_check_atomic_op
, NULL
, NULL
,
3510 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3511 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3512 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3514 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR
, CLASS_ATOMIC
,
3515 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3516 gfc_check_atomic_op
, NULL
, NULL
,
3517 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3518 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3519 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3521 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR
, CLASS_ATOMIC
,
3522 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3523 gfc_check_atomic_op
, NULL
, NULL
,
3524 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3525 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3526 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3528 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD
, CLASS_ATOMIC
,
3529 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3530 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3531 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3532 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3533 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3534 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3536 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND
, CLASS_ATOMIC
,
3537 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3538 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3539 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3540 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3541 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3542 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3544 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR
, CLASS_ATOMIC
,
3545 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3546 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3547 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3548 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3549 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3550 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3552 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR
, CLASS_ATOMIC
,
3553 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3554 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3555 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3556 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3557 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3558 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3560 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE
, GFC_STD_GNU
, NULL
);
3562 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3563 GFC_STD_F95
, gfc_check_cpu_time
, NULL
, gfc_resolve_cpu_time
,
3564 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3566 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY
, CLASS_ATOMIC
,
3567 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3568 gfc_check_event_query
, NULL
, gfc_resolve_event_query
,
3569 "event", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3570 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3571 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3573 /* More G77 compatibility garbage. */
3574 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3575 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
3576 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3577 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3579 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3580 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
3581 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3583 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3584 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
3585 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3587 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3588 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
3589 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3590 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3592 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3593 GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
3594 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3595 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3597 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3598 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
3599 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3601 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3602 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
3603 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3604 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3606 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3607 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
3608 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3609 md
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3610 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3612 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
3613 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
3614 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3615 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3616 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3617 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3619 /* More G77 compatibility garbage. */
3620 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3621 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
3622 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3623 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3625 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3626 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
3627 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3628 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3630 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
3631 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
3632 NULL
, NULL
, gfc_resolve_execute_command_line
,
3633 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3634 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
3635 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
3636 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3637 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3639 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3640 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
3641 dt
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3643 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3644 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
3645 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3647 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3648 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
3649 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3650 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3652 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
3653 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3654 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3655 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3657 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
3658 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
3659 pos
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3660 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3662 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
3663 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
3664 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3666 /* F2003 commandline routines. */
3668 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
3669 BT_UNKNOWN
, 0, GFC_STD_F2003
,
3670 NULL
, NULL
, gfc_resolve_get_command
,
3671 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3672 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3673 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3675 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
3676 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
3677 gfc_resolve_get_command_argument
,
3678 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3679 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3680 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3681 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3683 /* F2003 subroutine to get environment variables. */
3685 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
3686 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
3687 NULL
, NULL
, gfc_resolve_get_environment_variable
,
3688 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3689 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3690 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3691 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3692 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
3694 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
, BT_UNKNOWN
, 0,
3696 gfc_check_move_alloc
, NULL
, NULL
,
3697 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
3698 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3700 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
3701 GFC_STD_F95
, gfc_check_mvbits
, NULL
, gfc_resolve_mvbits
,
3702 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3703 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3704 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3705 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3706 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3708 if (flag_dec_intrinsic_ints
)
3710 make_alias ("bmvbits", GFC_STD_GNU
);
3711 make_alias ("imvbits", GFC_STD_GNU
);
3712 make_alias ("jmvbits", GFC_STD_GNU
);
3713 make_alias ("kmvbits", GFC_STD_GNU
);
3716 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT
, CLASS_IMPURE
,
3717 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3718 gfc_check_random_init
, NULL
, gfc_resolve_random_init
,
3719 "repeatable", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
,
3720 "image_distinct", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
);
3722 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
3723 BT_UNKNOWN
, 0, GFC_STD_F95
,
3724 gfc_check_random_number
, NULL
, gfc_resolve_random_number
,
3725 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3727 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
3728 BT_UNKNOWN
, 0, GFC_STD_F95
,
3729 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
3730 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3731 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3732 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3734 /* The following subroutines are part of ISO_C_BINDING. */
3736 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3737 GFC_STD_F2003
, gfc_check_c_f_pointer
, NULL
, NULL
,
3738 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3739 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
,
3740 "shape", BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3743 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER
, CLASS_IMPURE
,
3744 BT_UNKNOWN
, 0, GFC_STD_F2003
, gfc_check_c_f_procpointer
,
3746 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3747 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3750 /* Internal subroutine for emitting a runtime error. */
3752 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR
, CLASS_IMPURE
,
3753 BT_UNKNOWN
, 0, GFC_STD_GNU
,
3754 gfc_check_fe_runtime_error
, NULL
, gfc_resolve_fe_runtime_error
,
3755 "msg", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3759 make_from_module ();
3761 /* Coarray collectives. */
3762 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST
, CLASS_IMPURE
,
3763 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3764 gfc_check_co_broadcast
, NULL
, NULL
,
3765 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3766 "source_image", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3767 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3768 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3770 add_sym_4s ("co_max", GFC_ISYM_CO_MAX
, CLASS_IMPURE
,
3771 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3772 gfc_check_co_minmax
, NULL
, NULL
,
3773 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3774 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3775 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3776 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3778 add_sym_4s ("co_min", GFC_ISYM_CO_MIN
, CLASS_IMPURE
,
3779 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3780 gfc_check_co_minmax
, NULL
, NULL
,
3781 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3782 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3783 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3784 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3786 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM
, CLASS_IMPURE
,
3787 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3788 gfc_check_co_sum
, NULL
, NULL
,
3789 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3790 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3791 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3792 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3794 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE
, CLASS_IMPURE
,
3795 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3796 gfc_check_co_reduce
, NULL
, NULL
,
3797 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3798 "operation", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3799 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3800 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3801 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3804 /* The following subroutine is internally used for coarray libray functions.
3805 "make_from_module" makes it inaccessible for external users. */
3806 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND
, CLASS_IMPURE
,
3807 BT_UNKNOWN
, 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3808 "x", BT_REAL
, dr
, REQUIRED
, INTENT_OUT
,
3809 "y", BT_REAL
, dr
, REQUIRED
, INTENT_IN
);
3813 /* More G77 compatibility garbage. */
3814 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3815 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
3816 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3817 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3818 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3820 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
3821 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
3822 "seed", BT_INTEGER
, 4, REQUIRED
, INTENT_IN
);
3824 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3825 gfc_check_exit
, NULL
, gfc_resolve_exit
,
3826 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3830 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3831 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
3832 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3833 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3834 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3836 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3837 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
3838 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3839 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3841 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3842 gfc_check_flush
, NULL
, gfc_resolve_flush
,
3843 ut
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3845 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3846 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
3847 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3848 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3849 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3851 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3852 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
3853 c_
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3854 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3856 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3857 gfc_check_free
, NULL
, NULL
,
3858 ptr
, BT_INTEGER
, ii
, REQUIRED
, INTENT_INOUT
);
3860 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3861 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
3862 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3863 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3864 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3865 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3867 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3868 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
3869 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3870 of
, BT_INTEGER
, ii
, REQUIRED
, INTENT_OUT
);
3872 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3873 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
3874 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3875 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3877 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3878 gfc_check_kill_sub
, NULL
, NULL
,
3879 pid
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3880 sig
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3881 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3883 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3884 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
3885 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3886 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3887 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3889 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3890 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
3891 "string", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3893 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3894 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
3895 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3896 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3897 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3899 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3900 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
3901 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3903 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3904 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
3905 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3906 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3907 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3909 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3910 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
3911 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3912 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3913 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3915 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3916 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
3917 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3918 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3919 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3921 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3922 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3923 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3924 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3925 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3927 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3928 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3929 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3930 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3931 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3933 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3934 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3935 com
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3936 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3938 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3939 BT_UNKNOWN
, 0, GFC_STD_F95
,
3940 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3941 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3942 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3943 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3945 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3946 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3947 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3948 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3950 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3951 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3952 msk
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3953 old
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3955 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3956 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3957 "path", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3958 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3962 /* Add a function to the list of conversion symbols. */
3965 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3967 gfc_typespec from
, to
;
3968 gfc_intrinsic_sym
*sym
;
3970 if (sizing
== SZ_CONVS
)
3976 gfc_clear_ts (&from
);
3977 from
.type
= from_type
;
3978 from
.kind
= from_kind
;
3984 sym
= conversion
+ nconv
;
3986 sym
->name
= conv_name (&from
, &to
);
3987 sym
->lib_name
= sym
->name
;
3988 sym
->simplify
.cc
= gfc_convert_constant
;
3989 sym
->standard
= standard
;
3992 sym
->conversion
= 1;
3994 sym
->id
= GFC_ISYM_CONVERSION
;
4000 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
4001 functions by looping over the kind tables. */
4004 add_conversions (void)
4008 /* Integer-Integer conversions. */
4009 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4010 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
4015 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4016 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
4019 /* Integer-Real/Complex conversions. */
4020 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4021 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
4023 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4024 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4026 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
4027 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
4029 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4030 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4032 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
4033 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
4036 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
4038 /* Hollerith-Integer conversions. */
4039 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4040 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4041 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4042 /* Hollerith-Real conversions. */
4043 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4044 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4045 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4046 /* Hollerith-Complex conversions. */
4047 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4048 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4049 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4051 /* Hollerith-Character conversions. */
4052 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
4053 gfc_default_character_kind
, GFC_STD_LEGACY
);
4055 /* Hollerith-Logical conversions. */
4056 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
4057 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
4058 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
4061 /* Real/Complex - Real/Complex conversions. */
4062 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4063 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
4067 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
4068 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4070 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
4071 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4074 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
4075 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4077 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
4078 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
4081 /* Logical/Logical kind conversion. */
4082 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
4083 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
4088 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
4089 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
4092 /* Integer-Logical and Logical-Integer conversions. */
4093 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
4094 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
4095 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
4097 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4098 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
4099 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
4100 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4103 /* DEC legacy feature allows character conversions similar to Hollerith
4104 conversions - the character data will transferred on a byte by byte
4106 if (flag_dec_char_conversions
)
4108 /* Character-Integer conversions. */
4109 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
4110 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4111 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4112 /* Character-Real conversions. */
4113 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4114 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4115 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4116 /* Character-Complex conversions. */
4117 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
4118 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4119 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
4120 /* Character-Logical conversions. */
4121 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
4122 add_conv (BT_CHARACTER
, gfc_default_character_kind
,
4123 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
4129 add_char_conversions (void)
4133 /* Count possible conversions. */
4134 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4135 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4139 /* Allocate memory. */
4140 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
4142 /* Add the conversions themselves. */
4144 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4145 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4147 gfc_typespec from
, to
;
4152 gfc_clear_ts (&from
);
4153 from
.type
= BT_CHARACTER
;
4154 from
.kind
= gfc_character_kinds
[i
].kind
;
4157 to
.type
= BT_CHARACTER
;
4158 to
.kind
= gfc_character_kinds
[j
].kind
;
4160 char_conversions
[n
].name
= conv_name (&from
, &to
);
4161 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
4162 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
4163 char_conversions
[n
].standard
= GFC_STD_F2003
;
4164 char_conversions
[n
].elemental
= 1;
4165 char_conversions
[n
].pure
= 1;
4166 char_conversions
[n
].conversion
= 0;
4167 char_conversions
[n
].ts
= to
;
4168 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
4175 /* Initialize the table of intrinsics. */
4177 gfc_intrinsic_init_1 (void)
4179 nargs
= nfunc
= nsub
= nconv
= 0;
4181 /* Create a namespace to hold the resolved intrinsic symbols. */
4182 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
4191 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
4192 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
4193 + sizeof (gfc_intrinsic_arg
) * nargs
);
4195 next_sym
= functions
;
4196 subroutines
= functions
+ nfunc
;
4198 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
4200 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
4202 sizing
= SZ_NOTHING
;
4209 /* Character conversion intrinsics need to be treated separately. */
4210 add_char_conversions ();
4215 gfc_intrinsic_done_1 (void)
4219 free (char_conversions
);
4220 gfc_free_namespace (gfc_intrinsic_namespace
);
4224 /******** Subroutines to check intrinsic interfaces ***********/
4226 /* Given a formal argument list, remove any NULL arguments that may
4227 have been left behind by a sort against some formal argument list. */
4230 remove_nullargs (gfc_actual_arglist
**ap
)
4232 gfc_actual_arglist
*head
, *tail
, *next
;
4236 for (head
= *ap
; head
; head
= next
)
4240 if (head
->expr
== NULL
&& !head
->label
)
4243 gfc_free_actual_arglist (head
);
4263 set_intrinsic_dummy_arg (gfc_dummy_arg
*&dummy_arg
,
4264 gfc_intrinsic_arg
*intrinsic
)
4266 if (dummy_arg
== NULL
)
4267 dummy_arg
= gfc_get_dummy_arg ();
4269 dummy_arg
->intrinsicness
= GFC_INTRINSIC_DUMMY_ARG
;
4270 dummy_arg
->u
.intrinsic
= intrinsic
;
4274 /* Given an actual arglist and a formal arglist, sort the actual
4275 arglist so that its arguments are in a one-to-one correspondence
4276 with the format arglist. Arguments that are not present are given
4277 a blank gfc_actual_arglist structure. If something is obviously
4278 wrong (say, a missing required argument) we abort sorting and
4282 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
4283 gfc_intrinsic_arg
*formal
, locus
*where
)
4285 gfc_actual_arglist
*actual
, *a
;
4286 gfc_intrinsic_arg
*f
;
4288 remove_nullargs (ap
);
4291 auto_vec
<gfc_intrinsic_arg
*> dummy_args
;
4292 auto_vec
<gfc_actual_arglist
*> ordered_actual_args
;
4294 for (f
= formal
; f
; f
= f
->next
)
4295 dummy_args
.safe_push (f
);
4297 ordered_actual_args
.safe_grow_cleared (dummy_args
.length (),
4303 if (f
== NULL
&& a
== NULL
) /* No arguments */
4306 /* ALLOCATED has two mutually exclusive keywords, but only one
4307 can be present at time and neither is optional. */
4308 if (strcmp (name
, "allocated") == 0)
4312 gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar "
4313 "allocatable entity", where
);
4319 if (strcmp (a
->name
, "scalar") == 0)
4323 if (a
->expr
->rank
!= 0)
4325 gfc_error ("Scalar entity required at %L", &a
->expr
->where
);
4330 else if (strcmp (a
->name
, "array") == 0)
4334 if (a
->expr
->rank
== 0)
4336 gfc_error ("Array entity required at %L", &a
->expr
->where
);
4343 gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
4344 a
->name
, name
, &a
->expr
->where
);
4350 for (int i
= 0;; i
++)
4351 { /* Put the nonkeyword arguments in a 1:1 correspondence */
4357 if (a
->name
!= NULL
)
4360 ordered_actual_args
[i
] = a
;
4370 gfc_error ("Too many arguments in call to %qs at %L", name
, where
);
4374 /* Associate the remaining actual arguments, all of which have
4375 to be keyword arguments. */
4376 for (; a
; a
= a
->next
)
4379 FOR_EACH_VEC_ELT (dummy_args
, idx
, f
)
4380 if (strcmp (a
->name
, f
->name
) == 0)
4385 if (a
->name
[0] == '%')
4386 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4387 "are not allowed in this context at %L", where
);
4389 gfc_error ("Cannot find keyword named %qs in call to %qs at %L",
4390 a
->name
, name
, where
);
4394 if (ordered_actual_args
[idx
] != NULL
)
4396 gfc_error ("Argument %qs appears twice in call to %qs at %L",
4397 f
->name
, name
, where
);
4400 ordered_actual_args
[idx
] = a
;
4404 /* At this point, all unmatched formal args must be optional. */
4406 FOR_EACH_VEC_ELT (dummy_args
, idx
, f
)
4408 if (ordered_actual_args
[idx
] == NULL
&& f
->optional
== 0)
4410 gfc_error ("Missing actual argument %qs in call to %qs at %L",
4411 f
->name
, name
, where
);
4417 /* Using the formal argument list, string the actual argument list
4418 together in a way that corresponds with the formal list. */
4421 FOR_EACH_VEC_ELT (dummy_args
, idx
, f
)
4423 a
= ordered_actual_args
[idx
];
4424 if (a
&& a
->label
!= NULL
)
4426 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
4431 a
= gfc_get_actual_arglist ();
4433 set_intrinsic_dummy_arg (a
->associated_dummy
, f
);
4442 actual
->next
= NULL
; /* End the sorted argument list. */
4448 /* Compare an actual argument list with an intrinsic's formal argument
4449 list. The lists are checked for agreement of type. We don't check
4450 for arrayness here. */
4453 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
4456 gfc_actual_arglist
*actual
;
4457 gfc_intrinsic_arg
*formal
;
4460 formal
= sym
->formal
;
4464 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
4468 if (actual
->expr
== NULL
)
4473 /* A kind of 0 means we don't check for kind. */
4475 ts
.kind
= actual
->expr
->ts
.kind
;
4477 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
4480 gfc_error ("In call to %qs at %L, type mismatch in argument "
4481 "%qs; pass %qs to %qs", gfc_current_intrinsic
,
4482 &actual
->expr
->where
,
4483 gfc_current_intrinsic_arg
[i
]->name
,
4484 gfc_typename (actual
->expr
),
4485 gfc_dummy_typename (&formal
->ts
));
4489 /* F2018, p. 328: An argument to an intrinsic procedure other than
4490 ASSOCIATED, NULL, or PRESENT shall be a data object. An EXPR_NULL
4491 is not a data object. */
4492 if (actual
->expr
->expr_type
== EXPR_NULL
4493 && (!(sym
->id
== GFC_ISYM_ASSOCIATED
4494 || sym
->id
== GFC_ISYM_NULL
4495 || sym
->id
== GFC_ISYM_PRESENT
)))
4497 gfc_invalid_null_arg (actual
->expr
);
4501 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4502 if (formal
->intent
== INTENT_INOUT
|| formal
->intent
== INTENT_OUT
)
4504 const char* context
= (error_flag
4505 ? _("actual argument to INTENT = OUT/INOUT")
4508 /* No pointer arguments for intrinsics. */
4509 if (!gfc_check_vardef_context (actual
->expr
, false, false, false, context
))
4518 /* Given a pointer to an intrinsic symbol and an expression node that
4519 represent the function call to that subroutine, figure out the type
4520 of the result. This may involve calling a resolution subroutine. */
4523 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4525 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4526 gfc_actual_arglist
*arg
;
4528 if (specific
->resolve
.f1
== NULL
)
4530 if (e
->value
.function
.name
== NULL
)
4531 e
->value
.function
.name
= specific
->lib_name
;
4533 if (e
->ts
.type
== BT_UNKNOWN
)
4534 e
->ts
= specific
->ts
;
4538 arg
= e
->value
.function
.actual
;
4540 /* Special case hacks for MIN and MAX. */
4541 if (specific
->resolve
.f1m
== gfc_resolve_max
4542 || specific
->resolve
.f1m
== gfc_resolve_min
)
4544 (*specific
->resolve
.f1m
) (e
, arg
);
4550 (*specific
->resolve
.f0
) (e
);
4559 (*specific
->resolve
.f1
) (e
, a1
);
4568 (*specific
->resolve
.f2
) (e
, a1
, a2
);
4577 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
4586 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
4595 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
4604 (*specific
->resolve
.f6
) (e
, a1
, a2
, a3
, a4
, a5
, a6
);
4608 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4612 /* Given an intrinsic symbol node and an expression node, call the
4613 simplification function (if there is one), perhaps replacing the
4614 expression with something simpler. We return false on an error
4615 of the simplification, true if the simplification worked, even
4616 if nothing has changed in the expression itself. */
4619 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4621 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4622 gfc_actual_arglist
*arg
;
4624 /* Max and min require special handling due to the variable number
4626 if (specific
->simplify
.f1
== gfc_simplify_min
)
4628 result
= gfc_simplify_min (e
);
4632 if (specific
->simplify
.f1
== gfc_simplify_max
)
4634 result
= gfc_simplify_max (e
);
4638 if (specific
->simplify
.f1
== NULL
)
4644 arg
= e
->value
.function
.actual
;
4648 result
= (*specific
->simplify
.f0
) ();
4655 if (specific
->simplify
.cc
== gfc_convert_constant
4656 || specific
->simplify
.cc
== gfc_convert_char_constant
)
4658 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
4663 result
= (*specific
->simplify
.f1
) (a1
);
4670 result
= (*specific
->simplify
.f2
) (a1
, a2
);
4677 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
4684 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
4691 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
4698 result
= (*specific
->simplify
.f6
)
4699 (a1
, a2
, a3
, a4
, a5
, a6
);
4702 ("do_simplify(): Too many args for intrinsic");
4710 if (result
== &gfc_bad_expr
)
4714 resolve_intrinsic (specific
, e
); /* Must call at run-time */
4717 result
->where
= e
->where
;
4718 gfc_replace_expr (e
, result
);
4725 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4726 error messages. This subroutine returns false if a subroutine
4727 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4728 list cannot match any intrinsic. */
4731 init_arglist (gfc_intrinsic_sym
*isym
)
4733 gfc_intrinsic_arg
*formal
;
4736 gfc_current_intrinsic
= isym
->name
;
4739 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
4741 if (i
>= MAX_INTRINSIC_ARGS
)
4742 gfc_internal_error ("init_arglist(): too many arguments");
4743 gfc_current_intrinsic_arg
[i
++] = formal
;
4748 /* Given a pointer to an intrinsic symbol and an expression consisting
4749 of a function call, see if the function call is consistent with the
4750 intrinsic's formal argument list. Return true if the expression
4751 and intrinsic match, false otherwise. */
4754 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
4756 gfc_actual_arglist
*arg
, **ap
;
4759 ap
= &expr
->value
.function
.actual
;
4761 init_arglist (specific
);
4763 /* Don't attempt to sort the argument list for min or max. */
4764 if (specific
->check
.f1m
== gfc_check_min_max
4765 || specific
->check
.f1m
== gfc_check_min_max_integer
4766 || specific
->check
.f1m
== gfc_check_min_max_real
4767 || specific
->check
.f1m
== gfc_check_min_max_double
)
4769 if (!do_ts29113_check (specific
, *ap
))
4771 return (*specific
->check
.f1m
) (*ap
);
4774 if (!sort_actual (specific
->name
, ap
, specific
->formal
, &expr
->where
))
4777 if (!do_ts29113_check (specific
, *ap
))
4780 if (specific
->check
.f5ml
== gfc_check_minloc_maxloc
)
4781 /* This is special because we might have to reorder the argument list. */
4782 t
= gfc_check_minloc_maxloc (*ap
);
4783 else if (specific
->check
.f6fl
== gfc_check_findloc
)
4784 t
= gfc_check_findloc (*ap
);
4785 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
4786 /* This is also special because we also might have to reorder the
4788 t
= gfc_check_minval_maxval (*ap
);
4789 else if (specific
->check
.f3red
== gfc_check_product_sum
)
4790 /* Same here. The difference to the previous case is that we allow a
4791 general numeric type. */
4792 t
= gfc_check_product_sum (*ap
);
4793 else if (specific
->check
.f3red
== gfc_check_transf_bit_intrins
)
4794 /* Same as for PRODUCT and SUM, but different checks. */
4795 t
= gfc_check_transf_bit_intrins (*ap
);
4798 if (specific
->check
.f1
== NULL
)
4800 t
= check_arglist (ap
, specific
, error_flag
);
4802 expr
->ts
= specific
->ts
;
4805 t
= do_check (specific
, *ap
);
4808 /* Check conformance of elemental intrinsics. */
4809 if (t
&& specific
->elemental
)
4812 gfc_expr
*first_expr
;
4813 arg
= expr
->value
.function
.actual
;
4815 /* There is no elemental intrinsic without arguments. */
4816 gcc_assert(arg
!= NULL
);
4817 first_expr
= arg
->expr
;
4819 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
4820 if (!gfc_check_conformance (first_expr
, arg
->expr
,
4821 _("arguments '%s' and '%s' for "
4823 gfc_current_intrinsic_arg
[0]->name
,
4824 gfc_current_intrinsic_arg
[n
]->name
,
4825 gfc_current_intrinsic
))
4830 remove_nullargs (ap
);
4836 /* Check whether an intrinsic belongs to whatever standard the user
4837 has chosen, taking also into account -fall-intrinsics. Here, no
4838 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4839 textual representation of the symbols standard status (like
4840 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4841 can be used to construct a detailed warning/error message in case of
4845 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
4846 const char** symstd
, bool silent
, locus where
)
4848 const char* symstd_msg
;
4850 /* For -fall-intrinsics, just succeed. */
4851 if (flag_all_intrinsics
)
4854 /* Find the symbol's standard message for later usage. */
4855 switch (isym
->standard
)
4858 symstd_msg
= _("available since Fortran 77");
4861 case GFC_STD_F95_OBS
:
4862 symstd_msg
= _("obsolescent in Fortran 95");
4865 case GFC_STD_F95_DEL
:
4866 symstd_msg
= _("deleted in Fortran 95");
4870 symstd_msg
= _("new in Fortran 95");
4874 symstd_msg
= _("new in Fortran 2003");
4878 symstd_msg
= _("new in Fortran 2008");
4882 symstd_msg
= _("new in Fortran 2018");
4886 symstd_msg
= _("a GNU Fortran extension");
4889 case GFC_STD_LEGACY
:
4890 symstd_msg
= _("for backward compatibility");
4894 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
4895 isym
->name
, isym
->standard
);
4898 /* If warning about the standard, warn and succeed. */
4899 if (gfc_option
.warn_std
& isym
->standard
)
4901 /* Do only print a warning if not a GNU extension. */
4902 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
4903 gfc_warning (0, "Intrinsic %qs (%s) used at %L",
4904 isym
->name
, symstd_msg
, &where
);
4909 /* If allowing the symbol's standard, succeed, too. */
4910 if (gfc_option
.allow_std
& isym
->standard
)
4913 /* Otherwise, fail. */
4915 *symstd
= symstd_msg
;
4920 /* See if a function call corresponds to an intrinsic function call.
4923 MATCH_YES if the call corresponds to an intrinsic, simplification
4924 is done if possible.
4926 MATCH_NO if the call does not correspond to an intrinsic
4928 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4929 error during the simplification process.
4931 The error_flag parameter enables an error reporting. */
4934 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
4937 gfc_intrinsic_sym
*isym
, *specific
;
4938 gfc_actual_arglist
*actual
;
4941 if (expr
->value
.function
.isym
!= NULL
)
4942 return (!do_simplify(expr
->value
.function
.isym
, expr
))
4943 ? MATCH_ERROR
: MATCH_YES
;
4946 gfc_push_suppress_errors ();
4949 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
4950 if (actual
->expr
!= NULL
)
4951 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
4952 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
4954 sym
= expr
->symtree
->n
.sym
;
4956 if (sym
->intmod_sym_id
)
4958 gfc_isym_id id
= gfc_isym_id_by_intmod_sym (sym
);
4959 isym
= specific
= gfc_intrinsic_function_by_id (id
);
4962 isym
= specific
= gfc_find_function (sym
->name
);
4967 gfc_pop_suppress_errors ();
4971 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
4972 || isym
->id
== GFC_ISYM_CMPLX
|| isym
->id
== GFC_ISYM_FLOAT
4973 || isym
->id
== GFC_ISYM_SNGL
|| isym
->id
== GFC_ISYM_DFLOAT
)
4974 && gfc_init_expr_flag
4975 && !gfc_notify_std (GFC_STD_F2003
, "Function %qs as initialization "
4976 "expression at %L", sym
->name
, &expr
->where
))
4979 gfc_pop_suppress_errors ();
4983 /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
4984 SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
4985 initialization expressions. */
4987 if (gfc_init_expr_flag
&& isym
->transformational
)
4989 gfc_isym_id id
= isym
->id
;
4990 if (id
!= GFC_ISYM_REPEAT
&& id
!= GFC_ISYM_RESHAPE
4991 && id
!= GFC_ISYM_SI_KIND
&& id
!= GFC_ISYM_SR_KIND
4992 && id
!= GFC_ISYM_TRANSFER
&& id
!= GFC_ISYM_TRIM
4993 && !gfc_notify_std (GFC_STD_F2003
, "Transformational function %qs "
4994 "at %L is invalid in an initialization "
4995 "expression", sym
->name
, &expr
->where
))
4998 gfc_pop_suppress_errors ();
5004 gfc_current_intrinsic_where
= &expr
->where
;
5006 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
5007 if (isym
->check
.f1m
== gfc_check_min_max
)
5009 init_arglist (isym
);
5011 if (isym
->check
.f1m(expr
->value
.function
.actual
))
5015 gfc_pop_suppress_errors ();
5019 /* If the function is generic, check all of its specific
5020 incarnations. If the generic name is also a specific, we check
5021 that name last, so that any error message will correspond to the
5023 gfc_push_suppress_errors ();
5027 for (specific
= isym
->specific_head
; specific
;
5028 specific
= specific
->next
)
5030 if (specific
== isym
)
5032 if (check_specific (specific
, expr
, 0))
5034 gfc_pop_suppress_errors ();
5040 gfc_pop_suppress_errors ();
5042 if (!check_specific (isym
, expr
, error_flag
))
5045 gfc_pop_suppress_errors ();
5052 expr
->value
.function
.isym
= specific
;
5054 gfc_pop_suppress_errors ();
5056 if (!do_simplify (specific
, expr
))
5059 /* F95, 7.1.6.1, Initialization expressions
5060 (4) An elemental intrinsic function reference of type integer or
5061 character where each argument is an initialization expression
5062 of type integer or character
5064 F2003, 7.1.7 Initialization expression
5065 (4) A reference to an elemental standard intrinsic function,
5066 where each argument is an initialization expression */
5068 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
5069 && !gfc_notify_std (GFC_STD_F2003
, "Elemental function as "
5070 "initialization expression with non-integer/non-"
5071 "character arguments at %L", &expr
->where
))
5074 if (sym
->attr
.flavor
== FL_UNKNOWN
)
5076 sym
->attr
.function
= 1;
5077 sym
->attr
.intrinsic
= 1;
5078 sym
->attr
.flavor
= FL_PROCEDURE
;
5080 if (sym
->attr
.flavor
== FL_PROCEDURE
)
5082 sym
->attr
.function
= 1;
5083 sym
->attr
.proc
= PROC_INTRINSIC
;
5087 gfc_intrinsic_symbol (sym
);
5089 /* Have another stab at simplification since elemental intrinsics with array
5090 actual arguments would be missed by the calls above to do_simplify. */
5091 if (isym
->elemental
)
5092 gfc_simplify_expr (expr
, 1);
5098 /* See if a CALL statement corresponds to an intrinsic subroutine.
5099 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
5100 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
5104 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
5106 gfc_intrinsic_sym
*isym
;
5109 name
= c
->symtree
->n
.sym
->name
;
5111 if (c
->symtree
->n
.sym
->intmod_sym_id
)
5114 id
= gfc_isym_id_by_intmod_sym (c
->symtree
->n
.sym
);
5115 isym
= gfc_intrinsic_subroutine_by_id (id
);
5118 isym
= gfc_find_subroutine (name
);
5123 gfc_push_suppress_errors ();
5125 init_arglist (isym
);
5127 if (!isym
->vararg
&& !sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
))
5130 if (!do_ts29113_check (isym
, c
->ext
.actual
))
5133 if (isym
->check
.f1
!= NULL
)
5135 if (!do_check (isym
, c
->ext
.actual
))
5140 if (!check_arglist (&c
->ext
.actual
, isym
, 1))
5144 /* The subroutine corresponds to an intrinsic. Allow errors to be
5145 seen at this point. */
5147 gfc_pop_suppress_errors ();
5149 c
->resolved_isym
= isym
;
5150 if (isym
->resolve
.s1
!= NULL
)
5151 isym
->resolve
.s1 (c
);
5154 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
5155 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
5158 if (gfc_do_concurrent_flag
&& !isym
->pure
)
5160 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
5161 "block at %L is not PURE", name
, &c
->loc
);
5165 if (!isym
->pure
&& gfc_pure (NULL
))
5167 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name
,
5173 gfc_unset_implicit_pure (NULL
);
5175 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
5181 gfc_pop_suppress_errors ();
5186 /* Call gfc_convert_type() with warning enabled. */
5189 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
5191 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
5195 /* Try to convert an expression (in place) from one type to another.
5196 'eflag' controls the behavior on error.
5198 The possible values are:
5200 1 Generate a gfc_error()
5201 2 Generate a gfc_internal_error().
5203 'wflag' controls the warning related to conversion.
5205 'array' indicates whether the conversion is in an array constructor.
5206 Non-standard conversion from character to numeric not allowed if true.
5210 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
,
5213 gfc_intrinsic_sym
*sym
;
5214 gfc_typespec from_ts
;
5219 bool is_char_constant
= (expr
->expr_type
== EXPR_CONSTANT
)
5220 && (expr
->ts
.type
== BT_CHARACTER
);
5222 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
5224 if (ts
->type
== BT_UNKNOWN
)
5227 expr
->do_not_warn
= ! wflag
;
5229 /* NULL and zero size arrays get their type here, unless they already have a
5231 if ((expr
->expr_type
== EXPR_NULL
5232 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
5233 && expr
->ts
.type
== BT_UNKNOWN
)
5235 /* Sometimes the RHS acquire the type. */
5240 if (expr
->ts
.type
== BT_UNKNOWN
)
5243 /* In building an array constructor, gfortran can end up here when no
5244 conversion is required for an intrinsic type. We need to let derived
5245 types drop through. */
5246 if (from_ts
.type
!= BT_DERIVED
&& from_ts
.type
!= BT_CLASS
5247 && (from_ts
.type
== ts
->type
&& from_ts
.kind
== ts
->kind
))
5250 if ((expr
->ts
.type
== BT_DERIVED
|| expr
->ts
.type
== BT_CLASS
)
5251 && (ts
->type
== BT_DERIVED
|| ts
->type
== BT_CLASS
)
5252 && gfc_compare_types (ts
, &expr
->ts
))
5255 /* If array is true then conversion is in an array constructor where
5256 non-standard conversion is not allowed. */
5257 if (array
&& from_ts
.type
== BT_CHARACTER
5258 && (gfc_numeric_ts (ts
) || ts
->type
== BT_LOGICAL
))
5261 sym
= find_conv (&expr
->ts
, ts
);
5265 /* At this point, a conversion is necessary. A warning may be needed. */
5266 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
5268 const char *type_name
= is_char_constant
? gfc_typename (expr
)
5269 : gfc_typename (&from_ts
);
5270 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
5271 type_name
, gfc_dummy_typename (ts
),
5276 if (flag_range_check
&& expr
->expr_type
== EXPR_CONSTANT
5277 && from_ts
.type
== ts
->type
)
5279 /* Do nothing. Constants of the same type are range-checked
5280 elsewhere. If a value too large for the target type is
5281 assigned, an error is generated. Not checking here avoids
5282 duplications of warnings/errors.
5283 If range checking was disabled, but -Wconversion enabled,
5284 a non range checked warning is generated below. */
5286 else if (flag_dec_char_conversions
&& from_ts
.type
== BT_CHARACTER
5287 && (gfc_numeric_ts (ts
) || ts
->type
== BT_LOGICAL
))
5289 const char *type_name
= is_char_constant
? gfc_typename (expr
)
5290 : gfc_typename (&from_ts
);
5291 gfc_warning_now (OPT_Wconversion
, "Nonstandard conversion from %s "
5292 "to %s at %L", type_name
, gfc_typename (ts
),
5295 else if (from_ts
.type
== ts
->type
5296 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
5297 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
5298 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
5300 /* Larger kinds can hold values of smaller kinds without problems.
5301 Hence, only warn if target kind is smaller than the source
5302 kind - or if -Wconversion-extra is specified. LOGICAL values
5303 will always fit regardless of kind so ignore conversion. */
5304 if (expr
->expr_type
!= EXPR_CONSTANT
5305 && ts
->type
!= BT_LOGICAL
)
5307 if (warn_conversion
&& from_ts
.kind
> ts
->kind
)
5308 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5309 "conversion from %s to %s at %L",
5310 gfc_typename (&from_ts
), gfc_typename (ts
),
5313 gfc_warning_now (OPT_Wconversion_extra
, "Conversion from %s to %s "
5314 "at %L", gfc_typename (&from_ts
),
5315 gfc_typename (ts
), &expr
->where
);
5318 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
5319 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
5320 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
5322 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
5323 usually comes with a loss of information, regardless of kinds. */
5324 if (expr
->expr_type
!= EXPR_CONSTANT
)
5325 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5326 "conversion from %s to %s at %L",
5327 gfc_typename (&from_ts
), gfc_typename (ts
),
5330 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
5332 /* If HOLLERITH is involved, all bets are off. */
5333 gfc_warning_now (OPT_Wconversion
, "Conversion from %s to %s at %L",
5334 gfc_typename (&from_ts
), gfc_dummy_typename (ts
),
5337 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
5339 /* Do nothing. This block exists only to simplify the other
5340 else-if expressions.
5341 LOGICAL <> LOGICAL no warning, independent of kind values
5342 LOGICAL <> INTEGER extension, warned elsewhere
5343 LOGICAL <> REAL invalid, error generated elsewhere
5344 LOGICAL <> COMPLEX invalid, error generated elsewhere */
5350 /* Insert a pre-resolved function call to the right function. */
5351 old_where
= expr
->where
;
5353 shape
= expr
->shape
;
5355 new_expr
= gfc_get_expr ();
5358 new_expr
= gfc_build_conversion (new_expr
);
5359 new_expr
->value
.function
.name
= sym
->lib_name
;
5360 new_expr
->value
.function
.isym
= sym
;
5361 new_expr
->where
= old_where
;
5363 new_expr
->rank
= rank
;
5364 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5366 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5367 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
5368 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5369 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5370 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5371 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5372 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5373 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
5374 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5375 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5376 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5383 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5384 && !do_simplify (sym
, expr
))
5389 return false; /* Error already generated in do_simplify() */
5395 const char *type_name
= is_char_constant
? gfc_typename (expr
)
5396 : gfc_typename (&from_ts
);
5399 gfc_error ("Cannot convert %s to %s at %L", type_name
, gfc_typename (ts
),
5404 gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name
,
5405 gfc_typename (ts
), &expr
->where
);
5411 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
5413 gfc_intrinsic_sym
*sym
;
5419 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
5421 sym
= find_char_conv (&expr
->ts
, ts
);
5425 /* Insert a pre-resolved function call to the right function. */
5426 old_where
= expr
->where
;
5428 shape
= expr
->shape
;
5430 new_expr
= gfc_get_expr ();
5433 new_expr
= gfc_build_conversion (new_expr
);
5434 new_expr
->value
.function
.name
= sym
->lib_name
;
5435 new_expr
->value
.function
.isym
= sym
;
5436 new_expr
->where
= old_where
;
5438 new_expr
->rank
= rank
;
5439 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5441 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5442 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5443 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5444 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5445 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5446 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5447 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5448 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5449 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5456 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5457 && !do_simplify (sym
, expr
))
5459 /* Error already generated in do_simplify() */
5467 /* Check if the passed name is name of an intrinsic (taking into account the
5468 current -std=* and -fall-intrinsic settings). If it is, see if we should
5469 warn about this as a user-procedure having the same name as an intrinsic
5470 (-Wintrinsic-shadow enabled) and do so if we should. */
5473 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
5475 gfc_intrinsic_sym
* isym
;
5477 /* If the warning is disabled, do nothing at all. */
5478 if (!warn_intrinsic_shadow
)
5481 /* Try to find an intrinsic of the same name. */
5483 isym
= gfc_find_function (sym
->name
);
5485 isym
= gfc_find_subroutine (sym
->name
);
5487 /* If no intrinsic was found with this name or it's not included in the
5488 selected standard, everything's fine. */
5489 if (!isym
|| !gfc_check_intrinsic_standard (isym
, NULL
, true,
5493 /* Emit the warning. */
5494 if (in_module
|| sym
->ns
->proc_name
)
5495 gfc_warning (OPT_Wintrinsic_shadow
,
5496 "%qs declared at %L may shadow the intrinsic of the same"
5497 " name. In order to call the intrinsic, explicit INTRINSIC"
5498 " declarations may be required.",
5499 sym
->name
, &sym
->declared_at
);
5501 gfc_warning (OPT_Wintrinsic_shadow
,
5502 "%qs declared at %L is also the name of an intrinsic. It can"
5503 " only be called via an explicit interface or if declared"
5504 " EXTERNAL.", sym
->name
, &sym
->declared_at
);