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