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