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