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