1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000-2018 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 /* Get a symbol for a resolved name. Note, if needed be, the elemental
107 attribute has be added afterwards. */
110 gfc_get_intrinsic_sub_symbol (const char *name
)
114 gfc_get_symbol (name
, gfc_intrinsic_namespace
, &sym
);
115 sym
->attr
.always_explicit
= 1;
116 sym
->attr
.subroutine
= 1;
117 sym
->attr
.flavor
= FL_PROCEDURE
;
118 sym
->attr
.proc
= PROC_INTRINSIC
;
120 gfc_commit_symbol (sym
);
126 /* Return a pointer to the name of a conversion function given two
130 conv_name (gfc_typespec
*from
, gfc_typespec
*to
)
132 return gfc_get_string ("__convert_%c%d_%c%d",
133 gfc_type_letter (from
->type
), from
->kind
,
134 gfc_type_letter (to
->type
), to
->kind
);
138 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
139 corresponds to the conversion. Returns NULL if the conversion
142 static gfc_intrinsic_sym
*
143 find_conv (gfc_typespec
*from
, gfc_typespec
*to
)
145 gfc_intrinsic_sym
*sym
;
149 target
= conv_name (from
, to
);
152 for (i
= 0; i
< nconv
; i
++, sym
++)
153 if (target
== sym
->name
)
160 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
161 that corresponds to the conversion. Returns NULL if the conversion
164 static gfc_intrinsic_sym
*
165 find_char_conv (gfc_typespec
*from
, gfc_typespec
*to
)
167 gfc_intrinsic_sym
*sym
;
171 target
= conv_name (from
, to
);
172 sym
= char_conversions
;
174 for (i
= 0; i
< ncharconv
; i
++, sym
++)
175 if (target
== sym
->name
)
182 /* Check TS29113, C407b for assumed type and C535b for assumed-rank,
183 and a likewise check for NO_ARG_CHECK. */
186 do_ts29113_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
188 gfc_actual_arglist
*a
;
190 for (a
= arg
; a
; a
= a
->next
)
195 if (a
->expr
->expr_type
== EXPR_VARIABLE
196 && (a
->expr
->symtree
->n
.sym
->attr
.ext_attr
197 & (1 << EXT_ATTR_NO_ARG_CHECK
))
198 && specific
->id
!= GFC_ISYM_C_LOC
199 && specific
->id
!= GFC_ISYM_PRESENT
)
201 gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
202 "permitted as argument to the intrinsic functions "
203 "C_LOC and PRESENT", &a
->expr
->where
);
206 else if (a
->expr
->ts
.type
== BT_ASSUMED
207 && specific
->id
!= GFC_ISYM_LBOUND
208 && specific
->id
!= GFC_ISYM_PRESENT
209 && specific
->id
!= GFC_ISYM_RANK
210 && specific
->id
!= GFC_ISYM_SHAPE
211 && specific
->id
!= GFC_ISYM_SIZE
212 && specific
->id
!= GFC_ISYM_SIZEOF
213 && specific
->id
!= GFC_ISYM_UBOUND
214 && specific
->id
!= GFC_ISYM_C_LOC
)
216 gfc_error ("Assumed-type argument at %L is not permitted as actual"
217 " argument to the intrinsic %s", &a
->expr
->where
,
218 gfc_current_intrinsic
);
221 else if (a
->expr
->ts
.type
== BT_ASSUMED
&& a
!= arg
)
223 gfc_error ("Assumed-type argument at %L is only permitted as "
224 "first actual argument to the intrinsic %s",
225 &a
->expr
->where
, gfc_current_intrinsic
);
228 if (a
->expr
->rank
== -1 && !specific
->inquiry
)
230 gfc_error ("Assumed-rank argument at %L is only permitted as actual "
231 "argument to intrinsic inquiry functions",
235 if (a
->expr
->rank
== -1 && arg
!= a
)
237 gfc_error ("Assumed-rank argument at %L is only permitted as first "
238 "actual argument to the intrinsic inquiry function %s",
239 &a
->expr
->where
, gfc_current_intrinsic
);
248 /* Interface to the check functions. We break apart an argument list
249 and call the proper check function rather than forcing each
250 function to manipulate the argument list. */
253 do_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
255 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
258 return (*specific
->check
.f0
) ();
263 return (*specific
->check
.f1
) (a1
);
268 return (*specific
->check
.f2
) (a1
, a2
);
273 return (*specific
->check
.f3
) (a1
, a2
, a3
);
278 return (*specific
->check
.f4
) (a1
, a2
, a3
, a4
);
283 return (*specific
->check
.f5
) (a1
, a2
, a3
, a4
, a5
);
285 gfc_internal_error ("do_check(): too many args");
289 /*********** Subroutines to build the intrinsic list ****************/
291 /* Add a single intrinsic symbol to the current list.
294 char * name of function
295 int whether function is elemental
296 int If the function can be used as an actual argument [1]
297 bt return type of function
298 int kind of return type of function
299 int Fortran standard version
300 check pointer to check function
301 simplify pointer to simplification function
302 resolve pointer to resolution function
304 Optional arguments come in multiples of five:
305 char * name of argument
308 int arg optional flag (1=optional, 0=required)
309 sym_intent intent of argument
311 The sequence is terminated by a NULL name.
314 [1] Whether a function can or cannot be used as an actual argument is
315 determined by its presence on the 13.6 list in Fortran 2003. The
316 following intrinsics, which are GNU extensions, are considered allowed
317 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
318 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
321 add_sym (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
, int kind
,
322 int standard
, gfc_check_f check
, gfc_simplify_f simplify
,
323 gfc_resolve_f resolve
, ...)
325 char buf
[GFC_MAX_SYMBOL_LEN
+ 11]; /* 10 for '_gfortran_', 1 for '\0' */
326 int optional
, first_flag
;
341 next_sym
->name
= gfc_get_string ("%s", name
);
343 strcpy (buf
, "_gfortran_");
345 next_sym
->lib_name
= gfc_get_string ("%s", buf
);
347 next_sym
->pure
= (cl
!= CLASS_IMPURE
);
348 next_sym
->elemental
= (cl
== CLASS_ELEMENTAL
);
349 next_sym
->inquiry
= (cl
== CLASS_INQUIRY
);
350 next_sym
->transformational
= (cl
== CLASS_TRANSFORMATIONAL
);
351 next_sym
->actual_ok
= actual_ok
;
352 next_sym
->ts
.type
= type
;
353 next_sym
->ts
.kind
= kind
;
354 next_sym
->standard
= standard
;
355 next_sym
->simplify
= simplify
;
356 next_sym
->check
= check
;
357 next_sym
->resolve
= resolve
;
358 next_sym
->specific
= 0;
359 next_sym
->generic
= 0;
360 next_sym
->conversion
= 0;
365 gfc_internal_error ("add_sym(): Bad sizing mode");
368 va_start (argp
, resolve
);
374 name
= va_arg (argp
, char *);
378 type
= (bt
) va_arg (argp
, int);
379 kind
= va_arg (argp
, int);
380 optional
= va_arg (argp
, int);
381 intent
= (sym_intent
) va_arg (argp
, int);
383 if (sizing
!= SZ_NOTHING
)
390 next_sym
->formal
= next_arg
;
392 (next_arg
- 1)->next
= next_arg
;
396 strcpy (next_arg
->name
, name
);
397 next_arg
->ts
.type
= type
;
398 next_arg
->ts
.kind
= kind
;
399 next_arg
->optional
= optional
;
401 next_arg
->intent
= intent
;
411 /* Add a symbol to the function list where the function takes
415 add_sym_0 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
416 int kind
, int standard
,
417 bool (*check
) (void),
418 gfc_expr
*(*simplify
) (void),
419 void (*resolve
) (gfc_expr
*))
429 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
434 /* Add a symbol to the subroutine list where the subroutine takes
438 add_sym_0s (const char *name
, gfc_isym_id id
, int standard
,
439 void (*resolve
) (gfc_code
*))
449 add_sym (name
, id
, CLASS_IMPURE
, ACTUAL_NO
, BT_UNKNOWN
, 0, standard
, cf
, sf
,
454 /* Add a symbol to the function list where the function takes
458 add_sym_1 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
459 int kind
, int standard
,
460 bool (*check
) (gfc_expr
*),
461 gfc_expr
*(*simplify
) (gfc_expr
*),
462 void (*resolve
) (gfc_expr
*, gfc_expr
*),
463 const char *a1
, bt type1
, int kind1
, int optional1
)
473 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
474 a1
, type1
, kind1
, optional1
, INTENT_IN
,
479 /* Add a symbol to the function list where the function takes
480 1 arguments, specifying the intent of the argument. */
483 add_sym_1_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
484 int actual_ok
, bt type
, int kind
, int standard
,
485 bool (*check
) (gfc_expr
*),
486 gfc_expr
*(*simplify
) (gfc_expr
*),
487 void (*resolve
) (gfc_expr
*, gfc_expr
*),
488 const char *a1
, bt type1
, int kind1
, int optional1
,
499 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
500 a1
, type1
, kind1
, optional1
, intent1
,
505 /* Add a symbol to the subroutine list where the subroutine takes
506 1 arguments, specifying the intent of the argument. */
509 add_sym_1s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
510 int standard
, bool (*check
) (gfc_expr
*),
511 gfc_expr
*(*simplify
) (gfc_expr
*), void (*resolve
) (gfc_code
*),
512 const char *a1
, bt type1
, int kind1
, int optional1
,
523 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
524 a1
, type1
, kind1
, optional1
, intent1
,
528 /* Add a symbol to the subroutine ilst where the subroutine takes one
529 printf-style character argument and a variable number of arguments
533 add_sym_1p (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
534 int standard
, bool (*check
) (gfc_actual_arglist
*),
535 gfc_expr
*(*simplify
) (gfc_expr
*), void (*resolve
) (gfc_code
*),
536 const char *a1
, bt type1
, int kind1
, int optional1
, sym_intent intent1
)
546 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
547 a1
, type1
, kind1
, optional1
, intent1
,
552 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
553 function. MAX et al take 2 or more arguments. */
556 add_sym_1m (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
557 int kind
, int standard
,
558 bool (*check
) (gfc_actual_arglist
*),
559 gfc_expr
*(*simplify
) (gfc_expr
*),
560 void (*resolve
) (gfc_expr
*, gfc_actual_arglist
*),
561 const char *a1
, bt type1
, int kind1
, int optional1
,
562 const char *a2
, bt type2
, int kind2
, int optional2
)
572 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
573 a1
, type1
, kind1
, optional1
, INTENT_IN
,
574 a2
, type2
, kind2
, optional2
, INTENT_IN
,
579 /* Add a symbol to the function list where the function takes
583 add_sym_2 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
584 int kind
, int standard
,
585 bool (*check
) (gfc_expr
*, gfc_expr
*),
586 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
587 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
588 const char *a1
, bt type1
, int kind1
, int optional1
,
589 const char *a2
, bt type2
, int kind2
, int optional2
)
599 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
600 a1
, type1
, kind1
, optional1
, INTENT_IN
,
601 a2
, type2
, kind2
, optional2
, INTENT_IN
,
606 /* Add a symbol to the function list where the function takes
607 2 arguments; same as add_sym_2 - but allows to specify the intent. */
610 add_sym_2_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
611 int actual_ok
, bt type
, int kind
, int standard
,
612 bool (*check
) (gfc_expr
*, gfc_expr
*),
613 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
614 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
615 const char *a1
, bt type1
, int kind1
, int optional1
,
616 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
617 int optional2
, sym_intent intent2
)
627 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
628 a1
, type1
, kind1
, optional1
, intent1
,
629 a2
, type2
, kind2
, optional2
, intent2
,
634 /* Add a symbol to the subroutine list where the subroutine takes
635 2 arguments, specifying the intent of the arguments. */
638 add_sym_2s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
639 int kind
, int standard
,
640 bool (*check
) (gfc_expr
*, gfc_expr
*),
641 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
642 void (*resolve
) (gfc_code
*),
643 const char *a1
, bt type1
, int kind1
, int optional1
,
644 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
645 int optional2
, sym_intent intent2
)
655 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
656 a1
, type1
, kind1
, optional1
, intent1
,
657 a2
, type2
, kind2
, optional2
, intent2
,
662 /* Add a symbol to the function list where the function takes
666 add_sym_3 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
667 int kind
, int standard
,
668 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
669 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
670 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
671 const char *a1
, bt type1
, int kind1
, int optional1
,
672 const char *a2
, bt type2
, int kind2
, int optional2
,
673 const char *a3
, bt type3
, int kind3
, int optional3
)
683 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
684 a1
, type1
, kind1
, optional1
, INTENT_IN
,
685 a2
, type2
, kind2
, optional2
, INTENT_IN
,
686 a3
, type3
, kind3
, optional3
, INTENT_IN
,
691 /* MINLOC and MAXLOC get special treatment because their
692 argument might have to be reordered. */
695 add_sym_5ml (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
696 int kind
, int standard
,
697 bool (*check
) (gfc_actual_arglist
*),
698 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
699 gfc_expr
*, gfc_expr
*),
700 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
701 gfc_expr
*, gfc_expr
*),
702 const char *a1
, bt type1
, int kind1
, int optional1
,
703 const char *a2
, bt type2
, int kind2
, int optional2
,
704 const char *a3
, bt type3
, int kind3
, int optional3
,
705 const char *a4
, bt type4
, int kind4
, int optional4
,
706 const char *a5
, bt type5
, int kind5
, int optional5
)
716 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
717 a1
, type1
, kind1
, optional1
, INTENT_IN
,
718 a2
, type2
, kind2
, optional2
, INTENT_IN
,
719 a3
, type3
, kind3
, optional3
, INTENT_IN
,
720 a4
, type4
, kind4
, optional4
, INTENT_IN
,
721 a5
, type5
, kind5
, optional5
, INTENT_IN
,
725 /* Similar for FINDLOC. */
728 add_sym_6fl (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
,
729 bt type
, int kind
, int standard
,
730 bool (*check
) (gfc_actual_arglist
*),
731 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
732 gfc_expr
*, gfc_expr
*, gfc_expr
*),
733 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
734 gfc_expr
*, gfc_expr
*, gfc_expr
*),
735 const char *a1
, bt type1
, int kind1
, int optional1
,
736 const char *a2
, bt type2
, int kind2
, int optional2
,
737 const char *a3
, bt type3
, int kind3
, int optional3
,
738 const char *a4
, bt type4
, int kind4
, int optional4
,
739 const char *a5
, bt type5
, int kind5
, int optional5
,
740 const char *a6
, bt type6
, int kind6
, int optional6
)
751 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
752 a1
, type1
, kind1
, optional1
, INTENT_IN
,
753 a2
, type2
, kind2
, optional2
, INTENT_IN
,
754 a3
, type3
, kind3
, optional3
, INTENT_IN
,
755 a4
, type4
, kind4
, optional4
, INTENT_IN
,
756 a5
, type5
, kind5
, optional5
, INTENT_IN
,
757 a6
, type6
, kind6
, optional6
, INTENT_IN
,
762 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
763 their argument also might have to be reordered. */
766 add_sym_3red (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
767 int kind
, int standard
,
768 bool (*check
) (gfc_actual_arglist
*),
769 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
770 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
771 const char *a1
, bt type1
, int kind1
, int optional1
,
772 const char *a2
, bt type2
, int kind2
, int optional2
,
773 const char *a3
, bt type3
, int kind3
, int optional3
)
783 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
784 a1
, type1
, kind1
, optional1
, INTENT_IN
,
785 a2
, type2
, kind2
, optional2
, INTENT_IN
,
786 a3
, type3
, kind3
, optional3
, INTENT_IN
,
791 /* Add a symbol to the subroutine list where the subroutine takes
792 3 arguments, specifying the intent of the arguments. */
795 add_sym_3s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
796 int kind
, int standard
,
797 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
798 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
799 void (*resolve
) (gfc_code
*),
800 const char *a1
, bt type1
, int kind1
, int optional1
,
801 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
802 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
803 int kind3
, int optional3
, sym_intent intent3
)
813 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
814 a1
, type1
, kind1
, optional1
, intent1
,
815 a2
, type2
, kind2
, optional2
, intent2
,
816 a3
, type3
, kind3
, optional3
, intent3
,
821 /* Add a symbol to the function list where the function takes
825 add_sym_4 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
826 int kind
, int standard
,
827 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
828 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
830 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
832 const char *a1
, bt type1
, int kind1
, int optional1
,
833 const char *a2
, bt type2
, int kind2
, int optional2
,
834 const char *a3
, bt type3
, int kind3
, int optional3
,
835 const char *a4
, bt type4
, int kind4
, int optional4
)
845 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
846 a1
, type1
, kind1
, optional1
, INTENT_IN
,
847 a2
, type2
, kind2
, optional2
, INTENT_IN
,
848 a3
, type3
, kind3
, optional3
, INTENT_IN
,
849 a4
, type4
, kind4
, optional4
, INTENT_IN
,
854 /* Add a symbol to the subroutine list where the subroutine takes
858 add_sym_4s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
860 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
861 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
863 void (*resolve
) (gfc_code
*),
864 const char *a1
, bt type1
, int kind1
, int optional1
,
865 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
866 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
867 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
868 bt type4
, int kind4
, int optional4
, sym_intent intent4
)
878 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
879 a1
, type1
, kind1
, optional1
, intent1
,
880 a2
, type2
, kind2
, optional2
, intent2
,
881 a3
, type3
, kind3
, optional3
, intent3
,
882 a4
, type4
, kind4
, optional4
, intent4
,
887 /* Add a symbol to the subroutine list where the subroutine takes
891 add_sym_5s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
893 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
895 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
896 gfc_expr
*, gfc_expr
*),
897 void (*resolve
) (gfc_code
*),
898 const char *a1
, bt type1
, int kind1
, int optional1
,
899 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
900 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
901 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
902 bt type4
, int kind4
, int optional4
, sym_intent intent4
,
903 const char *a5
, bt type5
, int kind5
, int optional5
,
914 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
915 a1
, type1
, kind1
, optional1
, intent1
,
916 a2
, type2
, kind2
, optional2
, intent2
,
917 a3
, type3
, kind3
, optional3
, intent3
,
918 a4
, type4
, kind4
, optional4
, intent4
,
919 a5
, type5
, kind5
, optional5
, intent5
,
924 /* Locate an intrinsic symbol given a base pointer, number of elements
925 in the table and a pointer to a name. Returns the NULL pointer if
926 a name is not found. */
928 static gfc_intrinsic_sym
*
929 find_sym (gfc_intrinsic_sym
*start
, int n
, const char *name
)
931 /* name may be a user-supplied string, so we must first make sure
932 that we're comparing against a pointer into the global string
934 const char *p
= gfc_get_string ("%s", name
);
938 if (p
== start
->name
)
950 gfc_isym_id_by_intmod (intmod_id from_intmod
, int intmod_sym_id
)
952 if (from_intmod
== INTMOD_NONE
)
953 return (gfc_isym_id
) intmod_sym_id
;
954 else if (from_intmod
== INTMOD_ISO_C_BINDING
)
955 return (gfc_isym_id
) c_interop_kinds_table
[intmod_sym_id
].value
;
956 else if (from_intmod
== INTMOD_ISO_FORTRAN_ENV
)
957 switch (intmod_sym_id
)
959 #define NAMED_SUBROUTINE(a,b,c,d) \
961 return (gfc_isym_id) c;
962 #define NAMED_FUNCTION(a,b,c,d) \
964 return (gfc_isym_id) c;
965 #include "iso-fortran-env.def"
971 return (gfc_isym_id
) 0;
976 gfc_isym_id_by_intmod_sym (gfc_symbol
*sym
)
978 return gfc_isym_id_by_intmod (sym
->from_intmod
, sym
->intmod_sym_id
);
983 gfc_intrinsic_subroutine_by_id (gfc_isym_id id
)
985 gfc_intrinsic_sym
*start
= subroutines
;
1001 gfc_intrinsic_function_by_id (gfc_isym_id id
)
1003 gfc_intrinsic_sym
*start
= functions
;
1009 if (id
== start
->id
)
1018 /* Given a name, find a function in the intrinsic function table.
1019 Returns NULL if not found. */
1022 gfc_find_function (const char *name
)
1024 gfc_intrinsic_sym
*sym
;
1026 sym
= find_sym (functions
, nfunc
, name
);
1027 if (!sym
|| sym
->from_module
)
1028 sym
= find_sym (conversion
, nconv
, name
);
1030 return (!sym
|| sym
->from_module
) ? NULL
: sym
;
1034 /* Given a name, find a function in the intrinsic subroutine table.
1035 Returns NULL if not found. */
1038 gfc_find_subroutine (const char *name
)
1040 gfc_intrinsic_sym
*sym
;
1041 sym
= find_sym (subroutines
, nsub
, name
);
1042 return (!sym
|| sym
->from_module
) ? NULL
: sym
;
1046 /* Given a string, figure out if it is the name of a generic intrinsic
1050 gfc_generic_intrinsic (const char *name
)
1052 gfc_intrinsic_sym
*sym
;
1054 sym
= gfc_find_function (name
);
1055 return (!sym
|| sym
->from_module
) ? 0 : sym
->generic
;
1059 /* Given a string, figure out if it is the name of a specific
1060 intrinsic function or not. */
1063 gfc_specific_intrinsic (const char *name
)
1065 gfc_intrinsic_sym
*sym
;
1067 sym
= gfc_find_function (name
);
1068 return (!sym
|| sym
->from_module
) ? 0 : sym
->specific
;
1072 /* Given a string, figure out if it is the name of an intrinsic function
1073 or subroutine allowed as an actual argument or not. */
1075 gfc_intrinsic_actual_ok (const char *name
, const bool subroutine_flag
)
1077 gfc_intrinsic_sym
*sym
;
1079 /* Intrinsic subroutines are not allowed as actual arguments. */
1080 if (subroutine_flag
)
1084 sym
= gfc_find_function (name
);
1085 return (sym
== NULL
) ? 0 : sym
->actual_ok
;
1090 /* Given a symbol, find out if it is (and is to be treated as) an intrinsic.
1091 If its name refers to an intrinsic, but this intrinsic is not included in
1092 the selected standard, this returns FALSE and sets the symbol's external
1096 gfc_is_intrinsic (gfc_symbol
* sym
, int subroutine_flag
, locus loc
)
1098 gfc_intrinsic_sym
* isym
;
1101 /* If INTRINSIC attribute is already known, return. */
1102 if (sym
->attr
.intrinsic
)
1105 /* Check for attributes which prevent the symbol from being INTRINSIC. */
1106 if (sym
->attr
.external
|| sym
->attr
.contained
1107 || sym
->attr
.if_source
== IFSRC_IFBODY
)
1110 if (subroutine_flag
)
1111 isym
= gfc_find_subroutine (sym
->name
);
1113 isym
= gfc_find_function (sym
->name
);
1115 /* No such intrinsic available at all? */
1119 /* See if this intrinsic is allowed in the current standard. */
1120 if (!gfc_check_intrinsic_standard (isym
, &symstd
, false, loc
)
1121 && !sym
->attr
.artificial
)
1123 if (sym
->attr
.proc
== PROC_UNKNOWN
&& warn_intrinsics_std
)
1124 gfc_warning_now (OPT_Wintrinsics_std
, "The intrinsic %qs at %L is not "
1125 "included in the selected standard but %s and %qs will"
1126 " be treated as if declared EXTERNAL. Use an"
1127 " appropriate -std=* option or define"
1128 " -fall-intrinsics to allow this intrinsic.",
1129 sym
->name
, &loc
, symstd
, sym
->name
);
1138 /* Collect a set of intrinsic functions into a generic collection.
1139 The first argument is the name of the generic function, which is
1140 also the name of a specific function. The rest of the specifics
1141 currently in the table are placed into the list of specific
1142 functions associated with that generic.
1145 FIXME: Remove the argument STANDARD if no regressions are
1146 encountered. Change all callers (approx. 360).
1150 make_generic (const char *name
, gfc_isym_id id
, int standard ATTRIBUTE_UNUSED
)
1152 gfc_intrinsic_sym
*g
;
1154 if (sizing
!= SZ_NOTHING
)
1157 g
= gfc_find_function (name
);
1159 gfc_internal_error ("make_generic(): Can't find generic symbol %qs",
1162 gcc_assert (g
->id
== id
);
1166 if ((g
+ 1)->name
!= NULL
)
1167 g
->specific_head
= g
+ 1;
1170 while (g
->name
!= NULL
)
1182 /* Create a duplicate intrinsic function entry for the current
1183 function, the only differences being the alternate name and
1184 a different standard if necessary. Note that we use argument
1185 lists more than once, but all argument lists are freed as a
1189 make_alias (const char *name
, int standard
)
1202 next_sym
[0] = next_sym
[-1];
1203 next_sym
->name
= gfc_get_string ("%s", name
);
1204 next_sym
->standard
= standard
;
1214 /* Make the current subroutine noreturn. */
1217 make_noreturn (void)
1219 if (sizing
== SZ_NOTHING
)
1220 next_sym
[-1].noreturn
= 1;
1224 /* Mark current intrinsic as module intrinsic. */
1226 make_from_module (void)
1228 if (sizing
== SZ_NOTHING
)
1229 next_sym
[-1].from_module
= 1;
1233 /* Mark the current subroutine as having a variable number of
1239 if (sizing
== SZ_NOTHING
)
1240 next_sym
[-1].vararg
= 1;
1243 /* Set the attr.value of the current procedure. */
1246 set_attr_value (int n
, ...)
1248 gfc_intrinsic_arg
*arg
;
1252 if (sizing
!= SZ_NOTHING
)
1256 arg
= next_sym
[-1].formal
;
1258 for (i
= 0; i
< n
; i
++)
1260 gcc_assert (arg
!= NULL
);
1261 arg
->value
= va_arg (argp
, int);
1268 /* Add intrinsic functions. */
1271 add_functions (void)
1273 /* Argument names. These are used as argument keywords and so need to
1274 match the documentation. Please keep this list in sorted order. */
1276 *a
= "a", *a1
= "a1", *a2
= "a2", *ar
= "array", *b
= "b",
1277 *bck
= "back", *bd
= "boundary", *c
= "c", *c_ptr_1
= "c_ptr_1",
1278 *c_ptr_2
= "c_ptr_2", *ca
= "coarray", *com
= "command",
1279 *dist
= "distance", *dm
= "dim", *f
= "field", *failed
="failed",
1280 *fs
= "fsource", *han
= "handler", *i
= "i",
1281 *image
= "image", *j
= "j", *kind
= "kind",
1282 *l
= "l", *ln
= "len", *level
= "level", *m
= "matrix", *ma
= "matrix_a",
1283 *mb
= "matrix_b", *md
= "mode", *mo
= "mold", *msk
= "mask",
1284 *n
= "n", *ncopies
= "ncopies", *nm
= "name", *num
= "number",
1285 *ord
= "order", *p
= "p", *p1
= "path1", *p2
= "path2",
1286 *pad
= "pad", *pid
= "pid", *pos
= "pos", *pt
= "pointer",
1287 *r
= "r", *s
= "s", *set
= "set", *sh
= "shift", *shp
= "shape",
1288 *sig
= "sig", *src
= "source", *ssg
= "substring",
1289 *sta
= "string_a", *stb
= "string_b", *stg
= "string",
1290 *sub
= "sub", *sz
= "size", *tg
= "target", *team
= "team", *tm
= "time",
1291 *ts
= "tsource", *ut
= "unit", *v
= "vector", *va
= "vector_a",
1292 *vb
= "vector_b", *vl
= "values", *val
= "value", *x
= "x", *y
= "y",
1295 int di
, dr
, dd
, dl
, dc
, dz
, ii
;
1297 di
= gfc_default_integer_kind
;
1298 dr
= gfc_default_real_kind
;
1299 dd
= gfc_default_double_kind
;
1300 dl
= gfc_default_logical_kind
;
1301 dc
= gfc_default_character_kind
;
1302 dz
= gfc_default_complex_kind
;
1303 ii
= gfc_index_integer_kind
;
1305 add_sym_1 ("abs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1306 gfc_check_abs
, gfc_simplify_abs
, gfc_resolve_abs
,
1307 a
, BT_REAL
, dr
, REQUIRED
);
1309 if (flag_dec_intrinsic_ints
)
1311 make_alias ("babs", GFC_STD_GNU
);
1312 make_alias ("iiabs", GFC_STD_GNU
);
1313 make_alias ("jiabs", GFC_STD_GNU
);
1314 make_alias ("kiabs", GFC_STD_GNU
);
1317 add_sym_1 ("iabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1318 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1319 a
, BT_INTEGER
, di
, REQUIRED
);
1321 add_sym_1 ("dabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1322 gfc_check_fn_d
, gfc_simplify_abs
, gfc_resolve_abs
,
1323 a
, BT_REAL
, dd
, REQUIRED
);
1325 add_sym_1 ("cabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1326 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1327 a
, BT_COMPLEX
, dz
, REQUIRED
);
1329 add_sym_1 ("zabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1330 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1331 a
, BT_COMPLEX
, dd
, REQUIRED
);
1333 make_alias ("cdabs", GFC_STD_GNU
);
1335 make_generic ("abs", GFC_ISYM_ABS
, GFC_STD_F77
);
1337 /* The checking function for ACCESS is called gfc_check_access_func
1338 because the name gfc_check_access is already used in module.c. */
1339 add_sym_2 ("access", GFC_ISYM_ACCESS
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1340 di
, GFC_STD_GNU
, gfc_check_access_func
, NULL
, gfc_resolve_access
,
1341 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1343 make_generic ("access", GFC_ISYM_ACCESS
, GFC_STD_GNU
);
1345 add_sym_2 ("achar", GFC_ISYM_ACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1346 BT_CHARACTER
, dc
, GFC_STD_F95
,
1347 gfc_check_achar
, gfc_simplify_achar
, gfc_resolve_achar
,
1348 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1350 make_generic ("achar", GFC_ISYM_ACHAR
, GFC_STD_F95
);
1352 add_sym_1 ("acos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1353 gfc_check_fn_rc2008
, gfc_simplify_acos
, gfc_resolve_acos
,
1354 x
, BT_REAL
, dr
, REQUIRED
);
1356 add_sym_1 ("dacos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1357 gfc_check_fn_d
, gfc_simplify_acos
, gfc_resolve_acos
,
1358 x
, BT_REAL
, dd
, REQUIRED
);
1360 make_generic ("acos", GFC_ISYM_ACOS
, GFC_STD_F77
);
1362 add_sym_1 ("acosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1363 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_acosh
,
1364 gfc_resolve_acosh
, x
, BT_REAL
, dr
, REQUIRED
);
1366 add_sym_1 ("dacosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1367 gfc_check_fn_d
, gfc_simplify_acosh
, gfc_resolve_acosh
,
1368 x
, BT_REAL
, dd
, REQUIRED
);
1370 make_generic ("acosh", GFC_ISYM_ACOSH
, GFC_STD_F2008
);
1372 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1373 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustl
,
1374 gfc_resolve_adjustl
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1376 make_generic ("adjustl", GFC_ISYM_ADJUSTL
, GFC_STD_F95
);
1378 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1379 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustr
,
1380 gfc_resolve_adjustr
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1382 make_generic ("adjustr", GFC_ISYM_ADJUSTR
, GFC_STD_F95
);
1384 add_sym_1 ("aimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1385 gfc_check_fn_c
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1386 z
, BT_COMPLEX
, dz
, REQUIRED
);
1388 make_alias ("imag", GFC_STD_GNU
);
1389 make_alias ("imagpart", GFC_STD_GNU
);
1391 add_sym_1 ("dimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1392 NULL
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1393 z
, BT_COMPLEX
, dd
, REQUIRED
);
1395 make_generic ("aimag", GFC_ISYM_AIMAG
, GFC_STD_F77
);
1397 add_sym_2 ("aint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1398 gfc_check_a_xkind
, gfc_simplify_aint
, gfc_resolve_aint
,
1399 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1401 add_sym_1 ("dint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1402 NULL
, gfc_simplify_dint
, gfc_resolve_dint
,
1403 a
, BT_REAL
, dd
, REQUIRED
);
1405 make_generic ("aint", GFC_ISYM_AINT
, GFC_STD_F77
);
1407 add_sym_2 ("all", GFC_ISYM_ALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1408 gfc_check_all_any
, gfc_simplify_all
, gfc_resolve_all
,
1409 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1411 make_generic ("all", GFC_ISYM_ALL
, GFC_STD_F95
);
1413 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1414 gfc_check_allocated
, NULL
, NULL
,
1415 ar
, BT_UNKNOWN
, 0, REQUIRED
);
1417 make_generic ("allocated", GFC_ISYM_ALLOCATED
, GFC_STD_F95
);
1419 add_sym_2 ("anint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1420 gfc_check_a_xkind
, gfc_simplify_anint
, gfc_resolve_anint
,
1421 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1423 add_sym_1 ("dnint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1424 NULL
, gfc_simplify_dnint
, gfc_resolve_dnint
,
1425 a
, BT_REAL
, dd
, REQUIRED
);
1427 make_generic ("anint", GFC_ISYM_ANINT
, GFC_STD_F77
);
1429 add_sym_2 ("any", GFC_ISYM_ANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1430 gfc_check_all_any
, gfc_simplify_any
, gfc_resolve_any
,
1431 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1433 make_generic ("any", GFC_ISYM_ANY
, GFC_STD_F95
);
1435 add_sym_1 ("asin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1436 gfc_check_fn_rc2008
, gfc_simplify_asin
, gfc_resolve_asin
,
1437 x
, BT_REAL
, dr
, REQUIRED
);
1439 add_sym_1 ("dasin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1440 gfc_check_fn_d
, gfc_simplify_asin
, gfc_resolve_asin
,
1441 x
, BT_REAL
, dd
, REQUIRED
);
1443 make_generic ("asin", GFC_ISYM_ASIN
, GFC_STD_F77
);
1445 add_sym_1 ("asinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1446 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_asinh
,
1447 gfc_resolve_asinh
, x
, BT_REAL
, dr
, REQUIRED
);
1449 add_sym_1 ("dasinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1450 gfc_check_fn_d
, gfc_simplify_asinh
, gfc_resolve_asinh
,
1451 x
, BT_REAL
, dd
, REQUIRED
);
1453 make_generic ("asinh", GFC_ISYM_ASINH
, GFC_STD_F2008
);
1455 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
,
1456 GFC_STD_F95
, gfc_check_associated
, NULL
, NULL
,
1457 pt
, BT_UNKNOWN
, 0, REQUIRED
, tg
, BT_UNKNOWN
, 0, OPTIONAL
);
1459 make_generic ("associated", GFC_ISYM_ASSOCIATED
, GFC_STD_F95
);
1461 add_sym_1 ("atan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1462 gfc_check_fn_rc2008
, gfc_simplify_atan
, gfc_resolve_atan
,
1463 x
, BT_REAL
, dr
, REQUIRED
);
1465 add_sym_1 ("datan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1466 gfc_check_fn_d
, gfc_simplify_atan
, gfc_resolve_atan
,
1467 x
, BT_REAL
, dd
, REQUIRED
);
1469 /* Two-argument version of atan, equivalent to atan2. */
1470 add_sym_2 ("atan", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F2008
,
1471 gfc_check_atan_2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1472 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1474 make_generic ("atan", GFC_ISYM_ATAN
, GFC_STD_F77
);
1476 add_sym_1 ("atanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1477 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_atanh
,
1478 gfc_resolve_atanh
, x
, BT_REAL
, dr
, REQUIRED
);
1480 add_sym_1 ("datanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1481 gfc_check_fn_d
, gfc_simplify_atanh
, gfc_resolve_atanh
,
1482 x
, BT_REAL
, dd
, REQUIRED
);
1484 make_generic ("atanh", GFC_ISYM_ATANH
, GFC_STD_F2008
);
1486 add_sym_2 ("atan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1487 gfc_check_atan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1488 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1490 add_sym_2 ("datan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1491 gfc_check_datan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1492 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1494 make_generic ("atan2", GFC_ISYM_ATAN2
, GFC_STD_F77
);
1496 /* Bessel and Neumann functions for G77 compatibility. */
1497 add_sym_1 ("besj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1498 gfc_check_fn_r
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1499 x
, BT_REAL
, dr
, REQUIRED
);
1501 make_alias ("bessel_j0", GFC_STD_F2008
);
1503 add_sym_1 ("dbesj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1504 gfc_check_fn_d
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1505 x
, BT_REAL
, dd
, REQUIRED
);
1507 make_generic ("bessel_j0", GFC_ISYM_J0
, GFC_STD_F2008
);
1509 add_sym_1 ("besj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1510 gfc_check_fn_r
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1511 x
, BT_REAL
, dr
, REQUIRED
);
1513 make_alias ("bessel_j1", GFC_STD_F2008
);
1515 add_sym_1 ("dbesj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1516 gfc_check_fn_d
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1517 x
, BT_REAL
, dd
, REQUIRED
);
1519 make_generic ("bessel_j1", GFC_ISYM_J1
, GFC_STD_F2008
);
1521 add_sym_2 ("besjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1522 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1523 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1525 make_alias ("bessel_jn", GFC_STD_F2008
);
1527 add_sym_2 ("dbesjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1528 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1529 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1531 add_sym_3 ("bessel_jn", GFC_ISYM_JN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1532 gfc_check_bessel_n2
, gfc_simplify_bessel_jn2
, gfc_resolve_bessel_n2
,
1533 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1534 x
, BT_REAL
, dr
, REQUIRED
);
1535 set_attr_value (3, true, true, true);
1537 make_generic ("bessel_jn", GFC_ISYM_JN
, GFC_STD_F2008
);
1539 add_sym_1 ("besy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1540 gfc_check_fn_r
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1541 x
, BT_REAL
, dr
, REQUIRED
);
1543 make_alias ("bessel_y0", GFC_STD_F2008
);
1545 add_sym_1 ("dbesy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1546 gfc_check_fn_d
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1547 x
, BT_REAL
, dd
, REQUIRED
);
1549 make_generic ("bessel_y0", GFC_ISYM_Y0
, GFC_STD_F2008
);
1551 add_sym_1 ("besy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1552 gfc_check_fn_r
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1553 x
, BT_REAL
, dr
, REQUIRED
);
1555 make_alias ("bessel_y1", GFC_STD_F2008
);
1557 add_sym_1 ("dbesy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1558 gfc_check_fn_d
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1559 x
, BT_REAL
, dd
, REQUIRED
);
1561 make_generic ("bessel_y1", GFC_ISYM_Y1
, GFC_STD_F2008
);
1563 add_sym_2 ("besyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1564 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1565 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1567 make_alias ("bessel_yn", GFC_STD_F2008
);
1569 add_sym_2 ("dbesyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1570 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1571 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1573 add_sym_3 ("bessel_yn", GFC_ISYM_YN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1574 gfc_check_bessel_n2
, gfc_simplify_bessel_yn2
, gfc_resolve_bessel_n2
,
1575 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1576 x
, BT_REAL
, dr
, REQUIRED
);
1577 set_attr_value (3, true, true, true);
1579 make_generic ("bessel_yn", GFC_ISYM_YN
, GFC_STD_F2008
);
1581 add_sym_2 ("bge", GFC_ISYM_BGE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1582 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1583 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bge
, NULL
,
1584 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1586 make_generic ("bge", GFC_ISYM_BGE
, GFC_STD_F2008
);
1588 add_sym_2 ("bgt", GFC_ISYM_BGT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1589 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1590 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bgt
, NULL
,
1591 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1593 make_generic ("bgt", GFC_ISYM_BGT
, GFC_STD_F2008
);
1595 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1596 gfc_check_i
, gfc_simplify_bit_size
, NULL
,
1597 i
, BT_INTEGER
, di
, REQUIRED
);
1599 make_generic ("bit_size", GFC_ISYM_BIT_SIZE
, GFC_STD_F95
);
1601 add_sym_2 ("ble", GFC_ISYM_BLE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1602 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1603 gfc_check_bge_bgt_ble_blt
, gfc_simplify_ble
, NULL
,
1604 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1606 make_generic ("ble", GFC_ISYM_BLE
, GFC_STD_F2008
);
1608 add_sym_2 ("blt", GFC_ISYM_BLT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1609 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1610 gfc_check_bge_bgt_ble_blt
, gfc_simplify_blt
, NULL
,
1611 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1613 make_generic ("blt", GFC_ISYM_BLT
, GFC_STD_F2008
);
1615 add_sym_2 ("btest", GFC_ISYM_BTEST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1616 gfc_check_bitfcn
, gfc_simplify_btest
, gfc_resolve_btest
,
1617 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1619 if (flag_dec_intrinsic_ints
)
1621 make_alias ("bbtest", GFC_STD_GNU
);
1622 make_alias ("bitest", GFC_STD_GNU
);
1623 make_alias ("bjtest", GFC_STD_GNU
);
1624 make_alias ("bktest", GFC_STD_GNU
);
1627 make_generic ("btest", GFC_ISYM_BTEST
, GFC_STD_F95
);
1629 add_sym_2 ("ceiling", GFC_ISYM_CEILING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1630 gfc_check_a_ikind
, gfc_simplify_ceiling
, gfc_resolve_ceiling
,
1631 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1633 make_generic ("ceiling", GFC_ISYM_CEILING
, GFC_STD_F95
);
1635 add_sym_2 ("char", GFC_ISYM_CHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F77
,
1636 gfc_check_char
, gfc_simplify_char
, gfc_resolve_char
,
1637 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1639 make_generic ("char", GFC_ISYM_CHAR
, GFC_STD_F77
);
1641 add_sym_1 ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
1642 GFC_STD_GNU
, gfc_check_chdir
, NULL
, gfc_resolve_chdir
,
1643 nm
, BT_CHARACTER
, dc
, REQUIRED
);
1645 make_generic ("chdir", GFC_ISYM_CHDIR
, GFC_STD_GNU
);
1647 add_sym_2 ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1648 di
, GFC_STD_GNU
, gfc_check_chmod
, NULL
, gfc_resolve_chmod
,
1649 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1651 make_generic ("chmod", GFC_ISYM_CHMOD
, GFC_STD_GNU
);
1653 add_sym_3 ("cmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1654 gfc_check_cmplx
, gfc_simplify_cmplx
, gfc_resolve_cmplx
,
1655 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, OPTIONAL
,
1656 kind
, BT_INTEGER
, di
, OPTIONAL
);
1658 make_generic ("cmplx", GFC_ISYM_CMPLX
, GFC_STD_F77
);
1660 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
, CLASS_INQUIRY
,
1661 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
, NULL
, NULL
, NULL
);
1663 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
,
1666 add_sym_2 ("complex", GFC_ISYM_COMPLEX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_GNU
,
1667 gfc_check_complex
, gfc_simplify_complex
, gfc_resolve_complex
,
1668 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, REQUIRED
);
1670 make_generic ("complex", GFC_ISYM_COMPLEX
, GFC_STD_GNU
);
1672 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1673 complex instead of the default complex. */
1675 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1676 gfc_check_dcmplx
, gfc_simplify_dcmplx
, gfc_resolve_dcmplx
,
1677 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, OPTIONAL
);
1679 make_generic ("dcmplx", GFC_ISYM_CMPLX
, GFC_STD_GNU
);
1681 add_sym_1 ("conjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1682 gfc_check_fn_c
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1683 z
, BT_COMPLEX
, dz
, REQUIRED
);
1685 add_sym_1 ("dconjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1686 NULL
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1687 z
, BT_COMPLEX
, dd
, REQUIRED
);
1689 make_generic ("conjg", GFC_ISYM_CONJG
, GFC_STD_F77
);
1691 add_sym_1 ("cos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1692 gfc_check_fn_rc
, gfc_simplify_cos
, gfc_resolve_cos
,
1693 x
, BT_REAL
, dr
, REQUIRED
);
1695 add_sym_1 ("dcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1696 gfc_check_fn_d
, gfc_simplify_cos
, gfc_resolve_cos
,
1697 x
, BT_REAL
, dd
, REQUIRED
);
1699 add_sym_1 ("ccos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1700 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1701 x
, BT_COMPLEX
, dz
, REQUIRED
);
1703 add_sym_1 ("zcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1704 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1705 x
, BT_COMPLEX
, dd
, REQUIRED
);
1707 make_alias ("cdcos", GFC_STD_GNU
);
1709 make_generic ("cos", GFC_ISYM_COS
, GFC_STD_F77
);
1711 add_sym_1 ("cosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1712 gfc_check_fn_rc2008
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1713 x
, BT_REAL
, dr
, REQUIRED
);
1715 add_sym_1 ("dcosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1716 gfc_check_fn_d
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1717 x
, BT_REAL
, dd
, REQUIRED
);
1719 make_generic ("cosh", GFC_ISYM_COSH
, GFC_STD_F77
);
1721 add_sym_3 ("count", GFC_ISYM_COUNT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1722 BT_INTEGER
, di
, GFC_STD_F95
,
1723 gfc_check_count
, gfc_simplify_count
, gfc_resolve_count
,
1724 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1725 kind
, BT_INTEGER
, di
, OPTIONAL
);
1727 make_generic ("count", GFC_ISYM_COUNT
, GFC_STD_F95
);
1729 add_sym_3 ("cshift", GFC_ISYM_CSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1730 BT_REAL
, dr
, GFC_STD_F95
,
1731 gfc_check_cshift
, gfc_simplify_cshift
, gfc_resolve_cshift
,
1732 ar
, BT_REAL
, dr
, REQUIRED
,
1733 sh
, BT_INTEGER
, di
, REQUIRED
,
1734 dm
, BT_INTEGER
, ii
, OPTIONAL
);
1736 make_generic ("cshift", GFC_ISYM_CSHIFT
, GFC_STD_F95
);
1738 add_sym_1 ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1739 0, GFC_STD_GNU
, gfc_check_ctime
, NULL
, gfc_resolve_ctime
,
1740 tm
, BT_INTEGER
, di
, REQUIRED
);
1742 make_generic ("ctime", GFC_ISYM_CTIME
, GFC_STD_GNU
);
1744 add_sym_1 ("dble", GFC_ISYM_DBLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
1745 gfc_check_dble
, gfc_simplify_dble
, gfc_resolve_dble
,
1746 a
, BT_REAL
, dr
, REQUIRED
);
1748 make_generic ("dble", GFC_ISYM_DBLE
, GFC_STD_F77
);
1750 add_sym_1 ("digits", GFC_ISYM_DIGITS
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1751 gfc_check_digits
, gfc_simplify_digits
, NULL
,
1752 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1754 make_generic ("digits", GFC_ISYM_DIGITS
, GFC_STD_F95
);
1756 add_sym_2 ("dim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1757 gfc_check_a_p
, gfc_simplify_dim
, gfc_resolve_dim
,
1758 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1760 add_sym_2 ("idim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1761 NULL
, gfc_simplify_dim
, gfc_resolve_dim
,
1762 x
, BT_INTEGER
, di
, REQUIRED
, y
, BT_INTEGER
, di
, REQUIRED
);
1764 add_sym_2 ("ddim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1765 gfc_check_x_yd
, gfc_simplify_dim
, gfc_resolve_dim
,
1766 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, REQUIRED
);
1768 make_generic ("dim", GFC_ISYM_DIM
, GFC_STD_F77
);
1770 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
1771 GFC_STD_F95
, gfc_check_dot_product
, gfc_simplify_dot_product
, gfc_resolve_dot_product
,
1772 va
, BT_REAL
, dr
, REQUIRED
, vb
, BT_REAL
, dr
, REQUIRED
);
1774 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT
, GFC_STD_F95
);
1776 add_sym_2 ("dprod", GFC_ISYM_DPROD
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1777 gfc_check_dprod
, gfc_simplify_dprod
, gfc_resolve_dprod
,
1778 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1780 make_generic ("dprod", GFC_ISYM_DPROD
, GFC_STD_F77
);
1782 add_sym_1 ("dreal", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1783 BT_REAL
, dd
, GFC_STD_GNU
, NULL
, gfc_simplify_dreal
, NULL
,
1784 a
, BT_COMPLEX
, dd
, REQUIRED
);
1786 make_generic ("dreal", GFC_ISYM_REAL
, GFC_STD_GNU
);
1788 add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1789 BT_INTEGER
, di
, GFC_STD_F2008
,
1790 gfc_check_dshift
, gfc_simplify_dshiftl
, gfc_resolve_dshift
,
1791 i
, BT_INTEGER
, di
, REQUIRED
,
1792 j
, BT_INTEGER
, di
, REQUIRED
,
1793 sh
, BT_INTEGER
, di
, REQUIRED
);
1795 make_generic ("dshiftl", GFC_ISYM_DSHIFTL
, GFC_STD_F2008
);
1797 add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1798 BT_INTEGER
, di
, GFC_STD_F2008
,
1799 gfc_check_dshift
, gfc_simplify_dshiftr
, gfc_resolve_dshift
,
1800 i
, BT_INTEGER
, di
, REQUIRED
,
1801 j
, BT_INTEGER
, di
, REQUIRED
,
1802 sh
, BT_INTEGER
, di
, REQUIRED
);
1804 make_generic ("dshiftr", GFC_ISYM_DSHIFTR
, GFC_STD_F2008
);
1806 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1807 gfc_check_eoshift
, gfc_simplify_eoshift
, gfc_resolve_eoshift
,
1808 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, ii
, REQUIRED
,
1809 bd
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1811 make_generic ("eoshift", GFC_ISYM_EOSHIFT
, GFC_STD_F95
);
1813 add_sym_1 ("epsilon", GFC_ISYM_EPSILON
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
,
1814 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_epsilon
, NULL
,
1815 x
, BT_REAL
, dr
, REQUIRED
);
1817 make_generic ("epsilon", GFC_ISYM_EPSILON
, GFC_STD_F95
);
1819 /* G77 compatibility for the ERF() and ERFC() functions. */
1820 add_sym_1 ("erf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1821 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erf
,
1822 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1824 add_sym_1 ("derf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1825 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erf
,
1826 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1828 make_generic ("erf", GFC_ISYM_ERF
, GFC_STD_F2008
);
1830 add_sym_1 ("erfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1831 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erfc
,
1832 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1834 add_sym_1 ("derfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1835 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erfc
,
1836 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1838 make_generic ("erfc", GFC_ISYM_ERFC
, GFC_STD_F2008
);
1840 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1841 BT_REAL
, dr
, GFC_STD_F2008
, gfc_check_fn_r
,
1842 gfc_simplify_erfc_scaled
, gfc_resolve_g77_math1
, x
, BT_REAL
,
1845 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, GFC_STD_F2008
);
1847 /* G77 compatibility */
1848 add_sym_1 ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1849 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1850 x
, BT_REAL
, 4, REQUIRED
);
1852 make_generic ("dtime", GFC_ISYM_DTIME
, GFC_STD_GNU
);
1854 add_sym_1 ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1855 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1856 x
, BT_REAL
, 4, REQUIRED
);
1858 make_generic ("etime", GFC_ISYM_ETIME
, GFC_STD_GNU
);
1860 add_sym_1 ("exp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1861 gfc_check_fn_rc
, gfc_simplify_exp
, gfc_resolve_exp
,
1862 x
, BT_REAL
, dr
, REQUIRED
);
1864 add_sym_1 ("dexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1865 gfc_check_fn_d
, gfc_simplify_exp
, gfc_resolve_exp
,
1866 x
, BT_REAL
, dd
, REQUIRED
);
1868 add_sym_1 ("cexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1869 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1870 x
, BT_COMPLEX
, dz
, REQUIRED
);
1872 add_sym_1 ("zexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1873 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1874 x
, BT_COMPLEX
, dd
, REQUIRED
);
1876 make_alias ("cdexp", GFC_STD_GNU
);
1878 make_generic ("exp", GFC_ISYM_EXP
, GFC_STD_F77
);
1880 add_sym_1 ("exponent", GFC_ISYM_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
1881 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_exponent
, gfc_resolve_exponent
,
1882 x
, BT_REAL
, dr
, REQUIRED
);
1884 make_generic ("exponent", GFC_ISYM_EXPONENT
, GFC_STD_F95
);
1886 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF
, CLASS_INQUIRY
,
1887 ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1888 gfc_check_same_type_as
, gfc_simplify_extends_type_of
,
1889 gfc_resolve_extends_type_of
,
1890 a
, BT_UNKNOWN
, 0, REQUIRED
,
1891 mo
, BT_UNKNOWN
, 0, REQUIRED
);
1893 add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES
, CLASS_TRANSFORMATIONAL
,
1894 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
1895 gfc_check_failed_or_stopped_images
,
1896 gfc_simplify_failed_or_stopped_images
,
1897 gfc_resolve_failed_images
, team
, BT_VOID
, di
, OPTIONAL
,
1898 kind
, BT_INTEGER
, di
, OPTIONAL
);
1900 add_sym_0 ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1901 dc
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_fdate
);
1903 make_generic ("fdate", GFC_ISYM_FDATE
, GFC_STD_GNU
);
1905 add_sym_2 ("floor", GFC_ISYM_FLOOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1906 gfc_check_a_ikind
, gfc_simplify_floor
, gfc_resolve_floor
,
1907 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1909 make_generic ("floor", GFC_ISYM_FLOOR
, GFC_STD_F95
);
1911 /* G77 compatible fnum */
1912 add_sym_1 ("fnum", GFC_ISYM_FNUM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1913 di
, GFC_STD_GNU
, gfc_check_fnum
, NULL
, gfc_resolve_fnum
,
1914 ut
, BT_INTEGER
, di
, REQUIRED
);
1916 make_generic ("fnum", GFC_ISYM_FNUM
, GFC_STD_GNU
);
1918 add_sym_1 ("fraction", GFC_ISYM_FRACTION
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1919 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_fraction
, gfc_resolve_fraction
,
1920 x
, BT_REAL
, dr
, REQUIRED
);
1922 make_generic ("fraction", GFC_ISYM_FRACTION
, GFC_STD_F95
);
1924 add_sym_2_intent ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
1925 BT_INTEGER
, di
, GFC_STD_GNU
,
1926 gfc_check_fstat
, NULL
, gfc_resolve_fstat
,
1927 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1928 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
1930 make_generic ("fstat", GFC_ISYM_FSTAT
, GFC_STD_GNU
);
1932 add_sym_1 ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1933 ii
, GFC_STD_GNU
, gfc_check_ftell
, NULL
, gfc_resolve_ftell
,
1934 ut
, BT_INTEGER
, di
, REQUIRED
);
1936 make_generic ("ftell", GFC_ISYM_FTELL
, GFC_STD_GNU
);
1938 add_sym_2_intent ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, ACTUAL_NO
,
1939 BT_INTEGER
, di
, GFC_STD_GNU
,
1940 gfc_check_fgetputc
, NULL
, gfc_resolve_fgetc
,
1941 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1942 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1944 make_generic ("fgetc", GFC_ISYM_FGETC
, GFC_STD_GNU
);
1946 add_sym_1_intent ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1947 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fget
,
1948 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1950 make_generic ("fget", GFC_ISYM_FGET
, GFC_STD_GNU
);
1952 add_sym_2 ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1953 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fputc
,
1954 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
1956 make_generic ("fputc", GFC_ISYM_FPUTC
, GFC_STD_GNU
);
1958 add_sym_1 ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1959 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fput
,
1960 c
, BT_CHARACTER
, dc
, REQUIRED
);
1962 make_generic ("fput", GFC_ISYM_FPUT
, GFC_STD_GNU
);
1964 add_sym_1 ("gamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1965 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_gamma
,
1966 gfc_resolve_gamma
, x
, BT_REAL
, dr
, REQUIRED
);
1968 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1969 gfc_check_fn_d
, gfc_simplify_gamma
, gfc_resolve_gamma
,
1970 x
, BT_REAL
, dr
, REQUIRED
);
1972 make_generic ("gamma", GFC_ISYM_TGAMMA
, GFC_STD_F2008
);
1974 /* Unix IDs (g77 compatibility) */
1975 add_sym_1 ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1976 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getcwd
,
1977 c
, BT_CHARACTER
, dc
, REQUIRED
);
1979 make_generic ("getcwd", GFC_ISYM_GETCWD
, GFC_STD_GNU
);
1981 add_sym_0 ("getgid", GFC_ISYM_GETGID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1982 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getgid
);
1984 make_generic ("getgid", GFC_ISYM_GETGID
, GFC_STD_GNU
);
1986 add_sym_0 ("getpid", GFC_ISYM_GETPID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1987 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getpid
);
1989 make_generic ("getpid", GFC_ISYM_GETPID
, GFC_STD_GNU
);
1991 add_sym_1 ("get_team", GFC_ISYM_GET_TEAM
, CLASS_TRANSFORMATIONAL
,
1992 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2018
,
1993 gfc_check_get_team
, NULL
, gfc_resolve_get_team
,
1994 level
, BT_INTEGER
, di
, OPTIONAL
);
1996 add_sym_0 ("getuid", GFC_ISYM_GETUID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1997 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getuid
);
1999 make_generic ("getuid", GFC_ISYM_GETUID
, GFC_STD_GNU
);
2001 add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, ACTUAL_NO
,
2002 BT_INTEGER
, di
, GFC_STD_GNU
,
2003 gfc_check_hostnm
, NULL
, gfc_resolve_hostnm
,
2004 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
2006 make_generic ("hostnm", GFC_ISYM_HOSTNM
, GFC_STD_GNU
);
2008 add_sym_1 ("huge", GFC_ISYM_HUGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2009 gfc_check_huge
, gfc_simplify_huge
, NULL
,
2010 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2012 make_generic ("huge", GFC_ISYM_HUGE
, GFC_STD_F95
);
2014 add_sym_2 ("hypot", GFC_ISYM_HYPOT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2015 BT_REAL
, dr
, GFC_STD_F2008
,
2016 gfc_check_hypot
, gfc_simplify_hypot
, gfc_resolve_hypot
,
2017 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
2019 make_generic ("hypot", GFC_ISYM_HYPOT
, GFC_STD_F2008
);
2021 add_sym_2 ("iachar", GFC_ISYM_IACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2022 BT_INTEGER
, di
, GFC_STD_F95
,
2023 gfc_check_ichar_iachar
, gfc_simplify_iachar
, gfc_resolve_iachar
,
2024 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2026 make_generic ("iachar", GFC_ISYM_IACHAR
, GFC_STD_F95
);
2028 add_sym_2 ("iand", GFC_ISYM_IAND
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2029 gfc_check_iand
, gfc_simplify_iand
, gfc_resolve_iand
,
2030 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2032 if (flag_dec_intrinsic_ints
)
2034 make_alias ("biand", GFC_STD_GNU
);
2035 make_alias ("iiand", GFC_STD_GNU
);
2036 make_alias ("jiand", GFC_STD_GNU
);
2037 make_alias ("kiand", GFC_STD_GNU
);
2040 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
2042 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2043 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
2044 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2046 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
2048 add_sym_3red ("iall", GFC_ISYM_IALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2049 gfc_check_transf_bit_intrins
, gfc_simplify_iall
, gfc_resolve_iall
,
2050 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2051 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2053 make_generic ("iall", GFC_ISYM_IALL
, GFC_STD_F2008
);
2055 add_sym_3red ("iany", GFC_ISYM_IANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2056 gfc_check_transf_bit_intrins
, gfc_simplify_iany
, gfc_resolve_iany
,
2057 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2058 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2060 make_generic ("iany", GFC_ISYM_IANY
, GFC_STD_F2008
);
2062 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2063 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2065 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
2067 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2068 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
2069 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2071 if (flag_dec_intrinsic_ints
)
2073 make_alias ("bbclr", GFC_STD_GNU
);
2074 make_alias ("iibclr", GFC_STD_GNU
);
2075 make_alias ("jibclr", GFC_STD_GNU
);
2076 make_alias ("kibclr", GFC_STD_GNU
);
2079 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
2081 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2082 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
2083 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
2084 ln
, BT_INTEGER
, di
, REQUIRED
);
2086 if (flag_dec_intrinsic_ints
)
2088 make_alias ("bbits", GFC_STD_GNU
);
2089 make_alias ("iibits", GFC_STD_GNU
);
2090 make_alias ("jibits", GFC_STD_GNU
);
2091 make_alias ("kibits", GFC_STD_GNU
);
2094 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
2096 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2097 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
2098 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2100 if (flag_dec_intrinsic_ints
)
2102 make_alias ("bbset", GFC_STD_GNU
);
2103 make_alias ("iibset", GFC_STD_GNU
);
2104 make_alias ("jibset", GFC_STD_GNU
);
2105 make_alias ("kibset", GFC_STD_GNU
);
2108 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
2110 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2111 BT_INTEGER
, di
, GFC_STD_F77
,
2112 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
2113 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2115 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
2117 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2118 gfc_check_ieor
, gfc_simplify_ieor
, gfc_resolve_ieor
,
2119 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2121 if (flag_dec_intrinsic_ints
)
2123 make_alias ("bieor", GFC_STD_GNU
);
2124 make_alias ("iieor", GFC_STD_GNU
);
2125 make_alias ("jieor", GFC_STD_GNU
);
2126 make_alias ("kieor", GFC_STD_GNU
);
2129 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
2131 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2132 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
2133 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2135 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
2137 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2138 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
2140 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
2142 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2143 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
2144 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
2146 add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2147 BT_INTEGER
, di
, GFC_STD_F2018
, gfc_check_image_status
,
2148 gfc_simplify_image_status
, gfc_resolve_image_status
, image
,
2149 BT_INTEGER
, di
, REQUIRED
, team
, BT_VOID
, di
, OPTIONAL
);
2151 /* The resolution function for INDEX is called gfc_resolve_index_func
2152 because the name gfc_resolve_index is already used in resolve.c. */
2153 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
2154 BT_INTEGER
, di
, GFC_STD_F77
,
2155 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
2156 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
2157 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2159 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
2161 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2162 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
2163 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2165 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2166 NULL
, gfc_simplify_ifix
, NULL
,
2167 a
, BT_REAL
, dr
, REQUIRED
);
2169 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2170 NULL
, gfc_simplify_idint
, NULL
,
2171 a
, BT_REAL
, dd
, REQUIRED
);
2173 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
2175 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2176 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
2177 a
, BT_REAL
, dr
, REQUIRED
);
2179 make_alias ("short", GFC_STD_GNU
);
2181 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
2183 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2184 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
2185 a
, BT_REAL
, dr
, REQUIRED
);
2187 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
2189 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2190 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
2191 a
, BT_REAL
, dr
, REQUIRED
);
2193 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
2195 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2196 gfc_check_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
2197 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2199 if (flag_dec_intrinsic_ints
)
2201 make_alias ("bior", GFC_STD_GNU
);
2202 make_alias ("iior", GFC_STD_GNU
);
2203 make_alias ("jior", GFC_STD_GNU
);
2204 make_alias ("kior", GFC_STD_GNU
);
2207 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
2209 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2210 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
2211 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2213 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
2215 add_sym_3red ("iparity", GFC_ISYM_IPARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2216 gfc_check_transf_bit_intrins
, gfc_simplify_iparity
, gfc_resolve_iparity
,
2217 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2218 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2220 make_generic ("iparity", GFC_ISYM_IPARITY
, GFC_STD_F2008
);
2222 /* The following function is for G77 compatibility. */
2223 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2224 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
2225 i
, BT_INTEGER
, 4, OPTIONAL
);
2227 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
2229 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2230 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
2231 ut
, BT_INTEGER
, di
, REQUIRED
);
2233 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
2235 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
2236 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2237 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
2238 i
, BT_INTEGER
, 0, REQUIRED
);
2240 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
2242 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
2243 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2244 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
2245 i
, BT_INTEGER
, 0, REQUIRED
);
2247 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
2249 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2250 BT_LOGICAL
, dl
, GFC_STD_GNU
,
2251 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
2252 x
, BT_REAL
, 0, REQUIRED
);
2254 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
2256 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2257 BT_INTEGER
, di
, GFC_STD_GNU
,
2258 gfc_check_ishft
, gfc_simplify_rshift
, gfc_resolve_rshift
,
2259 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2261 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
2263 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2264 BT_INTEGER
, di
, GFC_STD_GNU
,
2265 gfc_check_ishft
, gfc_simplify_lshift
, gfc_resolve_lshift
,
2266 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2268 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
2270 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2271 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
2272 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2274 if (flag_dec_intrinsic_ints
)
2276 make_alias ("bshft", GFC_STD_GNU
);
2277 make_alias ("iishft", GFC_STD_GNU
);
2278 make_alias ("jishft", GFC_STD_GNU
);
2279 make_alias ("kishft", GFC_STD_GNU
);
2282 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
2284 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2285 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
2286 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
2287 sz
, BT_INTEGER
, di
, OPTIONAL
);
2289 if (flag_dec_intrinsic_ints
)
2291 make_alias ("bshftc", GFC_STD_GNU
);
2292 make_alias ("iishftc", GFC_STD_GNU
);
2293 make_alias ("jishftc", GFC_STD_GNU
);
2294 make_alias ("kishftc", GFC_STD_GNU
);
2297 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
2299 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2300 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, NULL
,
2301 pid
, BT_INTEGER
, di
, REQUIRED
, sig
, BT_INTEGER
, di
, REQUIRED
);
2303 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
2305 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2306 gfc_check_kind
, gfc_simplify_kind
, NULL
,
2307 x
, BT_REAL
, dr
, REQUIRED
);
2309 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
2311 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2312 BT_INTEGER
, di
, GFC_STD_F95
,
2313 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
2314 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
2315 kind
, BT_INTEGER
, di
, OPTIONAL
);
2317 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
2319 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2320 BT_INTEGER
, di
, GFC_STD_F2008
,
2321 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
2322 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2323 kind
, BT_INTEGER
, di
, OPTIONAL
);
2325 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
2327 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2328 BT_INTEGER
, di
, GFC_STD_F2008
,
2329 gfc_check_i
, gfc_simplify_leadz
, NULL
,
2330 i
, BT_INTEGER
, di
, REQUIRED
);
2332 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
2334 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
2335 BT_INTEGER
, di
, GFC_STD_F77
,
2336 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
2337 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2339 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
2341 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2342 BT_INTEGER
, di
, GFC_STD_F95
,
2343 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
2344 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2346 make_alias ("lnblnk", GFC_STD_GNU
);
2348 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
2350 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2352 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2353 x
, BT_REAL
, dr
, REQUIRED
);
2355 make_alias ("log_gamma", GFC_STD_F2008
);
2357 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2358 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2359 x
, BT_REAL
, dr
, REQUIRED
);
2361 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2362 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2363 x
, BT_REAL
, dr
, REQUIRED
);
2365 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2368 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2369 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2370 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2372 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2374 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2375 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2376 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2378 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2380 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2381 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2382 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2384 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2386 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2387 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2388 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2390 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2392 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2393 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2394 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2396 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2398 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2399 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2400 x
, BT_REAL
, dr
, REQUIRED
);
2402 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2403 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2404 x
, BT_REAL
, dr
, REQUIRED
);
2406 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2407 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2408 x
, BT_REAL
, dd
, REQUIRED
);
2410 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2411 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2412 x
, BT_COMPLEX
, dz
, REQUIRED
);
2414 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2415 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2416 x
, BT_COMPLEX
, dd
, REQUIRED
);
2418 make_alias ("cdlog", GFC_STD_GNU
);
2420 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2422 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2423 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2424 x
, BT_REAL
, dr
, REQUIRED
);
2426 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2427 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2428 x
, BT_REAL
, dr
, REQUIRED
);
2430 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2431 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2432 x
, BT_REAL
, dd
, REQUIRED
);
2434 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2436 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2437 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2438 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2440 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2442 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
2443 BT_INTEGER
, di
, GFC_STD_GNU
,
2444 gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2445 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2446 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2448 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2450 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2451 GFC_STD_GNU
, gfc_check_malloc
, NULL
, NULL
,
2452 sz
, BT_INTEGER
, di
, REQUIRED
);
2454 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2456 add_sym_2 ("maskl", GFC_ISYM_MASKL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2457 BT_INTEGER
, di
, GFC_STD_F2008
,
2458 gfc_check_mask
, gfc_simplify_maskl
, gfc_resolve_mask
,
2459 i
, BT_INTEGER
, di
, REQUIRED
,
2460 kind
, BT_INTEGER
, di
, OPTIONAL
);
2462 make_generic ("maskl", GFC_ISYM_MASKL
, GFC_STD_F2008
);
2464 add_sym_2 ("maskr", GFC_ISYM_MASKR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2465 BT_INTEGER
, di
, GFC_STD_F2008
,
2466 gfc_check_mask
, gfc_simplify_maskr
, gfc_resolve_mask
,
2467 i
, BT_INTEGER
, di
, REQUIRED
,
2468 kind
, BT_INTEGER
, di
, OPTIONAL
);
2470 make_generic ("maskr", GFC_ISYM_MASKR
, GFC_STD_F2008
);
2472 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2473 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2474 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2476 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2478 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2479 int(max). The max function must take at least two arguments. */
2481 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2482 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2483 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2485 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2486 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2487 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2489 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2490 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2491 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2493 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2494 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2495 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2497 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2498 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2499 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2501 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2502 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2503 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2505 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2507 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2508 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_maxexponent
, NULL
,
2509 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2511 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2513 add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2514 gfc_check_minloc_maxloc
, gfc_simplify_maxloc
, gfc_resolve_maxloc
,
2515 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2516 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2517 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2519 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2521 add_sym_6fl ("findloc", GFC_ISYM_FINDLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
2522 BT_INTEGER
, di
, GFC_STD_F2008
,
2523 gfc_check_findloc
, gfc_simplify_findloc
, gfc_resolve_findloc
,
2524 ar
, BT_REAL
, dr
, REQUIRED
, val
, BT_REAL
, dr
, REQUIRED
,
2525 dm
, BT_INTEGER
, ii
, OPTIONAL
, msk
, BT_LOGICAL
, dl
, OPTIONAL
,
2526 kind
, BT_INTEGER
, di
, OPTIONAL
, bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2528 make_generic ("findloc", GFC_ISYM_FINDLOC
, GFC_STD_F2008
);
2530 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2531 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2532 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2533 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2535 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2537 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2538 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2540 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2542 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2543 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2545 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2547 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2548 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2549 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2550 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2552 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2554 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2555 BT_INTEGER
, di
, GFC_STD_F2008
,
2556 gfc_check_merge_bits
, gfc_simplify_merge_bits
,
2557 gfc_resolve_merge_bits
,
2558 i
, BT_INTEGER
, di
, REQUIRED
,
2559 j
, BT_INTEGER
, di
, REQUIRED
,
2560 msk
, BT_INTEGER
, di
, REQUIRED
);
2562 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS
, GFC_STD_F2008
);
2564 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2567 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2568 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2569 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2571 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2572 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2573 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2575 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2576 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2577 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2579 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2580 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2581 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2583 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2584 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2585 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2587 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2588 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2589 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2591 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2593 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2594 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_minexponent
, NULL
,
2595 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2597 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2599 add_sym_5ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2600 gfc_check_minloc_maxloc
, gfc_simplify_minloc
, gfc_resolve_minloc
,
2601 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2602 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2603 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2605 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2607 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2608 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2609 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2610 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2612 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2614 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2615 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2616 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2618 if (flag_dec_intrinsic_ints
)
2620 make_alias ("bmod", GFC_STD_GNU
);
2621 make_alias ("imod", GFC_STD_GNU
);
2622 make_alias ("jmod", GFC_STD_GNU
);
2623 make_alias ("kmod", GFC_STD_GNU
);
2626 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2627 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2628 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2630 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2631 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2632 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2634 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2636 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2637 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2638 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2640 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2642 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2643 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2644 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2646 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2648 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2649 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2650 a
, BT_CHARACTER
, dc
, REQUIRED
);
2652 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2654 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2655 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2656 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2658 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2659 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2660 a
, BT_REAL
, dd
, REQUIRED
);
2662 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2664 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2665 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2666 i
, BT_INTEGER
, di
, REQUIRED
);
2668 if (flag_dec_intrinsic_ints
)
2670 make_alias ("bnot", GFC_STD_GNU
);
2671 make_alias ("inot", GFC_STD_GNU
);
2672 make_alias ("jnot", GFC_STD_GNU
);
2673 make_alias ("knot", GFC_STD_GNU
);
2676 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2678 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2679 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2680 x
, BT_REAL
, dr
, REQUIRED
,
2681 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2683 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2685 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2686 gfc_check_null
, gfc_simplify_null
, NULL
,
2687 mo
, BT_INTEGER
, di
, OPTIONAL
);
2689 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2691 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES
, CLASS_INQUIRY
, ACTUAL_NO
,
2692 BT_INTEGER
, di
, GFC_STD_F2008
,
2693 gfc_check_num_images
, gfc_simplify_num_images
, NULL
,
2694 dist
, BT_INTEGER
, di
, OPTIONAL
,
2695 failed
, BT_LOGICAL
, dl
, OPTIONAL
);
2697 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2698 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2699 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2700 v
, BT_REAL
, dr
, OPTIONAL
);
2702 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2705 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2706 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2707 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2708 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2710 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2712 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2713 BT_INTEGER
, di
, GFC_STD_F2008
,
2714 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2715 i
, BT_INTEGER
, di
, REQUIRED
);
2717 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2719 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2720 BT_INTEGER
, di
, GFC_STD_F2008
,
2721 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2722 i
, BT_INTEGER
, di
, REQUIRED
);
2724 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2726 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2727 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2728 x
, BT_UNKNOWN
, 0, REQUIRED
);
2730 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2732 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2733 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2734 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2736 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2738 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2739 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2740 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2741 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2743 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2745 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2746 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2747 x
, BT_UNKNOWN
, 0, REQUIRED
);
2749 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2751 /* The following function is for G77 compatibility. */
2752 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2753 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2754 i
, BT_INTEGER
, 4, OPTIONAL
);
2756 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2757 use slightly different shoddy multiplicative congruential PRNG. */
2758 make_alias ("ran", GFC_STD_GNU
);
2760 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2762 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2763 gfc_check_range
, gfc_simplify_range
, NULL
,
2764 x
, BT_REAL
, dr
, REQUIRED
);
2766 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2768 add_sym_1 ("rank", GFC_ISYM_RANK
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2769 GFC_STD_F2018
, gfc_check_rank
, gfc_simplify_rank
, gfc_resolve_rank
,
2770 a
, BT_REAL
, dr
, REQUIRED
);
2771 make_generic ("rank", GFC_ISYM_RANK
, GFC_STD_F2018
);
2773 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2774 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2775 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2777 /* This provides compatibility with g77. */
2778 add_sym_1 ("realpart", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2779 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2780 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2782 add_sym_1 ("float", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2783 gfc_check_float
, gfc_simplify_float
, NULL
,
2784 a
, BT_INTEGER
, di
, REQUIRED
);
2786 if (flag_dec_intrinsic_ints
)
2788 make_alias ("floati", GFC_STD_GNU
);
2789 make_alias ("floatj", GFC_STD_GNU
);
2790 make_alias ("floatk", GFC_STD_GNU
);
2793 add_sym_1 ("dfloat", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2794 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2795 a
, BT_REAL
, dr
, REQUIRED
);
2797 add_sym_1 ("sngl", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2798 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2799 a
, BT_REAL
, dd
, REQUIRED
);
2801 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2803 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2804 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2805 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2807 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2809 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2810 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2811 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2813 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2815 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2816 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2817 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2818 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2820 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2822 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
2823 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2824 x
, BT_REAL
, dr
, REQUIRED
);
2826 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2828 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2829 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2830 gfc_check_same_type_as
, gfc_simplify_same_type_as
, NULL
,
2831 a
, BT_UNKNOWN
, 0, REQUIRED
,
2832 b
, BT_UNKNOWN
, 0, REQUIRED
);
2834 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2835 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2836 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2838 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2840 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2841 BT_INTEGER
, di
, GFC_STD_F95
,
2842 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2843 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2844 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2846 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2848 /* Added for G77 compatibility garbage. */
2849 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2850 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2852 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2854 /* Added for G77 compatibility. */
2855 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2856 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2857 x
, BT_REAL
, dr
, REQUIRED
);
2859 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2861 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2862 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2863 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2864 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2866 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2868 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2869 GFC_STD_F95
, gfc_check_selected_int_kind
,
2870 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2872 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2874 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2875 GFC_STD_F95
, gfc_check_selected_real_kind
,
2876 gfc_simplify_selected_real_kind
, NULL
,
2877 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2878 "radix", BT_INTEGER
, di
, OPTIONAL
);
2880 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2882 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2883 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2884 gfc_resolve_set_exponent
,
2885 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2887 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2889 add_sym_2 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2890 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2891 src
, BT_REAL
, dr
, REQUIRED
,
2892 kind
, BT_INTEGER
, di
, OPTIONAL
);
2894 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2896 add_sym_2 ("shifta", GFC_ISYM_SHIFTA
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2897 BT_INTEGER
, di
, GFC_STD_F2008
,
2898 gfc_check_shift
, gfc_simplify_shifta
, gfc_resolve_shift
,
2899 i
, BT_INTEGER
, di
, REQUIRED
,
2900 sh
, BT_INTEGER
, di
, REQUIRED
);
2902 make_generic ("shifta", GFC_ISYM_SHIFTA
, GFC_STD_F2008
);
2904 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2905 BT_INTEGER
, di
, GFC_STD_F2008
,
2906 gfc_check_shift
, gfc_simplify_shiftl
, gfc_resolve_shift
,
2907 i
, BT_INTEGER
, di
, REQUIRED
,
2908 sh
, BT_INTEGER
, di
, REQUIRED
);
2910 make_generic ("shiftl", GFC_ISYM_SHIFTL
, GFC_STD_F2008
);
2912 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2913 BT_INTEGER
, di
, GFC_STD_F2008
,
2914 gfc_check_shift
, gfc_simplify_shiftr
, gfc_resolve_shift
,
2915 i
, BT_INTEGER
, di
, REQUIRED
,
2916 sh
, BT_INTEGER
, di
, REQUIRED
);
2918 make_generic ("shiftr", GFC_ISYM_SHIFTR
, GFC_STD_F2008
);
2920 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2921 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
2922 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
2924 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2925 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
2926 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2928 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2929 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
2930 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
2932 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
2934 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2935 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
2936 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_VOID
, 0, REQUIRED
);
2938 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
2940 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2941 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
2942 x
, BT_REAL
, dr
, REQUIRED
);
2944 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2945 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
2946 x
, BT_REAL
, dd
, REQUIRED
);
2948 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2949 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2950 x
, BT_COMPLEX
, dz
, REQUIRED
);
2952 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2953 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2954 x
, BT_COMPLEX
, dd
, REQUIRED
);
2956 make_alias ("cdsin", GFC_STD_GNU
);
2958 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
2960 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2961 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2962 x
, BT_REAL
, dr
, REQUIRED
);
2964 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2965 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2966 x
, BT_REAL
, dd
, REQUIRED
);
2968 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
2970 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2971 BT_INTEGER
, di
, GFC_STD_F95
,
2972 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
2973 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2974 kind
, BT_INTEGER
, di
, OPTIONAL
);
2976 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
2978 /* Obtain the stride for a given dimensions; to be used only internally.
2979 "make_from_module" makes it inaccessible for external users. */
2980 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE
, CLASS_INQUIRY
, ACTUAL_NO
,
2981 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_GNU
,
2982 NULL
, NULL
, gfc_resolve_stride
,
2983 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
2986 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2987 BT_INTEGER
, ii
, GFC_STD_GNU
,
2988 gfc_check_sizeof
, gfc_simplify_sizeof
, NULL
,
2989 x
, BT_UNKNOWN
, 0, REQUIRED
);
2991 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
2993 /* The following functions are part of ISO_C_BINDING. */
2994 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
,
2995 BT_LOGICAL
, dl
, GFC_STD_F2003
, gfc_check_c_associated
, NULL
, NULL
,
2996 c_ptr_1
, BT_VOID
, 0, REQUIRED
,
2997 c_ptr_2
, BT_VOID
, 0, OPTIONAL
);
3000 add_sym_1 ("c_loc", GFC_ISYM_C_LOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3001 BT_VOID
, 0, GFC_STD_F2003
,
3002 gfc_check_c_loc
, NULL
, gfc_resolve_c_loc
,
3003 x
, BT_UNKNOWN
, 0, REQUIRED
);
3006 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3007 BT_VOID
, 0, GFC_STD_F2003
,
3008 gfc_check_c_funloc
, NULL
, gfc_resolve_c_funloc
,
3009 x
, BT_UNKNOWN
, 0, REQUIRED
);
3012 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
3013 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_F2008
,
3014 gfc_check_c_sizeof
, gfc_simplify_sizeof
, NULL
,
3015 x
, BT_UNKNOWN
, 0, REQUIRED
);
3018 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
3019 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS
, CLASS_INQUIRY
,
3020 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3021 NULL
, gfc_simplify_compiler_options
, NULL
);
3024 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION
, CLASS_INQUIRY
,
3025 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3026 NULL
, gfc_simplify_compiler_version
, NULL
);
3029 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
3030 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_spacing
, gfc_resolve_spacing
,
3031 x
, BT_REAL
, dr
, REQUIRED
);
3033 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
3035 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3036 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
3037 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
3038 ncopies
, BT_INTEGER
, di
, REQUIRED
);
3040 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
3042 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3043 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3044 x
, BT_REAL
, dr
, REQUIRED
);
3046 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3047 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3048 x
, BT_REAL
, dd
, REQUIRED
);
3050 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
3051 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3052 x
, BT_COMPLEX
, dz
, REQUIRED
);
3054 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
3055 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3056 x
, BT_COMPLEX
, dd
, REQUIRED
);
3058 make_alias ("cdsqrt", GFC_STD_GNU
);
3060 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
3062 add_sym_2_intent ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
,
3063 BT_INTEGER
, di
, GFC_STD_GNU
,
3064 gfc_check_stat
, NULL
, gfc_resolve_stat
,
3065 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3066 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3068 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
3070 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES
, CLASS_TRANSFORMATIONAL
,
3071 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
3072 gfc_check_failed_or_stopped_images
,
3073 gfc_simplify_failed_or_stopped_images
,
3074 gfc_resolve_stopped_images
, team
, BT_VOID
, di
, OPTIONAL
,
3075 kind
, BT_INTEGER
, di
, OPTIONAL
);
3077 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
3078 BT_INTEGER
, di
, GFC_STD_F2008
,
3079 gfc_check_storage_size
, gfc_simplify_storage_size
,
3080 gfc_resolve_storage_size
,
3081 a
, BT_UNKNOWN
, 0, REQUIRED
,
3082 kind
, BT_INTEGER
, di
, OPTIONAL
);
3084 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3085 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
3086 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3087 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
3089 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
3091 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3092 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
3093 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
3095 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
3097 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3098 GFC_STD_GNU
, NULL
, NULL
, NULL
,
3099 com
, BT_CHARACTER
, dc
, REQUIRED
);
3101 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
3103 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3104 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
3105 x
, BT_REAL
, dr
, REQUIRED
);
3107 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3108 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
3109 x
, BT_REAL
, dd
, REQUIRED
);
3111 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
3113 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3114 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3115 x
, BT_REAL
, dr
, REQUIRED
);
3117 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3118 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3119 x
, BT_REAL
, dd
, REQUIRED
);
3121 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
3123 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER
, CLASS_TRANSFORMATIONAL
,
3124 ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F2018
,
3125 gfc_check_team_number
, NULL
, gfc_resolve_team_number
,
3126 team
, BT_DERIVED
, di
, OPTIONAL
);
3128 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
3129 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
3130 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3131 dist
, BT_INTEGER
, di
, OPTIONAL
);
3133 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3134 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
3136 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
3138 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3139 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
3141 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
3143 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3144 gfc_check_fn_r
, gfc_simplify_tiny
, NULL
, x
, BT_REAL
, dr
, REQUIRED
);
3146 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
3148 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3149 BT_INTEGER
, di
, GFC_STD_F2008
,
3150 gfc_check_i
, gfc_simplify_trailz
, NULL
,
3151 i
, BT_INTEGER
, di
, REQUIRED
);
3153 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
3155 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3156 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
3157 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
3158 sz
, BT_INTEGER
, di
, OPTIONAL
);
3160 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
3162 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3163 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
3164 m
, BT_REAL
, dr
, REQUIRED
);
3166 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
3168 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
3169 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
3170 stg
, BT_CHARACTER
, dc
, REQUIRED
);
3172 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
3174 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
3175 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
3176 ut
, BT_INTEGER
, di
, REQUIRED
);
3178 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
3180 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3181 BT_INTEGER
, di
, GFC_STD_F95
,
3182 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
3183 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3184 kind
, BT_INTEGER
, di
, OPTIONAL
);
3186 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
3188 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3189 BT_INTEGER
, di
, GFC_STD_F2008
,
3190 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
3191 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3192 kind
, BT_INTEGER
, di
, OPTIONAL
);
3194 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
3196 /* g77 compatibility for UMASK. */
3197 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3198 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
3199 msk
, BT_INTEGER
, di
, REQUIRED
);
3201 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
3203 /* g77 compatibility for UNLINK. */
3204 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3205 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
3206 "path", BT_CHARACTER
, dc
, REQUIRED
);
3208 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
3210 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3211 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
3212 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
3213 f
, BT_REAL
, dr
, REQUIRED
);
3215 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
3217 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3218 BT_INTEGER
, di
, GFC_STD_F95
,
3219 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
3220 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
3221 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
3223 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
3225 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
3226 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
3227 x
, BT_UNKNOWN
, 0, REQUIRED
);
3229 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
3233 add_sym_1 ("acosd", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3235 gfc_check_fn_r
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3236 x
, BT_REAL
, dr
, REQUIRED
);
3238 add_sym_1 ("dacosd", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3240 gfc_check_fn_d
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3241 x
, BT_REAL
, dd
, REQUIRED
);
3243 make_generic ("acosd", GFC_ISYM_ACOS
, GFC_STD_GNU
);
3245 add_sym_1 ("asind", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3247 gfc_check_fn_r
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3248 x
, BT_REAL
, dr
, REQUIRED
);
3250 add_sym_1 ("dasind", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3252 gfc_check_fn_d
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3253 x
, BT_REAL
, dd
, REQUIRED
);
3255 make_generic ("asind", GFC_ISYM_ASIN
, GFC_STD_GNU
);
3257 add_sym_1 ("atand", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3259 gfc_check_fn_r
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3260 x
, BT_REAL
, dr
, REQUIRED
);
3262 add_sym_1 ("datand", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3264 gfc_check_fn_d
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3265 x
, BT_REAL
, dd
, REQUIRED
);
3267 make_generic ("atand", GFC_ISYM_ATAN
, GFC_STD_GNU
);
3269 add_sym_2 ("atan2d",GFC_ISYM_ATAN2
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3271 gfc_check_atan2
, gfc_simplify_atan2d
, gfc_resolve_atan2d
,
3272 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
3274 add_sym_2 ("datan2d",GFC_ISYM_ATAN2
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3276 gfc_check_datan2
, gfc_simplify_atan2d
, gfc_resolve_atan2d
,
3277 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
3279 make_generic ("atan2d", GFC_ISYM_ATAN2
, GFC_STD_GNU
);
3281 add_sym_1 ("cosd", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3283 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3284 x
, BT_REAL
, dr
, REQUIRED
);
3286 add_sym_1 ("dcosd", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3288 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3289 x
, BT_REAL
, dd
, REQUIRED
);
3291 make_generic ("cosd", GFC_ISYM_COS
, GFC_STD_GNU
);
3293 add_sym_1 ("cotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3295 gfc_check_fn_rc2008
, gfc_simplify_cotan
, gfc_resolve_cotan
,
3296 x
, BT_REAL
, dr
, REQUIRED
);
3298 add_sym_1 ("dcotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3300 gfc_check_fn_d
, gfc_simplify_cotan
, gfc_resolve_cotan
,
3301 x
, BT_REAL
, dd
, REQUIRED
);
3303 make_generic ("cotan", GFC_ISYM_COTAN
, GFC_STD_GNU
);
3305 add_sym_1 ("cotand", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3307 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3308 x
, BT_REAL
, dr
, REQUIRED
);
3310 add_sym_1 ("dcotand",GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3312 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3313 x
, BT_REAL
, dd
, REQUIRED
);
3315 make_generic ("cotand", GFC_ISYM_COTAN
, GFC_STD_GNU
);
3317 add_sym_1 ("sind", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3319 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3320 x
, BT_REAL
, dr
, REQUIRED
);
3322 add_sym_1 ("dsind", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3324 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3325 x
, BT_REAL
, dd
, REQUIRED
);
3327 make_generic ("sind", GFC_ISYM_SIN
, GFC_STD_GNU
);
3329 add_sym_1 ("tand", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3331 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3332 x
, BT_REAL
, dr
, REQUIRED
);
3334 add_sym_1 ("dtand", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3336 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3337 x
, BT_REAL
, dd
, REQUIRED
);
3339 make_generic ("tand", GFC_ISYM_TAN
, GFC_STD_GNU
);
3342 /* The following function is internally used for coarray libray functions.
3343 "make_from_module" makes it inaccessible for external users. */
3344 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET
, CLASS_IMPURE
, ACTUAL_NO
,
3345 BT_REAL
, dr
, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3346 x
, BT_REAL
, dr
, REQUIRED
);
3351 /* Add intrinsic subroutines. */
3354 add_subroutines (void)
3356 /* Argument names. These are used as argument keywords and so need to
3357 match the documentation. Please keep this list in sorted order. */
3359 *a
= "a", *c
= "count", *cm
= "count_max", *com
= "command",
3360 *cr
= "count_rate", *dt
= "date", *errmsg
= "errmsg", *f
= "from",
3361 *fp
= "frompos", *gt
= "get", *h
= "harvest", *han
= "handler",
3362 *length
= "length", *ln
= "len", *md
= "mode", *msk
= "mask",
3363 *name
= "name", *num
= "number", *of
= "offset", *old
= "old",
3364 *p1
= "path1", *p2
= "path2", *pid
= "pid", *pos
= "pos",
3365 *pt
= "put", *ptr
= "ptr", *res
= "result",
3366 *result_image
= "result_image", *sec
= "seconds", *sig
= "sig",
3367 *st
= "status", *stat
= "stat", *sz
= "size", *t
= "to",
3368 *tm
= "time", *tp
= "topos", *trim_name
= "trim_name", *ut
= "unit",
3369 *val
= "value", *vl
= "values", *whence
= "whence", *zn
= "zone";
3371 int di
, dr
, dc
, dl
, ii
;
3373 di
= gfc_default_integer_kind
;
3374 dr
= gfc_default_real_kind
;
3375 dc
= gfc_default_character_kind
;
3376 dl
= gfc_default_logical_kind
;
3377 ii
= gfc_index_integer_kind
;
3379 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
3383 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF
, CLASS_ATOMIC
,
3384 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3385 gfc_check_atomic_def
, NULL
, gfc_resolve_atomic_def
,
3386 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3387 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3388 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3390 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF
, CLASS_ATOMIC
,
3391 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3392 gfc_check_atomic_ref
, NULL
, gfc_resolve_atomic_ref
,
3393 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3394 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3395 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3397 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS
, CLASS_ATOMIC
,
3398 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3399 gfc_check_atomic_cas
, NULL
, NULL
,
3400 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3401 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3402 "compare", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3403 "new", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3404 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3406 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD
, CLASS_ATOMIC
,
3407 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3408 gfc_check_atomic_op
, NULL
, NULL
,
3409 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3410 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3411 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3413 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND
, CLASS_ATOMIC
,
3414 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3415 gfc_check_atomic_op
, NULL
, NULL
,
3416 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3417 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3418 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3420 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR
, CLASS_ATOMIC
,
3421 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3422 gfc_check_atomic_op
, NULL
, NULL
,
3423 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3424 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3425 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3427 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR
, CLASS_ATOMIC
,
3428 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3429 gfc_check_atomic_op
, NULL
, NULL
,
3430 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3431 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3432 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3434 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD
, CLASS_ATOMIC
,
3435 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3436 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3437 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3438 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3439 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3440 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3442 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND
, CLASS_ATOMIC
,
3443 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3444 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3445 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3446 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3447 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3448 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3450 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR
, CLASS_ATOMIC
,
3451 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3452 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3453 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3454 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3455 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3456 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3458 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR
, CLASS_ATOMIC
,
3459 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3460 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3461 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3462 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3463 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3464 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3466 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE
, GFC_STD_GNU
, NULL
);
3468 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3469 GFC_STD_F95
, gfc_check_cpu_time
, NULL
, gfc_resolve_cpu_time
,
3470 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3472 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY
, CLASS_ATOMIC
,
3473 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3474 gfc_check_event_query
, NULL
, gfc_resolve_event_query
,
3475 "event", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3476 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3477 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3479 /* More G77 compatibility garbage. */
3480 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3481 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
3482 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3483 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3485 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3486 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
3487 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3489 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3490 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
3491 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3493 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3494 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
3495 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3496 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3498 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3499 GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
3500 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3501 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3503 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3504 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
3505 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3507 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3508 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
3509 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3510 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3512 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3513 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
3514 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3515 md
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3516 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3518 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
3519 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
3520 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3521 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3522 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3523 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3525 /* More G77 compatibility garbage. */
3526 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3527 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
3528 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3529 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3531 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3532 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
3533 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3534 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3536 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
3537 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
3538 NULL
, NULL
, gfc_resolve_execute_command_line
,
3539 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3540 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
3541 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
3542 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3543 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3545 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3546 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
3547 dt
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3549 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3550 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
3551 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3553 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3554 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
3555 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3556 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3558 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
3559 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3560 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3561 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3563 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
3564 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
3565 pos
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3566 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3568 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
3569 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
3570 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3572 /* F2003 commandline routines. */
3574 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
3575 BT_UNKNOWN
, 0, GFC_STD_F2003
,
3576 NULL
, NULL
, gfc_resolve_get_command
,
3577 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3578 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3579 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3581 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
3582 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
3583 gfc_resolve_get_command_argument
,
3584 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3585 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3586 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3587 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3589 /* F2003 subroutine to get environment variables. */
3591 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
3592 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
3593 NULL
, NULL
, gfc_resolve_get_environment_variable
,
3594 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3595 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3596 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3597 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3598 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
3600 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
, BT_UNKNOWN
, 0,
3602 gfc_check_move_alloc
, NULL
, NULL
,
3603 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
3604 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3606 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
3607 GFC_STD_F95
, gfc_check_mvbits
, NULL
, gfc_resolve_mvbits
,
3608 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3609 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3610 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3611 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3612 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3614 if (flag_dec_intrinsic_ints
)
3616 make_alias ("bmvbits", GFC_STD_GNU
);
3617 make_alias ("imvbits", GFC_STD_GNU
);
3618 make_alias ("jmvbits", GFC_STD_GNU
);
3619 make_alias ("kmvbits", GFC_STD_GNU
);
3622 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT
, CLASS_IMPURE
,
3623 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3624 gfc_check_random_init
, NULL
, gfc_resolve_random_init
,
3625 "repeatable", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
,
3626 "image_distinct", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
);
3628 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
3629 BT_UNKNOWN
, 0, GFC_STD_F95
,
3630 gfc_check_random_number
, NULL
, gfc_resolve_random_number
,
3631 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3633 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
3634 BT_UNKNOWN
, 0, GFC_STD_F95
,
3635 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
3636 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3637 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3638 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3640 /* The following subroutines are part of ISO_C_BINDING. */
3642 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3643 GFC_STD_F2003
, gfc_check_c_f_pointer
, NULL
, NULL
,
3644 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3645 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
,
3646 "shape", BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3649 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER
, CLASS_IMPURE
,
3650 BT_UNKNOWN
, 0, GFC_STD_F2003
, gfc_check_c_f_procpointer
,
3652 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3653 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3656 /* Internal subroutine for emitting a runtime error. */
3658 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR
, CLASS_IMPURE
,
3659 BT_UNKNOWN
, 0, GFC_STD_GNU
,
3660 gfc_check_fe_runtime_error
, NULL
, gfc_resolve_fe_runtime_error
,
3661 "msg", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3665 make_from_module ();
3667 /* Coarray collectives. */
3668 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST
, CLASS_IMPURE
,
3669 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3670 gfc_check_co_broadcast
, NULL
, NULL
,
3671 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3672 "source_image", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3673 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3674 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3676 add_sym_4s ("co_max", GFC_ISYM_CO_MAX
, CLASS_IMPURE
,
3677 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3678 gfc_check_co_minmax
, NULL
, NULL
,
3679 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3680 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3681 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3682 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3684 add_sym_4s ("co_min", GFC_ISYM_CO_MIN
, CLASS_IMPURE
,
3685 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3686 gfc_check_co_minmax
, NULL
, NULL
,
3687 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3688 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3689 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3690 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3692 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM
, CLASS_IMPURE
,
3693 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3694 gfc_check_co_sum
, NULL
, NULL
,
3695 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3696 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3697 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3698 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3700 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE
, CLASS_IMPURE
,
3701 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3702 gfc_check_co_reduce
, NULL
, NULL
,
3703 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3704 "operator", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3705 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3706 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3707 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3710 /* The following subroutine is internally used for coarray libray functions.
3711 "make_from_module" makes it inaccessible for external users. */
3712 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND
, CLASS_IMPURE
,
3713 BT_UNKNOWN
, 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3714 "x", BT_REAL
, dr
, REQUIRED
, INTENT_OUT
,
3715 "y", BT_REAL
, dr
, REQUIRED
, INTENT_IN
);
3719 /* More G77 compatibility garbage. */
3720 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3721 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
3722 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3723 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3724 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3726 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
3727 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
3728 "seed", BT_INTEGER
, 4, REQUIRED
, INTENT_IN
);
3730 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3731 gfc_check_exit
, NULL
, gfc_resolve_exit
,
3732 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3736 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3737 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
3738 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3739 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3740 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3742 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3743 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
3744 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3745 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3747 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3748 gfc_check_flush
, NULL
, gfc_resolve_flush
,
3749 ut
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3751 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3752 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
3753 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3754 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3755 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3757 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3758 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
3759 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3760 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3762 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3763 gfc_check_free
, NULL
, NULL
,
3764 ptr
, BT_INTEGER
, ii
, REQUIRED
, INTENT_INOUT
);
3766 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3767 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
3768 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3769 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3770 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3771 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3773 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3774 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
3775 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3776 of
, BT_INTEGER
, ii
, REQUIRED
, INTENT_OUT
);
3778 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3779 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
3780 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3781 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3783 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3784 gfc_check_kill_sub
, NULL
, NULL
,
3785 pid
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3786 sig
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3787 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3789 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3790 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
3791 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3792 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3793 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3795 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3796 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
3797 "string", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3799 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3800 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
3801 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3802 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3803 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3805 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3806 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
3807 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3809 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3810 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
3811 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3812 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3813 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3815 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3816 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
3817 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3818 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3819 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3821 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3822 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
3823 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3824 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3825 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3827 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3828 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3829 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3830 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3831 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3833 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3834 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3835 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3836 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3837 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3839 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3840 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3841 com
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3842 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3844 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3845 BT_UNKNOWN
, 0, GFC_STD_F95
,
3846 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3847 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3848 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3849 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3851 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3852 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3853 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3854 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3856 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3857 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3858 msk
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3859 old
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3861 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3862 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3863 "path", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3864 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3868 /* Add a function to the list of conversion symbols. */
3871 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3873 gfc_typespec from
, to
;
3874 gfc_intrinsic_sym
*sym
;
3876 if (sizing
== SZ_CONVS
)
3882 gfc_clear_ts (&from
);
3883 from
.type
= from_type
;
3884 from
.kind
= from_kind
;
3890 sym
= conversion
+ nconv
;
3892 sym
->name
= conv_name (&from
, &to
);
3893 sym
->lib_name
= sym
->name
;
3894 sym
->simplify
.cc
= gfc_convert_constant
;
3895 sym
->standard
= standard
;
3898 sym
->conversion
= 1;
3900 sym
->id
= GFC_ISYM_CONVERSION
;
3906 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3907 functions by looping over the kind tables. */
3910 add_conversions (void)
3914 /* Integer-Integer conversions. */
3915 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3916 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
3921 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3922 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
3925 /* Integer-Real/Complex conversions. */
3926 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3927 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3929 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3930 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3932 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
3933 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3935 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3936 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3938 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
3939 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3942 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3944 /* Hollerith-Integer conversions. */
3945 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3946 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3947 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3948 /* Hollerith-Real conversions. */
3949 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3950 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3951 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3952 /* Hollerith-Complex conversions. */
3953 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3954 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3955 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3957 /* Hollerith-Character conversions. */
3958 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
3959 gfc_default_character_kind
, GFC_STD_LEGACY
);
3961 /* Hollerith-Logical conversions. */
3962 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
3963 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3964 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
3967 /* Real/Complex - Real/Complex conversions. */
3968 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3969 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3973 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3974 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3976 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3977 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3980 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3981 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3983 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3984 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3987 /* Logical/Logical kind conversion. */
3988 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
3989 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
3994 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
3995 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
3998 /* Integer-Logical and Logical-Integer conversions. */
3999 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
4000 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
4001 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
4003 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4004 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
4005 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
4006 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4012 add_char_conversions (void)
4016 /* Count possible conversions. */
4017 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4018 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4022 /* Allocate memory. */
4023 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
4025 /* Add the conversions themselves. */
4027 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4028 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4030 gfc_typespec from
, to
;
4035 gfc_clear_ts (&from
);
4036 from
.type
= BT_CHARACTER
;
4037 from
.kind
= gfc_character_kinds
[i
].kind
;
4040 to
.type
= BT_CHARACTER
;
4041 to
.kind
= gfc_character_kinds
[j
].kind
;
4043 char_conversions
[n
].name
= conv_name (&from
, &to
);
4044 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
4045 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
4046 char_conversions
[n
].standard
= GFC_STD_F2003
;
4047 char_conversions
[n
].elemental
= 1;
4048 char_conversions
[n
].pure
= 1;
4049 char_conversions
[n
].conversion
= 0;
4050 char_conversions
[n
].ts
= to
;
4051 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
4058 /* Initialize the table of intrinsics. */
4060 gfc_intrinsic_init_1 (void)
4062 nargs
= nfunc
= nsub
= nconv
= 0;
4064 /* Create a namespace to hold the resolved intrinsic symbols. */
4065 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
4074 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
4075 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
4076 + sizeof (gfc_intrinsic_arg
) * nargs
);
4078 next_sym
= functions
;
4079 subroutines
= functions
+ nfunc
;
4081 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
4083 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
4085 sizing
= SZ_NOTHING
;
4092 /* Character conversion intrinsics need to be treated separately. */
4093 add_char_conversions ();
4098 gfc_intrinsic_done_1 (void)
4102 free (char_conversions
);
4103 gfc_free_namespace (gfc_intrinsic_namespace
);
4107 /******** Subroutines to check intrinsic interfaces ***********/
4109 /* Given a formal argument list, remove any NULL arguments that may
4110 have been left behind by a sort against some formal argument list. */
4113 remove_nullargs (gfc_actual_arglist
**ap
)
4115 gfc_actual_arglist
*head
, *tail
, *next
;
4119 for (head
= *ap
; head
; head
= next
)
4123 if (head
->expr
== NULL
&& !head
->label
)
4126 gfc_free_actual_arglist (head
);
4145 /* Given an actual arglist and a formal arglist, sort the actual
4146 arglist so that its arguments are in a one-to-one correspondence
4147 with the format arglist. Arguments that are not present are given
4148 a blank gfc_actual_arglist structure. If something is obviously
4149 wrong (say, a missing required argument) we abort sorting and
4153 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
4154 gfc_intrinsic_arg
*formal
, locus
*where
)
4156 gfc_actual_arglist
*actual
, *a
;
4157 gfc_intrinsic_arg
*f
;
4159 remove_nullargs (ap
);
4162 for (f
= formal
; f
; f
= f
->next
)
4168 if (f
== NULL
&& a
== NULL
) /* No arguments */
4172 { /* Put the nonkeyword arguments in a 1:1 correspondence */
4178 if (a
->name
!= NULL
)
4190 gfc_error ("Too many arguments in call to %qs at %L", name
, where
);
4194 /* Associate the remaining actual arguments, all of which have
4195 to be keyword arguments. */
4196 for (; a
; a
= a
->next
)
4198 for (f
= formal
; f
; f
= f
->next
)
4199 if (strcmp (a
->name
, f
->name
) == 0)
4204 if (a
->name
[0] == '%')
4205 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4206 "are not allowed in this context at %L", where
);
4208 gfc_error ("Can't find keyword named %qs in call to %qs at %L",
4209 a
->name
, name
, where
);
4213 if (f
->actual
!= NULL
)
4215 gfc_error ("Argument %qs appears twice in call to %qs at %L",
4216 f
->name
, name
, where
);
4224 /* At this point, all unmatched formal args must be optional. */
4225 for (f
= formal
; f
; f
= f
->next
)
4227 if (f
->actual
== NULL
&& f
->optional
== 0)
4229 gfc_error ("Missing actual argument %qs in call to %qs at %L",
4230 f
->name
, name
, where
);
4236 /* Using the formal argument list, string the actual argument list
4237 together in a way that corresponds with the formal list. */
4240 for (f
= formal
; f
; f
= f
->next
)
4242 if (f
->actual
&& f
->actual
->label
!= NULL
&& f
->ts
.type
)
4244 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
4248 if (f
->actual
== NULL
)
4250 a
= gfc_get_actual_arglist ();
4251 a
->missing_arg_type
= f
->ts
.type
;
4263 actual
->next
= NULL
; /* End the sorted argument list. */
4269 /* Compare an actual argument list with an intrinsic's formal argument
4270 list. The lists are checked for agreement of type. We don't check
4271 for arrayness here. */
4274 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
4277 gfc_actual_arglist
*actual
;
4278 gfc_intrinsic_arg
*formal
;
4281 formal
= sym
->formal
;
4285 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
4289 if (actual
->expr
== NULL
)
4294 /* A kind of 0 means we don't check for kind. */
4296 ts
.kind
= actual
->expr
->ts
.kind
;
4298 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
4301 gfc_error ("Type of argument %qs in call to %qs at %L should "
4302 "be %s, not %s", gfc_current_intrinsic_arg
[i
]->name
,
4303 gfc_current_intrinsic
, &actual
->expr
->where
,
4304 gfc_typename (&formal
->ts
),
4305 gfc_typename (&actual
->expr
->ts
));
4309 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4310 if (formal
->intent
== INTENT_INOUT
|| formal
->intent
== INTENT_OUT
)
4312 const char* context
= (error_flag
4313 ? _("actual argument to INTENT = OUT/INOUT")
4316 /* No pointer arguments for intrinsics. */
4317 if (!gfc_check_vardef_context (actual
->expr
, false, false, false, context
))
4326 /* Given a pointer to an intrinsic symbol and an expression node that
4327 represent the function call to that subroutine, figure out the type
4328 of the result. This may involve calling a resolution subroutine. */
4331 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4333 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4334 gfc_actual_arglist
*arg
;
4336 if (specific
->resolve
.f1
== NULL
)
4338 if (e
->value
.function
.name
== NULL
)
4339 e
->value
.function
.name
= specific
->lib_name
;
4341 if (e
->ts
.type
== BT_UNKNOWN
)
4342 e
->ts
= specific
->ts
;
4346 arg
= e
->value
.function
.actual
;
4348 /* Special case hacks for MIN and MAX. */
4349 if (specific
->resolve
.f1m
== gfc_resolve_max
4350 || specific
->resolve
.f1m
== gfc_resolve_min
)
4352 (*specific
->resolve
.f1m
) (e
, arg
);
4358 (*specific
->resolve
.f0
) (e
);
4367 (*specific
->resolve
.f1
) (e
, a1
);
4376 (*specific
->resolve
.f2
) (e
, a1
, a2
);
4385 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
4394 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
4403 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
4412 (*specific
->resolve
.f6
) (e
, a1
, a2
, a3
, a4
, a5
, a6
);
4416 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4420 /* Given an intrinsic symbol node and an expression node, call the
4421 simplification function (if there is one), perhaps replacing the
4422 expression with something simpler. We return false on an error
4423 of the simplification, true if the simplification worked, even
4424 if nothing has changed in the expression itself. */
4427 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4429 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4430 gfc_actual_arglist
*arg
;
4432 /* Max and min require special handling due to the variable number
4434 if (specific
->simplify
.f1
== gfc_simplify_min
)
4436 result
= gfc_simplify_min (e
);
4440 if (specific
->simplify
.f1
== gfc_simplify_max
)
4442 result
= gfc_simplify_max (e
);
4446 /* Some math intrinsics need to wrap the original expression. */
4447 if (specific
->simplify
.f1
== gfc_simplify_trigd
4448 || specific
->simplify
.f1
== gfc_simplify_atrigd
4449 || specific
->simplify
.f1
== gfc_simplify_cotan
)
4451 result
= (*specific
->simplify
.f1
) (e
);
4455 if (specific
->simplify
.f1
== NULL
)
4461 arg
= e
->value
.function
.actual
;
4465 result
= (*specific
->simplify
.f0
) ();
4472 if (specific
->simplify
.cc
== gfc_convert_constant
4473 || specific
->simplify
.cc
== gfc_convert_char_constant
)
4475 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
4480 result
= (*specific
->simplify
.f1
) (a1
);
4487 result
= (*specific
->simplify
.f2
) (a1
, a2
);
4494 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
4501 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
4508 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
4515 result
= (*specific
->simplify
.f6
)
4516 (a1
, a2
, a3
, a4
, a5
, a6
);
4519 ("do_simplify(): Too many args for intrinsic");
4527 if (result
== &gfc_bad_expr
)
4531 resolve_intrinsic (specific
, e
); /* Must call at run-time */
4534 result
->where
= e
->where
;
4535 gfc_replace_expr (e
, result
);
4542 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4543 error messages. This subroutine returns false if a subroutine
4544 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4545 list cannot match any intrinsic. */
4548 init_arglist (gfc_intrinsic_sym
*isym
)
4550 gfc_intrinsic_arg
*formal
;
4553 gfc_current_intrinsic
= isym
->name
;
4556 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
4558 if (i
>= MAX_INTRINSIC_ARGS
)
4559 gfc_internal_error ("init_arglist(): too many arguments");
4560 gfc_current_intrinsic_arg
[i
++] = formal
;
4565 /* Given a pointer to an intrinsic symbol and an expression consisting
4566 of a function call, see if the function call is consistent with the
4567 intrinsic's formal argument list. Return true if the expression
4568 and intrinsic match, false otherwise. */
4571 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
4573 gfc_actual_arglist
*arg
, **ap
;
4576 ap
= &expr
->value
.function
.actual
;
4578 init_arglist (specific
);
4580 /* Don't attempt to sort the argument list for min or max. */
4581 if (specific
->check
.f1m
== gfc_check_min_max
4582 || specific
->check
.f1m
== gfc_check_min_max_integer
4583 || specific
->check
.f1m
== gfc_check_min_max_real
4584 || specific
->check
.f1m
== gfc_check_min_max_double
)
4586 if (!do_ts29113_check (specific
, *ap
))
4588 return (*specific
->check
.f1m
) (*ap
);
4591 if (!sort_actual (specific
->name
, ap
, specific
->formal
, &expr
->where
))
4594 if (!do_ts29113_check (specific
, *ap
))
4597 if (specific
->check
.f5ml
== gfc_check_minloc_maxloc
)
4598 /* This is special because we might have to reorder the argument list. */
4599 t
= gfc_check_minloc_maxloc (*ap
);
4600 else if (specific
->check
.f6fl
== gfc_check_findloc
)
4601 t
= gfc_check_findloc (*ap
);
4602 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
4603 /* This is also special because we also might have to reorder the
4605 t
= gfc_check_minval_maxval (*ap
);
4606 else if (specific
->check
.f3red
== gfc_check_product_sum
)
4607 /* Same here. The difference to the previous case is that we allow a
4608 general numeric type. */
4609 t
= gfc_check_product_sum (*ap
);
4610 else if (specific
->check
.f3red
== gfc_check_transf_bit_intrins
)
4611 /* Same as for PRODUCT and SUM, but different checks. */
4612 t
= gfc_check_transf_bit_intrins (*ap
);
4615 if (specific
->check
.f1
== NULL
)
4617 t
= check_arglist (ap
, specific
, error_flag
);
4619 expr
->ts
= specific
->ts
;
4622 t
= do_check (specific
, *ap
);
4625 /* Check conformance of elemental intrinsics. */
4626 if (t
&& specific
->elemental
)
4629 gfc_expr
*first_expr
;
4630 arg
= expr
->value
.function
.actual
;
4632 /* There is no elemental intrinsic without arguments. */
4633 gcc_assert(arg
!= NULL
);
4634 first_expr
= arg
->expr
;
4636 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
4637 if (!gfc_check_conformance (first_expr
, arg
->expr
,
4638 "arguments '%s' and '%s' for "
4640 gfc_current_intrinsic_arg
[0]->name
,
4641 gfc_current_intrinsic_arg
[n
]->name
,
4642 gfc_current_intrinsic
))
4647 remove_nullargs (ap
);
4653 /* Check whether an intrinsic belongs to whatever standard the user
4654 has chosen, taking also into account -fall-intrinsics. Here, no
4655 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4656 textual representation of the symbols standard status (like
4657 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4658 can be used to construct a detailed warning/error message in case of
4662 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
4663 const char** symstd
, bool silent
, locus where
)
4665 const char* symstd_msg
;
4667 /* For -fall-intrinsics, just succeed. */
4668 if (flag_all_intrinsics
)
4671 /* Find the symbol's standard message for later usage. */
4672 switch (isym
->standard
)
4675 symstd_msg
= "available since Fortran 77";
4678 case GFC_STD_F95_OBS
:
4679 symstd_msg
= "obsolescent in Fortran 95";
4682 case GFC_STD_F95_DEL
:
4683 symstd_msg
= "deleted in Fortran 95";
4687 symstd_msg
= "new in Fortran 95";
4691 symstd_msg
= "new in Fortran 2003";
4695 symstd_msg
= "new in Fortran 2008";
4699 symstd_msg
= "new in Fortran 2018";
4703 symstd_msg
= "a GNU Fortran extension";
4706 case GFC_STD_LEGACY
:
4707 symstd_msg
= "for backward compatibility";
4711 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
4712 isym
->name
, isym
->standard
);
4715 /* If warning about the standard, warn and succeed. */
4716 if (gfc_option
.warn_std
& isym
->standard
)
4718 /* Do only print a warning if not a GNU extension. */
4719 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
4720 gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
4721 isym
->name
, _(symstd_msg
), &where
);
4726 /* If allowing the symbol's standard, succeed, too. */
4727 if (gfc_option
.allow_std
& isym
->standard
)
4730 /* Otherwise, fail. */
4732 *symstd
= _(symstd_msg
);
4737 /* See if a function call corresponds to an intrinsic function call.
4740 MATCH_YES if the call corresponds to an intrinsic, simplification
4741 is done if possible.
4743 MATCH_NO if the call does not correspond to an intrinsic
4745 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4746 error during the simplification process.
4748 The error_flag parameter enables an error reporting. */
4751 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
4753 gfc_intrinsic_sym
*isym
, *specific
;
4754 gfc_actual_arglist
*actual
;
4758 if (expr
->value
.function
.isym
!= NULL
)
4759 return (!do_simplify(expr
->value
.function
.isym
, expr
))
4760 ? MATCH_ERROR
: MATCH_YES
;
4763 gfc_push_suppress_errors ();
4766 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
4767 if (actual
->expr
!= NULL
)
4768 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
4769 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
4771 name
= expr
->symtree
->n
.sym
->name
;
4773 if (expr
->symtree
->n
.sym
->intmod_sym_id
)
4775 gfc_isym_id id
= gfc_isym_id_by_intmod_sym (expr
->symtree
->n
.sym
);
4776 isym
= specific
= gfc_intrinsic_function_by_id (id
);
4779 isym
= specific
= gfc_find_function (name
);
4784 gfc_pop_suppress_errors ();
4788 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
4789 || isym
->id
== GFC_ISYM_CMPLX
)
4790 && gfc_init_expr_flag
4791 && !gfc_notify_std (GFC_STD_F2003
, "Function %qs as initialization "
4792 "expression at %L", name
, &expr
->where
))
4795 gfc_pop_suppress_errors ();
4799 /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
4800 SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
4801 initialization expressions. */
4803 if (gfc_init_expr_flag
&& isym
->transformational
)
4805 gfc_isym_id id
= isym
->id
;
4806 if (id
!= GFC_ISYM_REPEAT
&& id
!= GFC_ISYM_RESHAPE
4807 && id
!= GFC_ISYM_SI_KIND
&& id
!= GFC_ISYM_SR_KIND
4808 && id
!= GFC_ISYM_TRANSFER
&& id
!= GFC_ISYM_TRIM
4809 && !gfc_notify_std (GFC_STD_F2003
, "Transformational function %qs "
4810 "at %L is invalid in an initialization "
4811 "expression", name
, &expr
->where
))
4814 gfc_pop_suppress_errors ();
4820 gfc_current_intrinsic_where
= &expr
->where
;
4822 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
4823 if (isym
->check
.f1m
== gfc_check_min_max
)
4825 init_arglist (isym
);
4827 if (isym
->check
.f1m(expr
->value
.function
.actual
))
4831 gfc_pop_suppress_errors ();
4835 /* If the function is generic, check all of its specific
4836 incarnations. If the generic name is also a specific, we check
4837 that name last, so that any error message will correspond to the
4839 gfc_push_suppress_errors ();
4843 for (specific
= isym
->specific_head
; specific
;
4844 specific
= specific
->next
)
4846 if (specific
== isym
)
4848 if (check_specific (specific
, expr
, 0))
4850 gfc_pop_suppress_errors ();
4856 gfc_pop_suppress_errors ();
4858 if (!check_specific (isym
, expr
, error_flag
))
4861 gfc_pop_suppress_errors ();
4868 expr
->value
.function
.isym
= specific
;
4869 if (!expr
->symtree
->n
.sym
->module
)
4870 gfc_intrinsic_symbol (expr
->symtree
->n
.sym
);
4873 gfc_pop_suppress_errors ();
4875 if (!do_simplify (specific
, expr
))
4878 /* F95, 7.1.6.1, Initialization expressions
4879 (4) An elemental intrinsic function reference of type integer or
4880 character where each argument is an initialization expression
4881 of type integer or character
4883 F2003, 7.1.7 Initialization expression
4884 (4) A reference to an elemental standard intrinsic function,
4885 where each argument is an initialization expression */
4887 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
4888 && !gfc_notify_std (GFC_STD_F2003
, "Elemental function as "
4889 "initialization expression with non-integer/non-"
4890 "character arguments at %L", &expr
->where
))
4897 /* See if a CALL statement corresponds to an intrinsic subroutine.
4898 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4899 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4903 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
4905 gfc_intrinsic_sym
*isym
;
4908 name
= c
->symtree
->n
.sym
->name
;
4910 if (c
->symtree
->n
.sym
->intmod_sym_id
)
4913 id
= gfc_isym_id_by_intmod_sym (c
->symtree
->n
.sym
);
4914 isym
= gfc_intrinsic_subroutine_by_id (id
);
4917 isym
= gfc_find_subroutine (name
);
4922 gfc_push_suppress_errors ();
4924 init_arglist (isym
);
4926 if (!isym
->vararg
&& !sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
))
4929 if (!do_ts29113_check (isym
, c
->ext
.actual
))
4932 if (isym
->check
.f1
!= NULL
)
4934 if (!do_check (isym
, c
->ext
.actual
))
4939 if (!check_arglist (&c
->ext
.actual
, isym
, 1))
4943 /* The subroutine corresponds to an intrinsic. Allow errors to be
4944 seen at this point. */
4946 gfc_pop_suppress_errors ();
4948 c
->resolved_isym
= isym
;
4949 if (isym
->resolve
.s1
!= NULL
)
4950 isym
->resolve
.s1 (c
);
4953 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
4954 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
4957 if (gfc_do_concurrent_flag
&& !isym
->pure
)
4959 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
4960 "block at %L is not PURE", name
, &c
->loc
);
4964 if (!isym
->pure
&& gfc_pure (NULL
))
4966 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name
,
4972 gfc_unset_implicit_pure (NULL
);
4974 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
4980 gfc_pop_suppress_errors ();
4985 /* Call gfc_convert_type() with warning enabled. */
4988 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
4990 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
4994 /* Try to convert an expression (in place) from one type to another.
4995 'eflag' controls the behavior on error.
4997 The possible values are:
4999 1 Generate a gfc_error()
5000 2 Generate a gfc_internal_error().
5002 'wflag' controls the warning related to conversion. */
5005 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
)
5007 gfc_intrinsic_sym
*sym
;
5008 gfc_typespec from_ts
;
5014 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
5016 if (ts
->type
== BT_UNKNOWN
)
5019 /* NULL and zero size arrays get their type here, unless they already have a
5021 if ((expr
->expr_type
== EXPR_NULL
5022 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
5023 && expr
->ts
.type
== BT_UNKNOWN
)
5025 /* Sometimes the RHS acquire the type. */
5030 if (expr
->ts
.type
== BT_UNKNOWN
)
5033 if (expr
->ts
.type
== BT_DERIVED
&& ts
->type
== BT_DERIVED
5034 && gfc_compare_types (&expr
->ts
, ts
))
5037 sym
= find_conv (&expr
->ts
, ts
);
5041 /* At this point, a conversion is necessary. A warning may be needed. */
5042 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
5044 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
5045 gfc_typename (&from_ts
), gfc_typename (ts
),
5050 if (flag_range_check
&& expr
->expr_type
== EXPR_CONSTANT
5051 && from_ts
.type
== ts
->type
)
5053 /* Do nothing. Constants of the same type are range-checked
5054 elsewhere. If a value too large for the target type is
5055 assigned, an error is generated. Not checking here avoids
5056 duplications of warnings/errors.
5057 If range checking was disabled, but -Wconversion enabled,
5058 a non range checked warning is generated below. */
5060 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
5062 /* Do nothing. This block exists only to simplify the other
5063 else-if expressions.
5064 LOGICAL <> LOGICAL no warning, independent of kind values
5065 LOGICAL <> INTEGER extension, warned elsewhere
5066 LOGICAL <> REAL invalid, error generated elsewhere
5067 LOGICAL <> COMPLEX invalid, error generated elsewhere */
5069 else if (from_ts
.type
== ts
->type
5070 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
5071 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
5072 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
5074 /* Larger kinds can hold values of smaller kinds without problems.
5075 Hence, only warn if target kind is smaller than the source
5076 kind - or if -Wconversion-extra is specified. */
5077 if (expr
->expr_type
!= EXPR_CONSTANT
)
5079 if (warn_conversion
&& from_ts
.kind
> ts
->kind
)
5080 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5081 "conversion from %s to %s at %L",
5082 gfc_typename (&from_ts
), gfc_typename (ts
),
5084 else if (warn_conversion_extra
)
5085 gfc_warning_now (OPT_Wconversion_extra
, "Conversion from %s to %s "
5086 "at %L", gfc_typename (&from_ts
),
5087 gfc_typename (ts
), &expr
->where
);
5090 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
5091 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
5092 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
5094 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
5095 usually comes with a loss of information, regardless of kinds. */
5096 if (warn_conversion
&& expr
->expr_type
!= EXPR_CONSTANT
)
5097 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5098 "conversion from %s to %s at %L",
5099 gfc_typename (&from_ts
), gfc_typename (ts
),
5102 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
5104 /* If HOLLERITH is involved, all bets are off. */
5105 if (warn_conversion
)
5106 gfc_warning_now (OPT_Wconversion
, "Conversion from %s to %s at %L",
5107 gfc_typename (&from_ts
), gfc_typename (ts
),
5114 /* Insert a pre-resolved function call to the right function. */
5115 old_where
= expr
->where
;
5117 shape
= expr
->shape
;
5119 new_expr
= gfc_get_expr ();
5122 new_expr
= gfc_build_conversion (new_expr
);
5123 new_expr
->value
.function
.name
= sym
->lib_name
;
5124 new_expr
->value
.function
.isym
= sym
;
5125 new_expr
->where
= old_where
;
5127 new_expr
->rank
= rank
;
5128 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5130 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5131 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
5132 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5133 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5134 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5135 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5136 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5137 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
5138 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5139 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5140 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5147 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5148 && !do_simplify (sym
, expr
))
5153 return false; /* Error already generated in do_simplify() */
5161 gfc_error ("Can't convert %s to %s at %L",
5162 gfc_typename (&from_ts
), gfc_typename (ts
), &expr
->where
);
5166 gfc_internal_error ("Can't convert %qs to %qs at %L",
5167 gfc_typename (&from_ts
), gfc_typename (ts
),
5174 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
5176 gfc_intrinsic_sym
*sym
;
5182 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
5184 sym
= find_char_conv (&expr
->ts
, ts
);
5187 /* Insert a pre-resolved function call to the right function. */
5188 old_where
= expr
->where
;
5190 shape
= expr
->shape
;
5192 new_expr
= gfc_get_expr ();
5195 new_expr
= gfc_build_conversion (new_expr
);
5196 new_expr
->value
.function
.name
= sym
->lib_name
;
5197 new_expr
->value
.function
.isym
= sym
;
5198 new_expr
->where
= old_where
;
5200 new_expr
->rank
= rank
;
5201 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5203 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5204 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5205 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5206 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5207 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5208 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5209 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5210 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5211 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5218 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5219 && !do_simplify (sym
, expr
))
5221 /* Error already generated in do_simplify() */
5229 /* Check if the passed name is name of an intrinsic (taking into account the
5230 current -std=* and -fall-intrinsic settings). If it is, see if we should
5231 warn about this as a user-procedure having the same name as an intrinsic
5232 (-Wintrinsic-shadow enabled) and do so if we should. */
5235 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
5237 gfc_intrinsic_sym
* isym
;
5239 /* If the warning is disabled, do nothing at all. */
5240 if (!warn_intrinsic_shadow
)
5243 /* Try to find an intrinsic of the same name. */
5245 isym
= gfc_find_function (sym
->name
);
5247 isym
= gfc_find_subroutine (sym
->name
);
5249 /* If no intrinsic was found with this name or it's not included in the
5250 selected standard, everything's fine. */
5251 if (!isym
|| !gfc_check_intrinsic_standard (isym
, NULL
, true,
5255 /* Emit the warning. */
5256 if (in_module
|| sym
->ns
->proc_name
)
5257 gfc_warning (OPT_Wintrinsic_shadow
,
5258 "%qs declared at %L may shadow the intrinsic of the same"
5259 " name. In order to call the intrinsic, explicit INTRINSIC"
5260 " declarations may be required.",
5261 sym
->name
, &sym
->declared_at
);
5263 gfc_warning (OPT_Wintrinsic_shadow
,
5264 "%qs declared at %L is also the name of an intrinsic. It can"
5265 " only be called via an explicit interface or if declared"
5266 " EXTERNAL.", sym
->name
, &sym
->declared_at
);