]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/intrinsic.c
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
re PR fortran/45420 ([OOP] polymorphic TBP call in a CLASS DEFAULT clause)
[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
e1633d82 2271 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2272 gfc_check_null, gfc_simplify_null, NULL,
1270d633 2273 mo, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2274
cd5ecab6 2275 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
6de9cd9a 2276
d0a4a61c
TB		 2277 add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
2278 NULL, gfc_simplify_num_images, NULL);
2279
e1633d82 2280 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
7ba8c18c 2281 gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
1270d633
SK		 2282 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2283 v, BT_REAL, dr, OPTIONAL);
6de9cd9a 2284
b7892582 2285 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
6de9cd9a 2286
e1633d82 2287 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2288 gfc_check_precision, gfc_simplify_precision, NULL,
1270d633 2289 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2290
cd5ecab6 2291 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
6de9cd9a 2292
23e38561
JW		 2293 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2294 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2295 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
6de9cd9a 2296
b7892582 2297 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
6de9cd9a 2298
e1633d82 2299 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a16d978f 2300 gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
1270d633
SK		 2301 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2302 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2303
b7892582 2304 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
6de9cd9a 2305
e1633d82 2306 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2307 gfc_check_radix, gfc_simplify_radix, NULL,
1270d633 2308 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2309
cd5ecab6 2310 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
6de9cd9a 2311
2bd74949 2312 /* The following function is for G77 compatibility. */
e6c14898
DK		 2313 add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2314 4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
b251af97 2315 i, BT_INTEGER, 4, OPTIONAL);
2bd74949 2316
1270d633
SK		 2317 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2318 use slightly different shoddy multiplicative congruential PRNG. */
19060788 2319 make_alias ("ran", GFC_STD_GNU);
f8e566e5 2320
b7892582 2321 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2bd74949 2322
e1633d82 2323 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2324 gfc_check_range, gfc_simplify_range, NULL,
1270d633 2325 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2326
cd5ecab6 2327 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
6de9cd9a 2328
e1633d82 2329 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2330 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1270d633 2331 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2332
6970fcc8 2333 /* This provides compatibility with g77. */
e1633d82 2334 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
6970fcc8
SK		 2335 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2336 a, BT_UNKNOWN, dr, REQUIRED);
2337
7f59aaba 2338 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
c9018c71 2339 gfc_check_float, gfc_simplify_float, NULL,
1270d633 2340 a, BT_INTEGER, di, REQUIRED);
6de9cd9a 2341
c9018c71
DF		 2342 add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
2343 gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
2344 a, BT_REAL, dr, REQUIRED);
2345
7f59aaba 2346 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
c9018c71 2347 gfc_check_sngl, gfc_simplify_sngl, NULL,
1270d633 2348 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2349
b7892582 2350 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
6de9cd9a 2351
e6c14898 2352 add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2353 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2354 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC		 2355
2356 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2357
e1633d82 2358 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 2359 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
0881653c 2360 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 2361
b7892582 2362 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
6de9cd9a 2363
e1633d82 2364 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2365 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
1270d633
SK		 2366 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2367 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 2368
b7892582 2369 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
6de9cd9a 2370
e1633d82 2371 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2372 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
1270d633 2373 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2374
b7892582 2375 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
6de9cd9a 2376
cf2b3c22
TB		 2377 add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
2378 BT_LOGICAL, dl, GFC_STD_F2003,
2379 gfc_check_same_type_as, NULL, NULL,
2380 a, BT_UNKNOWN, 0, REQUIRED,
2381 b, BT_UNKNOWN, 0, REQUIRED);
2382
e1633d82 2383 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2384 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
1270d633 2385 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2386
b7892582 2387 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
6de9cd9a 2388
5cda5098
FXC		 2389 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2390 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2391 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
1270d633 2392 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 2393 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2394
b7892582 2395 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
6de9cd9a 2396
f7b529fa 2397 /* Added for G77 compatibility garbage. */
e6c14898
DK		 2398 add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2399 4, GFC_STD_GNU, NULL, NULL, NULL);
2bd74949 2400
b7892582 2401 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2bd74949 2402
53096259 2403 /* Added for G77 compatibility. */
e6c14898
DK		 2404 add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
2405 dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
53096259
PT		 2406 x, BT_REAL, dr, REQUIRED);
2407
2408 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2409
a39fafac
FXC		 2410 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2411 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2412 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2413 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2414
2415 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2416
e1633d82 2417 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC		 2418 GFC_STD_F95, gfc_check_selected_int_kind,
2419 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
6de9cd9a 2420
b7892582 2421 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
6de9cd9a 2422
01349049 2423 add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC		 2424 GFC_STD_F95, gfc_check_selected_real_kind,
2425 gfc_simplify_selected_real_kind, NULL,
01349049
TB		 2426 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
2427 "radix", BT_INTEGER, di, OPTIONAL);
6de9cd9a 2428
b7892582 2429 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
6de9cd9a 2430
e1633d82 2431 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a
DN		 2432 gfc_check_set_exponent, gfc_simplify_set_exponent,
2433 gfc_resolve_set_exponent,
1270d633 2434 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2435
b7892582 2436 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
6de9cd9a 2437
e1633d82 2438 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2439 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
1270d633 2440 src, BT_REAL, dr, REQUIRED);
6de9cd9a 2441
b7892582 2442 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
6de9cd9a 2443
e1633d82 2444 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2445 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2446 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
6de9cd9a 2447
e1633d82 2448 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2449 NULL, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2450 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
6de9cd9a 2451
e1633d82 2452 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2453 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2454 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
6de9cd9a 2455
b7892582 2456 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
6de9cd9a 2457
e6c14898
DK		 2458 add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2459 di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
185d7d97
FXC		 2460 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2461
2462 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2463
e1633d82 2464 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2465 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2466 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2467
e1633d82 2468 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2469 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2470 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2471
e1633d82 2472 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2473 NULL, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2474 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2475
e1633d82 2476 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK		 2477 NULL, gfc_simplify_sin, gfc_resolve_sin,
2478 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2479
19060788 2480 make_alias ("cdsin", GFC_STD_GNU);
6de9cd9a 2481
b7892582 2482 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
6de9cd9a 2483
e1633d82 2484 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 2485 gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 2486 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2487
e1633d82 2488 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2489 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 2490 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2491
b7892582 2492 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
6de9cd9a 2493
5cda5098
FXC		 2494 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2495 BT_INTEGER, di, GFC_STD_F95,
2496 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2497 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2498 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2499
b7892582 2500 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
6de9cd9a 2501
e6c14898 2502 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
fd2157ce 2503 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
8d82b242 2504 x, BT_UNKNOWN, 0, REQUIRED);
fd2157ce 2505
cd5ecab6 2506 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
048510c8
JW		 2507
2508 add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
2509 BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
2510 x, BT_UNKNOWN, 0, REQUIRED);
fd2157ce 2511
e1633d82 2512 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2513 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
1270d633 2514 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2515
b7892582 2516 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
6de9cd9a 2517
e1633d82 2518 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
c430a6f9 2519 gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
1270d633 2520 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
0881653c 2521 ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 2522
b7892582 2523 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
6de9cd9a 2524
e1633d82 2525 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2526 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 2527 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2528
e1633d82 2529 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2530 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 2531 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2532
e1633d82 2533 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2534 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 2535 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2536
e1633d82 2537 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK		 2538 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2539 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2540
19060788 2541 make_alias ("cdsqrt", GFC_STD_GNU);
6de9cd9a 2542
b7892582 2543 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
6de9cd9a 2544
e6c14898 2545 add_sym_2 ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2546 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2547 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
df65f093
SK		 2548
2549 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2550
048510c8
JW		 2551 add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2552 BT_INTEGER, di, GFC_STD_F2008,
2553 gfc_check_storage_size, NULL, gfc_resolve_storage_size,
2554 a, BT_UNKNOWN, 0, REQUIRED,
2555 kind, BT_INTEGER, di, OPTIONAL);
2556
e1633d82 2557 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a16d978f 2558 gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
1270d633
SK		 2559 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2560 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2561
b7892582 2562 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
6de9cd9a 2563
e6c14898 2564 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2565 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2566 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC		 2567
2568 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2569
e6c14898 2570 add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2571 GFC_STD_GNU, NULL, NULL, NULL,
2572 com, BT_CHARACTER, dc, REQUIRED);
1270d633 2573
b7892582 2574 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
5b1374e9 2575
e1633d82 2576 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 2577 gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
1270d633 2578 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2579
e1633d82 2580 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2581 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
1270d633 2582 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2583
b7892582 2584 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
6de9cd9a 2585
e1633d82 2586 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
8d3681f9 2587 gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 2588 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2589
e1633d82 2590 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2591 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 2592 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2593
b7892582 2594 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
6de9cd9a 2595
64f002ed 2596 add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
0d6d8e00 2597 gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
64f002ed
TB		 2598 ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
2599
e6c14898
DK		 2600 add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2601 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
f77b6ca3
FXC		 2602
2603 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2604
e6c14898
DK		 2605 add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2606 di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
f77b6ca3
FXC		 2607
2608 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2609
e1633d82 2610 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1270d633
SK		 2611 gfc_check_x, gfc_simplify_tiny, NULL,
2612 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2613
cd5ecab6 2614 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
6de9cd9a 2615
414f00e9
SB		 2616 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2617 BT_INTEGER, di, GFC_STD_F2008,
2618 gfc_check_i, gfc_simplify_trailz, NULL,
2619 i, BT_INTEGER, di, REQUIRED);
2620
2621 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2622
e1633d82 2623 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a4a11197 2624 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
1270d633
SK		 2625 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2626 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2627
b7892582 2628 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
6de9cd9a 2629
e1633d82 2630 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8ec259c1 2631 gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
1270d633 2632 m, BT_REAL, dr, REQUIRED);
6de9cd9a 2633
b7892582 2634 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
6de9cd9a 2635
e1633d82 2636 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 2637 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
1270d633 2638 stg, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2639
b7892582 2640 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
6de9cd9a 2641
e6c14898
DK		 2642 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
2643 0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
b251af97 2644 ut, BT_INTEGER, di, REQUIRED);
25fc05eb
FXC		 2645
2646 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2647
5cda5098
FXC		 2648 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2649 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2650 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
5cda5098
FXC		 2651 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2652 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2653
b7892582 2654 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
6de9cd9a 2655
64f002ed 2656 add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
e6c14898
DK		 2657 BT_INTEGER, di, GFC_STD_F2008,
2658 gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
2659 ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2660 kind, BT_INTEGER, di, OPTIONAL);
64f002ed 2661
0d6d8e00 2662 make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
64f002ed 2663
d8fe26b2 2664 /* g77 compatibility for UMASK. */
e6c14898 2665 add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
2f8cce28
FXC		 2666 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2667 msk, BT_INTEGER, di, REQUIRED);
d8fe26b2
SK		 2668
2669 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2670
2671 /* g77 compatibility for UNLINK. */
e6c14898
DK		 2672 add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
2673 di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
2f8cce28 2674 "path", BT_CHARACTER, dc, REQUIRED);
d8fe26b2
SK		 2675
2676 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2677
e1633d82 2678 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
c430a6f9 2679 gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
1270d633
SK		 2680 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2681 f, BT_REAL, dr, REQUIRED);
6de9cd9a 2682
b7892582 2683 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
6de9cd9a 2684
5cda5098
FXC		 2685 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2686 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2687 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
1270d633 2688 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 2689 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2690
b7892582 2691 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
83d890b9 2692
e6c14898 2693 add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
2f8cce28
FXC		 2694 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2695 x, BT_UNKNOWN, 0, REQUIRED);
83d890b9
AL		 2696
2697 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
6de9cd9a
DN		 2698}
2699
2700
6de9cd9a
DN		 2701/* Add intrinsic subroutines. */
2702
2703static void
2704add_subroutines (void)
2705{
2706 /* Argument names as in the standard (to be used as argument keywords). */
2707 const char
2708 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2709 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2710 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
b41b2534
JB		 2711 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2712 *com = "command", *length = "length", *st = "status",
aa6fc635 2713 *val = "value", *num = "number", *name = "name",
185d7d97 2714 *trim_name = "trim_name", *ut = "unit", *han = "handler",
dcdc26df 2715 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2f8cce28
FXC		 2716 *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2717 *p2 = "path2", *msk = "mask", *old = "old";
6de9cd9a 2718
0d519038 2719 int di, dr, dc, dl, ii;
6de9cd9a 2720
9d64df18
TS		 2721 di = gfc_default_integer_kind;
2722 dr = gfc_default_real_kind;
2723 dc = gfc_default_character_kind;
2724 dl = gfc_default_logical_kind;
0d519038 2725 ii = gfc_index_integer_kind;
6de9cd9a 2726
cd5ecab6 2727 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
6de9cd9a 2728
3f2286f2 2729 make_noreturn();
fe58e076 2730
e6c14898 2731 add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
23e38561
JW		 2732 GFC_STD_F95, gfc_check_cpu_time, NULL,
2733 gfc_resolve_cpu_time,
2734 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
6de9cd9a 2735
f7b529fa 2736 /* More G77 compatibility garbage. */
e6c14898 2737 add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210
FXC		 2738 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2739 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2740
e6c14898 2741 add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210
FXC		 2742 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2743 vl, BT_INTEGER, 4, REQUIRED);
2744
e6c14898 2745 add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210
FXC		 2746 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2747 vl, BT_INTEGER, 4, REQUIRED);
35059811 2748
e6c14898 2749 add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a119fc1c
FXC		 2750 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2751 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2752
e6c14898
DK		 2753 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN,
2754 0, GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
a119fc1c
FXC		 2755 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2756
e6c14898
DK		 2757 add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
2758 GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
1270d633 2759 tm, BT_REAL, dr, REQUIRED);
2bd74949 2760
e6c14898 2761 add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2762 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
f77b6ca3
FXC		 2763 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2764
e6c14898 2765 add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2766 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
a119fc1c
FXC		 2767 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2768 st, BT_INTEGER, di, OPTIONAL);
2769
e6c14898
DK		 2770 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
2771 0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
23e38561
JW		 2772 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2773 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2774 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2775 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 2776
f7b529fa 2777 /* More G77 compatibility garbage. */
e6c14898 2778 add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 2779 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
1270d633 2780 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2bd74949 2781
e6c14898 2782 add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 2783 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
1270d633 2784 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2bd74949 2785
e6c14898 2786 add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97
SK		 2787 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2788 dt, BT_CHARACTER, dc, REQUIRED);
35059811 2789
e6c14898
DK		 2790 add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
2791 0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
2792 res, BT_CHARACTER, dc, REQUIRED);
f77b6ca3 2793
e6c14898
DK		 2794 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
2795 GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
1270d633 2796 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
a8c60d7f 2797
e6c14898
DK		 2798 add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
2799 0, GFC_STD_GNU, NULL, NULL, NULL,
2800 name, BT_CHARACTER, dc, REQUIRED,
2801 val, BT_CHARACTER, dc, REQUIRED);
aa6fc635 2802
e6c14898
DK		 2803 add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
2804 0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
ed8315d5 2805 pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
a8c60d7f 2806
e6c14898
DK		 2807 add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
2808 0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
2809 c, BT_CHARACTER, dc, REQUIRED);
f77b6ca3 2810
b41b2534
JB		 2811 /* F2003 commandline routines. */
2812
e6c14898
DK		 2813 add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
2814 BT_UNKNOWN, 0, GFC_STD_F2003,
2815 NULL, NULL, gfc_resolve_get_command,
23e38561
JW		 2816 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2817 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2818 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
60c9a35b 2819
e6c14898
DK		 2820 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
2821 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
23e38561
JW		 2822 gfc_resolve_get_command_argument,
2823 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2824 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2825 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2826 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
aa6fc635 2827
f7b529fa 2828 /* F2003 subroutine to get environment variables. */
aa6fc635 2829
23e38561 2830 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
e6c14898 2831 CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
b251af97 2832 NULL, NULL, gfc_resolve_get_environment_variable,
23e38561
JW		 2833 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2834 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2835 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2836 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2837 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2838
e6c14898
DK		 2839 add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE,
2840 BT_UNKNOWN, 0, GFC_STD_F2003,
2841 gfc_check_move_alloc, NULL, NULL,
23e38561
JW		 2842 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2843 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2844
2845 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2846 GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2847 gfc_resolve_mvbits,
2848 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2849 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2850 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2851 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2852 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2853
e6c14898 2854 add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
23e38561
JW		 2855 BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2856 gfc_resolve_random_number,
2857 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2858
e6c14898 2859 add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
23e38561
JW		 2860 BT_UNKNOWN, 0, GFC_STD_F95,
2861 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2862 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2863 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2864 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 2865
f7b529fa 2866 /* More G77 compatibility garbage. */
e6c14898 2867 add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
185d7d97
FXC		 2868 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2869 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2870 st, BT_INTEGER, di, OPTIONAL);
2871
e6c14898
DK		 2872 add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
2873 di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
2f8cce28 2874 "seed", BT_INTEGER, 4, REQUIRED);
2bd74949 2875
e6c14898 2876 add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2877 gfc_check_exit, NULL, gfc_resolve_exit,
9fe3100e 2878 st, BT_INTEGER, di, OPTIONAL);
d8fe26b2 2879
3f2286f2 2880 make_noreturn();
fe58e076 2881
e6c14898 2882 add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC		 2883 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2884 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2885 st, BT_INTEGER, di, OPTIONAL);
2886
e6c14898 2887 add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC		 2888 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2889 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2890
e6c14898 2891 add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 2892 gfc_check_flush, NULL, gfc_resolve_flush,
ca41838c 2893 ut, BT_INTEGER, di, OPTIONAL);
df65f093 2894
e6c14898 2895 add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC		 2896 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2897 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2898 st, BT_INTEGER, di, OPTIONAL);
2899
e6c14898 2900 add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC		 2901 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2902 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2903
e6c14898 2904 add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2f8cce28
FXC		 2905 gfc_check_free, NULL, gfc_resolve_free,
2906 ptr, BT_INTEGER, ii, REQUIRED);
0d519038 2907
e6c14898
DK		 2908 add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
2909 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
2910 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
23e38561 2911 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
e6c14898 2912 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
23e38561 2913 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
dcdc26df 2914
e6c14898 2915 add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC		 2916 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2917 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2918
e6c14898
DK		 2919 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
2920 GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
f77b6ca3
FXC		 2921 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2922
e6c14898
DK		 2923 add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN,
2924 0, GFC_STD_GNU, gfc_check_kill_sub,
f77b6ca3
FXC		 2925 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2926 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2927
e6c14898 2928 add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2929 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2f8cce28 2930 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
f77b6ca3
FXC		 2931 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2932
e6c14898
DK		 2933 add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
2934 0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
2f8cce28 2935 "string", BT_CHARACTER, dc, REQUIRED);
f77b6ca3 2936
e6c14898
DK		 2937 add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
2938 GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2f8cce28 2939 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
f77b6ca3
FXC		 2940 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2941
e6c14898 2942 add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2943 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2f8cce28 2944 sec, BT_INTEGER, di, REQUIRED);
f77b6ca3 2945
e6c14898 2946 add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093
SK		 2947 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2948 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2949 st, BT_INTEGER, di, OPTIONAL);
2950
e6c14898 2951 add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
bf3fb7e4
FXC		 2952 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2953 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2954 st, BT_INTEGER, di, OPTIONAL);
2955
e6c14898 2956 add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093
SK		 2957 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2958 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2959 st, BT_INTEGER, di, OPTIONAL);
2960
e6c14898
DK		 2961 add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
2962 GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
185d7d97
FXC		 2963 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2964 st, BT_INTEGER, di, OPTIONAL);
2965
e6c14898
DK		 2966 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
2967 GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_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_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
2972 0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
d393bbd7 2973 com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
5b1374e9 2974
e6c14898 2975 add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
23e38561
JW		 2976 BT_UNKNOWN, 0, GFC_STD_F95,
2977 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2978 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2979 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2980 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
d8fe26b2 2981
e6c14898
DK		 2982 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
2983 GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
f53e867d 2984 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
ae8b8789 2985
e6c14898 2986 add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2987 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2f8cce28 2988 msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
d8fe26b2 2989
e6c14898
DK		 2990 add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
2991 GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2f8cce28 2992 "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
6de9cd9a
DN		 2993}
2994
2995
2996/* Add a function to the list of conversion symbols. */
2997
2998static void
c3a29423 2999add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
6de9cd9a 3000{
6de9cd9a
DN		 3001 gfc_typespec from, to;
3002 gfc_intrinsic_sym *sym;
3003
3004 if (sizing == SZ_CONVS)
3005 {
3006 nconv++;
3007 return;
3008 }
3009
3010 gfc_clear_ts (&from);
3011 from.type = from_type;
3012 from.kind = from_kind;
3013
3014 gfc_clear_ts (&to);
3015 to.type = to_type;
3016 to.kind = to_kind;
3017
3018 sym = conversion + nconv;
3019
c3a29423 3020 sym->name = conv_name (&from, &to);
cb9e4f55 3021 sym->lib_name = sym->name;
c3a29423
RS		 3022 sym->simplify.cc = gfc_convert_constant;
3023 sym->standard = standard;
6de9cd9a 3024 sym->elemental = 1;
e1633d82 3025 sym->conversion = 1;
6de9cd9a 3026 sym->ts = to;
cd5ecab6 3027 sym->id = GFC_ISYM_CONVERSION;
6de9cd9a
DN		 3028
3029 nconv++;
3030}
3031
3032
3033/* Create gfc_intrinsic_sym nodes for all intrinsic conversion
3034 functions by looping over the kind tables. */
3035
3036static void
3037add_conversions (void)
3038{
3039 int i, j;
3040
3041 /* Integer-Integer conversions. */
3042 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3043 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
3044 {
3045 if (i == j)
3046 continue;
3047
3048 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3049 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3050 }
3051
3052 /* Integer-Real/Complex conversions. */
3053 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3054 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3055 {
3056 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3057 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3058
3059 add_conv (BT_REAL, gfc_real_kinds[j].kind,
c3a29423 3060 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN		 3061
3062 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 3063 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3064
3065 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
c3a29423 3066 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN		 3067 }
3068
d3642f89
FW		 3069 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3070 {
3071 /* Hollerith-Integer conversions. */
3072 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
3073 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3074 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3075 /* Hollerith-Real conversions. */
3076 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3077 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3078 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3079 /* Hollerith-Complex conversions. */
3080 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3081 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3082 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
3083
3084 /* Hollerith-Character conversions. */
3085 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
3086 gfc_default_character_kind, GFC_STD_LEGACY);
3087
3088 /* Hollerith-Logical conversions. */
3089 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
3090 add_conv (BT_HOLLERITH, gfc_default_character_kind,
3091 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
3092 }
3093
6de9cd9a
DN		 3094 /* Real/Complex - Real/Complex conversions. */
3095 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
3096 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
3097 {
3098 if (i != j)
3099 {
3100 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 3101 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3102
3103 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 3104 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3105 }
3106
3107 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 3108 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3109
3110 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 3111 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN		 3112 }
3113
3114 /* Logical/Logical kind conversion. */
3115 for (i = 0; gfc_logical_kinds[i].kind; i++)
3116 for (j = 0; gfc_logical_kinds[j].kind; j++)
3117 {
3118 if (i == j)
3119 continue;
3120
3121 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
c3a29423 3122 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
6de9cd9a 3123 }
c3a29423
RS		 3124
3125 /* Integer-Logical and Logical-Integer conversions. */
3126 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3127 for (i=0; gfc_integer_kinds[i].kind; i++)
3128 for (j=0; gfc_logical_kinds[j].kind; j++)
3129 {
3130 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3131 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3132 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3133 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3134 }
6de9cd9a
DN		 3135}
3136
3137
d393bbd7
FXC		 3138static void
3139add_char_conversions (void)
3140{
3141 int n, i, j;
3142
3143 /* Count possible conversions. */
3144 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3145 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3146 if (i != j)
3147 ncharconv++;
3148
3149 /* Allocate memory. */
ece3f663 3150 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
d393bbd7
FXC		 3151
3152 /* Add the conversions themselves. */
3153 n = 0;
3154 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3155 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3156 {
3157 gfc_typespec from, to;
3158
3159 if (i == j)
3160 continue;
3161
3162 gfc_clear_ts (&from);
3163 from.type = BT_CHARACTER;
3164 from.kind = gfc_character_kinds[i].kind;
3165
3166 gfc_clear_ts (&to);
3167 to.type = BT_CHARACTER;
3168 to.kind = gfc_character_kinds[j].kind;
3169
3170 char_conversions[n].name = conv_name (&from, &to);
3171 char_conversions[n].lib_name = char_conversions[n].name;
3172 char_conversions[n].simplify.cc = gfc_convert_char_constant;
3173 char_conversions[n].standard = GFC_STD_F2003;
3174 char_conversions[n].elemental = 1;
3175 char_conversions[n].conversion = 0;
3176 char_conversions[n].ts = to;
3177 char_conversions[n].id = GFC_ISYM_CONVERSION;
3178
3179 n++;
3180 }
3181}
3182
3183
6de9cd9a
DN		 3184/* Initialize the table of intrinsics. */
3185void
3186gfc_intrinsic_init_1 (void)
3187{
3188 int i;
3189
3190 nargs = nfunc = nsub = nconv = 0;
3191
3192 /* Create a namespace to hold the resolved intrinsic symbols. */
0366dfe9 3193 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
6de9cd9a
DN		 3194
3195 sizing = SZ_FUNCS;
3196 add_functions ();
3197 sizing = SZ_SUBS;
3198 add_subroutines ();
3199 sizing = SZ_CONVS;
3200 add_conversions ();
3201
ece3f663
KG		 3202 functions = XCNEWVAR (struct gfc_intrinsic_sym,
3203 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3204 + sizeof (gfc_intrinsic_arg) * nargs);
6de9cd9a
DN		 3205
3206 next_sym = functions;
3207 subroutines = functions + nfunc;
3208
ece3f663 3209 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
6de9cd9a
DN		 3210
3211 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3212
3213 sizing = SZ_NOTHING;
3214 nconv = 0;
3215
3216 add_functions ();
3217 add_subroutines ();
3218 add_conversions ();
3219
d393bbd7
FXC		 3220 /* Character conversion intrinsics need to be treated separately. */
3221 add_char_conversions ();
3222
6de9cd9a 3223 /* Set the pure flag. All intrinsic functions are pure, and
f7b529fa 3224 intrinsic subroutines are pure if they are elemental. */
6de9cd9a
DN		 3225
3226 for (i = 0; i < nfunc; i++)
3227 functions[i].pure = 1;
3228
3229 for (i = 0; i < nsub; i++)
3230 subroutines[i].pure = subroutines[i].elemental;
3231}
3232
3233
3234void
3235gfc_intrinsic_done_1 (void)
3236{
3237 gfc_free (functions);
3238 gfc_free (conversion);
d393bbd7 3239 gfc_free (char_conversions);
6de9cd9a
DN		 3240 gfc_free_namespace (gfc_intrinsic_namespace);
3241}
3242
3243
3244/******** Subroutines to check intrinsic interfaces ***********/
3245
3246/* Given a formal argument list, remove any NULL arguments that may
3247 have been left behind by a sort against some formal argument list. */
3248
3249static void
b251af97 3250remove_nullargs (gfc_actual_arglist **ap)
6de9cd9a
DN		 3251{
3252 gfc_actual_arglist *head, *tail, *next;
3253
3254 tail = NULL;
3255
3256 for (head = *ap; head; head = next)
3257 {
3258 next = head->next;
3259
c5bfb045 3260 if (head->expr == NULL && !head->label)
6de9cd9a
DN		 3261 {
3262 head->next = NULL;
3263 gfc_free_actual_arglist (head);
3264 }
3265 else
3266 {
3267 if (tail == NULL)
3268 *ap = head;
3269 else
3270 tail->next = head;
3271
3272 tail = head;
3273 tail->next = NULL;
3274 }
3275 }
3276
3277 if (tail == NULL)
3278 *ap = NULL;
3279}
3280
3281
3282/* Given an actual arglist and a formal arglist, sort the actual
3283 arglist so that its arguments are in a one-to-one correspondence
3284 with the format arglist. Arguments that are not present are given
3285 a blank gfc_actual_arglist structure. If something is obviously
3286 wrong (say, a missing required argument) we abort sorting and
3287 return FAILURE. */
3288
17b1d2a0 3289static gfc_try
b251af97
SK		 3290sort_actual (const char *name, gfc_actual_arglist **ap,
3291 gfc_intrinsic_arg *formal, locus *where)
6de9cd9a 3292{
6de9cd9a
DN		 3293 gfc_actual_arglist *actual, *a;
3294 gfc_intrinsic_arg *f;
3295
3296 remove_nullargs (ap);
3297 actual = *ap;
3298
3299 for (f = formal; f; f = f->next)
3300 f->actual = NULL;
3301
3302 f = formal;
3303 a = actual;
3304
3305 if (f == NULL && a == NULL) /* No arguments */
3306 return SUCCESS;
3307
3308 for (;;)
b251af97 3309 { /* Put the nonkeyword arguments in a 1:1 correspondence */
6de9cd9a
DN		 3310 if (f == NULL)
3311 break;
3312 if (a == NULL)
3313 goto optional;
3314
cb9e4f55 3315 if (a->name != NULL)
6de9cd9a
DN		 3316 goto keywords;
3317
3318 f->actual = a;
3319
3320 f = f->next;
3321 a = a->next;
3322 }
3323
3324 if (a == NULL)
3325 goto do_sort;
3326
3327 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3328 return FAILURE;
3329
3330keywords:
3331 /* Associate the remaining actual arguments, all of which have
3332 to be keyword arguments. */
3333 for (; a; a = a->next)
3334 {
3335 for (f = formal; f; f = f->next)
3336 if (strcmp (a->name, f->name) == 0)
3337 break;
3338
3339 if (f == NULL)
3340 {
7fcafa71 3341 if (a->name[0] == '%')
29ea08da
TB		 3342 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3343 "are not allowed in this context at %L", where);
7fcafa71
PT		 3344 else
3345 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
b251af97 3346 a->name, name, where);
6de9cd9a
DN		 3347 return FAILURE;
3348 }
3349
3350 if (f->actual != NULL)
3351 {
b41f8489 3352 gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
6de9cd9a
DN		 3353 f->name, name, where);
3354 return FAILURE;
3355 }
3356
3357 f->actual = a;
3358 }
3359
3360optional:
3361 /* At this point, all unmatched formal args must be optional. */
3362 for (f = formal; f; f = f->next)
3363 {
3364 if (f->actual == NULL && f->optional == 0)
3365 {
3366 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3367 f->name, name, where);
3368 return FAILURE;
3369 }
3370 }
3371
3372do_sort:
3373 /* Using the formal argument list, string the actual argument list
3374 together in a way that corresponds with the formal list. */
3375 actual = NULL;
3376
3377 for (f = formal; f; f = f->next)
3378 {
c5bfb045
PT		 3379 if (f->actual && f->actual->label != NULL && f->ts.type)
3380 {
3381 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3382 return FAILURE;
3383 }
3384
f9fed73b
TS		 3385 if (f->actual == NULL)
3386 {
3387 a = gfc_get_actual_arglist ();
3388 a->missing_arg_type = f->ts.type;
3389 }
3390 else
3391 a = f->actual;
6de9cd9a
DN		 3392
3393 if (actual == NULL)
3394 *ap = a;
3395 else
3396 actual->next = a;
3397
3398 actual = a;
3399 }
f7b529fa 3400 actual->next = NULL; /* End the sorted argument list. */
6de9cd9a
DN		 3401
3402 return SUCCESS;
3403}
3404
3405
3406/* Compare an actual argument list with an intrinsic's formal argument
3407 list. The lists are checked for agreement of type. We don't check
3408 for arrayness here. */
3409
17b1d2a0 3410static gfc_try
b251af97 3411check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
6de9cd9a
DN		 3412 int error_flag)
3413{
3414 gfc_actual_arglist *actual;
3415 gfc_intrinsic_arg *formal;
3416 int i;
3417
3418 formal = sym->formal;
3419 actual = *ap;
3420
3421 i = 0;
3422 for (; formal; formal = formal->next, actual = actual->next, i++)
3423 {
d393bbd7
FXC		 3424 gfc_typespec ts;
3425
6de9cd9a
DN		 3426 if (actual->expr == NULL)
3427 continue;
3428
d393bbd7
FXC		 3429 ts = formal->ts;
3430
3431 /* A kind of 0 means we don't check for kind. */
3432 if (ts.kind == 0)
3433 ts.kind = actual->expr->ts.kind;
3434
3435 if (!gfc_compare_types (&ts, &actual->expr->ts))
6de9cd9a
DN		 3436 {
3437 if (error_flag)
b251af97 3438 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
c4aa95f8 3439 "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
b251af97
SK		 3440 gfc_current_intrinsic, &actual->expr->where,
3441 gfc_typename (&formal->ts),
3442 gfc_typename (&actual->expr->ts));
6de9cd9a
DN		 3443 return FAILURE;
3444 }
3445 }
3446
3447 return SUCCESS;
3448}
3449
3450
3451/* Given a pointer to an intrinsic symbol and an expression node that
3452 represent the function call to that subroutine, figure out the type
3453 of the result. This may involve calling a resolution subroutine. */
3454
3455static void
b251af97 3456resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a
DN		 3457{
3458 gfc_expr *a1, *a2, *a3, *a4, *a5;
3459 gfc_actual_arglist *arg;
3460
3461 if (specific->resolve.f1 == NULL)
3462 {
3463 if (e->value.function.name == NULL)
3464 e->value.function.name = specific->lib_name;
3465
3466 if (e->ts.type == BT_UNKNOWN)
3467 e->ts = specific->ts;
3468 return;
3469 }
3470
3471 arg = e->value.function.actual;
3472
6de9cd9a
DN		 3473 /* Special case hacks for MIN and MAX. */
3474 if (specific->resolve.f1m == gfc_resolve_max
3475 || specific->resolve.f1m == gfc_resolve_min)
3476 {
3477 (*specific->resolve.f1m) (e, arg);
3478 return;
3479 }
3480
4c0c6b9f
SK		 3481 if (arg == NULL)
3482 {
3483 (*specific->resolve.f0) (e);
3484 return;
3485 }
3486
6de9cd9a
DN		 3487 a1 = arg->expr;
3488 arg = arg->next;
3489
3490 if (arg == NULL)
3491 {
3492 (*specific->resolve.f1) (e, a1);
3493 return;
3494 }
3495
3496 a2 = arg->expr;
3497 arg = arg->next;
3498
3499 if (arg == NULL)
3500 {
3501 (*specific->resolve.f2) (e, a1, a2);
3502 return;
3503 }
3504
3505 a3 = arg->expr;
3506 arg = arg->next;
3507
3508 if (arg == NULL)
3509 {
3510 (*specific->resolve.f3) (e, a1, a2, a3);
3511 return;
3512 }
3513
3514 a4 = arg->expr;
3515 arg = arg->next;
3516
3517 if (arg == NULL)
3518 {
3519 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3520 return;
3521 }
3522
3523 a5 = arg->expr;
3524 arg = arg->next;
3525
3526 if (arg == NULL)
3527 {
3528 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3529 return;
3530 }
3531
3532 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3533}
3534
3535
3536/* Given an intrinsic symbol node and an expression node, call the
3537 simplification function (if there is one), perhaps replacing the
3538 expression with something simpler. We return FAILURE on an error
3539 of the simplification, SUCCESS if the simplification worked, even
3540 if nothing has changed in the expression itself. */
3541
17b1d2a0 3542static gfc_try
b251af97 3543do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a
DN		 3544{
3545 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3546 gfc_actual_arglist *arg;
3547
3548 /* Max and min require special handling due to the variable number
3549 of args. */
3550 if (specific->simplify.f1 == gfc_simplify_min)
3551 {
3552 result = gfc_simplify_min (e);
3553 goto finish;
3554 }
3555
3556 if (specific->simplify.f1 == gfc_simplify_max)
3557 {
3558 result = gfc_simplify_max (e);
3559 goto finish;
3560 }
3561
3562 if (specific->simplify.f1 == NULL)
3563 {
3564 result = NULL;
3565 goto finish;
3566 }
3567
3568 arg = e->value.function.actual;
3569
4c0c6b9f
SK		 3570 if (arg == NULL)
3571 {
3572 result = (*specific->simplify.f0) ();
3573 goto finish;
3574 }
3575
6de9cd9a
DN		 3576 a1 = arg->expr;
3577 arg = arg->next;
3578
d393bbd7
FXC		 3579 if (specific->simplify.cc == gfc_convert_constant
3580 || specific->simplify.cc == gfc_convert_char_constant)
6de9cd9a 3581 {
d393bbd7 3582 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
6de9cd9a
DN		 3583 goto finish;
3584 }
3585
6de9cd9a
DN		 3586 if (arg == NULL)
3587 result = (*specific->simplify.f1) (a1);
3588 else
3589 {
3590 a2 = arg->expr;
3591 arg = arg->next;
3592
3593 if (arg == NULL)
3594 result = (*specific->simplify.f2) (a1, a2);
3595 else
3596 {
3597 a3 = arg->expr;
3598 arg = arg->next;
3599
3600 if (arg == NULL)
3601 result = (*specific->simplify.f3) (a1, a2, a3);
3602 else
3603 {
3604 a4 = arg->expr;
3605 arg = arg->next;
3606
3607 if (arg == NULL)
3608 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3609 else
3610 {
3611 a5 = arg->expr;
3612 arg = arg->next;
3613
3614 if (arg == NULL)
3615 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3616 else
3617 gfc_internal_error
3618 ("do_simplify(): Too many args for intrinsic");
3619 }
3620 }
3621 }
3622 }
3623
3624finish:
3625 if (result == &gfc_bad_expr)
3626 return FAILURE;
3627
3628 if (result == NULL)
3629 resolve_intrinsic (specific, e); /* Must call at run-time */
3630 else
3631 {
3632 result->where = e->where;
3633 gfc_replace_expr (e, result);
3634 }
3635
3636 return SUCCESS;
3637}
3638
3639
3640/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3641 error messages. This subroutine returns FAILURE if a subroutine
3642 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3643 list cannot match any intrinsic. */
3644
3645static void
b251af97 3646init_arglist (gfc_intrinsic_sym *isym)
6de9cd9a
DN		 3647{
3648 gfc_intrinsic_arg *formal;
3649 int i;
3650
3651 gfc_current_intrinsic = isym->name;
3652
3653 i = 0;
3654 for (formal = isym->formal; formal; formal = formal->next)
3655 {
3656 if (i >= MAX_INTRINSIC_ARGS)
3657 gfc_internal_error ("init_arglist(): too many arguments");
c4aa95f8 3658 gfc_current_intrinsic_arg[i++] = formal;
6de9cd9a
DN		 3659 }
3660}
3661
3662
3663/* Given a pointer to an intrinsic symbol and an expression consisting
3664 of a function call, see if the function call is consistent with the
3665 intrinsic's formal argument list. Return SUCCESS if the expression
3666 and intrinsic match, FAILURE otherwise. */
3667
17b1d2a0 3668static gfc_try
b251af97 3669check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
6de9cd9a
DN		 3670{
3671 gfc_actual_arglist *arg, **ap;
17b1d2a0 3672 gfc_try t;
6de9cd9a
DN		 3673
3674 ap = &expr->value.function.actual;
3675
3676 init_arglist (specific);
3677
3678 /* Don't attempt to sort the argument list for min or max. */
3679 if (specific->check.f1m == gfc_check_min_max
3680 || specific->check.f1m == gfc_check_min_max_integer
3681 || specific->check.f1m == gfc_check_min_max_real
3682 || specific->check.f1m == gfc_check_min_max_double)
3683 return (*specific->check.f1m) (*ap);
3684
3685 if (sort_actual (specific->name, ap, specific->formal,
3686 &expr->where) == FAILURE)
3687 return FAILURE;
3688
7551270e 3689 if (specific->check.f3ml == gfc_check_minloc_maxloc)
b251af97 3690 /* This is special because we might have to reorder the argument list. */
7551270e 3691 t = gfc_check_minloc_maxloc (*ap);
617097a3 3692 else if (specific->check.f3red == gfc_check_minval_maxval)
7551270e
ES		 3693 /* This is also special because we also might have to reorder the
3694 argument list. */
617097a3
TS		 3695 t = gfc_check_minval_maxval (*ap);
3696 else if (specific->check.f3red == gfc_check_product_sum)
3697 /* Same here. The difference to the previous case is that we allow a
3698 general numeric type. */
3699 t = gfc_check_product_sum (*ap);
7551270e 3700 else
f3207b37
TS		 3701 {
3702 if (specific->check.f1 == NULL)
3703 {
3704 t = check_arglist (ap, specific, error_flag);
3705 if (t == SUCCESS)
3706 expr->ts = specific->ts;
3707 }
3708 else
3709 t = do_check (specific, *ap);
3710 }
6de9cd9a 3711
0881653c 3712 /* Check conformance of elemental intrinsics. */
6de9cd9a
DN		 3713 if (t == SUCCESS && specific->elemental)
3714 {
0881653c
DF		 3715 int n = 0;
3716 gfc_expr *first_expr;
3717 arg = expr->value.function.actual;
6de9cd9a 3718
0881653c
DF		 3719 /* There is no elemental intrinsic without arguments. */
3720 gcc_assert(arg != NULL);
3721 first_expr = arg->expr;
3722
3723 for ( ; arg && arg->expr; arg = arg->next, n++)
ca8a8795
DF		 3724 if (gfc_check_conformance (first_expr, arg->expr,
3725 "arguments '%s' and '%s' for "
3726 "intrinsic '%s'",
c4aa95f8
JW		 3727 gfc_current_intrinsic_arg[0]->name,
3728 gfc_current_intrinsic_arg[n]->name,
ca8a8795
DF		 3729 gfc_current_intrinsic) == FAILURE)
3730 return FAILURE;
6de9cd9a
DN		 3731 }
3732
3733 if (t == FAILURE)
3734 remove_nullargs (ap);
3735
3736 return t;
3737}
3738
3739
b7892582 3740/* Check whether an intrinsic belongs to whatever standard the user
c3005b0f
DK		 3741 has chosen, taking also into account -fall-intrinsics. Here, no
3742 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3743 textual representation of the symbols standard status (like
3744 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3745 can be used to construct a detailed warning/error message in case of
3746 a FAILURE. */
b7892582 3747
17b1d2a0 3748gfc_try
c3005b0f
DK		 3749gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3750 const char** symstd, bool silent, locus where)
b7892582 3751{
c3005b0f
DK		 3752 const char* symstd_msg;
3753
3754 /* For -fall-intrinsics, just succeed. */
3755 if (gfc_option.flag_all_intrinsics)
3f2286f2 3756 return SUCCESS;
b7892582 3757
c3005b0f
DK		 3758 /* Find the symbol's standard message for later usage. */
3759 switch (isym->standard)
3760 {
3761 case GFC_STD_F77:
3762 symstd_msg = "available since Fortran 77";
3763 break;
3f2286f2 3764
c3005b0f
DK		 3765 case GFC_STD_F95_OBS:
3766 symstd_msg = "obsolescent in Fortran 95";
3767 break;
3768
3769 case GFC_STD_F95_DEL:
3770 symstd_msg = "deleted in Fortran 95";
3771 break;
3772
3773 case GFC_STD_F95:
3774 symstd_msg = "new in Fortran 95";
3775 break;
3776
3777 case GFC_STD_F2003:
3778 symstd_msg = "new in Fortran 2003";
3779 break;
3780
3781 case GFC_STD_F2008:
3782 symstd_msg = "new in Fortran 2008";
3783 break;
3784
3785 case GFC_STD_GNU:
3786 symstd_msg = "a GNU Fortran extension";
3787 break;
3788
3789 case GFC_STD_LEGACY:
3790 symstd_msg = "for backward compatibility";
3791 break;
3792
3793 default:
3794 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3795 isym->name, isym->standard);
3796 }
3797
3798 /* If warning about the standard, warn and succeed. */
3799 if (gfc_option.warn_std & isym->standard)
3800 {
3801 /* Do only print a warning if not a GNU extension. */
3802 if (!silent && isym->standard != GFC_STD_GNU)
3803 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3804 isym->name, _(symstd_msg), &where);
3805
3806 return SUCCESS;
3807 }
3808
3809 /* If allowing the symbol's standard, succeed, too. */
3810 if (gfc_option.allow_std & isym->standard)
3811 return SUCCESS;
3812
3813 /* Otherwise, fail. */
3814 if (symstd)
3815 *symstd = _(symstd_msg);
3816 return FAILURE;
b7892582
JB		 3817}
3818
3819
6de9cd9a
DN		 3820/* See if a function call corresponds to an intrinsic function call.
3821 We return:
3822
3823 MATCH_YES if the call corresponds to an intrinsic, simplification
b251af97 3824 is done if possible.
6de9cd9a
DN		 3825
3826 MATCH_NO if the call does not correspond to an intrinsic
3827
3828 MATCH_ERROR if the call corresponds to an intrinsic but there was an
b251af97 3829 error during the simplification process.
6de9cd9a
DN		 3830
3831 The error_flag parameter enables an error reporting. */
3832
3833match
b251af97 3834gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
6de9cd9a
DN		 3835{
3836 gfc_intrinsic_sym *isym, *specific;
3837 gfc_actual_arglist *actual;
3838 const char *name;
3839 int flag;
3840
3841 if (expr->value.function.isym != NULL)
3842 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
b251af97 3843 ? MATCH_ERROR : MATCH_YES;
6de9cd9a 3844
a3d3c0f5
DK		 3845 if (!error_flag)
3846 gfc_push_suppress_errors ();
6de9cd9a
DN		 3847 flag = 0;
3848
3849 for (actual = expr->value.function.actual; actual; actual = actual->next)
3850 if (actual->expr != NULL)
3851 flag |= (actual->expr->ts.type != BT_INTEGER
3852 && actual->expr->ts.type != BT_CHARACTER);
3853
3854 name = expr->symtree->n.sym->name;
3855
3856 isym = specific = gfc_find_function (name);
3857 if (isym == NULL)
3858 {
a3d3c0f5
DK		 3859 if (!error_flag)
3860 gfc_pop_suppress_errors ();
6de9cd9a
DN		 3861 return MATCH_NO;
3862 }
3863
b7970354
TB		 3864 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3865 || isym->id == GFC_ISYM_CMPLX)
f2cbd86c 3866 && gfc_init_expr_flag
b7970354
TB		 3867 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3868 "as initialization expression at %L", name,
3869 &expr->where) == FAILURE)
a3d3c0f5
DK		 3870 {
3871 if (!error_flag)
3872 gfc_pop_suppress_errors ();
3873 return MATCH_ERROR;
3874 }
b7970354 3875
6de9cd9a
DN		 3876 gfc_current_intrinsic_where = &expr->where;
3877
3878 /* Bypass the generic list for min and max. */
3879 if (isym->check.f1m == gfc_check_min_max)
3880 {
3881 init_arglist (isym);
3882
3883 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3884 goto got_specific;
3885
a3d3c0f5
DK		 3886 if (!error_flag)
3887 gfc_pop_suppress_errors ();
6de9cd9a
DN		 3888 return MATCH_NO;
3889 }
3890
3891 /* If the function is generic, check all of its specific
3892 incarnations. If the generic name is also a specific, we check
3893 that name last, so that any error message will correspond to the
3894 specific. */
a3d3c0f5 3895 gfc_push_suppress_errors ();
6de9cd9a
DN		 3896
3897 if (isym->generic)
3898 {
3899 for (specific = isym->specific_head; specific;
3900 specific = specific->next)
3901 {
3902 if (specific == isym)
3903 continue;
3904 if (check_specific (specific, expr, 0) == SUCCESS)
a3d3c0f5
DK		 3905 {
3906 gfc_pop_suppress_errors ();
3907 goto got_specific;
3908 }
6de9cd9a
DN		 3909 }
3910 }
3911
a3d3c0f5 3912 gfc_pop_suppress_errors ();
6de9cd9a
DN		 3913
3914 if (check_specific (isym, expr, error_flag) == FAILURE)
3915 {
a3d3c0f5
DK		 3916 if (!error_flag)
3917 gfc_pop_suppress_errors ();
6de9cd9a
DN		 3918 return MATCH_NO;
3919 }
3920
3921 specific = isym;
3922
3923got_specific:
3924 expr->value.function.isym = specific;
3925 gfc_intrinsic_symbol (expr->symtree->n.sym);
3926
a3d3c0f5
DK		 3927 if (!error_flag)
3928 gfc_pop_suppress_errors ();
3929
6de9cd9a 3930 if (do_simplify (specific, expr) == FAILURE)
14ceeb32 3931 return MATCH_ERROR;
6de9cd9a 3932
e1633d82
DF		 3933 /* F95, 7.1.6.1, Initialization expressions
3934 (4) An elemental intrinsic function reference of type integer or
3935 character where each argument is an initialization expression
3936 of type integer or character
3937
3938 F2003, 7.1.7 Initialization expression
3939 (4) A reference to an elemental standard intrinsic function,
3940 where each argument is an initialization expression */
3941
f2cbd86c 3942 if (gfc_init_expr_flag && isym->elemental && flag
ef7e861a
TB		 3943 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3944 "as initialization expression with non-integer/non-"
3945 "character arguments at %L", &expr->where) == FAILURE)
e1633d82 3946 return MATCH_ERROR;
6de9cd9a
DN		 3947
3948 return MATCH_YES;
3949}
3950
3951
3952/* See if a CALL statement corresponds to an intrinsic subroutine.
3953 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3954 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3955 correspond). */
3956
3957match
b251af97 3958gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
6de9cd9a
DN		 3959{
3960 gfc_intrinsic_sym *isym;
3961 const char *name;
3962
3963 name = c->symtree->n.sym->name;
3964
cd5ecab6 3965 isym = gfc_find_subroutine (name);
6de9cd9a
DN		 3966 if (isym == NULL)
3967 return MATCH_NO;
3968
a3d3c0f5
DK		 3969 if (!error_flag)
3970 gfc_push_suppress_errors ();
6de9cd9a
DN		 3971
3972 init_arglist (isym);
3973
3974 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3975 goto fail;
3976
3977 if (isym->check.f1 != NULL)
3978 {
3979 if (do_check (isym, c->ext.actual) == FAILURE)
3980 goto fail;
3981 }
3982 else
3983 {
3984 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3985 goto fail;
3986 }
3987
3988 /* The subroutine corresponds to an intrinsic. Allow errors to be
f7b529fa 3989 seen at this point. */
a3d3c0f5
DK		 3990 if (!error_flag)
3991 gfc_pop_suppress_errors ();
6de9cd9a 3992
12f681a0 3993 c->resolved_isym = isym;
6de9cd9a
DN		 3994 if (isym->resolve.s1 != NULL)
3995 isym->resolve.s1 (c);
3996 else
42a8c358
TB		 3997 {
3998 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3999 c->resolved_sym->attr.elemental = isym->elemental;
4000 }
6de9cd9a
DN		 4001
4002 if (gfc_pure (NULL) && !isym->elemental)
4003 {
4004 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
4005 &c->loc);
4006 return MATCH_ERROR;
4007 }
4008
fe58e076 4009 c->resolved_sym->attr.noreturn = isym->noreturn;
b7892582 4010
6de9cd9a
DN		 4011 return MATCH_YES;
4012
4013fail:
a3d3c0f5
DK		 4014 if (!error_flag)
4015 gfc_pop_suppress_errors ();
6de9cd9a
DN		 4016 return MATCH_NO;
4017}
4018
4019
4020/* Call gfc_convert_type() with warning enabled. */
4021
17b1d2a0 4022gfc_try
b251af97 4023gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
6de9cd9a
DN		 4024{
4025 return gfc_convert_type_warn (expr, ts, eflag, 1);
4026}
4027
4028
4029/* Try to convert an expression (in place) from one type to another.
4030 'eflag' controls the behavior on error.
4031
4032 The possible values are:
4033
4034 1 Generate a gfc_error()
4035 2 Generate a gfc_internal_error().
4036
4037 'wflag' controls the warning related to conversion. */
4038
17b1d2a0 4039gfc_try
b251af97 4040gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
6de9cd9a
DN		 4041{
4042 gfc_intrinsic_sym *sym;
4043 gfc_typespec from_ts;
4044 locus old_where;
7b901ac4 4045 gfc_expr *new_expr;
6de9cd9a 4046 int rank;
323c74da 4047 mpz_t *shape;
6de9cd9a
DN		 4048
4049 from_ts = expr->ts; /* expr->ts gets clobbered */
4050
4051 if (ts->type == BT_UNKNOWN)
4052 goto bad;
4053
4054 /* NULL and zero size arrays get their type here. */
4055 if (expr->expr_type == EXPR_NULL
b251af97 4056 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
6de9cd9a
DN		 4057 {
4058 /* Sometimes the RHS acquire the type. */
4059 expr->ts = *ts;
4060 return SUCCESS;
4061 }
4062
4063 if (expr->ts.type == BT_UNKNOWN)
4064 goto bad;
4065
b251af97 4066 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
6de9cd9a
DN		 4067 && gfc_compare_types (&expr->ts, ts))
4068 return SUCCESS;
4069
4070 sym = find_conv (&expr->ts, ts);
4071 if (sym == NULL)
4072 goto bad;
4073
4074 /* At this point, a conversion is necessary. A warning may be needed. */
c3a29423 4075 if ((gfc_option.warn_std & sym->standard) != 0)
4e42ad66 4076 {
daf8c6f0
DF		 4077 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
4078 gfc_typename (&from_ts), gfc_typename (ts),
4079 &expr->where);
4080 }
4081 else if (wflag)
4082 {
33169a22
DF		 4083 if (gfc_option.flag_range_check
4084 && expr->expr_type == EXPR_CONSTANT
4085 && from_ts.type == ts->type)
4086 {
4087 /* Do nothing. Constants of the same type are range-checked
4088 elsewhere. If a value too large for the target type is
4089 assigned, an error is generated. Not checking here avoids
4090 duplications of warnings/errors.
4091 If range checking was disabled, but -Wconversion enabled,
4092 a non range checked warning is generated below. */
4093 }
4094 else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
4095 {
4096 /* Do nothing. This block exists only to simplify the other
4097 else-if expressions.
4098 LOGICAL <> LOGICAL no warning, independent of kind values
4099 LOGICAL <> INTEGER extension, warned elsewhere
4100 LOGICAL <> REAL invalid, error generated elsewhere
4101 LOGICAL <> COMPLEX invalid, error generated elsewhere */
4102 }
4103 else if (from_ts.type == ts->type
4104 || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
4105 || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
4106 || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
4107 {
4108 /* Larger kinds can hold values of smaller kinds without problems.
4109 Hence, only warn if target kind is smaller than the source
4110 kind - or if -Wconversion-extra is specified. */
4111 if (gfc_option.warn_conversion_extra)
4112 gfc_warning_now ("Conversion from %s to %s at %L",
4113 gfc_typename (&from_ts), gfc_typename (ts),
4114 &expr->where);
4115 else if (gfc_option.warn_conversion
4116 && from_ts.kind > ts->kind)
4117 gfc_warning_now ("Possible change of value in conversion "
4118 "from %s to %s at %L", gfc_typename (&from_ts),
4119 gfc_typename (ts), &expr->where);
4120 }
4121 else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
4122 || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
4123 || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
4124 {
4125 /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
4126 usually comes with a loss of information, regardless of kinds. */
4127 if (gfc_option.warn_conversion_extra
4128 || gfc_option.warn_conversion)
4129 gfc_warning_now ("Possible change of value in conversion "
4130 "from %s to %s at %L", gfc_typename (&from_ts),
4131 gfc_typename (ts), &expr->where);
4132 }
4133 else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
4134 {
4135 /* If HOLLERITH is involved, all bets are off. */
4136 if (gfc_option.warn_conversion_extra
4137 || gfc_option.warn_conversion)
4138 gfc_warning_now ("Conversion from %s to %s at %L",
4139 gfc_typename (&from_ts), gfc_typename (ts),
4140 &expr->where);
4141 }
4142 else
4143 gcc_unreachable ();
4e42ad66 4144 }
6de9cd9a
DN		 4145
4146 /* Insert a pre-resolved function call to the right function. */
4147 old_where = expr->where;
4148 rank = expr->rank;
323c74da
RH		 4149 shape = expr->shape;
4150
7b901ac4
KG		 4151 new_expr = gfc_get_expr ();
4152 *new_expr = *expr;
4153
4154 new_expr = gfc_build_conversion (new_expr);
4155 new_expr->value.function.name = sym->lib_name;
4156 new_expr->value.function.isym = sym;
4157 new_expr->where = old_where;
4158 new_expr->rank = rank;
4159 new_expr->shape = gfc_copy_shape (shape, rank);
4160
4161 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4b41f35e 4162 new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
7b901ac4
KG		 4163 new_expr->symtree->n.sym->ts = *ts;
4164 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4165 new_expr->symtree->n.sym->attr.function = 1;
4166 new_expr->symtree->n.sym->attr.elemental = 1;
4167 new_expr->symtree->n.sym->attr.pure = 1;
4168 new_expr->symtree->n.sym->attr.referenced = 1;
4169 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4170 gfc_commit_symbol (new_expr->symtree->n.sym);
4171
4172 *expr = *new_expr;
4173
4174 gfc_free (new_expr);
6de9cd9a
DN		 4175 expr->ts = *ts;
4176
4177 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4178 && do_simplify (sym, expr) == FAILURE)
4179 {
4180
4181 if (eflag == 2)
4182 goto bad;
4183 return FAILURE; /* Error already generated in do_simplify() */
4184 }
4185
4186 return SUCCESS;
4187
4188bad:
4189 if (eflag == 1)
4190 {
4191 gfc_error ("Can't convert %s to %s at %L",
4192 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4193 return FAILURE;
4194 }
4195
4196 gfc_internal_error ("Can't convert %s to %s at %L",
4197 gfc_typename (&from_ts), gfc_typename (ts),
4198 &expr->where);
4199 /* Not reached */
4200}
d393bbd7
FXC		 4201
4202
17b1d2a0 4203gfc_try
d393bbd7
FXC		 4204gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4205{
4206 gfc_intrinsic_sym *sym;
d393bbd7 4207 locus old_where;
7b901ac4 4208 gfc_expr *new_expr;
d393bbd7
FXC		 4209 int rank;
4210 mpz_t *shape;
4211
4212 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
d393bbd7
FXC		 4213
4214 sym = find_char_conv (&expr->ts, ts);
4215 gcc_assert (sym);
4216
4217 /* Insert a pre-resolved function call to the right function. */
4218 old_where = expr->where;
4219 rank = expr->rank;
4220 shape = expr->shape;
4221
7b901ac4
KG		 4222 new_expr = gfc_get_expr ();
4223 *new_expr = *expr;
d393bbd7 4224
7b901ac4
KG		 4225 new_expr = gfc_build_conversion (new_expr);
4226 new_expr->value.function.name = sym->lib_name;
4227 new_expr->value.function.isym = sym;
4228 new_expr->where = old_where;
4229 new_expr->rank = rank;
4230 new_expr->shape = gfc_copy_shape (shape, rank);
d393bbd7 4231
7b901ac4
KG		 4232 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4233 new_expr->symtree->n.sym->ts = *ts;
4234 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4235 new_expr->symtree->n.sym->attr.function = 1;
4236 new_expr->symtree->n.sym->attr.elemental = 1;
4237 new_expr->symtree->n.sym->attr.referenced = 1;
4238 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4239 gfc_commit_symbol (new_expr->symtree->n.sym);
d393bbd7 4240
7b901ac4 4241 *expr = *new_expr;
d393bbd7 4242
7b901ac4 4243 gfc_free (new_expr);
d393bbd7
FXC		 4244 expr->ts = *ts;
4245
4246 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4247 && do_simplify (sym, expr) == FAILURE)
4248 {
4249 /* Error already generated in do_simplify() */
4250 return FAILURE;
4251 }
4252
4253 return SUCCESS;
4254}
c3005b0f
DK		 4255
4256
4257/* Check if the passed name is name of an intrinsic (taking into account the
4258 current -std=* and -fall-intrinsic settings). If it is, see if we should
4259 warn about this as a user-procedure having the same name as an intrinsic
4260 (-Wintrinsic-shadow enabled) and do so if we should. */
4261
4262void
4263gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4264{
4265 gfc_intrinsic_sym* isym;
4266
4267 /* If the warning is disabled, do nothing at all. */
4268 if (!gfc_option.warn_intrinsic_shadow)
4269 return;
4270
4271 /* Try to find an intrinsic of the same name. */
4272 if (func)
4273 isym = gfc_find_function (sym->name);
4274 else
4275 isym = gfc_find_subroutine (sym->name);
4276
4277 /* If no intrinsic was found with this name or it's not included in the
4278 selected standard, everything's fine. */
4279 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4280 sym->declared_at) == FAILURE)
4281 return;
4282
4283 /* Emit the warning. */
4284 if (in_module)
4285 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4286 " name. In order to call the intrinsic, explicit INTRINSIC"
4287 " declarations may be required.",
4288 sym->name, &sym->declared_at);
4289 else
4290 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4291 " only be called via an explicit interface or if declared"
4292 " EXTERNAL.", sym->name, &sym->declared_at);
4293}
Mirror of https://gcc.gnu.org/git/gcc.git