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
,
2030 gfc_check_iand_ieor_ior
, gfc_simplify_iand
, gfc_resolve_iand
,
2031 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2033 if (flag_dec_intrinsic_ints
)
2035 make_alias ("biand", GFC_STD_GNU
);
2036 make_alias ("iiand", GFC_STD_GNU
);
2037 make_alias ("jiand", GFC_STD_GNU
);
2038 make_alias ("kiand", GFC_STD_GNU
);
2041 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
2043 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2044 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
2045 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2047 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
2049 add_sym_3red ("iall", GFC_ISYM_IALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2050 gfc_check_transf_bit_intrins
, gfc_simplify_iall
, gfc_resolve_iall
,
2051 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2052 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2054 make_generic ("iall", GFC_ISYM_IALL
, GFC_STD_F2008
);
2056 add_sym_3red ("iany", GFC_ISYM_IANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2057 gfc_check_transf_bit_intrins
, gfc_simplify_iany
, gfc_resolve_iany
,
2058 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2059 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2061 make_generic ("iany", GFC_ISYM_IANY
, GFC_STD_F2008
);
2063 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2064 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2066 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
2068 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2069 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
2070 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2072 if (flag_dec_intrinsic_ints
)
2074 make_alias ("bbclr", GFC_STD_GNU
);
2075 make_alias ("iibclr", GFC_STD_GNU
);
2076 make_alias ("jibclr", GFC_STD_GNU
);
2077 make_alias ("kibclr", GFC_STD_GNU
);
2080 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
2082 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2083 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
2084 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
2085 ln
, BT_INTEGER
, di
, REQUIRED
);
2087 if (flag_dec_intrinsic_ints
)
2089 make_alias ("bbits", GFC_STD_GNU
);
2090 make_alias ("iibits", GFC_STD_GNU
);
2091 make_alias ("jibits", GFC_STD_GNU
);
2092 make_alias ("kibits", GFC_STD_GNU
);
2095 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
2097 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2098 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
2099 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
2101 if (flag_dec_intrinsic_ints
)
2103 make_alias ("bbset", GFC_STD_GNU
);
2104 make_alias ("iibset", GFC_STD_GNU
);
2105 make_alias ("jibset", GFC_STD_GNU
);
2106 make_alias ("kibset", GFC_STD_GNU
);
2109 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
2111 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2112 BT_INTEGER
, di
, GFC_STD_F77
,
2113 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
2114 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2116 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
2118 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2120 gfc_check_iand_ieor_ior
, gfc_simplify_ieor
, gfc_resolve_ieor
,
2121 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2123 if (flag_dec_intrinsic_ints
)
2125 make_alias ("bieor", GFC_STD_GNU
);
2126 make_alias ("iieor", GFC_STD_GNU
);
2127 make_alias ("jieor", GFC_STD_GNU
);
2128 make_alias ("kieor", GFC_STD_GNU
);
2131 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
2133 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2134 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
2135 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2137 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
2139 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2140 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
2142 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
2144 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2145 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
2146 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
2148 add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2149 BT_INTEGER
, di
, GFC_STD_F2018
, gfc_check_image_status
,
2150 gfc_simplify_image_status
, gfc_resolve_image_status
, image
,
2151 BT_INTEGER
, di
, REQUIRED
, team
, BT_VOID
, di
, OPTIONAL
);
2153 /* The resolution function for INDEX is called gfc_resolve_index_func
2154 because the name gfc_resolve_index is already used in resolve.c. */
2155 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
2156 BT_INTEGER
, di
, GFC_STD_F77
,
2157 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
2158 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
2159 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2161 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
2163 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2164 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
2165 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2167 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2168 NULL
, gfc_simplify_ifix
, NULL
,
2169 a
, BT_REAL
, dr
, REQUIRED
);
2171 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2172 NULL
, gfc_simplify_idint
, NULL
,
2173 a
, BT_REAL
, dd
, REQUIRED
);
2175 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
2177 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2178 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
2179 a
, BT_REAL
, dr
, REQUIRED
);
2181 make_alias ("short", GFC_STD_GNU
);
2183 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
2185 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2186 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
2187 a
, BT_REAL
, dr
, REQUIRED
);
2189 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
2191 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2192 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
2193 a
, BT_REAL
, dr
, REQUIRED
);
2195 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
2197 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2199 gfc_check_iand_ieor_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
2200 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2202 if (flag_dec_intrinsic_ints
)
2204 make_alias ("bior", GFC_STD_GNU
);
2205 make_alias ("iior", GFC_STD_GNU
);
2206 make_alias ("jior", GFC_STD_GNU
);
2207 make_alias ("kior", GFC_STD_GNU
);
2210 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
2212 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2213 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
2214 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2216 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
2218 add_sym_3red ("iparity", GFC_ISYM_IPARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2219 gfc_check_transf_bit_intrins
, gfc_simplify_iparity
, gfc_resolve_iparity
,
2220 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2221 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2223 make_generic ("iparity", GFC_ISYM_IPARITY
, GFC_STD_F2008
);
2225 /* The following function is for G77 compatibility. */
2226 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2227 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
2228 i
, BT_INTEGER
, 4, OPTIONAL
);
2230 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
2232 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2233 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
2234 ut
, BT_INTEGER
, di
, REQUIRED
);
2236 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
2238 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
2239 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2240 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
2241 i
, BT_INTEGER
, 0, REQUIRED
);
2243 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
2245 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
2246 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2247 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
2248 i
, BT_INTEGER
, 0, REQUIRED
);
2250 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
2252 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2253 BT_LOGICAL
, dl
, GFC_STD_GNU
,
2254 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
2255 x
, BT_REAL
, 0, REQUIRED
);
2257 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
2259 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2260 BT_INTEGER
, di
, GFC_STD_GNU
,
2261 gfc_check_ishft
, gfc_simplify_rshift
, gfc_resolve_rshift
,
2262 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2264 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
2266 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2267 BT_INTEGER
, di
, GFC_STD_GNU
,
2268 gfc_check_ishft
, gfc_simplify_lshift
, gfc_resolve_lshift
,
2269 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2271 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
2273 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2274 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
2275 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2277 if (flag_dec_intrinsic_ints
)
2279 make_alias ("bshft", GFC_STD_GNU
);
2280 make_alias ("iishft", GFC_STD_GNU
);
2281 make_alias ("jishft", GFC_STD_GNU
);
2282 make_alias ("kishft", GFC_STD_GNU
);
2285 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
2287 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2288 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
2289 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
2290 sz
, BT_INTEGER
, di
, OPTIONAL
);
2292 if (flag_dec_intrinsic_ints
)
2294 make_alias ("bshftc", GFC_STD_GNU
);
2295 make_alias ("iishftc", GFC_STD_GNU
);
2296 make_alias ("jishftc", GFC_STD_GNU
);
2297 make_alias ("kishftc", GFC_STD_GNU
);
2300 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
2302 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2303 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, NULL
,
2304 pid
, BT_INTEGER
, di
, REQUIRED
, sig
, BT_INTEGER
, di
, REQUIRED
);
2306 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
2308 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2309 gfc_check_kind
, gfc_simplify_kind
, NULL
,
2310 x
, BT_REAL
, dr
, REQUIRED
);
2312 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
2314 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2315 BT_INTEGER
, di
, GFC_STD_F95
,
2316 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
2317 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
2318 kind
, BT_INTEGER
, di
, OPTIONAL
);
2320 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
2322 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2323 BT_INTEGER
, di
, GFC_STD_F2008
,
2324 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
2325 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2326 kind
, BT_INTEGER
, di
, OPTIONAL
);
2328 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
2330 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2331 BT_INTEGER
, di
, GFC_STD_F2008
,
2332 gfc_check_i
, gfc_simplify_leadz
, NULL
,
2333 i
, BT_INTEGER
, di
, REQUIRED
);
2335 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
2337 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
2338 BT_INTEGER
, di
, GFC_STD_F77
,
2339 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
2340 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2342 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
2344 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2345 BT_INTEGER
, di
, GFC_STD_F95
,
2346 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
2347 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2349 make_alias ("lnblnk", GFC_STD_GNU
);
2351 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
2353 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2355 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2356 x
, BT_REAL
, dr
, REQUIRED
);
2358 make_alias ("log_gamma", GFC_STD_F2008
);
2360 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2361 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2362 x
, BT_REAL
, dr
, REQUIRED
);
2364 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2365 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2366 x
, BT_REAL
, dr
, REQUIRED
);
2368 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2371 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2372 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2373 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2375 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2377 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2378 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2379 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2381 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2383 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2384 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2385 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2387 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2389 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2390 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2391 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2393 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2395 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2396 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2397 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2399 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2401 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2402 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2403 x
, BT_REAL
, dr
, REQUIRED
);
2405 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2406 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2407 x
, BT_REAL
, dr
, REQUIRED
);
2409 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2410 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2411 x
, BT_REAL
, dd
, REQUIRED
);
2413 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2414 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2415 x
, BT_COMPLEX
, dz
, REQUIRED
);
2417 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2418 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2419 x
, BT_COMPLEX
, dd
, REQUIRED
);
2421 make_alias ("cdlog", GFC_STD_GNU
);
2423 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2425 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2426 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2427 x
, BT_REAL
, dr
, REQUIRED
);
2429 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2430 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2431 x
, BT_REAL
, dr
, REQUIRED
);
2433 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2434 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2435 x
, BT_REAL
, dd
, REQUIRED
);
2437 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2439 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2440 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2441 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2443 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2445 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
2446 BT_INTEGER
, di
, GFC_STD_GNU
,
2447 gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2448 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2449 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2451 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2453 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2454 GFC_STD_GNU
, gfc_check_malloc
, NULL
, NULL
,
2455 sz
, BT_INTEGER
, di
, REQUIRED
);
2457 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2459 add_sym_2 ("maskl", GFC_ISYM_MASKL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2460 BT_INTEGER
, di
, GFC_STD_F2008
,
2461 gfc_check_mask
, gfc_simplify_maskl
, gfc_resolve_mask
,
2462 i
, BT_INTEGER
, di
, REQUIRED
,
2463 kind
, BT_INTEGER
, di
, OPTIONAL
);
2465 make_generic ("maskl", GFC_ISYM_MASKL
, GFC_STD_F2008
);
2467 add_sym_2 ("maskr", GFC_ISYM_MASKR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2468 BT_INTEGER
, di
, GFC_STD_F2008
,
2469 gfc_check_mask
, gfc_simplify_maskr
, gfc_resolve_mask
,
2470 i
, BT_INTEGER
, di
, REQUIRED
,
2471 kind
, BT_INTEGER
, di
, OPTIONAL
);
2473 make_generic ("maskr", GFC_ISYM_MASKR
, GFC_STD_F2008
);
2475 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2476 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2477 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2479 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2481 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2482 int(max). The max function must take at least two arguments. */
2484 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2485 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2486 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2488 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2489 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2490 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2492 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2493 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2494 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2496 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2497 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2498 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2500 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2501 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2502 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2504 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2505 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2506 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2508 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2510 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2511 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_maxexponent
, NULL
,
2512 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2514 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2516 add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2517 gfc_check_minloc_maxloc
, gfc_simplify_maxloc
, gfc_resolve_maxloc
,
2518 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2519 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2520 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2522 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2524 add_sym_6fl ("findloc", GFC_ISYM_FINDLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
2525 BT_INTEGER
, di
, GFC_STD_F2008
,
2526 gfc_check_findloc
, gfc_simplify_findloc
, gfc_resolve_findloc
,
2527 ar
, BT_REAL
, dr
, REQUIRED
, val
, BT_REAL
, dr
, REQUIRED
,
2528 dm
, BT_INTEGER
, ii
, OPTIONAL
, msk
, BT_LOGICAL
, dl
, OPTIONAL
,
2529 kind
, BT_INTEGER
, di
, OPTIONAL
, bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2531 make_generic ("findloc", GFC_ISYM_FINDLOC
, GFC_STD_F2008
);
2533 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2534 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2535 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2536 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2538 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2540 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2541 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2543 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2545 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2546 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2548 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2550 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2551 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2552 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2553 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2555 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2557 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2558 BT_INTEGER
, di
, GFC_STD_F2008
,
2559 gfc_check_merge_bits
, gfc_simplify_merge_bits
,
2560 gfc_resolve_merge_bits
,
2561 i
, BT_INTEGER
, di
, REQUIRED
,
2562 j
, BT_INTEGER
, di
, REQUIRED
,
2563 msk
, BT_INTEGER
, di
, REQUIRED
);
2565 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS
, GFC_STD_F2008
);
2567 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2570 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2571 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2572 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2574 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2575 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2576 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2578 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2579 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2580 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2582 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2583 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2584 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2586 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2587 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2588 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2590 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2591 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2592 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2594 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2596 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
,
2597 di
, GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_minexponent
, NULL
,
2598 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2600 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2602 add_sym_5ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2603 gfc_check_minloc_maxloc
, gfc_simplify_minloc
, gfc_resolve_minloc
,
2604 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2605 msk
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
,
2606 bck
, BT_LOGICAL
, dl
, OPTIONAL
);
2608 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2610 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2611 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2612 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2613 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2615 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2617 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2618 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2619 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2621 if (flag_dec_intrinsic_ints
)
2623 make_alias ("bmod", GFC_STD_GNU
);
2624 make_alias ("imod", GFC_STD_GNU
);
2625 make_alias ("jmod", GFC_STD_GNU
);
2626 make_alias ("kmod", GFC_STD_GNU
);
2629 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2630 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2631 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2633 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2634 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2635 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2637 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2639 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2640 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2641 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2643 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2645 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2646 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2647 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2649 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2651 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2652 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2653 a
, BT_CHARACTER
, dc
, REQUIRED
);
2655 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2657 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2658 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2659 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2661 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2662 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2663 a
, BT_REAL
, dd
, REQUIRED
);
2665 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2667 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2668 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2669 i
, BT_INTEGER
, di
, REQUIRED
);
2671 if (flag_dec_intrinsic_ints
)
2673 make_alias ("bnot", GFC_STD_GNU
);
2674 make_alias ("inot", GFC_STD_GNU
);
2675 make_alias ("jnot", GFC_STD_GNU
);
2676 make_alias ("knot", GFC_STD_GNU
);
2679 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2681 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2682 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2683 x
, BT_REAL
, dr
, REQUIRED
,
2684 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2686 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2688 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2689 gfc_check_null
, gfc_simplify_null
, NULL
,
2690 mo
, BT_INTEGER
, di
, OPTIONAL
);
2692 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2694 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES
, CLASS_INQUIRY
, ACTUAL_NO
,
2695 BT_INTEGER
, di
, GFC_STD_F2008
,
2696 gfc_check_num_images
, gfc_simplify_num_images
, NULL
,
2697 dist
, BT_INTEGER
, di
, OPTIONAL
,
2698 failed
, BT_LOGICAL
, dl
, OPTIONAL
);
2700 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2701 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2702 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2703 v
, BT_REAL
, dr
, OPTIONAL
);
2705 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2708 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2709 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2710 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2711 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2713 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2715 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2716 BT_INTEGER
, di
, GFC_STD_F2008
,
2717 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2718 i
, BT_INTEGER
, di
, REQUIRED
);
2720 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2722 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2723 BT_INTEGER
, di
, GFC_STD_F2008
,
2724 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2725 i
, BT_INTEGER
, di
, REQUIRED
);
2727 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2729 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2730 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2731 x
, BT_UNKNOWN
, 0, REQUIRED
);
2733 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2735 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2736 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2737 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2739 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2741 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2742 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2743 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2744 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2746 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2748 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2749 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2750 x
, BT_UNKNOWN
, 0, REQUIRED
);
2752 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2754 /* The following function is for G77 compatibility. */
2755 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2756 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2757 i
, BT_INTEGER
, 4, OPTIONAL
);
2759 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2760 use slightly different shoddy multiplicative congruential PRNG. */
2761 make_alias ("ran", GFC_STD_GNU
);
2763 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2765 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2766 gfc_check_range
, gfc_simplify_range
, NULL
,
2767 x
, BT_REAL
, dr
, REQUIRED
);
2769 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2771 add_sym_1 ("rank", GFC_ISYM_RANK
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2772 GFC_STD_F2018
, gfc_check_rank
, gfc_simplify_rank
, gfc_resolve_rank
,
2773 a
, BT_REAL
, dr
, REQUIRED
);
2774 make_generic ("rank", GFC_ISYM_RANK
, GFC_STD_F2018
);
2776 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2777 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2778 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2780 /* This provides compatibility with g77. */
2781 add_sym_1 ("realpart", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2782 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2783 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2785 add_sym_1 ("float", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2786 gfc_check_float
, gfc_simplify_float
, NULL
,
2787 a
, BT_INTEGER
, di
, REQUIRED
);
2789 if (flag_dec_intrinsic_ints
)
2791 make_alias ("floati", GFC_STD_GNU
);
2792 make_alias ("floatj", GFC_STD_GNU
);
2793 make_alias ("floatk", GFC_STD_GNU
);
2796 add_sym_1 ("dfloat", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2797 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2798 a
, BT_REAL
, dr
, REQUIRED
);
2800 add_sym_1 ("sngl", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2801 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2802 a
, BT_REAL
, dd
, REQUIRED
);
2804 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2806 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2807 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2808 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2810 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2812 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2813 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2814 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2816 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2818 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2819 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2820 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2821 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2823 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2825 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
2826 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2827 x
, BT_REAL
, dr
, REQUIRED
);
2829 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2831 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2832 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2833 gfc_check_same_type_as
, gfc_simplify_same_type_as
, NULL
,
2834 a
, BT_UNKNOWN
, 0, REQUIRED
,
2835 b
, BT_UNKNOWN
, 0, REQUIRED
);
2837 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2838 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2839 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2841 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2843 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2844 BT_INTEGER
, di
, GFC_STD_F95
,
2845 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2846 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2847 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2849 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2851 /* Added for G77 compatibility garbage. */
2852 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2853 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2855 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2857 /* Added for G77 compatibility. */
2858 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2859 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2860 x
, BT_REAL
, dr
, REQUIRED
);
2862 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2864 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2865 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2866 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2867 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2869 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2871 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2872 GFC_STD_F95
, gfc_check_selected_int_kind
,
2873 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2875 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2877 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2878 GFC_STD_F95
, gfc_check_selected_real_kind
,
2879 gfc_simplify_selected_real_kind
, NULL
,
2880 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2881 "radix", BT_INTEGER
, di
, OPTIONAL
);
2883 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2885 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2886 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2887 gfc_resolve_set_exponent
,
2888 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2890 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2892 add_sym_2 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2893 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2894 src
, BT_REAL
, dr
, REQUIRED
,
2895 kind
, BT_INTEGER
, di
, OPTIONAL
);
2897 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2899 add_sym_2 ("shifta", GFC_ISYM_SHIFTA
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2900 BT_INTEGER
, di
, GFC_STD_F2008
,
2901 gfc_check_shift
, gfc_simplify_shifta
, gfc_resolve_shift
,
2902 i
, BT_INTEGER
, di
, REQUIRED
,
2903 sh
, BT_INTEGER
, di
, REQUIRED
);
2905 make_generic ("shifta", GFC_ISYM_SHIFTA
, GFC_STD_F2008
);
2907 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2908 BT_INTEGER
, di
, GFC_STD_F2008
,
2909 gfc_check_shift
, gfc_simplify_shiftl
, gfc_resolve_shift
,
2910 i
, BT_INTEGER
, di
, REQUIRED
,
2911 sh
, BT_INTEGER
, di
, REQUIRED
);
2913 make_generic ("shiftl", GFC_ISYM_SHIFTL
, GFC_STD_F2008
);
2915 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2916 BT_INTEGER
, di
, GFC_STD_F2008
,
2917 gfc_check_shift
, gfc_simplify_shiftr
, gfc_resolve_shift
,
2918 i
, BT_INTEGER
, di
, REQUIRED
,
2919 sh
, BT_INTEGER
, di
, REQUIRED
);
2921 make_generic ("shiftr", GFC_ISYM_SHIFTR
, GFC_STD_F2008
);
2923 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2924 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
2925 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
2927 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2928 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
2929 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2931 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2932 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
2933 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
2935 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
2937 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2938 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
2939 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_VOID
, 0, REQUIRED
);
2941 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
2943 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2944 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
2945 x
, BT_REAL
, dr
, REQUIRED
);
2947 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2948 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
2949 x
, BT_REAL
, dd
, REQUIRED
);
2951 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2952 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2953 x
, BT_COMPLEX
, dz
, REQUIRED
);
2955 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2956 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2957 x
, BT_COMPLEX
, dd
, REQUIRED
);
2959 make_alias ("cdsin", GFC_STD_GNU
);
2961 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
2963 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2964 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2965 x
, BT_REAL
, dr
, REQUIRED
);
2967 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2968 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2969 x
, BT_REAL
, dd
, REQUIRED
);
2971 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
2973 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2974 BT_INTEGER
, di
, GFC_STD_F95
,
2975 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
2976 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2977 kind
, BT_INTEGER
, di
, OPTIONAL
);
2979 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
2981 /* Obtain the stride for a given dimensions; to be used only internally.
2982 "make_from_module" makes it inaccessible for external users. */
2983 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE
, CLASS_INQUIRY
, ACTUAL_NO
,
2984 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_GNU
,
2985 NULL
, NULL
, gfc_resolve_stride
,
2986 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
2989 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2990 BT_INTEGER
, ii
, GFC_STD_GNU
,
2991 gfc_check_sizeof
, gfc_simplify_sizeof
, NULL
,
2992 x
, BT_UNKNOWN
, 0, REQUIRED
);
2994 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
2996 /* The following functions are part of ISO_C_BINDING. */
2997 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
,
2998 BT_LOGICAL
, dl
, GFC_STD_F2003
, gfc_check_c_associated
, NULL
, NULL
,
2999 c_ptr_1
, BT_VOID
, 0, REQUIRED
,
3000 c_ptr_2
, BT_VOID
, 0, OPTIONAL
);
3003 add_sym_1 ("c_loc", GFC_ISYM_C_LOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3004 BT_VOID
, 0, GFC_STD_F2003
,
3005 gfc_check_c_loc
, NULL
, gfc_resolve_c_loc
,
3006 x
, BT_UNKNOWN
, 0, REQUIRED
);
3009 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC
, CLASS_INQUIRY
, ACTUAL_NO
,
3010 BT_VOID
, 0, GFC_STD_F2003
,
3011 gfc_check_c_funloc
, NULL
, gfc_resolve_c_funloc
,
3012 x
, BT_UNKNOWN
, 0, REQUIRED
);
3015 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
3016 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_F2008
,
3017 gfc_check_c_sizeof
, gfc_simplify_sizeof
, NULL
,
3018 x
, BT_UNKNOWN
, 0, REQUIRED
);
3021 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
3022 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS
, CLASS_INQUIRY
,
3023 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3024 NULL
, gfc_simplify_compiler_options
, NULL
);
3027 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION
, CLASS_INQUIRY
,
3028 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
3029 NULL
, gfc_simplify_compiler_version
, NULL
);
3032 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
3033 GFC_STD_F95
, gfc_check_fn_r
, gfc_simplify_spacing
, gfc_resolve_spacing
,
3034 x
, BT_REAL
, dr
, REQUIRED
);
3036 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
3038 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3039 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
3040 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
3041 ncopies
, BT_INTEGER
, di
, REQUIRED
);
3043 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
3045 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3046 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3047 x
, BT_REAL
, dr
, REQUIRED
);
3049 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3050 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3051 x
, BT_REAL
, dd
, REQUIRED
);
3053 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
3054 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3055 x
, BT_COMPLEX
, dz
, REQUIRED
);
3057 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
3058 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
3059 x
, BT_COMPLEX
, dd
, REQUIRED
);
3061 make_alias ("cdsqrt", GFC_STD_GNU
);
3063 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
3065 add_sym_2_intent ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
,
3066 BT_INTEGER
, di
, GFC_STD_GNU
,
3067 gfc_check_stat
, NULL
, gfc_resolve_stat
,
3068 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3069 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3071 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
3073 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES
, CLASS_TRANSFORMATIONAL
,
3074 ACTUAL_NO
, BT_INTEGER
, dd
, GFC_STD_F2018
,
3075 gfc_check_failed_or_stopped_images
,
3076 gfc_simplify_failed_or_stopped_images
,
3077 gfc_resolve_stopped_images
, team
, BT_VOID
, di
, OPTIONAL
,
3078 kind
, BT_INTEGER
, di
, OPTIONAL
);
3080 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
3081 BT_INTEGER
, di
, GFC_STD_F2008
,
3082 gfc_check_storage_size
, gfc_simplify_storage_size
,
3083 gfc_resolve_storage_size
,
3084 a
, BT_UNKNOWN
, 0, REQUIRED
,
3085 kind
, BT_INTEGER
, di
, OPTIONAL
);
3087 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3088 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
3089 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3090 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
3092 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
3094 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3095 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
3096 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
3098 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
3100 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3101 GFC_STD_GNU
, NULL
, NULL
, NULL
,
3102 com
, BT_CHARACTER
, dc
, REQUIRED
);
3104 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
3106 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3107 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
3108 x
, BT_REAL
, dr
, REQUIRED
);
3110 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3111 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
3112 x
, BT_REAL
, dd
, REQUIRED
);
3114 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
3116 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
3117 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3118 x
, BT_REAL
, dr
, REQUIRED
);
3120 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
3121 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
3122 x
, BT_REAL
, dd
, REQUIRED
);
3124 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
3126 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER
, CLASS_TRANSFORMATIONAL
,
3127 ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F2018
,
3128 gfc_check_team_number
, NULL
, gfc_resolve_team_number
,
3129 team
, BT_DERIVED
, di
, OPTIONAL
);
3131 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
3132 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
3133 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3134 dist
, BT_INTEGER
, di
, OPTIONAL
);
3136 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3137 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
3139 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
3141 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3142 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
3144 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
3146 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3147 gfc_check_fn_r
, gfc_simplify_tiny
, NULL
, x
, BT_REAL
, dr
, REQUIRED
);
3149 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
3151 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3152 BT_INTEGER
, di
, GFC_STD_F2008
,
3153 gfc_check_i
, gfc_simplify_trailz
, NULL
,
3154 i
, BT_INTEGER
, di
, REQUIRED
);
3156 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
3158 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3159 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
3160 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
3161 sz
, BT_INTEGER
, di
, OPTIONAL
);
3163 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
3165 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3166 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
3167 m
, BT_REAL
, dr
, REQUIRED
);
3169 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
3171 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
3172 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
3173 stg
, BT_CHARACTER
, dc
, REQUIRED
);
3175 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
3177 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
3178 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
3179 ut
, BT_INTEGER
, di
, REQUIRED
);
3181 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
3183 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3184 BT_INTEGER
, di
, GFC_STD_F95
,
3185 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
3186 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3187 kind
, BT_INTEGER
, di
, OPTIONAL
);
3189 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
3191 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
3192 BT_INTEGER
, di
, GFC_STD_F2008
,
3193 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
3194 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
3195 kind
, BT_INTEGER
, di
, OPTIONAL
);
3197 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
3199 /* g77 compatibility for UMASK. */
3200 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3201 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
3202 msk
, BT_INTEGER
, di
, REQUIRED
);
3204 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
3206 /* g77 compatibility for UNLINK. */
3207 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3208 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
3209 "path", BT_CHARACTER
, dc
, REQUIRED
);
3211 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
3213 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3214 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
3215 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
3216 f
, BT_REAL
, dr
, REQUIRED
);
3218 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
3220 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3221 BT_INTEGER
, di
, GFC_STD_F95
,
3222 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
3223 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
3224 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
3226 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
3228 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
3229 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
3230 x
, BT_UNKNOWN
, 0, REQUIRED
);
3232 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
3236 add_sym_1 ("acosd", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3238 gfc_check_fn_r
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3239 x
, BT_REAL
, dr
, REQUIRED
);
3241 add_sym_1 ("dacosd", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3243 gfc_check_fn_d
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3244 x
, BT_REAL
, dd
, REQUIRED
);
3246 make_generic ("acosd", GFC_ISYM_ACOS
, GFC_STD_GNU
);
3248 add_sym_1 ("asind", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3250 gfc_check_fn_r
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3251 x
, BT_REAL
, dr
, REQUIRED
);
3253 add_sym_1 ("dasind", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3255 gfc_check_fn_d
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3256 x
, BT_REAL
, dd
, REQUIRED
);
3258 make_generic ("asind", GFC_ISYM_ASIN
, GFC_STD_GNU
);
3260 add_sym_1 ("atand", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3262 gfc_check_fn_r
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3263 x
, BT_REAL
, dr
, REQUIRED
);
3265 add_sym_1 ("datand", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3267 gfc_check_fn_d
, gfc_simplify_atrigd
, gfc_resolve_atrigd
,
3268 x
, BT_REAL
, dd
, REQUIRED
);
3270 make_generic ("atand", GFC_ISYM_ATAN
, GFC_STD_GNU
);
3272 add_sym_2 ("atan2d",GFC_ISYM_ATAN2
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3274 gfc_check_atan2
, gfc_simplify_atan2d
, gfc_resolve_atan2d
,
3275 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
3277 add_sym_2 ("datan2d",GFC_ISYM_ATAN2
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3279 gfc_check_datan2
, gfc_simplify_atan2d
, gfc_resolve_atan2d
,
3280 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
3282 make_generic ("atan2d", GFC_ISYM_ATAN2
, GFC_STD_GNU
);
3284 add_sym_1 ("cosd", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3286 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3287 x
, BT_REAL
, dr
, REQUIRED
);
3289 add_sym_1 ("dcosd", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3291 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3292 x
, BT_REAL
, dd
, REQUIRED
);
3294 make_generic ("cosd", GFC_ISYM_COS
, GFC_STD_GNU
);
3296 add_sym_1 ("cotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3298 gfc_check_fn_rc2008
, gfc_simplify_cotan
, gfc_resolve_cotan
,
3299 x
, BT_REAL
, dr
, REQUIRED
);
3301 add_sym_1 ("dcotan", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3303 gfc_check_fn_d
, gfc_simplify_cotan
, gfc_resolve_cotan
,
3304 x
, BT_REAL
, dd
, REQUIRED
);
3306 make_generic ("cotan", GFC_ISYM_COTAN
, GFC_STD_GNU
);
3308 add_sym_1 ("cotand", GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3310 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3311 x
, BT_REAL
, dr
, REQUIRED
);
3313 add_sym_1 ("dcotand",GFC_ISYM_COTAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3315 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3316 x
, BT_REAL
, dd
, REQUIRED
);
3318 make_generic ("cotand", GFC_ISYM_COTAN
, GFC_STD_GNU
);
3320 add_sym_1 ("sind", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3322 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3323 x
, BT_REAL
, dr
, REQUIRED
);
3325 add_sym_1 ("dsind", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3327 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3328 x
, BT_REAL
, dd
, REQUIRED
);
3330 make_generic ("sind", GFC_ISYM_SIN
, GFC_STD_GNU
);
3332 add_sym_1 ("tand", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3334 gfc_check_fn_r
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3335 x
, BT_REAL
, dr
, REQUIRED
);
3337 add_sym_1 ("dtand", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
,
3339 gfc_check_fn_d
, gfc_simplify_trigd
, gfc_resolve_trigd
,
3340 x
, BT_REAL
, dd
, REQUIRED
);
3342 make_generic ("tand", GFC_ISYM_TAN
, GFC_STD_GNU
);
3345 /* The following function is internally used for coarray libray functions.
3346 "make_from_module" makes it inaccessible for external users. */
3347 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET
, CLASS_IMPURE
, ACTUAL_NO
,
3348 BT_REAL
, dr
, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3349 x
, BT_REAL
, dr
, REQUIRED
);
3354 /* Add intrinsic subroutines. */
3357 add_subroutines (void)
3359 /* Argument names. These are used as argument keywords and so need to
3360 match the documentation. Please keep this list in sorted order. */
3362 *a
= "a", *c
= "count", *cm
= "count_max", *com
= "command",
3363 *cr
= "count_rate", *dt
= "date", *errmsg
= "errmsg", *f
= "from",
3364 *fp
= "frompos", *gt
= "get", *h
= "harvest", *han
= "handler",
3365 *length
= "length", *ln
= "len", *md
= "mode", *msk
= "mask",
3366 *name
= "name", *num
= "number", *of
= "offset", *old
= "old",
3367 *p1
= "path1", *p2
= "path2", *pid
= "pid", *pos
= "pos",
3368 *pt
= "put", *ptr
= "ptr", *res
= "result",
3369 *result_image
= "result_image", *sec
= "seconds", *sig
= "sig",
3370 *st
= "status", *stat
= "stat", *sz
= "size", *t
= "to",
3371 *tm
= "time", *tp
= "topos", *trim_name
= "trim_name", *ut
= "unit",
3372 *val
= "value", *vl
= "values", *whence
= "whence", *zn
= "zone";
3374 int di
, dr
, dc
, dl
, ii
;
3376 di
= gfc_default_integer_kind
;
3377 dr
= gfc_default_real_kind
;
3378 dc
= gfc_default_character_kind
;
3379 dl
= gfc_default_logical_kind
;
3380 ii
= gfc_index_integer_kind
;
3382 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
3386 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF
, CLASS_ATOMIC
,
3387 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3388 gfc_check_atomic_def
, NULL
, gfc_resolve_atomic_def
,
3389 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3390 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3391 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3393 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF
, CLASS_ATOMIC
,
3394 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3395 gfc_check_atomic_ref
, NULL
, gfc_resolve_atomic_ref
,
3396 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3397 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3398 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3400 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS
, CLASS_ATOMIC
,
3401 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3402 gfc_check_atomic_cas
, NULL
, NULL
,
3403 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3404 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3405 "compare", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3406 "new", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3407 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3409 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD
, CLASS_ATOMIC
,
3410 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3411 gfc_check_atomic_op
, NULL
, NULL
,
3412 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3413 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3414 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3416 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND
, CLASS_ATOMIC
,
3417 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3418 gfc_check_atomic_op
, NULL
, NULL
,
3419 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3420 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3421 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3423 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR
, CLASS_ATOMIC
,
3424 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3425 gfc_check_atomic_op
, NULL
, NULL
,
3426 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3427 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3428 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3430 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR
, CLASS_ATOMIC
,
3431 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3432 gfc_check_atomic_op
, NULL
, NULL
,
3433 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3434 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3435 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3437 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD
, CLASS_ATOMIC
,
3438 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3439 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3440 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3441 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3442 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3443 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3445 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND
, CLASS_ATOMIC
,
3446 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3447 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3448 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3449 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3450 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3451 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3453 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR
, CLASS_ATOMIC
,
3454 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3455 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3456 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3457 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3458 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3459 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3461 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR
, CLASS_ATOMIC
,
3462 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3463 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3464 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3465 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3466 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3467 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3469 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE
, GFC_STD_GNU
, NULL
);
3471 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3472 GFC_STD_F95
, gfc_check_cpu_time
, NULL
, gfc_resolve_cpu_time
,
3473 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3475 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY
, CLASS_ATOMIC
,
3476 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3477 gfc_check_event_query
, NULL
, gfc_resolve_event_query
,
3478 "event", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3479 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3480 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3482 /* More G77 compatibility garbage. */
3483 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3484 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
3485 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3486 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3488 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3489 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
3490 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3492 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3493 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
3494 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3496 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3497 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
3498 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3499 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3501 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3502 GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
3503 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3504 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3506 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3507 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
3508 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3510 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3511 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
3512 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3513 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3515 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3516 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
3517 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3518 md
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3519 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3521 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
3522 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
3523 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3524 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3525 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3526 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3528 /* More G77 compatibility garbage. */
3529 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3530 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
3531 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3532 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3534 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3535 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
3536 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3537 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3539 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
3540 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
3541 NULL
, NULL
, gfc_resolve_execute_command_line
,
3542 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3543 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
3544 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
3545 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3546 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3548 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3549 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
3550 dt
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3552 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3553 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
3554 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3556 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3557 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
3558 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3559 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3561 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
3562 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3563 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3564 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3566 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
3567 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
3568 pos
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3569 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3571 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
3572 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
3573 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3575 /* F2003 commandline routines. */
3577 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
3578 BT_UNKNOWN
, 0, GFC_STD_F2003
,
3579 NULL
, NULL
, gfc_resolve_get_command
,
3580 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3581 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3582 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3584 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
3585 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
3586 gfc_resolve_get_command_argument
,
3587 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3588 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3589 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3590 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3592 /* F2003 subroutine to get environment variables. */
3594 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
3595 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
3596 NULL
, NULL
, gfc_resolve_get_environment_variable
,
3597 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3598 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3599 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3600 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3601 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
3603 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
, BT_UNKNOWN
, 0,
3605 gfc_check_move_alloc
, NULL
, NULL
,
3606 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
3607 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3609 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
3610 GFC_STD_F95
, gfc_check_mvbits
, NULL
, gfc_resolve_mvbits
,
3611 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3612 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3613 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3614 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3615 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3617 if (flag_dec_intrinsic_ints
)
3619 make_alias ("bmvbits", GFC_STD_GNU
);
3620 make_alias ("imvbits", GFC_STD_GNU
);
3621 make_alias ("jmvbits", GFC_STD_GNU
);
3622 make_alias ("kmvbits", GFC_STD_GNU
);
3625 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT
, CLASS_IMPURE
,
3626 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3627 gfc_check_random_init
, NULL
, gfc_resolve_random_init
,
3628 "repeatable", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
,
3629 "image_distinct", BT_LOGICAL
, dl
, REQUIRED
, INTENT_IN
);
3631 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
3632 BT_UNKNOWN
, 0, GFC_STD_F95
,
3633 gfc_check_random_number
, NULL
, gfc_resolve_random_number
,
3634 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3636 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
3637 BT_UNKNOWN
, 0, GFC_STD_F95
,
3638 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
3639 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3640 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3641 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3643 /* The following subroutines are part of ISO_C_BINDING. */
3645 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3646 GFC_STD_F2003
, gfc_check_c_f_pointer
, NULL
, NULL
,
3647 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3648 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
,
3649 "shape", BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3652 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER
, CLASS_IMPURE
,
3653 BT_UNKNOWN
, 0, GFC_STD_F2003
, gfc_check_c_f_procpointer
,
3655 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3656 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3659 /* Internal subroutine for emitting a runtime error. */
3661 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR
, CLASS_IMPURE
,
3662 BT_UNKNOWN
, 0, GFC_STD_GNU
,
3663 gfc_check_fe_runtime_error
, NULL
, gfc_resolve_fe_runtime_error
,
3664 "msg", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3668 make_from_module ();
3670 /* Coarray collectives. */
3671 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST
, CLASS_IMPURE
,
3672 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3673 gfc_check_co_broadcast
, NULL
, NULL
,
3674 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3675 "source_image", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3676 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3677 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3679 add_sym_4s ("co_max", GFC_ISYM_CO_MAX
, CLASS_IMPURE
,
3680 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3681 gfc_check_co_minmax
, NULL
, NULL
,
3682 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3683 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3684 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3685 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3687 add_sym_4s ("co_min", GFC_ISYM_CO_MIN
, CLASS_IMPURE
,
3688 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3689 gfc_check_co_minmax
, NULL
, NULL
,
3690 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3691 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3692 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3693 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3695 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM
, CLASS_IMPURE
,
3696 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3697 gfc_check_co_sum
, NULL
, NULL
,
3698 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3699 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3700 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3701 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3703 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE
, CLASS_IMPURE
,
3704 BT_UNKNOWN
, 0, GFC_STD_F2018
,
3705 gfc_check_co_reduce
, NULL
, NULL
,
3706 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3707 "operator", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3708 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3709 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3710 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3713 /* The following subroutine is internally used for coarray libray functions.
3714 "make_from_module" makes it inaccessible for external users. */
3715 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND
, CLASS_IMPURE
,
3716 BT_UNKNOWN
, 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3717 "x", BT_REAL
, dr
, REQUIRED
, INTENT_OUT
,
3718 "y", BT_REAL
, dr
, REQUIRED
, INTENT_IN
);
3722 /* More G77 compatibility garbage. */
3723 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3724 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
3725 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3726 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3727 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3729 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
3730 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
3731 "seed", BT_INTEGER
, 4, REQUIRED
, INTENT_IN
);
3733 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3734 gfc_check_exit
, NULL
, gfc_resolve_exit
,
3735 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3739 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3740 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
3741 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3742 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3743 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3745 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3746 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
3747 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3748 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3750 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3751 gfc_check_flush
, NULL
, gfc_resolve_flush
,
3752 ut
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3754 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3755 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
3756 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3757 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3758 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3760 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3761 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
3762 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3763 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3765 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3766 gfc_check_free
, NULL
, NULL
,
3767 ptr
, BT_INTEGER
, ii
, REQUIRED
, INTENT_INOUT
);
3769 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3770 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
3771 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3772 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3773 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3774 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3776 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3777 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
3778 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3779 of
, BT_INTEGER
, ii
, REQUIRED
, INTENT_OUT
);
3781 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3782 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
3783 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3784 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3786 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3787 gfc_check_kill_sub
, NULL
, NULL
,
3788 pid
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3789 sig
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3790 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3792 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3793 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
3794 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3795 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3796 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3798 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3799 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
3800 "string", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3802 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3803 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
3804 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3805 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3806 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3808 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3809 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
3810 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3812 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3813 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
3814 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3815 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3816 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3818 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3819 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
3820 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3821 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3822 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3824 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3825 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
3826 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3827 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3828 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3830 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3831 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3832 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3833 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3834 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3836 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3837 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3838 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3839 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3840 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3842 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3843 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3844 com
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3845 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3847 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3848 BT_UNKNOWN
, 0, GFC_STD_F95
,
3849 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3850 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3851 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3852 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3854 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3855 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3856 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3857 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3859 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3860 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3861 msk
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3862 old
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3864 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3865 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3866 "path", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3867 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3871 /* Add a function to the list of conversion symbols. */
3874 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3876 gfc_typespec from
, to
;
3877 gfc_intrinsic_sym
*sym
;
3879 if (sizing
== SZ_CONVS
)
3885 gfc_clear_ts (&from
);
3886 from
.type
= from_type
;
3887 from
.kind
= from_kind
;
3893 sym
= conversion
+ nconv
;
3895 sym
->name
= conv_name (&from
, &to
);
3896 sym
->lib_name
= sym
->name
;
3897 sym
->simplify
.cc
= gfc_convert_constant
;
3898 sym
->standard
= standard
;
3901 sym
->conversion
= 1;
3903 sym
->id
= GFC_ISYM_CONVERSION
;
3909 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3910 functions by looping over the kind tables. */
3913 add_conversions (void)
3917 /* Integer-Integer conversions. */
3918 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3919 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
3924 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3925 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
3928 /* Integer-Real/Complex conversions. */
3929 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3930 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3932 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3933 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3935 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
3936 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3938 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3939 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3941 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
3942 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3945 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3947 /* Hollerith-Integer conversions. */
3948 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3949 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3950 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3951 /* Hollerith-Real conversions. */
3952 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3953 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3954 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3955 /* Hollerith-Complex conversions. */
3956 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3957 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3958 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3960 /* Hollerith-Character conversions. */
3961 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
3962 gfc_default_character_kind
, GFC_STD_LEGACY
);
3964 /* Hollerith-Logical conversions. */
3965 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
3966 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3967 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
3970 /* Real/Complex - Real/Complex conversions. */
3971 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3972 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3976 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3977 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3979 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3980 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3983 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3984 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3986 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3987 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3990 /* Logical/Logical kind conversion. */
3991 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
3992 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
3997 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
3998 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
4001 /* Integer-Logical and Logical-Integer conversions. */
4002 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
4003 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
4004 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
4006 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
4007 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
4008 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
4009 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
4015 add_char_conversions (void)
4019 /* Count possible conversions. */
4020 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4021 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4025 /* Allocate memory. */
4026 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
4028 /* Add the conversions themselves. */
4030 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
4031 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
4033 gfc_typespec from
, to
;
4038 gfc_clear_ts (&from
);
4039 from
.type
= BT_CHARACTER
;
4040 from
.kind
= gfc_character_kinds
[i
].kind
;
4043 to
.type
= BT_CHARACTER
;
4044 to
.kind
= gfc_character_kinds
[j
].kind
;
4046 char_conversions
[n
].name
= conv_name (&from
, &to
);
4047 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
4048 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
4049 char_conversions
[n
].standard
= GFC_STD_F2003
;
4050 char_conversions
[n
].elemental
= 1;
4051 char_conversions
[n
].pure
= 1;
4052 char_conversions
[n
].conversion
= 0;
4053 char_conversions
[n
].ts
= to
;
4054 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
4061 /* Initialize the table of intrinsics. */
4063 gfc_intrinsic_init_1 (void)
4065 nargs
= nfunc
= nsub
= nconv
= 0;
4067 /* Create a namespace to hold the resolved intrinsic symbols. */
4068 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
4077 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
4078 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
4079 + sizeof (gfc_intrinsic_arg
) * nargs
);
4081 next_sym
= functions
;
4082 subroutines
= functions
+ nfunc
;
4084 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
4086 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
4088 sizing
= SZ_NOTHING
;
4095 /* Character conversion intrinsics need to be treated separately. */
4096 add_char_conversions ();
4101 gfc_intrinsic_done_1 (void)
4105 free (char_conversions
);
4106 gfc_free_namespace (gfc_intrinsic_namespace
);
4110 /******** Subroutines to check intrinsic interfaces ***********/
4112 /* Given a formal argument list, remove any NULL arguments that may
4113 have been left behind by a sort against some formal argument list. */
4116 remove_nullargs (gfc_actual_arglist
**ap
)
4118 gfc_actual_arglist
*head
, *tail
, *next
;
4122 for (head
= *ap
; head
; head
= next
)
4126 if (head
->expr
== NULL
&& !head
->label
)
4129 gfc_free_actual_arglist (head
);
4148 /* Given an actual arglist and a formal arglist, sort the actual
4149 arglist so that its arguments are in a one-to-one correspondence
4150 with the format arglist. Arguments that are not present are given
4151 a blank gfc_actual_arglist structure. If something is obviously
4152 wrong (say, a missing required argument) we abort sorting and
4156 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
4157 gfc_intrinsic_arg
*formal
, locus
*where
)
4159 gfc_actual_arglist
*actual
, *a
;
4160 gfc_intrinsic_arg
*f
;
4162 remove_nullargs (ap
);
4165 for (f
= formal
; f
; f
= f
->next
)
4171 if (f
== NULL
&& a
== NULL
) /* No arguments */
4175 { /* Put the nonkeyword arguments in a 1:1 correspondence */
4181 if (a
->name
!= NULL
)
4193 gfc_error ("Too many arguments in call to %qs at %L", name
, where
);
4197 /* Associate the remaining actual arguments, all of which have
4198 to be keyword arguments. */
4199 for (; a
; a
= a
->next
)
4201 for (f
= formal
; f
; f
= f
->next
)
4202 if (strcmp (a
->name
, f
->name
) == 0)
4207 if (a
->name
[0] == '%')
4208 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4209 "are not allowed in this context at %L", where
);
4211 gfc_error ("Can't find keyword named %qs in call to %qs at %L",
4212 a
->name
, name
, where
);
4216 if (f
->actual
!= NULL
)
4218 gfc_error ("Argument %qs appears twice in call to %qs at %L",
4219 f
->name
, name
, where
);
4227 /* At this point, all unmatched formal args must be optional. */
4228 for (f
= formal
; f
; f
= f
->next
)
4230 if (f
->actual
== NULL
&& f
->optional
== 0)
4232 gfc_error ("Missing actual argument %qs in call to %qs at %L",
4233 f
->name
, name
, where
);
4239 /* Using the formal argument list, string the actual argument list
4240 together in a way that corresponds with the formal list. */
4243 for (f
= formal
; f
; f
= f
->next
)
4245 if (f
->actual
&& f
->actual
->label
!= NULL
&& f
->ts
.type
)
4247 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
4251 if (f
->actual
== NULL
)
4253 a
= gfc_get_actual_arglist ();
4254 a
->missing_arg_type
= f
->ts
.type
;
4266 actual
->next
= NULL
; /* End the sorted argument list. */
4272 /* Compare an actual argument list with an intrinsic's formal argument
4273 list. The lists are checked for agreement of type. We don't check
4274 for arrayness here. */
4277 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
4280 gfc_actual_arglist
*actual
;
4281 gfc_intrinsic_arg
*formal
;
4284 formal
= sym
->formal
;
4288 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
4292 if (actual
->expr
== NULL
)
4297 /* A kind of 0 means we don't check for kind. */
4299 ts
.kind
= actual
->expr
->ts
.kind
;
4301 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
4304 gfc_error ("Type of argument %qs in call to %qs at %L should "
4305 "be %s, not %s", gfc_current_intrinsic_arg
[i
]->name
,
4306 gfc_current_intrinsic
, &actual
->expr
->where
,
4307 gfc_typename (&formal
->ts
),
4308 gfc_typename (&actual
->expr
->ts
));
4312 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4313 if (formal
->intent
== INTENT_INOUT
|| formal
->intent
== INTENT_OUT
)
4315 const char* context
= (error_flag
4316 ? _("actual argument to INTENT = OUT/INOUT")
4319 /* No pointer arguments for intrinsics. */
4320 if (!gfc_check_vardef_context (actual
->expr
, false, false, false, context
))
4329 /* Given a pointer to an intrinsic symbol and an expression node that
4330 represent the function call to that subroutine, figure out the type
4331 of the result. This may involve calling a resolution subroutine. */
4334 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4336 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4337 gfc_actual_arglist
*arg
;
4339 if (specific
->resolve
.f1
== NULL
)
4341 if (e
->value
.function
.name
== NULL
)
4342 e
->value
.function
.name
= specific
->lib_name
;
4344 if (e
->ts
.type
== BT_UNKNOWN
)
4345 e
->ts
= specific
->ts
;
4349 arg
= e
->value
.function
.actual
;
4351 /* Special case hacks for MIN and MAX. */
4352 if (specific
->resolve
.f1m
== gfc_resolve_max
4353 || specific
->resolve
.f1m
== gfc_resolve_min
)
4355 (*specific
->resolve
.f1m
) (e
, arg
);
4361 (*specific
->resolve
.f0
) (e
);
4370 (*specific
->resolve
.f1
) (e
, a1
);
4379 (*specific
->resolve
.f2
) (e
, a1
, a2
);
4388 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
4397 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
4406 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
4415 (*specific
->resolve
.f6
) (e
, a1
, a2
, a3
, a4
, a5
, a6
);
4419 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4423 /* Given an intrinsic symbol node and an expression node, call the
4424 simplification function (if there is one), perhaps replacing the
4425 expression with something simpler. We return false on an error
4426 of the simplification, true if the simplification worked, even
4427 if nothing has changed in the expression itself. */
4430 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4432 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
, *a6
;
4433 gfc_actual_arglist
*arg
;
4435 /* Max and min require special handling due to the variable number
4437 if (specific
->simplify
.f1
== gfc_simplify_min
)
4439 result
= gfc_simplify_min (e
);
4443 if (specific
->simplify
.f1
== gfc_simplify_max
)
4445 result
= gfc_simplify_max (e
);
4449 /* Some math intrinsics need to wrap the original expression. */
4450 if (specific
->simplify
.f1
== gfc_simplify_trigd
4451 || specific
->simplify
.f1
== gfc_simplify_atrigd
4452 || specific
->simplify
.f1
== gfc_simplify_cotan
)
4454 result
= (*specific
->simplify
.f1
) (e
);
4458 if (specific
->simplify
.f1
== NULL
)
4464 arg
= e
->value
.function
.actual
;
4468 result
= (*specific
->simplify
.f0
) ();
4475 if (specific
->simplify
.cc
== gfc_convert_constant
4476 || specific
->simplify
.cc
== gfc_convert_char_constant
)
4478 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
4483 result
= (*specific
->simplify
.f1
) (a1
);
4490 result
= (*specific
->simplify
.f2
) (a1
, a2
);
4497 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
4504 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
4511 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
4518 result
= (*specific
->simplify
.f6
)
4519 (a1
, a2
, a3
, a4
, a5
, a6
);
4522 ("do_simplify(): Too many args for intrinsic");
4530 if (result
== &gfc_bad_expr
)
4534 resolve_intrinsic (specific
, e
); /* Must call at run-time */
4537 result
->where
= e
->where
;
4538 gfc_replace_expr (e
, result
);
4545 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4546 error messages. This subroutine returns false if a subroutine
4547 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4548 list cannot match any intrinsic. */
4551 init_arglist (gfc_intrinsic_sym
*isym
)
4553 gfc_intrinsic_arg
*formal
;
4556 gfc_current_intrinsic
= isym
->name
;
4559 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
4561 if (i
>= MAX_INTRINSIC_ARGS
)
4562 gfc_internal_error ("init_arglist(): too many arguments");
4563 gfc_current_intrinsic_arg
[i
++] = formal
;
4568 /* Given a pointer to an intrinsic symbol and an expression consisting
4569 of a function call, see if the function call is consistent with the
4570 intrinsic's formal argument list. Return true if the expression
4571 and intrinsic match, false otherwise. */
4574 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
4576 gfc_actual_arglist
*arg
, **ap
;
4579 ap
= &expr
->value
.function
.actual
;
4581 init_arglist (specific
);
4583 /* Don't attempt to sort the argument list for min or max. */
4584 if (specific
->check
.f1m
== gfc_check_min_max
4585 || specific
->check
.f1m
== gfc_check_min_max_integer
4586 || specific
->check
.f1m
== gfc_check_min_max_real
4587 || specific
->check
.f1m
== gfc_check_min_max_double
)
4589 if (!do_ts29113_check (specific
, *ap
))
4591 return (*specific
->check
.f1m
) (*ap
);
4594 if (!sort_actual (specific
->name
, ap
, specific
->formal
, &expr
->where
))
4597 if (!do_ts29113_check (specific
, *ap
))
4600 if (specific
->check
.f5ml
== gfc_check_minloc_maxloc
)
4601 /* This is special because we might have to reorder the argument list. */
4602 t
= gfc_check_minloc_maxloc (*ap
);
4603 else if (specific
->check
.f6fl
== gfc_check_findloc
)
4604 t
= gfc_check_findloc (*ap
);
4605 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
4606 /* This is also special because we also might have to reorder the
4608 t
= gfc_check_minval_maxval (*ap
);
4609 else if (specific
->check
.f3red
== gfc_check_product_sum
)
4610 /* Same here. The difference to the previous case is that we allow a
4611 general numeric type. */
4612 t
= gfc_check_product_sum (*ap
);
4613 else if (specific
->check
.f3red
== gfc_check_transf_bit_intrins
)
4614 /* Same as for PRODUCT and SUM, but different checks. */
4615 t
= gfc_check_transf_bit_intrins (*ap
);
4618 if (specific
->check
.f1
== NULL
)
4620 t
= check_arglist (ap
, specific
, error_flag
);
4622 expr
->ts
= specific
->ts
;
4625 t
= do_check (specific
, *ap
);
4628 /* Check conformance of elemental intrinsics. */
4629 if (t
&& specific
->elemental
)
4632 gfc_expr
*first_expr
;
4633 arg
= expr
->value
.function
.actual
;
4635 /* There is no elemental intrinsic without arguments. */
4636 gcc_assert(arg
!= NULL
);
4637 first_expr
= arg
->expr
;
4639 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
4640 if (!gfc_check_conformance (first_expr
, arg
->expr
,
4641 "arguments '%s' and '%s' for "
4643 gfc_current_intrinsic_arg
[0]->name
,
4644 gfc_current_intrinsic_arg
[n
]->name
,
4645 gfc_current_intrinsic
))
4650 remove_nullargs (ap
);
4656 /* Check whether an intrinsic belongs to whatever standard the user
4657 has chosen, taking also into account -fall-intrinsics. Here, no
4658 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4659 textual representation of the symbols standard status (like
4660 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4661 can be used to construct a detailed warning/error message in case of
4665 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
4666 const char** symstd
, bool silent
, locus where
)
4668 const char* symstd_msg
;
4670 /* For -fall-intrinsics, just succeed. */
4671 if (flag_all_intrinsics
)
4674 /* Find the symbol's standard message for later usage. */
4675 switch (isym
->standard
)
4678 symstd_msg
= "available since Fortran 77";
4681 case GFC_STD_F95_OBS
:
4682 symstd_msg
= "obsolescent in Fortran 95";
4685 case GFC_STD_F95_DEL
:
4686 symstd_msg
= "deleted in Fortran 95";
4690 symstd_msg
= "new in Fortran 95";
4694 symstd_msg
= "new in Fortran 2003";
4698 symstd_msg
= "new in Fortran 2008";
4702 symstd_msg
= "new in Fortran 2018";
4706 symstd_msg
= "a GNU Fortran extension";
4709 case GFC_STD_LEGACY
:
4710 symstd_msg
= "for backward compatibility";
4714 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
4715 isym
->name
, isym
->standard
);
4718 /* If warning about the standard, warn and succeed. */
4719 if (gfc_option
.warn_std
& isym
->standard
)
4721 /* Do only print a warning if not a GNU extension. */
4722 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
4723 gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
4724 isym
->name
, _(symstd_msg
), &where
);
4729 /* If allowing the symbol's standard, succeed, too. */
4730 if (gfc_option
.allow_std
& isym
->standard
)
4733 /* Otherwise, fail. */
4735 *symstd
= _(symstd_msg
);
4740 /* See if a function call corresponds to an intrinsic function call.
4743 MATCH_YES if the call corresponds to an intrinsic, simplification
4744 is done if possible.
4746 MATCH_NO if the call does not correspond to an intrinsic
4748 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4749 error during the simplification process.
4751 The error_flag parameter enables an error reporting. */
4754 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
4756 gfc_intrinsic_sym
*isym
, *specific
;
4757 gfc_actual_arglist
*actual
;
4761 if (expr
->value
.function
.isym
!= NULL
)
4762 return (!do_simplify(expr
->value
.function
.isym
, expr
))
4763 ? MATCH_ERROR
: MATCH_YES
;
4766 gfc_push_suppress_errors ();
4769 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
4770 if (actual
->expr
!= NULL
)
4771 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
4772 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
4774 name
= expr
->symtree
->n
.sym
->name
;
4776 if (expr
->symtree
->n
.sym
->intmod_sym_id
)
4778 gfc_isym_id id
= gfc_isym_id_by_intmod_sym (expr
->symtree
->n
.sym
);
4779 isym
= specific
= gfc_intrinsic_function_by_id (id
);
4782 isym
= specific
= gfc_find_function (name
);
4787 gfc_pop_suppress_errors ();
4791 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
4792 || isym
->id
== GFC_ISYM_CMPLX
)
4793 && gfc_init_expr_flag
4794 && !gfc_notify_std (GFC_STD_F2003
, "Function %qs as initialization "
4795 "expression at %L", name
, &expr
->where
))
4798 gfc_pop_suppress_errors ();
4802 /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
4803 SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
4804 initialization expressions. */
4806 if (gfc_init_expr_flag
&& isym
->transformational
)
4808 gfc_isym_id id
= isym
->id
;
4809 if (id
!= GFC_ISYM_REPEAT
&& id
!= GFC_ISYM_RESHAPE
4810 && id
!= GFC_ISYM_SI_KIND
&& id
!= GFC_ISYM_SR_KIND
4811 && id
!= GFC_ISYM_TRANSFER
&& id
!= GFC_ISYM_TRIM
4812 && !gfc_notify_std (GFC_STD_F2003
, "Transformational function %qs "
4813 "at %L is invalid in an initialization "
4814 "expression", name
, &expr
->where
))
4817 gfc_pop_suppress_errors ();
4823 gfc_current_intrinsic_where
= &expr
->where
;
4825 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
4826 if (isym
->check
.f1m
== gfc_check_min_max
)
4828 init_arglist (isym
);
4830 if (isym
->check
.f1m(expr
->value
.function
.actual
))
4834 gfc_pop_suppress_errors ();
4838 /* If the function is generic, check all of its specific
4839 incarnations. If the generic name is also a specific, we check
4840 that name last, so that any error message will correspond to the
4842 gfc_push_suppress_errors ();
4846 for (specific
= isym
->specific_head
; specific
;
4847 specific
= specific
->next
)
4849 if (specific
== isym
)
4851 if (check_specific (specific
, expr
, 0))
4853 gfc_pop_suppress_errors ();
4859 gfc_pop_suppress_errors ();
4861 if (!check_specific (isym
, expr
, error_flag
))
4864 gfc_pop_suppress_errors ();
4871 expr
->value
.function
.isym
= specific
;
4872 if (!expr
->symtree
->n
.sym
->module
)
4873 gfc_intrinsic_symbol (expr
->symtree
->n
.sym
);
4876 gfc_pop_suppress_errors ();
4878 if (!do_simplify (specific
, expr
))
4881 /* F95, 7.1.6.1, Initialization expressions
4882 (4) An elemental intrinsic function reference of type integer or
4883 character where each argument is an initialization expression
4884 of type integer or character
4886 F2003, 7.1.7 Initialization expression
4887 (4) A reference to an elemental standard intrinsic function,
4888 where each argument is an initialization expression */
4890 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
4891 && !gfc_notify_std (GFC_STD_F2003
, "Elemental function as "
4892 "initialization expression with non-integer/non-"
4893 "character arguments at %L", &expr
->where
))
4900 /* See if a CALL statement corresponds to an intrinsic subroutine.
4901 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4902 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4906 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
4908 gfc_intrinsic_sym
*isym
;
4911 name
= c
->symtree
->n
.sym
->name
;
4913 if (c
->symtree
->n
.sym
->intmod_sym_id
)
4916 id
= gfc_isym_id_by_intmod_sym (c
->symtree
->n
.sym
);
4917 isym
= gfc_intrinsic_subroutine_by_id (id
);
4920 isym
= gfc_find_subroutine (name
);
4925 gfc_push_suppress_errors ();
4927 init_arglist (isym
);
4929 if (!isym
->vararg
&& !sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
))
4932 if (!do_ts29113_check (isym
, c
->ext
.actual
))
4935 if (isym
->check
.f1
!= NULL
)
4937 if (!do_check (isym
, c
->ext
.actual
))
4942 if (!check_arglist (&c
->ext
.actual
, isym
, 1))
4946 /* The subroutine corresponds to an intrinsic. Allow errors to be
4947 seen at this point. */
4949 gfc_pop_suppress_errors ();
4951 c
->resolved_isym
= isym
;
4952 if (isym
->resolve
.s1
!= NULL
)
4953 isym
->resolve
.s1 (c
);
4956 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
4957 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
4960 if (gfc_do_concurrent_flag
&& !isym
->pure
)
4962 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
4963 "block at %L is not PURE", name
, &c
->loc
);
4967 if (!isym
->pure
&& gfc_pure (NULL
))
4969 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name
,
4975 gfc_unset_implicit_pure (NULL
);
4977 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
4983 gfc_pop_suppress_errors ();
4988 /* Call gfc_convert_type() with warning enabled. */
4991 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
4993 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
4997 /* Try to convert an expression (in place) from one type to another.
4998 'eflag' controls the behavior on error.
5000 The possible values are:
5002 1 Generate a gfc_error()
5003 2 Generate a gfc_internal_error().
5005 'wflag' controls the warning related to conversion. */
5008 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
)
5010 gfc_intrinsic_sym
*sym
;
5011 gfc_typespec from_ts
;
5017 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
5019 if (ts
->type
== BT_UNKNOWN
)
5022 /* NULL and zero size arrays get their type here, unless they already have a
5024 if ((expr
->expr_type
== EXPR_NULL
5025 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
5026 && expr
->ts
.type
== BT_UNKNOWN
)
5028 /* Sometimes the RHS acquire the type. */
5033 if (expr
->ts
.type
== BT_UNKNOWN
)
5036 /* In building an array constructor, gfortran can end up here when no
5037 conversion is required for an intrinsic type. We need to let derived
5038 types drop through. */
5039 if (from_ts
.type
!= BT_DERIVED
5040 && (from_ts
.type
== ts
->type
&& from_ts
.kind
== ts
->kind
))
5043 if (expr
->ts
.type
== BT_DERIVED
&& ts
->type
== BT_DERIVED
5044 && gfc_compare_types (&expr
->ts
, ts
))
5047 sym
= find_conv (&expr
->ts
, ts
);
5051 /* At this point, a conversion is necessary. A warning may be needed. */
5052 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
5054 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
5055 gfc_typename (&from_ts
), gfc_typename (ts
),
5060 if (flag_range_check
&& expr
->expr_type
== EXPR_CONSTANT
5061 && from_ts
.type
== ts
->type
)
5063 /* Do nothing. Constants of the same type are range-checked
5064 elsewhere. If a value too large for the target type is
5065 assigned, an error is generated. Not checking here avoids
5066 duplications of warnings/errors.
5067 If range checking was disabled, but -Wconversion enabled,
5068 a non range checked warning is generated below. */
5070 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
5072 /* Do nothing. This block exists only to simplify the other
5073 else-if expressions.
5074 LOGICAL <> LOGICAL no warning, independent of kind values
5075 LOGICAL <> INTEGER extension, warned elsewhere
5076 LOGICAL <> REAL invalid, error generated elsewhere
5077 LOGICAL <> COMPLEX invalid, error generated elsewhere */
5079 else if (from_ts
.type
== ts
->type
5080 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
5081 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
5082 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
5084 /* Larger kinds can hold values of smaller kinds without problems.
5085 Hence, only warn if target kind is smaller than the source
5086 kind - or if -Wconversion-extra is specified. */
5087 if (expr
->expr_type
!= EXPR_CONSTANT
)
5089 if (warn_conversion
&& from_ts
.kind
> ts
->kind
)
5090 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5091 "conversion from %s to %s at %L",
5092 gfc_typename (&from_ts
), gfc_typename (ts
),
5094 else if (warn_conversion_extra
)
5095 gfc_warning_now (OPT_Wconversion_extra
, "Conversion from %s to %s "
5096 "at %L", gfc_typename (&from_ts
),
5097 gfc_typename (ts
), &expr
->where
);
5100 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
5101 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
5102 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
5104 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
5105 usually comes with a loss of information, regardless of kinds. */
5106 if (warn_conversion
&& expr
->expr_type
!= EXPR_CONSTANT
)
5107 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
5108 "conversion from %s to %s at %L",
5109 gfc_typename (&from_ts
), gfc_typename (ts
),
5112 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
5114 /* If HOLLERITH is involved, all bets are off. */
5115 if (warn_conversion
)
5116 gfc_warning_now (OPT_Wconversion
, "Conversion from %s to %s at %L",
5117 gfc_typename (&from_ts
), gfc_typename (ts
),
5124 /* Insert a pre-resolved function call to the right function. */
5125 old_where
= expr
->where
;
5127 shape
= expr
->shape
;
5129 new_expr
= gfc_get_expr ();
5132 new_expr
= gfc_build_conversion (new_expr
);
5133 new_expr
->value
.function
.name
= sym
->lib_name
;
5134 new_expr
->value
.function
.isym
= sym
;
5135 new_expr
->where
= old_where
;
5137 new_expr
->rank
= rank
;
5138 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5140 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5141 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
5142 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5143 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5144 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5145 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5146 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5147 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
5148 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5149 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5150 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5157 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5158 && !do_simplify (sym
, expr
))
5163 return false; /* Error already generated in do_simplify() */
5171 gfc_error ("Can't convert %s to %s at %L",
5172 gfc_typename (&from_ts
), gfc_typename (ts
), &expr
->where
);
5176 gfc_internal_error ("Can't convert %qs to %qs at %L",
5177 gfc_typename (&from_ts
), gfc_typename (ts
),
5184 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
5186 gfc_intrinsic_sym
*sym
;
5192 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
5194 sym
= find_char_conv (&expr
->ts
, ts
);
5197 /* Insert a pre-resolved function call to the right function. */
5198 old_where
= expr
->where
;
5200 shape
= expr
->shape
;
5202 new_expr
= gfc_get_expr ();
5205 new_expr
= gfc_build_conversion (new_expr
);
5206 new_expr
->value
.function
.name
= sym
->lib_name
;
5207 new_expr
->value
.function
.isym
= sym
;
5208 new_expr
->where
= old_where
;
5210 new_expr
->rank
= rank
;
5211 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
5213 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
5214 new_expr
->symtree
->n
.sym
->ts
.type
= ts
->type
;
5215 new_expr
->symtree
->n
.sym
->ts
.kind
= ts
->kind
;
5216 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
5217 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
5218 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
5219 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
5220 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
5221 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
5228 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
5229 && !do_simplify (sym
, expr
))
5231 /* Error already generated in do_simplify() */
5239 /* Check if the passed name is name of an intrinsic (taking into account the
5240 current -std=* and -fall-intrinsic settings). If it is, see if we should
5241 warn about this as a user-procedure having the same name as an intrinsic
5242 (-Wintrinsic-shadow enabled) and do so if we should. */
5245 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
5247 gfc_intrinsic_sym
* isym
;
5249 /* If the warning is disabled, do nothing at all. */
5250 if (!warn_intrinsic_shadow
)
5253 /* Try to find an intrinsic of the same name. */
5255 isym
= gfc_find_function (sym
->name
);
5257 isym
= gfc_find_subroutine (sym
->name
);
5259 /* If no intrinsic was found with this name or it's not included in the
5260 selected standard, everything's fine. */
5261 if (!isym
|| !gfc_check_intrinsic_standard (isym
, NULL
, true,
5265 /* Emit the warning. */
5266 if (in_module
|| sym
->ns
->proc_name
)
5267 gfc_warning (OPT_Wintrinsic_shadow
,
5268 "%qs declared at %L may shadow the intrinsic of the same"
5269 " name. In order to call the intrinsic, explicit INTRINSIC"
5270 " declarations may be required.",
5271 sym
->name
, &sym
->declared_at
);
5273 gfc_warning (OPT_Wintrinsic_shadow
,
5274 "%qs declared at %L is also the name of an intrinsic. It can"
5275 " only be called via an explicit interface or if declared"
5276 " EXTERNAL.", sym
->name
, &sym
->declared_at
);