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
, BT_REAL
, dr
, GFC_STD_F95
,
1663 gfc_check_cshift
, NULL
, gfc_resolve_cshift
,
1664 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
1665 dm
, BT_INTEGER
, ii
, OPTIONAL
);
1667 make_generic ("cshift", GFC_ISYM_CSHIFT
, GFC_STD_F95
);
1669 add_sym_1 ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1670 0, GFC_STD_GNU
, gfc_check_ctime
, NULL
, gfc_resolve_ctime
,
1671 tm
, BT_INTEGER
, di
, REQUIRED
);
1673 make_generic ("ctime", GFC_ISYM_CTIME
, GFC_STD_GNU
);
1675 add_sym_1 ("dble", GFC_ISYM_DBLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
1676 gfc_check_dble
, gfc_simplify_dble
, gfc_resolve_dble
,
1677 a
, BT_REAL
, dr
, REQUIRED
);
1679 make_generic ("dble", GFC_ISYM_DBLE
, GFC_STD_F77
);
1681 add_sym_1 ("digits", GFC_ISYM_DIGITS
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1682 gfc_check_digits
, gfc_simplify_digits
, NULL
,
1683 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1685 make_generic ("digits", GFC_ISYM_DIGITS
, GFC_STD_F95
);
1687 add_sym_2 ("dim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1688 gfc_check_a_p
, gfc_simplify_dim
, gfc_resolve_dim
,
1689 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1691 add_sym_2 ("idim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
1692 NULL
, gfc_simplify_dim
, gfc_resolve_dim
,
1693 x
, BT_INTEGER
, di
, REQUIRED
, y
, BT_INTEGER
, di
, REQUIRED
);
1695 add_sym_2 ("ddim", GFC_ISYM_DIM
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1696 gfc_check_x_yd
, gfc_simplify_dim
, gfc_resolve_dim
,
1697 x
, BT_REAL
, dd
, REQUIRED
, y
, BT_REAL
, dd
, REQUIRED
);
1699 make_generic ("dim", GFC_ISYM_DIM
, GFC_STD_F77
);
1701 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
1702 GFC_STD_F95
, gfc_check_dot_product
, gfc_simplify_dot_product
, gfc_resolve_dot_product
,
1703 va
, BT_REAL
, dr
, REQUIRED
, vb
, BT_REAL
, dr
, REQUIRED
);
1705 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT
, GFC_STD_F95
);
1707 add_sym_2 ("dprod", GFC_ISYM_DPROD
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1708 gfc_check_dprod
, gfc_simplify_dprod
, gfc_resolve_dprod
,
1709 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1711 make_generic ("dprod", GFC_ISYM_DPROD
, GFC_STD_F77
);
1713 add_sym_1 ("dreal", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1714 BT_REAL
, dd
, GFC_STD_GNU
, NULL
, gfc_simplify_dreal
, NULL
,
1715 a
, BT_COMPLEX
, dd
, REQUIRED
);
1717 make_generic ("dreal", GFC_ISYM_REAL
, GFC_STD_GNU
);
1719 add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1720 BT_INTEGER
, di
, GFC_STD_F2008
,
1721 gfc_check_dshift
, gfc_simplify_dshiftl
, gfc_resolve_dshift
,
1722 i
, BT_INTEGER
, di
, REQUIRED
,
1723 j
, BT_INTEGER
, di
, REQUIRED
,
1724 sh
, BT_INTEGER
, di
, REQUIRED
);
1726 make_generic ("dshiftl", GFC_ISYM_DSHIFTL
, GFC_STD_F2008
);
1728 add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1729 BT_INTEGER
, di
, GFC_STD_F2008
,
1730 gfc_check_dshift
, gfc_simplify_dshiftr
, gfc_resolve_dshift
,
1731 i
, BT_INTEGER
, di
, REQUIRED
,
1732 j
, BT_INTEGER
, di
, REQUIRED
,
1733 sh
, BT_INTEGER
, di
, REQUIRED
);
1735 make_generic ("dshiftr", GFC_ISYM_DSHIFTR
, GFC_STD_F2008
);
1737 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1738 gfc_check_eoshift
, NULL
, gfc_resolve_eoshift
,
1739 ar
, BT_REAL
, dr
, REQUIRED
, sh
, BT_INTEGER
, ii
, REQUIRED
,
1740 bd
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
1742 make_generic ("eoshift", GFC_ISYM_EOSHIFT
, GFC_STD_F95
);
1744 add_sym_1 ("epsilon", GFC_ISYM_EPSILON
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1745 gfc_check_x
, gfc_simplify_epsilon
, NULL
,
1746 x
, BT_REAL
, dr
, REQUIRED
);
1748 make_generic ("epsilon", GFC_ISYM_EPSILON
, GFC_STD_F95
);
1750 /* G77 compatibility for the ERF() and ERFC() functions. */
1751 add_sym_1 ("erf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1752 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erf
,
1753 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1755 add_sym_1 ("derf", GFC_ISYM_ERF
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1756 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erf
,
1757 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1759 make_generic ("erf", GFC_ISYM_ERF
, GFC_STD_F2008
);
1761 add_sym_1 ("erfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1762 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_erfc
,
1763 gfc_resolve_g77_math1
, x
, BT_REAL
, dr
, REQUIRED
);
1765 add_sym_1 ("derfc", GFC_ISYM_ERFC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
,
1766 GFC_STD_GNU
, gfc_check_fn_d
, gfc_simplify_erfc
,
1767 gfc_resolve_g77_math1
, x
, BT_REAL
, dd
, REQUIRED
);
1769 make_generic ("erfc", GFC_ISYM_ERFC
, GFC_STD_F2008
);
1771 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1772 BT_REAL
, dr
, GFC_STD_F2008
, gfc_check_fn_r
,
1773 gfc_simplify_erfc_scaled
, gfc_resolve_g77_math1
, x
, BT_REAL
,
1776 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED
, GFC_STD_F2008
);
1778 /* G77 compatibility */
1779 add_sym_1 ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1780 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1781 x
, BT_REAL
, 4, REQUIRED
);
1783 make_generic ("dtime", GFC_ISYM_DTIME
, GFC_STD_GNU
);
1785 add_sym_1 ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
1786 4, GFC_STD_GNU
, gfc_check_dtime_etime
, NULL
, NULL
,
1787 x
, BT_REAL
, 4, REQUIRED
);
1789 make_generic ("etime", GFC_ISYM_ETIME
, GFC_STD_GNU
);
1791 add_sym_1 ("exp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
1792 gfc_check_fn_rc
, gfc_simplify_exp
, gfc_resolve_exp
,
1793 x
, BT_REAL
, dr
, REQUIRED
);
1795 add_sym_1 ("dexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
1796 gfc_check_fn_d
, gfc_simplify_exp
, gfc_resolve_exp
,
1797 x
, BT_REAL
, dd
, REQUIRED
);
1799 add_sym_1 ("cexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
1800 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1801 x
, BT_COMPLEX
, dz
, REQUIRED
);
1803 add_sym_1 ("zexp", GFC_ISYM_EXP
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
1804 NULL
, gfc_simplify_exp
, gfc_resolve_exp
,
1805 x
, BT_COMPLEX
, dd
, REQUIRED
);
1807 make_alias ("cdexp", GFC_STD_GNU
);
1809 make_generic ("exp", GFC_ISYM_EXP
, GFC_STD_F77
);
1811 add_sym_1 ("exponent", GFC_ISYM_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1812 gfc_check_x
, gfc_simplify_exponent
, gfc_resolve_exponent
,
1813 x
, BT_REAL
, dr
, REQUIRED
);
1815 make_generic ("exponent", GFC_ISYM_EXPONENT
, GFC_STD_F95
);
1817 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF
, CLASS_INQUIRY
,
1818 ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
1819 gfc_check_same_type_as
, gfc_simplify_extends_type_of
,
1820 gfc_resolve_extends_type_of
,
1821 a
, BT_UNKNOWN
, 0, REQUIRED
,
1822 mo
, BT_UNKNOWN
, 0, REQUIRED
);
1824 add_sym_0 ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
1825 dc
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_fdate
);
1827 make_generic ("fdate", GFC_ISYM_FDATE
, GFC_STD_GNU
);
1829 add_sym_2 ("floor", GFC_ISYM_FLOOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1830 gfc_check_a_ikind
, gfc_simplify_floor
, gfc_resolve_floor
,
1831 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1833 make_generic ("floor", GFC_ISYM_FLOOR
, GFC_STD_F95
);
1835 /* G77 compatible fnum */
1836 add_sym_1 ("fnum", GFC_ISYM_FNUM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1837 di
, GFC_STD_GNU
, gfc_check_fnum
, NULL
, gfc_resolve_fnum
,
1838 ut
, BT_INTEGER
, di
, REQUIRED
);
1840 make_generic ("fnum", GFC_ISYM_FNUM
, GFC_STD_GNU
);
1842 add_sym_1 ("fraction", GFC_ISYM_FRACTION
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1843 gfc_check_x
, gfc_simplify_fraction
, gfc_resolve_fraction
,
1844 x
, BT_REAL
, dr
, REQUIRED
);
1846 make_generic ("fraction", GFC_ISYM_FRACTION
, GFC_STD_F95
);
1848 add_sym_2_intent ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
1849 BT_INTEGER
, di
, GFC_STD_GNU
,
1850 gfc_check_fstat
, NULL
, gfc_resolve_fstat
,
1851 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1852 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
1854 make_generic ("fstat", GFC_ISYM_FSTAT
, GFC_STD_GNU
);
1856 add_sym_1 ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1857 ii
, GFC_STD_GNU
, gfc_check_ftell
, NULL
, gfc_resolve_ftell
,
1858 ut
, BT_INTEGER
, di
, REQUIRED
);
1860 make_generic ("ftell", GFC_ISYM_FTELL
, GFC_STD_GNU
);
1862 add_sym_2_intent ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, ACTUAL_NO
,
1863 BT_INTEGER
, di
, GFC_STD_GNU
,
1864 gfc_check_fgetputc
, NULL
, gfc_resolve_fgetc
,
1865 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
1866 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1868 make_generic ("fgetc", GFC_ISYM_FGETC
, GFC_STD_GNU
);
1870 add_sym_1_intent ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1871 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fget
,
1872 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1874 make_generic ("fget", GFC_ISYM_FGET
, GFC_STD_GNU
);
1876 add_sym_2 ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1877 di
, GFC_STD_GNU
, gfc_check_fgetputc
, NULL
, gfc_resolve_fputc
,
1878 ut
, BT_INTEGER
, di
, REQUIRED
, c
, BT_CHARACTER
, dc
, REQUIRED
);
1880 make_generic ("fputc", GFC_ISYM_FPUTC
, GFC_STD_GNU
);
1882 add_sym_1 ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1883 di
, GFC_STD_GNU
, gfc_check_fgetput
, NULL
, gfc_resolve_fput
,
1884 c
, BT_CHARACTER
, dc
, REQUIRED
);
1886 make_generic ("fput", GFC_ISYM_FPUT
, GFC_STD_GNU
);
1888 add_sym_1 ("gamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
,
1889 GFC_STD_F2008
, gfc_check_fn_r
, gfc_simplify_gamma
,
1890 gfc_resolve_gamma
, x
, BT_REAL
, dr
, REQUIRED
);
1892 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
1893 gfc_check_fn_d
, gfc_simplify_gamma
, gfc_resolve_gamma
,
1894 x
, BT_REAL
, dr
, REQUIRED
);
1896 make_generic ("gamma", GFC_ISYM_TGAMMA
, GFC_STD_F2008
);
1898 /* Unix IDs (g77 compatibility) */
1899 add_sym_1 ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1900 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getcwd
,
1901 c
, BT_CHARACTER
, dc
, REQUIRED
);
1903 make_generic ("getcwd", GFC_ISYM_GETCWD
, GFC_STD_GNU
);
1905 add_sym_0 ("getgid", GFC_ISYM_GETGID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1906 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getgid
);
1908 make_generic ("getgid", GFC_ISYM_GETGID
, GFC_STD_GNU
);
1910 add_sym_0 ("getpid", GFC_ISYM_GETPID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1911 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getpid
);
1913 make_generic ("getpid", GFC_ISYM_GETPID
, GFC_STD_GNU
);
1915 add_sym_0 ("getuid", GFC_ISYM_GETUID
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1916 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_getuid
);
1918 make_generic ("getuid", GFC_ISYM_GETUID
, GFC_STD_GNU
);
1920 add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, ACTUAL_NO
,
1921 BT_INTEGER
, di
, GFC_STD_GNU
,
1922 gfc_check_hostnm
, NULL
, gfc_resolve_hostnm
,
1923 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
1925 make_generic ("hostnm", GFC_ISYM_HOSTNM
, GFC_STD_GNU
);
1927 add_sym_1 ("huge", GFC_ISYM_HUGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
1928 gfc_check_huge
, gfc_simplify_huge
, NULL
,
1929 x
, BT_UNKNOWN
, dr
, REQUIRED
);
1931 make_generic ("huge", GFC_ISYM_HUGE
, GFC_STD_F95
);
1933 add_sym_2 ("hypot", GFC_ISYM_HYPOT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1934 BT_REAL
, dr
, GFC_STD_F2008
,
1935 gfc_check_hypot
, gfc_simplify_hypot
, gfc_resolve_hypot
,
1936 x
, BT_REAL
, dr
, REQUIRED
, y
, BT_REAL
, dr
, REQUIRED
);
1938 make_generic ("hypot", GFC_ISYM_HYPOT
, GFC_STD_F2008
);
1940 add_sym_2 ("iachar", GFC_ISYM_IACHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1941 BT_INTEGER
, di
, GFC_STD_F95
,
1942 gfc_check_ichar_iachar
, gfc_simplify_iachar
, gfc_resolve_iachar
,
1943 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
1945 make_generic ("iachar", GFC_ISYM_IACHAR
, GFC_STD_F95
);
1947 add_sym_2 ("iand", GFC_ISYM_IAND
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1948 gfc_check_iand
, gfc_simplify_iand
, gfc_resolve_iand
,
1949 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
1951 make_generic ("iand", GFC_ISYM_IAND
, GFC_STD_F95
);
1953 add_sym_2 ("and", GFC_ISYM_AND
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
1954 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_and
, gfc_resolve_and
,
1955 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
1957 make_generic ("and", GFC_ISYM_AND
, GFC_STD_GNU
);
1959 add_sym_3red ("iall", GFC_ISYM_IALL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1960 gfc_check_transf_bit_intrins
, gfc_simplify_iall
, gfc_resolve_iall
,
1961 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1962 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
1964 make_generic ("iall", GFC_ISYM_IALL
, GFC_STD_F2008
);
1966 add_sym_3red ("iany", GFC_ISYM_IANY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
1967 gfc_check_transf_bit_intrins
, gfc_simplify_iany
, gfc_resolve_iany
,
1968 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
1969 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
1971 make_generic ("iany", GFC_ISYM_IANY
, GFC_STD_F2008
);
1973 add_sym_0 ("iargc", GFC_ISYM_IARGC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
1974 di
, GFC_STD_GNU
, NULL
, NULL
, NULL
);
1976 make_generic ("iargc", GFC_ISYM_IARGC
, GFC_STD_GNU
);
1978 add_sym_2 ("ibclr", GFC_ISYM_IBCLR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1979 gfc_check_bitfcn
, gfc_simplify_ibclr
, gfc_resolve_ibclr
,
1980 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1982 make_generic ("ibclr", GFC_ISYM_IBCLR
, GFC_STD_F95
);
1984 add_sym_3 ("ibits", GFC_ISYM_IBITS
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1985 gfc_check_ibits
, gfc_simplify_ibits
, gfc_resolve_ibits
,
1986 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
,
1987 ln
, BT_INTEGER
, di
, REQUIRED
);
1989 make_generic ("ibits", GFC_ISYM_IBITS
, GFC_STD_F95
);
1991 add_sym_2 ("ibset", GFC_ISYM_IBSET
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
1992 gfc_check_bitfcn
, gfc_simplify_ibset
, gfc_resolve_ibset
,
1993 i
, BT_INTEGER
, di
, REQUIRED
, pos
, BT_INTEGER
, di
, REQUIRED
);
1995 make_generic ("ibset", GFC_ISYM_IBSET
, GFC_STD_F95
);
1997 add_sym_2 ("ichar", GFC_ISYM_ICHAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
1998 BT_INTEGER
, di
, GFC_STD_F77
,
1999 gfc_check_ichar_iachar
, gfc_simplify_ichar
, gfc_resolve_ichar
,
2000 c
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2002 make_generic ("ichar", GFC_ISYM_ICHAR
, GFC_STD_F77
);
2004 add_sym_2 ("ieor", GFC_ISYM_IEOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2005 gfc_check_ieor
, gfc_simplify_ieor
, gfc_resolve_ieor
,
2006 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2008 make_generic ("ieor", GFC_ISYM_IEOR
, GFC_STD_F95
);
2010 add_sym_2 ("xor", GFC_ISYM_XOR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2011 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_xor
, gfc_resolve_xor
,
2012 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2014 make_generic ("xor", GFC_ISYM_XOR
, GFC_STD_GNU
);
2016 add_sym_0 ("ierrno", GFC_ISYM_IERRNO
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2017 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_ierrno
);
2019 make_generic ("ierrno", GFC_ISYM_IERRNO
, GFC_STD_GNU
);
2021 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2022 gfc_check_image_index
, gfc_simplify_image_index
, gfc_resolve_image_index
,
2023 ca
, BT_REAL
, dr
, REQUIRED
, sub
, BT_INTEGER
, ii
, REQUIRED
);
2025 /* The resolution function for INDEX is called gfc_resolve_index_func
2026 because the name gfc_resolve_index is already used in resolve.c. */
2027 add_sym_4 ("index", GFC_ISYM_INDEX
, CLASS_ELEMENTAL
, ACTUAL_YES
,
2028 BT_INTEGER
, di
, GFC_STD_F77
,
2029 gfc_check_index
, gfc_simplify_index
, gfc_resolve_index_func
,
2030 stg
, BT_CHARACTER
, dc
, REQUIRED
, ssg
, BT_CHARACTER
, dc
, REQUIRED
,
2031 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2033 make_generic ("index", GFC_ISYM_INDEX
, GFC_STD_F77
);
2035 add_sym_2 ("int", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2036 gfc_check_int
, gfc_simplify_int
, gfc_resolve_int
,
2037 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2039 add_sym_1 ("ifix", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2040 NULL
, gfc_simplify_ifix
, NULL
,
2041 a
, BT_REAL
, dr
, REQUIRED
);
2043 add_sym_1 ("idint", GFC_ISYM_INT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2044 NULL
, gfc_simplify_idint
, NULL
,
2045 a
, BT_REAL
, dd
, REQUIRED
);
2047 make_generic ("int", GFC_ISYM_INT
, GFC_STD_F77
);
2049 add_sym_1 ("int2", GFC_ISYM_INT2
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2050 gfc_check_intconv
, gfc_simplify_int2
, gfc_resolve_int2
,
2051 a
, BT_REAL
, dr
, REQUIRED
);
2053 make_alias ("short", GFC_STD_GNU
);
2055 make_generic ("int2", GFC_ISYM_INT2
, GFC_STD_GNU
);
2057 add_sym_1 ("int8", GFC_ISYM_INT8
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2058 gfc_check_intconv
, gfc_simplify_int8
, gfc_resolve_int8
,
2059 a
, BT_REAL
, dr
, REQUIRED
);
2061 make_generic ("int8", GFC_ISYM_INT8
, GFC_STD_GNU
);
2063 add_sym_1 ("long", GFC_ISYM_LONG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_GNU
,
2064 gfc_check_intconv
, gfc_simplify_long
, gfc_resolve_long
,
2065 a
, BT_REAL
, dr
, REQUIRED
);
2067 make_generic ("long", GFC_ISYM_LONG
, GFC_STD_GNU
);
2069 add_sym_2 ("ior", GFC_ISYM_IOR
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2070 gfc_check_ior
, gfc_simplify_ior
, gfc_resolve_ior
,
2071 i
, BT_INTEGER
, di
, REQUIRED
, j
, BT_INTEGER
, di
, REQUIRED
);
2073 make_generic ("ior", GFC_ISYM_IOR
, GFC_STD_F95
);
2075 add_sym_2 ("or", GFC_ISYM_OR
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2076 dl
, GFC_STD_GNU
, gfc_check_and
, gfc_simplify_or
, gfc_resolve_or
,
2077 i
, BT_UNKNOWN
, 0, REQUIRED
, j
, BT_UNKNOWN
, 0, REQUIRED
);
2079 make_generic ("or", GFC_ISYM_OR
, GFC_STD_GNU
);
2081 add_sym_3red ("iparity", GFC_ISYM_IPARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F2008
,
2082 gfc_check_transf_bit_intrins
, gfc_simplify_iparity
, gfc_resolve_iparity
,
2083 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2084 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2086 make_generic ("iparity", GFC_ISYM_IPARITY
, GFC_STD_F2008
);
2088 /* The following function is for G77 compatibility. */
2089 add_sym_1 ("irand", GFC_ISYM_IRAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2090 4, GFC_STD_GNU
, gfc_check_irand
, NULL
, NULL
,
2091 i
, BT_INTEGER
, 4, OPTIONAL
);
2093 make_generic ("irand", GFC_ISYM_IRAND
, GFC_STD_GNU
);
2095 add_sym_1 ("isatty", GFC_ISYM_ISATTY
, CLASS_IMPURE
, ACTUAL_NO
, BT_LOGICAL
,
2096 dl
, GFC_STD_GNU
, gfc_check_isatty
, NULL
, gfc_resolve_isatty
,
2097 ut
, BT_INTEGER
, di
, REQUIRED
);
2099 make_generic ("isatty", GFC_ISYM_ISATTY
, GFC_STD_GNU
);
2101 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
,
2102 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2103 gfc_check_i
, gfc_simplify_is_iostat_end
, NULL
,
2104 i
, BT_INTEGER
, 0, REQUIRED
);
2106 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END
, GFC_STD_F2003
);
2108 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
,
2109 CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F2003
,
2110 gfc_check_i
, gfc_simplify_is_iostat_eor
, NULL
,
2111 i
, BT_INTEGER
, 0, REQUIRED
);
2113 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR
, GFC_STD_F2003
);
2115 add_sym_1 ("isnan", GFC_ISYM_ISNAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2116 BT_LOGICAL
, dl
, GFC_STD_GNU
,
2117 gfc_check_isnan
, gfc_simplify_isnan
, NULL
,
2118 x
, BT_REAL
, 0, REQUIRED
);
2120 make_generic ("isnan", GFC_ISYM_ISNAN
, GFC_STD_GNU
);
2122 add_sym_2 ("rshift", GFC_ISYM_RSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2123 BT_INTEGER
, di
, GFC_STD_GNU
,
2124 gfc_check_ishft
, gfc_simplify_rshift
, gfc_resolve_rshift
,
2125 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2127 make_generic ("rshift", GFC_ISYM_RSHIFT
, GFC_STD_GNU
);
2129 add_sym_2 ("lshift", GFC_ISYM_LSHIFT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2130 BT_INTEGER
, di
, GFC_STD_GNU
,
2131 gfc_check_ishft
, gfc_simplify_lshift
, gfc_resolve_lshift
,
2132 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2134 make_generic ("lshift", GFC_ISYM_LSHIFT
, GFC_STD_GNU
);
2136 add_sym_2 ("ishft", GFC_ISYM_ISHFT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2137 gfc_check_ishft
, gfc_simplify_ishft
, gfc_resolve_ishft
,
2138 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
);
2140 make_generic ("ishft", GFC_ISYM_ISHFT
, GFC_STD_F95
);
2142 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2143 gfc_check_ishftc
, gfc_simplify_ishftc
, gfc_resolve_ishftc
,
2144 i
, BT_INTEGER
, di
, REQUIRED
, sh
, BT_INTEGER
, di
, REQUIRED
,
2145 sz
, BT_INTEGER
, di
, OPTIONAL
);
2147 make_generic ("ishftc", GFC_ISYM_ISHFTC
, GFC_STD_F95
);
2149 add_sym_2 ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2150 di
, GFC_STD_GNU
, gfc_check_kill
, NULL
, gfc_resolve_kill
,
2151 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2153 make_generic ("kill", GFC_ISYM_KILL
, GFC_STD_GNU
);
2155 add_sym_1 ("kind", GFC_ISYM_KIND
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2156 gfc_check_kind
, gfc_simplify_kind
, NULL
,
2157 x
, BT_REAL
, dr
, REQUIRED
);
2159 make_generic ("kind", GFC_ISYM_KIND
, GFC_STD_F95
);
2161 add_sym_3 ("lbound", GFC_ISYM_LBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2162 BT_INTEGER
, di
, GFC_STD_F95
,
2163 gfc_check_lbound
, gfc_simplify_lbound
, gfc_resolve_lbound
,
2164 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, di
, OPTIONAL
,
2165 kind
, BT_INTEGER
, di
, OPTIONAL
);
2167 make_generic ("lbound", GFC_ISYM_LBOUND
, GFC_STD_F95
);
2169 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2170 BT_INTEGER
, di
, GFC_STD_F2008
,
2171 gfc_check_lcobound
, gfc_simplify_lcobound
, gfc_resolve_lcobound
,
2172 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2173 kind
, BT_INTEGER
, di
, OPTIONAL
);
2175 make_generic ("lcobound", GFC_ISYM_LCOBOUND
, GFC_STD_F2008
);
2177 add_sym_1 ("leadz", GFC_ISYM_LEADZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2178 BT_INTEGER
, di
, GFC_STD_F2008
,
2179 gfc_check_i
, gfc_simplify_leadz
, NULL
,
2180 i
, BT_INTEGER
, di
, REQUIRED
);
2182 make_generic ("leadz", GFC_ISYM_LEADZ
, GFC_STD_F2008
);
2184 add_sym_2 ("len", GFC_ISYM_LEN
, CLASS_INQUIRY
, ACTUAL_YES
,
2185 BT_INTEGER
, di
, GFC_STD_F77
,
2186 gfc_check_len_lentrim
, gfc_simplify_len
, gfc_resolve_len
,
2187 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2189 make_generic ("len", GFC_ISYM_LEN
, GFC_STD_F77
);
2191 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2192 BT_INTEGER
, di
, GFC_STD_F95
,
2193 gfc_check_len_lentrim
, gfc_simplify_len_trim
, gfc_resolve_len_trim
,
2194 stg
, BT_CHARACTER
, dc
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2196 make_alias ("lnblnk", GFC_STD_GNU
);
2198 make_generic ("len_trim", GFC_ISYM_LEN_TRIM
, GFC_STD_F95
);
2200 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
,
2202 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2203 x
, BT_REAL
, dr
, REQUIRED
);
2205 make_alias ("log_gamma", GFC_STD_F2008
);
2207 add_sym_1 ("algama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2208 gfc_check_fn_r
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2209 x
, BT_REAL
, dr
, REQUIRED
);
2211 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2212 gfc_check_fn_d
, gfc_simplify_lgamma
, gfc_resolve_lgamma
,
2213 x
, BT_REAL
, dr
, REQUIRED
);
2215 make_generic ("log_gamma", GFC_ISYM_LGAMMA
, GFC_STD_F2008
);
2218 add_sym_2 ("lge", GFC_ISYM_LGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2219 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lge
, NULL
,
2220 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2222 make_generic ("lge", GFC_ISYM_LGE
, GFC_STD_F77
);
2224 add_sym_2 ("lgt", GFC_ISYM_LGT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2225 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lgt
, NULL
,
2226 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2228 make_generic ("lgt", GFC_ISYM_LGT
, GFC_STD_F77
);
2230 add_sym_2 ("lle",GFC_ISYM_LLE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2231 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_lle
, NULL
,
2232 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2234 make_generic ("lle", GFC_ISYM_LLE
, GFC_STD_F77
);
2236 add_sym_2 ("llt", GFC_ISYM_LLT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2237 GFC_STD_F77
, gfc_check_lge_lgt_lle_llt
, gfc_simplify_llt
, NULL
,
2238 sta
, BT_CHARACTER
, dc
, REQUIRED
, stb
, BT_CHARACTER
, dc
, REQUIRED
);
2240 make_generic ("llt", GFC_ISYM_LLT
, GFC_STD_F77
);
2242 add_sym_2 ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2243 GFC_STD_GNU
, gfc_check_link
, NULL
, gfc_resolve_link
,
2244 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2246 make_generic ("link", GFC_ISYM_LINK
, GFC_STD_GNU
);
2248 add_sym_1 ("log", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2249 gfc_check_fn_rc
, gfc_simplify_log
, gfc_resolve_log
,
2250 x
, BT_REAL
, dr
, REQUIRED
);
2252 add_sym_1 ("alog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2253 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2254 x
, BT_REAL
, dr
, REQUIRED
);
2256 add_sym_1 ("dlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2257 gfc_check_fn_d
, gfc_simplify_log
, gfc_resolve_log
,
2258 x
, BT_REAL
, dd
, REQUIRED
);
2260 add_sym_1 ("clog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2261 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2262 x
, BT_COMPLEX
, dz
, REQUIRED
);
2264 add_sym_1 ("zlog", GFC_ISYM_LOG
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2265 NULL
, gfc_simplify_log
, gfc_resolve_log
,
2266 x
, BT_COMPLEX
, dd
, REQUIRED
);
2268 make_alias ("cdlog", GFC_STD_GNU
);
2270 make_generic ("log", GFC_ISYM_LOG
, GFC_STD_F77
);
2272 add_sym_1 ("log10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2273 gfc_check_fn_r
, gfc_simplify_log10
, gfc_resolve_log10
,
2274 x
, BT_REAL
, dr
, REQUIRED
);
2276 add_sym_1 ("alog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2277 NULL
, gfc_simplify_log10
, gfc_resolve_log10
,
2278 x
, BT_REAL
, dr
, REQUIRED
);
2280 add_sym_1 ("dlog10", GFC_ISYM_LOG10
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2281 gfc_check_fn_d
, gfc_simplify_log10
, gfc_resolve_log10
,
2282 x
, BT_REAL
, dd
, REQUIRED
);
2284 make_generic ("log10", GFC_ISYM_LOG10
, GFC_STD_F77
);
2286 add_sym_2 ("logical", GFC_ISYM_LOGICAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_LOGICAL
, dl
, GFC_STD_F95
,
2287 gfc_check_logical
, gfc_simplify_logical
, gfc_resolve_logical
,
2288 l
, BT_LOGICAL
, dl
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2290 make_generic ("logical", GFC_ISYM_LOGICAL
, GFC_STD_F95
);
2292 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, ACTUAL_NO
,
2293 BT_INTEGER
, di
, GFC_STD_GNU
,
2294 gfc_check_stat
, NULL
, gfc_resolve_lstat
,
2295 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2296 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2298 make_generic ("lstat", GFC_ISYM_LSTAT
, GFC_STD_GNU
);
2300 add_sym_1 ("malloc", GFC_ISYM_MALLOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
2301 GFC_STD_GNU
, gfc_check_malloc
, NULL
, gfc_resolve_malloc
,
2302 sz
, BT_INTEGER
, di
, REQUIRED
);
2304 make_generic ("malloc", GFC_ISYM_MALLOC
, GFC_STD_GNU
);
2306 add_sym_2 ("maskl", GFC_ISYM_MASKL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2307 BT_INTEGER
, di
, GFC_STD_F2008
,
2308 gfc_check_mask
, gfc_simplify_maskl
, gfc_resolve_mask
,
2309 i
, BT_INTEGER
, di
, REQUIRED
,
2310 kind
, BT_INTEGER
, di
, OPTIONAL
);
2312 make_generic ("maskl", GFC_ISYM_MASKL
, GFC_STD_F2008
);
2314 add_sym_2 ("maskr", GFC_ISYM_MASKR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2315 BT_INTEGER
, di
, GFC_STD_F2008
,
2316 gfc_check_mask
, gfc_simplify_maskr
, gfc_resolve_mask
,
2317 i
, BT_INTEGER
, di
, REQUIRED
,
2318 kind
, BT_INTEGER
, di
, OPTIONAL
);
2320 make_generic ("maskr", GFC_ISYM_MASKR
, GFC_STD_F2008
);
2322 add_sym_2 ("matmul", GFC_ISYM_MATMUL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2323 gfc_check_matmul
, gfc_simplify_matmul
, gfc_resolve_matmul
,
2324 ma
, BT_REAL
, dr
, REQUIRED
, mb
, BT_REAL
, dr
, REQUIRED
);
2326 make_generic ("matmul", GFC_ISYM_MATMUL
, GFC_STD_F95
);
2328 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2329 int(max). The max function must take at least two arguments. */
2331 add_sym_1m ("max", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2332 gfc_check_min_max
, gfc_simplify_max
, gfc_resolve_max
,
2333 a1
, BT_UNKNOWN
, dr
, REQUIRED
, a2
, BT_UNKNOWN
, dr
, REQUIRED
);
2335 add_sym_1m ("max0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2336 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2337 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2339 add_sym_1m ("amax0", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2340 gfc_check_min_max_integer
, gfc_simplify_max
, NULL
,
2341 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2343 add_sym_1m ("amax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2344 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2345 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2347 add_sym_1m ("max1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2348 gfc_check_min_max_real
, gfc_simplify_max
, NULL
,
2349 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2351 add_sym_1m ("dmax1", GFC_ISYM_MAX
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2352 gfc_check_min_max_double
, gfc_simplify_max
, NULL
,
2353 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2355 make_generic ("max", GFC_ISYM_MAX
, GFC_STD_F77
);
2357 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2358 GFC_STD_F95
, gfc_check_x
, gfc_simplify_maxexponent
, NULL
,
2359 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2361 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT
, GFC_STD_F95
);
2363 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2364 gfc_check_minloc_maxloc
, NULL
, gfc_resolve_maxloc
,
2365 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2366 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2368 make_generic ("maxloc", GFC_ISYM_MAXLOC
, GFC_STD_F95
);
2370 add_sym_3red ("maxval", GFC_ISYM_MAXVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2371 gfc_check_minval_maxval
, gfc_simplify_maxval
, gfc_resolve_maxval
,
2372 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2373 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2375 make_generic ("maxval", GFC_ISYM_MAXVAL
, GFC_STD_F95
);
2377 add_sym_0 ("mclock", GFC_ISYM_MCLOCK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2378 GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock
);
2380 make_generic ("mclock", GFC_ISYM_MCLOCK
, GFC_STD_GNU
);
2382 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2383 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_mclock8
);
2385 make_generic ("mclock8", GFC_ISYM_MCLOCK8
, GFC_STD_GNU
);
2387 add_sym_3 ("merge", GFC_ISYM_MERGE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2388 gfc_check_merge
, gfc_simplify_merge
, gfc_resolve_merge
,
2389 ts
, BT_REAL
, dr
, REQUIRED
, fs
, BT_REAL
, dr
, REQUIRED
,
2390 msk
, BT_LOGICAL
, dl
, REQUIRED
);
2392 make_generic ("merge", GFC_ISYM_MERGE
, GFC_STD_F95
);
2394 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2395 BT_INTEGER
, di
, GFC_STD_F2008
,
2396 gfc_check_merge_bits
, gfc_simplify_merge_bits
,
2397 gfc_resolve_merge_bits
,
2398 i
, BT_INTEGER
, di
, REQUIRED
,
2399 j
, BT_INTEGER
, di
, REQUIRED
,
2400 msk
, BT_INTEGER
, di
, REQUIRED
);
2402 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS
, GFC_STD_F2008
);
2404 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2407 add_sym_1m ("min", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_UNKNOWN
, 0, GFC_STD_F77
,
2408 gfc_check_min_max
, gfc_simplify_min
, gfc_resolve_min
,
2409 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2411 add_sym_1m ("min0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2412 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2413 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2415 add_sym_1m ("amin0", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2416 gfc_check_min_max_integer
, gfc_simplify_min
, NULL
,
2417 a1
, BT_INTEGER
, di
, REQUIRED
, a2
, BT_INTEGER
, di
, REQUIRED
);
2419 add_sym_1m ("amin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2420 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2421 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2423 add_sym_1m ("min1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F77
,
2424 gfc_check_min_max_real
, gfc_simplify_min
, NULL
,
2425 a1
, BT_REAL
, dr
, REQUIRED
, a2
, BT_REAL
, dr
, REQUIRED
);
2427 add_sym_1m ("dmin1", GFC_ISYM_MIN
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_F77
,
2428 gfc_check_min_max_double
, gfc_simplify_min
, NULL
,
2429 a1
, BT_REAL
, dd
, REQUIRED
, a2
, BT_REAL
, dd
, REQUIRED
);
2431 make_generic ("min", GFC_ISYM_MIN
, GFC_STD_F77
);
2433 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2434 GFC_STD_F95
, gfc_check_x
, gfc_simplify_minexponent
, NULL
,
2435 x
, BT_UNKNOWN
, dr
, REQUIRED
);
2437 make_generic ("minexponent", GFC_ISYM_MINEXPONENT
, GFC_STD_F95
);
2439 add_sym_3ml ("minloc", GFC_ISYM_MINLOC
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2440 gfc_check_minloc_maxloc
, NULL
, gfc_resolve_minloc
,
2441 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2442 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2444 make_generic ("minloc", GFC_ISYM_MINLOC
, GFC_STD_F95
);
2446 add_sym_3red ("minval", GFC_ISYM_MINVAL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2447 gfc_check_minval_maxval
, gfc_simplify_minval
, gfc_resolve_minval
,
2448 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2449 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2451 make_generic ("minval", GFC_ISYM_MINVAL
, GFC_STD_F95
);
2453 add_sym_2 ("mod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2454 gfc_check_a_p
, gfc_simplify_mod
, gfc_resolve_mod
,
2455 a
, BT_INTEGER
, di
, REQUIRED
, p
, BT_INTEGER
, di
, REQUIRED
);
2457 add_sym_2 ("amod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2458 NULL
, gfc_simplify_mod
, gfc_resolve_mod
,
2459 a
, BT_REAL
, dr
, REQUIRED
, p
, BT_REAL
, dr
, REQUIRED
);
2461 add_sym_2 ("dmod", GFC_ISYM_MOD
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2462 gfc_check_x_yd
, gfc_simplify_mod
, gfc_resolve_mod
,
2463 a
, BT_REAL
, dd
, REQUIRED
, p
, BT_REAL
, dd
, REQUIRED
);
2465 make_generic ("mod", GFC_ISYM_MOD
, GFC_STD_F77
);
2467 add_sym_2 ("modulo", GFC_ISYM_MODULO
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, di
, GFC_STD_F95
,
2468 gfc_check_a_p
, gfc_simplify_modulo
, gfc_resolve_modulo
,
2469 a
, BT_REAL
, di
, REQUIRED
, p
, BT_REAL
, di
, REQUIRED
);
2471 make_generic ("modulo", GFC_ISYM_MODULO
, GFC_STD_F95
);
2473 add_sym_2 ("nearest", GFC_ISYM_NEAREST
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2474 gfc_check_nearest
, gfc_simplify_nearest
, gfc_resolve_nearest
,
2475 x
, BT_REAL
, dr
, REQUIRED
, s
, BT_REAL
, dr
, REQUIRED
);
2477 make_generic ("nearest", GFC_ISYM_NEAREST
, GFC_STD_F95
);
2479 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_CHARACTER
, dc
,
2480 GFC_STD_F2003
, gfc_check_new_line
, gfc_simplify_new_line
, NULL
,
2481 a
, BT_CHARACTER
, dc
, REQUIRED
);
2483 make_generic ("new_line", GFC_ISYM_NEW_LINE
, GFC_STD_F2003
);
2485 add_sym_2 ("nint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2486 gfc_check_a_ikind
, gfc_simplify_nint
, gfc_resolve_nint
,
2487 a
, BT_REAL
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2489 add_sym_1 ("idnint", GFC_ISYM_NINT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2490 gfc_check_idnint
, gfc_simplify_idnint
, gfc_resolve_idnint
,
2491 a
, BT_REAL
, dd
, REQUIRED
);
2493 make_generic ("nint", GFC_ISYM_NINT
, GFC_STD_F77
);
2495 add_sym_1 ("not", GFC_ISYM_NOT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2496 gfc_check_i
, gfc_simplify_not
, gfc_resolve_not
,
2497 i
, BT_INTEGER
, di
, REQUIRED
);
2499 make_generic ("not", GFC_ISYM_NOT
, GFC_STD_F95
);
2501 add_sym_2 ("norm2", GFC_ISYM_NORM2
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
,
2502 GFC_STD_F2008
, gfc_check_norm2
, gfc_simplify_norm2
, gfc_resolve_norm2
,
2503 x
, BT_REAL
, dr
, REQUIRED
,
2504 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2506 make_generic ("norm2", GFC_ISYM_NORM2
, GFC_STD_F2008
);
2508 add_sym_1 ("null", GFC_ISYM_NULL
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2509 gfc_check_null
, gfc_simplify_null
, NULL
,
2510 mo
, BT_INTEGER
, di
, OPTIONAL
);
2512 make_generic ("null", GFC_ISYM_NULL
, GFC_STD_F95
);
2514 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES
, CLASS_INQUIRY
, ACTUAL_NO
,
2515 BT_INTEGER
, di
, GFC_STD_F2008
,
2516 gfc_check_num_images
, gfc_simplify_num_images
, NULL
,
2517 dist
, BT_INTEGER
, di
, OPTIONAL
,
2518 failed
, BT_LOGICAL
, dl
, OPTIONAL
);
2520 add_sym_3 ("pack", GFC_ISYM_PACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2521 gfc_check_pack
, gfc_simplify_pack
, gfc_resolve_pack
,
2522 ar
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
2523 v
, BT_REAL
, dr
, OPTIONAL
);
2525 make_generic ("pack", GFC_ISYM_PACK
, GFC_STD_F95
);
2528 add_sym_2 ("parity", GFC_ISYM_PARITY
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_LOGICAL
, dl
,
2529 GFC_STD_F2008
, gfc_check_parity
, gfc_simplify_parity
, gfc_resolve_parity
,
2530 msk
, BT_LOGICAL
, dl
, REQUIRED
,
2531 dm
, BT_INTEGER
, ii
, OPTIONAL
);
2533 make_generic ("parity", GFC_ISYM_PARITY
, GFC_STD_F2008
);
2535 add_sym_1 ("popcnt", GFC_ISYM_POPCNT
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2536 BT_INTEGER
, di
, GFC_STD_F2008
,
2537 gfc_check_i
, gfc_simplify_popcnt
, NULL
,
2538 i
, BT_INTEGER
, di
, REQUIRED
);
2540 make_generic ("popcnt", GFC_ISYM_POPCNT
, GFC_STD_F2008
);
2542 add_sym_1 ("poppar", GFC_ISYM_POPPAR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2543 BT_INTEGER
, di
, GFC_STD_F2008
,
2544 gfc_check_i
, gfc_simplify_poppar
, NULL
,
2545 i
, BT_INTEGER
, di
, REQUIRED
);
2547 make_generic ("poppar", GFC_ISYM_POPPAR
, GFC_STD_F2008
);
2549 add_sym_1 ("precision", GFC_ISYM_PRECISION
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2550 gfc_check_precision
, gfc_simplify_precision
, NULL
,
2551 x
, BT_UNKNOWN
, 0, REQUIRED
);
2553 make_generic ("precision", GFC_ISYM_PRECISION
, GFC_STD_F95
);
2555 add_sym_1_intent ("present", GFC_ISYM_PRESENT
, CLASS_INQUIRY
, ACTUAL_NO
,
2556 BT_LOGICAL
, dl
, GFC_STD_F95
, gfc_check_present
, NULL
, NULL
,
2557 a
, BT_REAL
, dr
, REQUIRED
, INTENT_UNKNOWN
);
2559 make_generic ("present", GFC_ISYM_PRESENT
, GFC_STD_F95
);
2561 add_sym_3red ("product", GFC_ISYM_PRODUCT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2562 gfc_check_product_sum
, gfc_simplify_product
, gfc_resolve_product
,
2563 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2564 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2566 make_generic ("product", GFC_ISYM_PRODUCT
, GFC_STD_F95
);
2568 add_sym_1 ("radix", GFC_ISYM_RADIX
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2569 gfc_check_radix
, gfc_simplify_radix
, NULL
,
2570 x
, BT_UNKNOWN
, 0, REQUIRED
);
2572 make_generic ("radix", GFC_ISYM_RADIX
, GFC_STD_F95
);
2574 /* The following function is for G77 compatibility. */
2575 add_sym_1 ("rand", GFC_ISYM_RAND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2576 4, GFC_STD_GNU
, gfc_check_rand
, NULL
, NULL
,
2577 i
, BT_INTEGER
, 4, OPTIONAL
);
2579 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2580 use slightly different shoddy multiplicative congruential PRNG. */
2581 make_alias ("ran", GFC_STD_GNU
);
2583 make_generic ("rand", GFC_ISYM_RAND
, GFC_STD_GNU
);
2585 add_sym_1 ("range", GFC_ISYM_RANGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2586 gfc_check_range
, gfc_simplify_range
, NULL
,
2587 x
, BT_REAL
, dr
, REQUIRED
);
2589 make_generic ("range", GFC_ISYM_RANGE
, GFC_STD_F95
);
2591 add_sym_1 ("rank", GFC_ISYM_RANK
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
,
2592 GFC_STD_F2008_TS
, gfc_check_rank
, gfc_simplify_rank
, gfc_resolve_rank
,
2593 a
, BT_REAL
, dr
, REQUIRED
);
2594 make_generic ("rank", GFC_ISYM_RANK
, GFC_STD_F2008_TS
);
2596 add_sym_2 ("real", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2597 gfc_check_real
, gfc_simplify_real
, gfc_resolve_real
,
2598 a
, BT_UNKNOWN
, dr
, REQUIRED
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2600 /* This provides compatibility with g77. */
2601 add_sym_1 ("realpart", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_GNU
,
2602 gfc_check_fn_c
, gfc_simplify_realpart
, gfc_resolve_realpart
,
2603 a
, BT_UNKNOWN
, dr
, REQUIRED
);
2605 add_sym_1 ("float", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2606 gfc_check_float
, gfc_simplify_float
, NULL
,
2607 a
, BT_INTEGER
, di
, REQUIRED
);
2609 add_sym_1 ("dfloat", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dd
, GFC_STD_GNU
,
2610 gfc_check_float
, gfc_simplify_dble
, gfc_resolve_dble
,
2611 a
, BT_REAL
, dr
, REQUIRED
);
2613 add_sym_1 ("sngl", GFC_ISYM_REAL
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F77
,
2614 gfc_check_sngl
, gfc_simplify_sngl
, NULL
,
2615 a
, BT_REAL
, dd
, REQUIRED
);
2617 make_generic ("real", GFC_ISYM_REAL
, GFC_STD_F77
);
2619 add_sym_2 ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2620 GFC_STD_GNU
, gfc_check_rename
, NULL
, gfc_resolve_rename
,
2621 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2623 make_generic ("rename", GFC_ISYM_RENAME
, GFC_STD_GNU
);
2625 add_sym_2 ("repeat", GFC_ISYM_REPEAT
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2626 gfc_check_repeat
, gfc_simplify_repeat
, gfc_resolve_repeat
,
2627 stg
, BT_CHARACTER
, dc
, REQUIRED
, ncopies
, BT_INTEGER
, di
, REQUIRED
);
2629 make_generic ("repeat", GFC_ISYM_REPEAT
, GFC_STD_F95
);
2631 add_sym_4 ("reshape", GFC_ISYM_RESHAPE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2632 gfc_check_reshape
, gfc_simplify_reshape
, gfc_resolve_reshape
,
2633 src
, BT_REAL
, dr
, REQUIRED
, shp
, BT_INTEGER
, ii
, REQUIRED
,
2634 pad
, BT_REAL
, dr
, OPTIONAL
, ord
, BT_INTEGER
, ii
, OPTIONAL
);
2636 make_generic ("reshape", GFC_ISYM_RESHAPE
, GFC_STD_F95
);
2638 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2639 gfc_check_x
, gfc_simplify_rrspacing
, gfc_resolve_rrspacing
,
2640 x
, BT_REAL
, dr
, REQUIRED
);
2642 make_generic ("rrspacing", GFC_ISYM_RRSPACING
, GFC_STD_F95
);
2644 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS
, CLASS_INQUIRY
, ACTUAL_NO
,
2645 BT_LOGICAL
, dl
, GFC_STD_F2003
,
2646 gfc_check_same_type_as
, gfc_simplify_same_type_as
, NULL
,
2647 a
, BT_UNKNOWN
, 0, REQUIRED
,
2648 b
, BT_UNKNOWN
, 0, REQUIRED
);
2650 add_sym_2 ("scale", GFC_ISYM_SCALE
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2651 gfc_check_scale
, gfc_simplify_scale
, gfc_resolve_scale
,
2652 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2654 make_generic ("scale", GFC_ISYM_SCALE
, GFC_STD_F95
);
2656 add_sym_4 ("scan", GFC_ISYM_SCAN
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2657 BT_INTEGER
, di
, GFC_STD_F95
,
2658 gfc_check_scan
, gfc_simplify_scan
, gfc_resolve_scan
,
2659 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
2660 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
2662 make_generic ("scan", GFC_ISYM_SCAN
, GFC_STD_F95
);
2664 /* Added for G77 compatibility garbage. */
2665 add_sym_0 ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2666 4, GFC_STD_GNU
, NULL
, NULL
, NULL
);
2668 make_generic ("second", GFC_ISYM_SECOND
, GFC_STD_GNU
);
2670 /* Added for G77 compatibility. */
2671 add_sym_1 ("secnds", GFC_ISYM_SECNDS
, CLASS_IMPURE
, ACTUAL_NO
, BT_REAL
,
2672 dr
, GFC_STD_GNU
, gfc_check_secnds
, NULL
, gfc_resolve_secnds
,
2673 x
, BT_REAL
, dr
, REQUIRED
);
2675 make_generic ("secnds", GFC_ISYM_SECNDS
, GFC_STD_GNU
);
2677 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND
, CLASS_TRANSFORMATIONAL
,
2678 ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2003
,
2679 gfc_check_selected_char_kind
, gfc_simplify_selected_char_kind
,
2680 NULL
, nm
, BT_CHARACTER
, dc
, REQUIRED
);
2682 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND
, GFC_STD_F2003
);
2684 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2685 GFC_STD_F95
, gfc_check_selected_int_kind
,
2686 gfc_simplify_selected_int_kind
, NULL
, r
, BT_INTEGER
, di
, REQUIRED
);
2688 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND
, GFC_STD_F95
);
2690 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_INTEGER
, di
,
2691 GFC_STD_F95
, gfc_check_selected_real_kind
,
2692 gfc_simplify_selected_real_kind
, NULL
,
2693 p
, BT_INTEGER
, di
, OPTIONAL
, r
, BT_INTEGER
, di
, OPTIONAL
,
2694 "radix", BT_INTEGER
, di
, OPTIONAL
);
2696 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND
, GFC_STD_F95
);
2698 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2699 gfc_check_set_exponent
, gfc_simplify_set_exponent
,
2700 gfc_resolve_set_exponent
,
2701 x
, BT_REAL
, dr
, REQUIRED
, i
, BT_INTEGER
, di
, REQUIRED
);
2703 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT
, GFC_STD_F95
);
2705 add_sym_2 ("shape", GFC_ISYM_SHAPE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F95
,
2706 gfc_check_shape
, gfc_simplify_shape
, gfc_resolve_shape
,
2707 src
, BT_REAL
, dr
, REQUIRED
,
2708 kind
, BT_INTEGER
, di
, OPTIONAL
);
2710 make_generic ("shape", GFC_ISYM_SHAPE
, GFC_STD_F95
);
2712 add_sym_2 ("shifta", GFC_ISYM_SHIFTA
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2713 BT_INTEGER
, di
, GFC_STD_F2008
,
2714 gfc_check_shift
, gfc_simplify_shifta
, gfc_resolve_shift
,
2715 i
, BT_INTEGER
, di
, REQUIRED
,
2716 sh
, BT_INTEGER
, di
, REQUIRED
);
2718 make_generic ("shifta", GFC_ISYM_SHIFTA
, GFC_STD_F2008
);
2720 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2721 BT_INTEGER
, di
, GFC_STD_F2008
,
2722 gfc_check_shift
, gfc_simplify_shiftl
, gfc_resolve_shift
,
2723 i
, BT_INTEGER
, di
, REQUIRED
,
2724 sh
, BT_INTEGER
, di
, REQUIRED
);
2726 make_generic ("shiftl", GFC_ISYM_SHIFTL
, GFC_STD_F2008
);
2728 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2729 BT_INTEGER
, di
, GFC_STD_F2008
,
2730 gfc_check_shift
, gfc_simplify_shiftr
, gfc_resolve_shift
,
2731 i
, BT_INTEGER
, di
, REQUIRED
,
2732 sh
, BT_INTEGER
, di
, REQUIRED
);
2734 make_generic ("shiftr", GFC_ISYM_SHIFTR
, GFC_STD_F2008
);
2736 add_sym_2 ("sign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2737 gfc_check_sign
, gfc_simplify_sign
, gfc_resolve_sign
,
2738 a
, BT_REAL
, dr
, REQUIRED
, b
, BT_REAL
, dr
, REQUIRED
);
2740 add_sym_2 ("isign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_INTEGER
, di
, GFC_STD_F77
,
2741 NULL
, gfc_simplify_sign
, gfc_resolve_sign
,
2742 a
, BT_INTEGER
, di
, REQUIRED
, b
, BT_INTEGER
, di
, REQUIRED
);
2744 add_sym_2 ("dsign", GFC_ISYM_SIGN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2745 gfc_check_x_yd
, gfc_simplify_sign
, gfc_resolve_sign
,
2746 a
, BT_REAL
, dd
, REQUIRED
, b
, BT_REAL
, dd
, REQUIRED
);
2748 make_generic ("sign", GFC_ISYM_SIGN
, GFC_STD_F77
);
2750 add_sym_2 ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2751 di
, GFC_STD_GNU
, gfc_check_signal
, NULL
, gfc_resolve_signal
,
2752 num
, BT_INTEGER
, di
, REQUIRED
, han
, BT_VOID
, 0, REQUIRED
);
2754 make_generic ("signal", GFC_ISYM_SIGNAL
, GFC_STD_GNU
);
2756 add_sym_1 ("sin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2757 gfc_check_fn_rc
, gfc_simplify_sin
, gfc_resolve_sin
,
2758 x
, BT_REAL
, dr
, REQUIRED
);
2760 add_sym_1 ("dsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2761 gfc_check_fn_d
, gfc_simplify_sin
, gfc_resolve_sin
,
2762 x
, BT_REAL
, dd
, REQUIRED
);
2764 add_sym_1 ("csin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2765 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2766 x
, BT_COMPLEX
, dz
, REQUIRED
);
2768 add_sym_1 ("zsin", GFC_ISYM_SIN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2769 NULL
, gfc_simplify_sin
, gfc_resolve_sin
,
2770 x
, BT_COMPLEX
, dd
, REQUIRED
);
2772 make_alias ("cdsin", GFC_STD_GNU
);
2774 make_generic ("sin", GFC_ISYM_SIN
, GFC_STD_F77
);
2776 add_sym_1 ("sinh", GFC_ISYM_SINH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2777 gfc_check_fn_rc2008
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2778 x
, BT_REAL
, dr
, REQUIRED
);
2780 add_sym_1 ("dsinh", GFC_ISYM_SINH
,CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2781 gfc_check_fn_d
, gfc_simplify_sinh
, gfc_resolve_sinh
,
2782 x
, BT_REAL
, dd
, REQUIRED
);
2784 make_generic ("sinh", GFC_ISYM_SINH
, GFC_STD_F77
);
2786 add_sym_3 ("size", GFC_ISYM_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2787 BT_INTEGER
, di
, GFC_STD_F95
,
2788 gfc_check_size
, gfc_simplify_size
, gfc_resolve_size
,
2789 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2790 kind
, BT_INTEGER
, di
, OPTIONAL
);
2792 make_generic ("size", GFC_ISYM_SIZE
, GFC_STD_F95
);
2794 /* Obtain the stride for a given dimensions; to be used only internally.
2795 "make_from_module" makes it inaccessible for external users. */
2796 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE
, CLASS_INQUIRY
, ACTUAL_NO
,
2797 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_GNU
,
2798 NULL
, NULL
, gfc_resolve_stride
,
2799 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
);
2802 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2803 BT_INTEGER
, ii
, GFC_STD_GNU
,
2804 gfc_check_sizeof
, gfc_simplify_sizeof
, NULL
,
2805 x
, BT_UNKNOWN
, 0, REQUIRED
);
2807 make_generic ("sizeof", GFC_ISYM_SIZEOF
, GFC_STD_GNU
);
2809 /* The following functions are part of ISO_C_BINDING. */
2810 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED
, CLASS_INQUIRY
, ACTUAL_NO
,
2811 BT_LOGICAL
, dl
, GFC_STD_F2003
, gfc_check_c_associated
, NULL
, NULL
,
2812 "C_PTR_1", BT_VOID
, 0, REQUIRED
,
2813 "C_PTR_2", BT_VOID
, 0, OPTIONAL
);
2816 add_sym_1 ("c_loc", GFC_ISYM_C_LOC
, CLASS_INQUIRY
, ACTUAL_NO
,
2817 BT_VOID
, 0, GFC_STD_F2003
,
2818 gfc_check_c_loc
, NULL
, gfc_resolve_c_loc
,
2819 x
, BT_UNKNOWN
, 0, REQUIRED
);
2822 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC
, CLASS_INQUIRY
, ACTUAL_NO
,
2823 BT_VOID
, 0, GFC_STD_F2003
,
2824 gfc_check_c_funloc
, NULL
, gfc_resolve_c_funloc
,
2825 x
, BT_UNKNOWN
, 0, REQUIRED
);
2828 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF
, CLASS_INQUIRY
, ACTUAL_NO
,
2829 BT_INTEGER
, gfc_index_integer_kind
, GFC_STD_F2008
,
2830 gfc_check_c_sizeof
, gfc_simplify_sizeof
, NULL
,
2831 x
, BT_UNKNOWN
, 0, REQUIRED
);
2834 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
2835 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS
, CLASS_INQUIRY
,
2836 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
2837 NULL
, gfc_simplify_compiler_options
, NULL
);
2840 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION
, CLASS_INQUIRY
,
2841 ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F2008
,
2842 NULL
, gfc_simplify_compiler_version
, NULL
);
2845 add_sym_1 ("spacing", GFC_ISYM_SPACING
, CLASS_ELEMENTAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2846 gfc_check_x
, gfc_simplify_spacing
, gfc_resolve_spacing
,
2847 x
, BT_REAL
, dr
, REQUIRED
);
2849 make_generic ("spacing", GFC_ISYM_SPACING
, GFC_STD_F95
);
2851 add_sym_3 ("spread", GFC_ISYM_SPREAD
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2852 gfc_check_spread
, gfc_simplify_spread
, gfc_resolve_spread
,
2853 src
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, REQUIRED
,
2854 ncopies
, BT_INTEGER
, di
, REQUIRED
);
2856 make_generic ("spread", GFC_ISYM_SPREAD
, GFC_STD_F95
);
2858 add_sym_1 ("sqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2859 gfc_check_fn_rc
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2860 x
, BT_REAL
, dr
, REQUIRED
);
2862 add_sym_1 ("dsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2863 gfc_check_fn_d
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2864 x
, BT_REAL
, dd
, REQUIRED
);
2866 add_sym_1 ("csqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dz
, GFC_STD_F77
,
2867 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2868 x
, BT_COMPLEX
, dz
, REQUIRED
);
2870 add_sym_1 ("zsqrt", GFC_ISYM_SQRT
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_COMPLEX
, dd
, GFC_STD_GNU
,
2871 NULL
, gfc_simplify_sqrt
, gfc_resolve_sqrt
,
2872 x
, BT_COMPLEX
, dd
, REQUIRED
);
2874 make_alias ("cdsqrt", GFC_STD_GNU
);
2876 make_generic ("sqrt", GFC_ISYM_SQRT
, GFC_STD_F77
);
2878 add_sym_2_intent ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, ACTUAL_NO
,
2879 BT_INTEGER
, di
, GFC_STD_GNU
,
2880 gfc_check_stat
, NULL
, gfc_resolve_stat
,
2881 nm
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
2882 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
2884 make_generic ("stat", GFC_ISYM_STAT
, GFC_STD_GNU
);
2886 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE
, CLASS_INQUIRY
, ACTUAL_NO
,
2887 BT_INTEGER
, di
, GFC_STD_F2008
,
2888 gfc_check_storage_size
, gfc_simplify_storage_size
,
2889 gfc_resolve_storage_size
,
2890 a
, BT_UNKNOWN
, 0, REQUIRED
,
2891 kind
, BT_INTEGER
, di
, OPTIONAL
);
2893 add_sym_3red ("sum", GFC_ISYM_SUM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2894 gfc_check_product_sum
, gfc_simplify_sum
, gfc_resolve_sum
,
2895 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2896 msk
, BT_LOGICAL
, dl
, OPTIONAL
);
2898 make_generic ("sum", GFC_ISYM_SUM
, GFC_STD_F95
);
2900 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2901 GFC_STD_GNU
, gfc_check_symlnk
, NULL
, gfc_resolve_symlnk
,
2902 p1
, BT_CHARACTER
, dc
, REQUIRED
, p2
, BT_CHARACTER
, dc
, REQUIRED
);
2904 make_generic ("symlnk", GFC_ISYM_SYMLNK
, GFC_STD_GNU
);
2906 add_sym_1 ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
2907 GFC_STD_GNU
, NULL
, NULL
, NULL
,
2908 com
, BT_CHARACTER
, dc
, REQUIRED
);
2910 make_generic ("system", GFC_ISYM_SYSTEM
, GFC_STD_GNU
);
2912 add_sym_1 ("tan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2913 gfc_check_fn_rc2008
, gfc_simplify_tan
, gfc_resolve_tan
,
2914 x
, BT_REAL
, dr
, REQUIRED
);
2916 add_sym_1 ("dtan", GFC_ISYM_TAN
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2917 gfc_check_fn_d
, gfc_simplify_tan
, gfc_resolve_tan
,
2918 x
, BT_REAL
, dd
, REQUIRED
);
2920 make_generic ("tan", GFC_ISYM_TAN
, GFC_STD_F77
);
2922 add_sym_1 ("tanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dr
, GFC_STD_F77
,
2923 gfc_check_fn_rc2008
, gfc_simplify_tanh
, gfc_resolve_tanh
,
2924 x
, BT_REAL
, dr
, REQUIRED
);
2926 add_sym_1 ("dtanh", GFC_ISYM_TANH
, CLASS_ELEMENTAL
, ACTUAL_YES
, BT_REAL
, dd
, GFC_STD_F77
,
2927 gfc_check_fn_d
, gfc_simplify_tanh
, gfc_resolve_tanh
,
2928 x
, BT_REAL
, dd
, REQUIRED
);
2930 make_generic ("tanh", GFC_ISYM_TANH
, GFC_STD_F77
);
2932 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE
, CLASS_INQUIRY
, ACTUAL_NO
, BT_INTEGER
, di
, GFC_STD_F2008
,
2933 gfc_check_this_image
, gfc_simplify_this_image
, gfc_resolve_this_image
,
2934 ca
, BT_REAL
, dr
, OPTIONAL
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2935 dist
, BT_INTEGER
, di
, OPTIONAL
);
2937 add_sym_0 ("time", GFC_ISYM_TIME
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2938 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time
);
2940 make_generic ("time", GFC_ISYM_TIME
, GFC_STD_GNU
);
2942 add_sym_0 ("time8", GFC_ISYM_TIME8
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
2943 di
, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_time8
);
2945 make_generic ("time8", GFC_ISYM_TIME8
, GFC_STD_GNU
);
2947 add_sym_1 ("tiny", GFC_ISYM_TINY
, CLASS_INQUIRY
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2948 gfc_check_x
, gfc_simplify_tiny
, NULL
,
2949 x
, BT_REAL
, dr
, REQUIRED
);
2951 make_generic ("tiny", GFC_ISYM_TINY
, GFC_STD_F95
);
2953 add_sym_1 ("trailz", GFC_ISYM_TRAILZ
, CLASS_ELEMENTAL
, ACTUAL_NO
,
2954 BT_INTEGER
, di
, GFC_STD_F2008
,
2955 gfc_check_i
, gfc_simplify_trailz
, NULL
,
2956 i
, BT_INTEGER
, di
, REQUIRED
);
2958 make_generic ("trailz", GFC_ISYM_TRAILZ
, GFC_STD_F2008
);
2960 add_sym_3 ("transfer", GFC_ISYM_TRANSFER
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2961 gfc_check_transfer
, gfc_simplify_transfer
, gfc_resolve_transfer
,
2962 src
, BT_REAL
, dr
, REQUIRED
, mo
, BT_REAL
, dr
, REQUIRED
,
2963 sz
, BT_INTEGER
, di
, OPTIONAL
);
2965 make_generic ("transfer", GFC_ISYM_TRANSFER
, GFC_STD_F95
);
2967 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
2968 gfc_check_transpose
, gfc_simplify_transpose
, gfc_resolve_transpose
,
2969 m
, BT_REAL
, dr
, REQUIRED
);
2971 make_generic ("transpose", GFC_ISYM_TRANSPOSE
, GFC_STD_F95
);
2973 add_sym_1 ("trim", GFC_ISYM_TRIM
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_CHARACTER
, dc
, GFC_STD_F95
,
2974 gfc_check_trim
, gfc_simplify_trim
, gfc_resolve_trim
,
2975 stg
, BT_CHARACTER
, dc
, REQUIRED
);
2977 make_generic ("trim", GFC_ISYM_TRIM
, GFC_STD_F95
);
2979 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, ACTUAL_NO
, BT_CHARACTER
,
2980 0, GFC_STD_GNU
, gfc_check_ttynam
, NULL
, gfc_resolve_ttynam
,
2981 ut
, BT_INTEGER
, di
, REQUIRED
);
2983 make_generic ("ttynam", GFC_ISYM_TTYNAM
, GFC_STD_GNU
);
2985 add_sym_3 ("ubound", GFC_ISYM_UBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2986 BT_INTEGER
, di
, GFC_STD_F95
,
2987 gfc_check_ubound
, gfc_simplify_ubound
, gfc_resolve_ubound
,
2988 ar
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2989 kind
, BT_INTEGER
, di
, OPTIONAL
);
2991 make_generic ("ubound", GFC_ISYM_UBOUND
, GFC_STD_F95
);
2993 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND
, CLASS_INQUIRY
, ACTUAL_NO
,
2994 BT_INTEGER
, di
, GFC_STD_F2008
,
2995 gfc_check_ucobound
, gfc_simplify_ucobound
, gfc_resolve_ucobound
,
2996 ca
, BT_REAL
, dr
, REQUIRED
, dm
, BT_INTEGER
, ii
, OPTIONAL
,
2997 kind
, BT_INTEGER
, di
, OPTIONAL
);
2999 make_generic ("ucobound", GFC_ISYM_UCOBOUND
, GFC_STD_F2008
);
3001 /* g77 compatibility for UMASK. */
3002 add_sym_1 ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, di
,
3003 GFC_STD_GNU
, gfc_check_umask
, NULL
, gfc_resolve_umask
,
3004 msk
, BT_INTEGER
, di
, REQUIRED
);
3006 make_generic ("umask", GFC_ISYM_UMASK
, GFC_STD_GNU
);
3008 /* g77 compatibility for UNLINK. */
3009 add_sym_1 ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
,
3010 di
, GFC_STD_GNU
, gfc_check_unlink
, NULL
, gfc_resolve_unlink
,
3011 "path", BT_CHARACTER
, dc
, REQUIRED
);
3013 make_generic ("unlink", GFC_ISYM_UNLINK
, GFC_STD_GNU
);
3015 add_sym_3 ("unpack", GFC_ISYM_UNPACK
, CLASS_TRANSFORMATIONAL
, ACTUAL_NO
, BT_REAL
, dr
, GFC_STD_F95
,
3016 gfc_check_unpack
, gfc_simplify_unpack
, gfc_resolve_unpack
,
3017 v
, BT_REAL
, dr
, REQUIRED
, msk
, BT_LOGICAL
, dl
, REQUIRED
,
3018 f
, BT_REAL
, dr
, REQUIRED
);
3020 make_generic ("unpack", GFC_ISYM_UNPACK
, GFC_STD_F95
);
3022 add_sym_4 ("verify", GFC_ISYM_VERIFY
, CLASS_ELEMENTAL
, ACTUAL_NO
,
3023 BT_INTEGER
, di
, GFC_STD_F95
,
3024 gfc_check_verify
, gfc_simplify_verify
, gfc_resolve_verify
,
3025 stg
, BT_CHARACTER
, dc
, REQUIRED
, set
, BT_CHARACTER
, dc
, REQUIRED
,
3026 bck
, BT_LOGICAL
, dl
, OPTIONAL
, kind
, BT_INTEGER
, di
, OPTIONAL
);
3028 make_generic ("verify", GFC_ISYM_VERIFY
, GFC_STD_F95
);
3030 add_sym_1 ("loc", GFC_ISYM_LOC
, CLASS_IMPURE
, ACTUAL_NO
, BT_INTEGER
, ii
,
3031 GFC_STD_GNU
, gfc_check_loc
, NULL
, gfc_resolve_loc
,
3032 x
, BT_UNKNOWN
, 0, REQUIRED
);
3034 make_generic ("loc", GFC_ISYM_LOC
, GFC_STD_GNU
);
3036 /* The following function is internally used for coarray libray functions.
3037 "make_from_module" makes it inaccessible for external users. */
3038 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET
, CLASS_IMPURE
, ACTUAL_NO
,
3039 BT_REAL
, dr
, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3040 x
, BT_REAL
, dr
, REQUIRED
);
3045 /* Add intrinsic subroutines. */
3048 add_subroutines (void)
3050 /* Argument names as in the standard (to be used as argument keywords). */
3052 *a
= "a", *h
= "harvest", *dt
= "date", *vl
= "values", *pt
= "put",
3053 *c
= "count", *tm
= "time", *tp
= "topos", *gt
= "get",
3054 *t
= "to", *zn
= "zone", *fp
= "frompos", *cm
= "count_max",
3055 *f
= "from", *sz
= "size", *ln
= "len", *cr
= "count_rate",
3056 *com
= "command", *length
= "length", *st
= "status",
3057 *val
= "value", *num
= "number", *name
= "name",
3058 *trim_name
= "trim_name", *ut
= "unit", *han
= "handler",
3059 *sec
= "seconds", *res
= "result", *of
= "offset", *md
= "mode",
3060 *whence
= "whence", *pos
= "pos", *ptr
= "ptr", *p1
= "path1",
3061 *p2
= "path2", *msk
= "mask", *old
= "old", *result_image
= "result_image",
3062 *stat
= "stat", *errmsg
= "errmsg";
3064 int di
, dr
, dc
, dl
, ii
;
3066 di
= gfc_default_integer_kind
;
3067 dr
= gfc_default_real_kind
;
3068 dc
= gfc_default_character_kind
;
3069 dl
= gfc_default_logical_kind
;
3070 ii
= gfc_index_integer_kind
;
3072 add_sym_0s ("abort", GFC_ISYM_ABORT
, GFC_STD_GNU
, NULL
);
3076 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF
, CLASS_ATOMIC
,
3077 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3078 gfc_check_atomic_def
, NULL
, gfc_resolve_atomic_def
,
3079 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3080 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3081 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3083 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF
, CLASS_ATOMIC
,
3084 BT_UNKNOWN
, 0, GFC_STD_F2008
,
3085 gfc_check_atomic_ref
, NULL
, gfc_resolve_atomic_ref
,
3086 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3087 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3088 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3090 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS
, CLASS_ATOMIC
,
3091 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3092 gfc_check_atomic_cas
, NULL
, NULL
,
3093 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3094 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3095 "compare", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3096 "new", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3097 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3099 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD
, CLASS_ATOMIC
,
3100 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3101 gfc_check_atomic_op
, NULL
, NULL
,
3102 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3103 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3104 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3106 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND
, CLASS_ATOMIC
,
3107 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3108 gfc_check_atomic_op
, NULL
, NULL
,
3109 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3110 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3111 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3113 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR
, CLASS_ATOMIC
,
3114 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3115 gfc_check_atomic_op
, NULL
, NULL
,
3116 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3117 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3118 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3120 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR
, CLASS_ATOMIC
,
3121 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3122 gfc_check_atomic_op
, NULL
, NULL
,
3123 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3124 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3125 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3127 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD
, CLASS_ATOMIC
,
3128 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3129 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3130 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3131 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3132 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3133 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3135 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND
, CLASS_ATOMIC
,
3136 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3137 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3138 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3139 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3140 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3141 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3143 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR
, CLASS_ATOMIC
,
3144 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3145 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3146 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3147 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3148 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3149 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3151 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR
, CLASS_ATOMIC
,
3152 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3153 gfc_check_atomic_fetch_op
, NULL
, NULL
,
3154 "atom", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3155 "value", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3156 "old", BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3157 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3159 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE
, GFC_STD_GNU
, NULL
);
3161 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3162 GFC_STD_F95
, gfc_check_cpu_time
, NULL
, gfc_resolve_cpu_time
,
3163 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3165 /* More G77 compatibility garbage. */
3166 add_sym_2s ("ctime", GFC_ISYM_CTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3167 gfc_check_ctime_sub
, NULL
, gfc_resolve_ctime_sub
,
3168 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3169 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3171 add_sym_1s ("idate", GFC_ISYM_IDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3172 gfc_check_itime_idate
, NULL
, gfc_resolve_idate
,
3173 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3175 add_sym_1s ("itime", GFC_ISYM_ITIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3176 gfc_check_itime_idate
, NULL
, gfc_resolve_itime
,
3177 vl
, BT_INTEGER
, 4, REQUIRED
, INTENT_OUT
);
3179 add_sym_2s ("ltime", GFC_ISYM_LTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3180 gfc_check_ltime_gmtime
, NULL
, gfc_resolve_ltime
,
3181 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3182 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3184 add_sym_2s ("gmtime", GFC_ISYM_GMTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3185 GFC_STD_GNU
, gfc_check_ltime_gmtime
, NULL
, gfc_resolve_gmtime
,
3186 tm
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3187 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
);
3189 add_sym_1s ("second", GFC_ISYM_SECOND
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3190 GFC_STD_GNU
, gfc_check_second_sub
, NULL
, gfc_resolve_second_sub
,
3191 tm
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3193 add_sym_2s ("chdir", GFC_ISYM_CHDIR
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3194 gfc_check_chdir_sub
, NULL
, gfc_resolve_chdir_sub
,
3195 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3196 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3198 add_sym_3s ("chmod", GFC_ISYM_CHMOD
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3199 gfc_check_chmod_sub
, NULL
, gfc_resolve_chmod_sub
,
3200 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3201 md
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3202 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3204 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME
, CLASS_IMPURE
, BT_UNKNOWN
,
3205 0, GFC_STD_F95
, gfc_check_date_and_time
, NULL
, NULL
,
3206 dt
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3207 tm
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3208 zn
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3209 vl
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3211 /* More G77 compatibility garbage. */
3212 add_sym_2s ("etime", GFC_ISYM_ETIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3213 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_etime_sub
,
3214 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3215 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3217 add_sym_2s ("dtime", GFC_ISYM_DTIME
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3218 gfc_check_dtime_etime_sub
, NULL
, gfc_resolve_dtime_sub
,
3219 vl
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
,
3220 tm
, BT_REAL
, 4, REQUIRED
, INTENT_OUT
);
3222 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE
,
3223 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2008
,
3224 NULL
, NULL
, gfc_resolve_execute_command_line
,
3225 "command", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3226 "wait", BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
,
3227 "exitstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_INOUT
,
3228 "cmdstat", BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3229 "cmdmsg", BT_CHARACTER
, dc
, OPTIONAL
, INTENT_INOUT
);
3231 add_sym_1s ("fdate", GFC_ISYM_FDATE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3232 gfc_check_fdate_sub
, NULL
, gfc_resolve_fdate_sub
,
3233 dt
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3235 add_sym_1s ("gerror", GFC_ISYM_GERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3236 0, GFC_STD_GNU
, gfc_check_gerror
, NULL
, gfc_resolve_gerror
,
3237 res
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3239 add_sym_2s ("getcwd", GFC_ISYM_GETCWD
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3240 GFC_STD_GNU
, gfc_check_getcwd_sub
, NULL
, gfc_resolve_getcwd_sub
,
3241 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3242 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3244 add_sym_2s ("getenv", GFC_ISYM_GETENV
, CLASS_IMPURE
, BT_UNKNOWN
,
3245 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3246 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3247 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3249 add_sym_2s ("getarg", GFC_ISYM_GETARG
, CLASS_IMPURE
, BT_UNKNOWN
,
3250 0, GFC_STD_GNU
, gfc_check_getarg
, NULL
, gfc_resolve_getarg
,
3251 pos
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3252 val
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3254 add_sym_1s ("getlog", GFC_ISYM_GETLOG
, CLASS_IMPURE
, BT_UNKNOWN
,
3255 0, GFC_STD_GNU
, gfc_check_getlog
, NULL
, gfc_resolve_getlog
,
3256 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3258 /* F2003 commandline routines. */
3260 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND
, CLASS_IMPURE
,
3261 BT_UNKNOWN
, 0, GFC_STD_F2003
,
3262 NULL
, NULL
, gfc_resolve_get_command
,
3263 com
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3264 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3265 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3267 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT
,
3268 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
, NULL
, NULL
,
3269 gfc_resolve_get_command_argument
,
3270 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3271 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3272 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3273 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3275 /* F2003 subroutine to get environment variables. */
3277 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE
,
3278 CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_F2003
,
3279 NULL
, NULL
, gfc_resolve_get_environment_variable
,
3280 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3281 val
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
,
3282 length
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3283 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3284 trim_name
, BT_LOGICAL
, dl
, OPTIONAL
, INTENT_IN
);
3286 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC
, CLASS_PURE
, BT_UNKNOWN
, 0,
3288 gfc_check_move_alloc
, NULL
, NULL
,
3289 f
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_INOUT
,
3290 t
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3292 add_sym_5s ("mvbits", GFC_ISYM_MVBITS
, CLASS_ELEMENTAL
, BT_UNKNOWN
, 0,
3293 GFC_STD_F95
, gfc_check_mvbits
, gfc_simplify_mvbits
,
3295 f
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3296 fp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3297 ln
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3298 t
, BT_INTEGER
, di
, REQUIRED
, INTENT_INOUT
,
3299 tp
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3301 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER
, CLASS_IMPURE
,
3302 BT_UNKNOWN
, 0, GFC_STD_F95
,
3303 gfc_check_random_number
, NULL
, gfc_resolve_random_number
,
3304 h
, BT_REAL
, dr
, REQUIRED
, INTENT_OUT
);
3306 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED
, CLASS_IMPURE
,
3307 BT_UNKNOWN
, 0, GFC_STD_F95
,
3308 gfc_check_random_seed
, NULL
, gfc_resolve_random_seed
,
3309 sz
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3310 pt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3311 gt
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3313 /* The following subroutines are part of ISO_C_BINDING. */
3315 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3316 GFC_STD_F2003
, gfc_check_c_f_pointer
, NULL
, NULL
,
3317 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3318 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
,
3319 "shape", BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3322 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER
, CLASS_IMPURE
,
3323 BT_UNKNOWN
, 0, GFC_STD_F2003
, gfc_check_c_f_procpointer
,
3325 "cptr", BT_VOID
, 0, REQUIRED
, INTENT_IN
,
3326 "fptr", BT_UNKNOWN
, 0, REQUIRED
, INTENT_OUT
);
3329 /* Internal subroutine for emitting a runtime error. */
3331 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR
, CLASS_IMPURE
,
3332 BT_UNKNOWN
, 0, GFC_STD_GNU
,
3333 gfc_check_fe_runtime_error
, NULL
, gfc_resolve_fe_runtime_error
,
3334 "msg", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3338 make_from_module ();
3340 /* Coarray collectives. */
3341 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST
, CLASS_IMPURE
,
3342 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3343 gfc_check_co_broadcast
, NULL
, NULL
,
3344 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3345 "source_image", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3346 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3347 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3349 add_sym_4s ("co_max", GFC_ISYM_CO_MAX
, CLASS_IMPURE
,
3350 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3351 gfc_check_co_minmax
, NULL
, NULL
,
3352 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3353 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3354 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3355 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3357 add_sym_4s ("co_min", GFC_ISYM_CO_MIN
, CLASS_IMPURE
,
3358 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3359 gfc_check_co_minmax
, NULL
, NULL
,
3360 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3361 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3362 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3363 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3365 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM
, CLASS_IMPURE
,
3366 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3367 gfc_check_co_sum
, NULL
, NULL
,
3368 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3369 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3370 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3371 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3373 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE
, CLASS_IMPURE
,
3374 BT_UNKNOWN
, 0, GFC_STD_F2008_TS
,
3375 gfc_check_co_reduce
, NULL
, NULL
,
3376 a
, BT_REAL
, dr
, REQUIRED
, INTENT_INOUT
,
3377 "operator", BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3378 result_image
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
,
3379 stat
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3380 errmsg
, BT_CHARACTER
, dc
, OPTIONAL
, INTENT_OUT
);
3383 /* The following subroutine is internally used for coarray libray functions.
3384 "make_from_module" makes it inaccessible for external users. */
3385 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND
, CLASS_IMPURE
,
3386 BT_UNKNOWN
, 0, GFC_STD_GNU
, NULL
, NULL
, NULL
,
3387 "x", BT_REAL
, dr
, REQUIRED
, INTENT_OUT
,
3388 "y", BT_REAL
, dr
, REQUIRED
, INTENT_IN
);
3392 /* More G77 compatibility garbage. */
3393 add_sym_3s ("alarm", GFC_ISYM_ALARM
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3394 gfc_check_alarm_sub
, NULL
, gfc_resolve_alarm_sub
,
3395 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3396 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3397 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3399 add_sym_1s ("srand", GFC_ISYM_SRAND
, CLASS_IMPURE
, BT_UNKNOWN
,
3400 di
, GFC_STD_GNU
, gfc_check_srand
, NULL
, gfc_resolve_srand
,
3401 "seed", BT_INTEGER
, 4, REQUIRED
, INTENT_IN
);
3403 add_sym_1s ("exit", GFC_ISYM_EXIT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3404 gfc_check_exit
, NULL
, gfc_resolve_exit
,
3405 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3409 add_sym_3s ("fgetc", GFC_ISYM_FGETC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3410 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fgetc_sub
,
3411 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3412 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3413 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3415 add_sym_2s ("fget", GFC_ISYM_FGET
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3416 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fget_sub
,
3417 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3418 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3420 add_sym_1s ("flush", GFC_ISYM_FLUSH
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3421 gfc_check_flush
, NULL
, gfc_resolve_flush
,
3422 ut
, BT_INTEGER
, di
, OPTIONAL
, INTENT_IN
);
3424 add_sym_3s ("fputc", GFC_ISYM_FPUTC
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3425 gfc_check_fgetputc_sub
, NULL
, gfc_resolve_fputc_sub
,
3426 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3427 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3428 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3430 add_sym_2s ("fput", GFC_ISYM_FPUT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3431 gfc_check_fgetput_sub
, NULL
, gfc_resolve_fput_sub
,
3432 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3433 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3435 add_sym_1s ("free", GFC_ISYM_FREE
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3436 gfc_check_free
, NULL
, gfc_resolve_free
,
3437 ptr
, BT_INTEGER
, ii
, REQUIRED
, INTENT_INOUT
);
3439 add_sym_4s ("fseek", GFC_ISYM_FSEEK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3440 gfc_check_fseek_sub
, NULL
, gfc_resolve_fseek_sub
,
3441 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3442 of
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3443 whence
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3444 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3446 add_sym_2s ("ftell", GFC_ISYM_FTELL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3447 gfc_check_ftell_sub
, NULL
, gfc_resolve_ftell_sub
,
3448 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3449 of
, BT_INTEGER
, ii
, REQUIRED
, INTENT_OUT
);
3451 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3452 GFC_STD_GNU
, gfc_check_hostnm_sub
, NULL
, gfc_resolve_hostnm_sub
,
3453 c
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
,
3454 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3456 add_sym_3s ("kill", GFC_ISYM_KILL
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3457 gfc_check_kill_sub
, NULL
, gfc_resolve_kill_sub
,
3458 c
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3459 val
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3460 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3462 add_sym_3s ("link", GFC_ISYM_LINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3463 gfc_check_link_sub
, NULL
, gfc_resolve_link_sub
,
3464 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3465 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3466 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3468 add_sym_1s ("perror", GFC_ISYM_PERROR
, CLASS_IMPURE
, BT_UNKNOWN
,
3469 0, GFC_STD_GNU
, gfc_check_perror
, NULL
, gfc_resolve_perror
,
3470 "string", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
);
3472 add_sym_3s ("rename", GFC_ISYM_RENAME
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3473 GFC_STD_GNU
, gfc_check_rename_sub
, NULL
, gfc_resolve_rename_sub
,
3474 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3475 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3476 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3478 add_sym_1s ("sleep", GFC_ISYM_SLEEP
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3479 gfc_check_sleep_sub
, NULL
, gfc_resolve_sleep_sub
,
3480 sec
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
);
3482 add_sym_3s ("fstat", GFC_ISYM_FSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3483 gfc_check_fstat_sub
, NULL
, gfc_resolve_fstat_sub
,
3484 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3485 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3486 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3488 add_sym_3s ("lstat", GFC_ISYM_LSTAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3489 gfc_check_stat_sub
, NULL
, gfc_resolve_lstat_sub
,
3490 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3491 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3492 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3494 add_sym_3s ("stat", GFC_ISYM_STAT
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3495 gfc_check_stat_sub
, NULL
, gfc_resolve_stat_sub
,
3496 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3497 vl
, BT_INTEGER
, di
, REQUIRED
, INTENT_OUT
,
3498 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3500 add_sym_3s ("signal", GFC_ISYM_SIGNAL
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3501 GFC_STD_GNU
, gfc_check_signal_sub
, NULL
, gfc_resolve_signal_sub
,
3502 num
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3503 han
, BT_UNKNOWN
, 0, REQUIRED
, INTENT_IN
,
3504 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3506 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3507 GFC_STD_GNU
, gfc_check_symlnk_sub
, NULL
, gfc_resolve_symlnk_sub
,
3508 p1
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3509 p2
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3510 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3512 add_sym_2s ("system", GFC_ISYM_SYSTEM
, CLASS_IMPURE
, BT_UNKNOWN
,
3513 0, GFC_STD_GNU
, NULL
, NULL
, gfc_resolve_system_sub
,
3514 com
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3515 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3517 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK
, CLASS_IMPURE
,
3518 BT_UNKNOWN
, 0, GFC_STD_F95
,
3519 gfc_check_system_clock
, NULL
, gfc_resolve_system_clock
,
3520 c
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3521 cr
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
,
3522 cm
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3524 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3525 GFC_STD_GNU
, gfc_check_ttynam_sub
, NULL
, gfc_resolve_ttynam_sub
,
3526 ut
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3527 name
, BT_CHARACTER
, dc
, REQUIRED
, INTENT_OUT
);
3529 add_sym_2s ("umask", GFC_ISYM_UMASK
, CLASS_IMPURE
, BT_UNKNOWN
, 0, GFC_STD_GNU
,
3530 gfc_check_umask_sub
, NULL
, gfc_resolve_umask_sub
,
3531 msk
, BT_INTEGER
, di
, REQUIRED
, INTENT_IN
,
3532 old
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3534 add_sym_2s ("unlink", GFC_ISYM_UNLINK
, CLASS_IMPURE
, BT_UNKNOWN
, 0,
3535 GFC_STD_GNU
, gfc_check_unlink_sub
, NULL
, gfc_resolve_unlink_sub
,
3536 "path", BT_CHARACTER
, dc
, REQUIRED
, INTENT_IN
,
3537 st
, BT_INTEGER
, di
, OPTIONAL
, INTENT_OUT
);
3541 /* Add a function to the list of conversion symbols. */
3544 add_conv (bt from_type
, int from_kind
, bt to_type
, int to_kind
, int standard
)
3546 gfc_typespec from
, to
;
3547 gfc_intrinsic_sym
*sym
;
3549 if (sizing
== SZ_CONVS
)
3555 gfc_clear_ts (&from
);
3556 from
.type
= from_type
;
3557 from
.kind
= from_kind
;
3563 sym
= conversion
+ nconv
;
3565 sym
->name
= conv_name (&from
, &to
);
3566 sym
->lib_name
= sym
->name
;
3567 sym
->simplify
.cc
= gfc_convert_constant
;
3568 sym
->standard
= standard
;
3571 sym
->conversion
= 1;
3573 sym
->id
= GFC_ISYM_CONVERSION
;
3579 /* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3580 functions by looping over the kind tables. */
3583 add_conversions (void)
3587 /* Integer-Integer conversions. */
3588 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3589 for (j
= 0; gfc_integer_kinds
[j
].kind
!= 0; j
++)
3594 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3595 BT_INTEGER
, gfc_integer_kinds
[j
].kind
, GFC_STD_F77
);
3598 /* Integer-Real/Complex conversions. */
3599 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3600 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3602 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3603 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3605 add_conv (BT_REAL
, gfc_real_kinds
[j
].kind
,
3606 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3608 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3609 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3611 add_conv (BT_COMPLEX
, gfc_real_kinds
[j
].kind
,
3612 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_F77
);
3615 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3617 /* Hollerith-Integer conversions. */
3618 for (i
= 0; gfc_integer_kinds
[i
].kind
!= 0; i
++)
3619 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3620 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3621 /* Hollerith-Real conversions. */
3622 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3623 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3624 BT_REAL
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3625 /* Hollerith-Complex conversions. */
3626 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3627 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3628 BT_COMPLEX
, gfc_real_kinds
[i
].kind
, GFC_STD_LEGACY
);
3630 /* Hollerith-Character conversions. */
3631 add_conv (BT_HOLLERITH
, gfc_default_character_kind
, BT_CHARACTER
,
3632 gfc_default_character_kind
, GFC_STD_LEGACY
);
3634 /* Hollerith-Logical conversions. */
3635 for (i
= 0; gfc_logical_kinds
[i
].kind
!= 0; i
++)
3636 add_conv (BT_HOLLERITH
, gfc_default_character_kind
,
3637 BT_LOGICAL
, gfc_logical_kinds
[i
].kind
, GFC_STD_LEGACY
);
3640 /* Real/Complex - Real/Complex conversions. */
3641 for (i
= 0; gfc_real_kinds
[i
].kind
!= 0; i
++)
3642 for (j
= 0; gfc_real_kinds
[j
].kind
!= 0; j
++)
3646 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3647 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3649 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3650 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3653 add_conv (BT_REAL
, gfc_real_kinds
[i
].kind
,
3654 BT_COMPLEX
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3656 add_conv (BT_COMPLEX
, gfc_real_kinds
[i
].kind
,
3657 BT_REAL
, gfc_real_kinds
[j
].kind
, GFC_STD_F77
);
3660 /* Logical/Logical kind conversion. */
3661 for (i
= 0; gfc_logical_kinds
[i
].kind
; i
++)
3662 for (j
= 0; gfc_logical_kinds
[j
].kind
; j
++)
3667 add_conv (BT_LOGICAL
, gfc_logical_kinds
[i
].kind
,
3668 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_F77
);
3671 /* Integer-Logical and Logical-Integer conversions. */
3672 if ((gfc_option
.allow_std
& GFC_STD_LEGACY
) != 0)
3673 for (i
=0; gfc_integer_kinds
[i
].kind
; i
++)
3674 for (j
=0; gfc_logical_kinds
[j
].kind
; j
++)
3676 add_conv (BT_INTEGER
, gfc_integer_kinds
[i
].kind
,
3677 BT_LOGICAL
, gfc_logical_kinds
[j
].kind
, GFC_STD_LEGACY
);
3678 add_conv (BT_LOGICAL
, gfc_logical_kinds
[j
].kind
,
3679 BT_INTEGER
, gfc_integer_kinds
[i
].kind
, GFC_STD_LEGACY
);
3685 add_char_conversions (void)
3689 /* Count possible conversions. */
3690 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
3691 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
3695 /* Allocate memory. */
3696 char_conversions
= XCNEWVEC (gfc_intrinsic_sym
, ncharconv
);
3698 /* Add the conversions themselves. */
3700 for (i
= 0; gfc_character_kinds
[i
].kind
!= 0; i
++)
3701 for (j
= 0; gfc_character_kinds
[j
].kind
!= 0; j
++)
3703 gfc_typespec from
, to
;
3708 gfc_clear_ts (&from
);
3709 from
.type
= BT_CHARACTER
;
3710 from
.kind
= gfc_character_kinds
[i
].kind
;
3713 to
.type
= BT_CHARACTER
;
3714 to
.kind
= gfc_character_kinds
[j
].kind
;
3716 char_conversions
[n
].name
= conv_name (&from
, &to
);
3717 char_conversions
[n
].lib_name
= char_conversions
[n
].name
;
3718 char_conversions
[n
].simplify
.cc
= gfc_convert_char_constant
;
3719 char_conversions
[n
].standard
= GFC_STD_F2003
;
3720 char_conversions
[n
].elemental
= 1;
3721 char_conversions
[n
].pure
= 1;
3722 char_conversions
[n
].conversion
= 0;
3723 char_conversions
[n
].ts
= to
;
3724 char_conversions
[n
].id
= GFC_ISYM_CONVERSION
;
3731 /* Initialize the table of intrinsics. */
3733 gfc_intrinsic_init_1 (void)
3735 nargs
= nfunc
= nsub
= nconv
= 0;
3737 /* Create a namespace to hold the resolved intrinsic symbols. */
3738 gfc_intrinsic_namespace
= gfc_get_namespace (NULL
, 0);
3747 functions
= XCNEWVAR (struct gfc_intrinsic_sym
,
3748 sizeof (gfc_intrinsic_sym
) * (nfunc
+ nsub
)
3749 + sizeof (gfc_intrinsic_arg
) * nargs
);
3751 next_sym
= functions
;
3752 subroutines
= functions
+ nfunc
;
3754 conversion
= XCNEWVEC (gfc_intrinsic_sym
, nconv
);
3756 next_arg
= ((gfc_intrinsic_arg
*) (subroutines
+ nsub
)) - 1;
3758 sizing
= SZ_NOTHING
;
3765 /* Character conversion intrinsics need to be treated separately. */
3766 add_char_conversions ();
3771 gfc_intrinsic_done_1 (void)
3775 free (char_conversions
);
3776 gfc_free_namespace (gfc_intrinsic_namespace
);
3780 /******** Subroutines to check intrinsic interfaces ***********/
3782 /* Given a formal argument list, remove any NULL arguments that may
3783 have been left behind by a sort against some formal argument list. */
3786 remove_nullargs (gfc_actual_arglist
**ap
)
3788 gfc_actual_arglist
*head
, *tail
, *next
;
3792 for (head
= *ap
; head
; head
= next
)
3796 if (head
->expr
== NULL
&& !head
->label
)
3799 gfc_free_actual_arglist (head
);
3818 /* Given an actual arglist and a formal arglist, sort the actual
3819 arglist so that its arguments are in a one-to-one correspondence
3820 with the format arglist. Arguments that are not present are given
3821 a blank gfc_actual_arglist structure. If something is obviously
3822 wrong (say, a missing required argument) we abort sorting and
3826 sort_actual (const char *name
, gfc_actual_arglist
**ap
,
3827 gfc_intrinsic_arg
*formal
, locus
*where
)
3829 gfc_actual_arglist
*actual
, *a
;
3830 gfc_intrinsic_arg
*f
;
3832 remove_nullargs (ap
);
3835 for (f
= formal
; f
; f
= f
->next
)
3841 if (f
== NULL
&& a
== NULL
) /* No arguments */
3845 { /* Put the nonkeyword arguments in a 1:1 correspondence */
3851 if (a
->name
!= NULL
)
3863 gfc_error ("Too many arguments in call to %qs at %L", name
, where
);
3867 /* Associate the remaining actual arguments, all of which have
3868 to be keyword arguments. */
3869 for (; a
; a
= a
->next
)
3871 for (f
= formal
; f
; f
= f
->next
)
3872 if (strcmp (a
->name
, f
->name
) == 0)
3877 if (a
->name
[0] == '%')
3878 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3879 "are not allowed in this context at %L", where
);
3881 gfc_error ("Can't find keyword named %qs in call to %qs at %L",
3882 a
->name
, name
, where
);
3886 if (f
->actual
!= NULL
)
3888 gfc_error ("Argument %qs appears twice in call to %qs at %L",
3889 f
->name
, name
, where
);
3897 /* At this point, all unmatched formal args must be optional. */
3898 for (f
= formal
; f
; f
= f
->next
)
3900 if (f
->actual
== NULL
&& f
->optional
== 0)
3902 gfc_error ("Missing actual argument %qs in call to %qs at %L",
3903 f
->name
, name
, where
);
3909 /* Using the formal argument list, string the actual argument list
3910 together in a way that corresponds with the formal list. */
3913 for (f
= formal
; f
; f
= f
->next
)
3915 if (f
->actual
&& f
->actual
->label
!= NULL
&& f
->ts
.type
)
3917 gfc_error ("ALTERNATE RETURN not permitted at %L", where
);
3921 if (f
->actual
== NULL
)
3923 a
= gfc_get_actual_arglist ();
3924 a
->missing_arg_type
= f
->ts
.type
;
3936 actual
->next
= NULL
; /* End the sorted argument list. */
3942 /* Compare an actual argument list with an intrinsic's formal argument
3943 list. The lists are checked for agreement of type. We don't check
3944 for arrayness here. */
3947 check_arglist (gfc_actual_arglist
**ap
, gfc_intrinsic_sym
*sym
,
3950 gfc_actual_arglist
*actual
;
3951 gfc_intrinsic_arg
*formal
;
3954 formal
= sym
->formal
;
3958 for (; formal
; formal
= formal
->next
, actual
= actual
->next
, i
++)
3962 if (actual
->expr
== NULL
)
3967 /* A kind of 0 means we don't check for kind. */
3969 ts
.kind
= actual
->expr
->ts
.kind
;
3971 if (!gfc_compare_types (&ts
, &actual
->expr
->ts
))
3974 gfc_error ("Type of argument %qs in call to %qs at %L should "
3975 "be %s, not %s", gfc_current_intrinsic_arg
[i
]->name
,
3976 gfc_current_intrinsic
, &actual
->expr
->where
,
3977 gfc_typename (&formal
->ts
),
3978 gfc_typename (&actual
->expr
->ts
));
3982 /* If the formal argument is INTENT([IN]OUT), check for definability. */
3983 if (formal
->intent
== INTENT_INOUT
|| formal
->intent
== INTENT_OUT
)
3985 const char* context
= (error_flag
3986 ? _("actual argument to INTENT = OUT/INOUT")
3989 /* No pointer arguments for intrinsics. */
3990 if (!gfc_check_vardef_context (actual
->expr
, false, false, false, context
))
3999 /* Given a pointer to an intrinsic symbol and an expression node that
4000 represent the function call to that subroutine, figure out the type
4001 of the result. This may involve calling a resolution subroutine. */
4004 resolve_intrinsic (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4006 gfc_expr
*a1
, *a2
, *a3
, *a4
, *a5
;
4007 gfc_actual_arglist
*arg
;
4009 if (specific
->resolve
.f1
== NULL
)
4011 if (e
->value
.function
.name
== NULL
)
4012 e
->value
.function
.name
= specific
->lib_name
;
4014 if (e
->ts
.type
== BT_UNKNOWN
)
4015 e
->ts
= specific
->ts
;
4019 arg
= e
->value
.function
.actual
;
4021 /* Special case hacks for MIN and MAX. */
4022 if (specific
->resolve
.f1m
== gfc_resolve_max
4023 || specific
->resolve
.f1m
== gfc_resolve_min
)
4025 (*specific
->resolve
.f1m
) (e
, arg
);
4031 (*specific
->resolve
.f0
) (e
);
4040 (*specific
->resolve
.f1
) (e
, a1
);
4049 (*specific
->resolve
.f2
) (e
, a1
, a2
);
4058 (*specific
->resolve
.f3
) (e
, a1
, a2
, a3
);
4067 (*specific
->resolve
.f4
) (e
, a1
, a2
, a3
, a4
);
4076 (*specific
->resolve
.f5
) (e
, a1
, a2
, a3
, a4
, a5
);
4080 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4084 /* Given an intrinsic symbol node and an expression node, call the
4085 simplification function (if there is one), perhaps replacing the
4086 expression with something simpler. We return false on an error
4087 of the simplification, true if the simplification worked, even
4088 if nothing has changed in the expression itself. */
4091 do_simplify (gfc_intrinsic_sym
*specific
, gfc_expr
*e
)
4093 gfc_expr
*result
, *a1
, *a2
, *a3
, *a4
, *a5
;
4094 gfc_actual_arglist
*arg
;
4096 /* Max and min require special handling due to the variable number
4098 if (specific
->simplify
.f1
== gfc_simplify_min
)
4100 result
= gfc_simplify_min (e
);
4104 if (specific
->simplify
.f1
== gfc_simplify_max
)
4106 result
= gfc_simplify_max (e
);
4110 if (specific
->simplify
.f1
== NULL
)
4116 arg
= e
->value
.function
.actual
;
4120 result
= (*specific
->simplify
.f0
) ();
4127 if (specific
->simplify
.cc
== gfc_convert_constant
4128 || specific
->simplify
.cc
== gfc_convert_char_constant
)
4130 result
= specific
->simplify
.cc (a1
, specific
->ts
.type
, specific
->ts
.kind
);
4135 result
= (*specific
->simplify
.f1
) (a1
);
4142 result
= (*specific
->simplify
.f2
) (a1
, a2
);
4149 result
= (*specific
->simplify
.f3
) (a1
, a2
, a3
);
4156 result
= (*specific
->simplify
.f4
) (a1
, a2
, a3
, a4
);
4163 result
= (*specific
->simplify
.f5
) (a1
, a2
, a3
, a4
, a5
);
4166 ("do_simplify(): Too many args for intrinsic");
4173 if (result
== &gfc_bad_expr
)
4177 resolve_intrinsic (specific
, e
); /* Must call at run-time */
4180 result
->where
= e
->where
;
4181 gfc_replace_expr (e
, result
);
4188 /* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
4189 error messages. This subroutine returns false if a subroutine
4190 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4191 list cannot match any intrinsic. */
4194 init_arglist (gfc_intrinsic_sym
*isym
)
4196 gfc_intrinsic_arg
*formal
;
4199 gfc_current_intrinsic
= isym
->name
;
4202 for (formal
= isym
->formal
; formal
; formal
= formal
->next
)
4204 if (i
>= MAX_INTRINSIC_ARGS
)
4205 gfc_internal_error ("init_arglist(): too many arguments");
4206 gfc_current_intrinsic_arg
[i
++] = formal
;
4211 /* Given a pointer to an intrinsic symbol and an expression consisting
4212 of a function call, see if the function call is consistent with the
4213 intrinsic's formal argument list. Return true if the expression
4214 and intrinsic match, false otherwise. */
4217 check_specific (gfc_intrinsic_sym
*specific
, gfc_expr
*expr
, int error_flag
)
4219 gfc_actual_arglist
*arg
, **ap
;
4222 ap
= &expr
->value
.function
.actual
;
4224 init_arglist (specific
);
4226 /* Don't attempt to sort the argument list for min or max. */
4227 if (specific
->check
.f1m
== gfc_check_min_max
4228 || specific
->check
.f1m
== gfc_check_min_max_integer
4229 || specific
->check
.f1m
== gfc_check_min_max_real
4230 || specific
->check
.f1m
== gfc_check_min_max_double
)
4232 if (!do_ts29113_check (specific
, *ap
))
4234 return (*specific
->check
.f1m
) (*ap
);
4237 if (!sort_actual (specific
->name
, ap
, specific
->formal
, &expr
->where
))
4240 if (!do_ts29113_check (specific
, *ap
))
4243 if (specific
->check
.f3ml
== gfc_check_minloc_maxloc
)
4244 /* This is special because we might have to reorder the argument list. */
4245 t
= gfc_check_minloc_maxloc (*ap
);
4246 else if (specific
->check
.f3red
== gfc_check_minval_maxval
)
4247 /* This is also special because we also might have to reorder the
4249 t
= gfc_check_minval_maxval (*ap
);
4250 else if (specific
->check
.f3red
== gfc_check_product_sum
)
4251 /* Same here. The difference to the previous case is that we allow a
4252 general numeric type. */
4253 t
= gfc_check_product_sum (*ap
);
4254 else if (specific
->check
.f3red
== gfc_check_transf_bit_intrins
)
4255 /* Same as for PRODUCT and SUM, but different checks. */
4256 t
= gfc_check_transf_bit_intrins (*ap
);
4259 if (specific
->check
.f1
== NULL
)
4261 t
= check_arglist (ap
, specific
, error_flag
);
4263 expr
->ts
= specific
->ts
;
4266 t
= do_check (specific
, *ap
);
4269 /* Check conformance of elemental intrinsics. */
4270 if (t
&& specific
->elemental
)
4273 gfc_expr
*first_expr
;
4274 arg
= expr
->value
.function
.actual
;
4276 /* There is no elemental intrinsic without arguments. */
4277 gcc_assert(arg
!= NULL
);
4278 first_expr
= arg
->expr
;
4280 for ( ; arg
&& arg
->expr
; arg
= arg
->next
, n
++)
4281 if (!gfc_check_conformance (first_expr
, arg
->expr
,
4282 "arguments '%s' and '%s' for "
4284 gfc_current_intrinsic_arg
[0]->name
,
4285 gfc_current_intrinsic_arg
[n
]->name
,
4286 gfc_current_intrinsic
))
4291 remove_nullargs (ap
);
4297 /* Check whether an intrinsic belongs to whatever standard the user
4298 has chosen, taking also into account -fall-intrinsics. Here, no
4299 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4300 textual representation of the symbols standard status (like
4301 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4302 can be used to construct a detailed warning/error message in case of
4306 gfc_check_intrinsic_standard (const gfc_intrinsic_sym
* isym
,
4307 const char** symstd
, bool silent
, locus where
)
4309 const char* symstd_msg
;
4311 /* For -fall-intrinsics, just succeed. */
4312 if (flag_all_intrinsics
)
4315 /* Find the symbol's standard message for later usage. */
4316 switch (isym
->standard
)
4319 symstd_msg
= "available since Fortran 77";
4322 case GFC_STD_F95_OBS
:
4323 symstd_msg
= "obsolescent in Fortran 95";
4326 case GFC_STD_F95_DEL
:
4327 symstd_msg
= "deleted in Fortran 95";
4331 symstd_msg
= "new in Fortran 95";
4335 symstd_msg
= "new in Fortran 2003";
4339 symstd_msg
= "new in Fortran 2008";
4342 case GFC_STD_F2008_TS
:
4343 symstd_msg
= "new in TS 29113/TS 18508";
4347 symstd_msg
= "a GNU Fortran extension";
4350 case GFC_STD_LEGACY
:
4351 symstd_msg
= "for backward compatibility";
4355 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
4356 isym
->name
, isym
->standard
);
4359 /* If warning about the standard, warn and succeed. */
4360 if (gfc_option
.warn_std
& isym
->standard
)
4362 /* Do only print a warning if not a GNU extension. */
4363 if (!silent
&& isym
->standard
!= GFC_STD_GNU
)
4364 gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
4365 isym
->name
, _(symstd_msg
), &where
);
4370 /* If allowing the symbol's standard, succeed, too. */
4371 if (gfc_option
.allow_std
& isym
->standard
)
4374 /* Otherwise, fail. */
4376 *symstd
= _(symstd_msg
);
4381 /* See if a function call corresponds to an intrinsic function call.
4384 MATCH_YES if the call corresponds to an intrinsic, simplification
4385 is done if possible.
4387 MATCH_NO if the call does not correspond to an intrinsic
4389 MATCH_ERROR if the call corresponds to an intrinsic but there was an
4390 error during the simplification process.
4392 The error_flag parameter enables an error reporting. */
4395 gfc_intrinsic_func_interface (gfc_expr
*expr
, int error_flag
)
4397 gfc_intrinsic_sym
*isym
, *specific
;
4398 gfc_actual_arglist
*actual
;
4402 if (expr
->value
.function
.isym
!= NULL
)
4403 return (!do_simplify(expr
->value
.function
.isym
, expr
))
4404 ? MATCH_ERROR
: MATCH_YES
;
4407 gfc_push_suppress_errors ();
4410 for (actual
= expr
->value
.function
.actual
; actual
; actual
= actual
->next
)
4411 if (actual
->expr
!= NULL
)
4412 flag
|= (actual
->expr
->ts
.type
!= BT_INTEGER
4413 && actual
->expr
->ts
.type
!= BT_CHARACTER
);
4415 name
= expr
->symtree
->n
.sym
->name
;
4417 if (expr
->symtree
->n
.sym
->intmod_sym_id
)
4419 gfc_isym_id id
= gfc_isym_id_by_intmod_sym (expr
->symtree
->n
.sym
);
4420 isym
= specific
= gfc_intrinsic_function_by_id (id
);
4423 isym
= specific
= gfc_find_function (name
);
4428 gfc_pop_suppress_errors ();
4432 if ((isym
->id
== GFC_ISYM_REAL
|| isym
->id
== GFC_ISYM_DBLE
4433 || isym
->id
== GFC_ISYM_CMPLX
)
4434 && gfc_init_expr_flag
4435 && !gfc_notify_std (GFC_STD_F2003
, "Function %qs as initialization "
4436 "expression at %L", name
, &expr
->where
))
4439 gfc_pop_suppress_errors ();
4443 gfc_current_intrinsic_where
= &expr
->where
;
4445 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
4446 if (isym
->check
.f1m
== gfc_check_min_max
)
4448 init_arglist (isym
);
4450 if (isym
->check
.f1m(expr
->value
.function
.actual
))
4454 gfc_pop_suppress_errors ();
4458 /* If the function is generic, check all of its specific
4459 incarnations. If the generic name is also a specific, we check
4460 that name last, so that any error message will correspond to the
4462 gfc_push_suppress_errors ();
4466 for (specific
= isym
->specific_head
; specific
;
4467 specific
= specific
->next
)
4469 if (specific
== isym
)
4471 if (check_specific (specific
, expr
, 0))
4473 gfc_pop_suppress_errors ();
4479 gfc_pop_suppress_errors ();
4481 if (!check_specific (isym
, expr
, error_flag
))
4484 gfc_pop_suppress_errors ();
4491 expr
->value
.function
.isym
= specific
;
4492 if (!expr
->symtree
->n
.sym
->module
)
4493 gfc_intrinsic_symbol (expr
->symtree
->n
.sym
);
4496 gfc_pop_suppress_errors ();
4498 if (!do_simplify (specific
, expr
))
4501 /* F95, 7.1.6.1, Initialization expressions
4502 (4) An elemental intrinsic function reference of type integer or
4503 character where each argument is an initialization expression
4504 of type integer or character
4506 F2003, 7.1.7 Initialization expression
4507 (4) A reference to an elemental standard intrinsic function,
4508 where each argument is an initialization expression */
4510 if (gfc_init_expr_flag
&& isym
->elemental
&& flag
4511 && !gfc_notify_std (GFC_STD_F2003
, "Elemental function as "
4512 "initialization expression with non-integer/non-"
4513 "character arguments at %L", &expr
->where
))
4520 /* See if a CALL statement corresponds to an intrinsic subroutine.
4521 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4522 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4526 gfc_intrinsic_sub_interface (gfc_code
*c
, int error_flag
)
4528 gfc_intrinsic_sym
*isym
;
4531 name
= c
->symtree
->n
.sym
->name
;
4533 if (c
->symtree
->n
.sym
->intmod_sym_id
)
4536 id
= gfc_isym_id_by_intmod_sym (c
->symtree
->n
.sym
);
4537 isym
= gfc_intrinsic_subroutine_by_id (id
);
4540 isym
= gfc_find_subroutine (name
);
4545 gfc_push_suppress_errors ();
4547 init_arglist (isym
);
4549 if (!isym
->vararg
&& !sort_actual (name
, &c
->ext
.actual
, isym
->formal
, &c
->loc
))
4552 if (!do_ts29113_check (isym
, c
->ext
.actual
))
4555 if (isym
->check
.f1
!= NULL
)
4557 if (!do_check (isym
, c
->ext
.actual
))
4562 if (!check_arglist (&c
->ext
.actual
, isym
, 1))
4566 /* The subroutine corresponds to an intrinsic. Allow errors to be
4567 seen at this point. */
4569 gfc_pop_suppress_errors ();
4571 c
->resolved_isym
= isym
;
4572 if (isym
->resolve
.s1
!= NULL
)
4573 isym
->resolve
.s1 (c
);
4576 c
->resolved_sym
= gfc_get_intrinsic_sub_symbol (isym
->lib_name
);
4577 c
->resolved_sym
->attr
.elemental
= isym
->elemental
;
4580 if (gfc_do_concurrent_flag
&& !isym
->pure
)
4582 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
4583 "block at %L is not PURE", name
, &c
->loc
);
4587 if (!isym
->pure
&& gfc_pure (NULL
))
4589 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name
,
4595 gfc_unset_implicit_pure (NULL
);
4597 c
->resolved_sym
->attr
.noreturn
= isym
->noreturn
;
4603 gfc_pop_suppress_errors ();
4608 /* Call gfc_convert_type() with warning enabled. */
4611 gfc_convert_type (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
)
4613 return gfc_convert_type_warn (expr
, ts
, eflag
, 1);
4617 /* Try to convert an expression (in place) from one type to another.
4618 'eflag' controls the behavior on error.
4620 The possible values are:
4622 1 Generate a gfc_error()
4623 2 Generate a gfc_internal_error().
4625 'wflag' controls the warning related to conversion. */
4628 gfc_convert_type_warn (gfc_expr
*expr
, gfc_typespec
*ts
, int eflag
, int wflag
)
4630 gfc_intrinsic_sym
*sym
;
4631 gfc_typespec from_ts
;
4637 from_ts
= expr
->ts
; /* expr->ts gets clobbered */
4639 if (ts
->type
== BT_UNKNOWN
)
4642 /* NULL and zero size arrays get their type here. */
4643 if (expr
->expr_type
== EXPR_NULL
4644 || (expr
->expr_type
== EXPR_ARRAY
&& expr
->value
.constructor
== NULL
))
4646 /* Sometimes the RHS acquire the type. */
4651 if (expr
->ts
.type
== BT_UNKNOWN
)
4654 if (expr
->ts
.type
== BT_DERIVED
&& ts
->type
== BT_DERIVED
4655 && gfc_compare_types (&expr
->ts
, ts
))
4658 sym
= find_conv (&expr
->ts
, ts
);
4662 /* At this point, a conversion is necessary. A warning may be needed. */
4663 if ((gfc_option
.warn_std
& sym
->standard
) != 0)
4665 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
4666 gfc_typename (&from_ts
), gfc_typename (ts
),
4671 if (flag_range_check
&& expr
->expr_type
== EXPR_CONSTANT
4672 && from_ts
.type
== ts
->type
)
4674 /* Do nothing. Constants of the same type are range-checked
4675 elsewhere. If a value too large for the target type is
4676 assigned, an error is generated. Not checking here avoids
4677 duplications of warnings/errors.
4678 If range checking was disabled, but -Wconversion enabled,
4679 a non range checked warning is generated below. */
4681 else if (from_ts
.type
== BT_LOGICAL
|| ts
->type
== BT_LOGICAL
)
4683 /* Do nothing. This block exists only to simplify the other
4684 else-if expressions.
4685 LOGICAL <> LOGICAL no warning, independent of kind values
4686 LOGICAL <> INTEGER extension, warned elsewhere
4687 LOGICAL <> REAL invalid, error generated elsewhere
4688 LOGICAL <> COMPLEX invalid, error generated elsewhere */
4690 else if (from_ts
.type
== ts
->type
4691 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_REAL
)
4692 || (from_ts
.type
== BT_INTEGER
&& ts
->type
== BT_COMPLEX
)
4693 || (from_ts
.type
== BT_REAL
&& ts
->type
== BT_COMPLEX
))
4695 /* Larger kinds can hold values of smaller kinds without problems.
4696 Hence, only warn if target kind is smaller than the source
4697 kind - or if -Wconversion-extra is specified. */
4698 if (warn_conversion
&& from_ts
.kind
> ts
->kind
)
4699 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
4700 "conversion from %s to %s at %L",
4701 gfc_typename (&from_ts
), gfc_typename (ts
),
4703 else if (warn_conversion_extra
)
4704 gfc_warning_now (OPT_Wconversion_extra
, "Conversion from %s to %s "
4705 "at %L", gfc_typename (&from_ts
),
4706 gfc_typename (ts
), &expr
->where
);
4708 else if ((from_ts
.type
== BT_REAL
&& ts
->type
== BT_INTEGER
)
4709 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_INTEGER
)
4710 || (from_ts
.type
== BT_COMPLEX
&& ts
->type
== BT_REAL
))
4712 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4713 usually comes with a loss of information, regardless of kinds. */
4714 if (warn_conversion
)
4715 gfc_warning_now (OPT_Wconversion
, "Possible change of value in "
4716 "conversion from %s to %s at %L",
4717 gfc_typename (&from_ts
), gfc_typename (ts
),
4720 else if (from_ts
.type
== BT_HOLLERITH
|| ts
->type
== BT_HOLLERITH
)
4722 /* If HOLLERITH is involved, all bets are off. */
4723 if (warn_conversion
)
4724 gfc_warning_now (OPT_Wconversion
, "Conversion from %s to %s at %L",
4725 gfc_typename (&from_ts
), gfc_typename (ts
),
4732 /* Insert a pre-resolved function call to the right function. */
4733 old_where
= expr
->where
;
4735 shape
= expr
->shape
;
4737 new_expr
= gfc_get_expr ();
4740 new_expr
= gfc_build_conversion (new_expr
);
4741 new_expr
->value
.function
.name
= sym
->lib_name
;
4742 new_expr
->value
.function
.isym
= sym
;
4743 new_expr
->where
= old_where
;
4744 new_expr
->rank
= rank
;
4745 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
4747 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
4748 new_expr
->symtree
->n
.sym
->result
= new_expr
->symtree
->n
.sym
;
4749 new_expr
->symtree
->n
.sym
->ts
= *ts
;
4750 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
4751 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
4752 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
4753 new_expr
->symtree
->n
.sym
->attr
.pure
= 1;
4754 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
4755 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
4756 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
4763 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
4764 && !do_simplify (sym
, expr
))
4769 return false; /* Error already generated in do_simplify() */
4777 gfc_error ("Can't convert %s to %s at %L",
4778 gfc_typename (&from_ts
), gfc_typename (ts
), &expr
->where
);
4782 gfc_internal_error ("Can't convert %qs to %qs at %L",
4783 gfc_typename (&from_ts
), gfc_typename (ts
),
4790 gfc_convert_chartype (gfc_expr
*expr
, gfc_typespec
*ts
)
4792 gfc_intrinsic_sym
*sym
;
4798 gcc_assert (expr
->ts
.type
== BT_CHARACTER
&& ts
->type
== BT_CHARACTER
);
4800 sym
= find_char_conv (&expr
->ts
, ts
);
4803 /* Insert a pre-resolved function call to the right function. */
4804 old_where
= expr
->where
;
4806 shape
= expr
->shape
;
4808 new_expr
= gfc_get_expr ();
4811 new_expr
= gfc_build_conversion (new_expr
);
4812 new_expr
->value
.function
.name
= sym
->lib_name
;
4813 new_expr
->value
.function
.isym
= sym
;
4814 new_expr
->where
= old_where
;
4815 new_expr
->rank
= rank
;
4816 new_expr
->shape
= gfc_copy_shape (shape
, rank
);
4818 gfc_get_ha_sym_tree (sym
->name
, &new_expr
->symtree
);
4819 new_expr
->symtree
->n
.sym
->ts
= *ts
;
4820 new_expr
->symtree
->n
.sym
->attr
.flavor
= FL_PROCEDURE
;
4821 new_expr
->symtree
->n
.sym
->attr
.function
= 1;
4822 new_expr
->symtree
->n
.sym
->attr
.elemental
= 1;
4823 new_expr
->symtree
->n
.sym
->attr
.referenced
= 1;
4824 gfc_intrinsic_symbol(new_expr
->symtree
->n
.sym
);
4825 gfc_commit_symbol (new_expr
->symtree
->n
.sym
);
4832 if (gfc_is_constant_expr (expr
->value
.function
.actual
->expr
)
4833 && !do_simplify (sym
, expr
))
4835 /* Error already generated in do_simplify() */
4843 /* Check if the passed name is name of an intrinsic (taking into account the
4844 current -std=* and -fall-intrinsic settings). If it is, see if we should
4845 warn about this as a user-procedure having the same name as an intrinsic
4846 (-Wintrinsic-shadow enabled) and do so if we should. */
4849 gfc_warn_intrinsic_shadow (const gfc_symbol
* sym
, bool in_module
, bool func
)
4851 gfc_intrinsic_sym
* isym
;
4853 /* If the warning is disabled, do nothing at all. */
4854 if (!warn_intrinsic_shadow
)
4857 /* Try to find an intrinsic of the same name. */
4859 isym
= gfc_find_function (sym
->name
);
4861 isym
= gfc_find_subroutine (sym
->name
);
4863 /* If no intrinsic was found with this name or it's not included in the
4864 selected standard, everything's fine. */
4865 if (!isym
|| !gfc_check_intrinsic_standard (isym
, NULL
, true,
4869 /* Emit the warning. */
4870 if (in_module
|| sym
->ns
->proc_name
)
4871 gfc_warning (OPT_Wintrinsic_shadow
,
4872 "%qs declared at %L may shadow the intrinsic of the same"
4873 " name. In order to call the intrinsic, explicit INTRINSIC"
4874 " declarations may be required.",
4875 sym
->name
, &sym
->declared_at
);
4877 gfc_warning (OPT_Wintrinsic_shadow
,
4878 "%qs declared at %L is also the name of an intrinsic. It can"
4879 " only be called via an explicit interface or if declared"
4880 " EXTERNAL.", sym
->name
, &sym
->declared_at
);