1 /* Build up a list of intrinsic subroutines and functions for the
3 Copyright (C) 2000-2015 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. */
66 gfc_type_letter (bt type
)
101 /* Get a symbol for a resolved name. Note, if needed be, the elemental
102 attribute has be added afterwards. */
105 gfc_get_intrinsic_sub_symbol (const char *name
)
109 gfc_get_symbol (name
, gfc_intrinsic_namespace
, &sym
);
110 sym
->attr
.always_explicit
= 1;
111 sym
->attr
.subroutine
= 1;
112 sym
->attr
.flavor
= FL_PROCEDURE
;
113 sym
->attr
.proc
= PROC_INTRINSIC
;
115 gfc_commit_symbol (sym
);
121 /* Return a pointer to the name of a conversion function given two
125 conv_name (gfc_typespec
*from
, gfc_typespec
*to
)
127 return gfc_get_string ("__convert_%c%d_%c%d",
128 gfc_type_letter (from
->type
), from
->kind
,
129 gfc_type_letter (to
->type
), to
->kind
);
133 /* Given a pair of typespecs, find the gfc_intrinsic_sym node that
134 corresponds to the conversion. Returns NULL if the conversion
137 static gfc_intrinsic_sym
*
138 find_conv (gfc_typespec
*from
, gfc_typespec
*to
)
140 gfc_intrinsic_sym
*sym
;
144 target
= conv_name (from
, to
);
147 for (i
= 0; i
< nconv
; i
++, sym
++)
148 if (target
== sym
->name
)
155 /* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
156 that corresponds to the conversion. Returns NULL if the conversion
159 static gfc_intrinsic_sym
*
160 find_char_conv (gfc_typespec
*from
, gfc_typespec
*to
)
162 gfc_intrinsic_sym
*sym
;
166 target
= conv_name (from
, to
);
167 sym
= char_conversions
;
169 for (i
= 0; i
< ncharconv
; i
++, sym
++)
170 if (target
== sym
->name
)
177 /* Check TS29113, C407b for assumed type and C535b for assumed-rank,
178 and a likewise check for NO_ARG_CHECK. */
181 do_ts29113_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
183 gfc_actual_arglist
*a
;
185 for (a
= arg
; a
; a
= a
->next
)
190 if (a
->expr
->expr_type
== EXPR_VARIABLE
191 && (a
->expr
->symtree
->n
.sym
->attr
.ext_attr
192 & (1 << EXT_ATTR_NO_ARG_CHECK
))
193 && specific
->id
!= GFC_ISYM_C_LOC
194 && specific
->id
!= GFC_ISYM_PRESENT
)
196 gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
197 "permitted as argument to the intrinsic functions "
198 "C_LOC and PRESENT", &a
->expr
->where
);
201 else if (a
->expr
->ts
.type
== BT_ASSUMED
202 && specific
->id
!= GFC_ISYM_LBOUND
203 && specific
->id
!= GFC_ISYM_PRESENT
204 && specific
->id
!= GFC_ISYM_RANK
205 && specific
->id
!= GFC_ISYM_SHAPE
206 && specific
->id
!= GFC_ISYM_SIZE
207 && specific
->id
!= GFC_ISYM_SIZEOF
208 && specific
->id
!= GFC_ISYM_UBOUND
209 && specific
->id
!= GFC_ISYM_C_LOC
)
211 gfc_error ("Assumed-type argument at %L is not permitted as actual"
212 " argument to the intrinsic %s", &a
->expr
->where
,
213 gfc_current_intrinsic
);
216 else if (a
->expr
->ts
.type
== BT_ASSUMED
&& a
!= arg
)
218 gfc_error ("Assumed-type argument at %L is only permitted as "
219 "first actual argument to the intrinsic %s",
220 &a
->expr
->where
, gfc_current_intrinsic
);
223 if (a
->expr
->rank
== -1 && !specific
->inquiry
)
225 gfc_error ("Assumed-rank argument at %L is only permitted as actual "
226 "argument to intrinsic inquiry functions",
230 if (a
->expr
->rank
== -1 && arg
!= a
)
232 gfc_error ("Assumed-rank argument at %L is only permitted as first "
233 "actual argument to the intrinsic inquiry function %s",
234 &a
->expr
->where
, gfc_current_intrinsic
);
243 /* Interface to the check functions. We break apart an argument list
244 and call the proper check function rather than forcing each
245 function to manipulate the argument list. */
248 do_check (gfc_intrinsic_sym
*specific
, gfc_actual_arglist
*arg
)
250 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
253 return (*specific
->check
.f0
) ();
258 return (*specific
->check
.f1
) (a1
);
263 return (*specific
->check
.f2
) (a1
, a2
);
268 return (*specific
->check
.f3
) (a1
, a2
, a3
);
273 return (*specific
->check
.f4
) (a1
, a2
, a3
, a4
);
278 return (*specific
->check
.f5
) (a1
, a2
, a3
, a4
, a5
);
280 gfc_internal_error ("do_check(): too many args");
284 /*********** Subroutines to build the intrinsic list ****************/
286 /* Add a single intrinsic symbol to the current list.
289 char * name of function
290 int whether function is elemental
291 int If the function can be used as an actual argument [1]
292 bt return type of function
293 int kind of return type of function
294 int Fortran standard version
295 check pointer to check function
296 simplify pointer to simplification function
297 resolve pointer to resolution function
299 Optional arguments come in multiples of five:
300 char * name of argument
303 int arg optional flag (1=optional, 0=required)
304 sym_intent intent of argument
306 The sequence is terminated by a NULL name.
309 [1] Whether a function can or cannot be used as an actual argument is
310 determined by its presence on the 13.6 list in Fortran 2003. The
311 following intrinsics, which are GNU extensions, are considered allowed
312 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
313 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
316 add_sym (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
, int kind
,
317 int standard
, gfc_check_f check
, gfc_simplify_f simplify
,
318 gfc_resolve_f resolve
, ...)
320 char buf
[GFC_MAX_SYMBOL_LEN
+ 11]; /* 10 for '_gfortran_', 1 for '\0' */
321 int optional
, first_flag
;
336 next_sym
->name
= gfc_get_string (name
);
338 strcpy (buf
, "_gfortran_");
340 next_sym
->lib_name
= gfc_get_string (buf
);
342 next_sym
->pure
= (cl
!= CLASS_IMPURE
);
343 next_sym
->elemental
= (cl
== CLASS_ELEMENTAL
);
344 next_sym
->inquiry
= (cl
== CLASS_INQUIRY
);
345 next_sym
->transformational
= (cl
== CLASS_TRANSFORMATIONAL
);
346 next_sym
->actual_ok
= actual_ok
;
347 next_sym
->ts
.type
= type
;
348 next_sym
->ts
.kind
= kind
;
349 next_sym
->standard
= standard
;
350 next_sym
->simplify
= simplify
;
351 next_sym
->check
= check
;
352 next_sym
->resolve
= resolve
;
353 next_sym
->specific
= 0;
354 next_sym
->generic
= 0;
355 next_sym
->conversion
= 0;
360 gfc_internal_error ("add_sym(): Bad sizing mode");
363 va_start (argp
, resolve
);
369 name
= va_arg (argp
, char *);
373 type
= (bt
) va_arg (argp
, int);
374 kind
= va_arg (argp
, int);
375 optional
= va_arg (argp
, int);
376 intent
= (sym_intent
) va_arg (argp
, int);
378 if (sizing
!= SZ_NOTHING
)
385 next_sym
->formal
= next_arg
;
387 (next_arg
- 1)->next
= next_arg
;
391 strcpy (next_arg
->name
, name
);
392 next_arg
->ts
.type
= type
;
393 next_arg
->ts
.kind
= kind
;
394 next_arg
->optional
= optional
;
396 next_arg
->intent
= intent
;
406 /* Add a symbol to the function list where the function takes
410 add_sym_0 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
411 int kind
, int standard
,
412 bool (*check
) (void),
413 gfc_expr
*(*simplify
) (void),
414 void (*resolve
) (gfc_expr
*))
424 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
429 /* Add a symbol to the subroutine list where the subroutine takes
433 add_sym_0s (const char *name
, gfc_isym_id id
, int standard
,
434 void (*resolve
) (gfc_code
*))
444 add_sym (name
, id
, CLASS_IMPURE
, ACTUAL_NO
, BT_UNKNOWN
, 0, standard
, cf
, sf
,
449 /* Add a symbol to the function list where the function takes
453 add_sym_1 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
454 int kind
, int standard
,
455 bool (*check
) (gfc_expr
*),
456 gfc_expr
*(*simplify
) (gfc_expr
*),
457 void (*resolve
) (gfc_expr
*, gfc_expr
*),
458 const char *a1
, bt type1
, int kind1
, int optional1
)
468 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
469 a1
, type1
, kind1
, optional1
, INTENT_IN
,
474 /* Add a symbol to the function list where the function takes
475 1 arguments, specifying the intent of the argument. */
478 add_sym_1_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
479 int actual_ok
, bt type
, int kind
, int standard
,
480 bool (*check
) (gfc_expr
*),
481 gfc_expr
*(*simplify
) (gfc_expr
*),
482 void (*resolve
) (gfc_expr
*, gfc_expr
*),
483 const char *a1
, bt type1
, int kind1
, int optional1
,
494 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
495 a1
, type1
, kind1
, optional1
, intent1
,
500 /* Add a symbol to the subroutine list where the subroutine takes
501 1 arguments, specifying the intent of the argument. */
504 add_sym_1s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
505 int standard
, bool (*check
) (gfc_expr
*),
506 gfc_expr
*(*simplify
) (gfc_expr
*), void (*resolve
) (gfc_code
*),
507 const char *a1
, bt type1
, int kind1
, int optional1
,
518 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
519 a1
, type1
, kind1
, optional1
, intent1
,
523 /* Add a symbol to the subroutine ilst where the subroutine takes one
524 printf-style character argument and a variable number of arguments
528 add_sym_1p (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
529 int standard
, bool (*check
) (gfc_actual_arglist
*),
530 gfc_expr
*(*simplify
) (gfc_expr
*), void (*resolve
) (gfc_code
*),
531 const char *a1
, bt type1
, int kind1
, int optional1
, sym_intent intent1
)
541 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
542 a1
, type1
, kind1
, optional1
, intent1
,
547 /* Add a symbol from the MAX/MIN family of intrinsic functions to the
548 function. MAX et al take 2 or more arguments. */
551 add_sym_1m (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
552 int kind
, int standard
,
553 bool (*check
) (gfc_actual_arglist
*),
554 gfc_expr
*(*simplify
) (gfc_expr
*),
555 void (*resolve
) (gfc_expr
*, gfc_actual_arglist
*),
556 const char *a1
, bt type1
, int kind1
, int optional1
,
557 const char *a2
, bt type2
, int kind2
, int optional2
)
567 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
568 a1
, type1
, kind1
, optional1
, INTENT_IN
,
569 a2
, type2
, kind2
, optional2
, INTENT_IN
,
574 /* Add a symbol to the function list where the function takes
578 add_sym_2 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
579 int kind
, int standard
,
580 bool (*check
) (gfc_expr
*, gfc_expr
*),
581 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
582 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
583 const char *a1
, bt type1
, int kind1
, int optional1
,
584 const char *a2
, bt type2
, int kind2
, int optional2
)
594 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
595 a1
, type1
, kind1
, optional1
, INTENT_IN
,
596 a2
, type2
, kind2
, optional2
, INTENT_IN
,
601 /* Add a symbol to the function list where the function takes
602 2 arguments; same as add_sym_2 - but allows to specify the intent. */
605 add_sym_2_intent (const char *name
, gfc_isym_id id
, enum klass cl
,
606 int actual_ok
, bt type
, int kind
, int standard
,
607 bool (*check
) (gfc_expr
*, gfc_expr
*),
608 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
609 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
610 const char *a1
, bt type1
, int kind1
, int optional1
,
611 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
612 int optional2
, sym_intent intent2
)
622 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
623 a1
, type1
, kind1
, optional1
, intent1
,
624 a2
, type2
, kind2
, optional2
, intent2
,
629 /* Add a symbol to the subroutine list where the subroutine takes
630 2 arguments, specifying the intent of the arguments. */
633 add_sym_2s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
634 int kind
, int standard
,
635 bool (*check
) (gfc_expr
*, gfc_expr
*),
636 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*),
637 void (*resolve
) (gfc_code
*),
638 const char *a1
, bt type1
, int kind1
, int optional1
,
639 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
640 int optional2
, sym_intent intent2
)
650 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
651 a1
, type1
, kind1
, optional1
, intent1
,
652 a2
, type2
, kind2
, optional2
, intent2
,
657 /* Add a symbol to the function list where the function takes
661 add_sym_3 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
662 int kind
, int standard
,
663 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
664 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
665 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
666 const char *a1
, bt type1
, int kind1
, int optional1
,
667 const char *a2
, bt type2
, int kind2
, int optional2
,
668 const char *a3
, bt type3
, int kind3
, int optional3
)
678 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
679 a1
, type1
, kind1
, optional1
, INTENT_IN
,
680 a2
, type2
, kind2
, optional2
, INTENT_IN
,
681 a3
, type3
, kind3
, optional3
, INTENT_IN
,
686 /* MINLOC and MAXLOC get special treatment because their argument
687 might have to be reordered. */
690 add_sym_3ml (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
691 int kind
, int standard
,
692 bool (*check
) (gfc_actual_arglist
*),
693 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
694 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
695 const char *a1
, bt type1
, int kind1
, int optional1
,
696 const char *a2
, bt type2
, int kind2
, int optional2
,
697 const char *a3
, bt type3
, int kind3
, int optional3
)
707 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
708 a1
, type1
, kind1
, optional1
, INTENT_IN
,
709 a2
, type2
, kind2
, optional2
, INTENT_IN
,
710 a3
, type3
, kind3
, optional3
, INTENT_IN
,
715 /* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
716 their argument also might have to be reordered. */
719 add_sym_3red (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
720 int kind
, int standard
,
721 bool (*check
) (gfc_actual_arglist
*),
722 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
723 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
724 const char *a1
, bt type1
, int kind1
, int optional1
,
725 const char *a2
, bt type2
, int kind2
, int optional2
,
726 const char *a3
, bt type3
, int kind3
, int optional3
)
736 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
737 a1
, type1
, kind1
, optional1
, INTENT_IN
,
738 a2
, type2
, kind2
, optional2
, INTENT_IN
,
739 a3
, type3
, kind3
, optional3
, INTENT_IN
,
744 /* Add a symbol to the subroutine list where the subroutine takes
745 3 arguments, specifying the intent of the arguments. */
748 add_sym_3s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
,
749 int kind
, int standard
,
750 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
751 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*),
752 void (*resolve
) (gfc_code
*),
753 const char *a1
, bt type1
, int kind1
, int optional1
,
754 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
755 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
756 int kind3
, int optional3
, sym_intent intent3
)
766 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
767 a1
, type1
, kind1
, optional1
, intent1
,
768 a2
, type2
, kind2
, optional2
, intent2
,
769 a3
, type3
, kind3
, optional3
, intent3
,
774 /* Add a symbol to the function list where the function takes
778 add_sym_4 (const char *name
, gfc_isym_id id
, enum klass cl
, int actual_ok
, bt type
,
779 int kind
, int standard
,
780 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
781 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
783 void (*resolve
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
785 const char *a1
, bt type1
, int kind1
, int optional1
,
786 const char *a2
, bt type2
, int kind2
, int optional2
,
787 const char *a3
, bt type3
, int kind3
, int optional3
,
788 const char *a4
, bt type4
, int kind4
, int optional4
)
798 add_sym (name
, id
, cl
, actual_ok
, type
, kind
, standard
, cf
, sf
, rf
,
799 a1
, type1
, kind1
, optional1
, INTENT_IN
,
800 a2
, type2
, kind2
, optional2
, INTENT_IN
,
801 a3
, type3
, kind3
, optional3
, INTENT_IN
,
802 a4
, type4
, kind4
, optional4
, INTENT_IN
,
807 /* Add a symbol to the subroutine list where the subroutine takes
811 add_sym_4s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
813 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*),
814 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
816 void (*resolve
) (gfc_code
*),
817 const char *a1
, bt type1
, int kind1
, int optional1
,
818 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
819 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
820 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
821 bt type4
, int kind4
, int optional4
, sym_intent intent4
)
831 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
832 a1
, type1
, kind1
, optional1
, intent1
,
833 a2
, type2
, kind2
, optional2
, intent2
,
834 a3
, type3
, kind3
, optional3
, intent3
,
835 a4
, type4
, kind4
, optional4
, intent4
,
840 /* Add a symbol to the subroutine list where the subroutine takes
844 add_sym_5s (const char *name
, gfc_isym_id id
, enum klass cl
, bt type
, int kind
,
846 bool (*check
) (gfc_expr
*, gfc_expr
*, gfc_expr
*, gfc_expr
*,
848 gfc_expr
*(*simplify
) (gfc_expr
*, gfc_expr
*, gfc_expr
*,
849 gfc_expr
*, gfc_expr
*),
850 void (*resolve
) (gfc_code
*),
851 const char *a1
, bt type1
, int kind1
, int optional1
,
852 sym_intent intent1
, const char *a2
, bt type2
, int kind2
,
853 int optional2
, sym_intent intent2
, const char *a3
, bt type3
,
854 int kind3
, int optional3
, sym_intent intent3
, const char *a4
,
855 bt type4
, int kind4
, int optional4
, sym_intent intent4
,
856 const char *a5
, bt type5
, int kind5
, int optional5
,
867 add_sym (name
, id
, cl
, ACTUAL_NO
, type
, kind
, standard
, cf
, sf
, rf
,
868 a1
, type1
, kind1
, optional1
, intent1
,
869 a2
, type2
, kind2
, optional2
, intent2
,
870 a3
, type3
, kind3
, optional3
, intent3
,
871 a4
, type4
, kind4
, optional4
, intent4
,
872 a5
, type5
, kind5
, optional5
, intent5
,
877 /* Locate an intrinsic symbol given a base pointer, number of elements
878 in the table and a pointer to a name. Returns the NULL pointer if
879 a name is not found. */
881 static gfc_intrinsic_sym
*
882 find_sym (gfc_intrinsic_sym
*start
, int n
, const char *name
)
884 /* name may be a user-supplied string, so we must first make sure
885 that we're comparing against a pointer into the global string
887 const char *p
= gfc_get_string (name
);
891 if (p
== start
->name
)
903 gfc_isym_id_by_intmod (intmod_id from_intmod
, int intmod_sym_id
)
905 if (from_intmod
== INTMOD_NONE
)
906 return (gfc_isym_id
) intmod_sym_id
;
907 else if (from_intmod
== INTMOD_ISO_C_BINDING
)
908 return (gfc_isym_id
) c_interop_kinds_table
[intmod_sym_id
].value
;
909 else if (from_intmod
== INTMOD_ISO_FORTRAN_ENV
)
910 switch (intmod_sym_id
)
912 #define NAMED_SUBROUTINE(a,b,c,d) \
914 return (gfc_isym_id) c;
915 #define NAMED_FUNCTION(a,b,c,d) \
917 return (gfc_isym_id) c;
918 #include "iso-fortran-env.def"
924 return (gfc_isym_id
) 0;
929 gfc_isym_id_by_intmod_sym (gfc_symbol
*sym
)
931 return gfc_isym_id_by_intmod (sym
->from_intmod
, sym
->intmod_sym_id
);
936 gfc_intrinsic_subroutine_by_id (gfc_isym_id id
)
938 gfc_intrinsic_sym
*start
= subroutines
;
954 gfc_intrinsic_function_by_id (gfc_isym_id id
)
956 gfc_intrinsic_sym
*start
= functions
;
971 /* Given a name, find a function in the intrinsic function table.
972 Returns NULL if not found. */
975 gfc_find_function (const char *name
)
977 gfc_intrinsic_sym
*sym
;
979 sym
= find_sym (functions
, nfunc
, name
);
980 if (!sym
|| sym
->from_module
)
981 sym
= find_sym (conversion
, nconv
, name
);
983 return (!sym
|| sym
->from_module
) ? NULL
: sym
;
987 /* Given a name, find a function in the intrinsic subroutine table.
988 Returns NULL if not found. */
991 gfc_find_subroutine (const char *name
)
993 gfc_intrinsic_sym
*sym
;
994 sym
= find_sym (subroutines
, nsub
, name
);
995 return (!sym
|| sym
->from_module
) ? NULL
: sym
;
999 /* Given a string, figure out if it is the name of a generic intrinsic
1003 gfc_generic_intrinsic (const char *name
)
1005 gfc_intrinsic_sym
*sym
;
1007 sym
= gfc_find_function (name
);
1008 return (!sym
|| sym
->from_module
) ? 0 : sym
->generic
;
1012 /* Given a string, figure out if it is the name of a specific
1013 intrinsic function or not. */
1016 gfc_specific_intrinsic (const char *name
)
1018 gfc_intrinsic_sym
*sym
;
1020 sym
= gfc_find_function (name
);
1021 return (!sym
|| sym
->from_module
) ? 0 : sym
->specific
;
1025 /* Given a string, figure out if it is the name of an intrinsic function
1026 or subroutine allowed as an actual argument or not. */
1028 gfc_intrinsic_actual_ok (const char *name
, const bool subroutine_flag
)
1030 gfc_intrinsic_sym
*sym
;
1032 /* Intrinsic subroutines are not allowed as actual arguments. */
1033 if (subroutine_flag
)
1037 sym
= gfc_find_function (name
);
1038 return (sym
== NULL
) ? 0 : sym
->actual_ok
;
1043 /* Given a symbol, find out if it is (and is to be treated as) an intrinsic.
1044 If its name refers to an intrinsic, but this intrinsic is not included in
1045 the selected standard, this returns FALSE and sets the symbol's external
1049 gfc_is_intrinsic (gfc_symbol
* sym
, int subroutine_flag
, locus loc
)
1051 gfc_intrinsic_sym
* isym
;
1054 /* If INTRINSIC attribute is already known, return. */
1055 if (sym
->attr
.intrinsic
)
1058 /* Check for attributes which prevent the symbol from being INTRINSIC. */
1059 if (sym
->attr
.external
|| sym
->attr
.contained
1060 || sym
->attr
.if_source
== IFSRC_IFBODY
)
1063 if (subroutine_flag
)
1064 isym
= gfc_find_subroutine (sym
->name
);
1066 isym
= gfc_find_function (sym
->name
);
1068 /* No such intrinsic available at all? */
1072 /* See if this intrinsic is allowed in the current standard. */
1073 if (!gfc_check_intrinsic_standard (isym
, &symstd
, false, loc
)
1074 && !sym
->attr
.artificial
)
1076 if (sym
->attr
.proc
== PROC_UNKNOWN
&& warn_intrinsics_std
)
1077 gfc_warning_now (OPT_Wintrinsics_std
, "The intrinsic %qs at %L is not "
1078 "included in the selected standard but %s and %qs will"
1079 " be treated as if declared EXTERNAL. Use an"
1080 " appropriate -std=* option or define"
1081 " -fall-intrinsics to allow this intrinsic.",
1082 sym
->name
, &loc
, symstd
, sym
->name
);
1091 /* Collect a set of intrinsic functions into a generic collection.
1092 The first argument is the name of the generic function, which is
1093 also the name of a specific function. The rest of the specifics
1094 currently in the table are placed into the list of specific
1095 functions associated with that generic.
1098 FIXME: Remove the argument STANDARD if no regressions are
1099 encountered. Change all callers (approx. 360).
1103 make_generic (const char *name
, gfc_isym_id id
, int standard ATTRIBUTE_UNUSED
)
1105 gfc_intrinsic_sym
*g
;
1107 if (sizing
!= SZ_NOTHING
)
1110 g
= gfc_find_function (name
);
1112 gfc_internal_error ("make_generic(): Can't find generic symbol %qs",
1115 gcc_assert (g
->id
== id
);
1119 if ((g
+ 1)->name
!= NULL
)
1120 g
->specific_head
= g
+ 1;
1123 while (g
->name
!= NULL
)
1135 /* Create a duplicate intrinsic function entry for the current
1136 function, the only differences being the alternate name and
1137 a different standard if necessary. Note that we use argument
1138 lists more than once, but all argument lists are freed as a
1142 make_alias (const char *name
, int standard
)
1155 next_sym
[0] = next_sym
[-1];
1156 next_sym
->name
= gfc_get_string (name
);
1157 next_sym
->standard
= standard
;
1167 /* Make the current subroutine noreturn. */
1170 make_noreturn (void)
1172 if (sizing
== SZ_NOTHING
)
1173 next_sym
[-1].noreturn
= 1;
1177 /* Mark current intrinsic as module intrinsic. */
1179 make_from_module (void)
1181 if (sizing
== SZ_NOTHING
)
1182 next_sym
[-1].from_module
= 1;
1186 /* Mark the current subroutine as having a variable number of
1192 if (sizing
== SZ_NOTHING
)
1193 next_sym
[-1].vararg
= 1;
1196 /* Set the attr.value of the current procedure. */
1199 set_attr_value (int n
, ...)
1201 gfc_intrinsic_arg
*arg
;
1205 if (sizing
!= SZ_NOTHING
)
1209 arg
= next_sym
[-1].formal
;
1211 for (i
= 0; i
< n
; i
++)
1213 gcc_assert (arg
!= NULL
);
1214 arg
->value
= va_arg (argp
, int);
1221 /* Add intrinsic functions. */
1224 add_functions (void)
1226 /* Argument names as in the standard (to be used as argument keywords). */
1228 *a
= "a", *f
= "field", *pt
= "pointer", *tg
= "target",
1229 *b
= "b", *m
= "matrix", *ma
= "matrix_a", *mb
= "matrix_b",
1230 *c
= "c", *n
= "n", *ncopies
= "ncopies", *pos
= "pos", *bck
= "back",
1231 *i
= "i", *v
= "vector", *va
= "vector_a", *vb
= "vector_b",
1232 *j
= "j", *a1
= "a1", *fs
= "fsource", *ts
= "tsource",
1233 *l
= "l", *a2
= "a2", *mo
= "mold", *ord
= "order",
1234 *p
= "p", *ar
= "array", *shp
= "shape", *src
= "source",
1235 *r
= "r", *bd
= "boundary", *pad
= "pad", *set
= "set",
1236 *s
= "s", *dm
= "dim", *kind
= "kind", *msk
= "mask",
1237 *x
= "x", *sh
= "shift", *stg
= "string", *ssg
= "substring",
1238 *y
= "y", *sz
= "size", *sta
= "string_a", *stb
= "string_b",
1239 *z
= "z", *ln
= "len", *ut
= "unit", *han
= "handler",
1240 *num
= "number", *tm
= "time", *nm
= "name", *md
= "mode",
1241 *vl
= "values", *p1
= "path1", *p2
= "path2", *com
= "command",
1242 *ca
= "coarray", *sub
= "sub", *dist
= "distance", *failed
="failed";
1244 int di
, dr
, dd
, dl
, dc
, dz
, ii
;
1246 di
= gfc_default_integer_kind
;
1247 dr
= gfc_default_real_kind
;
1248 dd
= gfc_default_double_kind
;
1249 dl
= gfc_default_logical_kind
;
1250 dc
= gfc_default_character_kind
;
1251 dz
= gfc_default_complex_kind
;
1252 ii
= gfc_index_integer_kind
;
1254 add_sym_1 ("abs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1255 gfc_check_abs
, gfc_simplify_abs
, gfc_resolve_abs
,
1256 a
, BT_REAL
, dr
, REQUIRED
);
1258 add_sym_1 ("iabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1259 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1260 a
, BT_INTEGER
, di
, REQUIRED
);
1262 add_sym_1 ("dabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1263 gfc_check_fn_d
, gfc_simplify_abs
, gfc_resolve_abs
,
1264 a
, BT_REAL
, dd
, REQUIRED
);
1266 add_sym_1 ("cabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1267 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1268 a
, BT_COMPLEX
, dz
, REQUIRED
);
1270 add_sym_1 ("zabs", GFC_ISYM_ABS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1271 NULL
, gfc_simplify_abs
, gfc_resolve_abs
,
1272 a
, BT_COMPLEX
, dd
, REQUIRED
);
1274 make_alias ("cdabs", GFC_STD_GNU
);
1276 make_generic ("abs", GFC_ISYM_ABS
, GFC_STD_F77
);
1278 /* The checking function for ACCESS is called gfc_check_access_func
1279 because the name gfc_check_access is already used in module.c. */
1280 add_sym_2 ("access", GFC_ISYM_ACCESS
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1281 di
, GFC_STD_GNU
, gfc_check_access_func
, NULL
, gfc_resolve_access
,
1282 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1284 make_generic ("access", GFC_ISYM_ACCESS
, GFC_STD_GNU
);
1286 add_sym_2 ("achar", GFC_ISYM_ACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1287 BT_CHARACTER
, dc
, GFC_STD_F95
,
1288 gfc_check_achar
, gfc_simplify_achar
, gfc_resolve_achar
,
1289 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1291 make_generic ("achar", GFC_ISYM_ACHAR
, GFC_STD_F95
);
1293 add_sym_1 ("acos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1294 gfc_check_fn_rc2008
, gfc_simplify_acos
, gfc_resolve_acos
,
1295 x
, BT_REAL
, dr
, REQUIRED
);
1297 add_sym_1 ("dacos", GFC_ISYM_ACOS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1298 gfc_check_fn_d
, gfc_simplify_acos
, gfc_resolve_acos
,
1299 x
, BT_REAL
, dd
, REQUIRED
);
1301 make_generic ("acos", GFC_ISYM_ACOS
, GFC_STD_F77
);
1303 add_sym_1 ("acosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1304 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_acosh
,
1305 gfc_resolve_acosh
, x
, BT_REAL
, dr
, REQUIRED
);
1307 add_sym_1 ("dacosh", GFC_ISYM_ACOSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1308 gfc_check_fn_d
, gfc_simplify_acosh
, gfc_resolve_acosh
,
1309 x
, BT_REAL
, dd
, REQUIRED
);
1311 make_generic ("acosh", GFC_ISYM_ACOSH
, GFC_STD_F2008
);
1313 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1314 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustl
,
1315 gfc_resolve_adjustl
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1317 make_generic ("adjustl", GFC_ISYM_ADJUSTL
, GFC_STD_F95
);
1319 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1320 BT_CHARACTER
, dc
, GFC_STD_F95
, NULL
, gfc_simplify_adjustr
,
1321 gfc_resolve_adjustr
, stg
, BT_CHARACTER
, 0, REQUIRED
);
1323 make_generic ("adjustr", GFC_ISYM_ADJUSTR
, GFC_STD_F95
);
1325 add_sym_1 ("aimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1326 gfc_check_fn_c
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1327 z
, BT_COMPLEX
, dz
, REQUIRED
);
1329 make_alias ("imag", GFC_STD_GNU
);
1330 make_alias ("imagpart", GFC_STD_GNU
);
1332 add_sym_1 ("dimag", GFC_ISYM_AIMAG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1333 NULL
, gfc_simplify_aimag
, gfc_resolve_aimag
,
1334 z
, BT_COMPLEX
, dd
, REQUIRED
);
1336 make_generic ("aimag", GFC_ISYM_AIMAG
, GFC_STD_F77
);
1338 add_sym_2 ("aint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1339 gfc_check_a_xkind
, gfc_simplify_aint
, gfc_resolve_aint
,
1340 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1342 add_sym_1 ("dint", GFC_ISYM_AINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1343 NULL
, gfc_simplify_dint
, gfc_resolve_dint
,
1344 a
, BT_REAL
, dd
, REQUIRED
);
1346 make_generic ("aint", GFC_ISYM_AINT
, GFC_STD_F77
);
1348 add_sym_2 ("all", GFC_ISYM_ALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1349 gfc_check_all_any
, gfc_simplify_all
, gfc_resolve_all
,
1350 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1352 make_generic ("all", GFC_ISYM_ALL
, GFC_STD_F95
);
1354 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1355 gfc_check_allocated
, NULL
, NULL
,
1356 ar
, BT_UNKNOWN
, 0, REQUIRED
);
1358 make_generic ("allocated", GFC_ISYM_ALLOCATED
, GFC_STD_F95
);
1360 add_sym_2 ("anint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1361 gfc_check_a_xkind
, gfc_simplify_anint
, gfc_resolve_anint
,
1362 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1364 add_sym_1 ("dnint", GFC_ISYM_ANINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1365 NULL
, gfc_simplify_dnint
, gfc_resolve_dnint
,
1366 a
, BT_REAL
, dd
, REQUIRED
);
1368 make_generic ("anint", GFC_ISYM_ANINT
, GFC_STD_F77
);
1370 add_sym_2 ("any", GFC_ISYM_ANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1371 gfc_check_all_any
, gfc_simplify_any
, gfc_resolve_any
,
1372 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1374 make_generic ("any", GFC_ISYM_ANY
, GFC_STD_F95
);
1376 add_sym_1 ("asin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1377 gfc_check_fn_rc2008
, gfc_simplify_asin
, gfc_resolve_asin
,
1378 x
, BT_REAL
, dr
, REQUIRED
);
1380 add_sym_1 ("dasin", GFC_ISYM_ASIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1381 gfc_check_fn_d
, gfc_simplify_asin
, gfc_resolve_asin
,
1382 x
, BT_REAL
, dd
, REQUIRED
);
1384 make_generic ("asin", GFC_ISYM_ASIN
, GFC_STD_F77
);
1386 add_sym_1 ("asinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1387 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_asinh
,
1388 gfc_resolve_asinh
, x
, BT_REAL
, dr
, REQUIRED
);
1390 add_sym_1 ("dasinh", GFC_ISYM_ASINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1391 gfc_check_fn_d
, gfc_simplify_asinh
, gfc_resolve_asinh
,
1392 x
, BT_REAL
, dd
, REQUIRED
);
1394 make_generic ("asinh", GFC_ISYM_ASINH
, GFC_STD_F2008
);
1396 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
, BT_LOGICAL
, dl
,
1397 GFC_STD_F95
, gfc_check_associated
, NULL
, NULL
,
1398 pt
, BT_UNKNOWN
, 0, REQUIRED
, tg
, BT_UNKNOWN
, 0, OPTIONAL
);
1400 make_generic ("associated", GFC_ISYM_ASSOCIATED
, GFC_STD_F95
);
1402 add_sym_1 ("atan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1403 gfc_check_fn_rc2008
, gfc_simplify_atan
, gfc_resolve_atan
,
1404 x
, BT_REAL
, dr
, REQUIRED
);
1406 add_sym_1 ("datan", GFC_ISYM_ATAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1407 gfc_check_fn_d
, gfc_simplify_atan
, gfc_resolve_atan
,
1408 x
, BT_REAL
, dd
, REQUIRED
);
1410 /* Two-argument version of atan, equivalent to atan2. */
1411 add_sym_2 ("atan", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F2008
,
1412 gfc_check_atan_2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1413 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1415 make_generic ("atan", GFC_ISYM_ATAN
, GFC_STD_F77
);
1417 add_sym_1 ("atanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
,
1418 GFC_STD_F2008
, gfc_check_fn_rc2008
, gfc_simplify_atanh
,
1419 gfc_resolve_atanh
, x
, BT_REAL
, dr
, REQUIRED
);
1421 add_sym_1 ("datanh", GFC_ISYM_ATANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_GNU
,
1422 gfc_check_fn_d
, gfc_simplify_atanh
, gfc_resolve_atanh
,
1423 x
, BT_REAL
, dd
, REQUIRED
);
1425 make_generic ("atanh", GFC_ISYM_ATANH
, GFC_STD_F2008
);
1427 add_sym_2 ("atan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1428 gfc_check_atan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1429 y
, BT_REAL
, dr
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1431 add_sym_2 ("datan2", GFC_ISYM_ATAN2
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1432 gfc_check_datan2
, gfc_simplify_atan2
, gfc_resolve_atan2
,
1433 y
, BT_REAL
, dd
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1435 make_generic ("atan2", GFC_ISYM_ATAN2
, GFC_STD_F77
);
1437 /* Bessel and Neumann functions for G77 compatibility. */
1438 add_sym_1 ("besj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1439 gfc_check_fn_r
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1440 x
, BT_REAL
, dr
, REQUIRED
);
1442 make_alias ("bessel_j0", GFC_STD_F2008
);
1444 add_sym_1 ("dbesj0", GFC_ISYM_J0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1445 gfc_check_fn_d
, gfc_simplify_bessel_j0
, gfc_resolve_g77_math1
,
1446 x
, BT_REAL
, dd
, REQUIRED
);
1448 make_generic ("bessel_j0", GFC_ISYM_J0
, GFC_STD_F2008
);
1450 add_sym_1 ("besj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1451 gfc_check_fn_r
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1452 x
, BT_REAL
, dr
, REQUIRED
);
1454 make_alias ("bessel_j1", GFC_STD_F2008
);
1456 add_sym_1 ("dbesj1", GFC_ISYM_J1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1457 gfc_check_fn_d
, gfc_simplify_bessel_j1
, gfc_resolve_g77_math1
,
1458 x
, BT_REAL
, dd
, REQUIRED
);
1460 make_generic ("bessel_j1", GFC_ISYM_J1
, GFC_STD_F2008
);
1462 add_sym_2 ("besjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1463 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1464 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1466 make_alias ("bessel_jn", GFC_STD_F2008
);
1468 add_sym_2 ("dbesjn", GFC_ISYM_JN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1469 gfc_check_besn
, gfc_simplify_bessel_jn
, gfc_resolve_besn
,
1470 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1472 add_sym_3 ("bessel_jn", GFC_ISYM_JN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1473 gfc_check_bessel_n2
, gfc_simplify_bessel_jn2
, gfc_resolve_bessel_n2
,
1474 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1475 x
, BT_REAL
, dr
, REQUIRED
);
1476 set_attr_value (3, true, true, true);
1478 make_generic ("bessel_jn", GFC_ISYM_JN
, GFC_STD_F2008
);
1480 add_sym_1 ("besy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1481 gfc_check_fn_r
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1482 x
, BT_REAL
, dr
, REQUIRED
);
1484 make_alias ("bessel_y0", GFC_STD_F2008
);
1486 add_sym_1 ("dbesy0", GFC_ISYM_Y0
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1487 gfc_check_fn_d
, gfc_simplify_bessel_y0
, gfc_resolve_g77_math1
,
1488 x
, BT_REAL
, dd
, REQUIRED
);
1490 make_generic ("bessel_y0", GFC_ISYM_Y0
, GFC_STD_F2008
);
1492 add_sym_1 ("besy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1493 gfc_check_fn_r
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1494 x
, BT_REAL
, dr
, REQUIRED
);
1496 make_alias ("bessel_y1", GFC_STD_F2008
);
1498 add_sym_1 ("dbesy1", GFC_ISYM_Y1
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1499 gfc_check_fn_d
, gfc_simplify_bessel_y1
, gfc_resolve_g77_math1
,
1500 x
, BT_REAL
, dd
, REQUIRED
);
1502 make_generic ("bessel_y1", GFC_ISYM_Y1
, GFC_STD_F2008
);
1504 add_sym_2 ("besyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1505 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1506 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dr
, REQUIRED
);
1508 make_alias ("bessel_yn", GFC_STD_F2008
);
1510 add_sym_2 ("dbesyn", GFC_ISYM_YN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
1511 gfc_check_besn
, gfc_simplify_bessel_yn
, gfc_resolve_besn
,
1512 n
, BT_INTEGER
, di
, REQUIRED
, x
, BT_REAL
, dd
, REQUIRED
);
1514 add_sym_3 ("bessel_yn", GFC_ISYM_YN2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1515 gfc_check_bessel_n2
, gfc_simplify_bessel_yn2
, gfc_resolve_bessel_n2
,
1516 "n1", BT_INTEGER
, di
, REQUIRED
,"n2", BT_INTEGER
, di
, REQUIRED
,
1517 x
, BT_REAL
, dr
, REQUIRED
);
1518 set_attr_value (3, true, true, true);
1520 make_generic ("bessel_yn", GFC_ISYM_YN
, GFC_STD_F2008
);
1522 add_sym_2 ("bge", GFC_ISYM_BGE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1523 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1524 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bge
, NULL
,
1525 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1527 make_generic ("bge", GFC_ISYM_BGE
, GFC_STD_F2008
);
1529 add_sym_2 ("bgt", GFC_ISYM_BGT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1530 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1531 gfc_check_bge_bgt_ble_blt
, gfc_simplify_bgt
, NULL
,
1532 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1534 make_generic ("bgt", GFC_ISYM_BGT
, GFC_STD_F2008
);
1536 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1537 gfc_check_i
, gfc_simplify_bit_size
, NULL
,
1538 i
, BT_INTEGER
, di
, REQUIRED
);
1540 make_generic ("bit_size", GFC_ISYM_BIT_SIZE
, GFC_STD_F95
);
1542 add_sym_2 ("ble", GFC_ISYM_BLE
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1543 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1544 gfc_check_bge_bgt_ble_blt
, gfc_simplify_ble
, NULL
,
1545 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1547 make_generic ("ble", GFC_ISYM_BLE
, GFC_STD_F2008
);
1549 add_sym_2 ("blt", GFC_ISYM_BLT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1550 BT_LOGICAL
, dl
, GFC_STD_F2008
,
1551 gfc_check_bge_bgt_ble_blt
, gfc_simplify_blt
, NULL
,
1552 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1554 make_generic ("blt", GFC_ISYM_BLT
, GFC_STD_F2008
);
1556 add_sym_2 ("btest", GFC_ISYM_BTEST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
1557 gfc_check_bitfcn
, gfc_simplify_btest
, gfc_resolve_btest
,
1558 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1560 make_generic ("btest", GFC_ISYM_BTEST
, GFC_STD_F95
);
1562 add_sym_2 ("ceiling", GFC_ISYM_CEILING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1563 gfc_check_a_ikind
, gfc_simplify_ceiling
, gfc_resolve_ceiling
,
1564 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1566 make_generic ("ceiling", GFC_ISYM_CEILING
, GFC_STD_F95
);
1568 add_sym_2 ("char", GFC_ISYM_CHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F77
,
1569 gfc_check_char
, gfc_simplify_char
, gfc_resolve_char
,
1570 i
, BT_INTEGER
, di
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1572 make_generic ("char", GFC_ISYM_CHAR
, GFC_STD_F77
);
1574 add_sym_1 ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
1575 GFC_STD_GNU
, gfc_check_chdir
, NULL
, gfc_resolve_chdir
,
1576 nm
, BT_CHARACTER
, dc
, REQUIRED
);
1578 make_generic ("chdir", GFC_ISYM_CHDIR
, GFC_STD_GNU
);
1580 add_sym_2 ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1581 di
, GFC_STD_GNU
, gfc_check_chmod
, NULL
, gfc_resolve_chmod
,
1582 nm
, BT_CHARACTER
, dc
, REQUIRED
, md
, BT_CHARACTER
, dc
, REQUIRED
);
1584 make_generic ("chmod", GFC_ISYM_CHMOD
, GFC_STD_GNU
);
1586 add_sym_3 ("cmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1587 gfc_check_cmplx
, gfc_simplify_cmplx
, gfc_resolve_cmplx
,
1588 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, OPTIONAL
,
1589 kind
, BT_INTEGER
, di
, OPTIONAL
);
1591 make_generic ("cmplx", GFC_ISYM_CMPLX
, GFC_STD_F77
);
1593 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
, CLASS_INQUIRY
,
1594 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
, NULL
, NULL
, NULL
);
1596 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT
,
1599 add_sym_2 ("complex", GFC_ISYM_COMPLEX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dz
, GFC_STD_GNU
,
1600 gfc_check_complex
, gfc_simplify_complex
, gfc_resolve_complex
,
1601 x
, BT_UNKNOWN
, dr
, REQUIRED
, y
, BT_UNKNOWN
, dr
, REQUIRED
);
1603 make_generic ("complex", GFC_ISYM_COMPLEX
, GFC_STD_GNU
);
1605 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1606 complex instead of the default complex. */
1608 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1609 gfc_check_dcmplx
, gfc_simplify_dcmplx
, gfc_resolve_dcmplx
,
1610 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, OPTIONAL
);
1612 make_generic ("dcmplx", GFC_ISYM_CMPLX
, GFC_STD_GNU
);
1614 add_sym_1 ("conjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1615 gfc_check_fn_c
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1616 z
, BT_COMPLEX
, dz
, REQUIRED
);
1618 add_sym_1 ("dconjg", GFC_ISYM_CONJG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1619 NULL
, gfc_simplify_conjg
, gfc_resolve_conjg
,
1620 z
, BT_COMPLEX
, dd
, REQUIRED
);
1622 make_generic ("conjg", GFC_ISYM_CONJG
, GFC_STD_F77
);
1624 add_sym_1 ("cos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1625 gfc_check_fn_rc
, gfc_simplify_cos
, gfc_resolve_cos
,
1626 x
, BT_REAL
, dr
, REQUIRED
);
1628 add_sym_1 ("dcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1629 gfc_check_fn_d
, gfc_simplify_cos
, gfc_resolve_cos
,
1630 x
, BT_REAL
, dd
, REQUIRED
);
1632 add_sym_1 ("ccos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1633 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1634 x
, BT_COMPLEX
, dz
, REQUIRED
);
1636 add_sym_1 ("zcos", GFC_ISYM_COS
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1637 NULL
, gfc_simplify_cos
, gfc_resolve_cos
,
1638 x
, BT_COMPLEX
, dd
, REQUIRED
);
1640 make_alias ("cdcos", GFC_STD_GNU
);
1642 make_generic ("cos", GFC_ISYM_COS
, GFC_STD_F77
);
1644 add_sym_1 ("cosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1645 gfc_check_fn_rc2008
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1646 x
, BT_REAL
, dr
, REQUIRED
);
1648 add_sym_1 ("dcosh", GFC_ISYM_COSH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1649 gfc_check_fn_d
, gfc_simplify_cosh
, gfc_resolve_cosh
,
1650 x
, BT_REAL
, dd
, REQUIRED
);
1652 make_generic ("cosh", GFC_ISYM_COSH
, GFC_STD_F77
);
1654 add_sym_3 ("count", GFC_ISYM_COUNT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1655 BT_INTEGER
, di
, GFC_STD_F95
,
1656 gfc_check_count
, gfc_simplify_count
, gfc_resolve_count
,
1657 msk
, BT_LOGICAL
, dl
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1658 kind
, BT_INTEGER
, di
, OPTIONAL
);
1660 make_generic ("count", GFC_ISYM_COUNT
, GFC_STD_F95
);
1662 add_sym_3 ("cshift", GFC_ISYM_CSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
,
1663 BT_REAL
, dr
, GFC_STD_F95
,
1664 gfc_check_cshift
, gfc_simplify_cshift
, gfc_resolve_cshift
,
1665 ar
, BT_REAL
, dr
, REQUIRED
,
1666 sh
, BT_INTEGER
, di
, REQUIRED
,
1667 dm
, BT_INTEGER
, ii
, OPTIONAL
);
1669 make_generic ("cshift", GFC_ISYM_CSHIFT
, GFC_STD_F95
);
1671 add_sym_1 ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1672 0, GFC_STD_GNU
, gfc_check_ctime
, NULL
, gfc_resolve_ctime
,
1673 tm
, BT_INTEGER
, di
, REQUIRED
);
1675 make_generic ("ctime", GFC_ISYM_CTIME
, GFC_STD_GNU
);
1677 add_sym_1 ("dble", GFC_ISYM_DBLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
1678 gfc_check_dble
, gfc_simplify_dble
, gfc_resolve_dble
,
1679 a
, BT_REAL
, dr
, REQUIRED
);
1681 make_generic ("dble", GFC_ISYM_DBLE
, GFC_STD_F77
);
1683 add_sym_1 ("digits", GFC_ISYM_DIGITS
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1684 gfc_check_digits
, gfc_simplify_digits
, NULL
,
1685 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1687 make_generic ("digits", GFC_ISYM_DIGITS
, GFC_STD_F95
);
1689 add_sym_2 ("dim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1690 gfc_check_a_p
, gfc_simplify_dim
, gfc_resolve_dim
,
1691 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1693 add_sym_2 ("idim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1694 NULL
, gfc_simplify_dim
, gfc_resolve_dim
,
1695 x
, BT_INTEGER
, di
, REQUIRED
, y
, BT_INTEGER
, di
, REQUIRED
);
1697 add_sym_2 ("ddim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1698 gfc_check_x_yd
, gfc_simplify_dim
, gfc_resolve_dim
,
1699 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, REQUIRED
);
1701 make_generic ("dim", GFC_ISYM_DIM
, GFC_STD_F77
);
1703 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
1704 GFC_STD_F95
, gfc_check_dot_product
, gfc_simplify_dot_product
, gfc_resolve_dot_product
,
1705 va
, BT_REAL
, dr
, REQUIRED
, vb
, BT_REAL
, dr
, REQUIRED
);
1707 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT
, GFC_STD_F95
);
1709 add_sym_2 ("dprod", GFC_ISYM_DPROD
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1710 gfc_check_dprod
, gfc_simplify_dprod
, gfc_resolve_dprod
,
1711 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1713 make_generic ("dprod", GFC_ISYM_DPROD
, GFC_STD_F77
);
1715 add_sym_1 ("dreal", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1716 BT_REAL
, dd
, GFC_STD_GNU
, NULL
, gfc_simplify_dreal
, NULL
,
1717 a
, BT_COMPLEX
, dd
, REQUIRED
);
1719 make_generic ("dreal", GFC_ISYM_REAL
, GFC_STD_GNU
);
1721 add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1722 BT_INTEGER
, di
, GFC_STD_F2008
,
1723 gfc_check_dshift
, gfc_simplify_dshiftl
, gfc_resolve_dshift
,
1724 i
, BT_INTEGER
, di
, REQUIRED
,
1725 j
, BT_INTEGER
, di
, REQUIRED
,
1726 sh
, BT_INTEGER
, di
, REQUIRED
);
1728 make_generic ("dshiftl", GFC_ISYM_DSHIFTL
, GFC_STD_F2008
);
1730 add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1731 BT_INTEGER
, di
, GFC_STD_F2008
,
1732 gfc_check_dshift
, gfc_simplify_dshiftr
, gfc_resolve_dshift
,
1733 i
, BT_INTEGER
, di
, REQUIRED
,
1734 j
, BT_INTEGER
, di
, REQUIRED
,
1735 sh
, BT_INTEGER
, di
, REQUIRED
);
1737 make_generic ("dshiftr", GFC_ISYM_DSHIFTR
, GFC_STD_F2008
);
1739 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1740 gfc_check_eoshift
, NULL
, gfc_resolve_eoshift
,
1741 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, ii
, REQUIRED
,
1742 bd
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1744 make_generic ("eoshift", GFC_ISYM_EOSHIFT
, GFC_STD_F95
);
1746 add_sym_1 ("epsilon", GFC_ISYM_EPSILON
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1747 gfc_check_x
, gfc_simplify_epsilon
, NULL
,
1748 x
, BT_REAL
, dr
, REQUIRED
);
1750 make_generic ("epsilon", GFC_ISYM_EPSILON
, GFC_STD_F95
);
1752 /* G77 compatibility for the ERF() and ERFC() functions. */
1753 add_sym_1 ("erf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1754 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erf
,
1755 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1757 add_sym_1 ("derf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1758 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erf
,
1759 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1761 make_generic ("erf", GFC_ISYM_ERF
, GFC_STD_F2008
);
1763 add_sym_1 ("erfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1764 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erfc
,
1765 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1767 add_sym_1 ("derfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1768 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erfc
,
1769 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1771 make_generic ("erfc", GFC_ISYM_ERFC
, GFC_STD_F2008
);
1773 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1774 BT_REAL
, dr
, GFC_STD_F2008
, gfc_check_fn_r
,
1775 gfc_simplify_erfc_scaled
, gfc_resolve_g77_math1
, x
, BT_REAL
,
1778 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, GFC_STD_F2008
);
1780 /* G77 compatibility */
1781 add_sym_1 ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1782 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1783 x
, BT_REAL
, 4, REQUIRED
);
1785 make_generic ("dtime", GFC_ISYM_DTIME
, GFC_STD_GNU
);
1787 add_sym_1 ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1788 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1789 x
, BT_REAL
, 4, REQUIRED
);
1791 make_generic ("etime", GFC_ISYM_ETIME
, GFC_STD_GNU
);
1793 add_sym_1 ("exp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1794 gfc_check_fn_rc
, gfc_simplify_exp
, gfc_resolve_exp
,
1795 x
, BT_REAL
, dr
, REQUIRED
);
1797 add_sym_1 ("dexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1798 gfc_check_fn_d
, gfc_simplify_exp
, gfc_resolve_exp
,
1799 x
, BT_REAL
, dd
, REQUIRED
);
1801 add_sym_1 ("cexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1802 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1803 x
, BT_COMPLEX
, dz
, REQUIRED
);
1805 add_sym_1 ("zexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1806 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1807 x
, BT_COMPLEX
, dd
, REQUIRED
);
1809 make_alias ("cdexp", GFC_STD_GNU
);
1811 make_generic ("exp", GFC_ISYM_EXP
, GFC_STD_F77
);
1813 add_sym_1 ("exponent", GFC_ISYM_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1814 gfc_check_x
, gfc_simplify_exponent
, gfc_resolve_exponent
,
1815 x
, BT_REAL
, dr
, REQUIRED
);
1817 make_generic ("exponent", GFC_ISYM_EXPONENT
, GFC_STD_F95
);
1819 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF
, CLASS_INQUIRY
,
1820 ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1821 gfc_check_same_type_as
, gfc_simplify_extends_type_of
,
1822 gfc_resolve_extends_type_of
,
1823 a
, BT_UNKNOWN
, 0, REQUIRED
,
1824 mo
, BT_UNKNOWN
, 0, REQUIRED
);
1826 add_sym_0 ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1827 dc
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_fdate
);
1829 make_generic ("fdate", GFC_ISYM_FDATE
, GFC_STD_GNU
);
1831 add_sym_2 ("floor", GFC_ISYM_FLOOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1832 gfc_check_a_ikind
, gfc_simplify_floor
, gfc_resolve_floor
,
1833 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1835 make_generic ("floor", GFC_ISYM_FLOOR
, GFC_STD_F95
);
1837 /* G77 compatible fnum */
1838 add_sym_1 ("fnum", GFC_ISYM_FNUM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1839 di
, GFC_STD_GNU
, gfc_check_fnum
, NULL
, gfc_resolve_fnum
,
1840 ut
, BT_INTEGER
, di
, REQUIRED
);
1842 make_generic ("fnum", GFC_ISYM_FNUM
, GFC_STD_GNU
);
1844 add_sym_1 ("fraction", GFC_ISYM_FRACTION
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1845 gfc_check_x
, gfc_simplify_fraction
, gfc_resolve_fraction
,
1846 x
, BT_REAL
, dr
, REQUIRED
);
1848 make_generic ("fraction", GFC_ISYM_FRACTION
, GFC_STD_F95
);
1850 add_sym_2_intent ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
1851 BT_INTEGER
, di
, GFC_STD_GNU
,
1852 gfc_check_fstat
, NULL
, gfc_resolve_fstat
,
1853 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1854 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
1856 make_generic ("fstat", GFC_ISYM_FSTAT
, GFC_STD_GNU
);
1858 add_sym_1 ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1859 ii
, GFC_STD_GNU
, gfc_check_ftell
, NULL
, gfc_resolve_ftell
,
1860 ut
, BT_INTEGER
, di
, REQUIRED
);
1862 make_generic ("ftell", GFC_ISYM_FTELL
, GFC_STD_GNU
);
1864 add_sym_2_intent ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, ACTUAL_NO
,
1865 BT_INTEGER
, di
, GFC_STD_GNU
,
1866 gfc_check_fgetputc
, NULL
, gfc_resolve_fgetc
,
1867 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1868 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1870 make_generic ("fgetc", GFC_ISYM_FGETC
, GFC_STD_GNU
);
1872 add_sym_1_intent ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1873 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fget
,
1874 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1876 make_generic ("fget", GFC_ISYM_FGET
, GFC_STD_GNU
);
1878 add_sym_2 ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1879 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fputc
,
1880 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
1882 make_generic ("fputc", GFC_ISYM_FPUTC
, GFC_STD_GNU
);
1884 add_sym_1 ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1885 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fput
,
1886 c
, BT_CHARACTER
, dc
, REQUIRED
);
1888 make_generic ("fput", GFC_ISYM_FPUT
, GFC_STD_GNU
);
1890 add_sym_1 ("gamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1891 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_gamma
,
1892 gfc_resolve_gamma
, x
, BT_REAL
, dr
, REQUIRED
);
1894 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1895 gfc_check_fn_d
, gfc_simplify_gamma
, gfc_resolve_gamma
,
1896 x
, BT_REAL
, dr
, REQUIRED
);
1898 make_generic ("gamma", GFC_ISYM_TGAMMA
, GFC_STD_F2008
);
1900 /* Unix IDs (g77 compatibility) */
1901 add_sym_1 ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1902 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getcwd
,
1903 c
, BT_CHARACTER
, dc
, REQUIRED
);
1905 make_generic ("getcwd", GFC_ISYM_GETCWD
, GFC_STD_GNU
);
1907 add_sym_0 ("getgid", GFC_ISYM_GETGID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1908 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getgid
);
1910 make_generic ("getgid", GFC_ISYM_GETGID
, GFC_STD_GNU
);
1912 add_sym_0 ("getpid", GFC_ISYM_GETPID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1913 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getpid
);
1915 make_generic ("getpid", GFC_ISYM_GETPID
, GFC_STD_GNU
);
1917 add_sym_0 ("getuid", GFC_ISYM_GETUID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1918 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getuid
);
1920 make_generic ("getuid", GFC_ISYM_GETUID
, GFC_STD_GNU
);
1922 add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, ACTUAL_NO
,
1923 BT_INTEGER
, di
, GFC_STD_GNU
,
1924 gfc_check_hostnm
, NULL
, gfc_resolve_hostnm
,
1925 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1927 make_generic ("hostnm", GFC_ISYM_HOSTNM
, GFC_STD_GNU
);
1929 add_sym_1 ("huge", GFC_ISYM_HUGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1930 gfc_check_huge
, gfc_simplify_huge
, NULL
,
1931 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1933 make_generic ("huge", GFC_ISYM_HUGE
, GFC_STD_F95
);
1935 add_sym_2 ("hypot", GFC_ISYM_HYPOT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1936 BT_REAL
, dr
, GFC_STD_F2008
,
1937 gfc_check_hypot
, gfc_simplify_hypot
, gfc_resolve_hypot
,
1938 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1940 make_generic ("hypot", GFC_ISYM_HYPOT
, GFC_STD_F2008
);
1942 add_sym_2 ("iachar", GFC_ISYM_IACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1943 BT_INTEGER
, di
, GFC_STD_F95
,
1944 gfc_check_ichar_iachar
, gfc_simplify_iachar
, gfc_resolve_iachar
,
1945 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1947 make_generic ("iachar", GFC_ISYM_IACHAR
, GFC_STD_F95
);
1949 add_sym_2 ("iand", GFC_ISYM_IAND
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1950 gfc_check_iand
, gfc_simplify_iand
, gfc_resolve_iand
,
1951 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1953 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
1955 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
1956 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
1957 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
1959 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
1961 add_sym_3red ("iall", GFC_ISYM_IALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1962 gfc_check_transf_bit_intrins
, gfc_simplify_iall
, gfc_resolve_iall
,
1963 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1964 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
1966 make_generic ("iall", GFC_ISYM_IALL
, GFC_STD_F2008
);
1968 add_sym_3red ("iany", GFC_ISYM_IANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1969 gfc_check_transf_bit_intrins
, gfc_simplify_iany
, gfc_resolve_iany
,
1970 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1971 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
1973 make_generic ("iany", GFC_ISYM_IANY
, GFC_STD_F2008
);
1975 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1976 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
1978 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
1980 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1981 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
1982 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1984 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
1986 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1987 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
1988 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
1989 ln
, BT_INTEGER
, di
, REQUIRED
);
1991 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
1993 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1994 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
1995 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1997 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
1999 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2000 BT_INTEGER
, di
, GFC_STD_F77
,
2001 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
2002 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2004 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
2006 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2007 gfc_check_ieor
, gfc_simplify_ieor
, gfc_resolve_ieor
,
2008 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2010 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
2012 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2013 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
2014 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2016 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
2018 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2019 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
2021 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
2023 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2024 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
2025 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
2027 /* The resolution function for INDEX is called gfc_resolve_index_func
2028 because the name gfc_resolve_index is already used in resolve.c. */
2029 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
2030 BT_INTEGER
, di
, GFC_STD_F77
,
2031 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
2032 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
2033 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2035 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
2037 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2038 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
2039 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2041 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2042 NULL
, gfc_simplify_ifix
, NULL
,
2043 a
, BT_REAL
, dr
, REQUIRED
);
2045 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2046 NULL
, gfc_simplify_idint
, NULL
,
2047 a
, BT_REAL
, dd
, REQUIRED
);
2049 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
2051 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2052 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
2053 a
, BT_REAL
, dr
, REQUIRED
);
2055 make_alias ("short", GFC_STD_GNU
);
2057 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
2059 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2060 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
2061 a
, BT_REAL
, dr
, REQUIRED
);
2063 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
2065 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2066 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
2067 a
, BT_REAL
, dr
, REQUIRED
);
2069 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
2071 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2072 gfc_check_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
2073 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2075 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
2077 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2078 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
2079 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2081 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
2083 add_sym_3red ("iparity", GFC_ISYM_IPARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2084 gfc_check_transf_bit_intrins
, gfc_simplify_iparity
, gfc_resolve_iparity
,
2085 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2086 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2088 make_generic ("iparity", GFC_ISYM_IPARITY
, GFC_STD_F2008
);
2090 /* The following function is for G77 compatibility. */
2091 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2092 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
2093 i
, BT_INTEGER
, 4, OPTIONAL
);
2095 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
2097 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2098 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
2099 ut
, BT_INTEGER
, di
, REQUIRED
);
2101 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
2103 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
2104 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2105 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
2106 i
, BT_INTEGER
, 0, REQUIRED
);
2108 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
2110 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
2111 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2112 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
2113 i
, BT_INTEGER
, 0, REQUIRED
);
2115 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
2117 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2118 BT_LOGICAL
, dl
, GFC_STD_GNU
,
2119 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
2120 x
, BT_REAL
, 0, REQUIRED
);
2122 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
2124 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2125 BT_INTEGER
, di
, GFC_STD_GNU
,
2126 gfc_check_ishft
, gfc_simplify_rshift
, gfc_resolve_rshift
,
2127 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2129 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
2131 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2132 BT_INTEGER
, di
, GFC_STD_GNU
,
2133 gfc_check_ishft
, gfc_simplify_lshift
, gfc_resolve_lshift
,
2134 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2136 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
2138 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2139 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
2140 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2142 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
2144 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2145 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
2146 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
2147 sz
, BT_INTEGER
, di
, OPTIONAL
);
2149 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
2151 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2152 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, gfc_resolve_kill
,
2153 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2155 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
2157 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2158 gfc_check_kind
, gfc_simplify_kind
, NULL
,
2159 x
, BT_REAL
, dr
, REQUIRED
);
2161 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
2163 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2164 BT_INTEGER
, di
, GFC_STD_F95
,
2165 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
2166 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
2167 kind
, BT_INTEGER
, di
, OPTIONAL
);
2169 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
2171 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2172 BT_INTEGER
, di
, GFC_STD_F2008
,
2173 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
2174 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2175 kind
, BT_INTEGER
, di
, OPTIONAL
);
2177 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
2179 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2180 BT_INTEGER
, di
, GFC_STD_F2008
,
2181 gfc_check_i
, gfc_simplify_leadz
, NULL
,
2182 i
, BT_INTEGER
, di
, REQUIRED
);
2184 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
2186 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
2187 BT_INTEGER
, di
, GFC_STD_F77
,
2188 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
2189 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2191 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
2193 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2194 BT_INTEGER
, di
, GFC_STD_F95
,
2195 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
2196 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2198 make_alias ("lnblnk", GFC_STD_GNU
);
2200 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
2202 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2204 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2205 x
, BT_REAL
, dr
, REQUIRED
);
2207 make_alias ("log_gamma", GFC_STD_F2008
);
2209 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2210 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2211 x
, BT_REAL
, dr
, REQUIRED
);
2213 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2214 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2215 x
, BT_REAL
, dr
, REQUIRED
);
2217 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2220 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2221 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2222 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2224 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2226 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2227 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2228 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2230 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2232 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2233 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2234 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2236 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2238 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2239 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2240 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2242 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2244 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2245 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2246 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2248 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2250 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2251 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2252 x
, BT_REAL
, dr
, REQUIRED
);
2254 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2255 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2256 x
, BT_REAL
, dr
, REQUIRED
);
2258 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2259 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2260 x
, BT_REAL
, dd
, REQUIRED
);
2262 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2263 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2264 x
, BT_COMPLEX
, dz
, REQUIRED
);
2266 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2267 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2268 x
, BT_COMPLEX
, dd
, REQUIRED
);
2270 make_alias ("cdlog", GFC_STD_GNU
);
2272 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2274 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2275 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2276 x
, BT_REAL
, dr
, REQUIRED
);
2278 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2279 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2280 x
, BT_REAL
, dr
, REQUIRED
);
2282 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2283 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2284 x
, BT_REAL
, dd
, REQUIRED
);
2286 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2288 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2289 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2290 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2292 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2294 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
2295 BT_INTEGER
, di
, GFC_STD_GNU
,
2296 gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2297 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2298 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2300 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2302 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2303 GFC_STD_GNU
, gfc_check_malloc
, NULL
, NULL
,
2304 sz
, BT_INTEGER
, di
, REQUIRED
);
2306 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2308 add_sym_2 ("maskl", GFC_ISYM_MASKL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2309 BT_INTEGER
, di
, GFC_STD_F2008
,
2310 gfc_check_mask
, gfc_simplify_maskl
, gfc_resolve_mask
,
2311 i
, BT_INTEGER
, di
, REQUIRED
,
2312 kind
, BT_INTEGER
, di
, OPTIONAL
);
2314 make_generic ("maskl", GFC_ISYM_MASKL
, GFC_STD_F2008
);
2316 add_sym_2 ("maskr", GFC_ISYM_MASKR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2317 BT_INTEGER
, di
, GFC_STD_F2008
,
2318 gfc_check_mask
, gfc_simplify_maskr
, gfc_resolve_mask
,
2319 i
, BT_INTEGER
, di
, REQUIRED
,
2320 kind
, BT_INTEGER
, di
, OPTIONAL
);
2322 make_generic ("maskr", GFC_ISYM_MASKR
, GFC_STD_F2008
);
2324 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2325 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2326 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2328 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2330 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2331 int(max). The max function must take at least two arguments. */
2333 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2334 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2335 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2337 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2338 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2339 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2341 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2342 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2343 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2345 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2346 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2347 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2349 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2350 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2351 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2353 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2354 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2355 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2357 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2359 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2360 GFC_STD_F95
, gfc_check_x
, gfc_simplify_maxexponent
, NULL
,
2361 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2363 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2365 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2366 gfc_check_minloc_maxloc
, NULL
, gfc_resolve_maxloc
,
2367 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2368 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2370 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2372 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2373 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2374 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2375 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2377 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2379 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2380 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2382 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2384 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2385 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2387 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2389 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2390 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2391 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2392 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2394 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2396 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2397 BT_INTEGER
, di
, GFC_STD_F2008
,
2398 gfc_check_merge_bits
, gfc_simplify_merge_bits
,
2399 gfc_resolve_merge_bits
,
2400 i
, BT_INTEGER
, di
, REQUIRED
,
2401 j
, BT_INTEGER
, di
, REQUIRED
,
2402 msk
, BT_INTEGER
, di
, REQUIRED
);
2404 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS
, GFC_STD_F2008
);
2406 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2409 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2410 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2411 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2413 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2414 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2415 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2417 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2418 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2419 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2421 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2422 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2423 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2425 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2426 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2427 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2429 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2430 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2431 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2433 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2435 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2436 GFC_STD_F95
, gfc_check_x
, gfc_simplify_minexponent
, NULL
,
2437 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2439 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2441 add_sym_3ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2442 gfc_check_minloc_maxloc
, NULL
, gfc_resolve_minloc
,
2443 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2444 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2446 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2448 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2449 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2450 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2451 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2453 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2455 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2456 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2457 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2459 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2460 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2461 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2463 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2464 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2465 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2467 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2469 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2470 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2471 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2473 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2475 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2476 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2477 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2479 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2481 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2482 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2483 a
, BT_CHARACTER
, dc
, REQUIRED
);
2485 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2487 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2488 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2489 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2491 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2492 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2493 a
, BT_REAL
, dd
, REQUIRED
);
2495 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2497 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2498 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2499 i
, BT_INTEGER
, di
, REQUIRED
);
2501 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2503 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2504 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2505 x
, BT_REAL
, dr
, REQUIRED
,
2506 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2508 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2510 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2511 gfc_check_null
, gfc_simplify_null
, NULL
,
2512 mo
, BT_INTEGER
, di
, OPTIONAL
);
2514 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2516 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES
, CLASS_INQUIRY
, ACTUAL_NO
,
2517 BT_INTEGER
, di
, GFC_STD_F2008
,
2518 gfc_check_num_images
, gfc_simplify_num_images
, NULL
,
2519 dist
, BT_INTEGER
, di
, OPTIONAL
,
2520 failed
, BT_LOGICAL
, dl
, OPTIONAL
);
2522 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2523 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2524 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2525 v
, BT_REAL
, dr
, OPTIONAL
);
2527 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2530 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2531 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2532 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2533 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2535 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2537 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2538 BT_INTEGER
, di
, GFC_STD_F2008
,
2539 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2540 i
, BT_INTEGER
, di
, REQUIRED
);
2542 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2544 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2545 BT_INTEGER
, di
, GFC_STD_F2008
,
2546 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2547 i
, BT_INTEGER
, di
, REQUIRED
);
2549 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2551 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2552 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2553 x
, BT_UNKNOWN
, 0, REQUIRED
);
2555 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2557 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2558 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2559 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2561 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2563 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2564 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2565 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2566 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2568 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2570 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2571 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2572 x
, BT_UNKNOWN
, 0, REQUIRED
);
2574 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2576 /* The following function is for G77 compatibility. */
2577 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2578 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2579 i
, BT_INTEGER
, 4, OPTIONAL
);
2581 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2582 use slightly different shoddy multiplicative congruential PRNG. */
2583 make_alias ("ran", GFC_STD_GNU
);
2585 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2587 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2588 gfc_check_range
, gfc_simplify_range
, NULL
,
2589 x
, BT_REAL
, dr
, REQUIRED
);
2591 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2593 add_sym_1 ("rank", GFC_ISYM_RANK
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2594 GFC_STD_F2008_TS
, gfc_check_rank
, gfc_simplify_rank
, gfc_resolve_rank
,
2595 a
, BT_REAL
, dr
, REQUIRED
);
2596 make_generic ("rank", GFC_ISYM_RANK
, GFC_STD_F2008_TS
);
2598 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2599 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2600 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2602 /* This provides compatibility with g77. */
2603 add_sym_1 ("realpart", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2604 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2605 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2607 add_sym_1 ("float", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2608 gfc_check_float
, gfc_simplify_float
, NULL
,
2609 a
, BT_INTEGER
, di
, REQUIRED
);
2611 add_sym_1 ("dfloat", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2612 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2613 a
, BT_REAL
, dr
, REQUIRED
);
2615 add_sym_1 ("sngl", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2616 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2617 a
, BT_REAL
, dd
, REQUIRED
);
2619 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2621 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2622 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2623 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2625 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2627 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2628 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2629 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2631 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2633 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2634 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2635 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2636 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2638 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2640 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2641 gfc_check_x
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2642 x
, BT_REAL
, dr
, REQUIRED
);
2644 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2646 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2647 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2648 gfc_check_same_type_as
, gfc_simplify_same_type_as
, NULL
,
2649 a
, BT_UNKNOWN
, 0, REQUIRED
,
2650 b
, BT_UNKNOWN
, 0, REQUIRED
);
2652 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2653 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2654 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2656 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2658 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2659 BT_INTEGER
, di
, GFC_STD_F95
,
2660 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2661 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2662 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2664 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2666 /* Added for G77 compatibility garbage. */
2667 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2668 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2670 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2672 /* Added for G77 compatibility. */
2673 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2674 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2675 x
, BT_REAL
, dr
, REQUIRED
);
2677 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2679 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2680 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2681 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2682 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2684 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2686 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2687 GFC_STD_F95
, gfc_check_selected_int_kind
,
2688 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2690 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2692 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2693 GFC_STD_F95
, gfc_check_selected_real_kind
,
2694 gfc_simplify_selected_real_kind
, NULL
,
2695 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2696 "radix", BT_INTEGER
, di
, OPTIONAL
);
2698 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2700 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2701 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2702 gfc_resolve_set_exponent
,
2703 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2705 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2707 add_sym_2 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2708 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2709 src
, BT_REAL
, dr
, REQUIRED
,
2710 kind
, BT_INTEGER
, di
, OPTIONAL
);
2712 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2714 add_sym_2 ("shifta", GFC_ISYM_SHIFTA
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2715 BT_INTEGER
, di
, GFC_STD_F2008
,
2716 gfc_check_shift
, gfc_simplify_shifta
, gfc_resolve_shift
,
2717 i
, BT_INTEGER
, di
, REQUIRED
,
2718 sh
, BT_INTEGER
, di
, REQUIRED
);
2720 make_generic ("shifta", GFC_ISYM_SHIFTA
, GFC_STD_F2008
);
2722 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2723 BT_INTEGER
, di
, GFC_STD_F2008
,
2724 gfc_check_shift
, gfc_simplify_shiftl
, gfc_resolve_shift
,
2725 i
, BT_INTEGER
, di
, REQUIRED
,
2726 sh
, BT_INTEGER
, di
, REQUIRED
);
2728 make_generic ("shiftl", GFC_ISYM_SHIFTL
, GFC_STD_F2008
);
2730 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2731 BT_INTEGER
, di
, GFC_STD_F2008
,
2732 gfc_check_shift
, gfc_simplify_shiftr
, gfc_resolve_shift
,
2733 i
, BT_INTEGER
, di
, REQUIRED
,
2734 sh
, BT_INTEGER
, di
, REQUIRED
);
2736 make_generic ("shiftr", GFC_ISYM_SHIFTR
, GFC_STD_F2008
);
2738 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2739 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
2740 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
2742 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2743 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
2744 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2746 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2747 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
2748 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
2750 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
2752 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2753 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
2754 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_VOID
, 0, REQUIRED
);
2756 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
2758 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2759 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
2760 x
, BT_REAL
, dr
, REQUIRED
);
2762 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2763 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
2764 x
, BT_REAL
, dd
, REQUIRED
);
2766 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2767 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2768 x
, BT_COMPLEX
, dz
, REQUIRED
);
2770 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2771 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2772 x
, BT_COMPLEX
, dd
, REQUIRED
);
2774 make_alias ("cdsin", GFC_STD_GNU
);
2776 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
2778 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2779 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2780 x
, BT_REAL
, dr
, REQUIRED
);
2782 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2783 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2784 x
, BT_REAL
, dd
, REQUIRED
);
2786 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
2788 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2789 BT_INTEGER
, di
, GFC_STD_F95
,
2790 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
2791 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2792 kind
, BT_INTEGER
, di
, OPTIONAL
);
2794 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
2796 /* Obtain the stride for a given dimensions; to be used only internally.
2797 "make_from_module" makes it inaccessible for external users. */
2798 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE
, CLASS_INQUIRY
, ACTUAL_NO
,
2799 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_GNU
,
2800 NULL
, NULL
, gfc_resolve_stride
,
2801 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
2804 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2805 BT_INTEGER
, ii
, GFC_STD_GNU
,
2806 gfc_check_sizeof
, gfc_simplify_sizeof
, NULL
,
2807 x
, BT_UNKNOWN
, 0, REQUIRED
);
2809 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
2811 /* The following functions are part of ISO_C_BINDING. */
2812 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
,
2813 BT_LOGICAL
, dl
, GFC_STD_F2003
, gfc_check_c_associated
, NULL
, NULL
,
2814 "C_PTR_1", BT_VOID
, 0, REQUIRED
,
2815 "C_PTR_2", BT_VOID
, 0, OPTIONAL
);
2818 add_sym_1 ("c_loc", GFC_ISYM_C_LOC
, CLASS_INQUIRY
, ACTUAL_NO
,
2819 BT_VOID
, 0, GFC_STD_F2003
,
2820 gfc_check_c_loc
, NULL
, gfc_resolve_c_loc
,
2821 x
, BT_UNKNOWN
, 0, REQUIRED
);
2824 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC
, CLASS_INQUIRY
, ACTUAL_NO
,
2825 BT_VOID
, 0, GFC_STD_F2003
,
2826 gfc_check_c_funloc
, NULL
, gfc_resolve_c_funloc
,
2827 x
, BT_UNKNOWN
, 0, REQUIRED
);
2830 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2831 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_F2008
,
2832 gfc_check_c_sizeof
, gfc_simplify_sizeof
, NULL
,
2833 x
, BT_UNKNOWN
, 0, REQUIRED
);
2836 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
2837 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS
, CLASS_INQUIRY
,
2838 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
2839 NULL
, gfc_simplify_compiler_options
, NULL
);
2842 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION
, CLASS_INQUIRY
,
2843 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
2844 NULL
, gfc_simplify_compiler_version
, NULL
);
2847 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2848 gfc_check_x
, gfc_simplify_spacing
, gfc_resolve_spacing
,
2849 x
, BT_REAL
, dr
, REQUIRED
);
2851 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
2853 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2854 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
2855 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
2856 ncopies
, BT_INTEGER
, di
, REQUIRED
);
2858 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
2860 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2861 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2862 x
, BT_REAL
, dr
, REQUIRED
);
2864 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2865 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2866 x
, BT_REAL
, dd
, REQUIRED
);
2868 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2869 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2870 x
, BT_COMPLEX
, dz
, REQUIRED
);
2872 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2873 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2874 x
, BT_COMPLEX
, dd
, REQUIRED
);
2876 make_alias ("cdsqrt", GFC_STD_GNU
);
2878 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
2880 add_sym_2_intent ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
,
2881 BT_INTEGER
, di
, GFC_STD_GNU
,
2882 gfc_check_stat
, NULL
, gfc_resolve_stat
,
2883 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2884 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2886 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
2888 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2889 BT_INTEGER
, di
, GFC_STD_F2008
,
2890 gfc_check_storage_size
, gfc_simplify_storage_size
,
2891 gfc_resolve_storage_size
,
2892 a
, BT_UNKNOWN
, 0, REQUIRED
,
2893 kind
, BT_INTEGER
, di
, OPTIONAL
);
2895 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2896 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
2897 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2898 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2900 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
2902 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2903 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
2904 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2906 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
2908 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2909 GFC_STD_GNU
, NULL
, NULL
, NULL
,
2910 com
, BT_CHARACTER
, dc
, REQUIRED
);
2912 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
2914 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2915 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
2916 x
, BT_REAL
, dr
, REQUIRED
);
2918 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2919 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
2920 x
, BT_REAL
, dd
, REQUIRED
);
2922 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
2924 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2925 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
2926 x
, BT_REAL
, dr
, REQUIRED
);
2928 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2929 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
2930 x
, BT_REAL
, dd
, REQUIRED
);
2932 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
2934 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2935 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
2936 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2937 dist
, BT_INTEGER
, di
, OPTIONAL
);
2939 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2940 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
2942 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
2944 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2945 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
2947 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
2949 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2950 gfc_check_x
, gfc_simplify_tiny
, NULL
,
2951 x
, BT_REAL
, dr
, REQUIRED
);
2953 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
2955 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2956 BT_INTEGER
, di
, GFC_STD_F2008
,
2957 gfc_check_i
, gfc_simplify_trailz
, NULL
,
2958 i
, BT_INTEGER
, di
, REQUIRED
);
2960 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
2962 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2963 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
2964 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
2965 sz
, BT_INTEGER
, di
, OPTIONAL
);
2967 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
2969 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2970 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
2971 m
, BT_REAL
, dr
, REQUIRED
);
2973 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
2975 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2976 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
2977 stg
, BT_CHARACTER
, dc
, REQUIRED
);
2979 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
2981 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
2982 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
2983 ut
, BT_INTEGER
, di
, REQUIRED
);
2985 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
2987 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2988 BT_INTEGER
, di
, GFC_STD_F95
,
2989 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
2990 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2991 kind
, BT_INTEGER
, di
, OPTIONAL
);
2993 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
2995 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2996 BT_INTEGER
, di
, GFC_STD_F2008
,
2997 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
2998 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2999 kind
, BT_INTEGER
, di
, OPTIONAL
);
3001 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
3003 /* g77 compatibility for UMASK. */
3004 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3005 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
3006 msk
, BT_INTEGER
, di
, REQUIRED
);
3008 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
3010 /* g77 compatibility for UNLINK. */
3011 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3012 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
3013 "path", BT_CHARACTER
, dc
, REQUIRED
);
3015 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
3017 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3018 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
3019 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
3020 f
, BT_REAL
, dr
, REQUIRED
);
3022 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
3024 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3025 BT_INTEGER
, di
, GFC_STD_F95
,
3026 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
3027 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
3028 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
3030 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
3032 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
3033 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
3034 x
, BT_UNKNOWN
, 0, REQUIRED
);
3036 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
3038 /* The following function is internally used for coarray libray functions.
3039 "make_from_module" makes it inaccessible for external users. */
3040 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET
, CLASS_IMPURE
, ACTUAL_NO
,
3041 BT_REAL
, dr
, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3042 x
, BT_REAL
, dr
, REQUIRED
);
3047 /* Add intrinsic subroutines. */
3050 add_subroutines (void)
3052 /* Argument names as in the standard (to be used as argument keywords). */
3054 *a
= "a", *h
= "harvest", *dt
= "date", *vl
= "values", *pt
= "put",
3055 *c
= "count", *tm
= "time", *tp
= "topos", *gt
= "get",
3056 *t
= "to", *zn
= "zone", *fp
= "frompos", *cm
= "count_max",
3057 *f
= "from", *sz
= "size", *ln
= "len", *cr
= "count_rate",
3058 *com
= "command", *length
= "length", *st
= "status",
3059 *val
= "value", *num
= "number", *name
= "name",
3060 *trim_name
= "trim_name", *ut
= "unit", *han
= "handler",
3061 *sec
= "seconds", *res
= "result", *of
= "offset", *md
= "mode",
3062 *whence
= "whence", *pos
= "pos", *ptr
= "ptr", *p1
= "path1",
3063 *p2
= "path2", *msk
= "mask", *old
= "old", *result_image
= "result_image",
3064 *stat
= "stat", *errmsg
= "errmsg";
3066 int di
, dr
, dc
, dl
, ii
;
3068 di
= gfc_default_integer_kind
;
3069 dr
= gfc_default_real_kind
;
3070 dc
= gfc_default_character_kind
;
3071 dl
= gfc_default_logical_kind
;
3072 ii
= gfc_index_integer_kind
;
3074 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
3078 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF
, CLASS_ATOMIC
,
3079 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3080 gfc_check_atomic_def
, NULL
, gfc_resolve_atomic_def
,
3081 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3082 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3083 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3085 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF
, CLASS_ATOMIC
,
3086 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3087 gfc_check_atomic_ref
, NULL
, gfc_resolve_atomic_ref
,
3088 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3089 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3090 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3092 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS
, CLASS_ATOMIC
,
3093 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3094 gfc_check_atomic_cas
, NULL
, NULL
,
3095 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3096 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3097 "compare", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3098 "new", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3099 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3101 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD
, CLASS_ATOMIC
,
3102 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3103 gfc_check_atomic_op
, NULL
, NULL
,
3104 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3105 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3106 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3108 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND
, CLASS_ATOMIC
,
3109 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3110 gfc_check_atomic_op
, NULL
, NULL
,
3111 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3112 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3113 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3115 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR
, CLASS_ATOMIC
,
3116 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3117 gfc_check_atomic_op
, NULL
, NULL
,
3118 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3119 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3120 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3122 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR
, CLASS_ATOMIC
,
3123 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3124 gfc_check_atomic_op
, NULL
, NULL
,
3125 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3126 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3127 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3129 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD
, CLASS_ATOMIC
,
3130 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3131 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3132 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3133 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3134 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3135 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3137 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND
, CLASS_ATOMIC
,
3138 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3139 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3140 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3141 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3142 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3143 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3145 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR
, CLASS_ATOMIC
,
3146 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3147 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3148 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3149 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3150 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3151 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3153 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR
, CLASS_ATOMIC
,
3154 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3155 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3156 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3157 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3158 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3159 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3161 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE
, GFC_STD_GNU
, NULL
);
3163 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3164 GFC_STD_F95
, gfc_check_cpu_time
, NULL
, gfc_resolve_cpu_time
,
3165 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3167 /* More G77 compatibility garbage. */
3168 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3169 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
3170 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3171 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3173 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3174 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
3175 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3177 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3178 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
3179 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3181 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3182 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
3183 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3184 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3186 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3187 GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
3188 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3189 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3191 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3192 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
3193 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3195 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3196 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
3197 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3198 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3200 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3201 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
3202 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3203 md
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3204 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3206 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
3207 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
3208 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3209 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3210 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3211 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3213 /* More G77 compatibility garbage. */
3214 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3215 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
3216 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3217 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3219 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3220 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
3221 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3222 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3224 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
3225 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
3226 NULL
, NULL
, gfc_resolve_execute_command_line
,
3227 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3228 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
3229 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
3230 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3231 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3233 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3234 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
3235 dt
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3237 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3238 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
3239 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3241 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3242 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
3243 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3244 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3246 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
3247 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3248 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3249 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3251 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
3252 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
3253 pos
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3254 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3256 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
3257 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
3258 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3260 /* F2003 commandline routines. */
3262 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
3263 BT_UNKNOWN
, 0, GFC_STD_F2003
,
3264 NULL
, NULL
, gfc_resolve_get_command
,
3265 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3266 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3267 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3269 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
3270 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
3271 gfc_resolve_get_command_argument
,
3272 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3273 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3274 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3275 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3277 /* F2003 subroutine to get environment variables. */
3279 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
3280 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
3281 NULL
, NULL
, gfc_resolve_get_environment_variable
,
3282 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3283 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3284 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3285 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3286 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
3288 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
, BT_UNKNOWN
, 0,
3290 gfc_check_move_alloc
, NULL
, NULL
,
3291 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
3292 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3294 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
3295 GFC_STD_F95
, gfc_check_mvbits
, NULL
, gfc_resolve_mvbits
,
3296 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3297 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3298 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3299 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3300 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3302 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
3303 BT_UNKNOWN
, 0, GFC_STD_F95
,
3304 gfc_check_random_number
, NULL
, gfc_resolve_random_number
,
3305 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3307 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
3308 BT_UNKNOWN
, 0, GFC_STD_F95
,
3309 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
3310 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3311 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3312 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3314 /* The following subroutines are part of ISO_C_BINDING. */
3316 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3317 GFC_STD_F2003
, gfc_check_c_f_pointer
, NULL
, NULL
,
3318 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3319 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
,
3320 "shape", BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3323 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER
, CLASS_IMPURE
,
3324 BT_UNKNOWN
, 0, GFC_STD_F2003
, gfc_check_c_f_procpointer
,
3326 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3327 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3330 /* Internal subroutine for emitting a runtime error. */
3332 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR
, CLASS_IMPURE
,
3333 BT_UNKNOWN
, 0, GFC_STD_GNU
,
3334 gfc_check_fe_runtime_error
, NULL
, gfc_resolve_fe_runtime_error
,
3335 "msg", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3339 make_from_module ();
3341 /* Coarray collectives. */
3342 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST
, CLASS_IMPURE
,
3343 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3344 gfc_check_co_broadcast
, NULL
, NULL
,
3345 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3346 "source_image", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3347 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3348 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3350 add_sym_4s ("co_max", GFC_ISYM_CO_MAX
, CLASS_IMPURE
,
3351 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3352 gfc_check_co_minmax
, NULL
, NULL
,
3353 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3354 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3355 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3356 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3358 add_sym_4s ("co_min", GFC_ISYM_CO_MIN
, CLASS_IMPURE
,
3359 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3360 gfc_check_co_minmax
, NULL
, NULL
,
3361 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3362 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3363 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3364 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3366 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM
, CLASS_IMPURE
,
3367 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3368 gfc_check_co_sum
, NULL
, NULL
,
3369 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3370 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3371 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3372 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3374 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE
, CLASS_IMPURE
,
3375 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3376 gfc_check_co_reduce
, NULL
, NULL
,
3377 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3378 "operator", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3379 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3380 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3381 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3384 /* The following subroutine is internally used for coarray libray functions.
3385 "make_from_module" makes it inaccessible for external users. */
3386 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND
, CLASS_IMPURE
,
3387 BT_UNKNOWN
, 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3388 "x", BT_REAL
, dr
, REQUIRED
, INTENT_OUT
,
3389 "y", BT_REAL
, dr
, REQUIRED
, INTENT_IN
);
3393 /* More G77 compatibility garbage. */
3394 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3395 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
3396 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3397 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3398 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3400 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
3401 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
3402 "seed", BT_INTEGER
, 4, REQUIRED
, INTENT_IN
);
3404 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3405 gfc_check_exit
, NULL
, gfc_resolve_exit
,
3406 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3410 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3411 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
3412 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3413 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3414 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3416 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3417 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
3418 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3419 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3421 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3422 gfc_check_flush
, NULL
, gfc_resolve_flush
,
3423 ut
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3425 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3426 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
3427 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3428 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3429 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3431 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3432 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
3433 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3434 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3436 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3437 gfc_check_free
, NULL
, NULL
,
3438 ptr
, BT_INTEGER
, ii
, REQUIRED
, INTENT_INOUT
);
3440 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3441 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
3442 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3443 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3444 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3445 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3447 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3448 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
3449 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3450 of
, BT_INTEGER
, ii
, REQUIRED
, INTENT_OUT
);
3452 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3453 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
3454 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3455 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3457 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3458 gfc_check_kill_sub
, NULL
, gfc_resolve_kill_sub
,
3459 c
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3460 val
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3461 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3463 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3464 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
3465 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3466 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3467 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3469 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3470 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
3471 "string", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3473 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3474 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
3475 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3476 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3477 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3479 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3480 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
3481 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3483 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3484 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
3485 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3486 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3487 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3489 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3490 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
3491 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3492 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3493 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3495 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3496 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
3497 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3498 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3499 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3501 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3502 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3503 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3504 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3505 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3507 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3508 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3509 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3510 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3511 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3513 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3514 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3515 com
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3516 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3518 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3519 BT_UNKNOWN
, 0, GFC_STD_F95
,
3520 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3521 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3522 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3523 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3525 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3526 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3527 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3528 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3530 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3531 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3532 msk
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3533 old
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3535 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3536 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3537 "path", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3538 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3542 /* Add a function to the list of conversion symbols. */
3545 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3547 gfc_typespec from
, to
;
3548 gfc_intrinsic_sym
*sym
;
3550 if (sizing
== SZ_CONVS
)
3556 gfc_clear_ts (&from
);
3557 from
.type
= from_type
;
3558 from
.kind
= from_kind
;
3564 sym
= conversion
+ nconv
;
3566 sym
->name
= conv_name (&from
, &to
);
3567 sym
->lib_name
= sym
->name
;
3568 sym
->simplify
.cc
= gfc_convert_constant
;
3569 sym
->standard
= standard
;
3572 sym
->conversion
= 1;
3574 sym
->id
= GFC_ISYM_CONVERSION
;
3580 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3581 functions by looping over the kind tables. */
3584 add_conversions (void)
3588 /* Integer-Integer conversions. */
3589 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3590 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
3595 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3596 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
3599 /* Integer-Real/Complex conversions. */
3600 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3601 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3603 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3604 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3606 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
3607 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3609 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3610 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3612 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
3613 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3616 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3618 /* Hollerith-Integer conversions. */
3619 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3620 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3621 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3622 /* Hollerith-Real conversions. */
3623 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3624 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3625 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3626 /* Hollerith-Complex conversions. */
3627 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3628 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3629 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3631 /* Hollerith-Character conversions. */
3632 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
3633 gfc_default_character_kind
, GFC_STD_LEGACY
);
3635 /* Hollerith-Logical conversions. */
3636 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
3637 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3638 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
3641 /* Real/Complex - Real/Complex conversions. */
3642 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3643 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3647 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3648 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3650 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3651 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3654 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3655 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3657 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3658 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3661 /* Logical/Logical kind conversion. */
3662 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
3663 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
3668 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
3669 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
3672 /* Integer-Logical and Logical-Integer conversions. */
3673 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3674 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
3675 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
3677 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3678 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
3679 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
3680 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3686 add_char_conversions (void)
3690 /* Count possible conversions. */
3691 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
3692 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
3696 /* Allocate memory. */
3697 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
3699 /* Add the conversions themselves. */
3701 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
3702 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
3704 gfc_typespec from
, to
;
3709 gfc_clear_ts (&from
);
3710 from
.type
= BT_CHARACTER
;
3711 from
.kind
= gfc_character_kinds
[i
].kind
;
3714 to
.type
= BT_CHARACTER
;
3715 to
.kind
= gfc_character_kinds
[j
].kind
;
3717 char_conversions
[n
].name
= conv_name (&from
, &to
);
3718 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
3719 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
3720 char_conversions
[n
].standard
= GFC_STD_F2003
;
3721 char_conversions
[n
].elemental
= 1;
3722 char_conversions
[n
].pure
= 1;
3723 char_conversions
[n
].conversion
= 0;
3724 char_conversions
[n
].ts
= to
;
3725 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
3732 /* Initialize the table of intrinsics. */
3734 gfc_intrinsic_init_1 (void)
3736 nargs
= nfunc
= nsub
= nconv
= 0;
3738 /* Create a namespace to hold the resolved intrinsic symbols. */
3739 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
3748 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
3749 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
3750 + sizeof (gfc_intrinsic_arg
) * nargs
);
3752 next_sym
= functions
;
3753 subroutines
= functions
+ nfunc
;
3755 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
3757 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
3759 sizing
= SZ_NOTHING
;
3766 /* Character conversion intrinsics need to be treated separately. */
3767 add_char_conversions ();
3772 gfc_intrinsic_done_1 (void)
3776 free (char_conversions
);
3777 gfc_free_namespace (gfc_intrinsic_namespace
);
3781 /******** Subroutines to check intrinsic interfaces ***********/
3783 /* Given a formal argument list, remove any NULL arguments that may
3784 have been left behind by a sort against some formal argument list. */
3787 remove_nullargs (gfc_actual_arglist
**ap
)
3789 gfc_actual_arglist
*head
, *tail
, *next
;
3793 for (head
= *ap
; head
; head
= next
)
3797 if (head
->expr
== NULL
&& !head
->label
)
3800 gfc_free_actual_arglist (head
);
3819 /* Given an actual arglist and a formal arglist, sort the actual
3820 arglist so that its arguments are in a one-to-one correspondence
3821 with the format arglist. Arguments that are not present are given
3822 a blank gfc_actual_arglist structure. If something is obviously
3823 wrong (say, a missing required argument) we abort sorting and
3827 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
3828 gfc_intrinsic_arg
*formal
, locus
*where
)
3830 gfc_actual_arglist
*actual
, *a
;
3831 gfc_intrinsic_arg
*f
;
3833 remove_nullargs (ap
);
3836 for (f
= formal
; f
; f
= f
->next
)
3842 if (f
== NULL
&& a
== NULL
) /* No arguments */
3846 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3852 if (a
->name
!= NULL
)
3864 gfc_error ("Too many arguments in call to %qs at %L", name
, where
);
3868 /* Associate the remaining actual arguments, all of which have
3869 to be keyword arguments. */
3870 for (; a
; a
= a
->next
)
3872 for (f
= formal
; f
; f
= f
->next
)
3873 if (strcmp (a
->name
, f
->name
) == 0)
3878 if (a
->name
[0] == '%')
3879 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3880 "are not allowed in this context at %L", where
);
3882 gfc_error ("Can't find keyword named %qs in call to %qs at %L",
3883 a
->name
, name
, where
);
3887 if (f
->actual
!= NULL
)
3889 gfc_error ("Argument %qs appears twice in call to %qs at %L",
3890 f
->name
, name
, where
);
3898 /* At this point, all unmatched formal args must be optional. */
3899 for (f
= formal
; f
; f
= f
->next
)
3901 if (f
->actual
== NULL
&& f
->optional
== 0)
3903 gfc_error ("Missing actual argument %qs in call to %qs at %L",
3904 f
->name
, name
, where
);
3910 /* Using the formal argument list, string the actual argument list
3911 together in a way that corresponds with the formal list. */
3914 for (f
= formal
; f
; f
= f
->next
)
3916 if (f
->actual
&& f
->actual
->label
!= NULL
&& f
->ts
.type
)
3918 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
3922 if (f
->actual
== NULL
)
3924 a
= gfc_get_actual_arglist ();
3925 a
->missing_arg_type
= f
->ts
.type
;
3937 actual
->next
= NULL
; /* End the sorted argument list. */
3943 /* Compare an actual argument list with an intrinsic's formal argument
3944 list. The lists are checked for agreement of type. We don't check
3945 for arrayness here. */
3948 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
3951 gfc_actual_arglist
*actual
;
3952 gfc_intrinsic_arg
*formal
;
3955 formal
= sym
->formal
;
3959 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
3963 if (actual
->expr
== NULL
)
3968 /* A kind of 0 means we don't check for kind. */
3970 ts
.kind
= actual
->expr
->ts
.kind
;
3972 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
3975 gfc_error ("Type of argument %qs in call to %qs at %L should "
3976 "be %s, not %s", gfc_current_intrinsic_arg
[i
]->name
,
3977 gfc_current_intrinsic
, &actual
->expr
->where
,
3978 gfc_typename (&formal
->ts
),
3979 gfc_typename (&actual
->expr
->ts
));
3983 /* If the formal argument is INTENT([IN]OUT), check for definability. */
3984 if (formal
->intent
== INTENT_INOUT
|| formal
->intent
== INTENT_OUT
)
3986 const char* context
= (error_flag
3987 ? _("actual argument to INTENT = OUT/INOUT")
3990 /* No pointer arguments for intrinsics. */
3991 if (!gfc_check_vardef_context (actual
->expr
, false, false, false, context
))
4000 /* Given a pointer to an intrinsic symbol and an expression node that
4001 represent the function call to that subroutine, figure out the type
4002 of the result. This may involve calling a resolution subroutine. */
4005 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4007 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
4008 gfc_actual_arglist
*arg
;
4010 if (specific
->resolve
.f1
== NULL
)
4012 if (e
->value
.function
.name
== NULL
)
4013 e
->value
.function
.name
= specific
->lib_name
;
4015 if (e
->ts
.type
== BT_UNKNOWN
)
4016 e
->ts
= specific
->ts
;
4020 arg
= e
->value
.function
.actual
;
4022 /* Special case hacks for MIN and MAX. */
4023 if (specific
->resolve
.f1m
== gfc_resolve_max
4024 || specific
->resolve
.f1m
== gfc_resolve_min
)
4026 (*specific
->resolve
.f1m
) (e
, arg
);
4032 (*specific
->resolve
.f0
) (e
);
4041 (*specific
->resolve
.f1
) (e
, a1
);
4050 (*specific
->resolve
.f2
) (e
, a1
, a2
);
4059 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
4068 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
4077 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
4081 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4085 /* Given an intrinsic symbol node and an expression node, call the
4086 simplification function (if there is one), perhaps replacing the
4087 expression with something simpler. We return false on an error
4088 of the simplification, true if the simplification worked, even
4089 if nothing has changed in the expression itself. */
4092 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4094 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
;
4095 gfc_actual_arglist
*arg
;
4097 /* Max and min require special handling due to the variable number
4099 if (specific
->simplify
.f1
== gfc_simplify_min
)
4101 result
= gfc_simplify_min (e
);
4105 if (specific
->simplify
.f1
== gfc_simplify_max
)
4107 result
= gfc_simplify_max (e
);
4111 if (specific
->simplify
.f1
== NULL
)
4117 arg
= e
->value
.function
.actual
;
4121 result
= (*specific
->simplify
.f0
) ();
4128 if (specific
->simplify
.cc
== gfc_convert_constant
4129 || specific
->simplify
.cc
== gfc_convert_char_constant
)
4131 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
4136 result
= (*specific
->simplify
.f1
) (a1
);
4143 result
= (*specific
->simplify
.f2
) (a1
, a2
);
4150 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
4157 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
4164 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
4167 ("do_simplify(): Too many args for intrinsic");
4174 if (result
== &gfc_bad_expr
)
4178 resolve_intrinsic (specific
, e
); /* Must call at run-time */
4181 result
->where
= e
->where
;
4182 gfc_replace_expr (e
, result
);
4189 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4190 error messages. This subroutine returns false if a subroutine
4191 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4192 list cannot match any intrinsic. */
4195 init_arglist (gfc_intrinsic_sym
*isym
)
4197 gfc_intrinsic_arg
*formal
;
4200 gfc_current_intrinsic
= isym
->name
;
4203 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
4205 if (i
>= MAX_INTRINSIC_ARGS
)
4206 gfc_internal_error ("init_arglist(): too many arguments");
4207 gfc_current_intrinsic_arg
[i
++] = formal
;
4212 /* Given a pointer to an intrinsic symbol and an expression consisting
4213 of a function call, see if the function call is consistent with the
4214 intrinsic's formal argument list. Return true if the expression
4215 and intrinsic match, false otherwise. */
4218 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
4220 gfc_actual_arglist
*arg
, **ap
;
4223 ap
= &expr
->value
.function
.actual
;
4225 init_arglist (specific
);
4227 /* Don't attempt to sort the argument list for min or max. */
4228 if (specific
->check
.f1m
== gfc_check_min_max
4229 || specific
->check
.f1m
== gfc_check_min_max_integer
4230 || specific
->check
.f1m
== gfc_check_min_max_real
4231 || specific
->check
.f1m
== gfc_check_min_max_double
)
4233 if (!do_ts29113_check (specific
, *ap
))
4235 return (*specific
->check
.f1m
) (*ap
);
4238 if (!sort_actual (specific
->name
, ap
, specific
->formal
, &expr
->where
))
4241 if (!do_ts29113_check (specific
, *ap
))
4244 if (specific
->check
.f3ml
== gfc_check_minloc_maxloc
)
4245 /* This is special because we might have to reorder the argument list. */
4246 t
= gfc_check_minloc_maxloc (*ap
);
4247 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
4248 /* This is also special because we also might have to reorder the
4250 t
= gfc_check_minval_maxval (*ap
);
4251 else if (specific
->check
.f3red
== gfc_check_product_sum
)
4252 /* Same here. The difference to the previous case is that we allow a
4253 general numeric type. */
4254 t
= gfc_check_product_sum (*ap
);
4255 else if (specific
->check
.f3red
== gfc_check_transf_bit_intrins
)
4256 /* Same as for PRODUCT and SUM, but different checks. */
4257 t
= gfc_check_transf_bit_intrins (*ap
);
4260 if (specific
->check
.f1
== NULL
)
4262 t
= check_arglist (ap
, specific
, error_flag
);
4264 expr
->ts
= specific
->ts
;
4267 t
= do_check (specific
, *ap
);
4270 /* Check conformance of elemental intrinsics. */
4271 if (t
&& specific
->elemental
)
4274 gfc_expr
*first_expr
;
4275 arg
= expr
->value
.function
.actual
;
4277 /* There is no elemental intrinsic without arguments. */
4278 gcc_assert(arg
!= NULL
);
4279 first_expr
= arg
->expr
;
4281 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
4282 if (!gfc_check_conformance (first_expr
, arg
->expr
,
4283 "arguments '%s' and '%s' for "
4285 gfc_current_intrinsic_arg
[0]->name
,
4286 gfc_current_intrinsic_arg
[n
]->name
,
4287 gfc_current_intrinsic
))
4292 remove_nullargs (ap
);
4298 /* Check whether an intrinsic belongs to whatever standard the user
4299 has chosen, taking also into account -fall-intrinsics. Here, no
4300 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4301 textual representation of the symbols standard status (like
4302 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4303 can be used to construct a detailed warning/error message in case of
4307 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
4308 const char** symstd
, bool silent
, locus where
)
4310 const char* symstd_msg
;
4312 /* For -fall-intrinsics, just succeed. */
4313 if (flag_all_intrinsics
)
4316 /* Find the symbol's standard message for later usage. */
4317 switch (isym
->standard
)
4320 symstd_msg
= "available since Fortran 77";
4323 case GFC_STD_F95_OBS
:
4324 symstd_msg
= "obsolescent in Fortran 95";
4327 case GFC_STD_F95_DEL
:
4328 symstd_msg
= "deleted in Fortran 95";
4332 symstd_msg
= "new in Fortran 95";
4336 symstd_msg
= "new in Fortran 2003";
4340 symstd_msg
= "new in Fortran 2008";
4343 case GFC_STD_F2008_TS
:
4344 symstd_msg
= "new in TS 29113/TS 18508";
4348 symstd_msg
= "a GNU Fortran extension";
4351 case GFC_STD_LEGACY
:
4352 symstd_msg
= "for backward compatibility";
4356 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
4357 isym
->name
, isym
->standard
);
4360 /* If warning about the standard, warn and succeed. */
4361 if (gfc_option
.warn_std
& isym
->standard
)
4363 /* Do only print a warning if not a GNU extension. */
4364 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
4365 gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
4366 isym
->name
, _(symstd_msg
), &where
);
4371 /* If allowing the symbol's standard, succeed, too. */
4372 if (gfc_option
.allow_std
& isym
->standard
)
4375 /* Otherwise, fail. */
4377 *symstd
= _(symstd_msg
);
4382 /* See if a function call corresponds to an intrinsic function call.
4385 MATCH_YES if the call corresponds to an intrinsic, simplification
4386 is done if possible.
4388 MATCH_NO if the call does not correspond to an intrinsic
4390 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4391 error during the simplification process.
4393 The error_flag parameter enables an error reporting. */
4396 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
4398 gfc_intrinsic_sym
*isym
, *specific
;
4399 gfc_actual_arglist
*actual
;
4403 if (expr
->value
.function
.isym
!= NULL
)
4404 return (!do_simplify(expr
->value
.function
.isym
, expr
))
4405 ? MATCH_ERROR
: MATCH_YES
;
4408 gfc_push_suppress_errors ();
4411 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
4412 if (actual
->expr
!= NULL
)
4413 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
4414 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
4416 name
= expr
->symtree
->n
.sym
->name
;
4418 if (expr
->symtree
->n
.sym
->intmod_sym_id
)
4420 gfc_isym_id id
= gfc_isym_id_by_intmod_sym (expr
->symtree
->n
.sym
);
4421 isym
= specific
= gfc_intrinsic_function_by_id (id
);
4424 isym
= specific
= gfc_find_function (name
);
4429 gfc_pop_suppress_errors ();
4433 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
4434 || isym
->id
== GFC_ISYM_CMPLX
)
4435 && gfc_init_expr_flag
4436 && !gfc_notify_std (GFC_STD_F2003
, "Function %qs as initialization "
4437 "expression at %L", name
, &expr
->where
))
4440 gfc_pop_suppress_errors ();
4444 gfc_current_intrinsic_where
= &expr
->where
;
4446 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
4447 if (isym
->check
.f1m
== gfc_check_min_max
)
4449 init_arglist (isym
);
4451 if (isym
->check
.f1m(expr
->value
.function
.actual
))
4455 gfc_pop_suppress_errors ();
4459 /* If the function is generic, check all of its specific
4460 incarnations. If the generic name is also a specific, we check
4461 that name last, so that any error message will correspond to the
4463 gfc_push_suppress_errors ();
4467 for (specific
= isym
->specific_head
; specific
;
4468 specific
= specific
->next
)
4470 if (specific
== isym
)
4472 if (check_specific (specific
, expr
, 0))
4474 gfc_pop_suppress_errors ();
4480 gfc_pop_suppress_errors ();
4482 if (!check_specific (isym
, expr
, error_flag
))
4485 gfc_pop_suppress_errors ();
4492 expr
->value
.function
.isym
= specific
;
4493 if (!expr
->symtree
->n
.sym
->module
)
4494 gfc_intrinsic_symbol (expr
->symtree
->n
.sym
);
4497 gfc_pop_suppress_errors ();
4499 if (!do_simplify (specific
, expr
))
4502 /* F95, 7.1.6.1, Initialization expressions
4503 (4) An elemental intrinsic function reference of type integer or
4504 character where each argument is an initialization expression
4505 of type integer or character
4507 F2003, 7.1.7 Initialization expression
4508 (4) A reference to an elemental standard intrinsic function,
4509 where each argument is an initialization expression */
4511 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
4512 && !gfc_notify_std (GFC_STD_F2003
, "Elemental function as "
4513 "initialization expression with non-integer/non-"
4514 "character arguments at %L", &expr
->where
))
4521 /* See if a CALL statement corresponds to an intrinsic subroutine.
4522 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4523 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4527 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
4529 gfc_intrinsic_sym
*isym
;
4532 name
= c
->symtree
->n
.sym
->name
;
4534 if (c
->symtree
->n
.sym
->intmod_sym_id
)
4537 id
= gfc_isym_id_by_intmod_sym (c
->symtree
->n
.sym
);
4538 isym
= gfc_intrinsic_subroutine_by_id (id
);
4541 isym
= gfc_find_subroutine (name
);
4546 gfc_push_suppress_errors ();
4548 init_arglist (isym
);
4550 if (!isym
->vararg
&& !sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
))
4553 if (!do_ts29113_check (isym
, c
->ext
.actual
))
4556 if (isym
->check
.f1
!= NULL
)
4558 if (!do_check (isym
, c
->ext
.actual
))
4563 if (!check_arglist (&c
->ext
.actual
, isym
, 1))
4567 /* The subroutine corresponds to an intrinsic. Allow errors to be
4568 seen at this point. */
4570 gfc_pop_suppress_errors ();
4572 c
->resolved_isym
= isym
;
4573 if (isym
->resolve
.s1
!= NULL
)
4574 isym
->resolve
.s1 (c
);
4577 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
4578 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
4581 if (gfc_do_concurrent_flag
&& !isym
->pure
)
4583 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
4584 "block at %L is not PURE", name
, &c
->loc
);
4588 if (!isym
->pure
&& gfc_pure (NULL
))
4590 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name
,
4596 gfc_unset_implicit_pure (NULL
);
4598 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
4604 gfc_pop_suppress_errors ();
4609 /* Call gfc_convert_type() with warning enabled. */
4612 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
4614 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
4618 /* Try to convert an expression (in place) from one type to another.
4619 'eflag' controls the behavior on error.
4621 The possible values are:
4623 1 Generate a gfc_error()
4624 2 Generate a gfc_internal_error().
4626 'wflag' controls the warning related to conversion. */
4629 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
)
4631 gfc_intrinsic_sym
*sym
;
4632 gfc_typespec from_ts
;
4638 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
4640 if (ts
->type
== BT_UNKNOWN
)
4643 /* NULL and zero size arrays get their type here. */
4644 if (expr
->expr_type
== EXPR_NULL
4645 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
4647 /* Sometimes the RHS acquire the type. */
4652 if (expr
->ts
.type
== BT_UNKNOWN
)
4655 if (expr
->ts
.type
== BT_DERIVED
&& ts
->type
== BT_DERIVED
4656 && gfc_compare_types (&expr
->ts
, ts
))
4659 sym
= find_conv (&expr
->ts
, ts
);
4663 /* At this point, a conversion is necessary. A warning may be needed. */
4664 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
4666 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
4667 gfc_typename (&from_ts
), gfc_typename (ts
),
4672 if (flag_range_check
&& expr
->expr_type
== EXPR_CONSTANT
4673 && from_ts
.type
== ts
->type
)
4675 /* Do nothing. Constants of the same type are range-checked
4676 elsewhere. If a value too large for the target type is
4677 assigned, an error is generated. Not checking here avoids
4678 duplications of warnings/errors.
4679 If range checking was disabled, but -Wconversion enabled,
4680 a non range checked warning is generated below. */
4682 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
4684 /* Do nothing. This block exists only to simplify the other
4685 else-if expressions.
4686 LOGICAL <> LOGICAL no warning, independent of kind values
4687 LOGICAL <> INTEGER extension, warned elsewhere
4688 LOGICAL <> REAL invalid, error generated elsewhere
4689 LOGICAL <> COMPLEX invalid, error generated elsewhere */
4691 else if (from_ts
.type
== ts
->type
4692 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
4693 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
4694 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
4696 /* Larger kinds can hold values of smaller kinds without problems.
4697 Hence, only warn if target kind is smaller than the source
4698 kind - or if -Wconversion-extra is specified. */
4699 if (expr
->expr_type
!= EXPR_CONSTANT
)
4701 if (warn_conversion
&& from_ts
.kind
> ts
->kind
)
4702 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
4703 "conversion from %s to %s at %L",
4704 gfc_typename (&from_ts
), gfc_typename (ts
),
4706 else if (warn_conversion_extra
)
4707 gfc_warning_now (OPT_Wconversion_extra
, "Conversion from %s to %s "
4708 "at %L", gfc_typename (&from_ts
),
4709 gfc_typename (ts
), &expr
->where
);
4712 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
4713 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
4714 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
4716 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4717 usually comes with a loss of information, regardless of kinds. */
4718 if (warn_conversion
&& expr
->expr_type
!= EXPR_CONSTANT
)
4719 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
4720 "conversion from %s to %s at %L",
4721 gfc_typename (&from_ts
), gfc_typename (ts
),
4724 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
4726 /* If HOLLERITH is involved, all bets are off. */
4727 if (warn_conversion
)
4728 gfc_warning_now (OPT_Wconversion
, "Conversion from %s to %s at %L",
4729 gfc_typename (&from_ts
), gfc_typename (ts
),
4736 /* Insert a pre-resolved function call to the right function. */
4737 old_where
= expr
->where
;
4739 shape
= expr
->shape
;
4741 new_expr
= gfc_get_expr ();
4744 new_expr
= gfc_build_conversion (new_expr
);
4745 new_expr
->value
.function
.name
= sym
->lib_name
;
4746 new_expr
->value
.function
.isym
= sym
;
4747 new_expr
->where
= old_where
;
4748 new_expr
->rank
= rank
;
4749 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
4751 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
4752 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
4753 new_expr
->symtree
->n
.sym
->ts
= *ts
;
4754 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
4755 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
4756 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
4757 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
4758 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
4759 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
4760 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
4767 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
4768 && !do_simplify (sym
, expr
))
4773 return false; /* Error already generated in do_simplify() */
4781 gfc_error ("Can't convert %s to %s at %L",
4782 gfc_typename (&from_ts
), gfc_typename (ts
), &expr
->where
);
4786 gfc_internal_error ("Can't convert %qs to %qs at %L",
4787 gfc_typename (&from_ts
), gfc_typename (ts
),
4794 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
4796 gfc_intrinsic_sym
*sym
;
4802 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
4804 sym
= find_char_conv (&expr
->ts
, ts
);
4807 /* Insert a pre-resolved function call to the right function. */
4808 old_where
= expr
->where
;
4810 shape
= expr
->shape
;
4812 new_expr
= gfc_get_expr ();
4815 new_expr
= gfc_build_conversion (new_expr
);
4816 new_expr
->value
.function
.name
= sym
->lib_name
;
4817 new_expr
->value
.function
.isym
= sym
;
4818 new_expr
->where
= old_where
;
4819 new_expr
->rank
= rank
;
4820 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
4822 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
4823 new_expr
->symtree
->n
.sym
->ts
= *ts
;
4824 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
4825 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
4826 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
4827 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
4828 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
4829 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
4836 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
4837 && !do_simplify (sym
, expr
))
4839 /* Error already generated in do_simplify() */
4847 /* Check if the passed name is name of an intrinsic (taking into account the
4848 current -std=* and -fall-intrinsic settings). If it is, see if we should
4849 warn about this as a user-procedure having the same name as an intrinsic
4850 (-Wintrinsic-shadow enabled) and do so if we should. */
4853 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
4855 gfc_intrinsic_sym
* isym
;
4857 /* If the warning is disabled, do nothing at all. */
4858 if (!warn_intrinsic_shadow
)
4861 /* Try to find an intrinsic of the same name. */
4863 isym
= gfc_find_function (sym
->name
);
4865 isym
= gfc_find_subroutine (sym
->name
);
4867 /* If no intrinsic was found with this name or it's not included in the
4868 selected standard, everything's fine. */
4869 if (!isym
|| !gfc_check_intrinsic_standard (isym
, NULL
, true,
4873 /* Emit the warning. */
4874 if (in_module
|| sym
->ns
->proc_name
)
4875 gfc_warning (OPT_Wintrinsic_shadow
,
4876 "%qs declared at %L may shadow the intrinsic of the same"
4877 " name. In order to call the intrinsic, explicit INTRINSIC"
4878 " declarations may be required.",
4879 sym
->name
, &sym
->declared_at
);
4881 gfc_warning (OPT_Wintrinsic_shadow
,
4882 "%qs declared at %L is also the name of an intrinsic. It can"
4883 " only be called via an explicit interface or if declared"
4884 " EXTERNAL.", sym
->name
, &sym
->declared_at
);