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