]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/intrinsic.c
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
ieee_9.f90: XFAIL on arm*-*-gnueabi[hf].
[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.
85ec4feb 3 Copyright (C) 2000-2018 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
e1633d82 2028 add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2029 gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
1270d633 2030 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
6de9cd9a 2031
c98583e9
FR		 2032 if (flag_dec_intrinsic_ints)
2033 {
2034 make_alias ("biand", GFC_STD_GNU);
2035 make_alias ("iiand", GFC_STD_GNU);
2036 make_alias ("jiand", GFC_STD_GNU);
2037 make_alias ("kiand", GFC_STD_GNU);
2038 }
2039
b7892582 2040 make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
6de9cd9a 2041
e6c14898
DK		 2042 add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2043 dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_and, gfc_resolve_and,
5d723e54
FXC		 2044 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
2045
2046 make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
2047
195a95c4
TB		 2048 add_sym_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
2049 gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
2050 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2051 msk, BT_LOGICAL, dl, OPTIONAL);
2052
2053 make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
2054
2055 add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
2056 gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
2057 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2058 msk, BT_LOGICAL, dl, OPTIONAL);
2059
2060 make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
2061
e6c14898
DK		 2062 add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2063 di, GFC_STD_GNU, NULL, NULL, NULL);
1270d633 2064
b7892582 2065 make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
b41b2534 2066
e1633d82 2067 add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
289e52fd 2068 gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
1270d633 2069 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
6de9cd9a 2070
c98583e9
FR		 2071 if (flag_dec_intrinsic_ints)
2072 {
2073 make_alias ("bbclr", GFC_STD_GNU);
2074 make_alias ("iibclr", GFC_STD_GNU);
2075 make_alias ("jibclr", GFC_STD_GNU);
2076 make_alias ("kibclr", GFC_STD_GNU);
2077 }
2078
b7892582 2079 make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
6de9cd9a 2080
e1633d82 2081 add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2082 gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
1270d633
SK		 2083 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
2084 ln, BT_INTEGER, di, REQUIRED);
6de9cd9a 2085
c98583e9
FR		 2086 if (flag_dec_intrinsic_ints)
2087 {
2088 make_alias ("bbits", GFC_STD_GNU);
2089 make_alias ("iibits", GFC_STD_GNU);
2090 make_alias ("jibits", GFC_STD_GNU);
2091 make_alias ("kibits", GFC_STD_GNU);
2092 }
2093
b7892582 2094 make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
6de9cd9a 2095
e1633d82 2096 add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
289e52fd 2097 gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
1270d633 2098 i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
6de9cd9a 2099
c98583e9
FR		 2100 if (flag_dec_intrinsic_ints)
2101 {
2102 make_alias ("bbset", GFC_STD_GNU);
2103 make_alias ("iibset", GFC_STD_GNU);
2104 make_alias ("jibset", GFC_STD_GNU);
2105 make_alias ("kibset", GFC_STD_GNU);
2106 }
2107
b7892582 2108 make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
6de9cd9a 2109
5cda5098
FXC		 2110 add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
2111 BT_INTEGER, di, GFC_STD_F77,
860c8f3b 2112 gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
5cda5098 2113 c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2114
b7892582 2115 make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
6de9cd9a 2116
e1633d82 2117 add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2118 gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
1270d633 2119 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
6de9cd9a 2120
c98583e9
FR		 2121 if (flag_dec_intrinsic_ints)
2122 {
2123 make_alias ("bieor", GFC_STD_GNU);
2124 make_alias ("iieor", GFC_STD_GNU);
2125 make_alias ("jieor", GFC_STD_GNU);
2126 make_alias ("kieor", GFC_STD_GNU);
2127 }
2128
c3d003d2 2129 make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
6de9cd9a 2130
e6c14898
DK		 2131 add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2132 dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
5d723e54
FXC		 2133 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
2134
2135 make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
2136
e6c14898
DK		 2137 add_sym_0 ("ierrno", GFC_ISYM_IERRNO, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2138 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno);
f77b6ca3
FXC		 2139
2140 make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
2141
64f002ed 2142 add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
0d6d8e00 2143 gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
64f002ed
TB		 2144 ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
2145
ef78bc3c 2146 add_sym_2 ("image_status", GFC_ISYM_IMAGE_STATUS, CLASS_ELEMENTAL, ACTUAL_NO,
286f737c 2147 BT_INTEGER, di, GFC_STD_F2018, gfc_check_image_status,
f8862a1b
DR		 2148 gfc_simplify_image_status, gfc_resolve_image_status, image,
2149 BT_INTEGER, di, REQUIRED, team, BT_VOID, di, OPTIONAL);
ef78bc3c 2150
32a126b2
FXC		 2151 /* The resolution function for INDEX is called gfc_resolve_index_func
2152 because the name gfc_resolve_index is already used in resolve.c. */
5cda5098
FXC		 2153 add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
2154 BT_INTEGER, di, GFC_STD_F77,
0e7e7e6e 2155 gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
1270d633 2156 stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
5cda5098 2157 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2158
b7892582 2159 make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
6de9cd9a 2160
e1633d82 2161 add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2162 gfc_check_int, gfc_simplify_int, gfc_resolve_int,
1270d633 2163 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2164
e1633d82 2165 add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1270d633
SK		 2166 NULL, gfc_simplify_ifix, NULL,
2167 a, BT_REAL, dr, REQUIRED);
6de9cd9a 2168
e1633d82 2169 add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
1270d633
SK		 2170 NULL, gfc_simplify_idint, NULL,
2171 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2172
b7892582 2173 make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
6de9cd9a 2174
e1633d82 2175 add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
bf3fb7e4
FXC		 2176 gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
2177 a, BT_REAL, dr, REQUIRED);
2178
2179 make_alias ("short", GFC_STD_GNU);
2180
2181 make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
2182
e1633d82 2183 add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
bf3fb7e4
FXC		 2184 gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
2185 a, BT_REAL, dr, REQUIRED);
2186
2187 make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
2188
e1633d82 2189 add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
bf3fb7e4
FXC		 2190 gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
2191 a, BT_REAL, dr, REQUIRED);
2192
2193 make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
2194
e1633d82 2195 add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2196 gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
1270d633 2197 i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
6de9cd9a 2198
c98583e9
FR		 2199 if (flag_dec_intrinsic_ints)
2200 {
2201 make_alias ("bior", GFC_STD_GNU);
2202 make_alias ("iior", GFC_STD_GNU);
2203 make_alias ("jior", GFC_STD_GNU);
2204 make_alias ("kior", GFC_STD_GNU);
2205 }
2206
b7892582 2207 make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
6de9cd9a 2208
e6c14898
DK		 2209 add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2210 dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_or, gfc_resolve_or,
5d723e54
FXC		 2211 i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
2212
2213 make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
2214
195a95c4
TB		 2215 add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
2216 gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
2217 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2218 msk, BT_LOGICAL, dl, OPTIONAL);
2219
2220 make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
2221
2bd74949 2222 /* The following function is for G77 compatibility. */
e6c14898
DK		 2223 add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2224 4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
1270d633 2225 i, BT_INTEGER, 4, OPTIONAL);
2bd74949 2226
b7892582 2227 make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
2bd74949 2228
e6c14898
DK		 2229 add_sym_1 ("isatty", GFC_ISYM_ISATTY, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
2230 dl, GFC_STD_GNU, gfc_check_isatty, NULL, gfc_resolve_isatty,
ae8b8789
FXC		 2231 ut, BT_INTEGER, di, REQUIRED);
2232
2233 make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
2234
bae89173
FXC		 2235 add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
2236 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
4ec80803
FXC		 2237 gfc_check_i, gfc_simplify_is_iostat_end, NULL,
2238 i, BT_INTEGER, 0, REQUIRED);
bae89173
FXC		 2239
2240 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
2241
2242 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
2243 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
4ec80803
FXC		 2244 gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
2245 i, BT_INTEGER, 0, REQUIRED);
bae89173
FXC		 2246
2247 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
2248
4ec80803
FXC		 2249 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
2250 BT_LOGICAL, dl, GFC_STD_GNU,
2251 gfc_check_isnan, gfc_simplify_isnan, NULL,
3d97b1af
FXC		 2252 x, BT_REAL, 0, REQUIRED);
2253
2254 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
2255
88a95a11
FXC		 2256 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
2257 BT_INTEGER, di, GFC_STD_GNU,
2258 gfc_check_ishft, gfc_simplify_rshift, gfc_resolve_rshift,
a119fc1c
FXC		 2259 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
2260
2261 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
2262
88a95a11
FXC		 2263 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
2264 BT_INTEGER, di, GFC_STD_GNU,
2265 gfc_check_ishft, gfc_simplify_lshift, gfc_resolve_lshift,
a119fc1c
FXC		 2266 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
2267
2268 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
2269
e1633d82 2270 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2271 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1270d633 2272 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
6de9cd9a 2273
c98583e9
FR		 2274 if (flag_dec_intrinsic_ints)
2275 {
2276 make_alias ("bshft", GFC_STD_GNU);
2277 make_alias ("iishft", GFC_STD_GNU);
2278 make_alias ("jishft", GFC_STD_GNU);
2279 make_alias ("kishft", GFC_STD_GNU);
2280 }
2281
b7892582 2282 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
6de9cd9a 2283
e1633d82 2284 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2285 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1270d633
SK		 2286 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
2287 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2288
c98583e9
FR		 2289 if (flag_dec_intrinsic_ints)
2290 {
2291 make_alias ("bshftc", GFC_STD_GNU);
2292 make_alias ("iishftc", GFC_STD_GNU);
2293 make_alias ("jishftc", GFC_STD_GNU);
2294 make_alias ("kishftc", GFC_STD_GNU);
2295 }
2296
b7892582 2297 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
6de9cd9a 2298
e6c14898 2299 add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
17164de4 2300 di, GFC_STD_GNU, gfc_check_kill, NULL, NULL,
fbe1f017 2301 pid, BT_INTEGER, di, REQUIRED, sig, BT_INTEGER, di, REQUIRED);
f77b6ca3
FXC		 2302
2303 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
2304
e1633d82 2305 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1270d633
SK		 2306 gfc_check_kind, gfc_simplify_kind, NULL,
2307 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2308
cd5ecab6 2309 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
6de9cd9a 2310
5cda5098
FXC		 2311 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
2312 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2313 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
5cda5098
FXC		 2314 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
2315 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2316
b7892582 2317 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
6de9cd9a 2318
64f002ed 2319 add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
0d6d8e00
TB		 2320 BT_INTEGER, di, GFC_STD_F2008,
2321 gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
64f002ed
TB		 2322 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2323 kind, BT_INTEGER, di, OPTIONAL);
2324
0d6d8e00 2325 make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
64f002ed 2326
414f00e9
SB		 2327 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
2328 BT_INTEGER, di, GFC_STD_F2008,
2329 gfc_check_i, gfc_simplify_leadz, NULL,
2330 i, BT_INTEGER, di, REQUIRED);
2331
2332 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
2333
5cda5098
FXC		 2334 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
2335 BT_INTEGER, di, GFC_STD_F77,
2336 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
2337 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2338
b7892582 2339 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
6de9cd9a 2340
5cda5098
FXC		 2341 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
2342 BT_INTEGER, di, GFC_STD_F95,
2343 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
2344 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2345
f77b6ca3
FXC		 2346 make_alias ("lnblnk", GFC_STD_GNU);
2347
b7892582 2348 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
6de9cd9a 2349
f489fba1
FXC		 2350 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
2351 dr, GFC_STD_GNU,
75be5dc0
TB		 2352 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2353 x, BT_REAL, dr, REQUIRED);
2354
f489fba1
FXC		 2355 make_alias ("log_gamma", GFC_STD_F2008);
2356
75be5dc0
TB		 2357 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
2358 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
2359 x, BT_REAL, dr, REQUIRED);
2360
2361 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
15ead859 2362 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
75be5dc0
TB		 2363 x, BT_REAL, dr, REQUIRED);
2364
f489fba1 2365 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
75be5dc0
TB		 2366
2367
d393bbd7
FXC		 2368 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2369 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1270d633 2370 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2371
b7892582 2372 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
6de9cd9a 2373
d393bbd7
FXC		 2374 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2375 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1270d633 2376 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2377
b7892582 2378 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
6de9cd9a 2379
d393bbd7
FXC		 2380 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2381 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1270d633 2382 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2383
b7892582 2384 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
6de9cd9a 2385
d393bbd7
FXC		 2386 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
2387 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1270d633 2388 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2389
b7892582 2390 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
6de9cd9a 2391
e6c14898 2392 add_sym_2 ("link", GFC_ISYM_LINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2393 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
2394 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC		 2395
2396 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
f8862a1b 2397
e1633d82 2398 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
985aff9c 2399 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1270d633 2400 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2401
e1633d82 2402 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1270d633
SK		 2403 NULL, gfc_simplify_log, gfc_resolve_log,
2404 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2405
e1633d82 2406 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2407 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
1270d633 2408 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2409
e1633d82 2410 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2411 NULL, gfc_simplify_log, gfc_resolve_log,
1270d633 2412 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2413
e1633d82 2414 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK		 2415 NULL, gfc_simplify_log, gfc_resolve_log,
2416 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2417
19060788 2418 make_alias ("cdlog", GFC_STD_GNU);
6de9cd9a 2419
b7892582 2420 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
6de9cd9a 2421
e1633d82 2422 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
985aff9c 2423 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2424 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2425
e1633d82 2426 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2427 NULL, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2428 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2429
e1633d82 2430 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2431 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2432 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2433
b7892582 2434 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
6de9cd9a 2435
e1633d82 2436 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
6de9cd9a 2437 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1270d633 2438 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2439
b7892582 2440 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
6de9cd9a 2441
1a14a58c
TB		 2442 add_sym_2_intent ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, ACTUAL_NO,
2443 BT_INTEGER, di, GFC_STD_GNU,
2444 gfc_check_stat, NULL, gfc_resolve_lstat,
2445 nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2446 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
bf3fb7e4
FXC		 2447
2448 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2449
e6c14898 2450 add_sym_1 ("malloc", GFC_ISYM_MALLOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
8b40ca6a 2451 GFC_STD_GNU, gfc_check_malloc, NULL, NULL,
2f8cce28 2452 sz, BT_INTEGER, di, REQUIRED);
0d519038
FXC		 2453
2454 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2455
88a95a11
FXC		 2456 add_sym_2 ("maskl", GFC_ISYM_MASKL, CLASS_ELEMENTAL, ACTUAL_NO,
2457 BT_INTEGER, di, GFC_STD_F2008,
2458 gfc_check_mask, gfc_simplify_maskl, gfc_resolve_mask,
2459 i, BT_INTEGER, di, REQUIRED,
2460 kind, BT_INTEGER, di, OPTIONAL);
2461
2462 make_generic ("maskl", GFC_ISYM_MASKL, GFC_STD_F2008);
2463
2464 add_sym_2 ("maskr", GFC_ISYM_MASKR, CLASS_ELEMENTAL, ACTUAL_NO,
2465 BT_INTEGER, di, GFC_STD_F2008,
2466 gfc_check_mask, gfc_simplify_maskr, gfc_resolve_mask,
2467 i, BT_INTEGER, di, REQUIRED,
2468 kind, BT_INTEGER, di, OPTIONAL);
2469
2470 make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
2471
e1633d82 2472 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8ec259c1 2473 gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
1270d633 2474 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
6de9cd9a 2475
b7892582 2476 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
6de9cd9a
DN		 2477
2478 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2479 int(max). The max function must take at least two arguments. */
2480
e1633d82 2481 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
6de9cd9a 2482 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1270d633 2483 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2484
e1633d82 2485 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2486 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1270d633 2487 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2488
e1633d82 2489 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2490 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1270d633 2491 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2492
e1633d82 2493 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2494 gfc_check_min_max_real, gfc_simplify_max, NULL,
1270d633 2495 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2496
e1633d82 2497 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2498 gfc_check_min_max_real, gfc_simplify_max, NULL,
1270d633 2499 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2500
e1633d82 2501 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 2502 gfc_check_min_max_double, gfc_simplify_max, NULL,
1270d633 2503 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
6de9cd9a 2504
b7892582 2505 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
6de9cd9a 2506
1b314f14
SK		 2507 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER,
2508 di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_maxexponent, NULL,
1270d633 2509 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2510
cd5ecab6 2511 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
6de9cd9a 2512
64b1806b 2513 add_sym_5ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
a1d6c052 2514 gfc_check_minloc_maxloc, gfc_simplify_maxloc, gfc_resolve_maxloc,
1270d633 2515 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
64b1806b 2516 msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
fbe1f017 2517 bck, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2518
b7892582 2519 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
6de9cd9a 2520
01ce9e31
TK		 2521 add_sym_6fl ("findloc", GFC_ISYM_FINDLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
2522 BT_INTEGER, di, GFC_STD_F2008,
2523 gfc_check_findloc, gfc_simplify_findloc, gfc_resolve_findloc,
2524 ar, BT_REAL, dr, REQUIRED, val, BT_REAL, dr, REQUIRED,
2525 dm, BT_INTEGER, ii, OPTIONAL, msk, BT_LOGICAL, dl, OPTIONAL,
2526 kind, BT_INTEGER, di, OPTIONAL, bck, BT_LOGICAL, dl, OPTIONAL);
2527
2528 make_generic ("findloc", GFC_ISYM_FINDLOC, GFC_STD_F2008);
2529
e1633d82 2530 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
5a0193ee 2531 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
1270d633
SK		 2532 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2533 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2534
b7892582 2535 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
6de9cd9a 2536
e6c14898 2537 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28 2538 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
bf3fb7e4
FXC		 2539
2540 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2541
e6c14898
DK		 2542 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2543 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
bf3fb7e4
FXC		 2544
2545 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2546
e1633d82 2547 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8f2b565d 2548 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
1270d633
SK		 2549 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2550 msk, BT_LOGICAL, dl, REQUIRED);
6de9cd9a 2551
b7892582 2552 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
6de9cd9a 2553
88a95a11
FXC		 2554 add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS, CLASS_ELEMENTAL, ACTUAL_NO,
2555 BT_INTEGER, di, GFC_STD_F2008,
2556 gfc_check_merge_bits, gfc_simplify_merge_bits,
2557 gfc_resolve_merge_bits,
2558 i, BT_INTEGER, di, REQUIRED,
2559 j, BT_INTEGER, di, REQUIRED,
2560 msk, BT_INTEGER, di, REQUIRED);
2561
2562 make_generic ("merge_bits", GFC_ISYM_MERGE_BITS, GFC_STD_F2008);
2563
1270d633
SK		 2564 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2565 int(min). */
6de9cd9a 2566
e1633d82 2567 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
6de9cd9a 2568 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
b251af97 2569 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2570
e1633d82 2571 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2572 gfc_check_min_max_integer, gfc_simplify_min, NULL,
b251af97 2573 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2574
e1633d82 2575 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2576 gfc_check_min_max_integer, gfc_simplify_min, NULL,
b251af97 2577 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2578
e1633d82 2579 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2580 gfc_check_min_max_real, gfc_simplify_min, NULL,
b251af97 2581 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2582
e1633d82 2583 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2584 gfc_check_min_max_real, gfc_simplify_min, NULL,
b251af97 2585 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2586
e1633d82 2587 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 2588 gfc_check_min_max_double, gfc_simplify_min, NULL,
b251af97 2589 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
6de9cd9a 2590
b7892582 2591 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
6de9cd9a 2592
1b314f14
SK		 2593 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER,
2594 di, GFC_STD_F95, gfc_check_fn_r, gfc_simplify_minexponent, NULL,
1270d633 2595 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2596
cd5ecab6 2597 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
6de9cd9a 2598
64b1806b 2599 add_sym_5ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
a1d6c052 2600 gfc_check_minloc_maxloc, gfc_simplify_minloc, gfc_resolve_minloc,
1270d633 2601 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
64b1806b 2602 msk, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL,
fbe1f017 2603 bck, BT_LOGICAL, dl, OPTIONAL);
f8862a1b 2604
b7892582 2605 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
6de9cd9a 2606
e1633d82 2607 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
5a0193ee 2608 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
1270d633
SK		 2609 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2610 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2611
b7892582 2612 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
6de9cd9a 2613
e1633d82 2614 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2615 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2616 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
6de9cd9a 2617
c98583e9
FR		 2618 if (flag_dec_intrinsic_ints)
2619 {
2620 make_alias ("bmod", GFC_STD_GNU);
2621 make_alias ("imod", GFC_STD_GNU);
2622 make_alias ("jmod", GFC_STD_GNU);
2623 make_alias ("kmod", GFC_STD_GNU);
2624 }
2625
e1633d82 2626 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2627 NULL, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2628 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
6de9cd9a 2629
e1633d82 2630 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2631 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2632 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
6de9cd9a 2633
b7892582 2634 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
6de9cd9a 2635
e1633d82 2636 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
6de9cd9a 2637 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1270d633 2638 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
6de9cd9a 2639
b7892582 2640 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
6de9cd9a 2641
e1633d82 2642 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8765339d 2643 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1270d633 2644 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
6de9cd9a 2645
b7892582 2646 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
6de9cd9a 2647
e1633d82 2648 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
8d2c2905 2649 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
9fe3100e 2650 a, BT_CHARACTER, dc, REQUIRED);
bec93d79 2651
cd5ecab6
DF		 2652 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2653
e1633d82 2654 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2655 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1270d633 2656 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2657
e1633d82 2658 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2659 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1270d633 2660 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2661
b7892582 2662 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
6de9cd9a 2663
e1633d82 2664 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2665 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1270d633 2666 i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2667
c98583e9
FR		 2668 if (flag_dec_intrinsic_ints)
2669 {
2670 make_alias ("bnot", GFC_STD_GNU);
2671 make_alias ("inot", GFC_STD_GNU);
2672 make_alias ("jnot", GFC_STD_GNU);
2673 make_alias ("knot", GFC_STD_GNU);
2674 }
2675
b7892582 2676 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
6de9cd9a 2677
0cd0559e
TB		 2678 add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
2679 GFC_STD_F2008, gfc_check_norm2, gfc_simplify_norm2, gfc_resolve_norm2,
2680 x, BT_REAL, dr, REQUIRED,
2681 dm, BT_INTEGER, ii, OPTIONAL);
2682
2683 make_generic ("norm2", GFC_ISYM_NORM2, GFC_STD_F2008);
2684
e1633d82 2685 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2686 gfc_check_null, gfc_simplify_null, NULL,
1270d633 2687 mo, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2688
cd5ecab6 2689 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
6de9cd9a 2690
05fc16dd 2691 add_sym_2 ("num_images", GFC_ISYM_NUM_IMAGES, CLASS_INQUIRY, ACTUAL_NO,
60386f50 2692 BT_INTEGER, di, GFC_STD_F2008,
05fc16dd
TB		 2693 gfc_check_num_images, gfc_simplify_num_images, NULL,
2694 dist, BT_INTEGER, di, OPTIONAL,
2695 failed, BT_LOGICAL, dl, OPTIONAL);
d0a4a61c 2696
e1633d82 2697 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
7ba8c18c 2698 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
1270d633
SK		 2699 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2700 v, BT_REAL, dr, OPTIONAL);
6de9cd9a 2701
b7892582 2702 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
6de9cd9a 2703
0cd0559e
TB		 2704
2705 add_sym_2 ("parity", GFC_ISYM_PARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl,
2706 GFC_STD_F2008, gfc_check_parity, gfc_simplify_parity, gfc_resolve_parity,
2707 msk, BT_LOGICAL, dl, REQUIRED,
2708 dm, BT_INTEGER, ii, OPTIONAL);
2709
2710 make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
2711
ad5f4de2
FXC		 2712 add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
2713 BT_INTEGER, di, GFC_STD_F2008,
2714 gfc_check_i, gfc_simplify_popcnt, NULL,
2715 i, BT_INTEGER, di, REQUIRED);
2716
2717 make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
2718
2719 add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
2720 BT_INTEGER, di, GFC_STD_F2008,
2721 gfc_check_i, gfc_simplify_poppar, NULL,
2722 i, BT_INTEGER, di, REQUIRED);
2723
2724 make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
2725
e1633d82 2726 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2727 gfc_check_precision, gfc_simplify_precision, NULL,
1270d633 2728 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2729
cd5ecab6 2730 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
6de9cd9a 2731
23e38561
JW		 2732 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2733 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2734 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
6de9cd9a 2735
b7892582 2736 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
6de9cd9a 2737
e1633d82 2738 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a16d978f 2739 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
1270d633
SK		 2740 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2741 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2742
b7892582 2743 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
6de9cd9a 2744
e1633d82 2745 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2746 gfc_check_radix, gfc_simplify_radix, NULL,
1270d633 2747 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2748
cd5ecab6 2749 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
6de9cd9a 2750
2bd74949 2751 /* The following function is for G77 compatibility. */
e6c14898
DK		 2752 add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2753 4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
b251af97 2754 i, BT_INTEGER, 4, OPTIONAL);
2bd74949 2755
1270d633
SK		 2756 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2757 use slightly different shoddy multiplicative congruential PRNG. */
19060788 2758 make_alias ("ran", GFC_STD_GNU);
f8e566e5 2759
b7892582 2760 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2bd74949 2761
e1633d82 2762 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2763 gfc_check_range, gfc_simplify_range, NULL,
1270d633 2764 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2765
cd5ecab6 2766 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
6de9cd9a 2767
2514987f 2768 add_sym_1 ("rank", GFC_ISYM_RANK, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
286f737c 2769 GFC_STD_F2018, gfc_check_rank, gfc_simplify_rank, gfc_resolve_rank,
2514987f 2770 a, BT_REAL, dr, REQUIRED);
286f737c 2771 make_generic ("rank", GFC_ISYM_RANK, GFC_STD_F2018);
2514987f 2772
e1633d82 2773 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2774 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1270d633 2775 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2776
6970fcc8 2777 /* This provides compatibility with g77. */
e1633d82 2778 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
6970fcc8
SK		 2779 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2780 a, BT_UNKNOWN, dr, REQUIRED);
2781
7f59aaba 2782 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
c9018c71 2783 gfc_check_float, gfc_simplify_float, NULL,
1270d633 2784 a, BT_INTEGER, di, REQUIRED);
6de9cd9a 2785
c98583e9
FR		 2786 if (flag_dec_intrinsic_ints)
2787 {
2788 make_alias ("floati", GFC_STD_GNU);
2789 make_alias ("floatj", GFC_STD_GNU);
2790 make_alias ("floatk", GFC_STD_GNU);
2791 }
2792
c9018c71
DF		 2793 add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
2794 gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2795 a, BT_REAL, dr, REQUIRED);
2796
7f59aaba 2797 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
c9018c71 2798 gfc_check_sngl, gfc_simplify_sngl, NULL,
1270d633 2799 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2800
b7892582 2801 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
6de9cd9a 2802
e6c14898 2803 add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2804 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2805 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC		 2806
2807 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
f8862a1b 2808
e1633d82 2809 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 2810 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
0881653c 2811 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 2812
b7892582 2813 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
6de9cd9a 2814
e1633d82 2815 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2816 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
1270d633
SK		 2817 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2818 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 2819
b7892582 2820 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
6de9cd9a 2821
1b314f14
SK		 2822 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
2823 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
1270d633 2824 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2825
b7892582 2826 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
6de9cd9a 2827
cf2b3c22
TB		 2828 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2829 BT_LOGICAL, dl, GFC_STD_F2003,
eaf31d82 2830 gfc_check_same_type_as, gfc_simplify_same_type_as, NULL,
cf2b3c22
TB		 2831 a, BT_UNKNOWN, 0, REQUIRED,
2832 b, BT_UNKNOWN, 0, REQUIRED);
2833
e1633d82 2834 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2835 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
1270d633 2836 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2837
b7892582 2838 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
6de9cd9a 2839
5cda5098
FXC		 2840 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2841 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2842 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
1270d633 2843 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 2844 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2845
b7892582 2846 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
6de9cd9a 2847
f7b529fa 2848 /* Added for G77 compatibility garbage. */
e6c14898
DK		 2849 add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2850 4, GFC_STD_GNU, NULL, NULL, NULL);
2bd74949 2851
b7892582 2852 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2bd74949 2853
53096259 2854 /* Added for G77 compatibility. */
e6c14898
DK		 2855 add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2856 dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
53096259
PT		 2857 x, BT_REAL, dr, REQUIRED);
2858
2859 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2860
a39fafac
FXC		 2861 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2862 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2863 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2864 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2865
2866 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2867
e1633d82 2868 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC		 2869 GFC_STD_F95, gfc_check_selected_int_kind,
2870 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
6de9cd9a 2871
b7892582 2872 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
6de9cd9a 2873
01349049 2874 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC		 2875 GFC_STD_F95, gfc_check_selected_real_kind,
2876 gfc_simplify_selected_real_kind, NULL,
01349049
TB		 2877 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2878 "radix", BT_INTEGER, di, OPTIONAL);
6de9cd9a 2879
b7892582 2880 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
6de9cd9a 2881
e1633d82 2882 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a
DN		 2883 gfc_check_set_exponent, gfc_simplify_set_exponent,
2884 gfc_resolve_set_exponent,
1270d633 2885 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2886
b7892582 2887 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
6de9cd9a 2888
7320cf09 2889 add_sym_2 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2890 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
7320cf09
TB		 2891 src, BT_REAL, dr, REQUIRED,
2892 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2893
b7892582 2894 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
6de9cd9a 2895
88a95a11
FXC		 2896 add_sym_2 ("shifta", GFC_ISYM_SHIFTA, CLASS_ELEMENTAL, ACTUAL_NO,
2897 BT_INTEGER, di, GFC_STD_F2008,
2898 gfc_check_shift, gfc_simplify_shifta, gfc_resolve_shift,
2899 i, BT_INTEGER, di, REQUIRED,
2900 sh, BT_INTEGER, di, REQUIRED);
2901
2902 make_generic ("shifta", GFC_ISYM_SHIFTA, GFC_STD_F2008);
2903
2904 add_sym_2 ("shiftl", GFC_ISYM_SHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
2905 BT_INTEGER, di, GFC_STD_F2008,
2906 gfc_check_shift, gfc_simplify_shiftl, gfc_resolve_shift,
2907 i, BT_INTEGER, di, REQUIRED,
2908 sh, BT_INTEGER, di, REQUIRED);
2909
2910 make_generic ("shiftl", GFC_ISYM_SHIFTL, GFC_STD_F2008);
2911
2912 add_sym_2 ("shiftr", GFC_ISYM_SHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
2913 BT_INTEGER, di, GFC_STD_F2008,
2914 gfc_check_shift, gfc_simplify_shiftr, gfc_resolve_shift,
2915 i, BT_INTEGER, di, REQUIRED,
2916 sh, BT_INTEGER, di, REQUIRED);
2917
2918 make_generic ("shiftr", GFC_ISYM_SHIFTR, GFC_STD_F2008);
2919
e1633d82 2920 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2921 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2922 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
6de9cd9a 2923
e1633d82 2924 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2925 NULL, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2926 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
6de9cd9a 2927
e1633d82 2928 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2929 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2930 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
6de9cd9a 2931
b7892582 2932 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
6de9cd9a 2933
e6c14898
DK		 2934 add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2935 di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
89560a3c 2936 num, BT_INTEGER, di, REQUIRED, han, BT_VOID, 0, REQUIRED);
185d7d97
FXC		 2937
2938 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2939
e1633d82 2940 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2941 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2942 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2943
e1633d82 2944 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2945 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2946 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2947
e1633d82 2948 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2949 NULL, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2950 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2951
e1633d82 2952 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK		 2953 NULL, gfc_simplify_sin, gfc_resolve_sin,
2954 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2955
19060788 2956 make_alias ("cdsin", GFC_STD_GNU);
6de9cd9a 2957
b7892582 2958 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
6de9cd9a 2959
e1633d82 2960 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 2961 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 2962 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2963
e1633d82 2964 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2965 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 2966 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2967
b7892582 2968 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
6de9cd9a 2969
5cda5098
FXC		 2970 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2971 BT_INTEGER, di, GFC_STD_F95,
2972 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2973 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2974 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2975
b7892582 2976 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
6de9cd9a 2977
0881224e 2978 /* Obtain the stride for a given dimensions; to be used only internally.
8a8d1a16 2979 "make_from_module" makes it inaccessible for external users. */
0881224e
TB		 2980 add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
2981 BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
2982 NULL, NULL, gfc_resolve_stride,
2983 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
2984 make_from_module();
2985
69c3654c
TB		 2986 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
2987 BT_INTEGER, ii, GFC_STD_GNU,
2988 gfc_check_sizeof, gfc_simplify_sizeof, NULL,
8d82b242 2989 x, BT_UNKNOWN, 0, REQUIRED);
fd2157ce 2990
cd5ecab6 2991 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
d000aa67 2992
cadddfdd
TB		 2993 /* The following functions are part of ISO_C_BINDING. */
2994 add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
2995 BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
8a92685e
SK		 2996 c_ptr_1, BT_VOID, 0, REQUIRED,
2997 c_ptr_2, BT_VOID, 0, OPTIONAL);
cadddfdd
TB		 2998 make_from_module();
2999
3000 add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
3001 BT_VOID, 0, GFC_STD_F2003,
3002 gfc_check_c_loc, NULL, gfc_resolve_c_loc,
3003 x, BT_UNKNOWN, 0, REQUIRED);
3004 make_from_module();
3005
3006 add_sym_1 ("c_funloc", GFC_ISYM_C_FUNLOC, CLASS_INQUIRY, ACTUAL_NO,
3007 BT_VOID, 0, GFC_STD_F2003,
3008 gfc_check_c_funloc, NULL, gfc_resolve_c_funloc,
3009 x, BT_UNKNOWN, 0, REQUIRED);
3010 make_from_module();
3011
048510c8 3012 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
cadddfdd 3013 BT_INTEGER, gfc_index_integer_kind, GFC_STD_F2008,
1a8c1e35 3014 gfc_check_c_sizeof, gfc_simplify_sizeof, NULL,
048510c8 3015 x, BT_UNKNOWN, 0, REQUIRED);
d000aa67
TB		 3016 make_from_module();
3017
f8862a1b 3018 /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV. */
41804a5b
TB		 3019 add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
3020 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
d000aa67
TB		 3021 NULL, gfc_simplify_compiler_options, NULL);
3022 make_from_module();
3023
41804a5b
TB		 3024 add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_INQUIRY,
3025 ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
d000aa67
TB		 3026 NULL, gfc_simplify_compiler_version, NULL);
3027 make_from_module();
fd2157ce 3028
1b314f14
SK		 3029 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
3030 GFC_STD_F95, gfc_check_fn_r, gfc_simplify_spacing, gfc_resolve_spacing,
1270d633 3031 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3032
b7892582 3033 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
6de9cd9a 3034
e1633d82 3035 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
c430a6f9 3036 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
1270d633 3037 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
0881653c 3038 ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 3039
b7892582 3040 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
6de9cd9a 3041
e1633d82 3042 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 3043 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 3044 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3045
e1633d82 3046 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3047 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 3048 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3049
e1633d82 3050 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 3051 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 3052 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 3053
e1633d82 3054 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK		 3055 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
3056 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 3057
19060788 3058 make_alias ("cdsqrt", GFC_STD_GNU);
6de9cd9a 3059
b7892582 3060 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
6de9cd9a 3061
1a14a58c
TB		 3062 add_sym_2_intent ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO,
3063 BT_INTEGER, di, GFC_STD_GNU,
3064 gfc_check_stat, NULL, gfc_resolve_stat,
3065 nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3066 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
df65f093
SK		 3067
3068 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
3069
ef78bc3c 3070 add_sym_2 ("stopped_images", GFC_ISYM_STOPPED_IMAGES, CLASS_TRANSFORMATIONAL,
286f737c 3071 ACTUAL_NO, BT_INTEGER, dd, GFC_STD_F2018,
ef78bc3c
AV		 3072 gfc_check_failed_or_stopped_images,
3073 gfc_simplify_failed_or_stopped_images,
f8862a1b
DR		 3074 gfc_resolve_stopped_images, team, BT_VOID, di, OPTIONAL,
3075 kind, BT_INTEGER, di, OPTIONAL);
ef78bc3c 3076
048510c8
JW		 3077 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
3078 BT_INTEGER, di, GFC_STD_F2008,
1a8c1e35
TB		 3079 gfc_check_storage_size, gfc_simplify_storage_size,
3080 gfc_resolve_storage_size,
048510c8
JW		 3081 a, BT_UNKNOWN, 0, REQUIRED,
3082 kind, BT_INTEGER, di, OPTIONAL);
f8862a1b 3083
e1633d82 3084 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a16d978f 3085 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
1270d633
SK		 3086 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3087 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 3088
b7892582 3089 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
6de9cd9a 3090
e6c14898 3091 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 3092 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
3093 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC		 3094
3095 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
3096
e6c14898 3097 add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 3098 GFC_STD_GNU, NULL, NULL, NULL,
3099 com, BT_CHARACTER, dc, REQUIRED);
1270d633 3100
b7892582 3101 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
5b1374e9 3102
e1633d82 3103 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 3104 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
1270d633 3105 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3106
e1633d82 3107 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3108 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
1270d633 3109 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3110
b7892582 3111 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
6de9cd9a 3112
e1633d82 3113 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 3114 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 3115 x, BT_REAL, dr, REQUIRED);
6de9cd9a 3116
e1633d82 3117 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 3118 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 3119 x, BT_REAL, dd, REQUIRED);
6de9cd9a 3120
b7892582 3121 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
6de9cd9a 3122
f8862a1b 3123 add_sym_1 ("team_number", GFC_ISYM_TEAM_NUMBER, CLASS_TRANSFORMATIONAL,
286f737c 3124 ACTUAL_YES, BT_INTEGER, di, GFC_STD_F2018,
f8862a1b
DR		 3125 gfc_check_team_number, NULL, gfc_resolve_team_number,
3126 team, BT_DERIVED, di, OPTIONAL);
3127
05fc16dd 3128 add_sym_3 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
0d6d8e00 3129 gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
05fc16dd
TB		 3130 ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL,
3131 dist, BT_INTEGER, di, OPTIONAL);
64f002ed 3132
e6c14898
DK		 3133 add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3134 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
f77b6ca3
FXC		 3135
3136 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
3137
e6c14898
DK		 3138 add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3139 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
f77b6ca3
FXC		 3140
3141 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
3142
e1633d82 3143 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1b314f14 3144 gfc_check_fn_r, gfc_simplify_tiny, NULL, x, BT_REAL, dr, REQUIRED);
6de9cd9a 3145
cd5ecab6 3146 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
6de9cd9a 3147
414f00e9
SB		 3148 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
3149 BT_INTEGER, di, GFC_STD_F2008,
3150 gfc_check_i, gfc_simplify_trailz, NULL,
3151 i, BT_INTEGER, di, REQUIRED);
3152
3153 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
3154
e1633d82 3155 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a4a11197 3156 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
1270d633
SK		 3157 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
3158 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3159
b7892582 3160 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
6de9cd9a 3161
e1633d82 3162 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8ec259c1 3163 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
1270d633 3164 m, BT_REAL, dr, REQUIRED);
6de9cd9a 3165
b7892582 3166 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
6de9cd9a 3167
e1633d82 3168 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 3169 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
1270d633 3170 stg, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 3171
b7892582 3172 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
6de9cd9a 3173
e6c14898
DK		 3174 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
3175 0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
b251af97 3176 ut, BT_INTEGER, di, REQUIRED);
25fc05eb
FXC		 3177
3178 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
3179
5cda5098
FXC		 3180 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
3181 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 3182 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
5cda5098
FXC		 3183 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3184 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3185
b7892582 3186 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
6de9cd9a 3187
64f002ed 3188 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
e6c14898
DK		 3189 BT_INTEGER, di, GFC_STD_F2008,
3190 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
3191 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
3192 kind, BT_INTEGER, di, OPTIONAL);
64f002ed 3193
0d6d8e00 3194 make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
64f002ed 3195
d8fe26b2 3196 /* g77 compatibility for UMASK. */
e6c14898 3197 add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 3198 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
3199 msk, BT_INTEGER, di, REQUIRED);
d8fe26b2
SK		 3200
3201 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
3202
3203 /* g77 compatibility for UNLINK. */
e6c14898
DK		 3204 add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
3205 di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
2f8cce28 3206 "path", BT_CHARACTER, dc, REQUIRED);
d8fe26b2
SK		 3207
3208 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
3209
e1633d82 3210 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
c430a6f9 3211 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
1270d633
SK		 3212 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
3213 f, BT_REAL, dr, REQUIRED);
6de9cd9a 3214
b7892582 3215 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
6de9cd9a 3216
5cda5098
FXC		 3217 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
3218 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 3219 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
1270d633 3220 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 3221 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 3222
b7892582 3223 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
f8862a1b 3224
e6c14898 3225 add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2f8cce28
FXC		 3226 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
3227 x, BT_UNKNOWN, 0, REQUIRED);
f8862a1b 3228
83d890b9 3229 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
8a8d1a16 3230
8e8c2744
FR		 3231 if (flag_dec_math)
3232 {
3233 add_sym_1 ("acosd", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3234 dr, GFC_STD_GNU,
3235 gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd,
3236 x, BT_REAL, dr, REQUIRED);
3237
3238 add_sym_1 ("dacosd", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3239 dd, GFC_STD_GNU,
3240 gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd,
3241 x, BT_REAL, dd, REQUIRED);
3242
3243 make_generic ("acosd", GFC_ISYM_ACOS, GFC_STD_GNU);
3244
3245 add_sym_1 ("asind", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3246 dr, GFC_STD_GNU,
3247 gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd,
3248 x, BT_REAL, dr, REQUIRED);
3249
3250 add_sym_1 ("dasind", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3251 dd, GFC_STD_GNU,
3252 gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd,
3253 x, BT_REAL, dd, REQUIRED);
3254
3255 make_generic ("asind", GFC_ISYM_ASIN, GFC_STD_GNU);
3256
3257 add_sym_1 ("atand", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3258 dr, GFC_STD_GNU,
3259 gfc_check_fn_r, gfc_simplify_atrigd, gfc_resolve_atrigd,
3260 x, BT_REAL, dr, REQUIRED);
3261
3262 add_sym_1 ("datand", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3263 dd, GFC_STD_GNU,
3264 gfc_check_fn_d, gfc_simplify_atrigd, gfc_resolve_atrigd,
3265 x, BT_REAL, dd, REQUIRED);
3266
3267 make_generic ("atand", GFC_ISYM_ATAN, GFC_STD_GNU);
3268
3269 add_sym_2 ("atan2d",GFC_ISYM_ATAN2,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3270 dr, GFC_STD_GNU,
3271 gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_atan2d,
3272 y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
3273
3274 add_sym_2 ("datan2d",GFC_ISYM_ATAN2,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3275 dd, GFC_STD_GNU,
3276 gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_atan2d,
3277 y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
3278
3279 make_generic ("atan2d", GFC_ISYM_ATAN2, GFC_STD_GNU);
3280
3281 add_sym_1 ("cosd", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3282 dr, GFC_STD_GNU,
3283 gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
3284 x, BT_REAL, dr, REQUIRED);
3285
3286 add_sym_1 ("dcosd", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3287 dd, GFC_STD_GNU,
3288 gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
3289 x, BT_REAL, dd, REQUIRED);
3290
3291 make_generic ("cosd", GFC_ISYM_COS, GFC_STD_GNU);
3292
3293 add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3294 dr, GFC_STD_GNU,
3295 gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_cotan,
3296 x, BT_REAL, dr, REQUIRED);
3297
3298 add_sym_1 ("dcotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3299 dd, GFC_STD_GNU,
3300 gfc_check_fn_d, gfc_simplify_cotan, gfc_resolve_cotan,
3301 x, BT_REAL, dd, REQUIRED);
3302
3303 make_generic ("cotan", GFC_ISYM_COTAN, GFC_STD_GNU);
3304
3305 add_sym_1 ("cotand", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3306 dr, GFC_STD_GNU,
3307 gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
3308 x, BT_REAL, dr, REQUIRED);
3309
3310 add_sym_1 ("dcotand",GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3311 dd, GFC_STD_GNU,
3312 gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
3313 x, BT_REAL, dd, REQUIRED);
3314
3315 make_generic ("cotand", GFC_ISYM_COTAN, GFC_STD_GNU);
3316
3317 add_sym_1 ("sind", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3318 dr, GFC_STD_GNU,
3319 gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
3320 x, BT_REAL, dr, REQUIRED);
3321
3322 add_sym_1 ("dsind", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3323 dd, GFC_STD_GNU,
3324 gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
3325 x, BT_REAL, dd, REQUIRED);
3326
3327 make_generic ("sind", GFC_ISYM_SIN, GFC_STD_GNU);
3328
3329 add_sym_1 ("tand", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3330 dr, GFC_STD_GNU,
3331 gfc_check_fn_r, gfc_simplify_trigd, gfc_resolve_trigd,
3332 x, BT_REAL, dr, REQUIRED);
3333
3334 add_sym_1 ("dtand", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL,
3335 dd, GFC_STD_GNU,
3336 gfc_check_fn_d, gfc_simplify_trigd, gfc_resolve_trigd,
3337 x, BT_REAL, dd, REQUIRED);
3338
3339 make_generic ("tand", GFC_ISYM_TAN, GFC_STD_GNU);
3340 }
3341
8a8d1a16
TB		 3342 /* The following function is internally used for coarray libray functions.
3343 "make_from_module" makes it inaccessible for external users. */
3344 add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
3345 BT_REAL, dr, GFC_STD_GNU, NULL, NULL, NULL,
3346 x, BT_REAL, dr, REQUIRED);
3347 make_from_module();
6de9cd9a
DN		 3348}
3349
3350
6de9cd9a
DN		 3351/* Add intrinsic subroutines. */
3352
3353static void
3354add_subroutines (void)
3355{
fbe1f017
SK		 3356 /* Argument names. These are used as argument keywords and so need to
3357 match the documentation. Please keep this list in sorted order. */
3358 static const char
3359 *a = "a", *c = "count", *cm = "count_max", *com = "command",
3360 *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
3361 *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
3362 *length = "length", *ln = "len", *md = "mode", *msk = "mask",
3363 *name = "name", *num = "number", *of = "offset", *old = "old",
3364 *p1 = "path1", *p2 = "path2", *pid = "pid", *pos = "pos",
3365 *pt = "put", *ptr = "ptr", *res = "result",
3366 *result_image = "result_image", *sec = "seconds", *sig = "sig",
3367 *st = "status", *stat = "stat", *sz = "size", *t = "to",
3368 *tm = "time", *tp = "topos", *trim_name = "trim_name", *ut = "unit",
3369 *val = "value", *vl = "values", *whence = "whence", *zn = "zone";
a5fbc2f3 3370
0d519038 3371 int di, dr, dc, dl, ii;
6de9cd9a 3372
9d64df18
TS		 3373 di = gfc_default_integer_kind;
3374 dr = gfc_default_real_kind;
3375 dc = gfc_default_character_kind;
3376 dl = gfc_default_logical_kind;
0d519038 3377 ii = gfc_index_integer_kind;
6de9cd9a 3378
cd5ecab6 3379 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
6de9cd9a 3380
3f2286f2 3381 make_noreturn();
fe58e076 3382
7f4aaf91 3383 add_sym_3s ("atomic_define", GFC_ISYM_ATOMIC_DEF, CLASS_ATOMIC,
da661a58
TB		 3384 BT_UNKNOWN, 0, GFC_STD_F2008,
3385 gfc_check_atomic_def, NULL, gfc_resolve_atomic_def,
3386 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
7f4aaf91
TB		 3387 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3388 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
da661a58 3389
7f4aaf91 3390 add_sym_3s ("atomic_ref", GFC_ISYM_ATOMIC_REF, CLASS_ATOMIC,
da661a58
TB		 3391 BT_UNKNOWN, 0, GFC_STD_F2008,
3392 gfc_check_atomic_ref, NULL, gfc_resolve_atomic_ref,
3393 "value", BT_INTEGER, di, REQUIRED, INTENT_OUT,
7f4aaf91
TB		 3394 "atom", BT_INTEGER, di, REQUIRED, INTENT_IN,
3395 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3396
3397 add_sym_5s ("atomic_cas", GFC_ISYM_ATOMIC_CAS, CLASS_ATOMIC,
286f737c 3398 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3399 gfc_check_atomic_cas, NULL, NULL,
3400 "atom", BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3401 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3402 "compare", BT_INTEGER, di, REQUIRED, INTENT_IN,
3403 "new", BT_INTEGER, di, REQUIRED, INTENT_IN,
3404 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3405
3406 add_sym_3s ("atomic_add", GFC_ISYM_ATOMIC_ADD, CLASS_ATOMIC,
286f737c 3407 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3408 gfc_check_atomic_op, NULL, NULL,
3409 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3410 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3411 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3412
3413 add_sym_3s ("atomic_and", GFC_ISYM_ATOMIC_AND, CLASS_ATOMIC,
286f737c 3414 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3415 gfc_check_atomic_op, NULL, NULL,
3416 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3417 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3418 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3419
3420 add_sym_3s ("atomic_or", GFC_ISYM_ATOMIC_OR, CLASS_ATOMIC,
286f737c 3421 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3422 gfc_check_atomic_op, NULL, NULL,
3423 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3424 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3425 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3426
3427 add_sym_3s ("atomic_xor", GFC_ISYM_ATOMIC_XOR, CLASS_ATOMIC,
286f737c 3428 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3429 gfc_check_atomic_op, NULL, NULL,
3430 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3431 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3432 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3433
3434 add_sym_4s ("atomic_fetch_add", GFC_ISYM_ATOMIC_FETCH_ADD, CLASS_ATOMIC,
286f737c 3435 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3436 gfc_check_atomic_fetch_op, NULL, NULL,
3437 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3438 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3439 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3440 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3441
3442 add_sym_4s ("atomic_fetch_and", GFC_ISYM_ATOMIC_FETCH_AND, CLASS_ATOMIC,
286f737c 3443 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3444 gfc_check_atomic_fetch_op, NULL, NULL,
3445 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3446 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3447 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3448 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3449
3450 add_sym_4s ("atomic_fetch_or", GFC_ISYM_ATOMIC_FETCH_OR, CLASS_ATOMIC,
286f737c 3451 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3452 gfc_check_atomic_fetch_op, NULL, NULL,
3453 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3454 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3455 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3456 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3457
3458 add_sym_4s ("atomic_fetch_xor", GFC_ISYM_ATOMIC_FETCH_XOR, CLASS_ATOMIC,
286f737c 3459 BT_UNKNOWN, 0, GFC_STD_F2018,
7f4aaf91
TB		 3460 gfc_check_atomic_fetch_op, NULL, NULL,
3461 "atom", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3462 "value", BT_INTEGER, di, REQUIRED, INTENT_IN,
3463 "old", BT_INTEGER, di, REQUIRED, INTENT_OUT,
3464 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
da661a58 3465
f0f67c96
JW		 3466 add_sym_0s ("backtrace", GFC_ISYM_BACKTRACE, GFC_STD_GNU, NULL);
3467
1a14a58c
TB		 3468 add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
3469 GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
3470 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
6de9cd9a 3471
5df445a2 3472 add_sym_3s ("event_query", GFC_ISYM_EVENT_QUERY, CLASS_ATOMIC,
286f737c 3473 BT_UNKNOWN, 0, GFC_STD_F2018,
5df445a2
TB		 3474 gfc_check_event_query, NULL, gfc_resolve_event_query,
3475 "event", BT_INTEGER, di, REQUIRED, INTENT_IN,
3476 c, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3477 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
3478
f7b529fa 3479 /* More G77 compatibility garbage. */
e6c14898 3480 add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210 3481 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
1a14a58c
TB		 3482 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3483 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
12197210 3484
e6c14898 3485 add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210 3486 gfc_check_itime_idate, NULL, gfc_resolve_idate,
1a14a58c 3487 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
12197210 3488
e6c14898 3489 add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210 3490 gfc_check_itime_idate, NULL, gfc_resolve_itime,
1a14a58c 3491 vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
35059811 3492
e6c14898 3493 add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a119fc1c 3494 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
1a14a58c
TB		 3495 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3496 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
a119fc1c 3497
1a14a58c
TB		 3498 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN, 0,
3499 GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
3500 tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
3501 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
a119fc1c 3502
e6c14898
DK		 3503 add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
3504 GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
1a14a58c 3505 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
2bd74949 3506
e6c14898 3507 add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3508 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
1a14a58c
TB		 3509 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3510 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3511
e6c14898 3512 add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3513 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
1a14a58c
TB		 3514 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3515 md, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3516 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
a119fc1c 3517
e6c14898
DK		 3518 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
3519 0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
23e38561
JW		 3520 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3521 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3522 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3523 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 3524
f7b529fa 3525 /* More G77 compatibility garbage. */
e6c14898 3526 add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 3527 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
1a14a58c
TB		 3528 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
3529 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
2bd74949 3530
e6c14898 3531 add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 3532 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
1a14a58c
TB		 3533 vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
3534 tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
2bd74949 3535
c14c8155
FXC		 3536 add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
3537 CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
3538 NULL, NULL, gfc_resolve_execute_command_line,
3539 "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3540 "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
3541 "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
3542 "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3543 "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
3544
e6c14898 3545 add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3546 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
1a14a58c 3547 dt, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
35059811 3548
e6c14898
DK		 3549 add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
3550 0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
1a14a58c 3551 res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
f77b6ca3 3552
e6c14898
DK		 3553 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
3554 GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
1a14a58c
TB		 3555 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3556 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
a8c60d7f 3557
e6c14898
DK		 3558 add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
3559 0, GFC_STD_GNU, NULL, NULL, NULL,
1a14a58c
TB		 3560 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3561 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
aa6fc635 3562
e6c14898
DK		 3563 add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
3564 0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
1a14a58c
TB		 3565 pos, BT_INTEGER, di, REQUIRED, INTENT_IN,
3566 val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
a8c60d7f 3567
e6c14898
DK		 3568 add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
3569 0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
1a14a58c 3570 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
f77b6ca3 3571
b41b2534
JB		 3572 /* F2003 commandline routines. */
3573
1a14a58c
TB		 3574 add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
3575 BT_UNKNOWN, 0, GFC_STD_F2003,
3576 NULL, NULL, gfc_resolve_get_command,
3577 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3578 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3579 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
60c9a35b 3580
e6c14898
DK		 3581 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
3582 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
23e38561
JW		 3583 gfc_resolve_get_command_argument,
3584 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3585 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3586 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3587 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
aa6fc635 3588
f7b529fa 3589 /* F2003 subroutine to get environment variables. */
aa6fc635 3590
23e38561 3591 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
e6c14898 3592 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
b251af97 3593 NULL, NULL, gfc_resolve_get_environment_variable,
23e38561
JW		 3594 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3595 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
3596 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3597 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3598 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
3599
1a14a58c
TB		 3600 add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE, BT_UNKNOWN, 0,
3601 GFC_STD_F2003,
3602 gfc_check_move_alloc, NULL, NULL,
3603 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
3604 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
23e38561
JW		 3605
3606 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
5e229618 3607 GFC_STD_F95, gfc_check_mvbits, NULL, gfc_resolve_mvbits,
23e38561
JW		 3608 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
3609 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
3610 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
3611 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
3612 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
3613
c98583e9
FR		 3614 if (flag_dec_intrinsic_ints)
3615 {
3616 make_alias ("bmvbits", GFC_STD_GNU);
3617 make_alias ("imvbits", GFC_STD_GNU);
3618 make_alias ("jmvbits", GFC_STD_GNU);
3619 make_alias ("kmvbits", GFC_STD_GNU);
3620 }
3621
ddd3e26e
SK		 3622 add_sym_2s ("random_init", GFC_ISYM_RANDOM_INIT, CLASS_IMPURE,
3623 BT_UNKNOWN, 0, GFC_STD_F2018,
3624 gfc_check_random_init, NULL, gfc_resolve_random_init,
3625 "repeatable", BT_LOGICAL, dl, REQUIRED, INTENT_IN,
3626 "image_distinct", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
3627
1a14a58c
TB		 3628 add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
3629 BT_UNKNOWN, 0, GFC_STD_F95,
3630 gfc_check_random_number, NULL, gfc_resolve_random_number,
3631 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
23e38561 3632
1a14a58c
TB		 3633 add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
3634 BT_UNKNOWN, 0, GFC_STD_F95,
3635 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
3636 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3637 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3638 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 3639
cadddfdd
TB		 3640 /* The following subroutines are part of ISO_C_BINDING. */
3641
3642 add_sym_3s ("c_f_pointer", GFC_ISYM_C_F_POINTER, CLASS_IMPURE, BT_UNKNOWN, 0,
3643 GFC_STD_F2003, gfc_check_c_f_pointer, NULL, NULL,
3644 "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
3645 "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT,
3646 "shape", BT_INTEGER, di, OPTIONAL, INTENT_IN);
3647 make_from_module();
3648
3649 add_sym_2s ("c_f_procpointer", GFC_ISYM_C_F_PROCPOINTER, CLASS_IMPURE,
3650 BT_UNKNOWN, 0, GFC_STD_F2003, gfc_check_c_f_procpointer,
3651 NULL, NULL,
3652 "cptr", BT_VOID, 0, REQUIRED, INTENT_IN,
3653 "fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
3654 make_from_module();
3655
f1abbf69
TK		 3656 /* Internal subroutine for emitting a runtime error. */
3657
3658 add_sym_1p ("fe_runtime_error", GFC_ISYM_FE_RUNTIME_ERROR, CLASS_IMPURE,
3659 BT_UNKNOWN, 0, GFC_STD_GNU,
3660 gfc_check_fe_runtime_error, NULL, gfc_resolve_fe_runtime_error,
3661 "msg", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
3662
3663 make_noreturn ();
3664 make_vararg ();
3665 make_from_module ();
3666
d62cf3df 3667 /* Coarray collectives. */
a16ee379 3668 add_sym_4s ("co_broadcast", GFC_ISYM_CO_BROADCAST, CLASS_IMPURE,
286f737c 3669 BT_UNKNOWN, 0, GFC_STD_F2018,
a16ee379
TB		 3670 gfc_check_co_broadcast, NULL, NULL,
3671 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3672 "source_image", BT_INTEGER, di, REQUIRED, INTENT_IN,
3673 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3674 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
3675
d62cf3df 3676 add_sym_4s ("co_max", GFC_ISYM_CO_MAX, CLASS_IMPURE,
286f737c 3677 BT_UNKNOWN, 0, GFC_STD_F2018,
d62cf3df
TB		 3678 gfc_check_co_minmax, NULL, NULL,
3679 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3680 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3681 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3682 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
3683
3684 add_sym_4s ("co_min", GFC_ISYM_CO_MIN, CLASS_IMPURE,
286f737c 3685 BT_UNKNOWN, 0, GFC_STD_F2018,
d62cf3df
TB		 3686 gfc_check_co_minmax, NULL, NULL,
3687 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3688 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3689 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3690 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
3691
3692 add_sym_4s ("co_sum", GFC_ISYM_CO_SUM, CLASS_IMPURE,
286f737c 3693 BT_UNKNOWN, 0, GFC_STD_F2018,
d62cf3df
TB		 3694 gfc_check_co_sum, NULL, NULL,
3695 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3696 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3697 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3698 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
3699
a16ee379 3700 add_sym_5s ("co_reduce", GFC_ISYM_CO_REDUCE, CLASS_IMPURE,
286f737c 3701 BT_UNKNOWN, 0, GFC_STD_F2018,
a16ee379
TB		 3702 gfc_check_co_reduce, NULL, NULL,
3703 a, BT_REAL, dr, REQUIRED, INTENT_INOUT,
3704 "operator", BT_INTEGER, di, REQUIRED, INTENT_IN,
3705 result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN,
3706 stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3707 errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT);
3708
3709
8a8d1a16
TB		 3710 /* The following subroutine is internally used for coarray libray functions.
3711 "make_from_module" makes it inaccessible for external users. */
3712 add_sym_2s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
3713 BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL,
3714 "x", BT_REAL, dr, REQUIRED, INTENT_OUT,
3715 "y", BT_REAL, dr, REQUIRED, INTENT_IN);
3716 make_from_module();
3717
3718
f7b529fa 3719 /* More G77 compatibility garbage. */
e6c14898 3720 add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
185d7d97 3721 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
1a14a58c
TB		 3722 sec, BT_INTEGER, di, REQUIRED, INTENT_IN,
3723 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3724 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
185d7d97 3725
e6c14898
DK		 3726 add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
3727 di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
1a14a58c 3728 "seed", BT_INTEGER, 4, REQUIRED, INTENT_IN);
2bd74949 3729
e6c14898 3730 add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3731 gfc_check_exit, NULL, gfc_resolve_exit,
1a14a58c 3732 st, BT_INTEGER, di, OPTIONAL, INTENT_IN);
d8fe26b2 3733
3f2286f2 3734 make_noreturn();
fe58e076 3735
e6c14898 3736 add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3737 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
1a14a58c
TB		 3738 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3739 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3740 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3741
e6c14898 3742 add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3743 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
1a14a58c
TB		 3744 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3745 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3746
e6c14898 3747 add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 3748 gfc_check_flush, NULL, gfc_resolve_flush,
1a14a58c 3749 ut, BT_INTEGER, di, OPTIONAL, INTENT_IN);
df65f093 3750
e6c14898 3751 add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3752 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
1a14a58c
TB		 3753 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3754 c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3755 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3756
e6c14898 3757 add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3758 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
1a14a58c
TB		 3759 c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3760 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5d723e54 3761
e6c14898 3762 add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
8b40ca6a 3763 gfc_check_free, NULL, NULL,
1a14a58c 3764 ptr, BT_INTEGER, ii, REQUIRED, INTENT_INOUT);
0d519038 3765
e6c14898
DK		 3766 add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
3767 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
3768 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
23e38561 3769 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
e6c14898 3770 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
23e38561 3771 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
dcdc26df 3772
e6c14898 3773 add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54 3774 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
1a14a58c
TB		 3775 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3776 of, BT_INTEGER, ii, REQUIRED, INTENT_OUT);
5d723e54 3777
e6c14898
DK		 3778 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
3779 GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
1a14a58c
TB		 3780 c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
3781 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3782
1a14a58c 3783 add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
17164de4 3784 gfc_check_kill_sub, NULL, NULL,
fbe1f017
SK		 3785 pid, BT_INTEGER, di, REQUIRED, INTENT_IN,
3786 sig, BT_INTEGER, di, REQUIRED, INTENT_IN,
1a14a58c 3787 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3788
e6c14898 3789 add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3790 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
1a14a58c
TB		 3791 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3792 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3793 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3794
e6c14898
DK		 3795 add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
3796 0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
1a14a58c 3797 "string", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
f77b6ca3 3798
e6c14898
DK		 3799 add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
3800 GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
1a14a58c
TB		 3801 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3802 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3803 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3804
e6c14898 3805 add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3806 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
1a14a58c 3807 sec, BT_INTEGER, di, REQUIRED, INTENT_IN);
f77b6ca3 3808
e6c14898 3809 add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 3810 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
1a14a58c
TB		 3811 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3812 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3813 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
df65f093 3814
e6c14898 3815 add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
bf3fb7e4 3816 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
1a14a58c
TB		 3817 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3818 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3819 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
bf3fb7e4 3820
e6c14898 3821 add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 3822 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
1a14a58c
TB		 3823 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3824 vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
3825 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
df65f093 3826
e6c14898
DK		 3827 add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
3828 GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
1a14a58c
TB		 3829 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
3830 han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
3831 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
185d7d97 3832
e6c14898
DK		 3833 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3834 GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
1a14a58c
TB		 3835 p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3836 p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3837 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
f77b6ca3 3838
e6c14898
DK		 3839 add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
3840 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
1a14a58c
TB		 3841 com, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3842 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
5b1374e9 3843
1a14a58c
TB		 3844 add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
3845 BT_UNKNOWN, 0, GFC_STD_F95,
3846 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
3847 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3848 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
3849 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
d8fe26b2 3850
e6c14898
DK		 3851 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
3852 GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
1a14a58c
TB		 3853 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
3854 name, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
ae8b8789 3855
e6c14898 3856 add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 3857 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
1a14a58c
TB		 3858 msk, BT_INTEGER, di, REQUIRED, INTENT_IN,
3859 old, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
d8fe26b2 3860
e6c14898
DK		 3861 add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
3862 GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
1a14a58c
TB		 3863 "path", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
3864 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a
DN		 3865}
3866
3867
3868/* Add a function to the list of conversion symbols. */
3869
3870static void
c3a29423 3871add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
6de9cd9a 3872{
6de9cd9a
DN		 3873 gfc_typespec from, to;
3874 gfc_intrinsic_sym *sym;
3875
3876 if (sizing == SZ_CONVS)
3877 {
3878 nconv++;
3879 return;
3880 }
3881
3882 gfc_clear_ts (&from);
3883 from.type = from_type;
3884 from.kind = from_kind;
3885
3886 gfc_clear_ts (&to);
3887 to.type = to_type;
3888 to.kind = to_kind;
3889
3890 sym = conversion + nconv;
3891
c3a29423 3892 sym->name = conv_name (&from, &to);
cb9e4f55 3893 sym->lib_name = sym->name;
c3a29423
RS		 3894 sym->simplify.cc = gfc_convert_constant;
3895 sym->standard = standard;
6de9cd9a 3896 sym->elemental = 1;
124a8ce6 3897 sym->pure = 1;
e1633d82 3898 sym->conversion = 1;
6de9cd9a 3899 sym->ts = to;
cd5ecab6 3900 sym->id = GFC_ISYM_CONVERSION;
6de9cd9a
DN		 3901
3902 nconv++;
3903}
3904
3905
3906/* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3907 functions by looping over the kind tables. */
3908
3909static void
3910add_conversions (void)
3911{
3912 int i, j;
3913
3914 /* Integer-Integer conversions. */
3915 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3916 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
3917 {
3918 if (i == j)
3919 continue;
3920
3921 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3922 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3923 }
3924
3925 /* Integer-Real/Complex conversions. */
3926 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3927 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3928 {
3929 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3930 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3931
3932 add_conv (BT_REAL, gfc_real_kinds[j].kind,
c3a29423 3933 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN		 3934
3935 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3936 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3937
3938 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
c3a29423 3939 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN		 3940 }
3941
d3642f89
FW		 3942 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3943 {
3944 /* Hollerith-Integer conversions. */
3945 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3946 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3947 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3948 /* Hollerith-Real conversions. */
3949 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3950 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3951 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3952 /* Hollerith-Complex conversions. */
3953 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3954 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3955 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3956
3957 /* Hollerith-Character conversions. */
3958 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3959 gfc_default_character_kind, GFC_STD_LEGACY);
3960
3961 /* Hollerith-Logical conversions. */
3962 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3963 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3964 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3965 }
3966
6de9cd9a
DN		 3967 /* Real/Complex - Real/Complex conversions. */
3968 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3969 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3970 {
3971 if (i != j)
3972 {
3973 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 3974 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3975
3976 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 3977 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3978 }
3979
3980 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 3981 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3982
3983 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 3984 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3985 }
3986
3987 /* Logical/Logical kind conversion. */
3988 for (i = 0; gfc_logical_kinds[i].kind; i++)
3989 for (j = 0; gfc_logical_kinds[j].kind; j++)
3990 {
3991 if (i == j)
3992 continue;
3993
3994 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
c3a29423 3995 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
6de9cd9a 3996 }
c3a29423
RS		 3997
3998 /* Integer-Logical and Logical-Integer conversions. */
3999 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
4000 for (i=0; gfc_integer_kinds[i].kind; i++)
4001 for (j=0; gfc_logical_kinds[j].kind; j++)
4002 {
4003 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
4004 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
4005 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
4006 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
4007 }
6de9cd9a
DN		 4008}
4009
4010
d393bbd7
FXC		 4011static void
4012add_char_conversions (void)
4013{
4014 int n, i, j;
4015
4016 /* Count possible conversions. */
4017 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
4018 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
4019 if (i != j)
4020 ncharconv++;
4021
4022 /* Allocate memory. */
ece3f663 4023 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
d393bbd7
FXC		 4024
4025 /* Add the conversions themselves. */
4026 n = 0;
4027 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
4028 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
4029 {
4030 gfc_typespec from, to;
4031
4032 if (i == j)
4033 continue;
4034
4035 gfc_clear_ts (&from);
4036 from.type = BT_CHARACTER;
4037 from.kind = gfc_character_kinds[i].kind;
4038
4039 gfc_clear_ts (&to);
4040 to.type = BT_CHARACTER;
4041 to.kind = gfc_character_kinds[j].kind;
4042
4043 char_conversions[n].name = conv_name (&from, &to);
4044 char_conversions[n].lib_name = char_conversions[n].name;
4045 char_conversions[n].simplify.cc = gfc_convert_char_constant;
4046 char_conversions[n].standard = GFC_STD_F2003;
4047 char_conversions[n].elemental = 1;
124a8ce6 4048 char_conversions[n].pure = 1;
d393bbd7
FXC		 4049 char_conversions[n].conversion = 0;
4050 char_conversions[n].ts = to;
4051 char_conversions[n].id = GFC_ISYM_CONVERSION;
4052
4053 n++;
4054 }
4055}
4056
4057
6de9cd9a
DN		 4058/* Initialize the table of intrinsics. */
4059void
4060gfc_intrinsic_init_1 (void)
4061{
6de9cd9a
DN		 4062 nargs = nfunc = nsub = nconv = 0;
4063
4064 /* Create a namespace to hold the resolved intrinsic symbols. */
0366dfe9 4065 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
6de9cd9a
DN		 4066
4067 sizing = SZ_FUNCS;
4068 add_functions ();
4069 sizing = SZ_SUBS;
4070 add_subroutines ();
4071 sizing = SZ_CONVS;
4072 add_conversions ();
4073
ece3f663
KG		 4074 functions = XCNEWVAR (struct gfc_intrinsic_sym,
4075 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
4076 + sizeof (gfc_intrinsic_arg) * nargs);
6de9cd9a
DN		 4077
4078 next_sym = functions;
4079 subroutines = functions + nfunc;
4080
ece3f663 4081 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
6de9cd9a
DN		 4082
4083 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
4084
4085 sizing = SZ_NOTHING;
4086 nconv = 0;
4087
4088 add_functions ();
4089 add_subroutines ();
4090 add_conversions ();
4091
d393bbd7
FXC		 4092 /* Character conversion intrinsics need to be treated separately. */
4093 add_char_conversions ();
6de9cd9a
DN		 4094}
4095
4096
4097void
4098gfc_intrinsic_done_1 (void)
4099{
cede9502
JM		 4100 free (functions);
4101 free (conversion);
4102 free (char_conversions);
6de9cd9a
DN		 4103 gfc_free_namespace (gfc_intrinsic_namespace);
4104}
4105
4106
4107/******** Subroutines to check intrinsic interfaces ***********/
4108
4109/* Given a formal argument list, remove any NULL arguments that may
4110 have been left behind by a sort against some formal argument list. */
4111
4112static void
b251af97 4113remove_nullargs (gfc_actual_arglist **ap)
6de9cd9a
DN		 4114{
4115 gfc_actual_arglist *head, *tail, *next;
4116
4117 tail = NULL;
4118
4119 for (head = *ap; head; head = next)
4120 {
4121 next = head->next;
4122
c5bfb045 4123 if (head->expr == NULL && !head->label)
6de9cd9a
DN		 4124 {
4125 head->next = NULL;
4126 gfc_free_actual_arglist (head);
4127 }
4128 else
4129 {
4130 if (tail == NULL)
4131 *ap = head;
4132 else
4133 tail->next = head;
4134
4135 tail = head;
4136 tail->next = NULL;
4137 }
4138 }
4139
4140 if (tail == NULL)
4141 *ap = NULL;
4142}
4143
4144
4145/* Given an actual arglist and a formal arglist, sort the actual
4146 arglist so that its arguments are in a one-to-one correspondence
4147 with the format arglist. Arguments that are not present are given
4148 a blank gfc_actual_arglist structure. If something is obviously
4149 wrong (say, a missing required argument) we abort sorting and
524af0d6 4150 return false. */
6de9cd9a 4151
524af0d6 4152static bool
b251af97
SK		 4153sort_actual (const char *name, gfc_actual_arglist **ap,
4154 gfc_intrinsic_arg *formal, locus *where)
6de9cd9a 4155{
6de9cd9a
DN		 4156 gfc_actual_arglist *actual, *a;
4157 gfc_intrinsic_arg *f;
4158
4159 remove_nullargs (ap);
4160 actual = *ap;
4161
4162 for (f = formal; f; f = f->next)
4163 f->actual = NULL;
4164
4165 f = formal;
4166 a = actual;
4167
4168 if (f == NULL && a == NULL) /* No arguments */
524af0d6 4169 return true;
6de9cd9a
DN		 4170
4171 for (;;)
b251af97 4172 { /* Put the nonkeyword arguments in a 1:1 correspondence */
6de9cd9a
DN		 4173 if (f == NULL)
4174 break;
4175 if (a == NULL)
4176 goto optional;
4177
cb9e4f55 4178 if (a->name != NULL)
6de9cd9a
DN		 4179 goto keywords;
4180
4181 f->actual = a;
4182
4183 f = f->next;
4184 a = a->next;
4185 }
4186
4187 if (a == NULL)
4188 goto do_sort;
4189
c4100eae 4190 gfc_error ("Too many arguments in call to %qs at %L", name, where);
524af0d6 4191 return false;
6de9cd9a
DN		 4192
4193keywords:
4194 /* Associate the remaining actual arguments, all of which have
4195 to be keyword arguments. */
4196 for (; a; a = a->next)
4197 {
4198 for (f = formal; f; f = f->next)
4199 if (strcmp (a->name, f->name) == 0)
4200 break;
4201
4202 if (f == NULL)
4203 {
7fcafa71 4204 if (a->name[0] == '%')
29ea08da
TB		 4205 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
4206 "are not allowed in this context at %L", where);
7fcafa71 4207 else
c4100eae 4208 gfc_error ("Can't find keyword named %qs in call to %qs at %L",
b251af97 4209 a->name, name, where);
524af0d6 4210 return false;
6de9cd9a
DN		 4211 }
4212
4213 if (f->actual != NULL)
4214 {
c4100eae 4215 gfc_error ("Argument %qs appears twice in call to %qs at %L",
6de9cd9a 4216 f->name, name, where);
524af0d6 4217 return false;
6de9cd9a
DN		 4218 }
4219
4220 f->actual = a;
4221 }
4222
4223optional:
4224 /* At this point, all unmatched formal args must be optional. */
4225 for (f = formal; f; f = f->next)
4226 {
4227 if (f->actual == NULL && f->optional == 0)
4228 {
c4100eae 4229 gfc_error ("Missing actual argument %qs in call to %qs at %L",
6de9cd9a 4230 f->name, name, where);
524af0d6 4231 return false;
6de9cd9a
DN		 4232 }
4233 }
4234
4235do_sort:
4236 /* Using the formal argument list, string the actual argument list
4237 together in a way that corresponds with the formal list. */
4238 actual = NULL;
4239
4240 for (f = formal; f; f = f->next)
4241 {
c5bfb045
PT		 4242 if (f->actual && f->actual->label != NULL && f->ts.type)
4243 {
4244 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
524af0d6 4245 return false;
c5bfb045
PT		 4246 }
4247
f9fed73b
TS		 4248 if (f->actual == NULL)
4249 {
4250 a = gfc_get_actual_arglist ();
4251 a->missing_arg_type = f->ts.type;
4252 }
4253 else
4254 a = f->actual;
6de9cd9a
DN		 4255
4256 if (actual == NULL)
4257 *ap = a;
4258 else
4259 actual->next = a;
4260
4261 actual = a;
4262 }
f7b529fa 4263 actual->next = NULL; /* End the sorted argument list. */
6de9cd9a 4264
524af0d6 4265 return true;
6de9cd9a
DN		 4266}
4267
4268
4269/* Compare an actual argument list with an intrinsic's formal argument
4270 list. The lists are checked for agreement of type. We don't check
4271 for arrayness here. */
4272
524af0d6 4273static bool
b251af97 4274check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
6de9cd9a
DN		 4275 int error_flag)
4276{
4277 gfc_actual_arglist *actual;
4278 gfc_intrinsic_arg *formal;
4279 int i;
4280
4281 formal = sym->formal;
4282 actual = *ap;
4283
4284 i = 0;
4285 for (; formal; formal = formal->next, actual = actual->next, i++)
4286 {
d393bbd7
FXC		 4287 gfc_typespec ts;
4288
6de9cd9a
DN		 4289 if (actual->expr == NULL)
4290 continue;
4291
d393bbd7
FXC		 4292 ts = formal->ts;
4293
4294 /* A kind of 0 means we don't check for kind. */
4295 if (ts.kind == 0)
4296 ts.kind = actual->expr->ts.kind;
4297
4298 if (!gfc_compare_types (&ts, &actual->expr->ts))
6de9cd9a
DN		 4299 {
4300 if (error_flag)
c4100eae 4301 gfc_error ("Type of argument %qs in call to %qs at %L should "
c4aa95f8 4302 "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
b251af97
SK		 4303 gfc_current_intrinsic, &actual->expr->where,
4304 gfc_typename (&formal->ts),
4305 gfc_typename (&actual->expr->ts));
524af0d6 4306 return false;
6de9cd9a 4307 }
8c91ab34
DK		 4308
4309 /* If the formal argument is INTENT([IN]OUT), check for definability. */
4310 if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
4311 {
4312 const char* context = (error_flag
4313 ? _("actual argument to INTENT = OUT/INOUT")
4314 : NULL);
4315
4316 /* No pointer arguments for intrinsics. */
524af0d6
JB		 4317 if (!gfc_check_vardef_context (actual->expr, false, false, false, context))
4318 return false;
8c91ab34 4319 }
6de9cd9a
DN		 4320 }
4321
524af0d6 4322 return true;
6de9cd9a
DN		 4323}
4324
4325
4326/* Given a pointer to an intrinsic symbol and an expression node that
4327 represent the function call to that subroutine, figure out the type
4328 of the result. This may involve calling a resolution subroutine. */
4329
4330static void
b251af97 4331resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a 4332{
01ce9e31 4333 gfc_expr *a1, *a2, *a3, *a4, *a5, *a6;
6de9cd9a
DN		 4334 gfc_actual_arglist *arg;
4335
4336 if (specific->resolve.f1 == NULL)
4337 {
4338 if (e->value.function.name == NULL)
4339 e->value.function.name = specific->lib_name;
4340
4341 if (e->ts.type == BT_UNKNOWN)
4342 e->ts = specific->ts;
4343 return;
4344 }
4345
4346 arg = e->value.function.actual;
4347
6de9cd9a
DN		 4348 /* Special case hacks for MIN and MAX. */
4349 if (specific->resolve.f1m == gfc_resolve_max
4350 || specific->resolve.f1m == gfc_resolve_min)
4351 {
4352 (*specific->resolve.f1m) (e, arg);
4353 return;
4354 }
4355
4c0c6b9f
SK		 4356 if (arg == NULL)
4357 {
4358 (*specific->resolve.f0) (e);
4359 return;
4360 }
4361
6de9cd9a
DN		 4362 a1 = arg->expr;
4363 arg = arg->next;
4364
4365 if (arg == NULL)
4366 {
4367 (*specific->resolve.f1) (e, a1);
4368 return;
4369 }
4370
4371 a2 = arg->expr;
4372 arg = arg->next;
4373
4374 if (arg == NULL)
4375 {
4376 (*specific->resolve.f2) (e, a1, a2);
4377 return;
4378 }
4379
4380 a3 = arg->expr;
4381 arg = arg->next;
4382
4383 if (arg == NULL)
4384 {
4385 (*specific->resolve.f3) (e, a1, a2, a3);
4386 return;
4387 }
4388
4389 a4 = arg->expr;
4390 arg = arg->next;
4391
4392 if (arg == NULL)
4393 {
4394 (*specific->resolve.f4) (e, a1, a2, a3, a4);
4395 return;
4396 }
4397
4398 a5 = arg->expr;
4399 arg = arg->next;
4400
4401 if (arg == NULL)
4402 {
4403 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
4404 return;
4405 }
4406
01ce9e31
TK		 4407 a6 = arg->expr;
4408 arg = arg->next;
4409
4410 if (arg == NULL)
4411 {
4412 (*specific->resolve.f6) (e, a1, a2, a3, a4, a5, a6);
4413 return;
4414 }
4415
6de9cd9a
DN		 4416 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
4417}
4418
4419
4420/* Given an intrinsic symbol node and an expression node, call the
4421 simplification function (if there is one), perhaps replacing the
524af0d6
JB		 4422 expression with something simpler. We return false on an error
4423 of the simplification, true if the simplification worked, even
6de9cd9a
DN		 4424 if nothing has changed in the expression itself. */
4425
524af0d6 4426static bool
b251af97 4427do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a 4428{
01ce9e31 4429 gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
6de9cd9a
DN		 4430 gfc_actual_arglist *arg;
4431
4432 /* Max and min require special handling due to the variable number
4433 of args. */
4434 if (specific->simplify.f1 == gfc_simplify_min)
4435 {
4436 result = gfc_simplify_min (e);
4437 goto finish;
4438 }
4439
4440 if (specific->simplify.f1 == gfc_simplify_max)
4441 {
4442 result = gfc_simplify_max (e);
4443 goto finish;
4444 }
4445
8e8c2744
FR		 4446 /* Some math intrinsics need to wrap the original expression. */
4447 if (specific->simplify.f1 == gfc_simplify_trigd
4448 || specific->simplify.f1 == gfc_simplify_atrigd
4449 || specific->simplify.f1 == gfc_simplify_cotan)
4450 {
4451 result = (*specific->simplify.f1) (e);
4452 goto finish;
4453 }
4454
6de9cd9a
DN		 4455 if (specific->simplify.f1 == NULL)
4456 {
4457 result = NULL;
4458 goto finish;
4459 }
4460
4461 arg = e->value.function.actual;
4462
4c0c6b9f
SK		 4463 if (arg == NULL)
4464 {
4465 result = (*specific->simplify.f0) ();
4466 goto finish;
4467 }
4468
6de9cd9a
DN		 4469 a1 = arg->expr;
4470 arg = arg->next;
4471
d393bbd7
FXC		 4472 if (specific->simplify.cc == gfc_convert_constant
4473 || specific->simplify.cc == gfc_convert_char_constant)
6de9cd9a 4474 {
d393bbd7 4475 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
6de9cd9a
DN		 4476 goto finish;
4477 }
4478
6de9cd9a
DN		 4479 if (arg == NULL)
4480 result = (*specific->simplify.f1) (a1);
4481 else
4482 {
4483 a2 = arg->expr;
4484 arg = arg->next;
4485
4486 if (arg == NULL)
4487 result = (*specific->simplify.f2) (a1, a2);
4488 else
4489 {
4490 a3 = arg->expr;
4491 arg = arg->next;
4492
4493 if (arg == NULL)
4494 result = (*specific->simplify.f3) (a1, a2, a3);
4495 else
4496 {
4497 a4 = arg->expr;
4498 arg = arg->next;
4499
4500 if (arg == NULL)
4501 result = (*specific->simplify.f4) (a1, a2, a3, a4);
4502 else
4503 {
4504 a5 = arg->expr;
4505 arg = arg->next;
4506
4507 if (arg == NULL)
4508 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
4509 else
01ce9e31
TK		 4510 {
4511 a6 = arg->expr;
4512 arg = arg->next;
4513
4514 if (arg == NULL)
4515 result = (*specific->simplify.f6)
4516 (a1, a2, a3, a4, a5, a6);
4517 else
4518 gfc_internal_error
4519 ("do_simplify(): Too many args for intrinsic");
4520 }
6de9cd9a
DN		 4521 }
4522 }
4523 }
4524 }
4525
4526finish:
4527 if (result == &gfc_bad_expr)
524af0d6 4528 return false;
6de9cd9a
DN		 4529
4530 if (result == NULL)
4531 resolve_intrinsic (specific, e); /* Must call at run-time */
4532 else
4533 {
4534 result->where = e->where;
4535 gfc_replace_expr (e, result);
4536 }
4537
524af0d6 4538 return true;
6de9cd9a
DN		 4539}
4540
4541
4542/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
524af0d6 4543 error messages. This subroutine returns false if a subroutine
6de9cd9a
DN		 4544 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
4545 list cannot match any intrinsic. */
4546
4547static void
b251af97 4548init_arglist (gfc_intrinsic_sym *isym)
6de9cd9a
DN		 4549{
4550 gfc_intrinsic_arg *formal;
4551 int i;
4552
4553 gfc_current_intrinsic = isym->name;
4554
4555 i = 0;
4556 for (formal = isym->formal; formal; formal = formal->next)
4557 {
4558 if (i >= MAX_INTRINSIC_ARGS)
4559 gfc_internal_error ("init_arglist(): too many arguments");
c4aa95f8 4560 gfc_current_intrinsic_arg[i++] = formal;
6de9cd9a
DN		 4561 }
4562}
4563
4564
4565/* Given a pointer to an intrinsic symbol and an expression consisting
4566 of a function call, see if the function call is consistent with the
524af0d6
JB		 4567 intrinsic's formal argument list. Return true if the expression
4568 and intrinsic match, false otherwise. */
6de9cd9a 4569
524af0d6 4570static bool
b251af97 4571check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
6de9cd9a
DN		 4572{
4573 gfc_actual_arglist *arg, **ap;
524af0d6 4574 bool t;
6de9cd9a
DN		 4575
4576 ap = &expr->value.function.actual;
4577
4578 init_arglist (specific);
4579
4580 /* Don't attempt to sort the argument list for min or max. */
4581 if (specific->check.f1m == gfc_check_min_max
4582 || specific->check.f1m == gfc_check_min_max_integer
4583 || specific->check.f1m == gfc_check_min_max_real
4584 || specific->check.f1m == gfc_check_min_max_double)
bf7a73f9
TB		 4585 {
4586 if (!do_ts29113_check (specific, *ap))
4587 return false;
4588 return (*specific->check.f1m) (*ap);
4589 }
6de9cd9a 4590
524af0d6
JB		 4591 if (!sort_actual (specific->name, ap, specific->formal, &expr->where))
4592 return false;
6de9cd9a 4593
bf7a73f9
TB		 4594 if (!do_ts29113_check (specific, *ap))
4595 return false;
4596
64b1806b 4597 if (specific->check.f5ml == gfc_check_minloc_maxloc)
b251af97 4598 /* This is special because we might have to reorder the argument list. */
7551270e 4599 t = gfc_check_minloc_maxloc (*ap);
01ce9e31
TK		 4600 else if (specific->check.f6fl == gfc_check_findloc)
4601 t = gfc_check_findloc (*ap);
617097a3 4602 else if (specific->check.f3red == gfc_check_minval_maxval)
7551270e
ES		 4603 /* This is also special because we also might have to reorder the
4604 argument list. */
617097a3
TS		 4605 t = gfc_check_minval_maxval (*ap);
4606 else if (specific->check.f3red == gfc_check_product_sum)
4607 /* Same here. The difference to the previous case is that we allow a
4608 general numeric type. */
4609 t = gfc_check_product_sum (*ap);
195a95c4
TB		 4610 else if (specific->check.f3red == gfc_check_transf_bit_intrins)
4611 /* Same as for PRODUCT and SUM, but different checks. */
4612 t = gfc_check_transf_bit_intrins (*ap);
7551270e 4613 else
f3207b37
TS		 4614 {
4615 if (specific->check.f1 == NULL)
4616 {
4617 t = check_arglist (ap, specific, error_flag);
524af0d6 4618 if (t)
f3207b37
TS		 4619 expr->ts = specific->ts;
4620 }
4621 else
4622 t = do_check (specific, *ap);
4623 }
6de9cd9a 4624
0881653c 4625 /* Check conformance of elemental intrinsics. */
524af0d6 4626 if (t && specific->elemental)
6de9cd9a 4627 {
0881653c
DF		 4628 int n = 0;
4629 gfc_expr *first_expr;
4630 arg = expr->value.function.actual;
6de9cd9a 4631
0881653c
DF		 4632 /* There is no elemental intrinsic without arguments. */
4633 gcc_assert(arg != NULL);
4634 first_expr = arg->expr;
4635
4636 for ( ; arg && arg->expr; arg = arg->next, n++)
f8862a1b 4637 if (!gfc_check_conformance (first_expr, arg->expr,
524af0d6 4638 "arguments '%s' and '%s' for "
f8862a1b
DR		 4639 "intrinsic '%s'",
4640 gfc_current_intrinsic_arg[0]->name,
4641 gfc_current_intrinsic_arg[n]->name,
524af0d6
JB		 4642 gfc_current_intrinsic))
4643 return false;
6de9cd9a
DN		 4644 }
4645
524af0d6 4646 if (!t)
6de9cd9a
DN		 4647 remove_nullargs (ap);
4648
4649 return t;
4650}
4651
4652
b7892582 4653/* Check whether an intrinsic belongs to whatever standard the user
c3005b0f
DK		 4654 has chosen, taking also into account -fall-intrinsics. Here, no
4655 warning/error is emitted; but if symstd is not NULL, it is pointed to a
4656 textual representation of the symbols standard status (like
4657 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
4658 can be used to construct a detailed warning/error message in case of
524af0d6 4659 a false. */
b7892582 4660
524af0d6 4661bool
c3005b0f
DK		 4662gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
4663 const char** symstd, bool silent, locus where)
b7892582 4664{
c3005b0f
DK		 4665 const char* symstd_msg;
4666
4667 /* For -fall-intrinsics, just succeed. */
c61819ff 4668 if (flag_all_intrinsics)
524af0d6 4669 return true;
b7892582 4670
c3005b0f
DK		 4671 /* Find the symbol's standard message for later usage. */
4672 switch (isym->standard)
4673 {
4674 case GFC_STD_F77:
4675 symstd_msg = "available since Fortran 77";
4676 break;
3f2286f2 4677
c3005b0f
DK		 4678 case GFC_STD_F95_OBS:
4679 symstd_msg = "obsolescent in Fortran 95";
4680 break;
4681
4682 case GFC_STD_F95_DEL:
4683 symstd_msg = "deleted in Fortran 95";
4684 break;
4685
4686 case GFC_STD_F95:
4687 symstd_msg = "new in Fortran 95";
4688 break;
4689
4690 case GFC_STD_F2003:
4691 symstd_msg = "new in Fortran 2003";
4692 break;
4693
4694 case GFC_STD_F2008:
4695 symstd_msg = "new in Fortran 2008";
4696 break;
4697
286f737c
JW		 4698 case GFC_STD_F2018:
4699 symstd_msg = "new in Fortran 2018";
2514987f
TB		 4700 break;
4701
c3005b0f
DK		 4702 case GFC_STD_GNU:
4703 symstd_msg = "a GNU Fortran extension";
4704 break;
4705
4706 case GFC_STD_LEGACY:
4707 symstd_msg = "for backward compatibility";
4708 break;
4709
4710 default:
17d5d49f 4711 gfc_internal_error ("Invalid standard code on intrinsic %qs (%d)",
c3005b0f
DK		 4712 isym->name, isym->standard);
4713 }
4714
4715 /* If warning about the standard, warn and succeed. */
4716 if (gfc_option.warn_std & isym->standard)
4717 {
4718 /* Do only print a warning if not a GNU extension. */
4719 if (!silent && isym->standard != GFC_STD_GNU)
db30e21c 4720 gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
c3005b0f
DK		 4721 isym->name, _(symstd_msg), &where);
4722
524af0d6 4723 return true;
c3005b0f
DK		 4724 }
4725
4726 /* If allowing the symbol's standard, succeed, too. */
4727 if (gfc_option.allow_std & isym->standard)
524af0d6 4728 return true;
c3005b0f
DK		 4729
4730 /* Otherwise, fail. */
4731 if (symstd)
4732 *symstd = _(symstd_msg);
524af0d6 4733 return false;
b7892582
JB		 4734}
4735
4736
6de9cd9a
DN		 4737/* See if a function call corresponds to an intrinsic function call.
4738 We return:
4739
4740 MATCH_YES if the call corresponds to an intrinsic, simplification
b251af97 4741 is done if possible.
6de9cd9a
DN		 4742
4743 MATCH_NO if the call does not correspond to an intrinsic
4744
4745 MATCH_ERROR if the call corresponds to an intrinsic but there was an
b251af97 4746 error during the simplification process.
6de9cd9a
DN		 4747
4748 The error_flag parameter enables an error reporting. */
4749
4750match
b251af97 4751gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
6de9cd9a
DN		 4752{
4753 gfc_intrinsic_sym *isym, *specific;
4754 gfc_actual_arglist *actual;
4755 const char *name;
4756 int flag;
4757
4758 if (expr->value.function.isym != NULL)
524af0d6 4759 return (!do_simplify(expr->value.function.isym, expr))
b251af97 4760 ? MATCH_ERROR : MATCH_YES;
6de9cd9a 4761
a3d3c0f5
DK		 4762 if (!error_flag)
4763 gfc_push_suppress_errors ();
6de9cd9a
DN		 4764 flag = 0;
4765
4766 for (actual = expr->value.function.actual; actual; actual = actual->next)
4767 if (actual->expr != NULL)
4768 flag |= (actual->expr->ts.type != BT_INTEGER
4769 && actual->expr->ts.type != BT_CHARACTER);
4770
4771 name = expr->symtree->n.sym->name;
4772
d000aa67
TB		 4773 if (expr->symtree->n.sym->intmod_sym_id)
4774 {
cadddfdd
TB		 4775 gfc_isym_id id = gfc_isym_id_by_intmod_sym (expr->symtree->n.sym);
4776 isym = specific = gfc_intrinsic_function_by_id (id);
d000aa67
TB		 4777 }
4778 else
4779 isym = specific = gfc_find_function (name);
4780
6de9cd9a
DN		 4781 if (isym == NULL)
4782 {
a3d3c0f5
DK		 4783 if (!error_flag)
4784 gfc_pop_suppress_errors ();
6de9cd9a
DN		 4785 return MATCH_NO;
4786 }
4787
b7970354
TB		 4788 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
4789 || isym->id == GFC_ISYM_CMPLX)
f2cbd86c 4790 && gfc_init_expr_flag
a4d9b221 4791 && !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
524af0d6 4792 "expression at %L", name, &expr->where))
a3d3c0f5
DK		 4793 {
4794 if (!error_flag)
4795 gfc_pop_suppress_errors ();
4796 return MATCH_ERROR;
4797 }
b7970354 4798
4bb91707
TK		 4799 /* F95, 7.1.6.1: Only transformational functions REPEAT, RESHAPE,
4800 SELECTED_INT_KIND, SELECTED_REAL_KIND, TRANSFER, and TRIM are allowed in
4801 initialization expressions. */
4802
4803 if (gfc_init_expr_flag && isym->transformational)
4804 {
4805 gfc_isym_id id = isym->id;
4806 if (id != GFC_ISYM_REPEAT && id != GFC_ISYM_RESHAPE
4807 && id != GFC_ISYM_SI_KIND && id != GFC_ISYM_SR_KIND
4808 && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
4809 && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
4810 "at %L is invalid in an initialization "
4811 "expression", name, &expr->where))
4812 {
4813 if (!error_flag)
4814 gfc_pop_suppress_errors ();
4815
4816 return MATCH_ERROR;
4817 }
4818 }
4819
6de9cd9a
DN		 4820 gfc_current_intrinsic_where = &expr->where;
4821
cadddfdd 4822 /* Bypass the generic list for min, max and ISO_C_Binding's c_loc. */
6de9cd9a
DN		 4823 if (isym->check.f1m == gfc_check_min_max)
4824 {
4825 init_arglist (isym);
4826
524af0d6 4827 if (isym->check.f1m(expr->value.function.actual))
6de9cd9a
DN		 4828 goto got_specific;
4829
a3d3c0f5
DK		 4830 if (!error_flag)
4831 gfc_pop_suppress_errors ();
6de9cd9a
DN		 4832 return MATCH_NO;
4833 }
4834
4835 /* If the function is generic, check all of its specific
4836 incarnations. If the generic name is also a specific, we check
4837 that name last, so that any error message will correspond to the
4838 specific. */
a3d3c0f5 4839 gfc_push_suppress_errors ();
6de9cd9a
DN		 4840
4841 if (isym->generic)
4842 {
4843 for (specific = isym->specific_head; specific;
4844 specific = specific->next)
4845 {
4846 if (specific == isym)
4847 continue;
524af0d6 4848 if (check_specific (specific, expr, 0))
a3d3c0f5
DK		 4849 {
4850 gfc_pop_suppress_errors ();
4851 goto got_specific;
4852 }
6de9cd9a
DN		 4853 }
4854 }
4855
a3d3c0f5 4856 gfc_pop_suppress_errors ();
6de9cd9a 4857
524af0d6 4858 if (!check_specific (isym, expr, error_flag))
6de9cd9a 4859 {
a3d3c0f5
DK		 4860 if (!error_flag)
4861 gfc_pop_suppress_errors ();
6de9cd9a
DN		 4862 return MATCH_NO;
4863 }
4864
4865 specific = isym;
4866
4867got_specific:
4868 expr->value.function.isym = specific;
326785a3
TB		 4869 if (!expr->symtree->n.sym->module)
4870 gfc_intrinsic_symbol (expr->symtree->n.sym);
6de9cd9a 4871
a3d3c0f5
DK		 4872 if (!error_flag)
4873 gfc_pop_suppress_errors ();
4874
524af0d6 4875 if (!do_simplify (specific, expr))
14ceeb32 4876 return MATCH_ERROR;
6de9cd9a 4877
e1633d82
DF		 4878 /* F95, 7.1.6.1, Initialization expressions
4879 (4) An elemental intrinsic function reference of type integer or
4880 character where each argument is an initialization expression
4881 of type integer or character
4882
4883 F2003, 7.1.7 Initialization expression
4884 (4) A reference to an elemental standard intrinsic function,
4885 where each argument is an initialization expression */
4886
f2cbd86c 4887 if (gfc_init_expr_flag && isym->elemental && flag
524af0d6
JB		 4888 && !gfc_notify_std (GFC_STD_F2003, "Elemental function as "
4889 "initialization expression with non-integer/non-"
4890 "character arguments at %L", &expr->where))
e1633d82 4891 return MATCH_ERROR;
6de9cd9a
DN		 4892
4893 return MATCH_YES;
4894}
4895
4896
4897/* See if a CALL statement corresponds to an intrinsic subroutine.
4898 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
4899 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
4900 correspond). */
4901
4902match
b251af97 4903gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
6de9cd9a
DN		 4904{
4905 gfc_intrinsic_sym *isym;
4906 const char *name;
4907
4908 name = c->symtree->n.sym->name;
4909
cadddfdd
TB		 4910 if (c->symtree->n.sym->intmod_sym_id)
4911 {
4912 gfc_isym_id id;
4913 id = gfc_isym_id_by_intmod_sym (c->symtree->n.sym);
4914 isym = gfc_intrinsic_subroutine_by_id (id);
4915 }
4916 else
4917 isym = gfc_find_subroutine (name);
6de9cd9a
DN		 4918 if (isym == NULL)
4919 return MATCH_NO;
4920
a3d3c0f5
DK		 4921 if (!error_flag)
4922 gfc_push_suppress_errors ();
6de9cd9a
DN		 4923
4924 init_arglist (isym);
4925
f1abbf69 4926 if (!isym->vararg && !sort_actual (name, &c->ext.actual, isym->formal, &c->loc))
6de9cd9a
DN		 4927 goto fail;
4928
bf7a73f9
TB		 4929 if (!do_ts29113_check (isym, c->ext.actual))
4930 goto fail;
4931
6de9cd9a
DN		 4932 if (isym->check.f1 != NULL)
4933 {
524af0d6 4934 if (!do_check (isym, c->ext.actual))
6de9cd9a
DN		 4935 goto fail;
4936 }
4937 else
4938 {
524af0d6 4939 if (!check_arglist (&c->ext.actual, isym, 1))
6de9cd9a
DN		 4940 goto fail;
4941 }
4942
4943 /* The subroutine corresponds to an intrinsic. Allow errors to be
f7b529fa 4944 seen at this point. */
a3d3c0f5
DK		 4945 if (!error_flag)
4946 gfc_pop_suppress_errors ();
6de9cd9a 4947
12f681a0 4948 c->resolved_isym = isym;
6de9cd9a
DN		 4949 if (isym->resolve.s1 != NULL)
4950 isym->resolve.s1 (c);
4951 else
42a8c358
TB		 4952 {
4953 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
4954 c->resolved_sym->attr.elemental = isym->elemental;
4955 }
6de9cd9a 4956
ce96d372
TK		 4957 if (gfc_do_concurrent_flag && !isym->pure)
4958 {
c4100eae 4959 gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
ce96d372
TK		 4960 "block at %L is not PURE", name, &c->loc);
4961 return MATCH_ERROR;
4962 }
4963
ccd7751b 4964 if (!isym->pure && gfc_pure (NULL))
6de9cd9a 4965 {
c4100eae 4966 gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name,
6de9cd9a
DN		 4967 &c->loc);
4968 return MATCH_ERROR;
4969 }
4970
ccd7751b
TB		 4971 if (!isym->pure)
4972 gfc_unset_implicit_pure (NULL);
4973
fe58e076 4974 c->resolved_sym->attr.noreturn = isym->noreturn;
b7892582 4975
6de9cd9a
DN		 4976 return MATCH_YES;
4977
4978fail:
a3d3c0f5
DK		 4979 if (!error_flag)
4980 gfc_pop_suppress_errors ();
6de9cd9a
DN		 4981 return MATCH_NO;
4982}
4983
4984
4985/* Call gfc_convert_type() with warning enabled. */
4986
524af0d6 4987bool
b251af97 4988gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
6de9cd9a
DN		 4989{
4990 return gfc_convert_type_warn (expr, ts, eflag, 1);
4991}
4992
4993
4994/* Try to convert an expression (in place) from one type to another.
4995 'eflag' controls the behavior on error.
4996
4997 The possible values are:
4998
4999 1 Generate a gfc_error()
5000 2 Generate a gfc_internal_error().
5001
5002 'wflag' controls the warning related to conversion. */
5003
524af0d6 5004bool
b251af97 5005gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
6de9cd9a
DN		 5006{
5007 gfc_intrinsic_sym *sym;
5008 gfc_typespec from_ts;
5009 locus old_where;
7b901ac4 5010 gfc_expr *new_expr;
6de9cd9a 5011 int rank;
323c74da 5012 mpz_t *shape;
6de9cd9a
DN		 5013
5014 from_ts = expr->ts; /* expr->ts gets clobbered */
5015
5016 if (ts->type == BT_UNKNOWN)
5017 goto bad;
5018
d8afd032
TK		 5019 /* NULL and zero size arrays get their type here, unless they already have a
5020 typespec. */
5021 if ((expr->expr_type == EXPR_NULL
5022 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
5023 && expr->ts.type == BT_UNKNOWN)
6de9cd9a
DN		 5024 {
5025 /* Sometimes the RHS acquire the type. */
5026 expr->ts = *ts;
524af0d6 5027 return true;
6de9cd9a
DN		 5028 }
5029
5030 if (expr->ts.type == BT_UNKNOWN)
5031 goto bad;
5032
e9b75848
SK		 5033 /* In building an array constructor, gfortran can end up here when no
5034 conversion is required for an intrinsic type. We need to let derived
5035 types drop through. */
5036 if (from_ts.type != BT_DERIVED
5037 && (from_ts.type == ts->type && from_ts.kind == ts->kind))
5038 return true;
5039
b251af97 5040 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
6de9cd9a 5041 && gfc_compare_types (&expr->ts, ts))
524af0d6 5042 return true;
6de9cd9a
DN		 5043
5044 sym = find_conv (&expr->ts, ts);
5045 if (sym == NULL)
5046 goto bad;
5047
5048 /* At this point, a conversion is necessary. A warning may be needed. */
c3a29423 5049 if ((gfc_option.warn_std & sym->standard) != 0)
4e42ad66 5050 {
db30e21c 5051 gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
daf8c6f0
DF		 5052 gfc_typename (&from_ts), gfc_typename (ts),
5053 &expr->where);
5054 }
5055 else if (wflag)
5056 {
c61819ff 5057 if (flag_range_check && expr->expr_type == EXPR_CONSTANT
33169a22
DF		 5058 && from_ts.type == ts->type)
5059 {
5060 /* Do nothing. Constants of the same type are range-checked
5061 elsewhere. If a value too large for the target type is
5062 assigned, an error is generated. Not checking here avoids
5063 duplications of warnings/errors.
5064 If range checking was disabled, but -Wconversion enabled,
5065 a non range checked warning is generated below. */
5066 }
5067 else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
5068 {
5069 /* Do nothing. This block exists only to simplify the other
5070 else-if expressions.
5071 LOGICAL <> LOGICAL no warning, independent of kind values
5072 LOGICAL <> INTEGER extension, warned elsewhere
5073 LOGICAL <> REAL invalid, error generated elsewhere
5074 LOGICAL <> COMPLEX invalid, error generated elsewhere */
5075 }
5076 else if (from_ts.type == ts->type
5077 || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
5078 || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
5079 || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
5080 {
5081 /* Larger kinds can hold values of smaller kinds without problems.
5082 Hence, only warn if target kind is smaller than the source
5083 kind - or if -Wconversion-extra is specified. */
cbf560d7
TK		 5084 if (expr->expr_type != EXPR_CONSTANT)
5085 {
5086 if (warn_conversion && from_ts.kind > ts->kind)
5087 gfc_warning_now (OPT_Wconversion, "Possible change of value in "
5088 "conversion from %s to %s at %L",
5089 gfc_typename (&from_ts), gfc_typename (ts),
5090 &expr->where);
5091 else if (warn_conversion_extra)
5092 gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
5093 "at %L", gfc_typename (&from_ts),
5094 gfc_typename (ts), &expr->where);
5095 }
33169a22
DF		 5096 }
5097 else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
5098 || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
5099 || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
5100 {
5101 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
5102 usually comes with a loss of information, regardless of kinds. */
cbf560d7 5103 if (warn_conversion && expr->expr_type != EXPR_CONSTANT)
4daa149b
TB		 5104 gfc_warning_now (OPT_Wconversion, "Possible change of value in "
5105 "conversion from %s to %s at %L",
5106 gfc_typename (&from_ts), gfc_typename (ts),
5107 &expr->where);
33169a22
DF		 5108 }
5109 else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
5110 {
5111 /* If HOLLERITH is involved, all bets are off. */
4daa149b
TB		 5112 if (warn_conversion)
5113 gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
33169a22
DF		 5114 gfc_typename (&from_ts), gfc_typename (ts),
5115 &expr->where);
5116 }
5117 else
5118 gcc_unreachable ();
4e42ad66 5119 }
6de9cd9a
DN		 5120
5121 /* Insert a pre-resolved function call to the right function. */
5122 old_where = expr->where;
5123 rank = expr->rank;
323c74da
RH		 5124 shape = expr->shape;
5125
7b901ac4
KG		 5126 new_expr = gfc_get_expr ();
5127 *new_expr = *expr;
5128
5129 new_expr = gfc_build_conversion (new_expr);
5130 new_expr->value.function.name = sym->lib_name;
5131 new_expr->value.function.isym = sym;
5132 new_expr->where = old_where;
aa7cfe40 5133 new_expr->ts = *ts;
7b901ac4
KG		 5134 new_expr->rank = rank;
5135 new_expr->shape = gfc_copy_shape (shape, rank);
5136
5137 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4b41f35e 5138 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
aa7cfe40
JW		 5139 new_expr->symtree->n.sym->ts.type = ts->type;
5140 new_expr->symtree->n.sym->ts.kind = ts->kind;
7b901ac4
KG		 5141 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
5142 new_expr->symtree->n.sym->attr.function = 1;
5143 new_expr->symtree->n.sym->attr.elemental = 1;
5144 new_expr->symtree->n.sym->attr.pure = 1;
5145 new_expr->symtree->n.sym->attr.referenced = 1;
5146 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
5147 gfc_commit_symbol (new_expr->symtree->n.sym);
5148
5149 *expr = *new_expr;
5150
cede9502 5151 free (new_expr);
6de9cd9a
DN		 5152 expr->ts = *ts;
5153
5154 if (gfc_is_constant_expr (expr->value.function.actual->expr)
524af0d6 5155 && !do_simplify (sym, expr))
6de9cd9a
DN		 5156 {
5157
5158 if (eflag == 2)
5159 goto bad;
524af0d6 5160 return false; /* Error already generated in do_simplify() */
6de9cd9a
DN		 5161 }
5162
524af0d6 5163 return true;
6de9cd9a
DN		 5164
5165bad:
5166 if (eflag == 1)
5167 {
5168 gfc_error ("Can't convert %s to %s at %L",
5169 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
524af0d6 5170 return false;
6de9cd9a
DN		 5171 }
5172
17d5d49f 5173 gfc_internal_error ("Can't convert %qs to %qs at %L",
6de9cd9a
DN		 5174 gfc_typename (&from_ts), gfc_typename (ts),
5175 &expr->where);
5176 /* Not reached */
5177}
d393bbd7
FXC		 5178
5179
524af0d6 5180bool
d393bbd7
FXC		 5181gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
5182{
5183 gfc_intrinsic_sym *sym;
d393bbd7 5184 locus old_where;
7b901ac4 5185 gfc_expr *new_expr;
d393bbd7
FXC		 5186 int rank;
5187 mpz_t *shape;
5188
5189 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
d393bbd7
FXC		 5190
5191 sym = find_char_conv (&expr->ts, ts);
5192 gcc_assert (sym);
5193
5194 /* Insert a pre-resolved function call to the right function. */
5195 old_where = expr->where;
5196 rank = expr->rank;
5197 shape = expr->shape;
5198
7b901ac4
KG		 5199 new_expr = gfc_get_expr ();
5200 *new_expr = *expr;
d393bbd7 5201
7b901ac4
KG		 5202 new_expr = gfc_build_conversion (new_expr);
5203 new_expr->value.function.name = sym->lib_name;
5204 new_expr->value.function.isym = sym;
5205 new_expr->where = old_where;
aa7cfe40 5206 new_expr->ts = *ts;
7b901ac4
KG		 5207 new_expr->rank = rank;
5208 new_expr->shape = gfc_copy_shape (shape, rank);
d393bbd7 5209
7b901ac4 5210 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
aa7cfe40
JW		 5211 new_expr->symtree->n.sym->ts.type = ts->type;
5212 new_expr->symtree->n.sym->ts.kind = ts->kind;
7b901ac4
KG		 5213 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
5214 new_expr->symtree->n.sym->attr.function = 1;
5215 new_expr->symtree->n.sym->attr.elemental = 1;
5216 new_expr->symtree->n.sym->attr.referenced = 1;
5217 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
5218 gfc_commit_symbol (new_expr->symtree->n.sym);
d393bbd7 5219
7b901ac4 5220 *expr = *new_expr;
d393bbd7 5221
cede9502 5222 free (new_expr);
d393bbd7
FXC		 5223 expr->ts = *ts;
5224
5225 if (gfc_is_constant_expr (expr->value.function.actual->expr)
524af0d6 5226 && !do_simplify (sym, expr))
d393bbd7
FXC		 5227 {
5228 /* Error already generated in do_simplify() */
524af0d6 5229 return false;
d393bbd7
FXC		 5230 }
5231
524af0d6 5232 return true;
d393bbd7 5233}
c3005b0f
DK		 5234
5235
5236/* Check if the passed name is name of an intrinsic (taking into account the
5237 current -std=* and -fall-intrinsic settings). If it is, see if we should
5238 warn about this as a user-procedure having the same name as an intrinsic
5239 (-Wintrinsic-shadow enabled) and do so if we should. */
5240
5241void
5242gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
5243{
5244 gfc_intrinsic_sym* isym;
5245
5246 /* If the warning is disabled, do nothing at all. */
73e42eef 5247 if (!warn_intrinsic_shadow)
c3005b0f
DK		 5248 return;
5249
5250 /* Try to find an intrinsic of the same name. */
5251 if (func)
5252 isym = gfc_find_function (sym->name);
f8862a1b 5253 else
c3005b0f
DK		 5254 isym = gfc_find_subroutine (sym->name);
5255
5256 /* If no intrinsic was found with this name or it's not included in the
5257 selected standard, everything's fine. */
f8862a1b 5258 if (!isym || !gfc_check_intrinsic_standard (isym, NULL, true,
524af0d6 5259 sym->declared_at))
c3005b0f
DK		 5260 return;
5261
5262 /* Emit the warning. */
62d6a5bb 5263 if (in_module || sym->ns->proc_name)
48749dbc
MLI		 5264 gfc_warning (OPT_Wintrinsic_shadow,
5265 "%qs declared at %L may shadow the intrinsic of the same"
c3005b0f
DK		 5266 " name. In order to call the intrinsic, explicit INTRINSIC"
5267 " declarations may be required.",
5268 sym->name, &sym->declared_at);
5269 else
48749dbc
MLI		 5270 gfc_warning (OPT_Wintrinsic_shadow,
5271 "%qs declared at %L is also the name of an intrinsic. It can"
c3005b0f
DK		 5272 " only be called via an explicit interface or if declared"
5273 " EXTERNAL.", sym->name, &sym->declared_at);
5274}
Mirror of https://gcc.gnu.org/git/gcc.git