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