]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/intrinsic.c
libstdc++: Merge latest Ryu sources
[thirdparty/gcc.git] / gcc / fortran / intrinsic.c
CommitLineData
6de9cd9a
DN
1/* Build up a list of intrinsic subroutines and functions for the
2 name-resolution stage.
99dee823 3 Copyright (C) 2000-2021 Free Software Foundation, Inc.
6de9cd9a
DN
4 Contributed by Andy Vaught & Katherine Holcomb
5
9fc4d79b 6This file is part of GCC.
6de9cd9a 7
9fc4d79b
TS
8GCC is free software; you can redistribute it and/or modify it under
9the terms of the GNU General Public License as published by the Free
d234d788 10Software Foundation; either version 3, or (at your option) any later
9fc4d79b 11version.
6de9cd9a 12
9fc4d79b
TS
13GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14WARRANTY; without even the implied warranty of MERCHANTABILITY or
15FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16for more details.
6de9cd9a
DN
17
18You should have received a copy of the GNU General Public License
d234d788
NC
19along with GCC; see the file COPYING3. If not see
20<http://www.gnu.org/licenses/>. */
6de9cd9a 21
6de9cd9a
DN
22#include "config.h"
23#include "system.h"
953bee7c 24#include "coretypes.h"
1916bcb5 25#include "options.h"
6de9cd9a
DN
26#include "gfortran.h"
27#include "intrinsic.h"
28
1f2959f0 29/* Namespace to hold the resolved symbols for intrinsic subroutines. */
6de9cd9a
DN
30static gfc_namespace *gfc_intrinsic_namespace;
31
f2cbd86c 32bool gfc_init_expr_flag = false;
6de9cd9a 33
1270d633 34/* Pointers to an intrinsic function and its argument names that are being
f7b529fa 35 checked. */
6de9cd9a 36
cb9e4f55 37const char *gfc_current_intrinsic;
c4aa95f8 38gfc_intrinsic_arg *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
6de9cd9a
DN
39locus *gfc_current_intrinsic_where;
40
41static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
d393bbd7 42static gfc_intrinsic_sym *char_conversions;
6de9cd9a
DN
43static gfc_intrinsic_arg *next_arg;
44
d393bbd7 45static int nfunc, nsub, nargs, nconv, ncharconv;
6de9cd9a
DN
46
47static enum
48{ SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
49sizing;
50
9aa433c2 51enum klass
e6c14898 52{ CLASS_IMPURE = 0, CLASS_PURE, CLASS_ELEMENTAL,
da661a58 53 CLASS_INQUIRY, CLASS_TRANSFORMATIONAL, CLASS_ATOMIC };
8d2c2905
FXC
54
55#define ACTUAL_NO 0
56#define ACTUAL_YES 1
57
1270d633
SK
58#define REQUIRED 0
59#define OPTIONAL 1
6de9cd9a 60
b251af97 61
6de9cd9a 62/* Return a letter based on the passed type. Used to construct the
01ce9e31
TK
63 name of a type-dependent subroutine. If logical_equals_int is
64 true, we can treat a logical like an int. */
6de9cd9a
DN
65
66char
01ce9e31 67gfc_type_letter (bt type, bool logical_equals_int)
6de9cd9a
DN
68{
69 char c;
70
71 switch (type)
72 {
73 case BT_LOGICAL:
01ce9e31
TK
74 if (logical_equals_int)
75 c = 'i';
76 else
77 c = 'l';
78
6de9cd9a
DN
79 break;
80 case BT_CHARACTER:
81 c = 's';
82 break;
83 case BT_INTEGER:
84 c = 'i';
85 break;
86 case BT_REAL:
87 c = 'r';
88 break;
89 case BT_COMPLEX:
90 c = 'c';
91 break;
92
d3642f89
FW
93 case BT_HOLLERITH:
94 c = 'h';
95 break;
96
6de9cd9a
DN
97 default:
98 c = 'u';
99 break;
100 }
101
102 return c;
103}
104
105
42a8c358
TB
106/* Get a symbol for a resolved name. Note, if needed be, the elemental
107 attribute has be added afterwards. */
6de9cd9a
DN
108
109gfc_symbol *
b251af97 110gfc_get_intrinsic_sub_symbol (const char *name)
6de9cd9a
DN
111{
112 gfc_symbol *sym;
113
114 gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
115 sym->attr.always_explicit = 1;
116 sym->attr.subroutine = 1;
117 sym->attr.flavor = FL_PROCEDURE;
118 sym->attr.proc = PROC_INTRINSIC;
119
ef973f3f
MM
120 gfc_commit_symbol (sym);
121
6de9cd9a 122 return sym;
47d13acb
TK
123}
124
125/* Get a symbol for a resolved function, with its special name. The
126 actual argument list needs to be set by the caller. */
127
128gfc_symbol *
129gfc_get_intrinsic_function_symbol (gfc_expr *expr)
130{
131 gfc_symbol *sym;
132
133 gfc_get_symbol (expr->value.function.name, gfc_intrinsic_namespace, &sym);
134 sym->attr.external = 1;
135 sym->attr.function = 1;
136 sym->attr.always_explicit = 1;
137 sym->attr.proc = PROC_INTRINSIC;
138 sym->attr.flavor = FL_PROCEDURE;
139 sym->result = sym;
140 if (expr->rank > 0)
141 {
142 sym->attr.dimension = 1;
143 sym->as = gfc_get_array_spec ();
144 sym->as->type = AS_ASSUMED_SHAPE;
145 sym->as->rank = expr->rank;
146 }
147 return sym;
148}
149
150/* Find a symbol for a resolved intrinsic procedure, return NULL if
151 not found. */
152
153gfc_symbol *
154gfc_find_intrinsic_symbol (gfc_expr *expr)
155{
156 gfc_symbol *sym;
157 gfc_find_symbol (expr->value.function.name, gfc_intrinsic_namespace,
158 0, &sym);
159 return sym;
6de9cd9a
DN
160}
161
162
163/* Return a pointer to the name of a conversion function given two
164 typespecs. */
165
cb9e4f55 166static const char *
b251af97 167conv_name (gfc_typespec *from, gfc_typespec *to)
6de9cd9a 168{
b6e2128e
TS
169 return gfc_get_string ("__convert_%c%d_%c%d",
170 gfc_type_letter (from->type), from->kind,
171 gfc_type_letter (to->type), to->kind);
6de9cd9a
DN
172}
173
174
175/* Given a pair of typespecs, find the gfc_intrinsic_sym node that
176 corresponds to the conversion. Returns NULL if the conversion
177 isn't found. */
178
179static gfc_intrinsic_sym *
b251af97 180find_conv (gfc_typespec *from, gfc_typespec *to)
6de9cd9a
DN
181{
182 gfc_intrinsic_sym *sym;
cb9e4f55 183 const char *target;
6de9cd9a
DN
184 int i;
185
186 target = conv_name (from, to);
187 sym = conversion;
188
189 for (i = 0; i < nconv; i++, sym++)
b6e2128e 190 if (target == sym->name)
6de9cd9a
DN
191 return sym;
192
193 return NULL;
194}
195
196
d393bbd7
FXC
197/* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
198 that corresponds to the conversion. Returns NULL if the conversion
199 isn't found. */
200
201static gfc_intrinsic_sym *
202find_char_conv (gfc_typespec *from, gfc_typespec *to)
203{
204 gfc_intrinsic_sym *sym;
205 const char *target;
206 int i;
207
208 target = conv_name (from, to);
209 sym = char_conversions;
210
211 for (i = 0; i < ncharconv; i++, sym++)
212 if (target == sym->name)
213 return sym;
214
215 return NULL;
216}
217
218
bf7a73f9
TB
219/* Check TS29113, C407b for assumed type and C535b for assumed-rank,
220 and a likewise check for NO_ARG_CHECK. */
6de9cd9a 221
524af0d6 222static bool
bf7a73f9 223do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
6de9cd9a 224{
86307f49 225 gfc_actual_arglist *a;
ee11be7f 226 bool ok = true;
4c0c6b9f 227
86307f49
TB
228 for (a = arg; a; a = a->next)
229 {
230 if (!a->expr)
231 continue;
232
233 if (a->expr->expr_type == EXPR_VARIABLE
234 && (a->expr->symtree->n.sym->attr.ext_attr
235 & (1 << EXT_ATTR_NO_ARG_CHECK))
236 && specific->id != GFC_ISYM_C_LOC
237 && specific->id != GFC_ISYM_PRESENT)
238 {
239 gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only "
240 "permitted as argument to the intrinsic functions "
241 "C_LOC and PRESENT", &a->expr->where);
ee11be7f 242 ok = false;
86307f49
TB
243 }
244 else if (a->expr->ts.type == BT_ASSUMED
245 && specific->id != GFC_ISYM_LBOUND
246 && specific->id != GFC_ISYM_PRESENT
247 && specific->id != GFC_ISYM_RANK
248 && specific->id != GFC_ISYM_SHAPE
249 && specific->id != GFC_ISYM_SIZE
69c3654c 250 && specific->id != GFC_ISYM_SIZEOF
86307f49 251 && specific->id != GFC_ISYM_UBOUND
419af57c 252 && specific->id != GFC_ISYM_IS_CONTIGUOUS
86307f49
TB
253 && specific->id != GFC_ISYM_C_LOC)
254 {
255 gfc_error ("Assumed-type argument at %L is not permitted as actual"
256 " argument to the intrinsic %s", &a->expr->where,
257 gfc_current_intrinsic);
ee11be7f 258 ok = false;
86307f49
TB
259 }
260 else if (a->expr->ts.type == BT_ASSUMED && a != arg)
261 {
262 gfc_error ("Assumed-type argument at %L is only permitted as "
263 "first actual argument to the intrinsic %s",
264 &a->expr->where, gfc_current_intrinsic);
ee11be7f 265 ok = false;
86307f49 266 }
ee11be7f 267 else if (a->expr->rank == -1 && !specific->inquiry)
86307f49
TB
268 {
269 gfc_error ("Assumed-rank argument at %L is only permitted as actual "
270 "argument to intrinsic inquiry functions",
271 &a->expr->where);
ee11be7f 272 ok = false;
86307f49 273 }
ee11be7f 274 else if (a->expr->rank == -1 && arg != a)
86307f49
TB
275 {
276 gfc_error ("Assumed-rank argument at %L is only permitted as first "
277 "actual argument to the intrinsic inquiry function %s",
278 &a->expr->where, gfc_current_intrinsic);
ee11be7f 279 ok = false;
86307f49
TB
280 }
281 }
282
ee11be7f 283 return ok;
bf7a73f9
TB
284}
285
286
287/* Interface to the check functions. We break apart an argument list
288 and call the proper check function rather than forcing each
289 function to manipulate the argument list. */
290
291static bool
292do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
293{
294 gfc_expr *a1, *a2, *a3, *a4, *a5;
295
296 if (arg == NULL)
297 return (*specific->check.f0) ();
298
6de9cd9a
DN
299 a1 = arg->expr;
300 arg = arg->next;
4c0c6b9f
SK
301 if (arg == NULL)
302 return (*specific->check.f1) (a1);
6de9cd9a 303
4c0c6b9f
SK
304 a2 = arg->expr;
305 arg = arg->next;
6de9cd9a 306 if (arg == NULL)
4c0c6b9f 307 return (*specific->check.f2) (a1, a2);
6de9cd9a 308
4c0c6b9f
SK
309 a3 = arg->expr;
310 arg = arg->next;
311 if (arg == NULL)
312 return (*specific->check.f3) (a1, a2, a3);
6de9cd9a 313
4c0c6b9f
SK
314 a4 = arg->expr;
315 arg = arg->next;
316 if (arg == NULL)
317 return (*specific->check.f4) (a1, a2, a3, a4);
6de9cd9a 318
4c0c6b9f
SK
319 a5 = arg->expr;
320 arg = arg->next;
321 if (arg == NULL)
322 return (*specific->check.f5) (a1, a2, a3, a4, a5);
323
324 gfc_internal_error ("do_check(): too many args");
6de9cd9a
DN
325}
326
327
328/*********** Subroutines to build the intrinsic list ****************/
329
330/* Add a single intrinsic symbol to the current list.
331
332 Argument list:
333 char * name of function
b251af97
SK
334 int whether function is elemental
335 int If the function can be used as an actual argument [1]
336 bt return type of function
337 int kind of return type of function
338 int Fortran standard version
6de9cd9a
DN
339 check pointer to check function
340 simplify pointer to simplification function
341 resolve pointer to resolution function
342
23e38561
JW
343 Optional arguments come in multiples of five:
344 char * name of argument
345 bt type of argument
346 int kind of argument
347 int arg optional flag (1=optional, 0=required)
348 sym_intent intent of argument
6de9cd9a
DN
349
350 The sequence is terminated by a NULL name.
351
0e7e7e6e
FXC
352
353 [1] Whether a function can or cannot be used as an actual argument is
354 determined by its presence on the 13.6 list in Fortran 2003. The
355 following intrinsics, which are GNU extensions, are considered allowed
356 as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
e7c1c8d1 357 ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT. */
6de9cd9a
DN
358
359static void
9aa433c2 360add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
0e7e7e6e
FXC
361 int standard, gfc_check_f check, gfc_simplify_f simplify,
362 gfc_resolve_f resolve, ...)
6de9cd9a 363{
cb9e4f55 364 char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0' */
6de9cd9a 365 int optional, first_flag;
23e38561 366 sym_intent intent;
6de9cd9a
DN
367 va_list argp;
368
369 switch (sizing)
370 {
371 case SZ_SUBS:
372 nsub++;
373 break;
374
375 case SZ_FUNCS:
376 nfunc++;
377 break;
378
379 case SZ_NOTHING:
51f03c6b 380 next_sym->name = gfc_get_string ("%s", name);
6de9cd9a 381
cb9e4f55
TS
382 strcpy (buf, "_gfortran_");
383 strcat (buf, name);
51f03c6b 384 next_sym->lib_name = gfc_get_string ("%s", buf);
6de9cd9a 385
83f3bd62 386 next_sym->pure = (cl != CLASS_IMPURE);
e1633d82
DF
387 next_sym->elemental = (cl == CLASS_ELEMENTAL);
388 next_sym->inquiry = (cl == CLASS_INQUIRY);
389 next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
0e7e7e6e 390 next_sym->actual_ok = actual_ok;
6de9cd9a
DN
391 next_sym->ts.type = type;
392 next_sym->ts.kind = kind;
b7892582 393 next_sym->standard = standard;
6de9cd9a
DN
394 next_sym->simplify = simplify;
395 next_sym->check = check;
396 next_sym->resolve = resolve;
397 next_sym->specific = 0;
398 next_sym->generic = 0;
e1633d82 399 next_sym->conversion = 0;
cd5ecab6 400 next_sym->id = id;
6de9cd9a
DN
401 break;
402
403 default:
404 gfc_internal_error ("add_sym(): Bad sizing mode");
405 }
406
407 va_start (argp, resolve);
408
409 first_flag = 1;
410
411 for (;;)
412 {
413 name = va_arg (argp, char *);
414 if (name == NULL)
415 break;
416
417 type = (bt) va_arg (argp, int);
418 kind = va_arg (argp, int);
419 optional = va_arg (argp, int);
9b2db7be 420 intent = (sym_intent) va_arg (argp, int);
6de9cd9a
DN
421
422 if (sizing != SZ_NOTHING)
423 nargs++;
424 else
425 {
426 next_arg++;
427
428 if (first_flag)
429 next_sym->formal = next_arg;
430 else
431 (next_arg - 1)->next = next_arg;
432
433 first_flag = 0;
434
435 strcpy (next_arg->name, name);
436 next_arg->ts.type = type;
437 next_arg->ts.kind = kind;
438 next_arg->optional = optional;
47b99694 439 next_arg->value = 0;
23e38561 440 next_arg->intent = intent;
6de9cd9a
DN
441 }
442 }
443
444 va_end (argp);
445
446 next_sym++;
447}
448
449
1270d633
SK
450/* Add a symbol to the function list where the function takes
451 0 arguments. */
452
453static void
9aa433c2 454add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 455 int kind, int standard,
524af0d6 456 bool (*check) (void),
b251af97
SK
457 gfc_expr *(*simplify) (void),
458 void (*resolve) (gfc_expr *))
1270d633 459{
6de9cd9a
DN
460 gfc_simplify_f sf;
461 gfc_check_f cf;
462 gfc_resolve_f rf;
463
4c0c6b9f
SK
464 cf.f0 = check;
465 sf.f0 = simplify;
466 rf.f0 = resolve;
6de9cd9a 467
e1633d82 468 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
b251af97 469 (void *) 0);
6de9cd9a
DN
470}
471
472
1270d633
SK
473/* Add a symbol to the subroutine list where the subroutine takes
474 0 arguments. */
475
476static void
e6c14898
DK
477add_sym_0s (const char *name, gfc_isym_id id, int standard,
478 void (*resolve) (gfc_code *))
1270d633 479{
6de9cd9a
DN
480 gfc_check_f cf;
481 gfc_simplify_f sf;
482 gfc_resolve_f rf;
483
1270d633
SK
484 cf.f1 = NULL;
485 sf.f1 = NULL;
486 rf.s1 = resolve;
6de9cd9a 487
e6c14898
DK
488 add_sym (name, id, CLASS_IMPURE, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf,
489 rf, (void *) 0);
6de9cd9a
DN
490}
491
492
1270d633
SK
493/* Add a symbol to the function list where the function takes
494 1 arguments. */
495
6de9cd9a 496static void
9aa433c2 497add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
1270d633 498 int kind, int standard,
524af0d6 499 bool (*check) (gfc_expr *),
b251af97
SK
500 gfc_expr *(*simplify) (gfc_expr *),
501 void (*resolve) (gfc_expr *, gfc_expr *),
502 const char *a1, bt type1, int kind1, int optional1)
6de9cd9a
DN
503{
504 gfc_check_f cf;
505 gfc_simplify_f sf;
506 gfc_resolve_f rf;
507
1270d633
SK
508 cf.f1 = check;
509 sf.f1 = simplify;
510 rf.f1 = resolve;
6de9cd9a 511
e1633d82 512 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561 513 a1, type1, kind1, optional1, INTENT_IN,
b251af97 514 (void *) 0);
6de9cd9a
DN
515}
516
517
23e38561
JW
518/* Add a symbol to the function list where the function takes
519 1 arguments, specifying the intent of the argument. */
520
521static void
522add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
523 int actual_ok, bt type, int kind, int standard,
524af0d6 524 bool (*check) (gfc_expr *),
23e38561
JW
525 gfc_expr *(*simplify) (gfc_expr *),
526 void (*resolve) (gfc_expr *, gfc_expr *),
527 const char *a1, bt type1, int kind1, int optional1,
528 sym_intent intent1)
529{
530 gfc_check_f cf;
531 gfc_simplify_f sf;
532 gfc_resolve_f rf;
533
534 cf.f1 = check;
535 sf.f1 = simplify;
536 rf.f1 = resolve;
537
538 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
539 a1, type1, kind1, optional1, intent1,
540 (void *) 0);
541}
542
543
544/* Add a symbol to the subroutine list where the subroutine takes
545 1 arguments, specifying the intent of the argument. */
546
547static void
1a14a58c 548add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
524af0d6 549 int standard, bool (*check) (gfc_expr *),
1a14a58c
TB
550 gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *),
551 const char *a1, bt type1, int kind1, int optional1,
552 sym_intent intent1)
23e38561
JW
553{
554 gfc_check_f cf;
555 gfc_simplify_f sf;
556 gfc_resolve_f rf;
557
558 cf.f1 = check;
559 sf.f1 = simplify;
560 rf.s1 = resolve;
561
562 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
563 a1, type1, kind1, optional1, intent1,
b251af97 564 (void *) 0);
6de9cd9a
DN
565}
566
f1abbf69
TK
567/* Add a symbol to the subroutine ilst where the subroutine takes one
568 printf-style character argument and a variable number of arguments
569 to follow. */
570
571static void
572add_sym_1p (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
573 int standard, bool (*check) (gfc_actual_arglist *),
574 gfc_expr *(*simplify) (gfc_expr*), void (*resolve) (gfc_code *),
575 const char *a1, bt type1, int kind1, int optional1, sym_intent intent1)
576{
577 gfc_check_f cf;
578 gfc_simplify_f sf;
579 gfc_resolve_f rf;
580
581 cf.f1m = check;
582 sf.f1 = simplify;
583 rf.s1 = resolve;
584
585 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
586 a1, type1, kind1, optional1, intent1,
587 (void *) 0);
588}
589
6de9cd9a 590
1270d633
SK
591/* Add a symbol from the MAX/MIN family of intrinsic functions to the
592 function. MAX et al take 2 or more arguments. */
593
594static void
9aa433c2 595add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 596 int kind, int standard,
524af0d6 597 bool (*check) (gfc_actual_arglist *),
b251af97
SK
598 gfc_expr *(*simplify) (gfc_expr *),
599 void (*resolve) (gfc_expr *, gfc_actual_arglist *),
600 const char *a1, bt type1, int kind1, int optional1,
601 const char *a2, bt type2, int kind2, int optional2)
1270d633 602{
6de9cd9a
DN
603 gfc_check_f cf;
604 gfc_simplify_f sf;
605 gfc_resolve_f rf;
606
607 cf.f1m = check;
608 sf.f1 = simplify;
609 rf.f1m = resolve;
610
e1633d82 611 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561
JW
612 a1, type1, kind1, optional1, INTENT_IN,
613 a2, type2, kind2, optional2, INTENT_IN,
b251af97 614 (void *) 0);
6de9cd9a
DN
615}
616
617
1270d633
SK
618/* Add a symbol to the function list where the function takes
619 2 arguments. */
620
621static void
9aa433c2 622add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 623 int kind, int standard,
524af0d6 624 bool (*check) (gfc_expr *, gfc_expr *),
b251af97
SK
625 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
626 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
627 const char *a1, bt type1, int kind1, int optional1,
628 const char *a2, bt type2, int kind2, int optional2)
1270d633 629{
6de9cd9a
DN
630 gfc_check_f cf;
631 gfc_simplify_f sf;
632 gfc_resolve_f rf;
633
634 cf.f2 = check;
635 sf.f2 = simplify;
636 rf.f2 = resolve;
637
e1633d82 638 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561
JW
639 a1, type1, kind1, optional1, INTENT_IN,
640 a2, type2, kind2, optional2, INTENT_IN,
b251af97 641 (void *) 0);
6de9cd9a
DN
642}
643
644
1a14a58c
TB
645/* Add a symbol to the function list where the function takes
646 2 arguments; same as add_sym_2 - but allows to specify the intent. */
2bd74949 647
1270d633 648static void
1a14a58c
TB
649add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl,
650 int actual_ok, bt type, int kind, int standard,
524af0d6 651 bool (*check) (gfc_expr *, gfc_expr *),
1a14a58c
TB
652 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
653 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
654 const char *a1, bt type1, int kind1, int optional1,
655 sym_intent intent1, const char *a2, bt type2, int kind2,
656 int optional2, sym_intent intent2)
1270d633 657{
2bd74949
SK
658 gfc_check_f cf;
659 gfc_simplify_f sf;
660 gfc_resolve_f rf;
661
6956a6f3
PB
662 cf.f2 = check;
663 sf.f2 = simplify;
1a14a58c 664 rf.f2 = resolve;
2bd74949 665
1a14a58c
TB
666 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
667 a1, type1, kind1, optional1, intent1,
668 a2, type2, kind2, optional2, intent2,
23e38561
JW
669 (void *) 0);
670}
671
672
673/* Add a symbol to the subroutine list where the subroutine takes
674 2 arguments, specifying the intent of the arguments. */
675
676static void
1a14a58c
TB
677add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type,
678 int kind, int standard,
524af0d6 679 bool (*check) (gfc_expr *, gfc_expr *),
1a14a58c
TB
680 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
681 void (*resolve) (gfc_code *),
682 const char *a1, bt type1, int kind1, int optional1,
683 sym_intent intent1, const char *a2, bt type2, int kind2,
684 int optional2, sym_intent intent2)
23e38561
JW
685{
686 gfc_check_f cf;
687 gfc_simplify_f sf;
688 gfc_resolve_f rf;
689
690 cf.f2 = check;
691 sf.f2 = simplify;
692 rf.s1 = resolve;
693
694 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
695 a1, type1, kind1, optional1, intent1,
696 a2, type2, kind2, optional2, intent2,
b251af97 697 (void *) 0);
2bd74949
SK
698}
699
700
1270d633
SK
701/* Add a symbol to the function list where the function takes
702 3 arguments. */
703
704static void
9aa433c2 705add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 706 int kind, int standard,
524af0d6 707 bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
b251af97
SK
708 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
709 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
710 const char *a1, bt type1, int kind1, int optional1,
711 const char *a2, bt type2, int kind2, int optional2,
712 const char *a3, bt type3, int kind3, int optional3)
1270d633 713{
6de9cd9a
DN
714 gfc_check_f cf;
715 gfc_simplify_f sf;
716 gfc_resolve_f rf;
717
718 cf.f3 = check;
719 sf.f3 = simplify;
720 rf.f3 = resolve;
721
e1633d82 722 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561
JW
723 a1, type1, kind1, optional1, INTENT_IN,
724 a2, type2, kind2, optional2, INTENT_IN,
725 a3, type3, kind3, optional3, INTENT_IN,
b251af97 726 (void *) 0);
6de9cd9a
DN
727}
728
1270d633 729
01ce9e31
TK
730/* MINLOC and MAXLOC get special treatment because their
731 argument might have to be reordered. */
f3207b37 732
1270d633 733static void
64b1806b 734add_sym_5ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 735 int kind, int standard,
524af0d6 736 bool (*check) (gfc_actual_arglist *),
64b1806b
TK
737 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
738 gfc_expr *, gfc_expr *),
739 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
740 gfc_expr *, gfc_expr *),
b251af97
SK
741 const char *a1, bt type1, int kind1, int optional1,
742 const char *a2, bt type2, int kind2, int optional2,
9a3d38f6 743 const char *a3, bt type3, int kind3, int optional3,
64b1806b
TK
744 const char *a4, bt type4, int kind4, int optional4,
745 const char *a5, bt type5, int kind5, int optional5)
1270d633 746{
f3207b37
TS
747 gfc_check_f cf;
748 gfc_simplify_f sf;
749 gfc_resolve_f rf;
750
64b1806b
TK
751 cf.f5ml = check;
752 sf.f5 = simplify;
753 rf.f5 = resolve;
f3207b37 754
e1633d82 755 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561
JW
756 a1, type1, kind1, optional1, INTENT_IN,
757 a2, type2, kind2, optional2, INTENT_IN,
758 a3, type3, kind3, optional3, INTENT_IN,
9a3d38f6 759 a4, type4, kind4, optional4, INTENT_IN,
64b1806b 760 a5, type5, kind5, optional5, INTENT_IN,
b251af97 761 (void *) 0);
f3207b37
TS
762}
763
01ce9e31
TK
764/* Similar for FINDLOC. */
765
766static void
767add_sym_6fl (const char *name, gfc_isym_id id, enum klass cl, int actual_ok,
768 bt type, int kind, int standard,
769 bool (*check) (gfc_actual_arglist *),
770 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
771 gfc_expr *, gfc_expr *, gfc_expr *),
772 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
773 gfc_expr *, gfc_expr *, gfc_expr *),
774 const char *a1, bt type1, int kind1, int optional1,
775 const char *a2, bt type2, int kind2, int optional2,
776 const char *a3, bt type3, int kind3, int optional3,
777 const char *a4, bt type4, int kind4, int optional4,
778 const char *a5, bt type5, int kind5, int optional5,
779 const char *a6, bt type6, int kind6, int optional6)
780
781{
782 gfc_check_f cf;
783 gfc_simplify_f sf;
784 gfc_resolve_f rf;
785
786 cf.f6fl = check;
787 sf.f6 = simplify;
788 rf.f6 = resolve;
789
790 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
791 a1, type1, kind1, optional1, INTENT_IN,
792 a2, type2, kind2, optional2, INTENT_IN,
793 a3, type3, kind3, optional3, INTENT_IN,
794 a4, type4, kind4, optional4, INTENT_IN,
795 a5, type5, kind5, optional5, INTENT_IN,
796 a6, type6, kind6, optional6, INTENT_IN,
797 (void *) 0);
798}
799
1270d633 800
7551270e
ES
801/* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
802 their argument also might have to be reordered. */
803
1270d633 804static void
9aa433c2 805add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 806 int kind, int standard,
524af0d6 807 bool (*check) (gfc_actual_arglist *),
b251af97
SK
808 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
809 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
810 const char *a1, bt type1, int kind1, int optional1,
811 const char *a2, bt type2, int kind2, int optional2,
812 const char *a3, bt type3, int kind3, int optional3)
1270d633 813{
7551270e
ES
814 gfc_check_f cf;
815 gfc_simplify_f sf;
816 gfc_resolve_f rf;
817
818 cf.f3red = check;
819 sf.f3 = simplify;
820 rf.f3 = resolve;
821
e1633d82 822 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561
JW
823 a1, type1, kind1, optional1, INTENT_IN,
824 a2, type2, kind2, optional2, INTENT_IN,
825 a3, type3, kind3, optional3, INTENT_IN,
b251af97 826 (void *) 0);
7551270e
ES
827}
828
21fdfcc1 829
1270d633 830/* Add a symbol to the subroutine list where the subroutine takes
1a14a58c 831 3 arguments, specifying the intent of the arguments. */
1270d633
SK
832
833static void
1a14a58c
TB
834add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type,
835 int kind, int standard,
524af0d6 836 bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
b251af97
SK
837 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
838 void (*resolve) (gfc_code *),
839 const char *a1, bt type1, int kind1, int optional1,
1a14a58c
TB
840 sym_intent intent1, const char *a2, bt type2, int kind2,
841 int optional2, sym_intent intent2, const char *a3, bt type3,
842 int kind3, int optional3, sym_intent intent3)
23e38561
JW
843{
844 gfc_check_f cf;
845 gfc_simplify_f sf;
846 gfc_resolve_f rf;
847
848 cf.f3 = check;
849 sf.f3 = simplify;
850 rf.s1 = resolve;
851
852 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
853 a1, type1, kind1, optional1, intent1,
854 a2, type2, kind2, optional2, intent2,
855 a3, type3, kind3, optional3, intent3,
b251af97 856 (void *) 0);
21fdfcc1
SK
857}
858
6de9cd9a 859
1270d633
SK
860/* Add a symbol to the function list where the function takes
861 4 arguments. */
862
863static void
9aa433c2 864add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
b251af97 865 int kind, int standard,
524af0d6 866 bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
b251af97
SK
867 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
868 gfc_expr *),
869 void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
870 gfc_expr *),
871 const char *a1, bt type1, int kind1, int optional1,
872 const char *a2, bt type2, int kind2, int optional2,
873 const char *a3, bt type3, int kind3, int optional3,
874 const char *a4, bt type4, int kind4, int optional4 )
1270d633 875{
6de9cd9a
DN
876 gfc_check_f cf;
877 gfc_simplify_f sf;
878 gfc_resolve_f rf;
879
880 cf.f4 = check;
881 sf.f4 = simplify;
882 rf.f4 = resolve;
883
e1633d82 884 add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
23e38561
JW
885 a1, type1, kind1, optional1, INTENT_IN,
886 a2, type2, kind2, optional2, INTENT_IN,
887 a3, type3, kind3, optional3, INTENT_IN,
888 a4, type4, kind4, optional4, INTENT_IN,
b251af97 889 (void *) 0);
6de9cd9a
DN
890}
891
892
1270d633
SK
893/* Add a symbol to the subroutine list where the subroutine takes
894 4 arguments. */
895
896static void
23e38561
JW
897add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
898 int standard,
524af0d6 899 bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
b251af97
SK
900 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
901 gfc_expr *),
902 void (*resolve) (gfc_code *),
903 const char *a1, bt type1, int kind1, int optional1,
23e38561
JW
904 sym_intent intent1, const char *a2, bt type2, int kind2,
905 int optional2, sym_intent intent2, const char *a3, bt type3,
906 int kind3, int optional3, sym_intent intent3, const char *a4,
907 bt type4, int kind4, int optional4, sym_intent intent4)
60c9a35b
PB
908{
909 gfc_check_f cf;
910 gfc_simplify_f sf;
911 gfc_resolve_f rf;
912
913 cf.f4 = check;
914 sf.f4 = simplify;
915 rf.s1 = resolve;
916
e1633d82 917 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
23e38561
JW
918 a1, type1, kind1, optional1, intent1,
919 a2, type2, kind2, optional2, intent2,
920 a3, type3, kind3, optional3, intent3,
921 a4, type4, kind4, optional4, intent4,
b251af97 922 (void *) 0);
60c9a35b
PB
923}
924
925
1270d633
SK
926/* Add a symbol to the subroutine list where the subroutine takes
927 5 arguments. */
928
929static void
23e38561
JW
930add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
931 int standard,
524af0d6 932 bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
b251af97
SK
933 gfc_expr *),
934 gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
935 gfc_expr *, gfc_expr *),
936 void (*resolve) (gfc_code *),
937 const char *a1, bt type1, int kind1, int optional1,
23e38561
JW
938 sym_intent intent1, const char *a2, bt type2, int kind2,
939 int optional2, sym_intent intent2, const char *a3, bt type3,
940 int kind3, int optional3, sym_intent intent3, const char *a4,
941 bt type4, int kind4, int optional4, sym_intent intent4,
942 const char *a5, bt type5, int kind5, int optional5,
f8862a1b 943 sym_intent intent5)
aa6fc635
JB
944{
945 gfc_check_f cf;
946 gfc_simplify_f sf;
947 gfc_resolve_f rf;
948
949 cf.f5 = check;
950 sf.f5 = simplify;
951 rf.s1 = resolve;
952
e1633d82 953 add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
23e38561
JW
954 a1, type1, kind1, optional1, intent1,
955 a2, type2, kind2, optional2, intent2,
956 a3, type3, kind3, optional3, intent3,
957 a4, type4, kind4, optional4, intent4,
958 a5, type5, kind5, optional5, intent5,
b251af97 959 (void *) 0);
aa6fc635
JB
960}
961
962
6de9cd9a
DN
963/* Locate an intrinsic symbol given a base pointer, number of elements
964 in the table and a pointer to a name. Returns the NULL pointer if
965 a name is not found. */
966
967static gfc_intrinsic_sym *
b251af97 968find_sym (gfc_intrinsic_sym *start, int n, const char *name)
6de9cd9a 969{
b6e2128e
TS
970 /* name may be a user-supplied string, so we must first make sure
971 that we're comparing against a pointer into the global string
972 table. */
51f03c6b 973 const char *p = gfc_get_string ("%s", name);
b6e2128e 974
6de9cd9a
DN
975 while (n > 0)
976 {
b6e2128e 977 if (p == start->name)
6de9cd9a
DN
978 return start;
979
980 start++;
981 n--;
982 }
983
984 return NULL;
985}
986
987
cadddfdd
TB
988gfc_isym_id
989gfc_isym_id_by_intmod (intmod_id from_intmod, int intmod_sym_id)
990{
cbde6c0f
TB
991 if (from_intmod == INTMOD_NONE)
992 return (gfc_isym_id) intmod_sym_id;
993 else if (from_intmod == INTMOD_ISO_C_BINDING)
cadddfdd
TB
994 return (gfc_isym_id) c_interop_kinds_table[intmod_sym_id].value;
995 else if (from_intmod == INTMOD_ISO_FORTRAN_ENV)
996 switch (intmod_sym_id)
997 {
998#define NAMED_SUBROUTINE(a,b,c,d) \
999 case a: \
1000 return (gfc_isym_id) c;
1001#define NAMED_FUNCTION(a,b,c,d) \
1002 case a: \
1003 return (gfc_isym_id) c;
1004#include "iso-fortran-env.def"
1005 default:
1006 gcc_unreachable ();
1007 }
1008 else
cbde6c0f 1009 gcc_unreachable ();
cadddfdd
TB
1010 return (gfc_isym_id) 0;
1011}
1012
1013
1014gfc_isym_id
1015gfc_isym_id_by_intmod_sym (gfc_symbol *sym)
1016{
1017 return gfc_isym_id_by_intmod (sym->from_intmod, sym->intmod_sym_id);
1018}
1019
1020
1021gfc_intrinsic_sym *
1022gfc_intrinsic_subroutine_by_id (gfc_isym_id id)
1023{
1024 gfc_intrinsic_sym *start = subroutines;
1025 int n = nsub;
1026
1027 while (true)
1028 {
1029 gcc_assert (n > 0);
1030 if (id == start->id)
1031 return start;
1032
1033 start++;
1034 n--;
1035 }
1036}
1037
1038
d000aa67
TB
1039gfc_intrinsic_sym *
1040gfc_intrinsic_function_by_id (gfc_isym_id id)
1041{
1042 gfc_intrinsic_sym *start = functions;
1043 int n = nfunc;
1044
1045 while (true)
1046 {
1047 gcc_assert (n > 0);
1048 if (id == start->id)
1049 return start;
1050
1051 start++;
1052 n--;
1053 }
1054}
1055
1056
6de9cd9a
DN
1057/* Given a name, find a function in the intrinsic function table.
1058 Returns NULL if not found. */
1059
1060gfc_intrinsic_sym *
1061gfc_find_function (const char *name)
1062{
810306f2
EE
1063 gfc_intrinsic_sym *sym;
1064
1065 sym = find_sym (functions, nfunc, name);
d000aa67 1066 if (!sym || sym->from_module)
810306f2 1067 sym = find_sym (conversion, nconv, name);
6de9cd9a 1068
d000aa67 1069 return (!sym || sym->from_module) ? NULL : sym;
6de9cd9a
DN
1070}
1071
1072
1073/* Given a name, find a function in the intrinsic subroutine table.
1074 Returns NULL if not found. */
1075
cd5ecab6
DF
1076gfc_intrinsic_sym *
1077gfc_find_subroutine (const char *name)
6de9cd9a 1078{
d000aa67
TB
1079 gfc_intrinsic_sym *sym;
1080 sym = find_sym (subroutines, nsub, name);
1081 return (!sym || sym->from_module) ? NULL : sym;
6de9cd9a
DN
1082}
1083
1084
1085/* Given a string, figure out if it is the name of a generic intrinsic
1086 function or not. */
1087
1088int
1089gfc_generic_intrinsic (const char *name)
1090{
1091 gfc_intrinsic_sym *sym;
1092
1093 sym = gfc_find_function (name);
d000aa67 1094 return (!sym || sym->from_module) ? 0 : sym->generic;
6de9cd9a
DN
1095}
1096
1097
1098/* Given a string, figure out if it is the name of a specific
1099 intrinsic function or not. */
1100
1101int
1102gfc_specific_intrinsic (const char *name)
1103{
1104 gfc_intrinsic_sym *sym;
1105
1106 sym = gfc_find_function (name);
d000aa67 1107 return (!sym || sym->from_module) ? 0 : sym->specific;
6de9cd9a
DN
1108}
1109
1110
0e7e7e6e
FXC
1111/* Given a string, figure out if it is the name of an intrinsic function
1112 or subroutine allowed as an actual argument or not. */
1113int
1114gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
1115{
1116 gfc_intrinsic_sym *sym;
1117
1118 /* Intrinsic subroutines are not allowed as actual arguments. */
1119 if (subroutine_flag)
1120 return 0;
1121 else
1122 {
1123 sym = gfc_find_function (name);
1124 return (sym == NULL) ? 0 : sym->actual_ok;
1125 }
1126}
1127
1128
0e8d854e
JW
1129/* Given a symbol, find out if it is (and is to be treated as) an intrinsic.
1130 If its name refers to an intrinsic, but this intrinsic is not included in
1131 the selected standard, this returns FALSE and sets the symbol's external
c3005b0f 1132 attribute. */
6de9cd9a 1133
c3005b0f
DK
1134bool
1135gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
6de9cd9a 1136{
c3005b0f
DK
1137 gfc_intrinsic_sym* isym;
1138 const char* symstd;
1139
0e8d854e 1140 /* If INTRINSIC attribute is already known, return. */
c3005b0f
DK
1141 if (sym->attr.intrinsic)
1142 return true;
0e8d854e
JW
1143
1144 /* Check for attributes which prevent the symbol from being INTRINSIC. */
1145 if (sym->attr.external || sym->attr.contained
1146 || sym->attr.if_source == IFSRC_IFBODY)
c3005b0f
DK
1147 return false;
1148
1149 if (subroutine_flag)
1150 isym = gfc_find_subroutine (sym->name);
1151 else
1152 isym = gfc_find_function (sym->name);
1153
1154 /* No such intrinsic available at all? */
1155 if (!isym)
1156 return false;
1157
1158 /* See if this intrinsic is allowed in the current standard. */
9606f3c9
TB
1159 if (!gfc_check_intrinsic_standard (isym, &symstd, false, loc)
1160 && !sym->attr.artificial)
c3005b0f 1161 {
4daa149b
TB
1162 if (sym->attr.proc == PROC_UNKNOWN && warn_intrinsics_std)
1163 gfc_warning_now (OPT_Wintrinsics_std, "The intrinsic %qs at %L is not "
1164 "included in the selected standard but %s and %qs will"
1165 " be treated as if declared EXTERNAL. Use an"
a3f9f006
ML
1166 " appropriate %<-std=%>* option or define"
1167 " %<-fall-intrinsics%> to allow this intrinsic.",
db7d7dc1 1168 sym->name, &loc, symstd, sym->name);
c3005b0f
DK
1169
1170 return false;
1171 }
1172
1173 return true;
6de9cd9a
DN
1174}
1175
1176
1177/* Collect a set of intrinsic functions into a generic collection.
1178 The first argument is the name of the generic function, which is
1179 also the name of a specific function. The rest of the specifics
1180 currently in the table are placed into the list of specific
3f2286f2
DF
1181 functions associated with that generic.
1182
1183 PR fortran/32778
1184 FIXME: Remove the argument STANDARD if no regressions are
1185 encountered. Change all callers (approx. 360).
1186*/
6de9cd9a
DN
1187
1188static void
3f2286f2 1189make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
6de9cd9a
DN
1190{
1191 gfc_intrinsic_sym *g;
1192
1193 if (sizing != SZ_NOTHING)
1194 return;
1195
1196 g = gfc_find_function (name);
1197 if (g == NULL)
1fe61adf 1198 gfc_internal_error ("make_generic(): Cannot find generic symbol %qs",
6de9cd9a
DN
1199 name);
1200
cd5ecab6
DF
1201 gcc_assert (g->id == id);
1202
6de9cd9a
DN
1203 g->generic = 1;
1204 g->specific = 1;
cb9e4f55 1205 if ((g + 1)->name != NULL)
6de9cd9a
DN
1206 g->specific_head = g + 1;
1207 g++;
1208
cb9e4f55 1209 while (g->name != NULL)
6de9cd9a
DN
1210 {
1211 g->next = g + 1;
1212 g->specific = 1;
6de9cd9a
DN
1213 g++;
1214 }
1215
1216 g--;
1217 g->next = NULL;
1218}
1219
1220
1221/* Create a duplicate intrinsic function entry for the current
3f2286f2
DF
1222 function, the only differences being the alternate name and
1223 a different standard if necessary. Note that we use argument
1224 lists more than once, but all argument lists are freed as a
1225 single block. */
6de9cd9a
DN
1226
1227static void
19060788 1228make_alias (const char *name, int standard)
6de9cd9a 1229{
6de9cd9a
DN
1230 switch (sizing)
1231 {
1232 case SZ_FUNCS:
1233 nfunc++;
1234 break;
1235
1236 case SZ_SUBS:
1237 nsub++;
1238 break;
1239
1240 case SZ_NOTHING:
1241 next_sym[0] = next_sym[-1];
51f03c6b 1242 next_sym->name = gfc_get_string ("%s", name);
3f2286f2 1243 next_sym->standard = standard;
6de9cd9a
DN
1244 next_sym++;
1245 break;
1246
1247 default:
1248 break;
1249 }
1250}
1251
b251af97 1252
fe58e076
TK
1253/* Make the current subroutine noreturn. */
1254
1255static void
b251af97 1256make_noreturn (void)
fe58e076
TK
1257{
1258 if (sizing == SZ_NOTHING)
b251af97 1259 next_sym[-1].noreturn = 1;
fe58e076 1260}
6de9cd9a 1261
d000aa67
TB
1262
1263/* Mark current intrinsic as module intrinsic. */
1264static void
1265make_from_module (void)
1266{
1267 if (sizing == SZ_NOTHING)
1268 next_sym[-1].from_module = 1;
1269}
1270
f1abbf69
TK
1271
1272/* Mark the current subroutine as having a variable number of
1273 arguments. */
1274
1275static void
1276make_vararg (void)
1277{
1278 if (sizing == SZ_NOTHING)
1279 next_sym[-1].vararg = 1;
1280}
1281
47b99694
TB
1282/* Set the attr.value of the current procedure. */
1283
1284static void
1285set_attr_value (int n, ...)
1286{
1287 gfc_intrinsic_arg *arg;
1288 va_list argp;
1289 int i;
1290
1291 if (sizing != SZ_NOTHING)
1292 return;
1293
1294 va_start (argp, n);
1295 arg = next_sym[-1].formal;
1296
1297 for (i = 0; i < n; i++)
1298 {
1299 gcc_assert (arg != NULL);
1300 arg->value = va_arg (argp, int);
1301 arg = arg->next;
1302 }
1303 va_end (argp);
1304}
1305
b251af97 1306
6de9cd9a
DN
1307/* Add intrinsic functions. */
1308
1309static void
1310add_functions (void)
1311{
fbe1f017
SK
1312 /* Argument names. These are used as argument keywords and so need to
1313 match the documentation. Please keep this list in sorted order. */
6de9cd9a 1314 const char
fbe1f017
SK
1315 *a = "a", *a1 = "a1", *a2 = "a2", *ar = "array", *b = "b",
1316 *bck = "back", *bd = "boundary", *c = "c", *c_ptr_1 = "c_ptr_1",
1317 *c_ptr_2 = "c_ptr_2", *ca = "coarray", *com = "command",
1318 *dist = "distance", *dm = "dim", *f = "field", *failed="failed",
1319 *fs = "fsource", *han = "handler", *i = "i",
1320 *image = "image", *j = "j", *kind = "kind",
1321 *l = "l", *ln = "len", *level = "level", *m = "matrix", *ma = "matrix_a",
1322 *mb = "matrix_b", *md = "mode", *mo = "mold", *msk = "mask",
1323 *n = "n", *ncopies= "ncopies", *nm = "name", *num = "number",
1324 *ord = "order", *p = "p", *p1 = "path1", *p2 = "path2",
1325 *pad = "pad", *pid = "pid", *pos = "pos", *pt = "pointer",
1326 *r = "r", *s = "s", *set = "set", *sh = "shift", *shp = "shape",
1327 *sig = "sig", *src = "source", *ssg = "substring",
1328 *sta = "string_a", *stb = "string_b", *stg = "string",
1329 *sub = "sub", *sz = "size", *tg = "target", *team = "team", *tm = "time",
1330 *ts = "tsource", *ut = "unit", *v = "vector", *va = "vector_a",
01ce9e31
TK
1331 *vb = "vector_b", *vl = "values", *val = "value", *x = "x", *y = "y",
1332 *z = "z";
6de9cd9a
DN
1333
1334 int di, dr, dd, dl, dc, dz, ii;
1335
9d64df18
TS
1336 di = gfc_default_integer_kind;
1337 dr = gfc_default_real_kind;
1338 dd = gfc_default_double_kind;
1339 dl = gfc_default_logical_kind;
1340 dc = gfc_default_character_kind;
1341 dz = gfc_default_complex_kind;
6de9cd9a
DN
1342 ii = gfc_index_integer_kind;
1343
e1633d82 1344 add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 1345 gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
1270d633 1346 a, BT_REAL, dr, REQUIRED);
6de9cd9a 1347
c98583e9
FR
1348 if (flag_dec_intrinsic_ints)
1349 {
1350 make_alias ("babs", GFC_STD_GNU);
1351 make_alias ("iiabs", GFC_STD_GNU);
1352 make_alias ("jiabs", GFC_STD_GNU);
1353 make_alias ("kiabs", GFC_STD_GNU);
1354 }
1355
e1633d82 1356 add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 1357 NULL, gfc_simplify_abs, gfc_resolve_abs,
1270d633 1358 a, BT_INTEGER, di, REQUIRED);
6de9cd9a 1359
e1633d82 1360 add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1361 gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
1270d633 1362 a, BT_REAL, dd, REQUIRED);
6de9cd9a 1363
e1633d82 1364 add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 1365 NULL, gfc_simplify_abs, gfc_resolve_abs,
1270d633 1366 a, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 1367
f8862a1b
DR
1368 add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1369 NULL, gfc_simplify_abs, gfc_resolve_abs,
1270d633 1370 a, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1371
19060788 1372 make_alias ("cdabs", GFC_STD_GNU);
6de9cd9a 1373
b7892582 1374 make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
6de9cd9a 1375
32a126b2
FXC
1376 /* The checking function for ACCESS is called gfc_check_access_func
1377 because the name gfc_check_access is already used in module.c. */
e6c14898
DK
1378 add_sym_2 ("access", GFC_ISYM_ACCESS, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1379 di, GFC_STD_GNU, gfc_check_access_func, NULL, gfc_resolve_access,
a119fc1c
FXC
1380 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1381
1382 make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
1383
719e72fb
FXC
1384 add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
1385 BT_CHARACTER, dc, GFC_STD_F95,
3c19e5e1 1386 gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
719e72fb 1387 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1388
b7892582 1389 make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
6de9cd9a 1390
e1633d82 1391 add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
504ed63a 1392 gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
1270d633 1393 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1394
e1633d82 1395 add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1396 gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
1270d633 1397 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1398
b7892582 1399 make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
6de9cd9a 1400
f489fba1 1401 add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
504ed63a 1402 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
f489fba1 1403 gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
1e399e23 1404
e1633d82 1405 add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
15ead859 1406 gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
1e399e23
JD
1407 x, BT_REAL, dd, REQUIRED);
1408
f489fba1 1409 make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
1e399e23 1410
d393bbd7
FXC
1411 add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
1412 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
1413 gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
6de9cd9a 1414
b7892582 1415 make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
6de9cd9a 1416
d393bbd7
FXC
1417 add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
1418 BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
1419 gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
6de9cd9a 1420
b7892582 1421 make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
6de9cd9a 1422
e1633d82 1423 add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 1424 gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
1270d633 1425 z, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 1426
6970fcc8
SK
1427 make_alias ("imag", GFC_STD_GNU);
1428 make_alias ("imagpart", GFC_STD_GNU);
1429
f8862a1b
DR
1430 add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
1431 NULL, gfc_simplify_aimag, gfc_resolve_aimag,
1270d633 1432 z, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1433
b7892582 1434 make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
6de9cd9a 1435
e1633d82 1436 add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 1437 gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
1270d633 1438 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1439
e1633d82 1440 add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 1441 NULL, gfc_simplify_dint, gfc_resolve_dint,
1270d633 1442 a, BT_REAL, dd, REQUIRED);
6de9cd9a 1443
b7892582 1444 make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
6de9cd9a 1445
e1633d82 1446 add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
a16d978f 1447 gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
1270d633 1448 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 1449
b7892582 1450 make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
6de9cd9a 1451
e1633d82 1452 add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
1270d633
SK
1453 gfc_check_allocated, NULL, NULL,
1454 ar, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 1455
b7892582 1456 make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
6de9cd9a 1457
e1633d82 1458 add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 1459 gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
1270d633 1460 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1461
e1633d82 1462 add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 1463 NULL, gfc_simplify_dnint, gfc_resolve_dnint,
1270d633 1464 a, BT_REAL, dd, REQUIRED);
6de9cd9a 1465
b7892582 1466 make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
6de9cd9a 1467
e1633d82 1468 add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
a16d978f 1469 gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
1270d633 1470 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 1471
b7892582 1472 make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
6de9cd9a 1473
e1633d82 1474 add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
504ed63a 1475 gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
1270d633 1476 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1477
e1633d82 1478 add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1479 gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
1270d633 1480 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1481
b7892582 1482 make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
f8862a1b 1483
f489fba1 1484 add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
504ed63a 1485 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
f489fba1 1486 gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
1e399e23 1487
e1633d82 1488 add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
15ead859 1489 gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
1e399e23
JD
1490 x, BT_REAL, dd, REQUIRED);
1491
f489fba1 1492 make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
6de9cd9a 1493
e1633d82 1494 add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
8d2c2905 1495 GFC_STD_F95, gfc_check_associated, NULL, NULL,
1270d633 1496 pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
6de9cd9a 1497
b7892582 1498 make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
6de9cd9a 1499
e1633d82 1500 add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
504ed63a 1501 gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
1270d633 1502 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1503
e1633d82 1504 add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1505 gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
1270d633 1506 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1507
ddf67998
TB
1508 /* Two-argument version of atan, equivalent to atan2. */
1509 add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
1510 gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
1511 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
1512
b7892582 1513 make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
f8862a1b 1514
f489fba1 1515 add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
504ed63a 1516 GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
f489fba1 1517 gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
1e399e23 1518
e1633d82 1519 add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
15ead859 1520 gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
1e399e23
JD
1521 x, BT_REAL, dd, REQUIRED);
1522
f489fba1 1523 make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
6de9cd9a 1524
e1633d82 1525 add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
a1bab9ea 1526 gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
1270d633 1527 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
6de9cd9a 1528
e1633d82 1529 add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1530 gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
1270d633 1531 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
6de9cd9a 1532
b7892582 1533 make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
f8862a1b 1534
e8525382 1535 /* Bessel and Neumann functions for G77 compatibility. */
e1633d82 1536 add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
3c3f4265 1537 gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1270d633 1538 x, BT_REAL, dr, REQUIRED);
e8525382 1539
f489fba1
FXC
1540 make_alias ("bessel_j0", GFC_STD_F2008);
1541
e1633d82 1542 add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
3c3f4265 1543 gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
1270d633 1544 x, BT_REAL, dd, REQUIRED);
e8525382 1545
f489fba1 1546 make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
e8525382 1547
e1633d82 1548 add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
3c3f4265 1549 gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1270d633 1550 x, BT_REAL, dr, REQUIRED);
e8525382 1551
f489fba1
FXC
1552 make_alias ("bessel_j1", GFC_STD_F2008);
1553
e1633d82 1554 add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
3c3f4265 1555 gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
1270d633 1556 x, BT_REAL, dd, REQUIRED);
e8525382 1557
f489fba1 1558 make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
e8525382 1559
e1633d82 1560 add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
3c3f4265 1561 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1270d633 1562 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
e8525382 1563
f489fba1
FXC
1564 make_alias ("bessel_jn", GFC_STD_F2008);
1565
e1633d82 1566 add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
3c3f4265 1567 gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
1270d633 1568 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
e8525382 1569
29698e0f 1570 add_sym_3 ("bessel_jn", GFC_ISYM_JN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
47b99694 1571 gfc_check_bessel_n2, gfc_simplify_bessel_jn2, gfc_resolve_bessel_n2,
29698e0f
TB
1572 "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
1573 x, BT_REAL, dr, REQUIRED);
47b99694 1574 set_attr_value (3, true, true, true);
29698e0f 1575
f489fba1 1576 make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
e8525382 1577
e1633d82 1578 add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
3c3f4265 1579 gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1270d633 1580 x, BT_REAL, dr, REQUIRED);
e8525382 1581
f489fba1
FXC
1582 make_alias ("bessel_y0", GFC_STD_F2008);
1583
e1633d82 1584 add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
3c3f4265 1585 gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
1270d633 1586 x, BT_REAL, dd, REQUIRED);
e8525382 1587
f489fba1 1588 make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
e8525382 1589
e1633d82 1590 add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
3c3f4265 1591 gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1270d633 1592 x, BT_REAL, dr, REQUIRED);
e8525382 1593
f489fba1
FXC
1594 make_alias ("bessel_y1", GFC_STD_F2008);
1595
e1633d82 1596 add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
3c3f4265 1597 gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
1270d633 1598 x, BT_REAL, dd, REQUIRED);
e8525382 1599
f489fba1 1600 make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
e8525382 1601
e1633d82 1602 add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
3c3f4265 1603 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1270d633 1604 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
e8525382 1605
f489fba1
FXC
1606 make_alias ("bessel_yn", GFC_STD_F2008);
1607
e1633d82 1608 add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
3c3f4265 1609 gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
1270d633 1610 n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
e8525382 1611
29698e0f 1612 add_sym_3 ("bessel_yn", GFC_ISYM_YN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
47b99694 1613 gfc_check_bessel_n2, gfc_simplify_bessel_yn2, gfc_resolve_bessel_n2,
29698e0f
TB
1614 "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
1615 x, BT_REAL, dr, REQUIRED);
47b99694 1616 set_attr_value (3, true, true, true);
29698e0f 1617
f489fba1 1618 make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
e8525382 1619
88a95a11
FXC
1620 add_sym_2 ("bge", GFC_ISYM_BGE, CLASS_ELEMENTAL, ACTUAL_NO,
1621 BT_LOGICAL, dl, GFC_STD_F2008,
1622 gfc_check_bge_bgt_ble_blt, gfc_simplify_bge, NULL,
1623 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1624
1625 make_generic ("bge", GFC_ISYM_BGE, GFC_STD_F2008);
1626
1627 add_sym_2 ("bgt", GFC_ISYM_BGT, CLASS_ELEMENTAL, ACTUAL_NO,
1628 BT_LOGICAL, dl, GFC_STD_F2008,
1629 gfc_check_bge_bgt_ble_blt, gfc_simplify_bgt, NULL,
1630 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1631
1632 make_generic ("bgt", GFC_ISYM_BGT, GFC_STD_F2008);
1633
e1633d82 1634 add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1635 gfc_check_i, gfc_simplify_bit_size, NULL,
1270d633 1636 i, BT_INTEGER, di, REQUIRED);
6de9cd9a 1637
cd5ecab6 1638 make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
6de9cd9a 1639
88a95a11
FXC
1640 add_sym_2 ("ble", GFC_ISYM_BLE, CLASS_ELEMENTAL, ACTUAL_NO,
1641 BT_LOGICAL, dl, GFC_STD_F2008,
1642 gfc_check_bge_bgt_ble_blt, gfc_simplify_ble, NULL,
1643 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1644
1645 make_generic ("ble", GFC_ISYM_BLE, GFC_STD_F2008);
1646
1647 add_sym_2 ("blt", GFC_ISYM_BLT, CLASS_ELEMENTAL, ACTUAL_NO,
1648 BT_LOGICAL, dl, GFC_STD_F2008,
1649 gfc_check_bge_bgt_ble_blt, gfc_simplify_blt, NULL,
1650 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
1651
1652 make_generic ("blt", GFC_ISYM_BLT, GFC_STD_F2008);
1653
e1633d82 1654 add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
289e52fd 1655 gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
1270d633 1656 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
6de9cd9a 1657
c98583e9
FR
1658 if (flag_dec_intrinsic_ints)
1659 {
1660 make_alias ("bbtest", GFC_STD_GNU);
1661 make_alias ("bitest", GFC_STD_GNU);
1662 make_alias ("bjtest", GFC_STD_GNU);
1663 make_alias ("bktest", GFC_STD_GNU);
1664 }
1665
b7892582 1666 make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
6de9cd9a 1667
e1633d82 1668 add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1669 gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
1270d633 1670 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1671
b7892582 1672 make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
6de9cd9a 1673
e1633d82 1674 add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
6de9cd9a 1675 gfc_check_char, gfc_simplify_char, gfc_resolve_char,
1270d633 1676 i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1677
b7892582 1678 make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
6de9cd9a 1679
e6c14898 1680 add_sym_1 ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
a3e3233a
FXC
1681 GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
1682 nm, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
1683
1684 make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
a119fc1c 1685
e6c14898
DK
1686 add_sym_2 ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1687 di, GFC_STD_GNU, gfc_check_chmod, NULL, gfc_resolve_chmod,
a119fc1c
FXC
1688 nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
1689
1690 make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
1691
e1633d82 1692 add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 1693 gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
1270d633
SK
1694 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
1695 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1696
b7892582 1697 make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
6de9cd9a 1698
f8862a1b 1699 add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY,
cd5ecab6 1700 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
0e7e7e6e
FXC
1701
1702 make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
b251af97 1703 GFC_STD_F2003);
0e7e7e6e 1704
e1633d82 1705 add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
5d723e54
FXC
1706 gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
1707 x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
1708
1709 make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
1710
6de9cd9a
DN
1711 /* Making dcmplx a specific of cmplx causes cmplx to return a double
1712 complex instead of the default complex. */
1713
e1633d82 1714 add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
6de9cd9a 1715 gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
1270d633 1716 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
6de9cd9a 1717
b7892582 1718 make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
6de9cd9a 1719
e1633d82 1720 add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
985aff9c 1721 gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
1270d633 1722 z, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 1723
e1633d82 1724 add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
f8862a1b 1725 NULL, gfc_simplify_conjg, gfc_resolve_conjg,
1270d633 1726 z, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1727
b7892582 1728 make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
6de9cd9a 1729
e1633d82 1730 add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 1731 gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
1270d633 1732 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1733
e1633d82 1734 add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1735 gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
1270d633 1736 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1737
e1633d82 1738 add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 1739 NULL, gfc_simplify_cos, gfc_resolve_cos,
1270d633 1740 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 1741
e1633d82 1742 add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
f8862a1b 1743 NULL, gfc_simplify_cos, gfc_resolve_cos,
1270d633 1744 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1745
19060788 1746 make_alias ("cdcos", GFC_STD_GNU);
6de9cd9a 1747
b7892582 1748 make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
6de9cd9a 1749
e1633d82 1750 add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 1751 gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
1270d633 1752 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1753
e1633d82 1754 add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1755 gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
1270d633 1756 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1757
b7892582 1758 make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
6de9cd9a 1759
5cda5098
FXC
1760 add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1761 BT_INTEGER, di, GFC_STD_F95,
a16d978f 1762 gfc_check_count, gfc_simplify_count, gfc_resolve_count,
5cda5098
FXC
1763 msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
1764 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1765
b7892582 1766 make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
6de9cd9a 1767
b1c1d761
SK
1768 add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
1769 BT_REAL, dr, GFC_STD_F95,
1770 gfc_check_cshift, gfc_simplify_cshift, gfc_resolve_cshift,
1771 ar, BT_REAL, dr, REQUIRED,
1772 sh, BT_INTEGER, di, REQUIRED,
1270d633 1773 dm, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 1774
b7892582 1775 make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
6de9cd9a 1776
e6c14898
DK
1777 add_sym_1 ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
1778 0, GFC_STD_GNU, gfc_check_ctime, NULL, gfc_resolve_ctime,
1779 tm, BT_INTEGER, di, REQUIRED);
35059811
FXC
1780
1781 make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
1782
e1633d82 1783 add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 1784 gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
1270d633 1785 a, BT_REAL, dr, REQUIRED);
6de9cd9a 1786
b7892582 1787 make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
6de9cd9a 1788
e1633d82 1789 add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1790 gfc_check_digits, gfc_simplify_digits, NULL,
1270d633 1791 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 1792
cd5ecab6 1793 make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
6de9cd9a 1794
e1633d82 1795 add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 1796 gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
c73b6478 1797 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
6de9cd9a 1798
e1633d82 1799 add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 1800 NULL, gfc_simplify_dim, gfc_resolve_dim,
1270d633 1801 x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
6de9cd9a 1802
e1633d82 1803 add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1804 gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
1270d633 1805 x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
6de9cd9a 1806
b7892582 1807 make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
6de9cd9a 1808
e1633d82 1809 add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
8ec259c1 1810 GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
1270d633 1811 va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
6de9cd9a 1812
b7892582 1813 make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
6de9cd9a 1814
e1633d82 1815 add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1816 gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
1270d633 1817 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
6de9cd9a 1818
b7892582 1819 make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
6de9cd9a 1820
02c74373
FXC
1821 add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO,
1822 BT_REAL, dd, GFC_STD_GNU, NULL, gfc_simplify_dreal, NULL,
1270d633 1823 a, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1824
b7892582 1825 make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
6de9cd9a 1826
88a95a11
FXC
1827 add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
1828 BT_INTEGER, di, GFC_STD_F2008,
1829 gfc_check_dshift, gfc_simplify_dshiftl, gfc_resolve_dshift,
1830 i, BT_INTEGER, di, REQUIRED,
1831 j, BT_INTEGER, di, REQUIRED,
1832 sh, BT_INTEGER, di, REQUIRED);
1833
1834 make_generic ("dshiftl", GFC_ISYM_DSHIFTL, GFC_STD_F2008);
1835
1836 add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
1837 BT_INTEGER, di, GFC_STD_F2008,
1838 gfc_check_dshift, gfc_simplify_dshiftr, gfc_resolve_dshift,
1839 i, BT_INTEGER, di, REQUIRED,
1840 j, BT_INTEGER, di, REQUIRED,
1841 sh, BT_INTEGER, di, REQUIRED);
1842
1843 make_generic ("dshiftr", GFC_ISYM_DSHIFTR, GFC_STD_F2008);
1844
e1633d82 1845 add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
fbd35ba1 1846 gfc_check_eoshift, gfc_simplify_eoshift, gfc_resolve_eoshift,
88a95a11
FXC
1847 ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, ii, REQUIRED,
1848 bd, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 1849
b7892582 1850 make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
6de9cd9a 1851
1b314f14
SK
1852 add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr,
1853 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_epsilon, NULL,
1270d633 1854 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1855
cd5ecab6 1856 make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
6de9cd9a 1857
e8525382 1858 /* G77 compatibility for the ERF() and ERFC() functions. */
f489fba1 1859 add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
fdc54e88
FXC
1860 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
1861 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
e8525382 1862
fdc54e88
FXC
1863 add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1864 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
1865 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
e8525382 1866
f489fba1 1867 make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
e8525382 1868
f489fba1 1869 add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
fdc54e88
FXC
1870 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
1871 gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
e8525382 1872
fdc54e88
FXC
1873 add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
1874 GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
1875 gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
e8525382 1876
f489fba1
FXC
1877 make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
1878
1879 add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
9b33a6a1
FXC
1880 BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
1881 gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
1882 dr, REQUIRED);
f489fba1
FXC
1883
1884 make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
e8525382 1885
2bd74949 1886 /* G77 compatibility */
e6c14898
DK
1887 add_sym_1 ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
1888 4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
1270d633 1889 x, BT_REAL, 4, REQUIRED);
2bd74949 1890
a1ba31ce
DF
1891 make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
1892
e6c14898
DK
1893 add_sym_1 ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
1894 4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
a1ba31ce 1895 x, BT_REAL, 4, REQUIRED);
2bd74949 1896
b7892582 1897 make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
2bd74949 1898
e1633d82 1899 add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 1900 gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
1270d633 1901 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1902
e1633d82 1903 add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1904 gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
1270d633 1905 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1906
e1633d82 1907 add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 1908 NULL, gfc_simplify_exp, gfc_resolve_exp,
1270d633 1909 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 1910
e1633d82 1911 add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
f8862a1b 1912 NULL, gfc_simplify_exp, gfc_resolve_exp,
1270d633 1913 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1914
19060788 1915 make_alias ("cdexp", GFC_STD_GNU);
6de9cd9a 1916
b7892582 1917 make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
6de9cd9a 1918
1b314f14
SK
1919 add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
1920 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_exponent, gfc_resolve_exponent,
1270d633 1921 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1922
b7892582 1923 make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
6de9cd9a 1924
cf2b3c22
TB
1925 add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
1926 ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
eaf31d82
TB
1927 gfc_check_same_type_as, gfc_simplify_extends_type_of,
1928 gfc_resolve_extends_type_of,
cf2b3c22
TB
1929 a, BT_UNKNOWN, 0, REQUIRED,
1930 mo, BT_UNKNOWN, 0, REQUIRED);
1931
ef78bc3c 1932 add_sym_2 ("failed_images", GFC_ISYM_FAILED_IMAGES, CLASS_TRANSFORMATIONAL,
286f737c 1933 ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2018,
ef78bc3c
AV
1934 gfc_check_failed_or_stopped_images,
1935 gfc_simplify_failed_or_stopped_images,
f8862a1b
DR
1936 gfc_resolve_failed_images, team, BT_VOID, di, OPTIONAL,
1937 kind, BT_INTEGER, di, OPTIONAL);
ef78bc3c 1938
e6c14898
DK
1939 add_sym_0 ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
1940 dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
35059811
FXC
1941
1942 make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
1943
e1633d82 1944 add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1945 gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
1270d633 1946 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1947
b7892582 1948 make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
6de9cd9a 1949
df65f093 1950 /* G77 compatible fnum */
e6c14898
DK
1951 add_sym_1 ("fnum", GFC_ISYM_FNUM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1952 di, GFC_STD_GNU, gfc_check_fnum, NULL, gfc_resolve_fnum,
df65f093
SK
1953 ut, BT_INTEGER, di, REQUIRED);
1954
1955 make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
1956
1b314f14
SK
1957 add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
1958 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_fraction, gfc_resolve_fraction,
1270d633 1959 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1960
b7892582 1961 make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
6de9cd9a 1962
1a14a58c
TB
1963 add_sym_2_intent ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, ACTUAL_NO,
1964 BT_INTEGER, di, GFC_STD_GNU,
1965 gfc_check_fstat, NULL, gfc_resolve_fstat,
1966 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
1967 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
df65f093
SK
1968
1969 make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
1970
e6c14898
DK
1971 add_sym_1 ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1972 ii, GFC_STD_GNU, gfc_check_ftell, NULL, gfc_resolve_ftell,
5d723e54
FXC
1973 ut, BT_INTEGER, di, REQUIRED);
1974
1975 make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
1976
1a14a58c
TB
1977 add_sym_2_intent ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, ACTUAL_NO,
1978 BT_INTEGER, di, GFC_STD_GNU,
1979 gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
1980 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
1981 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
5d723e54
FXC
1982
1983 make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
1984
1a14a58c 1985 add_sym_1_intent ("fget", GFC_ISYM_FGET, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
e6c14898 1986 di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fget,
1a14a58c 1987 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
5d723e54
FXC
1988
1989 make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
1990
e6c14898
DK
1991 add_sym_2 ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1992 di, GFC_STD_GNU, gfc_check_fgetputc, NULL, gfc_resolve_fputc,
5d723e54
FXC
1993 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
1994
1995 make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
1996
e6c14898
DK
1997 add_sym_1 ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
1998 di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fput,
5d723e54
FXC
1999 c, BT_CHARACTER, dc, REQUIRED);
2000
2001 make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
2002
7bc19392 2003 add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
f489fba1
FXC
2004 GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
2005 gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
75be5dc0 2006
7bc19392 2007 add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
15ead859 2008 gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
75be5dc0
TB
2009 x, BT_REAL, dr, REQUIRED);
2010
7bc19392 2011 make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
75be5dc0 2012
4c0c6b9f 2013 /* Unix IDs (g77 compatibility) */
e6c14898
DK
2014 add_sym_1 ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2015 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getcwd,
1270d633
SK
2016 c, BT_CHARACTER, dc, REQUIRED);
2017
b7892582 2018 make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
a8c60d7f 2019
e6c14898
DK
2020 add_sym_0 ("getgid", GFC_ISYM_GETGID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2021 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getgid);
1270d633 2022
b7892582 2023 make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
4c0c6b9f 2024
e6c14898
DK
2025 add_sym_0 ("getpid", GFC_ISYM_GETPID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2026 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getpid);
1270d633 2027
b7892582 2028 make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
4c0c6b9f 2029
f8862a1b 2030 add_sym_1 ("get_team", GFC_ISYM_GET_TEAM, CLASS_TRANSFORMATIONAL,
286f737c 2031 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2018,
f8862a1b
DR
2032 gfc_check_get_team, NULL, gfc_resolve_get_team,
2033 level, BT_INTEGER, di, OPTIONAL);
2034
e6c14898
DK
2035 add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2036 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getuid);
1270d633 2037
b7892582 2038 make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
4c0c6b9f 2039
1a14a58c
TB
2040 add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, ACTUAL_NO,
2041 BT_INTEGER, di, GFC_STD_GNU,
2042 gfc_check_hostnm, NULL, gfc_resolve_hostnm,
2043 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
f77b6ca3
FXC
2044
2045 make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
2046
e1633d82 2047 add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2048 gfc_check_huge, gfc_simplify_huge, NULL,
1270d633 2049 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2050
cd5ecab6 2051 make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
6de9cd9a 2052
f489fba1
FXC
2053 add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
2054 BT_REAL, dr, GFC_STD_F2008,
2055 gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
2056 x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
2057
2058 make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
2059
5cda5098
FXC
2060 add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
2061 BT_INTEGER, di, GFC_STD_F95,
2062 gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
2063 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2064
b7892582 2065 make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
6de9cd9a 2066
89c1cf26
SK
2067 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
2068 GFC_STD_F95,
2069 gfc_check_iand_ieor_ior, gfc_simplify_iand, gfc_resolve_iand,
1270d633 2070 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
6de9cd9a 2071
c98583e9
FR
2072 if (flag_dec_intrinsic_ints)
2073 {
2074 make_alias ("biand", GFC_STD_GNU);
2075 make_alias ("iiand", GFC_STD_GNU);
2076 make_alias ("jiand", GFC_STD_GNU);
2077 make_alias ("kiand", GFC_STD_GNU);
2078 }
2079
b7892582 2080 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
6de9cd9a 2081
e6c14898
DK
2082 add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2083 dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_and, gfc_resolve_and,
5d723e54
FXC
2084 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
2085
2086 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
2087
195a95c4
TB
2088 add_sym_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
2089 gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
2090 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2091 msk, BT_LOGICAL, dl, OPTIONAL);
2092
2093 make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
2094
2095 add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
2096 gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
2097 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2098 msk, BT_LOGICAL, dl, OPTIONAL);
2099
2100 make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
2101
e6c14898
DK
2102 add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2103 di, GFC_STD_GNU, NULL, NULL, NULL);
1270d633 2104
b7892582 2105 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
b41b2534 2106
e1633d82 2107 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
289e52fd 2108 gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
1270d633 2109 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
6de9cd9a 2110
c98583e9
FR
2111 if (flag_dec_intrinsic_ints)
2112 {
2113 make_alias ("bbclr", GFC_STD_GNU);
2114 make_alias ("iibclr", GFC_STD_GNU);
2115 make_alias ("jibclr", GFC_STD_GNU);
2116 make_alias ("kibclr", GFC_STD_GNU);
2117 }
2118
b7892582 2119 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
6de9cd9a 2120
e1633d82 2121 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2122 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1270d633
SK
2123 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
2124 ln, BT_INTEGER, di, REQUIRED);
6de9cd9a 2125
c98583e9
FR
2126 if (flag_dec_intrinsic_ints)
2127 {
2128 make_alias ("bbits", GFC_STD_GNU);
2129 make_alias ("iibits", GFC_STD_GNU);
2130 make_alias ("jibits", GFC_STD_GNU);
2131 make_alias ("kibits", GFC_STD_GNU);
2132 }
2133
b7892582 2134 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
6de9cd9a 2135
e1633d82 2136 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
289e52fd 2137 gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
1270d633 2138 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
6de9cd9a 2139
c98583e9
FR
2140 if (flag_dec_intrinsic_ints)
2141 {
2142 make_alias ("bbset", GFC_STD_GNU);
2143 make_alias ("iibset", GFC_STD_GNU);
2144 make_alias ("jibset", GFC_STD_GNU);
2145 make_alias ("kibset", GFC_STD_GNU);
2146 }
2147
b7892582 2148 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
6de9cd9a 2149
5cda5098
FXC
2150 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
2151 BT_INTEGER, di, GFC_STD_F77,
860c8f3b 2152 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
5cda5098 2153 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2154
b7892582 2155 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
6de9cd9a 2156
89c1cf26
SK
2157 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
2158 GFC_STD_F95,
2159 gfc_check_iand_ieor_ior, gfc_simplify_ieor, gfc_resolve_ieor,
1270d633 2160 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
6de9cd9a 2161
c98583e9
FR
2162 if (flag_dec_intrinsic_ints)
2163 {
2164 make_alias ("bieor", GFC_STD_GNU);
2165 make_alias ("iieor", GFC_STD_GNU);
2166 make_alias ("jieor", GFC_STD_GNU);
2167 make_alias ("kieor", GFC_STD_GNU);
2168 }
2169
c3d003d2 2170 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
6de9cd9a 2171
e6c14898
DK
2172 add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2173 dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
5d723e54
FXC
2174 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
2175
2176 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
2177
e6c14898
DK
2178 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2179 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno);
f77b6ca3
FXC
2180
2181 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
2182
64f002ed 2183 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
0d6d8e00 2184 gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
64f002ed
TB
2185 ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
2186
ef78bc3c 2187 add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
286f737c 2188 BT_INTEGER, di, GFC_STD_F2018, gfc_check_image_status,
f8862a1b
DR
2189 gfc_simplify_image_status, gfc_resolve_image_status, image,
2190 BT_INTEGER, di, REQUIRED, team, BT_VOID, di, OPTIONAL);
ef78bc3c 2191
32a126b2
FXC
2192 /* The resolution function for INDEX is called gfc_resolve_index_func
2193 because the name gfc_resolve_index is already used in resolve.c. */
68d62cb2
MM
2194 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
2195 BT_INTEGER, di, GFC_STD_F77,
2196 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
2197 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
2198 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2199
b7892582 2200 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
6de9cd9a 2201
e1633d82 2202 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2203 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1270d633 2204 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2205
e1633d82 2206 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1270d633
SK
2207 NULL, gfc_simplify_ifix, NULL,
2208 a, BT_REAL, dr, REQUIRED);
6de9cd9a 2209
e1633d82 2210 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1270d633
SK
2211 NULL, gfc_simplify_idint, NULL,
2212 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2213
b7892582 2214 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
6de9cd9a 2215
e1633d82 2216 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
bf3fb7e4
FXC
2217 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
2218 a, BT_REAL, dr, REQUIRED);
2219
2220 make_alias ("short", GFC_STD_GNU);
2221
2222 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
2223
e1633d82 2224 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
bf3fb7e4
FXC
2225 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
2226 a, BT_REAL, dr, REQUIRED);
2227
2228 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
2229
e1633d82 2230 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
bf3fb7e4
FXC
2231 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
2232 a, BT_REAL, dr, REQUIRED);
2233
2234 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
2235
89c1cf26
SK
2236 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di,
2237 GFC_STD_F95,
2238 gfc_check_iand_ieor_ior, gfc_simplify_ior, gfc_resolve_ior,
1270d633 2239 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
6de9cd9a 2240
c98583e9
FR
2241 if (flag_dec_intrinsic_ints)
2242 {
2243 make_alias ("bior", GFC_STD_GNU);
2244 make_alias ("iior", GFC_STD_GNU);
2245 make_alias ("jior", GFC_STD_GNU);
2246 make_alias ("kior", GFC_STD_GNU);
2247 }
2248
b7892582 2249 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
6de9cd9a 2250
e6c14898
DK
2251 add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2252 dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_or, gfc_resolve_or,
5d723e54
FXC
2253 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
2254
2255 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
2256
195a95c4
TB
2257 add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
2258 gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
2259 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2260 msk, BT_LOGICAL, dl, OPTIONAL);
2261
2262 make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
2263
2bd74949 2264 /* The following function is for G77 compatibility. */
e6c14898
DK
2265 add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2266 4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
1270d633 2267 i, BT_INTEGER, 4, OPTIONAL);
2bd74949 2268
b7892582 2269 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
2bd74949 2270
e6c14898
DK
2271 add_sym_1 ("isatty", GFC_ISYM_ISATTY, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2272 dl, GFC_STD_GNU, gfc_check_isatty, NULL, gfc_resolve_isatty,
ae8b8789
FXC
2273 ut, BT_INTEGER, di, REQUIRED);
2274
2275 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
2276
419af57c
TK
2277 add_sym_1 ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS, CLASS_INQUIRY, ACTUAL_NO,
2278 BT_LOGICAL, dl, GFC_STD_F2008,
2279 gfc_check_is_contiguous, gfc_simplify_is_contiguous,
2280 gfc_resolve_is_contiguous,
2281 ar, BT_REAL, dr, REQUIRED);
2282
2283 make_generic ("is_contiguous", GFC_ISYM_IS_CONTIGUOUS, GFC_STD_F2008);
2284
bae89173
FXC
2285 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
2286 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
4ec80803
FXC
2287 gfc_check_i, gfc_simplify_is_iostat_end, NULL,
2288 i, BT_INTEGER, 0, REQUIRED);
bae89173
FXC
2289
2290 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
2291
2292 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
2293 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
4ec80803
FXC
2294 gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
2295 i, BT_INTEGER, 0, REQUIRED);
bae89173
FXC
2296
2297 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
2298
4ec80803
FXC
2299 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
2300 BT_LOGICAL, dl, GFC_STD_GNU,
2301 gfc_check_isnan, gfc_simplify_isnan, NULL,
3d97b1af
FXC
2302 x, BT_REAL, 0, REQUIRED);
2303
2304 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
2305
88a95a11
FXC
2306 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
2307 BT_INTEGER, di, GFC_STD_GNU,
2308 gfc_check_ishft, gfc_simplify_rshift, gfc_resolve_rshift,
a119fc1c
FXC
2309 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
2310
2311 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
2312
88a95a11
FXC
2313 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
2314 BT_INTEGER, di, GFC_STD_GNU,
2315 gfc_check_ishft, gfc_simplify_lshift, gfc_resolve_lshift,
a119fc1c
FXC
2316 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
2317
2318 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
2319
e1633d82 2320 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2321 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1270d633 2322 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
6de9cd9a 2323
c98583e9
FR
2324 if (flag_dec_intrinsic_ints)
2325 {
2326 make_alias ("bshft", GFC_STD_GNU);
2327 make_alias ("iishft", GFC_STD_GNU);
2328 make_alias ("jishft", GFC_STD_GNU);
2329 make_alias ("kishft", GFC_STD_GNU);
2330 }
2331
b7892582 2332 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
6de9cd9a 2333
e1633d82 2334 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2335 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1270d633
SK
2336 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
2337 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2338
c98583e9
FR
2339 if (flag_dec_intrinsic_ints)
2340 {
2341 make_alias ("bshftc", GFC_STD_GNU);
2342 make_alias ("iishftc", GFC_STD_GNU);
2343 make_alias ("jishftc", GFC_STD_GNU);
2344 make_alias ("kishftc", GFC_STD_GNU);
2345 }
2346
b7892582 2347 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
6de9cd9a 2348
e6c14898 2349 add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
17164de4 2350 di, GFC_STD_GNU, gfc_check_kill, NULL, NULL,
fbe1f017 2351 pid, BT_INTEGER, di, REQUIRED, sig, BT_INTEGER, di, REQUIRED);
f77b6ca3
FXC
2352
2353 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
2354
e1633d82 2355 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1270d633
SK
2356 gfc_check_kind, gfc_simplify_kind, NULL,
2357 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2358
cd5ecab6 2359 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
6de9cd9a 2360
5cda5098
FXC
2361 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
2362 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2363 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
5cda5098
FXC
2364 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
2365 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2366
b7892582 2367 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
6de9cd9a 2368
64f002ed 2369 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
0d6d8e00
TB
2370 BT_INTEGER, di, GFC_STD_F2008,
2371 gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
64f002ed
TB
2372 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2373 kind, BT_INTEGER, di, OPTIONAL);
2374
0d6d8e00 2375 make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
64f002ed 2376
414f00e9
SB
2377 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
2378 BT_INTEGER, di, GFC_STD_F2008,
2379 gfc_check_i, gfc_simplify_leadz, NULL,
2380 i, BT_INTEGER, di, REQUIRED);
2381
2382 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
2383
5cda5098
FXC
2384 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
2385 BT_INTEGER, di, GFC_STD_F77,
2386 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
2387 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2388
b7892582 2389 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
6de9cd9a 2390
5cda5098
FXC
2391 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
2392 BT_INTEGER, di, GFC_STD_F95,
2393 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
2394 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2395
f77b6ca3
FXC
2396 make_alias ("lnblnk", GFC_STD_GNU);
2397
b7892582 2398 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
6de9cd9a 2399
f489fba1
FXC
2400 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
2401 dr, GFC_STD_GNU,
75be5dc0
TB
2402 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2403 x, BT_REAL, dr, REQUIRED);
2404
f489fba1
FXC
2405 make_alias ("log_gamma", GFC_STD_F2008);
2406
75be5dc0
TB
2407 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2408 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2409 x, BT_REAL, dr, REQUIRED);
2410
2411 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
15ead859 2412 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
75be5dc0
TB
2413 x, BT_REAL, dr, REQUIRED);
2414
f489fba1 2415 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
75be5dc0
TB
2416
2417
d393bbd7
FXC
2418 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2419 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1270d633 2420 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2421
b7892582 2422 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
6de9cd9a 2423
d393bbd7
FXC
2424 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2425 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1270d633 2426 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2427
b7892582 2428 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
6de9cd9a 2429
d393bbd7
FXC
2430 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2431 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1270d633 2432 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2433
b7892582 2434 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
6de9cd9a 2435
d393bbd7
FXC
2436 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2437 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1270d633 2438 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2439
b7892582 2440 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
6de9cd9a 2441
e6c14898 2442 add_sym_2 ("link", GFC_ISYM_LINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC
2443 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
2444 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
2445
2446 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
f8862a1b 2447
e1633d82 2448 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
985aff9c 2449 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1270d633 2450 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2451
e1633d82 2452 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1270d633
SK
2453 NULL, gfc_simplify_log, gfc_resolve_log,
2454 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2455
e1633d82 2456 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2457 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
1270d633 2458 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2459
e1633d82 2460 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2461 NULL, gfc_simplify_log, gfc_resolve_log,
1270d633 2462 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2463
e1633d82 2464 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK
2465 NULL, gfc_simplify_log, gfc_resolve_log,
2466 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2467
19060788 2468 make_alias ("cdlog", GFC_STD_GNU);
6de9cd9a 2469
b7892582 2470 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
6de9cd9a 2471
e1633d82 2472 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
985aff9c 2473 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2474 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2475
e1633d82 2476 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2477 NULL, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2478 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2479
e1633d82 2480 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2481 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2482 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2483
b7892582 2484 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
6de9cd9a 2485
e1633d82 2486 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
6de9cd9a 2487 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1270d633 2488 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2489
b7892582 2490 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
6de9cd9a 2491
1a14a58c
TB
2492 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, ACTUAL_NO,
2493 BT_INTEGER, di, GFC_STD_GNU,
2494 gfc_check_stat, NULL, gfc_resolve_lstat,
2495 nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2496 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
bf3fb7e4
FXC
2497
2498 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2499
e6c14898 2500 add_sym_1 ("malloc", GFC_ISYM_MALLOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
8b40ca6a 2501 GFC_STD_GNU, gfc_check_malloc, NULL, NULL,
2f8cce28 2502 sz, BT_INTEGER, di, REQUIRED);
0d519038
FXC
2503
2504 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2505
88a95a11
FXC
2506 add_sym_2 ("maskl", GFC_ISYM_MASKL, CLASS_ELEMENTAL, ACTUAL_NO,
2507 BT_INTEGER, di, GFC_STD_F2008,
2508 gfc_check_mask, gfc_simplify_maskl, gfc_resolve_mask,
2509 i, BT_INTEGER, di, REQUIRED,
2510 kind, BT_INTEGER, di, OPTIONAL);
2511
2512 make_generic ("maskl", GFC_ISYM_MASKL, GFC_STD_F2008);
2513
2514 add_sym_2 ("maskr", GFC_ISYM_MASKR, CLASS_ELEMENTAL, ACTUAL_NO,
2515 BT_INTEGER, di, GFC_STD_F2008,
2516 gfc_check_mask, gfc_simplify_maskr, gfc_resolve_mask,
2517 i, BT_INTEGER, di, REQUIRED,
2518 kind, BT_INTEGER, di, OPTIONAL);
2519
2520 make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
2521
e1633d82 2522 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8ec259c1 2523 gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
1270d633 2524 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
6de9cd9a 2525
b7892582 2526 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
6de9cd9a
DN
2527
2528 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2529 int(max). The max function must take at least two arguments. */
2530
e1633d82 2531 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
6de9cd9a 2532 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1270d633 2533 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2534
e1633d82 2535 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2536 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1270d633 2537 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2538
e1633d82 2539 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2540 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1270d633 2541 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2542
e1633d82 2543 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2544 gfc_check_min_max_real, gfc_simplify_max, NULL,
1270d633 2545 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2546
e1633d82 2547 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2548 gfc_check_min_max_real, gfc_simplify_max, NULL,
1270d633 2549 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2550
e1633d82 2551 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 2552 gfc_check_min_max_double, gfc_simplify_max, NULL,
1270d633 2553 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
6de9cd9a 2554
b7892582 2555 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
6de9cd9a 2556
1b314f14
SK
2557 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER,
2558 di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_maxexponent, NULL,
1270d633 2559 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2560
cd5ecab6 2561 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
6de9cd9a 2562
64b1806b 2563 add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
a1d6c052 2564 gfc_check_minloc_maxloc, gfc_simplify_maxloc, gfc_resolve_maxloc,
1270d633 2565 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
64b1806b 2566 msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
fbe1f017 2567 bck, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2568
b7892582 2569 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
6de9cd9a 2570
01ce9e31
TK
2571 add_sym_6fl ("findloc", GFC_ISYM_FINDLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
2572 BT_INTEGER, di, GFC_STD_F2008,
2573 gfc_check_findloc, gfc_simplify_findloc, gfc_resolve_findloc,
2574 ar, BT_REAL, dr, REQUIRED, val, BT_REAL, dr, REQUIRED,
2575 dm, BT_INTEGER, ii, OPTIONAL, msk, BT_LOGICAL, dl, OPTIONAL,
2576 kind, BT_INTEGER, di, OPTIONAL, bck, BT_LOGICAL, dl, OPTIONAL);
2577
2578 make_generic ("findloc", GFC_ISYM_FINDLOC, GFC_STD_F2008);
2579
e1633d82 2580 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
5a0193ee 2581 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
1270d633
SK
2582 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2583 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2584
b7892582 2585 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
6de9cd9a 2586
e6c14898 2587 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28 2588 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
bf3fb7e4
FXC
2589
2590 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2591
e6c14898
DK
2592 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2593 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
bf3fb7e4
FXC
2594
2595 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2596
e1633d82 2597 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8f2b565d 2598 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
1270d633
SK
2599 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2600 msk, BT_LOGICAL, dl, REQUIRED);
6de9cd9a 2601
b7892582 2602 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
6de9cd9a 2603
88a95a11
FXC
2604 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS, CLASS_ELEMENTAL, ACTUAL_NO,
2605 BT_INTEGER, di, GFC_STD_F2008,
2606 gfc_check_merge_bits, gfc_simplify_merge_bits,
2607 gfc_resolve_merge_bits,
2608 i, BT_INTEGER, di, REQUIRED,
2609 j, BT_INTEGER, di, REQUIRED,
2610 msk, BT_INTEGER, di, REQUIRED);
2611
2612 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS, GFC_STD_F2008);
2613
1270d633
SK
2614 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2615 int(min). */
6de9cd9a 2616
e1633d82 2617 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
6de9cd9a 2618 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
b251af97 2619 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2620
e1633d82 2621 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2622 gfc_check_min_max_integer, gfc_simplify_min, NULL,
b251af97 2623 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2624
e1633d82 2625 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2626 gfc_check_min_max_integer, gfc_simplify_min, NULL,
b251af97 2627 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2628
e1633d82 2629 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2630 gfc_check_min_max_real, gfc_simplify_min, NULL,
b251af97 2631 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2632
e1633d82 2633 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2634 gfc_check_min_max_real, gfc_simplify_min, NULL,
b251af97 2635 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2636
e1633d82 2637 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 2638 gfc_check_min_max_double, gfc_simplify_min, NULL,
b251af97 2639 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
6de9cd9a 2640
b7892582 2641 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
6de9cd9a 2642
1b314f14
SK
2643 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER,
2644 di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_minexponent, NULL,
1270d633 2645 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2646
cd5ecab6 2647 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
6de9cd9a 2648
64b1806b 2649 add_sym_5ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
a1d6c052 2650 gfc_check_minloc_maxloc, gfc_simplify_minloc, gfc_resolve_minloc,
1270d633 2651 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
64b1806b 2652 msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
fbe1f017 2653 bck, BT_LOGICAL, dl, OPTIONAL);
f8862a1b 2654
b7892582 2655 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
6de9cd9a 2656
e1633d82 2657 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
5a0193ee 2658 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
1270d633
SK
2659 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2660 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2661
b7892582 2662 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
6de9cd9a 2663
e1633d82 2664 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2665 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2666 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
6de9cd9a 2667
c98583e9
FR
2668 if (flag_dec_intrinsic_ints)
2669 {
2670 make_alias ("bmod", GFC_STD_GNU);
2671 make_alias ("imod", GFC_STD_GNU);
2672 make_alias ("jmod", GFC_STD_GNU);
2673 make_alias ("kmod", GFC_STD_GNU);
2674 }
2675
e1633d82 2676 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2677 NULL, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2678 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
6de9cd9a 2679
e1633d82 2680 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2681 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2682 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
6de9cd9a 2683
b7892582 2684 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
6de9cd9a 2685
e1633d82 2686 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
6de9cd9a 2687 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1270d633 2688 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
6de9cd9a 2689
b7892582 2690 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
6de9cd9a 2691
e1633d82 2692 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8765339d 2693 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1270d633 2694 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
6de9cd9a 2695
b7892582 2696 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
6de9cd9a 2697
e1633d82 2698 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
8d2c2905 2699 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
9fe3100e 2700 a, BT_CHARACTER, dc, REQUIRED);
bec93d79 2701
cd5ecab6
DF
2702 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2703
e1633d82 2704 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2705 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1270d633 2706 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2707
e1633d82 2708 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2709 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1270d633 2710 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2711
b7892582 2712 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
6de9cd9a 2713
e1633d82 2714 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2715 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1270d633 2716 i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2717
c98583e9
FR
2718 if (flag_dec_intrinsic_ints)
2719 {
2720 make_alias ("bnot", GFC_STD_GNU);
2721 make_alias ("inot", GFC_STD_GNU);
2722 make_alias ("jnot", GFC_STD_GNU);
2723 make_alias ("knot", GFC_STD_GNU);
2724 }
2725
b7892582 2726 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
6de9cd9a 2727
0cd0559e
TB
2728 add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
2729 GFC_STD_F2008, gfc_check_norm2, gfc_simplify_norm2, gfc_resolve_norm2,
2730 x, BT_REAL, dr, REQUIRED,
2731 dm, BT_INTEGER, ii, OPTIONAL);
2732
2733 make_generic ("norm2", GFC_ISYM_NORM2, GFC_STD_F2008);
2734
e1633d82 2735 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2736 gfc_check_null, gfc_simplify_null, NULL,
1270d633 2737 mo, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2738
cd5ecab6 2739 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
6de9cd9a 2740
647340c9
ME
2741 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_TRANSFORMATIONAL,
2742 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
05fc16dd
TB
2743 gfc_check_num_images, gfc_simplify_num_images, NULL,
2744 dist, BT_INTEGER, di, OPTIONAL,
2745 failed, BT_LOGICAL, dl, OPTIONAL);
d0a4a61c 2746
e1633d82 2747 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
7ba8c18c 2748 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
1270d633
SK
2749 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2750 v, BT_REAL, dr, OPTIONAL);
6de9cd9a 2751
b7892582 2752 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
6de9cd9a 2753
0cd0559e
TB
2754
2755 add_sym_2 ("parity", GFC_ISYM_PARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl,
2756 GFC_STD_F2008, gfc_check_parity, gfc_simplify_parity, gfc_resolve_parity,
2757 msk, BT_LOGICAL, dl, REQUIRED,
2758 dm, BT_INTEGER, ii, OPTIONAL);
2759
2760 make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
2761
ad5f4de2
FXC
2762 add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
2763 BT_INTEGER, di, GFC_STD_F2008,
2764 gfc_check_i, gfc_simplify_popcnt, NULL,
2765 i, BT_INTEGER, di, REQUIRED);
2766
2767 make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
2768
2769 add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
2770 BT_INTEGER, di, GFC_STD_F2008,
2771 gfc_check_i, gfc_simplify_poppar, NULL,
2772 i, BT_INTEGER, di, REQUIRED);
2773
2774 make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
2775
e1633d82 2776 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2777 gfc_check_precision, gfc_simplify_precision, NULL,
1270d633 2778 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2779
cd5ecab6 2780 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
6de9cd9a 2781
23e38561
JW
2782 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2783 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2784 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
6de9cd9a 2785
b7892582 2786 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
6de9cd9a 2787
e1633d82 2788 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a16d978f 2789 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
1270d633
SK
2790 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2791 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2792
b7892582 2793 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
6de9cd9a 2794
e1633d82 2795 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2796 gfc_check_radix, gfc_simplify_radix, NULL,
1270d633 2797 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2798
cd5ecab6 2799 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
6de9cd9a 2800
2bd74949 2801 /* The following function is for G77 compatibility. */
e6c14898
DK
2802 add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2803 4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
b251af97 2804 i, BT_INTEGER, 4, OPTIONAL);
2bd74949 2805
1270d633
SK
2806 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2807 use slightly different shoddy multiplicative congruential PRNG. */
19060788 2808 make_alias ("ran", GFC_STD_GNU);
f8e566e5 2809
b7892582 2810 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2bd74949 2811
e1633d82 2812 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2813 gfc_check_range, gfc_simplify_range, NULL,
1270d633 2814 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2815
cd5ecab6 2816 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
6de9cd9a 2817
2514987f 2818 add_sym_1 ("rank", GFC_ISYM_RANK, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
286f737c 2819 GFC_STD_F2018, gfc_check_rank, gfc_simplify_rank, gfc_resolve_rank,
2514987f 2820 a, BT_REAL, dr, REQUIRED);
286f737c 2821 make_generic ("rank", GFC_ISYM_RANK, GFC_STD_F2018);
2514987f 2822
e1633d82 2823 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2824 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1270d633 2825 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2826
878f88b7
SK
2827 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
2828
6970fcc8 2829 /* This provides compatibility with g77. */
878f88b7 2830 add_sym_1 ("realpart", GFC_ISYM_REALPART, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
6970fcc8
SK
2831 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2832 a, BT_UNKNOWN, dr, REQUIRED);
2833
878f88b7
SK
2834 make_generic ("realpart", GFC_ISYM_REALPART, GFC_STD_F77);
2835
2836 add_sym_1 ("float", GFC_ISYM_FLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
c9018c71 2837 gfc_check_float, gfc_simplify_float, NULL,
1270d633 2838 a, BT_INTEGER, di, REQUIRED);
6de9cd9a 2839
c98583e9
FR
2840 if (flag_dec_intrinsic_ints)
2841 {
2842 make_alias ("floati", GFC_STD_GNU);
2843 make_alias ("floatj", GFC_STD_GNU);
2844 make_alias ("floatk", GFC_STD_GNU);
2845 }
2846
878f88b7
SK
2847 make_generic ("float", GFC_ISYM_FLOAT, GFC_STD_F77);
2848
2849 add_sym_1 ("dfloat", GFC_ISYM_DFLOAT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
c9018c71
DF
2850 gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2851 a, BT_REAL, dr, REQUIRED);
2852
878f88b7
SK
2853 make_generic ("dfloat", GFC_ISYM_DFLOAT, GFC_STD_F77);
2854
2855 add_sym_1 ("sngl", GFC_ISYM_SNGL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
c9018c71 2856 gfc_check_sngl, gfc_simplify_sngl, NULL,
1270d633 2857 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2858
878f88b7 2859 make_generic ("sngl", GFC_ISYM_SNGL, GFC_STD_F77);
6de9cd9a 2860
e6c14898 2861 add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC
2862 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2863 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
2864
2865 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
f8862a1b 2866
e1633d82 2867 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 2868 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
0881653c 2869 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 2870
b7892582 2871 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
6de9cd9a 2872
e1633d82 2873 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2874 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
1270d633
SK
2875 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2876 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 2877
b7892582 2878 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
6de9cd9a 2879
1b314f14
SK
2880 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
2881 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
1270d633 2882 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2883
b7892582 2884 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
6de9cd9a 2885
cf2b3c22
TB
2886 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2887 BT_LOGICAL, dl, GFC_STD_F2003,
eaf31d82 2888 gfc_check_same_type_as, gfc_simplify_same_type_as, NULL,
cf2b3c22
TB
2889 a, BT_UNKNOWN, 0, REQUIRED,
2890 b, BT_UNKNOWN, 0, REQUIRED);
2891
e1633d82 2892 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2893 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
1270d633 2894 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2895
b7892582 2896 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
6de9cd9a 2897
5cda5098
FXC
2898 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2899 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2900 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
1270d633 2901 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 2902 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2903
b7892582 2904 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
6de9cd9a 2905
f7b529fa 2906 /* Added for G77 compatibility garbage. */
e6c14898
DK
2907 add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2908 4, GFC_STD_GNU, NULL, NULL, NULL);
2bd74949 2909
b7892582 2910 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2bd74949 2911
53096259 2912 /* Added for G77 compatibility. */
e6c14898
DK
2913 add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2914 dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
53096259
PT
2915 x, BT_REAL, dr, REQUIRED);
2916
2917 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2918
a39fafac
FXC
2919 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2920 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2921 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2922 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2923
2924 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2925
e1633d82 2926 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC
2927 GFC_STD_F95, gfc_check_selected_int_kind,
2928 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
6de9cd9a 2929
b7892582 2930 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
6de9cd9a 2931
01349049 2932 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC
2933 GFC_STD_F95, gfc_check_selected_real_kind,
2934 gfc_simplify_selected_real_kind, NULL,
01349049
TB
2935 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2936 "radix", BT_INTEGER, di, OPTIONAL);
6de9cd9a 2937
b7892582 2938 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
6de9cd9a 2939
e1633d82 2940 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a
DN
2941 gfc_check_set_exponent, gfc_simplify_set_exponent,
2942 gfc_resolve_set_exponent,
1270d633 2943 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2944
b7892582 2945 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
6de9cd9a 2946
7320cf09 2947 add_sym_2 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2948 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
7320cf09
TB
2949 src, BT_REAL, dr, REQUIRED,
2950 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2951
b7892582 2952 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
6de9cd9a 2953
88a95a11
FXC
2954 add_sym_2 ("shifta", GFC_ISYM_SHIFTA, CLASS_ELEMENTAL, ACTUAL_NO,
2955 BT_INTEGER, di, GFC_STD_F2008,
2956 gfc_check_shift, gfc_simplify_shifta, gfc_resolve_shift,
2957 i, BT_INTEGER, di, REQUIRED,
2958 sh, BT_INTEGER, di, REQUIRED);
2959
2960 make_generic ("shifta", GFC_ISYM_SHIFTA, GFC_STD_F2008);
2961
2962 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
2963 BT_INTEGER, di, GFC_STD_F2008,
2964 gfc_check_shift, gfc_simplify_shiftl, gfc_resolve_shift,
2965 i, BT_INTEGER, di, REQUIRED,
2966 sh, BT_INTEGER, di, REQUIRED);
2967
2968 make_generic ("shiftl", GFC_ISYM_SHIFTL, GFC_STD_F2008);
2969
2970 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
2971 BT_INTEGER, di, GFC_STD_F2008,
2972 gfc_check_shift, gfc_simplify_shiftr, gfc_resolve_shift,
2973 i, BT_INTEGER, di, REQUIRED,
2974 sh, BT_INTEGER, di, REQUIRED);
2975
2976 make_generic ("shiftr", GFC_ISYM_SHIFTR, GFC_STD_F2008);
2977
e1633d82 2978 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2979 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2980 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
6de9cd9a 2981
e1633d82 2982 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2983 NULL, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2984 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
6de9cd9a 2985
e1633d82 2986 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2987 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2988 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
6de9cd9a 2989
b7892582 2990 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
6de9cd9a 2991
e6c14898
DK
2992 add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2993 di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
89560a3c 2994 num, BT_INTEGER, di, REQUIRED, han, BT_VOID, 0, REQUIRED);
185d7d97
FXC
2995
2996 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2997
e1633d82 2998 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2999 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
1270d633 3000 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3001
e1633d82 3002 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3003 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
1270d633 3004 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3005
e1633d82 3006 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 3007 NULL, gfc_simplify_sin, gfc_resolve_sin,
1270d633 3008 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 3009
e1633d82 3010 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK
3011 NULL, gfc_simplify_sin, gfc_resolve_sin,
3012 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 3013
19060788 3014 make_alias ("cdsin", GFC_STD_GNU);
6de9cd9a 3015
b7892582 3016 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
6de9cd9a 3017
e1633d82 3018 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 3019 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 3020 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3021
e1633d82 3022 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3023 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 3024 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3025
b7892582 3026 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
6de9cd9a 3027
5cda5098
FXC
3028 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
3029 BT_INTEGER, di, GFC_STD_F95,
3030 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
3031 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3032 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3033
b7892582 3034 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
6de9cd9a 3035
0881224e 3036 /* Obtain the stride for a given dimensions; to be used only internally.
8a8d1a16 3037 "make_from_module" makes it inaccessible for external users. */
0881224e
TB
3038 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
3039 BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
3040 NULL, NULL, gfc_resolve_stride,
3041 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
3042 make_from_module();
3043
69c3654c
TB
3044 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
3045 BT_INTEGER, ii, GFC_STD_GNU,
3046 gfc_check_sizeof, gfc_simplify_sizeof, NULL,
8d82b242 3047 x, BT_UNKNOWN, 0, REQUIRED);
fd2157ce 3048
cd5ecab6 3049 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
d000aa67 3050
cadddfdd
TB
3051 /* The following functions are part of ISO_C_BINDING. */
3052 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
3053 BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
8a92685e
SK
3054 c_ptr_1, BT_VOID, 0, REQUIRED,
3055 c_ptr_2, BT_VOID, 0, OPTIONAL);
cadddfdd
TB
3056 make_from_module();
3057
3058 add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
3059 BT_VOID, 0, GFC_STD_F2003,
3060 gfc_check_c_loc, NULL, gfc_resolve_c_loc,
3061 x, BT_UNKNOWN, 0, REQUIRED);
3062 make_from_module();
3063
3064 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC, CLASS_INQUIRY, ACTUAL_NO,
3065 BT_VOID, 0, GFC_STD_F2003,
3066 gfc_check_c_funloc, NULL, gfc_resolve_c_funloc,
3067 x, BT_UNKNOWN, 0, REQUIRED);
3068 make_from_module();
3069
048510c8 3070 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
cadddfdd 3071 BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008,
1a8c1e35 3072 gfc_check_c_sizeof, gfc_simplify_sizeof, NULL,
048510c8 3073 x, BT_UNKNOWN, 0, REQUIRED);
d000aa67
TB
3074 make_from_module();
3075
f8862a1b 3076 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
41804a5b
TB
3077 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
3078 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
d000aa67
TB
3079 NULL, gfc_simplify_compiler_options, NULL);
3080 make_from_module();
3081
41804a5b
TB
3082 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_INQUIRY,
3083 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
d000aa67
TB
3084 NULL, gfc_simplify_compiler_version, NULL);
3085 make_from_module();
fd2157ce 3086
1b314f14
SK
3087 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
3088 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_spacing, gfc_resolve_spacing,
1270d633 3089 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3090
b7892582 3091 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
6de9cd9a 3092
e1633d82 3093 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
c430a6f9 3094 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
1270d633 3095 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
0881653c 3096 ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 3097
b7892582 3098 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
6de9cd9a 3099
e1633d82 3100 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 3101 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 3102 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3103
e1633d82 3104 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3105 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 3106 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3107
e1633d82 3108 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 3109 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 3110 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 3111
e1633d82 3112 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK
3113 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
3114 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 3115
19060788 3116 make_alias ("cdsqrt", GFC_STD_GNU);
6de9cd9a 3117
b7892582 3118 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
6de9cd9a 3119
1a14a58c
TB
3120 add_sym_2_intent ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO,
3121 BT_INTEGER, di, GFC_STD_GNU,
3122 gfc_check_stat, NULL, gfc_resolve_stat,
3123 nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3124 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
df65f093
SK
3125
3126 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
3127
ef78bc3c 3128 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
286f737c 3129 ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2018,
ef78bc3c
AV
3130 gfc_check_failed_or_stopped_images,
3131 gfc_simplify_failed_or_stopped_images,
f8862a1b
DR
3132 gfc_resolve_stopped_images, team, BT_VOID, di, OPTIONAL,
3133 kind, BT_INTEGER, di, OPTIONAL);
ef78bc3c 3134
048510c8
JW
3135 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
3136 BT_INTEGER, di, GFC_STD_F2008,
1a8c1e35
TB
3137 gfc_check_storage_size, gfc_simplify_storage_size,
3138 gfc_resolve_storage_size,
048510c8
JW
3139 a, BT_UNKNOWN, 0, REQUIRED,
3140 kind, BT_INTEGER, di, OPTIONAL);
f8862a1b 3141
e1633d82 3142 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a16d978f 3143 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
1270d633
SK
3144 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3145 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 3146
b7892582 3147 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
6de9cd9a 3148
e6c14898 3149 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC
3150 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
3151 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
3152
3153 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
3154
e6c14898 3155 add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC
3156 GFC_STD_GNU, NULL, NULL, NULL,
3157 com, BT_CHARACTER, dc, REQUIRED);
1270d633 3158
b7892582 3159 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
5b1374e9 3160
e1633d82 3161 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 3162 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
1270d633 3163 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3164
e1633d82 3165 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3166 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
1270d633 3167 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3168
b7892582 3169 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
6de9cd9a 3170
e1633d82 3171 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 3172 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 3173 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3174
e1633d82 3175 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3176 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 3177 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3178
b7892582 3179 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
6de9cd9a 3180
f8862a1b 3181 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER, CLASS_TRANSFORMATIONAL,
647340c9 3182 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2018,
f8862a1b
DR
3183 gfc_check_team_number, NULL, gfc_resolve_team_number,
3184 team, BT_DERIVED, di, OPTIONAL);
3185
05fc16dd 3186 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
0d6d8e00 3187 gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
05fc16dd
TB
3188 ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL,
3189 dist, BT_INTEGER, di, OPTIONAL);
64f002ed 3190
e6c14898
DK
3191 add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3192 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
f77b6ca3
FXC
3193
3194 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
3195
e6c14898
DK
3196 add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3197 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
f77b6ca3
FXC
3198
3199 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
3200
e1633d82 3201 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1b314f14 3202 gfc_check_fn_r, gfc_simplify_tiny, NULL, x, BT_REAL, dr, REQUIRED);
6de9cd9a 3203
cd5ecab6 3204 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
6de9cd9a 3205
414f00e9
SB
3206 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
3207 BT_INTEGER, di, GFC_STD_F2008,
3208 gfc_check_i, gfc_simplify_trailz, NULL,
3209 i, BT_INTEGER, di, REQUIRED);
3210
3211 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
3212
e1633d82 3213 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a4a11197 3214 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
1270d633
SK
3215 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
3216 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3217
b7892582 3218 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
6de9cd9a 3219
e1633d82 3220 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8ec259c1 3221 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
1270d633 3222 m, BT_REAL, dr, REQUIRED);
6de9cd9a 3223
b7892582 3224 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
6de9cd9a 3225
e1633d82 3226 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 3227 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
1270d633 3228 stg, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 3229
b7892582 3230 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
6de9cd9a 3231
e6c14898
DK
3232 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
3233 0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
b251af97 3234 ut, BT_INTEGER, di, REQUIRED);
25fc05eb
FXC
3235
3236 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
3237
5cda5098
FXC
3238 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
3239 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 3240 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
5cda5098
FXC
3241 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3242 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3243
b7892582 3244 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
6de9cd9a 3245
64f002ed 3246 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
e6c14898
DK
3247 BT_INTEGER, di, GFC_STD_F2008,
3248 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
3249 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3250 kind, BT_INTEGER, di, OPTIONAL);
64f002ed 3251
0d6d8e00 3252 make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
64f002ed 3253
d8fe26b2 3254 /* g77 compatibility for UMASK. */
e6c14898 3255 add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC
3256 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
3257 msk, BT_INTEGER, di, REQUIRED);
d8fe26b2
SK
3258
3259 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
3260
3261 /* g77 compatibility for UNLINK. */
e6c14898
DK
3262 add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3263 di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
2f8cce28 3264 "path", BT_CHARACTER, dc, REQUIRED);
d8fe26b2
SK
3265
3266 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
3267
e1633d82 3268 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
c430a6f9 3269 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
1270d633
SK
3270 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
3271 f, BT_REAL, dr, REQUIRED);
6de9cd9a 3272
b7892582 3273 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
6de9cd9a 3274
5cda5098
FXC
3275 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
3276 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 3277 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
1270d633 3278 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 3279 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3280
b7892582 3281 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
f8862a1b 3282
e6c14898 3283 add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2f8cce28
FXC
3284 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
3285 x, BT_UNKNOWN, 0, REQUIRED);
f8862a1b 3286
83d890b9 3287 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
8a8d1a16 3288
8e8c2744 3289
57391dda
FR
3290 /* The next of intrinsic subprogram are the degree trignometric functions.
3291 These were hidden behind the -fdec-math option, but are now simply
3292 included as extensions to the set of intrinsic subprograms. */
8e8c2744 3293
57391dda
FR
3294 add_sym_1 ("acosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
3295 BT_REAL, dr, GFC_STD_GNU,
3296 gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trigd,
3297 x, BT_REAL, dr, REQUIRED);
8e8c2744 3298
57391dda
FR
3299 add_sym_1 ("dacosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
3300 BT_REAL, dd, GFC_STD_GNU,
3301 gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trigd,
3302 x, BT_REAL, dd, REQUIRED);
8e8c2744 3303
57391dda 3304 make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_GNU);
8e8c2744 3305
57391dda
FR
3306 add_sym_1 ("asind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
3307 BT_REAL, dr, GFC_STD_GNU,
3308 gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trigd,
3309 x, BT_REAL, dr, REQUIRED);
8e8c2744 3310
57391dda
FR
3311 add_sym_1 ("dasind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
3312 BT_REAL, dd, GFC_STD_GNU,
3313 gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trigd,
3314 x, BT_REAL, dd, REQUIRED);
8e8c2744 3315
57391dda 3316 make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_GNU);
8e8c2744 3317
57391dda
FR
3318 add_sym_1 ("atand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
3319 BT_REAL, dr, GFC_STD_GNU,
3320 gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd,
3321 x, BT_REAL, dr, REQUIRED);
8e8c2744 3322
57391dda
FR
3323 add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
3324 BT_REAL, dd, GFC_STD_GNU,
3325 gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trigd,
3326 x, BT_REAL, dd, REQUIRED);
8e8c2744 3327
57391dda 3328 make_generic ("atand", GFC_ISYM_ATAND, GFC_STD_GNU);
8e8c2744 3329
57391dda
FR
3330 add_sym_2 ("atan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
3331 BT_REAL, dr, GFC_STD_GNU,
3332 gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
3333 y, BT_REAL, dr, REQUIRED,
3334 x, BT_REAL, dr, REQUIRED);
8e8c2744 3335
57391dda
FR
3336 add_sym_2 ("datan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
3337 BT_REAL, dd, GFC_STD_GNU,
3338 gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
3339 y, BT_REAL, dd, REQUIRED,
3340 x, BT_REAL, dd, REQUIRED);
8e8c2744 3341
57391dda 3342 make_generic ("atan2d", GFC_ISYM_ATAN2D, GFC_STD_GNU);
8e8c2744 3343
57391dda
FR
3344 add_sym_1 ("cosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
3345 BT_REAL, dr, GFC_STD_GNU,
3346 gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trigd,
3347 x, BT_REAL, dr, REQUIRED);
8e8c2744 3348
57391dda
FR
3349 add_sym_1 ("dcosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
3350 BT_REAL, dd, GFC_STD_GNU,
3351 gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trigd,
3352 x, BT_REAL, dd, REQUIRED);
8e8c2744 3353
57391dda 3354 make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_GNU);
8e8c2744 3355
57391dda
FR
3356 add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3357 BT_REAL, dr, GFC_STD_GNU,
3358 gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trigd,
3359 x, BT_REAL, dr, REQUIRED);
8e8c2744 3360
57391dda
FR
3361 add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3362 BT_REAL, dd, GFC_STD_GNU,
3363 gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_trigd,
3364 x, BT_REAL, dd, REQUIRED);
8e8c2744 3365
57391dda
FR
3366 add_sym_1 ("ccotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3367 BT_COMPLEX, dz, GFC_STD_GNU,
3368 NULL, gfc_simplify_cotan, gfc_resolve_trigd,
3369 x, BT_COMPLEX, dz, REQUIRED);
8e8c2744 3370
57391dda
FR
3371 add_sym_1 ("zcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
3372 BT_COMPLEX, dd, GFC_STD_GNU,
3373 NULL, gfc_simplify_cotan, gfc_resolve_trigd,
3374 x, BT_COMPLEX, dd, REQUIRED);
8e8c2744 3375
57391dda 3376 make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU);
8e8c2744 3377
57391dda
FR
3378 add_sym_1 ("cotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
3379 BT_REAL, dr, GFC_STD_GNU,
3380 gfc_check_fn_r, gfc_simplify_cotand, gfc_resolve_trigd,
3381 x, BT_REAL, dr, REQUIRED);
8e8c2744 3382
57391dda
FR
3383 add_sym_1 ("dcotand", GFC_ISYM_COTAND, CLASS_ELEMENTAL, ACTUAL_YES,
3384 BT_REAL, dd, GFC_STD_GNU,
3385 gfc_check_fn_d, gfc_simplify_cotand, gfc_resolve_trigd,
3386 x, BT_REAL, dd, REQUIRED);
8e8c2744 3387
57391dda 3388 make_generic ("cotand", GFC_ISYM_COTAND, GFC_STD_GNU);
8e8c2744 3389
57391dda
FR
3390 add_sym_1 ("sind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
3391 BT_REAL, dr, GFC_STD_GNU,
3392 gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trigd,
3393 x, BT_REAL, dr, REQUIRED);
3394
3395 add_sym_1 ("dsind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
3396 BT_REAL, dd, GFC_STD_GNU,
3397 gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trigd,
3398 x, BT_REAL, dd, REQUIRED);
3399
3400 make_generic ("sind", GFC_ISYM_SIND, GFC_STD_GNU);
3401
3402 add_sym_1 ("tand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
3403 BT_REAL, dr, GFC_STD_GNU,
3404 gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trigd,
3405 x, BT_REAL, dr, REQUIRED);
3406
3407 add_sym_1 ("dtand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
3408 BT_REAL, dd, GFC_STD_GNU,
3409 gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trigd,
3410 x, BT_REAL, dd, REQUIRED);
3411
3412 make_generic ("tand", GFC_ISYM_TAND, GFC_STD_GNU);
8e8c2744 3413
8a8d1a16
TB
3414 /* The following function is internally used for coarray libray functions.
3415 "make_from_module" makes it inaccessible for external users. */
3416 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
3417 BT_REAL, dr, GFC_STD_GNU, NULL, NULL, NULL,
3418 x, BT_REAL, dr, REQUIRED);
3419 make_from_module();
6de9cd9a
DN
3420}
3421
3422
6de9cd9a
DN
3423/* Add intrinsic subroutines. */
3424
3425static void
3426add_subroutines (void)
3427{
fbe1f017
SK
3428 /* Argument names. These are used as argument keywords and so need to
3429 match the documentation. Please keep this list in sorted order. */
3430 static const char
d0e7833b 3431 *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command",
fbe1f017
SK
3432 *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
3433 *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
3434 *length = "length", *ln = "len", *md = "mode", *msk = "mask",
3435 *name = "name", *num = "number", *of = "offset", *old = "old",
3436 *p1 = "path1", *p2 = "path2", *pid = "pid", *pos = "pos",
3437 *pt = "put", *ptr = "ptr", *res = "result",
3438 *result_image = "result_image", *sec = "seconds", *sig = "sig",
3439 *st = "status", *stat = "stat", *sz = "size", *t = "to",
3440 *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
3441 *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
a5fbc2f3 3442
0d519038 3443 int di, dr, dc, dl, ii;
6de9cd9a 3444
9d64df18
TS
3445 di = gfc_default_integer_kind;
3446 dr = gfc_default_real_kind;
3447 dc = gfc_default_character_kind;
3448 dl = gfc_default_logical_kind;
0d519038 3449 ii = gfc_index_integer_kind;
6de9cd9a 3450
cd5ecab6 3451 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
6de9cd9a 3452
3f2286f2 3453 make_noreturn();
fe58e076 3454
7f4aaf91 3455 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
da661a58
TB
3456 BT_UNKNOWN, 0, GFC_STD_F2008,
3457 gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
3458 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
7f4aaf91
TB
3459 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3460 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
da661a58 3461
7f4aaf91 3462 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
da661a58
TB
3463 BT_UNKNOWN, 0, GFC_STD_F2008,
3464 gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
3465 "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
7f4aaf91
TB
3466 "atom", BT_INTEGER, di, REQUIRED, INTENT_IN,
3467 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3468
3469 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS, CLASS_ATOMIC,
286f737c 3470 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3471 gfc_check_atomic_cas, NULL, NULL,
3472 "atom", BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3473 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3474 "compare", BT_INTEGER, di, REQUIRED, INTENT_IN,
3475 "new", BT_INTEGER, di, REQUIRED, INTENT_IN,
3476 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3477
3478 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD, CLASS_ATOMIC,
286f737c 3479 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3480 gfc_check_atomic_op, NULL, NULL,
3481 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3482 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3483 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3484
3485 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND, CLASS_ATOMIC,
286f737c 3486 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3487 gfc_check_atomic_op, NULL, NULL,
3488 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3489 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3490 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3491
3492 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR, CLASS_ATOMIC,
286f737c 3493 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3494 gfc_check_atomic_op, NULL, NULL,
3495 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3496 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3497 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3498
3499 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR, CLASS_ATOMIC,
286f737c 3500 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3501 gfc_check_atomic_op, NULL, NULL,
3502 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3503 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3504 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3505
3506 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD, CLASS_ATOMIC,
286f737c 3507 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3508 gfc_check_atomic_fetch_op, NULL, NULL,
3509 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3510 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3511 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3512 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3513
3514 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND, CLASS_ATOMIC,
286f737c 3515 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3516 gfc_check_atomic_fetch_op, NULL, NULL,
3517 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3518 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3519 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3520 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3521
3522 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR, CLASS_ATOMIC,
286f737c 3523 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3524 gfc_check_atomic_fetch_op, NULL, NULL,
3525 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3526 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3527 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3528 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3529
3530 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR, CLASS_ATOMIC,
286f737c 3531 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB
3532 gfc_check_atomic_fetch_op, NULL, NULL,
3533 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3534 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3535 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3536 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
da661a58 3537
f0f67c96
JW
3538 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
3539
1a14a58c
TB
3540 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
3541 GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
3542 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
6de9cd9a 3543
5df445a2 3544 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY, CLASS_ATOMIC,
286f737c 3545 BT_UNKNOWN, 0, GFC_STD_F2018,
5df445a2
TB
3546 gfc_check_event_query, NULL, gfc_resolve_event_query,
3547 "event", BT_INTEGER, di, REQUIRED, INTENT_IN,
3548 c, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3549 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3550
f7b529fa 3551 /* More G77 compatibility garbage. */
e6c14898 3552 add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210 3553 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
1a14a58c
TB
3554 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3555 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
12197210 3556
e6c14898 3557 add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210 3558 gfc_check_itime_idate, NULL, gfc_resolve_idate,
1a14a58c 3559 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
12197210 3560
e6c14898 3561 add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210 3562 gfc_check_itime_idate, NULL, gfc_resolve_itime,
1a14a58c 3563 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
35059811 3564
e6c14898 3565 add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a119fc1c 3566 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
1a14a58c
TB
3567 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3568 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
a119fc1c 3569
1a14a58c
TB
3570 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN, 0,
3571 GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
3572 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3573 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
a119fc1c 3574
e6c14898
DK
3575 add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
3576 GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
1a14a58c 3577 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2bd74949 3578
e6c14898 3579 add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3580 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
1a14a58c
TB
3581 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3582 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3583
e6c14898 3584 add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3585 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
1a14a58c
TB
3586 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3587 md, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3588 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
a119fc1c 3589
e6c14898
DK
3590 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
3591 0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
23e38561
JW
3592 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3593 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3594 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3595 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 3596
f7b529fa 3597 /* More G77 compatibility garbage. */
e6c14898 3598 add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 3599 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
1a14a58c
TB
3600 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
3601 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
2bd74949 3602
e6c14898 3603 add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 3604 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
1a14a58c
TB
3605 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
3606 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
2bd74949 3607
c14c8155
FXC
3608 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
3609 CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
3610 NULL, NULL, gfc_resolve_execute_command_line,
3611 "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3612 "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
3613 "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
3614 "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3615 "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3616
e6c14898 3617 add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3618 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
1a14a58c 3619 dt, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
35059811 3620
e6c14898
DK
3621 add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
3622 0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
1a14a58c 3623 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
f77b6ca3 3624
e6c14898
DK
3625 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
3626 GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
1a14a58c
TB
3627 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3628 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
a8c60d7f 3629
e6c14898
DK
3630 add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
3631 0, GFC_STD_GNU, NULL, NULL, NULL,
1a14a58c
TB
3632 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3633 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
aa6fc635 3634
e6c14898
DK
3635 add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
3636 0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
1a14a58c
TB
3637 pos, BT_INTEGER, di, REQUIRED, INTENT_IN,
3638 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
a8c60d7f 3639
e6c14898
DK
3640 add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
3641 0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
1a14a58c 3642 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
f77b6ca3 3643
b41b2534
JB
3644 /* F2003 commandline routines. */
3645
1a14a58c
TB
3646 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
3647 BT_UNKNOWN, 0, GFC_STD_F2003,
3648 NULL, NULL, gfc_resolve_get_command,
3649 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3650 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3651 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
60c9a35b 3652
e6c14898
DK
3653 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
3654 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
23e38561
JW
3655 gfc_resolve_get_command_argument,
3656 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3657 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3658 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3659 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
aa6fc635 3660
f7b529fa 3661 /* F2003 subroutine to get environment variables. */
aa6fc635 3662
23e38561 3663 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
e6c14898 3664 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
b251af97 3665 NULL, NULL, gfc_resolve_get_environment_variable,
23e38561
JW
3666 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3667 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3668 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3669 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3670 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
3671
1a14a58c
TB
3672 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE, BT_UNKNOWN, 0,
3673 GFC_STD_F2003,
3674 gfc_check_move_alloc, NULL, NULL,
3675 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
3676 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
23e38561
JW
3677
3678 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
5e229618 3679 GFC_STD_F95, gfc_check_mvbits, NULL, gfc_resolve_mvbits,
23e38561
JW
3680 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
3681 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
3682 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
3683 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3684 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
3685
c98583e9
FR
3686 if (flag_dec_intrinsic_ints)
3687 {
3688 make_alias ("bmvbits", GFC_STD_GNU);
3689 make_alias ("imvbits", GFC_STD_GNU);
3690 make_alias ("jmvbits", GFC_STD_GNU);
3691 make_alias ("kmvbits", GFC_STD_GNU);
3692 }
3693
ddd3e26e
SK
3694 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE,
3695 BT_UNKNOWN, 0, GFC_STD_F2018,
3696 gfc_check_random_init, NULL, gfc_resolve_random_init,
3697 "repeatable", BT_LOGICAL, dl, REQUIRED, INTENT_IN,
3698 "image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
3699
1a14a58c
TB
3700 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
3701 BT_UNKNOWN, 0, GFC_STD_F95,
3702 gfc_check_random_number, NULL, gfc_resolve_random_number,
3703 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
23e38561 3704
1a14a58c
TB
3705 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
3706 BT_UNKNOWN, 0, GFC_STD_F95,
3707 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
3708 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3709 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3710 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 3711
cadddfdd
TB
3712 /* The following subroutines are part of ISO_C_BINDING. */
3713
3714 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
3715 GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
3716 "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
3717 "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
3718 "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
3719 make_from_module();
3720
3721 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
3722 BT_UNKNOWN, 0, GFC_STD_F2003, gfc_check_c_f_procpointer,
3723 NULL, NULL,
3724 "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
3725 "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
3726 make_from_module();
3727
f1abbf69
TK
3728 /* Internal subroutine for emitting a runtime error. */
3729
3730 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR, CLASS_IMPURE,
3731 BT_UNKNOWN, 0, GFC_STD_GNU,
3732 gfc_check_fe_runtime_error, NULL, gfc_resolve_fe_runtime_error,
3733 "msg", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
3734
3735 make_noreturn ();
3736 make_vararg ();
3737 make_from_module ();
3738
d62cf3df 3739 /* Coarray collectives. */
a16ee379 3740 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST, CLASS_IMPURE,
286f737c 3741 BT_UNKNOWN, 0, GFC_STD_F2018,
a16ee379
TB
3742 gfc_check_co_broadcast, NULL, NULL,
3743 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3744 "source_image", BT_INTEGER, di, REQUIRED, INTENT_IN,
3745 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
f99aba15 3746 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
a16ee379 3747
d62cf3df 3748 add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
286f737c 3749 BT_UNKNOWN, 0, GFC_STD_F2018,
d62cf3df
TB
3750 gfc_check_co_minmax, NULL, NULL,
3751 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3752 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3753 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
f99aba15 3754 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
d62cf3df
TB
3755
3756 add_sym_4s ("co_min", GFC_ISYM_CO_MIN, CLASS_IMPURE,
286f737c 3757 BT_UNKNOWN, 0, GFC_STD_F2018,
d62cf3df
TB
3758 gfc_check_co_minmax, NULL, NULL,
3759 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3760 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3761 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
f99aba15 3762 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
d62cf3df
TB
3763
3764 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM, CLASS_IMPURE,
286f737c 3765 BT_UNKNOWN, 0, GFC_STD_F2018,
d62cf3df
TB
3766 gfc_check_co_sum, NULL, NULL,
3767 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3768 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3769 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
f99aba15 3770 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
d62cf3df 3771
a16ee379 3772 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE, CLASS_IMPURE,
286f737c 3773 BT_UNKNOWN, 0, GFC_STD_F2018,
a16ee379
TB
3774 gfc_check_co_reduce, NULL, NULL,
3775 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
962ff7d2 3776 "operation", BT_INTEGER, di, REQUIRED, INTENT_IN,
a16ee379
TB
3777 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3778 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
f99aba15 3779 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
a16ee379
TB
3780
3781
8a8d1a16
TB
3782 /* The following subroutine is internally used for coarray libray functions.
3783 "make_from_module" makes it inaccessible for external users. */
3784 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
3785 BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL,
3786 "x", BT_REAL, dr, REQUIRED, INTENT_OUT,
3787 "y", BT_REAL, dr, REQUIRED, INTENT_IN);
3788 make_from_module();
3789
3790
f7b529fa 3791 /* More G77 compatibility garbage. */
e6c14898 3792 add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
185d7d97 3793 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
1a14a58c
TB
3794 sec, BT_INTEGER, di, REQUIRED, INTENT_IN,
3795 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3796 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
185d7d97 3797
e6c14898
DK
3798 add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
3799 di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
1a14a58c 3800 "seed", BT_INTEGER, 4, REQUIRED, INTENT_IN);
2bd74949 3801
e6c14898 3802 add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3803 gfc_check_exit, NULL, gfc_resolve_exit,
1a14a58c 3804 st, BT_INTEGER, di, OPTIONAL, INTENT_IN);
d8fe26b2 3805
3f2286f2 3806 make_noreturn();
fe58e076 3807
e6c14898 3808 add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3809 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
1a14a58c 3810 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
d0e7833b 3811 c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
1a14a58c 3812 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3813
e6c14898 3814 add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3815 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
d0e7833b 3816 c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
1a14a58c 3817 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3818
e6c14898 3819 add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 3820 gfc_check_flush, NULL, gfc_resolve_flush,
1a14a58c 3821 ut, BT_INTEGER, di, OPTIONAL, INTENT_IN);
df65f093 3822
e6c14898 3823 add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3824 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
1a14a58c 3825 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
d0e7833b 3826 c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
1a14a58c 3827 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3828
e6c14898 3829 add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3830 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
d0e7833b 3831 c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
1a14a58c 3832 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3833
e6c14898 3834 add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
8b40ca6a 3835 gfc_check_free, NULL, NULL,
1a14a58c 3836 ptr, BT_INTEGER, ii, REQUIRED, INTENT_INOUT);
0d519038 3837
e6c14898
DK
3838 add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3839 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
3840 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
23e38561 3841 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
e6c14898 3842 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
23e38561 3843 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
dcdc26df 3844
e6c14898 3845 add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3846 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
1a14a58c
TB
3847 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3848 of, BT_INTEGER, ii, REQUIRED, INTENT_OUT);
5d723e54 3849
e6c14898
DK
3850 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
3851 GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
1a14a58c
TB
3852 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3853 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3854
1a14a58c 3855 add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
17164de4 3856 gfc_check_kill_sub, NULL, NULL,
fbe1f017
SK
3857 pid, BT_INTEGER, di, REQUIRED, INTENT_IN,
3858 sig, BT_INTEGER, di, REQUIRED, INTENT_IN,
1a14a58c 3859 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3860
e6c14898 3861 add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3862 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
1a14a58c
TB
3863 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3864 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3865 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3866
e6c14898
DK
3867 add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
3868 0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
1a14a58c 3869 "string", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
f77b6ca3 3870
e6c14898
DK
3871 add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
3872 GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
1a14a58c
TB
3873 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3874 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3875 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3876
e6c14898 3877 add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3878 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
1a14a58c 3879 sec, BT_INTEGER, di, REQUIRED, INTENT_IN);
f77b6ca3 3880
e6c14898 3881 add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 3882 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
1a14a58c
TB
3883 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3884 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3885 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
df65f093 3886
e6c14898 3887 add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
bf3fb7e4 3888 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
1a14a58c
TB
3889 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3890 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3891 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
bf3fb7e4 3892
e6c14898 3893 add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 3894 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
1a14a58c
TB
3895 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3896 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3897 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
df65f093 3898
e6c14898
DK
3899 add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
3900 GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
1a14a58c
TB
3901 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3902 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3903 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
185d7d97 3904
e6c14898
DK
3905 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3906 GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
1a14a58c
TB
3907 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3908 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3909 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3910
e6c14898
DK
3911 add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
3912 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
1a14a58c
TB
3913 com, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3914 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5b1374e9 3915
1a14a58c
TB
3916 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
3917 BT_UNKNOWN, 0, GFC_STD_F95,
3918 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
3919 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3920 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3921 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
d8fe26b2 3922
e6c14898
DK
3923 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
3924 GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
1a14a58c
TB
3925 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3926 name, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
ae8b8789 3927
e6c14898 3928 add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3929 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
1a14a58c
TB
3930 msk, BT_INTEGER, di, REQUIRED, INTENT_IN,
3931 old, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
d8fe26b2 3932
e6c14898
DK
3933 add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3934 GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
1a14a58c
TB
3935 "path", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3936 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a
DN
3937}
3938
3939
3940/* Add a function to the list of conversion symbols. */
3941
3942static void
c3a29423 3943add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
6de9cd9a 3944{
6de9cd9a
DN
3945 gfc_typespec from, to;
3946 gfc_intrinsic_sym *sym;
3947
3948 if (sizing == SZ_CONVS)
3949 {
3950 nconv++;
3951 return;
3952 }
3953
3954 gfc_clear_ts (&from);
3955 from.type = from_type;
3956 from.kind = from_kind;
3957
3958 gfc_clear_ts (&to);
3959 to.type = to_type;
3960 to.kind = to_kind;
3961
3962 sym = conversion + nconv;
3963
c3a29423 3964 sym->name = conv_name (&from, &to);
cb9e4f55 3965 sym->lib_name = sym->name;
c3a29423
RS
3966 sym->simplify.cc = gfc_convert_constant;
3967 sym->standard = standard;
6de9cd9a 3968 sym->elemental = 1;
124a8ce6 3969 sym->pure = 1;
e1633d82 3970 sym->conversion = 1;
6de9cd9a 3971 sym->ts = to;
cd5ecab6 3972 sym->id = GFC_ISYM_CONVERSION;
6de9cd9a
DN
3973
3974 nconv++;
3975}
3976
3977
3978/* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3979 functions by looping over the kind tables. */
3980
3981static void
3982add_conversions (void)
3983{
3984 int i, j;
3985
3986 /* Integer-Integer conversions. */
3987 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3988 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
3989 {
3990 if (i == j)
3991 continue;
3992
3993 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3994 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
3995 }
3996
3997 /* Integer-Real/Complex conversions. */
3998 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3999 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
4000 {
4001 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 4002 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
4003
4004 add_conv (BT_REAL, gfc_real_kinds[j].kind,
c3a29423 4005 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN
4006
4007 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 4008 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
4009
4010 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
c3a29423 4011 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN
4012 }
4013
d3642f89
FW
4014 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
4015 {
4016 /* Hollerith-Integer conversions. */
4017 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
4018 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4019 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4020 /* Hollerith-Real conversions. */
4021 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4022 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4023 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4024 /* Hollerith-Complex conversions. */
4025 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4026 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4027 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4028
4029 /* Hollerith-Character conversions. */
4030 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
4031 gfc_default_character_kind, GFC_STD_LEGACY);
4032
4033 /* Hollerith-Logical conversions. */
4034 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
4035 add_conv (BT_HOLLERITH, gfc_default_character_kind,
4036 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
4037 }
4038
6de9cd9a
DN
4039 /* Real/Complex - Real/Complex conversions. */
4040 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4041 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
4042 {
4043 if (i != j)
4044 {
4045 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 4046 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
4047
4048 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 4049 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
4050 }
4051
4052 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 4053 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
4054
4055 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 4056 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
4057 }
4058
4059 /* Logical/Logical kind conversion. */
4060 for (i = 0; gfc_logical_kinds[i].kind; i++)
4061 for (j = 0; gfc_logical_kinds[j].kind; j++)
4062 {
4063 if (i == j)
4064 continue;
4065
4066 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
c3a29423 4067 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
6de9cd9a 4068 }
c3a29423
RS
4069
4070 /* Integer-Logical and Logical-Integer conversions. */
4071 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
4072 for (i=0; gfc_integer_kinds[i].kind; i++)
4073 for (j=0; gfc_logical_kinds[j].kind; j++)
4074 {
4075 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
4076 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
4077 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
4078 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4079 }
2afeb1ca
ME
4080
4081 /* DEC legacy feature allows character conversions similar to Hollerith
4082 conversions - the character data will transferred on a byte by byte
4083 basis. */
4084 if (flag_dec_char_conversions)
4085 {
4086 /* Character-Integer conversions. */
4087 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
4088 add_conv (BT_CHARACTER, gfc_default_character_kind,
4089 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4090 /* Character-Real conversions. */
4091 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4092 add_conv (BT_CHARACTER, gfc_default_character_kind,
4093 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4094 /* Character-Complex conversions. */
4095 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
4096 add_conv (BT_CHARACTER, gfc_default_character_kind,
4097 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
4098 /* Character-Logical conversions. */
4099 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
4100 add_conv (BT_CHARACTER, gfc_default_character_kind,
4101 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
4102 }
6de9cd9a
DN
4103}
4104
4105
d393bbd7
FXC
4106static void
4107add_char_conversions (void)
4108{
4109 int n, i, j;
4110
4111 /* Count possible conversions. */
4112 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
4113 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
4114 if (i != j)
4115 ncharconv++;
4116
4117 /* Allocate memory. */
ece3f663 4118 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
d393bbd7
FXC
4119
4120 /* Add the conversions themselves. */
4121 n = 0;
4122 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
4123 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
4124 {
4125 gfc_typespec from, to;
4126
4127 if (i == j)
4128 continue;
4129
4130 gfc_clear_ts (&from);
4131 from.type = BT_CHARACTER;
4132 from.kind = gfc_character_kinds[i].kind;
4133
4134 gfc_clear_ts (&to);
4135 to.type = BT_CHARACTER;
4136 to.kind = gfc_character_kinds[j].kind;
4137
4138 char_conversions[n].name = conv_name (&from, &to);
4139 char_conversions[n].lib_name = char_conversions[n].name;
4140 char_conversions[n].simplify.cc = gfc_convert_char_constant;
4141 char_conversions[n].standard = GFC_STD_F2003;
4142 char_conversions[n].elemental = 1;
124a8ce6 4143 char_conversions[n].pure = 1;
d393bbd7
FXC
4144 char_conversions[n].conversion = 0;
4145 char_conversions[n].ts = to;
4146 char_conversions[n].id = GFC_ISYM_CONVERSION;
4147
4148 n++;
4149 }
4150}
4151
4152
6de9cd9a
DN
4153/* Initialize the table of intrinsics. */
4154void
4155gfc_intrinsic_init_1 (void)
4156{
6de9cd9a
DN
4157 nargs = nfunc = nsub = nconv = 0;
4158
4159 /* Create a namespace to hold the resolved intrinsic symbols. */
0366dfe9 4160 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
6de9cd9a
DN
4161
4162 sizing = SZ_FUNCS;
4163 add_functions ();
4164 sizing = SZ_SUBS;
4165 add_subroutines ();
4166 sizing = SZ_CONVS;
4167 add_conversions ();
4168
ece3f663
KG
4169 functions = XCNEWVAR (struct gfc_intrinsic_sym,
4170 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
4171 + sizeof (gfc_intrinsic_arg) * nargs);
6de9cd9a
DN
4172
4173 next_sym = functions;
4174 subroutines = functions + nfunc;
4175
ece3f663 4176 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
6de9cd9a
DN
4177
4178 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
4179
4180 sizing = SZ_NOTHING;
4181 nconv = 0;
4182
4183 add_functions ();
4184 add_subroutines ();
4185 add_conversions ();
4186
d393bbd7
FXC
4187 /* Character conversion intrinsics need to be treated separately. */
4188 add_char_conversions ();
6de9cd9a
DN
4189}
4190
4191
4192void
4193gfc_intrinsic_done_1 (void)
4194{
cede9502
JM
4195 free (functions);
4196 free (conversion);
4197 free (char_conversions);
6de9cd9a
DN
4198 gfc_free_namespace (gfc_intrinsic_namespace);
4199}
4200
4201
4202/******** Subroutines to check intrinsic interfaces ***********/
4203
4204/* Given a formal argument list, remove any NULL arguments that may
4205 have been left behind by a sort against some formal argument list. */
4206
4207static void
b251af97 4208remove_nullargs (gfc_actual_arglist **ap)
6de9cd9a
DN
4209{
4210 gfc_actual_arglist *head, *tail, *next;
4211
4212 tail = NULL;
4213
4214 for (head = *ap; head; head = next)
4215 {
4216 next = head->next;
4217
c5bfb045 4218 if (head->expr == NULL && !head->label)
6de9cd9a
DN
4219 {
4220 head->next = NULL;
4221 gfc_free_actual_arglist (head);
4222 }
4223 else
4224 {
4225 if (tail == NULL)
4226 *ap = head;
4227 else
4228 tail->next = head;
4229
4230 tail = head;
4231 tail->next = NULL;
4232 }
4233 }
4234
4235 if (tail == NULL)
4236 *ap = NULL;
4237}
4238
4239
4240/* Given an actual arglist and a formal arglist, sort the actual
4241 arglist so that its arguments are in a one-to-one correspondence
4242 with the format arglist. Arguments that are not present are given
4243 a blank gfc_actual_arglist structure. If something is obviously
4244 wrong (say, a missing required argument) we abort sorting and
524af0d6 4245 return false. */
6de9cd9a 4246
524af0d6 4247static bool
b251af97
SK
4248sort_actual (const char *name, gfc_actual_arglist **ap,
4249 gfc_intrinsic_arg *formal, locus *where)
6de9cd9a 4250{
6de9cd9a
DN
4251 gfc_actual_arglist *actual, *a;
4252 gfc_intrinsic_arg *f;
4253
4254 remove_nullargs (ap);
4255 actual = *ap;
4256
4257 for (f = formal; f; f = f->next)
4258 f->actual = NULL;
4259
4260 f = formal;
4261 a = actual;
4262
4263 if (f == NULL && a == NULL) /* No arguments */
524af0d6 4264 return true;
6de9cd9a 4265
1a392065
SK
4266 /* ALLOCATED has two mutually exclusive keywords, but only one
4267 can be present at time and neither is optional. */
c980510a 4268 if (strcmp (name, "allocated") == 0)
1a392065 4269 {
c980510a 4270 if (!a)
1a392065 4271 {
c980510a
SK
4272 gfc_error ("ALLOCATED intrinsic at %L requires an array or scalar "
4273 "allocatable entity", where);
4274 return false;
1a392065 4275 }
c980510a
SK
4276
4277 if (a->name)
1a392065 4278 {
c980510a
SK
4279 if (strcmp (a->name, "scalar") == 0)
4280 {
4281 if (a->next)
4282 goto whoops;
4283 if (a->expr->rank != 0)
4284 {
4285 gfc_error ("Scalar entity required at %L", &a->expr->where);
4286 return false;
4287 }
4288 return true;
4289 }
4290 else if (strcmp (a->name, "array") == 0)
1a392065 4291 {
c980510a
SK
4292 if (a->next)
4293 goto whoops;
4294 if (a->expr->rank == 0)
4295 {
4296 gfc_error ("Array entity required at %L", &a->expr->where);
4297 return false;
4298 }
4299 return true;
4300 }
4301 else
4302 {
4303 gfc_error ("Invalid keyword %qs in %qs intrinsic function at %L",
4304 a->name, name, &a->expr->where);
1a392065
SK
4305 return false;
4306 }
1a392065
SK
4307 }
4308 }
4309
6de9cd9a 4310 for (;;)
b251af97 4311 { /* Put the nonkeyword arguments in a 1:1 correspondence */
6de9cd9a
DN
4312 if (f == NULL)
4313 break;
4314 if (a == NULL)
4315 goto optional;
4316
cb9e4f55 4317 if (a->name != NULL)
6de9cd9a
DN
4318 goto keywords;
4319
4320 f->actual = a;
4321
4322 f = f->next;
4323 a = a->next;
4324 }
4325
4326 if (a == NULL)
4327 goto do_sort;
4328
1a392065 4329whoops:
c4100eae 4330 gfc_error ("Too many arguments in call to %qs at %L", name, where);
524af0d6 4331 return false;
6de9cd9a
DN
4332
4333keywords:
4334 /* Associate the remaining actual arguments, all of which have
4335 to be keyword arguments. */
4336 for (; a; a = a->next)
4337 {
4338 for (f = formal; f; f = f->next)
4339 if (strcmp (a->name, f->name) == 0)
4340 break;
4341
4342 if (f == NULL)
4343 {
7fcafa71 4344 if (a->name[0] == '%')
29ea08da
TB
4345 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4346 "are not allowed in this context at %L", where);
7fcafa71 4347 else
1fe61adf 4348 gfc_error ("Cannot find keyword named %qs in call to %qs at %L",
b251af97 4349 a->name, name, where);
524af0d6 4350 return false;
6de9cd9a
DN
4351 }
4352
4353 if (f->actual != NULL)
4354 {
c4100eae 4355 gfc_error ("Argument %qs appears twice in call to %qs at %L",
6de9cd9a 4356 f->name, name, where);
524af0d6 4357 return false;
6de9cd9a
DN
4358 }
4359
4360 f->actual = a;
4361 }
4362
4363optional:
4364 /* At this point, all unmatched formal args must be optional. */
4365 for (f = formal; f; f = f->next)
4366 {
4367 if (f->actual == NULL && f->optional == 0)
4368 {
c4100eae 4369 gfc_error ("Missing actual argument %qs in call to %qs at %L",
6de9cd9a 4370 f->name, name, where);
524af0d6 4371 return false;
6de9cd9a
DN
4372 }
4373 }
4374
4375do_sort:
4376 /* Using the formal argument list, string the actual argument list
4377 together in a way that corresponds with the formal list. */
4378 actual = NULL;
4379
4380 for (f = formal; f; f = f->next)
4381 {
c5bfb045
PT
4382 if (f->actual && f->actual->label != NULL && f->ts.type)
4383 {
4384 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
524af0d6 4385 return false;
c5bfb045
PT
4386 }
4387
f9fed73b
TS
4388 if (f->actual == NULL)
4389 {
4390 a = gfc_get_actual_arglist ();
4391 a->missing_arg_type = f->ts.type;
4392 }
4393 else
4394 a = f->actual;
6de9cd9a
DN
4395
4396 if (actual == NULL)
4397 *ap = a;
4398 else
4399 actual->next = a;
4400
4401 actual = a;
4402 }
f7b529fa 4403 actual->next = NULL; /* End the sorted argument list. */
6de9cd9a 4404
524af0d6 4405 return true;
6de9cd9a
DN
4406}
4407
4408
4409/* Compare an actual argument list with an intrinsic's formal argument
4410 list. The lists are checked for agreement of type. We don't check
4411 for arrayness here. */
4412
524af0d6 4413static bool
b251af97 4414check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
6de9cd9a
DN
4415 int error_flag)
4416{
4417 gfc_actual_arglist *actual;
4418 gfc_intrinsic_arg *formal;
4419 int i;
4420
4421 formal = sym->formal;
4422 actual = *ap;
4423
4424 i = 0;
4425 for (; formal; formal = formal->next, actual = actual->next, i++)
4426 {
d393bbd7
FXC
4427 gfc_typespec ts;
4428
6de9cd9a
DN
4429 if (actual->expr == NULL)
4430 continue;
4431
d393bbd7
FXC
4432 ts = formal->ts;
4433
4434 /* A kind of 0 means we don't check for kind. */
4435 if (ts.kind == 0)
4436 ts.kind = actual->expr->ts.kind;
4437
4438 if (!gfc_compare_types (&ts, &actual->expr->ts))
6de9cd9a
DN
4439 {
4440 if (error_flag)
f61e54e5
ME
4441 gfc_error ("In call to %qs at %L, type mismatch in argument "
4442 "%qs; pass %qs to %qs", gfc_current_intrinsic,
4443 &actual->expr->where,
4444 gfc_current_intrinsic_arg[i]->name,
4445 gfc_typename (actual->expr),
4446 gfc_dummy_typename (&formal->ts));
524af0d6 4447 return false;
6de9cd9a 4448 }
8c91ab34 4449
7fd614ee
HA
4450 /* F2018, p. 328: An argument to an intrinsic procedure other than
4451 ASSOCIATED, NULL, or PRESENT shall be a data object. An EXPR_NULL
4452 is not a data object. */
4453 if (actual->expr->expr_type == EXPR_NULL
4454 && (!(sym->id == GFC_ISYM_ASSOCIATED
4455 || sym->id == GFC_ISYM_NULL
4456 || sym->id == GFC_ISYM_PRESENT)))
4457 {
4458 gfc_invalid_null_arg (actual->expr);
4459 return false;
4460 }
4461
8c91ab34
DK
4462 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4463 if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
4464 {
4465 const char* context = (error_flag
4466 ? _("actual argument to INTENT = OUT/INOUT")
4467 : NULL);
4468
4469 /* No pointer arguments for intrinsics. */
524af0d6
JB
4470 if (!gfc_check_vardef_context (actual->expr, false, false, false, context))
4471 return false;
8c91ab34 4472 }
6de9cd9a
DN
4473 }
4474
524af0d6 4475 return true;
6de9cd9a
DN
4476}
4477
4478
4479/* Given a pointer to an intrinsic symbol and an expression node that
4480 represent the function call to that subroutine, figure out the type
4481 of the result. This may involve calling a resolution subroutine. */
4482
4483static void
b251af97 4484resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a 4485{
01ce9e31 4486 gfc_expr *a1, *a2, *a3, *a4, *a5, *a6;
6de9cd9a
DN
4487 gfc_actual_arglist *arg;
4488
4489 if (specific->resolve.f1 == NULL)
4490 {
4491 if (e->value.function.name == NULL)
4492 e->value.function.name = specific->lib_name;
4493
4494 if (e->ts.type == BT_UNKNOWN)
4495 e->ts = specific->ts;
4496 return;
4497 }
4498
4499 arg = e->value.function.actual;
4500
68d62cb2 4501 /* Special case hacks for MIN and MAX. */
6de9cd9a 4502 if (specific->resolve.f1m == gfc_resolve_max
68d62cb2 4503 || specific->resolve.f1m == gfc_resolve_min)
6de9cd9a
DN
4504 {
4505 (*specific->resolve.f1m) (e, arg);
4506 return;
4507 }
4508
4c0c6b9f
SK
4509 if (arg == NULL)
4510 {
4511 (*specific->resolve.f0) (e);
4512 return;
4513 }
4514
6de9cd9a
DN
4515 a1 = arg->expr;
4516 arg = arg->next;
4517
4518 if (arg == NULL)
4519 {
4520 (*specific->resolve.f1) (e, a1);
4521 return;
4522 }
4523
4524 a2 = arg->expr;
4525 arg = arg->next;
4526
4527 if (arg == NULL)
4528 {
4529 (*specific->resolve.f2) (e, a1, a2);
4530 return;
4531 }
4532
4533 a3 = arg->expr;
4534 arg = arg->next;
4535
4536 if (arg == NULL)
4537 {
4538 (*specific->resolve.f3) (e, a1, a2, a3);
4539 return;
4540 }
4541
4542 a4 = arg->expr;
4543 arg = arg->next;
4544
4545 if (arg == NULL)
4546 {
4547 (*specific->resolve.f4) (e, a1, a2, a3, a4);
4548 return;
4549 }
4550
4551 a5 = arg->expr;
4552 arg = arg->next;
4553
4554 if (arg == NULL)
4555 {
4556 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
4557 return;
4558 }
4559
01ce9e31
TK
4560 a6 = arg->expr;
4561 arg = arg->next;
4562
4563 if (arg == NULL)
4564 {
4565 (*specific->resolve.f6) (e, a1, a2, a3, a4, a5, a6);
4566 return;
4567 }
4568
6de9cd9a
DN
4569 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4570}
4571
4572
4573/* Given an intrinsic symbol node and an expression node, call the
4574 simplification function (if there is one), perhaps replacing the
524af0d6
JB
4575 expression with something simpler. We return false on an error
4576 of the simplification, true if the simplification worked, even
6de9cd9a
DN
4577 if nothing has changed in the expression itself. */
4578
524af0d6 4579static bool
b251af97 4580do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a 4581{
01ce9e31 4582 gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
6de9cd9a
DN
4583 gfc_actual_arglist *arg;
4584
4585 /* Max and min require special handling due to the variable number
4586 of args. */
4587 if (specific->simplify.f1 == gfc_simplify_min)
4588 {
4589 result = gfc_simplify_min (e);
4590 goto finish;
4591 }
4592
4593 if (specific->simplify.f1 == gfc_simplify_max)
4594 {
4595 result = gfc_simplify_max (e);
4596 goto finish;
4597 }
4598
4599 if (specific->simplify.f1 == NULL)
4600 {
4601 result = NULL;
4602 goto finish;
4603 }
4604
4605 arg = e->value.function.actual;
4606
4c0c6b9f
SK
4607 if (arg == NULL)
4608 {
4609 result = (*specific->simplify.f0) ();
4610 goto finish;
4611 }
4612
6de9cd9a
DN
4613 a1 = arg->expr;
4614 arg = arg->next;
4615
d393bbd7
FXC
4616 if (specific->simplify.cc == gfc_convert_constant
4617 || specific->simplify.cc == gfc_convert_char_constant)
6de9cd9a 4618 {
d393bbd7 4619 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
6de9cd9a
DN
4620 goto finish;
4621 }
4622
6de9cd9a
DN
4623 if (arg == NULL)
4624 result = (*specific->simplify.f1) (a1);
4625 else
4626 {
4627 a2 = arg->expr;
4628 arg = arg->next;
4629
4630 if (arg == NULL)
4631 result = (*specific->simplify.f2) (a1, a2);
4632 else
4633 {
4634 a3 = arg->expr;
4635 arg = arg->next;
4636
4637 if (arg == NULL)
4638 result = (*specific->simplify.f3) (a1, a2, a3);
4639 else
4640 {
4641 a4 = arg->expr;
4642 arg = arg->next;
4643
4644 if (arg == NULL)
4645 result = (*specific->simplify.f4) (a1, a2, a3, a4);
4646 else
4647 {
4648 a5 = arg->expr;
4649 arg = arg->next;
4650
4651 if (arg == NULL)
4652 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
4653 else
01ce9e31
TK
4654 {
4655 a6 = arg->expr;
4656 arg = arg->next;
4657
4658 if (arg == NULL)
4659 result = (*specific->simplify.f6)
4660 (a1, a2, a3, a4, a5, a6);
4661 else
4662 gfc_internal_error
4663 ("do_simplify(): Too many args for intrinsic");
4664 }
6de9cd9a
DN
4665 }
4666 }
4667 }
4668 }
4669
4670finish:
4671 if (result == &gfc_bad_expr)
524af0d6 4672 return false;
6de9cd9a
DN
4673
4674 if (result == NULL)
4675 resolve_intrinsic (specific, e); /* Must call at run-time */
4676 else
4677 {
4678 result->where = e->where;
4679 gfc_replace_expr (e, result);
4680 }
4681
524af0d6 4682 return true;
6de9cd9a
DN
4683}
4684
4685
4686/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
524af0d6 4687 error messages. This subroutine returns false if a subroutine
6de9cd9a
DN
4688 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4689 list cannot match any intrinsic. */
4690
4691static void
b251af97 4692init_arglist (gfc_intrinsic_sym *isym)
6de9cd9a
DN
4693{
4694 gfc_intrinsic_arg *formal;
4695 int i;
4696
4697 gfc_current_intrinsic = isym->name;
4698
4699 i = 0;
4700 for (formal = isym->formal; formal; formal = formal->next)
4701 {
4702 if (i >= MAX_INTRINSIC_ARGS)
4703 gfc_internal_error ("init_arglist(): too many arguments");
c4aa95f8 4704 gfc_current_intrinsic_arg[i++] = formal;
6de9cd9a
DN
4705 }
4706}
4707
4708
4709/* Given a pointer to an intrinsic symbol and an expression consisting
4710 of a function call, see if the function call is consistent with the
524af0d6
JB
4711 intrinsic's formal argument list. Return true if the expression
4712 and intrinsic match, false otherwise. */
6de9cd9a 4713
524af0d6 4714static bool
b251af97 4715check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
6de9cd9a
DN
4716{
4717 gfc_actual_arglist *arg, **ap;
524af0d6 4718 bool t;
6de9cd9a
DN
4719
4720 ap = &expr->value.function.actual;
4721
4722 init_arglist (specific);
4723
4724 /* Don't attempt to sort the argument list for min or max. */
4725 if (specific->check.f1m == gfc_check_min_max
4726 || specific->check.f1m == gfc_check_min_max_integer
4727 || specific->check.f1m == gfc_check_min_max_real
4728 || specific->check.f1m == gfc_check_min_max_double)
bf7a73f9
TB
4729 {
4730 if (!do_ts29113_check (specific, *ap))
4731 return false;
4732 return (*specific->check.f1m) (*ap);
4733 }
6de9cd9a 4734
524af0d6
JB
4735 if (!sort_actual (specific->name, ap, specific->formal, &expr->where))
4736 return false;
6de9cd9a 4737
bf7a73f9
TB
4738 if (!do_ts29113_check (specific, *ap))
4739 return false;
4740
64b1806b 4741 if (specific->check.f5ml == gfc_check_minloc_maxloc)
b251af97 4742 /* This is special because we might have to reorder the argument list. */
7551270e 4743 t = gfc_check_minloc_maxloc (*ap);
01ce9e31
TK
4744 else if (specific->check.f6fl == gfc_check_findloc)
4745 t = gfc_check_findloc (*ap);
617097a3 4746 else if (specific->check.f3red == gfc_check_minval_maxval)
7551270e
ES
4747 /* This is also special because we also might have to reorder the
4748 argument list. */
617097a3
TS
4749 t = gfc_check_minval_maxval (*ap);
4750 else if (specific->check.f3red == gfc_check_product_sum)
4751 /* Same here. The difference to the previous case is that we allow a
4752 general numeric type. */
4753 t = gfc_check_product_sum (*ap);
195a95c4
TB
4754 else if (specific->check.f3red == gfc_check_transf_bit_intrins)
4755 /* Same as for PRODUCT and SUM, but different checks. */
4756 t = gfc_check_transf_bit_intrins (*ap);
7551270e 4757 else
f3207b37
TS
4758 {
4759 if (specific->check.f1 == NULL)
4760 {
4761 t = check_arglist (ap, specific, error_flag);
524af0d6 4762 if (t)
f3207b37
TS
4763 expr->ts = specific->ts;
4764 }
4765 else
4766 t = do_check (specific, *ap);
4767 }
6de9cd9a 4768
0881653c 4769 /* Check conformance of elemental intrinsics. */
524af0d6 4770 if (t && specific->elemental)
6de9cd9a 4771 {
0881653c
DF
4772 int n = 0;
4773 gfc_expr *first_expr;
4774 arg = expr->value.function.actual;
6de9cd9a 4775
0881653c
DF
4776 /* There is no elemental intrinsic without arguments. */
4777 gcc_assert(arg != NULL);
4778 first_expr = arg->expr;
4779
4780 for ( ; arg && arg->expr; arg = arg->next, n++)
f8862a1b 4781 if (!gfc_check_conformance (first_expr, arg->expr,
0a7183f6
ME
4782 _("arguments '%s' and '%s' for "
4783 "intrinsic '%s'"),
f8862a1b
DR
4784 gfc_current_intrinsic_arg[0]->name,
4785 gfc_current_intrinsic_arg[n]->name,
524af0d6
JB
4786 gfc_current_intrinsic))
4787 return false;
6de9cd9a
DN
4788 }
4789
524af0d6 4790 if (!t)
6de9cd9a
DN
4791 remove_nullargs (ap);
4792
4793 return t;
4794}
4795
4796
b7892582 4797/* Check whether an intrinsic belongs to whatever standard the user
c3005b0f
DK
4798 has chosen, taking also into account -fall-intrinsics. Here, no
4799 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4800 textual representation of the symbols standard status (like
4801 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4802 can be used to construct a detailed warning/error message in case of
524af0d6 4803 a false. */
b7892582 4804
524af0d6 4805bool
c3005b0f
DK
4806gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
4807 const char** symstd, bool silent, locus where)
b7892582 4808{
c3005b0f
DK
4809 const char* symstd_msg;
4810
4811 /* For -fall-intrinsics, just succeed. */
c61819ff 4812 if (flag_all_intrinsics)
524af0d6 4813 return true;
b7892582 4814
c3005b0f
DK
4815 /* Find the symbol's standard message for later usage. */
4816 switch (isym->standard)
4817 {
4818 case GFC_STD_F77:
0a7183f6 4819 symstd_msg = _("available since Fortran 77");
c3005b0f 4820 break;
3f2286f2 4821
c3005b0f 4822 case GFC_STD_F95_OBS:
0a7183f6 4823 symstd_msg = _("obsolescent in Fortran 95");
c3005b0f
DK
4824 break;
4825
4826 case GFC_STD_F95_DEL:
0a7183f6 4827 symstd_msg = _("deleted in Fortran 95");
c3005b0f
DK
4828 break;
4829
4830 case GFC_STD_F95:
0a7183f6 4831 symstd_msg = _("new in Fortran 95");
c3005b0f
DK
4832 break;
4833
4834 case GFC_STD_F2003:
0a7183f6 4835 symstd_msg = _("new in Fortran 2003");
c3005b0f
DK
4836 break;
4837
4838 case GFC_STD_F2008:
0a7183f6 4839 symstd_msg = _("new in Fortran 2008");
c3005b0f
DK
4840 break;
4841
286f737c 4842 case GFC_STD_F2018:
0a7183f6 4843 symstd_msg = _("new in Fortran 2018");
2514987f
TB
4844 break;
4845
c3005b0f 4846 case GFC_STD_GNU:
0a7183f6 4847 symstd_msg = _("a GNU Fortran extension");
c3005b0f
DK
4848 break;
4849
4850 case GFC_STD_LEGACY:
0a7183f6 4851 symstd_msg = _("for backward compatibility");
c3005b0f
DK
4852 break;
4853
4854 default:
17d5d49f 4855 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
c3005b0f
DK
4856 isym->name, isym->standard);
4857 }
4858
4859 /* If warning about the standard, warn and succeed. */
4860 if (gfc_option.warn_std & isym->standard)
4861 {
4862 /* Do only print a warning if not a GNU extension. */
4863 if (!silent && isym->standard != GFC_STD_GNU)
0a7183f6
ME
4864 gfc_warning (0, "Intrinsic %qs (%s) used at %L",
4865 isym->name, symstd_msg, &where);
c3005b0f 4866
524af0d6 4867 return true;
c3005b0f
DK
4868 }
4869
4870 /* If allowing the symbol's standard, succeed, too. */
4871 if (gfc_option.allow_std & isym->standard)
524af0d6 4872 return true;
c3005b0f
DK
4873
4874 /* Otherwise, fail. */
4875 if (symstd)
0a7183f6 4876 *symstd = symstd_msg;
524af0d6 4877 return false;
b7892582
JB
4878}
4879
4880
6de9cd9a
DN
4881/* See if a function call corresponds to an intrinsic function call.
4882 We return:
4883
4884 MATCH_YES if the call corresponds to an intrinsic, simplification
b251af97 4885 is done if possible.
6de9cd9a
DN
4886
4887 MATCH_NO if the call does not correspond to an intrinsic
4888
4889 MATCH_ERROR if the call corresponds to an intrinsic but there was an
b251af97 4890 error during the simplification process.
6de9cd9a
DN
4891
4892 The error_flag parameter enables an error reporting. */
4893
4894match
b251af97 4895gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
6de9cd9a 4896{
394acee4 4897 gfc_symbol *sym;
6de9cd9a
DN
4898 gfc_intrinsic_sym *isym, *specific;
4899 gfc_actual_arglist *actual;
6de9cd9a
DN
4900 int flag;
4901
4902 if (expr->value.function.isym != NULL)
524af0d6 4903 return (!do_simplify(expr->value.function.isym, expr))
b251af97 4904 ? MATCH_ERROR : MATCH_YES;
6de9cd9a 4905
a3d3c0f5
DK
4906 if (!error_flag)
4907 gfc_push_suppress_errors ();
6de9cd9a
DN
4908 flag = 0;
4909
4910 for (actual = expr->value.function.actual; actual; actual = actual->next)
4911 if (actual->expr != NULL)
4912 flag |= (actual->expr->ts.type != BT_INTEGER
4913 && actual->expr->ts.type != BT_CHARACTER);
4914
394acee4 4915 sym = expr->symtree->n.sym;
6de9cd9a 4916
394acee4 4917 if (sym->intmod_sym_id)
d000aa67 4918 {
394acee4 4919 gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
cadddfdd 4920 isym = specific = gfc_intrinsic_function_by_id (id);
d000aa67
TB
4921 }
4922 else
394acee4 4923 isym = specific = gfc_find_function (sym->name);
d000aa67 4924
6de9cd9a
DN
4925 if (isym == NULL)
4926 {
a3d3c0f5
DK
4927 if (!error_flag)
4928 gfc_pop_suppress_errors ();
6de9cd9a
DN
4929 return MATCH_NO;
4930 }
4931
b7970354 4932 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
878f88b7
SK
4933 || isym->id == GFC_ISYM_CMPLX || isym->id == GFC_ISYM_FLOAT
4934 || isym->id == GFC_ISYM_SNGL || isym->id == GFC_ISYM_DFLOAT)
f2cbd86c 4935 && gfc_init_expr_flag
a4d9b221 4936 && !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
394acee4 4937 "expression at %L", sym->name, &expr->where))
a3d3c0f5
DK
4938 {
4939 if (!error_flag)
4940 gfc_pop_suppress_errors ();
4941 return MATCH_ERROR;
4942 }
b7970354 4943
4bb91707
TK
4944 /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
4945 SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
4946 initialization expressions. */
4947
4948 if (gfc_init_expr_flag && isym->transformational)
4949 {
4950 gfc_isym_id id = isym->id;
4951 if (id != GFC_ISYM_REPEAT && id != GFC_ISYM_RESHAPE
4952 && id != GFC_ISYM_SI_KIND && id != GFC_ISYM_SR_KIND
4953 && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
4954 && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
4955 "at %L is invalid in an initialization "
394acee4 4956 "expression", sym->name, &expr->where))
4bb91707
TK
4957 {
4958 if (!error_flag)
4959 gfc_pop_suppress_errors ();
4960
4961 return MATCH_ERROR;
4962 }
4963 }
4964
6de9cd9a
DN
4965 gfc_current_intrinsic_where = &expr->where;
4966
cadddfdd 4967 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
6de9cd9a
DN
4968 if (isym->check.f1m == gfc_check_min_max)
4969 {
4970 init_arglist (isym);
4971
524af0d6 4972 if (isym->check.f1m(expr->value.function.actual))
6de9cd9a
DN
4973 goto got_specific;
4974
a3d3c0f5
DK
4975 if (!error_flag)
4976 gfc_pop_suppress_errors ();
6de9cd9a
DN
4977 return MATCH_NO;
4978 }
4979
4980 /* If the function is generic, check all of its specific
4981 incarnations. If the generic name is also a specific, we check
4982 that name last, so that any error message will correspond to the
4983 specific. */
a3d3c0f5 4984 gfc_push_suppress_errors ();
6de9cd9a
DN
4985
4986 if (isym->generic)
4987 {
4988 for (specific = isym->specific_head; specific;
4989 specific = specific->next)
4990 {
4991 if (specific == isym)
4992 continue;
524af0d6 4993 if (check_specific (specific, expr, 0))
a3d3c0f5
DK
4994 {
4995 gfc_pop_suppress_errors ();
4996 goto got_specific;
4997 }
6de9cd9a
DN
4998 }
4999 }
5000
a3d3c0f5 5001 gfc_pop_suppress_errors ();
6de9cd9a 5002
524af0d6 5003 if (!check_specific (isym, expr, error_flag))
6de9cd9a 5004 {
a3d3c0f5
DK
5005 if (!error_flag)
5006 gfc_pop_suppress_errors ();
6de9cd9a
DN
5007 return MATCH_NO;
5008 }
5009
5010 specific = isym;
5011
5012got_specific:
5013 expr->value.function.isym = specific;
a3d3c0f5
DK
5014 if (!error_flag)
5015 gfc_pop_suppress_errors ();
5016
524af0d6 5017 if (!do_simplify (specific, expr))
14ceeb32 5018 return MATCH_ERROR;
6de9cd9a 5019
e1633d82
DF
5020 /* F95, 7.1.6.1, Initialization expressions
5021 (4) An elemental intrinsic function reference of type integer or
5022 character where each argument is an initialization expression
5023 of type integer or character
5024
5025 F2003, 7.1.7 Initialization expression
5026 (4) A reference to an elemental standard intrinsic function,
5027 where each argument is an initialization expression */
5028
f2cbd86c 5029 if (gfc_init_expr_flag && isym->elemental && flag
524af0d6
JB
5030 && !gfc_notify_std (GFC_STD_F2003, "Elemental function as "
5031 "initialization expression with non-integer/non-"
5032 "character arguments at %L", &expr->where))
e1633d82 5033 return MATCH_ERROR;
6de9cd9a 5034
394acee4
TB
5035 if (sym->attr.flavor == FL_UNKNOWN)
5036 {
5037 sym->attr.function = 1;
5038 sym->attr.intrinsic = 1;
5039 sym->attr.flavor = FL_PROCEDURE;
5040 }
9d45e848
TB
5041 if (sym->attr.flavor == FL_PROCEDURE)
5042 {
5043 sym->attr.function = 1;
5044 sym->attr.proc = PROC_INTRINSIC;
5045 }
394acee4
TB
5046
5047 if (!sym->module)
5048 gfc_intrinsic_symbol (sym);
5049
02629b11
HA
5050 /* Have another stab at simplification since elemental intrinsics with array
5051 actual arguments would be missed by the calls above to do_simplify. */
5052 if (isym->elemental)
5053 gfc_simplify_expr (expr, 1);
5054
6de9cd9a
DN
5055 return MATCH_YES;
5056}
5057
5058
5059/* See if a CALL statement corresponds to an intrinsic subroutine.
5060 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
5061 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
5062 correspond). */
5063
5064match
b251af97 5065gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
6de9cd9a
DN
5066{
5067 gfc_intrinsic_sym *isym;
5068 const char *name;
5069
5070 name = c->symtree->n.sym->name;
5071
cadddfdd
TB
5072 if (c->symtree->n.sym->intmod_sym_id)
5073 {
5074 gfc_isym_id id;
5075 id = gfc_isym_id_by_intmod_sym (c->symtree->n.sym);
5076 isym = gfc_intrinsic_subroutine_by_id (id);
5077 }
5078 else
5079 isym = gfc_find_subroutine (name);
6de9cd9a
DN
5080 if (isym == NULL)
5081 return MATCH_NO;
5082
a3d3c0f5
DK
5083 if (!error_flag)
5084 gfc_push_suppress_errors ();
6de9cd9a
DN
5085
5086 init_arglist (isym);
5087
f1abbf69 5088 if (!isym->vararg && !sort_actual (name, &c->ext.actual, isym->formal, &c->loc))
6de9cd9a
DN
5089 goto fail;
5090
bf7a73f9
TB
5091 if (!do_ts29113_check (isym, c->ext.actual))
5092 goto fail;
5093
6de9cd9a
DN
5094 if (isym->check.f1 != NULL)
5095 {
524af0d6 5096 if (!do_check (isym, c->ext.actual))
6de9cd9a
DN
5097 goto fail;
5098 }
5099 else
5100 {
524af0d6 5101 if (!check_arglist (&c->ext.actual, isym, 1))
6de9cd9a
DN
5102 goto fail;
5103 }
5104
5105 /* The subroutine corresponds to an intrinsic. Allow errors to be
f7b529fa 5106 seen at this point. */
a3d3c0f5
DK
5107 if (!error_flag)
5108 gfc_pop_suppress_errors ();
6de9cd9a 5109
12f681a0 5110 c->resolved_isym = isym;
6de9cd9a
DN
5111 if (isym->resolve.s1 != NULL)
5112 isym->resolve.s1 (c);
5113 else
42a8c358
TB
5114 {
5115 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
5116 c->resolved_sym->attr.elemental = isym->elemental;
5117 }
6de9cd9a 5118
ce96d372
TK
5119 if (gfc_do_concurrent_flag && !isym->pure)
5120 {
c4100eae 5121 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
ce96d372
TK
5122 "block at %L is not PURE", name, &c->loc);
5123 return MATCH_ERROR;
5124 }
5125
ccd7751b 5126 if (!isym->pure && gfc_pure (NULL))
6de9cd9a 5127 {
c4100eae 5128 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name,
6de9cd9a
DN
5129 &c->loc);
5130 return MATCH_ERROR;
5131 }
5132
ccd7751b
TB
5133 if (!isym->pure)
5134 gfc_unset_implicit_pure (NULL);
5135
fe58e076 5136 c->resolved_sym->attr.noreturn = isym->noreturn;
b7892582 5137
6de9cd9a
DN
5138 return MATCH_YES;
5139
5140fail:
a3d3c0f5
DK
5141 if (!error_flag)
5142 gfc_pop_suppress_errors ();
6de9cd9a
DN
5143 return MATCH_NO;
5144}
5145
5146
5147/* Call gfc_convert_type() with warning enabled. */
5148
524af0d6 5149bool
b251af97 5150gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
6de9cd9a
DN
5151{
5152 return gfc_convert_type_warn (expr, ts, eflag, 1);
5153}
5154
5155
5156/* Try to convert an expression (in place) from one type to another.
5157 'eflag' controls the behavior on error.
5158
5159 The possible values are:
5160
5161 1 Generate a gfc_error()
5162 2 Generate a gfc_internal_error().
5163
8405874a
ME
5164 'wflag' controls the warning related to conversion.
5165
5166 'array' indicates whether the conversion is in an array constructor.
5167 Non-standard conversion from character to numeric not allowed if true.
5168*/
6de9cd9a 5169
524af0d6 5170bool
8405874a
ME
5171gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag,
5172 bool array)
6de9cd9a
DN
5173{
5174 gfc_intrinsic_sym *sym;
5175 gfc_typespec from_ts;
5176 locus old_where;
7b901ac4 5177 gfc_expr *new_expr;
6de9cd9a 5178 int rank;
323c74da 5179 mpz_t *shape;
f61e54e5
ME
5180 bool is_char_constant = (expr->expr_type == EXPR_CONSTANT)
5181 && (expr->ts.type == BT_CHARACTER);
6de9cd9a
DN
5182
5183 from_ts = expr->ts; /* expr->ts gets clobbered */
5184
5185 if (ts->type == BT_UNKNOWN)
5186 goto bad;
5187
5197d799
TK
5188 expr->do_not_warn = ! wflag;
5189
d8afd032
TK
5190 /* NULL and zero size arrays get their type here, unless they already have a
5191 typespec. */
5192 if ((expr->expr_type == EXPR_NULL
5193 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
5194 && expr->ts.type == BT_UNKNOWN)
6de9cd9a
DN
5195 {
5196 /* Sometimes the RHS acquire the type. */
5197 expr->ts = *ts;
524af0d6 5198 return true;
6de9cd9a
DN
5199 }
5200
5201 if (expr->ts.type == BT_UNKNOWN)
5202 goto bad;
5203
e9b75848
SK
5204 /* In building an array constructor, gfortran can end up here when no
5205 conversion is required for an intrinsic type. We need to let derived
5206 types drop through. */
017665f6 5207 if (from_ts.type != BT_DERIVED && from_ts.type != BT_CLASS
e9b75848
SK
5208 && (from_ts.type == ts->type && from_ts.kind == ts->kind))
5209 return true;
5210
017665f6
TB
5211 if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
5212 && (ts->type == BT_DERIVED || ts->type == BT_CLASS)
5213 && gfc_compare_types (ts, &expr->ts))
524af0d6 5214 return true;
6de9cd9a 5215
8405874a
ME
5216 /* If array is true then conversion is in an array constructor where
5217 non-standard conversion is not allowed. */
5218 if (array && from_ts.type == BT_CHARACTER
5219 && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
5220 goto bad;
5221
6de9cd9a
DN
5222 sym = find_conv (&expr->ts, ts);
5223 if (sym == NULL)
5224 goto bad;
5225
5226 /* At this point, a conversion is necessary. A warning may be needed. */
c3a29423 5227 if ((gfc_option.warn_std & sym->standard) != 0)
4e42ad66 5228 {
2afeb1ca
ME
5229 const char *type_name = is_char_constant ? gfc_typename (expr)
5230 : gfc_typename (&from_ts);
db30e21c 5231 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
2afeb1ca 5232 type_name, gfc_dummy_typename (ts),
daf8c6f0
DF
5233 &expr->where);
5234 }
5235 else if (wflag)
5236 {
c61819ff 5237 if (flag_range_check && expr->expr_type == EXPR_CONSTANT
33169a22
DF
5238 && from_ts.type == ts->type)
5239 {
5240 /* Do nothing. Constants of the same type are range-checked
5241 elsewhere. If a value too large for the target type is
5242 assigned, an error is generated. Not checking here avoids
5243 duplications of warnings/errors.
5244 If range checking was disabled, but -Wconversion enabled,
5245 a non range checked warning is generated below. */
5246 }
2afeb1ca
ME
5247 else if (flag_dec_char_conversions && from_ts.type == BT_CHARACTER
5248 && (gfc_numeric_ts (ts) || ts->type == BT_LOGICAL))
33169a22 5249 {
2afeb1ca
ME
5250 const char *type_name = is_char_constant ? gfc_typename (expr)
5251 : gfc_typename (&from_ts);
5252 gfc_warning_now (OPT_Wconversion, "Nonstandard conversion from %s "
5253 "to %s at %L", type_name, gfc_typename (ts),
5254 &expr->where);
33169a22
DF
5255 }
5256 else if (from_ts.type == ts->type
5257 || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
5258 || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
5259 || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
5260 {
5261 /* Larger kinds can hold values of smaller kinds without problems.
5262 Hence, only warn if target kind is smaller than the source
6af82847
ME
5263 kind - or if -Wconversion-extra is specified. LOGICAL values
5264 will always fit regardless of kind so ignore conversion. */
5265 if (expr->expr_type != EXPR_CONSTANT
5266 && ts->type != BT_LOGICAL)
cbf560d7
TK
5267 {
5268 if (warn_conversion && from_ts.kind > ts->kind)
5269 gfc_warning_now (OPT_Wconversion, "Possible change of value in "
5270 "conversion from %s to %s at %L",
5271 gfc_typename (&from_ts), gfc_typename (ts),
5272 &expr->where);
2afeb1ca 5273 else
cbf560d7
TK
5274 gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
5275 "at %L", gfc_typename (&from_ts),
5276 gfc_typename (ts), &expr->where);
5277 }
33169a22
DF
5278 }
5279 else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
5280 || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
5281 || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
5282 {
5283 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
5284 usually comes with a loss of information, regardless of kinds. */
2afeb1ca 5285 if (expr->expr_type != EXPR_CONSTANT)
4daa149b
TB
5286 gfc_warning_now (OPT_Wconversion, "Possible change of value in "
5287 "conversion from %s to %s at %L",
5288 gfc_typename (&from_ts), gfc_typename (ts),
5289 &expr->where);
33169a22
DF
5290 }
5291 else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
5292 {
5293 /* If HOLLERITH is involved, all bets are off. */
2afeb1ca
ME
5294 gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
5295 gfc_typename (&from_ts), gfc_dummy_typename (ts),
5296 &expr->where);
5297 }
5298 else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
5299 {
5300 /* Do nothing. This block exists only to simplify the other
5301 else-if expressions.
5302 LOGICAL <> LOGICAL no warning, independent of kind values
5303 LOGICAL <> INTEGER extension, warned elsewhere
5304 LOGICAL <> REAL invalid, error generated elsewhere
5305 LOGICAL <> COMPLEX invalid, error generated elsewhere */
33169a22
DF
5306 }
5307 else
2afeb1ca 5308 gcc_unreachable ();
4e42ad66 5309 }
6de9cd9a
DN
5310
5311 /* Insert a pre-resolved function call to the right function. */
5312 old_where = expr->where;
5313 rank = expr->rank;
323c74da
RH
5314 shape = expr->shape;
5315
7b901ac4
KG
5316 new_expr = gfc_get_expr ();
5317 *new_expr = *expr;
5318
5319 new_expr = gfc_build_conversion (new_expr);
5320 new_expr->value.function.name = sym->lib_name;
5321 new_expr->value.function.isym = sym;
5322 new_expr->where = old_where;
aa7cfe40 5323 new_expr->ts = *ts;
7b901ac4
KG
5324 new_expr->rank = rank;
5325 new_expr->shape = gfc_copy_shape (shape, rank);
5326
5327 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4b41f35e 5328 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
aa7cfe40
JW
5329 new_expr->symtree->n.sym->ts.type = ts->type;
5330 new_expr->symtree->n.sym->ts.kind = ts->kind;
7b901ac4
KG
5331 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
5332 new_expr->symtree->n.sym->attr.function = 1;
5333 new_expr->symtree->n.sym->attr.elemental = 1;
5334 new_expr->symtree->n.sym->attr.pure = 1;
5335 new_expr->symtree->n.sym->attr.referenced = 1;
5336 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
5337 gfc_commit_symbol (new_expr->symtree->n.sym);
5338
5339 *expr = *new_expr;
5340
cede9502 5341 free (new_expr);
6de9cd9a
DN
5342 expr->ts = *ts;
5343
5344 if (gfc_is_constant_expr (expr->value.function.actual->expr)
524af0d6 5345 && !do_simplify (sym, expr))
6de9cd9a
DN
5346 {
5347
5348 if (eflag == 2)
5349 goto bad;
524af0d6 5350 return false; /* Error already generated in do_simplify() */
6de9cd9a
DN
5351 }
5352
524af0d6 5353 return true;
6de9cd9a
DN
5354
5355bad:
f61e54e5
ME
5356 const char *type_name = is_char_constant ? gfc_typename (expr)
5357 : gfc_typename (&from_ts);
6de9cd9a
DN
5358 if (eflag == 1)
5359 {
f61e54e5
ME
5360 gfc_error ("Cannot convert %s to %s at %L", type_name, gfc_typename (ts),
5361 &expr->where);
524af0d6 5362 return false;
6de9cd9a
DN
5363 }
5364
f61e54e5 5365 gfc_internal_error ("Cannot convert %qs to %qs at %L", type_name,
2afeb1ca 5366 gfc_typename (ts), &expr->where);
6de9cd9a
DN
5367 /* Not reached */
5368}
d393bbd7
FXC
5369
5370
524af0d6 5371bool
d393bbd7
FXC
5372gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
5373{
5374 gfc_intrinsic_sym *sym;
d393bbd7 5375 locus old_where;
7b901ac4 5376 gfc_expr *new_expr;
d393bbd7
FXC
5377 int rank;
5378 mpz_t *shape;
5379
5380 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
d393bbd7
FXC
5381
5382 sym = find_char_conv (&expr->ts, ts);
5383 gcc_assert (sym);
5384
5385 /* Insert a pre-resolved function call to the right function. */
5386 old_where = expr->where;
5387 rank = expr->rank;
5388 shape = expr->shape;
5389
7b901ac4
KG
5390 new_expr = gfc_get_expr ();
5391 *new_expr = *expr;
d393bbd7 5392
7b901ac4
KG
5393 new_expr = gfc_build_conversion (new_expr);
5394 new_expr->value.function.name = sym->lib_name;
5395 new_expr->value.function.isym = sym;
5396 new_expr->where = old_where;
aa7cfe40 5397 new_expr->ts = *ts;
7b901ac4
KG
5398 new_expr->rank = rank;
5399 new_expr->shape = gfc_copy_shape (shape, rank);
d393bbd7 5400
7b901ac4 5401 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
aa7cfe40
JW
5402 new_expr->symtree->n.sym->ts.type = ts->type;
5403 new_expr->symtree->n.sym->ts.kind = ts->kind;
7b901ac4
KG
5404 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
5405 new_expr->symtree->n.sym->attr.function = 1;
5406 new_expr->symtree->n.sym->attr.elemental = 1;
5407 new_expr->symtree->n.sym->attr.referenced = 1;
5408 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
5409 gfc_commit_symbol (new_expr->symtree->n.sym);
d393bbd7 5410
7b901ac4 5411 *expr = *new_expr;
d393bbd7 5412
cede9502 5413 free (new_expr);
d393bbd7
FXC
5414 expr->ts = *ts;
5415
5416 if (gfc_is_constant_expr (expr->value.function.actual->expr)
524af0d6 5417 && !do_simplify (sym, expr))
d393bbd7
FXC
5418 {
5419 /* Error already generated in do_simplify() */
524af0d6 5420 return false;
d393bbd7
FXC
5421 }
5422
524af0d6 5423 return true;
d393bbd7 5424}
c3005b0f
DK
5425
5426
5427/* Check if the passed name is name of an intrinsic (taking into account the
5428 current -std=* and -fall-intrinsic settings). If it is, see if we should
5429 warn about this as a user-procedure having the same name as an intrinsic
5430 (-Wintrinsic-shadow enabled) and do so if we should. */
5431
5432void
5433gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
5434{
5435 gfc_intrinsic_sym* isym;
5436
5437 /* If the warning is disabled, do nothing at all. */
73e42eef 5438 if (!warn_intrinsic_shadow)
c3005b0f
DK
5439 return;
5440
5441 /* Try to find an intrinsic of the same name. */
5442 if (func)
5443 isym = gfc_find_function (sym->name);
f8862a1b 5444 else
c3005b0f
DK
5445 isym = gfc_find_subroutine (sym->name);
5446
5447 /* If no intrinsic was found with this name or it's not included in the
5448 selected standard, everything's fine. */
f8862a1b 5449 if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true,
524af0d6 5450 sym->declared_at))
c3005b0f
DK
5451 return;
5452
5453 /* Emit the warning. */
62d6a5bb 5454 if (in_module || sym->ns->proc_name)
48749dbc
MLI
5455 gfc_warning (OPT_Wintrinsic_shadow,
5456 "%qs declared at %L may shadow the intrinsic of the same"
c3005b0f
DK
5457 " name. In order to call the intrinsic, explicit INTRINSIC"
5458 " declarations may be required.",
5459 sym->name, &sym->declared_at);
5460 else
48749dbc
MLI
5461 gfc_warning (OPT_Wintrinsic_shadow,
5462 "%qs declared at %L is also the name of an intrinsic. It can"
c3005b0f
DK
5463 " only be called via an explicit interface or if declared"
5464 " EXTERNAL.", sym->name, &sym->declared_at);
5465}