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