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