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