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