]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/intrinsic.c
sh.c (expand_cbranchdi4): Use a scratch register for the none zero constant operand...
[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);
23e38561 306 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,
6de9cd9a 1192 gfc_check_all_any, NULL, 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,
6de9cd9a 1214 gfc_check_all_any, NULL, 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,
6de9cd9a 1454 gfc_check_count, NULL, 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,
8d2c2905 1502 GFC_STD_F95, gfc_check_dot_product, NULL, 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,
1848 gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED);
1849
1850 make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
1851
1852 add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
1853 CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
1854 gfc_check_i, NULL, NULL, i, BT_INTEGER, 0, REQUIRED);
1855
1856 make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
1857
3d97b1af
FXC
1858 add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL,
1859 dl, GFC_STD_GNU, gfc_check_isnan, NULL, NULL,
1860 x, BT_REAL, 0, REQUIRED);
1861
1862 make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
1863
e1633d82 1864 add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
a119fc1c
FXC
1865 gfc_check_ishft, NULL, gfc_resolve_rshift,
1866 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1867
1868 make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
1869
e1633d82 1870 add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
a119fc1c
FXC
1871 gfc_check_ishft, NULL, gfc_resolve_lshift,
1872 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
1873
1874 make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
1875
e1633d82 1876 add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1877 gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
1270d633 1878 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
6de9cd9a 1879
b7892582 1880 make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
6de9cd9a 1881
e1633d82 1882 add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1883 gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
1270d633
SK
1884 i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
1885 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1886
b7892582 1887 make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
6de9cd9a 1888
e1633d82 1889 add_sym_2 ("kill", GFC_ISYM_KILL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
f77b6ca3
FXC
1890 gfc_check_kill, NULL, gfc_resolve_kill,
1891 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
1892
1893 make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
1894
e1633d82 1895 add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
1270d633
SK
1896 gfc_check_kind, gfc_simplify_kind, NULL,
1897 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1898
cd5ecab6 1899 make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
6de9cd9a 1900
5cda5098
FXC
1901 add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
1902 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 1903 gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
5cda5098
FXC
1904 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
1905 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1906
b7892582 1907 make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
6de9cd9a 1908
414f00e9
SB
1909 add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
1910 BT_INTEGER, di, GFC_STD_F2008,
1911 gfc_check_i, gfc_simplify_leadz, NULL,
1912 i, BT_INTEGER, di, REQUIRED);
1913
1914 make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
1915
5cda5098
FXC
1916 add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
1917 BT_INTEGER, di, GFC_STD_F77,
1918 gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
1919 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1920
b7892582 1921 make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
6de9cd9a 1922
5cda5098
FXC
1923 add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
1924 BT_INTEGER, di, GFC_STD_F95,
1925 gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
1926 stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 1927
f77b6ca3
FXC
1928 make_alias ("lnblnk", GFC_STD_GNU);
1929
b7892582 1930 make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
6de9cd9a 1931
f489fba1
FXC
1932 add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
1933 dr, GFC_STD_GNU,
75be5dc0
TB
1934 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1935 x, BT_REAL, dr, REQUIRED);
1936
f489fba1
FXC
1937 make_alias ("log_gamma", GFC_STD_F2008);
1938
75be5dc0
TB
1939 add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
1940 gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
1941 x, BT_REAL, dr, REQUIRED);
1942
1943 add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
15ead859 1944 gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
75be5dc0
TB
1945 x, BT_REAL, dr, REQUIRED);
1946
f489fba1 1947 make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
75be5dc0
TB
1948
1949
d393bbd7
FXC
1950 add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1951 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
1270d633 1952 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 1953
b7892582 1954 make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
6de9cd9a 1955
d393bbd7
FXC
1956 add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1957 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
1270d633 1958 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 1959
b7892582 1960 make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
6de9cd9a 1961
d393bbd7
FXC
1962 add_sym_2 ("lle",GFC_ISYM_LLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1963 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
1270d633 1964 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 1965
b7892582 1966 make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
6de9cd9a 1967
d393bbd7
FXC
1968 add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
1969 GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
1270d633 1970 sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 1971
b7892582 1972 make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
6de9cd9a 1973
2f8cce28
FXC
1974 add_sym_2 ("link", GFC_ISYM_LINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
1975 GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
1976 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
1977
1978 make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
1979
e1633d82 1980 add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
985aff9c 1981 gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
1270d633 1982 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1983
e1633d82 1984 add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
1270d633
SK
1985 NULL, gfc_simplify_log, gfc_resolve_log,
1986 x, BT_REAL, dr, REQUIRED);
6de9cd9a 1987
e1633d82 1988 add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 1989 gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
1270d633 1990 x, BT_REAL, dd, REQUIRED);
6de9cd9a 1991
e1633d82 1992 add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 1993 NULL, gfc_simplify_log, gfc_resolve_log,
1270d633 1994 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 1995
e1633d82 1996 add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK
1997 NULL, gfc_simplify_log, gfc_resolve_log,
1998 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 1999
19060788 2000 make_alias ("cdlog", GFC_STD_GNU);
6de9cd9a 2001
b7892582 2002 make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
6de9cd9a 2003
e1633d82 2004 add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
985aff9c 2005 gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2006 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2007
e1633d82 2008 add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2009 NULL, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2010 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2011
e1633d82 2012 add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2013 gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
1270d633 2014 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2015
b7892582 2016 make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
6de9cd9a 2017
e1633d82 2018 add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
6de9cd9a 2019 gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
1270d633 2020 l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2021
b7892582 2022 make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
6de9cd9a 2023
2f8cce28
FXC
2024 add_sym_2 ("lstat", GFC_ISYM_LSTAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2025 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_lstat,
2026 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
bf3fb7e4
FXC
2027
2028 make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
2029
2f8cce28
FXC
2030 add_sym_1 ("malloc", GFC_ISYM_MALLOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2031 GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
2032 sz, BT_INTEGER, di, REQUIRED);
0d519038
FXC
2033
2034 make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
2035
e1633d82 2036 add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2037 gfc_check_matmul, NULL, gfc_resolve_matmul,
1270d633 2038 ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
6de9cd9a 2039
b7892582 2040 make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
6de9cd9a
DN
2041
2042 /* Note: amax0 is equivalent to real(max), max1 is equivalent to
2043 int(max). The max function must take at least two arguments. */
2044
e1633d82 2045 add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
6de9cd9a 2046 gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
1270d633 2047 a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2048
e1633d82 2049 add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2050 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1270d633 2051 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2052
e1633d82 2053 add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2054 gfc_check_min_max_integer, gfc_simplify_max, NULL,
1270d633 2055 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2056
e1633d82 2057 add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2058 gfc_check_min_max_real, gfc_simplify_max, NULL,
1270d633 2059 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2060
e1633d82 2061 add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2062 gfc_check_min_max_real, gfc_simplify_max, NULL,
1270d633 2063 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2064
e1633d82 2065 add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 2066 gfc_check_min_max_double, gfc_simplify_max, NULL,
1270d633 2067 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
6de9cd9a 2068
b7892582 2069 make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
6de9cd9a 2070
e1633d82 2071 add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
8d2c2905 2072 GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
1270d633 2073 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2074
cd5ecab6 2075 make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
6de9cd9a 2076
e1633d82 2077 add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
f3207b37 2078 gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
1270d633
SK
2079 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2080 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2081
b7892582 2082 make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
6de9cd9a 2083
e1633d82 2084 add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
5a0193ee 2085 gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
1270d633
SK
2086 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2087 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2088
b7892582 2089 make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
6de9cd9a 2090
2f8cce28
FXC
2091 add_sym_0 ("mclock", GFC_ISYM_MCLOCK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2092 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
bf3fb7e4
FXC
2093
2094 make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
2095
2f8cce28
FXC
2096 add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2097 GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
bf3fb7e4
FXC
2098
2099 make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
2100
e1633d82 2101 add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8f2b565d 2102 gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
1270d633
SK
2103 ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
2104 msk, BT_LOGICAL, dl, REQUIRED);
6de9cd9a 2105
b7892582 2106 make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
6de9cd9a 2107
1270d633
SK
2108 /* Note: amin0 is equivalent to real(min), min1 is equivalent to
2109 int(min). */
6de9cd9a 2110
e1633d82 2111 add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
6de9cd9a 2112 gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
b251af97 2113 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2114
e1633d82 2115 add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2116 gfc_check_min_max_integer, gfc_simplify_min, NULL,
b251af97 2117 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2118
e1633d82 2119 add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2120 gfc_check_min_max_integer, gfc_simplify_min, NULL,
b251af97 2121 a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
6de9cd9a 2122
e1633d82 2123 add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2124 gfc_check_min_max_real, gfc_simplify_min, NULL,
b251af97 2125 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2126
e1633d82 2127 add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2128 gfc_check_min_max_real, gfc_simplify_min, NULL,
b251af97 2129 a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
6de9cd9a 2130
e1633d82 2131 add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
6de9cd9a 2132 gfc_check_min_max_double, gfc_simplify_min, NULL,
b251af97 2133 a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
6de9cd9a 2134
b7892582 2135 make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
6de9cd9a 2136
e1633d82 2137 add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
8d2c2905 2138 GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
1270d633 2139 x, BT_UNKNOWN, dr, REQUIRED);
6de9cd9a 2140
cd5ecab6 2141 make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
6de9cd9a 2142
e1633d82 2143 add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
f3207b37 2144 gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
1270d633
SK
2145 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2146 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2147
b7892582 2148 make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
6de9cd9a 2149
e1633d82 2150 add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
5a0193ee 2151 gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
1270d633
SK
2152 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2153 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2154
b7892582 2155 make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
6de9cd9a 2156
e1633d82 2157 add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2158 gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2159 a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
6de9cd9a 2160
e1633d82 2161 add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2162 NULL, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2163 a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
6de9cd9a 2164
e1633d82 2165 add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2166 gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
1270d633 2167 a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
6de9cd9a 2168
b7892582 2169 make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
6de9cd9a 2170
e1633d82 2171 add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
6de9cd9a 2172 gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
1270d633 2173 a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
6de9cd9a 2174
b7892582 2175 make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
6de9cd9a 2176
e1633d82 2177 add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
8765339d 2178 gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
1270d633 2179 x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
6de9cd9a 2180
b7892582 2181 make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
6de9cd9a 2182
e1633d82 2183 add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
8d2c2905 2184 GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
9fe3100e 2185 a, BT_CHARACTER, dc, REQUIRED);
bec93d79 2186
cd5ecab6
DF
2187 make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
2188
e1633d82 2189 add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2190 gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
1270d633 2191 a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2192
e1633d82 2193 add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2194 gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
1270d633 2195 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2196
b7892582 2197 make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
6de9cd9a 2198
e1633d82 2199 add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2200 gfc_check_i, gfc_simplify_not, gfc_resolve_not,
1270d633 2201 i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2202
b7892582 2203 make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
6de9cd9a 2204
e1633d82 2205 add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2206 gfc_check_null, gfc_simplify_null, NULL,
1270d633 2207 mo, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2208
cd5ecab6 2209 make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
6de9cd9a 2210
e1633d82 2211 add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2212 gfc_check_pack, NULL, gfc_resolve_pack,
1270d633
SK
2213 ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2214 v, BT_REAL, dr, OPTIONAL);
6de9cd9a 2215
b7892582 2216 make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
6de9cd9a 2217
e1633d82 2218 add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2219 gfc_check_precision, gfc_simplify_precision, NULL,
1270d633 2220 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2221
cd5ecab6 2222 make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
6de9cd9a 2223
23e38561
JW
2224 add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
2225 BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
2226 a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
6de9cd9a 2227
b7892582 2228 make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
6de9cd9a 2229
e1633d82 2230 add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
b251af97 2231 gfc_check_product_sum, NULL, gfc_resolve_product,
1270d633
SK
2232 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2233 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2234
b7892582 2235 make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
6de9cd9a 2236
e1633d82 2237 add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2238 gfc_check_radix, gfc_simplify_radix, NULL,
1270d633 2239 x, BT_UNKNOWN, 0, REQUIRED);
6de9cd9a 2240
cd5ecab6 2241 make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
6de9cd9a 2242
2bd74949 2243 /* The following function is for G77 compatibility. */
e1633d82 2244 add_sym_1 ("rand", GFC_ISYM_RAND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
b251af97
SK
2245 gfc_check_rand, NULL, NULL,
2246 i, BT_INTEGER, 4, OPTIONAL);
2bd74949 2247
1270d633
SK
2248 /* Compatibility with HP FORTRAN 77/iX Reference. Note, rand() and ran()
2249 use slightly different shoddy multiplicative congruential PRNG. */
19060788 2250 make_alias ("ran", GFC_STD_GNU);
f8e566e5 2251
b7892582 2252 make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
2bd74949 2253
e1633d82 2254 add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2255 gfc_check_range, gfc_simplify_range, NULL,
1270d633 2256 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2257
cd5ecab6 2258 make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
6de9cd9a 2259
e1633d82 2260 add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2261 gfc_check_real, gfc_simplify_real, gfc_resolve_real,
1270d633 2262 a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2263
6970fcc8 2264 /* This provides compatibility with g77. */
e1633d82 2265 add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
6970fcc8
SK
2266 gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
2267 a, BT_UNKNOWN, dr, REQUIRED);
2268
7f59aaba 2269 add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
6110b776 2270 gfc_check_i, gfc_simplify_float, NULL,
1270d633 2271 a, BT_INTEGER, di, REQUIRED);
6de9cd9a 2272
7f59aaba 2273 add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
1270d633
SK
2274 NULL, gfc_simplify_sngl, NULL,
2275 a, BT_REAL, dd, REQUIRED);
6de9cd9a 2276
b7892582 2277 make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
6de9cd9a 2278
2f8cce28
FXC
2279 add_sym_2 ("rename", GFC_ISYM_RENAME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2280 GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
2281 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
2282
2283 make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
2284
e1633d82 2285 add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 2286 gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
0881653c 2287 stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 2288
b7892582 2289 make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
6de9cd9a 2290
e1633d82 2291 add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2292 gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
1270d633
SK
2293 src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
2294 pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
6de9cd9a 2295
b7892582 2296 make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
6de9cd9a 2297
e1633d82 2298 add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2299 gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
1270d633 2300 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2301
b7892582 2302 make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
6de9cd9a 2303
e1633d82 2304 add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2305 gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
1270d633 2306 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2307
b7892582 2308 make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
6de9cd9a 2309
5cda5098
FXC
2310 add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
2311 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2312 gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
1270d633 2313 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 2314 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2315
b7892582 2316 make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
6de9cd9a 2317
f7b529fa 2318 /* Added for G77 compatibility garbage. */
e1633d82 2319 add_sym_0 ("second", GFC_ISYM_SECOND, NO_CLASS, ACTUAL_NO, BT_REAL, 4, GFC_STD_GNU,
1270d633 2320 NULL, NULL, NULL);
2bd74949 2321
b7892582 2322 make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
2bd74949 2323
53096259 2324 /* Added for G77 compatibility. */
e1633d82 2325 add_sym_1 ("secnds", GFC_ISYM_SECNDS, NO_CLASS, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
53096259
PT
2326 gfc_check_secnds, NULL, gfc_resolve_secnds,
2327 x, BT_REAL, dr, REQUIRED);
2328
2329 make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
2330
a39fafac
FXC
2331 add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
2332 ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
2333 gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
2334 NULL, nm, BT_CHARACTER, dc, REQUIRED);
2335
2336 make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
2337
e1633d82 2338 add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC
2339 GFC_STD_F95, gfc_check_selected_int_kind,
2340 gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
6de9cd9a 2341
b7892582 2342 make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
6de9cd9a 2343
e1633d82 2344 add_sym_2 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
8d2c2905
FXC
2345 GFC_STD_F95, gfc_check_selected_real_kind,
2346 gfc_simplify_selected_real_kind, NULL,
1270d633 2347 p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2348
b7892582 2349 make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
6de9cd9a 2350
e1633d82 2351 add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a
DN
2352 gfc_check_set_exponent, gfc_simplify_set_exponent,
2353 gfc_resolve_set_exponent,
1270d633 2354 x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
6de9cd9a 2355
b7892582 2356 make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
6de9cd9a 2357
e1633d82 2358 add_sym_1 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2359 gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
1270d633 2360 src, BT_REAL, dr, REQUIRED);
6de9cd9a 2361
b7892582 2362 make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
6de9cd9a 2363
e1633d82 2364 add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
6de9cd9a 2365 gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2366 a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
6de9cd9a 2367
e1633d82 2368 add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
6de9cd9a 2369 NULL, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2370 a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
6de9cd9a 2371
e1633d82 2372 add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2373 gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
1270d633 2374 a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
6de9cd9a 2375
b7892582 2376 make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
6de9cd9a 2377
e1633d82 2378 add_sym_2 ("signal", GFC_ISYM_SIGNAL, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
185d7d97
FXC
2379 gfc_check_signal, NULL, gfc_resolve_signal,
2380 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED);
2381
2382 make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
2383
e1633d82 2384 add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2385 gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2386 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2387
e1633d82 2388 add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2389 gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2390 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2391
e1633d82 2392 add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2393 NULL, gfc_simplify_sin, gfc_resolve_sin,
1270d633 2394 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2395
e1633d82 2396 add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK
2397 NULL, gfc_simplify_sin, gfc_resolve_sin,
2398 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2399
19060788 2400 make_alias ("cdsin", GFC_STD_GNU);
6de9cd9a 2401
b7892582 2402 make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
6de9cd9a 2403
e1633d82 2404 add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2405 gfc_check_fn_r, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 2406 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2407
e1633d82 2408 add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2409 gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
1270d633 2410 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2411
b7892582 2412 make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
6de9cd9a 2413
5cda5098
FXC
2414 add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
2415 BT_INTEGER, di, GFC_STD_F95,
2416 gfc_check_size, gfc_simplify_size, gfc_resolve_size,
2417 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2418 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2419
b7892582 2420 make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
6de9cd9a 2421
e1633d82 2422 add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
fd2157ce 2423 GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
8d82b242 2424 x, BT_UNKNOWN, 0, REQUIRED);
fd2157ce 2425
cd5ecab6 2426 make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
8d82b242 2427 make_alias ("c_sizeof", GFC_STD_F2008);
fd2157ce 2428
e1633d82 2429 add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2430 gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
1270d633 2431 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2432
b7892582 2433 make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
6de9cd9a 2434
e1633d82 2435 add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2436 gfc_check_spread, NULL, gfc_resolve_spread,
1270d633 2437 src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
0881653c 2438 ncopies, BT_INTEGER, di, REQUIRED);
6de9cd9a 2439
b7892582 2440 make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
6de9cd9a 2441
e1633d82 2442 add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2443 gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 2444 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2445
e1633d82 2446 add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2447 gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 2448 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2449
e1633d82 2450 add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
6de9cd9a 2451 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
1270d633 2452 x, BT_COMPLEX, dz, REQUIRED);
6de9cd9a 2453
e1633d82 2454 add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
1270d633
SK
2455 NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
2456 x, BT_COMPLEX, dd, REQUIRED);
6de9cd9a 2457
19060788 2458 make_alias ("cdsqrt", GFC_STD_GNU);
6de9cd9a 2459
b7892582 2460 make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
6de9cd9a 2461
2f8cce28
FXC
2462 add_sym_2 ("stat", GFC_ISYM_STAT, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2463 GFC_STD_GNU, gfc_check_stat, NULL, gfc_resolve_stat,
2464 nm, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
df65f093
SK
2465
2466 make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
2467
e1633d82 2468 add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
b251af97 2469 gfc_check_product_sum, NULL, gfc_resolve_sum,
1270d633
SK
2470 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2471 msk, BT_LOGICAL, dl, OPTIONAL);
6de9cd9a 2472
b7892582 2473 make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
6de9cd9a 2474
2f8cce28
FXC
2475 add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2476 GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
2477 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
f77b6ca3
FXC
2478
2479 make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
2480
2f8cce28
FXC
2481 add_sym_1 ("system", GFC_ISYM_SYSTEM, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2482 GFC_STD_GNU, NULL, NULL, NULL,
2483 com, BT_CHARACTER, dc, REQUIRED);
1270d633 2484
b7892582 2485 make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
5b1374e9 2486
e1633d82 2487 add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2488 gfc_check_fn_r, gfc_simplify_tan, gfc_resolve_tan,
1270d633 2489 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2490
e1633d82 2491 add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2492 gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
1270d633 2493 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2494
b7892582 2495 make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
6de9cd9a 2496
e1633d82 2497 add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
985aff9c 2498 gfc_check_fn_r, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 2499 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2500
e1633d82 2501 add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
15ead859 2502 gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
1270d633 2503 x, BT_REAL, dd, REQUIRED);
6de9cd9a 2504
b7892582 2505 make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
6de9cd9a 2506
e1633d82 2507 add_sym_0 ("time", GFC_ISYM_TIME, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
f77b6ca3
FXC
2508 NULL, NULL, gfc_resolve_time);
2509
2510 make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
2511
e1633d82 2512 add_sym_0 ("time8", GFC_ISYM_TIME8, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
f77b6ca3
FXC
2513 NULL, NULL, gfc_resolve_time8);
2514
2515 make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
2516
e1633d82 2517 add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
1270d633
SK
2518 gfc_check_x, gfc_simplify_tiny, NULL,
2519 x, BT_REAL, dr, REQUIRED);
6de9cd9a 2520
cd5ecab6 2521 make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
6de9cd9a 2522
414f00e9
SB
2523 add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
2524 BT_INTEGER, di, GFC_STD_F2008,
2525 gfc_check_i, gfc_simplify_trailz, NULL,
2526 i, BT_INTEGER, di, REQUIRED);
2527
2528 make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
2529
e1633d82 2530 add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
a4a11197 2531 gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
1270d633
SK
2532 src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
2533 sz, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2534
b7892582 2535 make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
6de9cd9a 2536
e1633d82 2537 add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2538 gfc_check_transpose, NULL, gfc_resolve_transpose,
1270d633 2539 m, BT_REAL, dr, REQUIRED);
6de9cd9a 2540
b7892582 2541 make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
6de9cd9a 2542
e1633d82 2543 add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
6de9cd9a 2544 gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
1270d633 2545 stg, BT_CHARACTER, dc, REQUIRED);
6de9cd9a 2546
b7892582 2547 make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
6de9cd9a 2548
e1633d82 2549 add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, ACTUAL_NO, BT_CHARACTER, 0, GFC_STD_GNU,
b251af97
SK
2550 gfc_check_ttynam, NULL, gfc_resolve_ttynam,
2551 ut, BT_INTEGER, di, REQUIRED);
25fc05eb
FXC
2552
2553 make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
2554
5cda5098
FXC
2555 add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
2556 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2557 gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
5cda5098
FXC
2558 ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
2559 kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2560
b7892582 2561 make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
6de9cd9a 2562
d8fe26b2 2563 /* g77 compatibility for UMASK. */
2f8cce28
FXC
2564 add_sym_1 ("umask", GFC_ISYM_UMASK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di,
2565 GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
2566 msk, BT_INTEGER, di, REQUIRED);
d8fe26b2
SK
2567
2568 make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
2569
2570 /* g77 compatibility for UNLINK. */
e1633d82 2571 add_sym_1 ("unlink", GFC_ISYM_UNLINK, NO_CLASS, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
d8fe26b2 2572 gfc_check_unlink, NULL, gfc_resolve_unlink,
2f8cce28 2573 "path", BT_CHARACTER, dc, REQUIRED);
d8fe26b2
SK
2574
2575 make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
2576
e1633d82 2577 add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
6de9cd9a 2578 gfc_check_unpack, NULL, gfc_resolve_unpack,
1270d633
SK
2579 v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
2580 f, BT_REAL, dr, REQUIRED);
6de9cd9a 2581
b7892582 2582 make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
6de9cd9a 2583
5cda5098
FXC
2584 add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
2585 BT_INTEGER, di, GFC_STD_F95,
6de9cd9a 2586 gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
1270d633 2587 stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
5cda5098 2588 bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
6de9cd9a 2589
b7892582 2590 make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
83d890b9 2591
2f8cce28
FXC
2592 add_sym_1 ("loc", GFC_ISYM_LOC, NO_CLASS, ACTUAL_NO, BT_INTEGER, ii,
2593 GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
2594 x, BT_UNKNOWN, 0, REQUIRED);
83d890b9
AL
2595
2596 make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
6de9cd9a
DN
2597}
2598
2599
6de9cd9a
DN
2600/* Add intrinsic subroutines. */
2601
2602static void
2603add_subroutines (void)
2604{
2605 /* Argument names as in the standard (to be used as argument keywords). */
2606 const char
2607 *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
2608 *c = "count", *tm = "time", *tp = "topos", *gt = "get",
2609 *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
b41b2534
JB
2610 *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
2611 *com = "command", *length = "length", *st = "status",
aa6fc635 2612 *val = "value", *num = "number", *name = "name",
185d7d97 2613 *trim_name = "trim_name", *ut = "unit", *han = "handler",
dcdc26df 2614 *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
2f8cce28
FXC
2615 *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
2616 *p2 = "path2", *msk = "mask", *old = "old";
6de9cd9a 2617
0d519038 2618 int di, dr, dc, dl, ii;
6de9cd9a 2619
9d64df18
TS
2620 di = gfc_default_integer_kind;
2621 dr = gfc_default_real_kind;
2622 dc = gfc_default_character_kind;
2623 dl = gfc_default_logical_kind;
0d519038 2624 ii = gfc_index_integer_kind;
6de9cd9a 2625
cd5ecab6 2626 add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
6de9cd9a 2627
3f2286f2 2628 make_noreturn();
fe58e076 2629
23e38561
JW
2630 add_sym_1s_intent ("cpu_time", GFC_ISYM_CPU_TIME, NO_CLASS, BT_UNKNOWN, 0,
2631 GFC_STD_F95, gfc_check_cpu_time, NULL,
2632 gfc_resolve_cpu_time,
2633 tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
6de9cd9a 2634
f7b529fa 2635 /* More G77 compatibility garbage. */
e1633d82 2636 add_sym_2s ("ctime", GFC_ISYM_CTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210
FXC
2637 gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
2638 tm, BT_INTEGER, di, REQUIRED, res, BT_CHARACTER, dc, REQUIRED);
2639
e1633d82 2640 add_sym_1s ("idate", GFC_ISYM_IDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210
FXC
2641 gfc_check_itime_idate, NULL, gfc_resolve_idate,
2642 vl, BT_INTEGER, 4, REQUIRED);
2643
e1633d82 2644 add_sym_1s ("itime", GFC_ISYM_ITIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
12197210
FXC
2645 gfc_check_itime_idate, NULL, gfc_resolve_itime,
2646 vl, BT_INTEGER, 4, REQUIRED);
35059811 2647
e1633d82 2648 add_sym_2s ("ltime", GFC_ISYM_LTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
a119fc1c
FXC
2649 gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
2650 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2651
e1633d82 2652 add_sym_2s ("gmtime", GFC_ISYM_GMTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
a119fc1c
FXC
2653 gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
2654 tm, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED);
2655
e1633d82 2656 add_sym_1s ("second", GFC_ISYM_SECOND, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2bd74949 2657 gfc_check_second_sub, NULL, gfc_resolve_second_sub,
1270d633 2658 tm, BT_REAL, dr, REQUIRED);
2bd74949 2659
e1633d82 2660 add_sym_2s ("chdir", GFC_ISYM_CHDIR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2661 gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
f77b6ca3
FXC
2662 name, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2663
e1633d82 2664 add_sym_3s ("chmod", GFC_ISYM_CHMOD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2665 gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
a119fc1c
FXC
2666 name, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED,
2667 st, BT_INTEGER, di, OPTIONAL);
2668
23e38561
JW
2669 add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, NO_CLASS, BT_UNKNOWN, 0,
2670 GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
2671 dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2672 tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2673 zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2674 vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 2675
f7b529fa 2676 /* More G77 compatibility garbage. */
e1633d82 2677 add_sym_2s ("etime", GFC_ISYM_ETIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 2678 gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
1270d633 2679 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2bd74949 2680
e1633d82 2681 add_sym_2s ("dtime", GFC_ISYM_DTIME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
a1ba31ce 2682 gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
1270d633 2683 vl, BT_REAL, 4, REQUIRED, tm, BT_REAL, 4, REQUIRED);
2bd74949 2684
e1633d82 2685 add_sym_1s ("fdate", GFC_ISYM_FDATE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97
SK
2686 gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
2687 dt, BT_CHARACTER, dc, REQUIRED);
35059811 2688
e1633d82 2689 add_sym_1s ("gerror", GFC_ISYM_GERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
f53e867d 2690 gfc_check_gerror, NULL, gfc_resolve_gerror, res, BT_CHARACTER,
f77b6ca3
FXC
2691 dc, REQUIRED);
2692
e1633d82 2693 add_sym_2s ("getcwd", GFC_ISYM_GETCWD, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2694 gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
1270d633 2695 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
a8c60d7f 2696
e1633d82 2697 add_sym_2s ("getenv", GFC_ISYM_GETENV, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
aa6fc635 2698 NULL, NULL, NULL,
b251af97
SK
2699 name, BT_CHARACTER, dc, REQUIRED, val, BT_CHARACTER, dc,
2700 REQUIRED);
aa6fc635 2701
e1633d82 2702 add_sym_2s ("getarg", GFC_ISYM_GETARG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
ed8315d5
FXC
2703 gfc_check_getarg, NULL, gfc_resolve_getarg,
2704 pos, BT_INTEGER, di, REQUIRED, val, BT_CHARACTER, dc, REQUIRED);
a8c60d7f 2705
e1633d82 2706 add_sym_1s ("getlog", GFC_ISYM_GETLOG, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2707 gfc_check_getlog, NULL, gfc_resolve_getlog, c, BT_CHARACTER,
f77b6ca3
FXC
2708 dc, REQUIRED);
2709
b41b2534
JB
2710 /* F2003 commandline routines. */
2711
23e38561
JW
2712 add_sym_3s_intent ("get_command", GFC_ISYM_GET_COMMAND, NO_CLASS, BT_UNKNOWN,
2713 0, GFC_STD_F2003, NULL, NULL, gfc_resolve_get_command,
2714 com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2715 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2716 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
60c9a35b 2717
23e38561
JW
2718 add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT, NO_CLASS,
2719 BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
2720 gfc_resolve_get_command_argument,
2721 num, BT_INTEGER, di, REQUIRED, INTENT_IN,
2722 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2723 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2724 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
aa6fc635 2725
f7b529fa 2726 /* F2003 subroutine to get environment variables. */
aa6fc635 2727
23e38561
JW
2728 add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
2729 NO_CLASS, BT_UNKNOWN, 0, GFC_STD_F2003,
b251af97 2730 NULL, NULL, gfc_resolve_get_environment_variable,
23e38561
JW
2731 name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
2732 val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
2733 length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2734 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2735 trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
2736
2737 add_sym_2s_intent ("move_alloc", GFC_ISYM_MOVE_ALLOC, NO_CLASS, BT_UNKNOWN, 0,
2738 GFC_STD_F2003, gfc_check_move_alloc, NULL, NULL,
2739 f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
2740 t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
2741
2742 add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
2743 GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
2744 gfc_resolve_mvbits,
2745 f, BT_INTEGER, di, REQUIRED, INTENT_IN,
2746 fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
2747 ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
2748 t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
2749 tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
2750
2751 add_sym_1s_intent ("random_number", GFC_ISYM_RANDOM_NUMBER, NO_CLASS,
2752 BT_UNKNOWN, 0, GFC_STD_F95, gfc_check_random_number, NULL,
2753 gfc_resolve_random_number,
2754 h, BT_REAL, dr, REQUIRED, INTENT_OUT);
2755
2756 add_sym_3s_intent ("random_seed", GFC_ISYM_RANDOM_SEED, NO_CLASS,
2757 BT_UNKNOWN, 0, GFC_STD_F95,
2758 gfc_check_random_seed, NULL, gfc_resolve_random_seed,
2759 sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2760 pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
2761 gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
6de9cd9a 2762
f7b529fa 2763 /* More G77 compatibility garbage. */
e1633d82 2764 add_sym_3s ("alarm", GFC_ISYM_ALARM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
185d7d97
FXC
2765 gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
2766 sec, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2767 st, BT_INTEGER, di, OPTIONAL);
2768
e1633d82 2769 add_sym_1s ("srand", GFC_ISYM_SRAND, NO_CLASS, BT_UNKNOWN, di, GFC_STD_GNU,
b251af97 2770 gfc_check_srand, NULL, gfc_resolve_srand,
2f8cce28 2771 "seed", BT_INTEGER, 4, REQUIRED);
2bd74949 2772
e1633d82 2773 add_sym_1s ("exit", GFC_ISYM_EXIT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2774 gfc_check_exit, NULL, gfc_resolve_exit,
9fe3100e 2775 st, BT_INTEGER, di, OPTIONAL);
d8fe26b2 2776
3f2286f2 2777 make_noreturn();
fe58e076 2778
e1633d82 2779 add_sym_3s ("fgetc", GFC_ISYM_FGETC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC
2780 gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
2781 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2782 st, BT_INTEGER, di, OPTIONAL);
2783
e1633d82 2784 add_sym_2s ("fget", GFC_ISYM_FGET, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC
2785 gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
2786 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2787
e1633d82 2788 add_sym_1s ("flush", GFC_ISYM_FLUSH, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093 2789 gfc_check_flush, NULL, gfc_resolve_flush,
ca41838c 2790 ut, BT_INTEGER, di, OPTIONAL);
df65f093 2791
e1633d82 2792 add_sym_3s ("fputc", GFC_ISYM_FPUTC, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC
2793 gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
2794 ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED,
2795 st, BT_INTEGER, di, OPTIONAL);
2796
e1633d82 2797 add_sym_2s ("fput", GFC_ISYM_FPUT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC
2798 gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
2799 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2800
2f8cce28
FXC
2801 add_sym_1s ("free", GFC_ISYM_FREE, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
2802 gfc_check_free, NULL, gfc_resolve_free,
2803 ptr, BT_INTEGER, ii, REQUIRED);
0d519038 2804
e1633d82 2805 add_sym_4s ("fseek", GFC_ISYM_FSEEK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
dcdc26df 2806 gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
23e38561
JW
2807 ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
2808 of, BT_INTEGER, di, REQUIRED, INTENT_IN,
2809 whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
2810 st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
dcdc26df 2811
e1633d82 2812 add_sym_2s ("ftell", GFC_ISYM_FTELL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
5d723e54
FXC
2813 gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
2814 ut, BT_INTEGER, di, REQUIRED, of, BT_INTEGER, ii, REQUIRED);
2815
e1633d82 2816 add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2817 gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
f77b6ca3
FXC
2818 c, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2819
e1633d82 2820 add_sym_3s ("kill", GFC_ISYM_KILL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_kill_sub,
f77b6ca3
FXC
2821 NULL, gfc_resolve_kill_sub, c, BT_INTEGER, di, REQUIRED,
2822 val, BT_INTEGER, di, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2823
e1633d82 2824 add_sym_3s ("link", GFC_ISYM_LINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2825 gfc_check_link_sub, NULL, gfc_resolve_link_sub,
2f8cce28 2826 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
f77b6ca3
FXC
2827 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2828
e1633d82 2829 add_sym_1s ("perror", GFC_ISYM_PERROR, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2830 gfc_check_perror, NULL, gfc_resolve_perror,
2f8cce28 2831 "string", BT_CHARACTER, dc, REQUIRED);
f77b6ca3 2832
e1633d82 2833 add_sym_3s ("rename", GFC_ISYM_RENAME, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2834 gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
2f8cce28 2835 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
f77b6ca3
FXC
2836 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2837
e1633d82 2838 add_sym_1s ("sleep", GFC_ISYM_SLEEP, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2839 gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
2f8cce28 2840 sec, BT_INTEGER, di, REQUIRED);
f77b6ca3 2841
e1633d82 2842 add_sym_3s ("fstat", GFC_ISYM_FSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093
SK
2843 gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
2844 ut, BT_INTEGER, di, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2845 st, BT_INTEGER, di, OPTIONAL);
2846
e1633d82 2847 add_sym_3s ("lstat", GFC_ISYM_LSTAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
bf3fb7e4
FXC
2848 gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
2849 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2850 st, BT_INTEGER, di, OPTIONAL);
2851
e1633d82 2852 add_sym_3s ("stat", GFC_ISYM_STAT, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
df65f093
SK
2853 gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
2854 name, BT_CHARACTER, dc, REQUIRED, vl, BT_INTEGER, di, REQUIRED,
2855 st, BT_INTEGER, di, OPTIONAL);
2856
e1633d82 2857 add_sym_3s ("signal", GFC_ISYM_SIGNAL, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
185d7d97
FXC
2858 gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
2859 num, BT_INTEGER, di, REQUIRED, han, BT_UNKNOWN, 0, REQUIRED,
2860 st, BT_INTEGER, di, OPTIONAL);
2861
e1633d82 2862 add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2863 gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
2f8cce28 2864 p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER,
f77b6ca3
FXC
2865 dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
2866
e1633d82 2867 add_sym_2s ("system", GFC_ISYM_SYSTEM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
5b1374e9 2868 NULL, NULL, gfc_resolve_system_sub,
d393bbd7 2869 com, BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
5b1374e9 2870
23e38561
JW
2871 add_sym_3s_intent ("system_clock", GFC_ISYM_SYSTEM_CLOCK, NO_CLASS,
2872 BT_UNKNOWN, 0, GFC_STD_F95,
2873 gfc_check_system_clock, NULL, gfc_resolve_system_clock,
2874 c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2875 cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
2876 cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
d8fe26b2 2877
e1633d82 2878 add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2879 gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
f53e867d 2880 ut, BT_INTEGER, di, REQUIRED, name, BT_CHARACTER, dc, REQUIRED);
ae8b8789 2881
e1633d82 2882 add_sym_2s ("umask", GFC_ISYM_UMASK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2883 gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
2f8cce28 2884 msk, BT_INTEGER, di, REQUIRED, old, BT_INTEGER, di, OPTIONAL);
d8fe26b2 2885
e1633d82 2886 add_sym_2s ("unlink", GFC_ISYM_UNLINK, NO_CLASS, BT_UNKNOWN, 0, GFC_STD_GNU,
b251af97 2887 gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
2f8cce28 2888 "path", BT_CHARACTER, dc, REQUIRED, st, BT_INTEGER, di, OPTIONAL);
6de9cd9a
DN
2889}
2890
2891
2892/* Add a function to the list of conversion symbols. */
2893
2894static void
c3a29423 2895add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
6de9cd9a 2896{
6de9cd9a
DN
2897 gfc_typespec from, to;
2898 gfc_intrinsic_sym *sym;
2899
2900 if (sizing == SZ_CONVS)
2901 {
2902 nconv++;
2903 return;
2904 }
2905
2906 gfc_clear_ts (&from);
2907 from.type = from_type;
2908 from.kind = from_kind;
2909
2910 gfc_clear_ts (&to);
2911 to.type = to_type;
2912 to.kind = to_kind;
2913
2914 sym = conversion + nconv;
2915
c3a29423 2916 sym->name = conv_name (&from, &to);
cb9e4f55 2917 sym->lib_name = sym->name;
c3a29423
RS
2918 sym->simplify.cc = gfc_convert_constant;
2919 sym->standard = standard;
6de9cd9a 2920 sym->elemental = 1;
e1633d82 2921 sym->conversion = 1;
6de9cd9a 2922 sym->ts = to;
cd5ecab6 2923 sym->id = GFC_ISYM_CONVERSION;
6de9cd9a
DN
2924
2925 nconv++;
2926}
2927
2928
2929/* Create gfc_intrinsic_sym nodes for all intrinsic conversion
2930 functions by looping over the kind tables. */
2931
2932static void
2933add_conversions (void)
2934{
2935 int i, j;
2936
2937 /* Integer-Integer conversions. */
2938 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2939 for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
2940 {
2941 if (i == j)
2942 continue;
2943
2944 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 2945 BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
2946 }
2947
2948 /* Integer-Real/Complex conversions. */
2949 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2950 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2951 {
2952 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 2953 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
2954
2955 add_conv (BT_REAL, gfc_real_kinds[j].kind,
c3a29423 2956 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN
2957
2958 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
c3a29423 2959 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
2960
2961 add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
c3a29423 2962 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
6de9cd9a
DN
2963 }
2964
d3642f89
FW
2965 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
2966 {
2967 /* Hollerith-Integer conversions. */
2968 for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
2969 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2970 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
2971 /* Hollerith-Real conversions. */
2972 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2973 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2974 BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2975 /* Hollerith-Complex conversions. */
2976 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2977 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2978 BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
2979
2980 /* Hollerith-Character conversions. */
2981 add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
2982 gfc_default_character_kind, GFC_STD_LEGACY);
2983
2984 /* Hollerith-Logical conversions. */
2985 for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
2986 add_conv (BT_HOLLERITH, gfc_default_character_kind,
2987 BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
2988 }
2989
6de9cd9a
DN
2990 /* Real/Complex - Real/Complex conversions. */
2991 for (i = 0; gfc_real_kinds[i].kind != 0; i++)
2992 for (j = 0; gfc_real_kinds[j].kind != 0; j++)
2993 {
2994 if (i != j)
2995 {
2996 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 2997 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
2998
2999 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 3000 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
3001 }
3002
3003 add_conv (BT_REAL, gfc_real_kinds[i].kind,
c3a29423 3004 BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
3005
3006 add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
c3a29423 3007 BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
6de9cd9a
DN
3008 }
3009
3010 /* Logical/Logical kind conversion. */
3011 for (i = 0; gfc_logical_kinds[i].kind; i++)
3012 for (j = 0; gfc_logical_kinds[j].kind; j++)
3013 {
3014 if (i == j)
3015 continue;
3016
3017 add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
c3a29423 3018 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
6de9cd9a 3019 }
c3a29423
RS
3020
3021 /* Integer-Logical and Logical-Integer conversions. */
3022 if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
3023 for (i=0; gfc_integer_kinds[i].kind; i++)
3024 for (j=0; gfc_logical_kinds[j].kind; j++)
3025 {
3026 add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
3027 BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
3028 add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
3029 BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
3030 }
6de9cd9a
DN
3031}
3032
3033
d393bbd7
FXC
3034static void
3035add_char_conversions (void)
3036{
3037 int n, i, j;
3038
3039 /* Count possible conversions. */
3040 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3041 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3042 if (i != j)
3043 ncharconv++;
3044
3045 /* Allocate memory. */
ece3f663 3046 char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
d393bbd7
FXC
3047
3048 /* Add the conversions themselves. */
3049 n = 0;
3050 for (i = 0; gfc_character_kinds[i].kind != 0; i++)
3051 for (j = 0; gfc_character_kinds[j].kind != 0; j++)
3052 {
3053 gfc_typespec from, to;
3054
3055 if (i == j)
3056 continue;
3057
3058 gfc_clear_ts (&from);
3059 from.type = BT_CHARACTER;
3060 from.kind = gfc_character_kinds[i].kind;
3061
3062 gfc_clear_ts (&to);
3063 to.type = BT_CHARACTER;
3064 to.kind = gfc_character_kinds[j].kind;
3065
3066 char_conversions[n].name = conv_name (&from, &to);
3067 char_conversions[n].lib_name = char_conversions[n].name;
3068 char_conversions[n].simplify.cc = gfc_convert_char_constant;
3069 char_conversions[n].standard = GFC_STD_F2003;
3070 char_conversions[n].elemental = 1;
3071 char_conversions[n].conversion = 0;
3072 char_conversions[n].ts = to;
3073 char_conversions[n].id = GFC_ISYM_CONVERSION;
3074
3075 n++;
3076 }
3077}
3078
3079
6de9cd9a
DN
3080/* Initialize the table of intrinsics. */
3081void
3082gfc_intrinsic_init_1 (void)
3083{
3084 int i;
3085
3086 nargs = nfunc = nsub = nconv = 0;
3087
3088 /* Create a namespace to hold the resolved intrinsic symbols. */
0366dfe9 3089 gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
6de9cd9a
DN
3090
3091 sizing = SZ_FUNCS;
3092 add_functions ();
3093 sizing = SZ_SUBS;
3094 add_subroutines ();
3095 sizing = SZ_CONVS;
3096 add_conversions ();
3097
ece3f663
KG
3098 functions = XCNEWVAR (struct gfc_intrinsic_sym,
3099 sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
3100 + sizeof (gfc_intrinsic_arg) * nargs);
6de9cd9a
DN
3101
3102 next_sym = functions;
3103 subroutines = functions + nfunc;
3104
ece3f663 3105 conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
6de9cd9a
DN
3106
3107 next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
3108
3109 sizing = SZ_NOTHING;
3110 nconv = 0;
3111
3112 add_functions ();
3113 add_subroutines ();
3114 add_conversions ();
3115
d393bbd7
FXC
3116 /* Character conversion intrinsics need to be treated separately. */
3117 add_char_conversions ();
3118
6de9cd9a 3119 /* Set the pure flag. All intrinsic functions are pure, and
f7b529fa 3120 intrinsic subroutines are pure if they are elemental. */
6de9cd9a
DN
3121
3122 for (i = 0; i < nfunc; i++)
3123 functions[i].pure = 1;
3124
3125 for (i = 0; i < nsub; i++)
3126 subroutines[i].pure = subroutines[i].elemental;
3127}
3128
3129
3130void
3131gfc_intrinsic_done_1 (void)
3132{
3133 gfc_free (functions);
3134 gfc_free (conversion);
d393bbd7 3135 gfc_free (char_conversions);
6de9cd9a
DN
3136 gfc_free_namespace (gfc_intrinsic_namespace);
3137}
3138
3139
3140/******** Subroutines to check intrinsic interfaces ***********/
3141
3142/* Given a formal argument list, remove any NULL arguments that may
3143 have been left behind by a sort against some formal argument list. */
3144
3145static void
b251af97 3146remove_nullargs (gfc_actual_arglist **ap)
6de9cd9a
DN
3147{
3148 gfc_actual_arglist *head, *tail, *next;
3149
3150 tail = NULL;
3151
3152 for (head = *ap; head; head = next)
3153 {
3154 next = head->next;
3155
c5bfb045 3156 if (head->expr == NULL && !head->label)
6de9cd9a
DN
3157 {
3158 head->next = NULL;
3159 gfc_free_actual_arglist (head);
3160 }
3161 else
3162 {
3163 if (tail == NULL)
3164 *ap = head;
3165 else
3166 tail->next = head;
3167
3168 tail = head;
3169 tail->next = NULL;
3170 }
3171 }
3172
3173 if (tail == NULL)
3174 *ap = NULL;
3175}
3176
3177
3178/* Given an actual arglist and a formal arglist, sort the actual
3179 arglist so that its arguments are in a one-to-one correspondence
3180 with the format arglist. Arguments that are not present are given
3181 a blank gfc_actual_arglist structure. If something is obviously
3182 wrong (say, a missing required argument) we abort sorting and
3183 return FAILURE. */
3184
17b1d2a0 3185static gfc_try
b251af97
SK
3186sort_actual (const char *name, gfc_actual_arglist **ap,
3187 gfc_intrinsic_arg *formal, locus *where)
6de9cd9a 3188{
6de9cd9a
DN
3189 gfc_actual_arglist *actual, *a;
3190 gfc_intrinsic_arg *f;
3191
3192 remove_nullargs (ap);
3193 actual = *ap;
3194
3195 for (f = formal; f; f = f->next)
3196 f->actual = NULL;
3197
3198 f = formal;
3199 a = actual;
3200
3201 if (f == NULL && a == NULL) /* No arguments */
3202 return SUCCESS;
3203
3204 for (;;)
b251af97 3205 { /* Put the nonkeyword arguments in a 1:1 correspondence */
6de9cd9a
DN
3206 if (f == NULL)
3207 break;
3208 if (a == NULL)
3209 goto optional;
3210
cb9e4f55 3211 if (a->name != NULL)
6de9cd9a
DN
3212 goto keywords;
3213
3214 f->actual = a;
3215
3216 f = f->next;
3217 a = a->next;
3218 }
3219
3220 if (a == NULL)
3221 goto do_sort;
3222
3223 gfc_error ("Too many arguments in call to '%s' at %L", name, where);
3224 return FAILURE;
3225
3226keywords:
3227 /* Associate the remaining actual arguments, all of which have
3228 to be keyword arguments. */
3229 for (; a; a = a->next)
3230 {
3231 for (f = formal; f; f = f->next)
3232 if (strcmp (a->name, f->name) == 0)
3233 break;
3234
3235 if (f == NULL)
3236 {
7fcafa71 3237 if (a->name[0] == '%')
29ea08da
TB
3238 gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
3239 "are not allowed in this context at %L", where);
7fcafa71
PT
3240 else
3241 gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
b251af97 3242 a->name, name, where);
6de9cd9a
DN
3243 return FAILURE;
3244 }
3245
3246 if (f->actual != NULL)
3247 {
3248 gfc_error ("Argument '%s' is appears twice in call to '%s' at %L",
3249 f->name, name, where);
3250 return FAILURE;
3251 }
3252
3253 f->actual = a;
3254 }
3255
3256optional:
3257 /* At this point, all unmatched formal args must be optional. */
3258 for (f = formal; f; f = f->next)
3259 {
3260 if (f->actual == NULL && f->optional == 0)
3261 {
3262 gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
3263 f->name, name, where);
3264 return FAILURE;
3265 }
3266 }
3267
3268do_sort:
3269 /* Using the formal argument list, string the actual argument list
3270 together in a way that corresponds with the formal list. */
3271 actual = NULL;
3272
3273 for (f = formal; f; f = f->next)
3274 {
c5bfb045
PT
3275 if (f->actual && f->actual->label != NULL && f->ts.type)
3276 {
3277 gfc_error ("ALTERNATE RETURN not permitted at %L", where);
3278 return FAILURE;
3279 }
3280
f9fed73b
TS
3281 if (f->actual == NULL)
3282 {
3283 a = gfc_get_actual_arglist ();
3284 a->missing_arg_type = f->ts.type;
3285 }
3286 else
3287 a = f->actual;
6de9cd9a
DN
3288
3289 if (actual == NULL)
3290 *ap = a;
3291 else
3292 actual->next = a;
3293
3294 actual = a;
3295 }
f7b529fa 3296 actual->next = NULL; /* End the sorted argument list. */
6de9cd9a
DN
3297
3298 return SUCCESS;
3299}
3300
3301
3302/* Compare an actual argument list with an intrinsic's formal argument
3303 list. The lists are checked for agreement of type. We don't check
3304 for arrayness here. */
3305
17b1d2a0 3306static gfc_try
b251af97 3307check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
6de9cd9a
DN
3308 int error_flag)
3309{
3310 gfc_actual_arglist *actual;
3311 gfc_intrinsic_arg *formal;
3312 int i;
3313
3314 formal = sym->formal;
3315 actual = *ap;
3316
3317 i = 0;
3318 for (; formal; formal = formal->next, actual = actual->next, i++)
3319 {
d393bbd7
FXC
3320 gfc_typespec ts;
3321
6de9cd9a
DN
3322 if (actual->expr == NULL)
3323 continue;
3324
d393bbd7
FXC
3325 ts = formal->ts;
3326
3327 /* A kind of 0 means we don't check for kind. */
3328 if (ts.kind == 0)
3329 ts.kind = actual->expr->ts.kind;
3330
3331 if (!gfc_compare_types (&ts, &actual->expr->ts))
6de9cd9a
DN
3332 {
3333 if (error_flag)
b251af97
SK
3334 gfc_error ("Type of argument '%s' in call to '%s' at %L should "
3335 "be %s, not %s", gfc_current_intrinsic_arg[i],
3336 gfc_current_intrinsic, &actual->expr->where,
3337 gfc_typename (&formal->ts),
3338 gfc_typename (&actual->expr->ts));
6de9cd9a
DN
3339 return FAILURE;
3340 }
3341 }
3342
3343 return SUCCESS;
3344}
3345
3346
3347/* Given a pointer to an intrinsic symbol and an expression node that
3348 represent the function call to that subroutine, figure out the type
3349 of the result. This may involve calling a resolution subroutine. */
3350
3351static void
b251af97 3352resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a
DN
3353{
3354 gfc_expr *a1, *a2, *a3, *a4, *a5;
3355 gfc_actual_arglist *arg;
3356
3357 if (specific->resolve.f1 == NULL)
3358 {
3359 if (e->value.function.name == NULL)
3360 e->value.function.name = specific->lib_name;
3361
3362 if (e->ts.type == BT_UNKNOWN)
3363 e->ts = specific->ts;
3364 return;
3365 }
3366
3367 arg = e->value.function.actual;
3368
6de9cd9a
DN
3369 /* Special case hacks for MIN and MAX. */
3370 if (specific->resolve.f1m == gfc_resolve_max
3371 || specific->resolve.f1m == gfc_resolve_min)
3372 {
3373 (*specific->resolve.f1m) (e, arg);
3374 return;
3375 }
3376
4c0c6b9f
SK
3377 if (arg == NULL)
3378 {
3379 (*specific->resolve.f0) (e);
3380 return;
3381 }
3382
6de9cd9a
DN
3383 a1 = arg->expr;
3384 arg = arg->next;
3385
3386 if (arg == NULL)
3387 {
3388 (*specific->resolve.f1) (e, a1);
3389 return;
3390 }
3391
3392 a2 = arg->expr;
3393 arg = arg->next;
3394
3395 if (arg == NULL)
3396 {
3397 (*specific->resolve.f2) (e, a1, a2);
3398 return;
3399 }
3400
3401 a3 = arg->expr;
3402 arg = arg->next;
3403
3404 if (arg == NULL)
3405 {
3406 (*specific->resolve.f3) (e, a1, a2, a3);
3407 return;
3408 }
3409
3410 a4 = arg->expr;
3411 arg = arg->next;
3412
3413 if (arg == NULL)
3414 {
3415 (*specific->resolve.f4) (e, a1, a2, a3, a4);
3416 return;
3417 }
3418
3419 a5 = arg->expr;
3420 arg = arg->next;
3421
3422 if (arg == NULL)
3423 {
3424 (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
3425 return;
3426 }
3427
3428 gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
3429}
3430
3431
3432/* Given an intrinsic symbol node and an expression node, call the
3433 simplification function (if there is one), perhaps replacing the
3434 expression with something simpler. We return FAILURE on an error
3435 of the simplification, SUCCESS if the simplification worked, even
3436 if nothing has changed in the expression itself. */
3437
17b1d2a0 3438static gfc_try
b251af97 3439do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
6de9cd9a
DN
3440{
3441 gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
3442 gfc_actual_arglist *arg;
3443
3444 /* Max and min require special handling due to the variable number
3445 of args. */
3446 if (specific->simplify.f1 == gfc_simplify_min)
3447 {
3448 result = gfc_simplify_min (e);
3449 goto finish;
3450 }
3451
3452 if (specific->simplify.f1 == gfc_simplify_max)
3453 {
3454 result = gfc_simplify_max (e);
3455 goto finish;
3456 }
3457
3458 if (specific->simplify.f1 == NULL)
3459 {
3460 result = NULL;
3461 goto finish;
3462 }
3463
3464 arg = e->value.function.actual;
3465
4c0c6b9f
SK
3466 if (arg == NULL)
3467 {
3468 result = (*specific->simplify.f0) ();
3469 goto finish;
3470 }
3471
6de9cd9a
DN
3472 a1 = arg->expr;
3473 arg = arg->next;
3474
d393bbd7
FXC
3475 if (specific->simplify.cc == gfc_convert_constant
3476 || specific->simplify.cc == gfc_convert_char_constant)
6de9cd9a 3477 {
d393bbd7 3478 result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
6de9cd9a
DN
3479 goto finish;
3480 }
3481
6de9cd9a
DN
3482 if (arg == NULL)
3483 result = (*specific->simplify.f1) (a1);
3484 else
3485 {
3486 a2 = arg->expr;
3487 arg = arg->next;
3488
3489 if (arg == NULL)
3490 result = (*specific->simplify.f2) (a1, a2);
3491 else
3492 {
3493 a3 = arg->expr;
3494 arg = arg->next;
3495
3496 if (arg == NULL)
3497 result = (*specific->simplify.f3) (a1, a2, a3);
3498 else
3499 {
3500 a4 = arg->expr;
3501 arg = arg->next;
3502
3503 if (arg == NULL)
3504 result = (*specific->simplify.f4) (a1, a2, a3, a4);
3505 else
3506 {
3507 a5 = arg->expr;
3508 arg = arg->next;
3509
3510 if (arg == NULL)
3511 result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
3512 else
3513 gfc_internal_error
3514 ("do_simplify(): Too many args for intrinsic");
3515 }
3516 }
3517 }
3518 }
3519
3520finish:
3521 if (result == &gfc_bad_expr)
3522 return FAILURE;
3523
3524 if (result == NULL)
3525 resolve_intrinsic (specific, e); /* Must call at run-time */
3526 else
3527 {
3528 result->where = e->where;
3529 gfc_replace_expr (e, result);
3530 }
3531
3532 return SUCCESS;
3533}
3534
3535
3536/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
3537 error messages. This subroutine returns FAILURE if a subroutine
3538 has more than MAX_INTRINSIC_ARGS, in which case the actual argument
3539 list cannot match any intrinsic. */
3540
3541static void
b251af97 3542init_arglist (gfc_intrinsic_sym *isym)
6de9cd9a
DN
3543{
3544 gfc_intrinsic_arg *formal;
3545 int i;
3546
3547 gfc_current_intrinsic = isym->name;
3548
3549 i = 0;
3550 for (formal = isym->formal; formal; formal = formal->next)
3551 {
3552 if (i >= MAX_INTRINSIC_ARGS)
3553 gfc_internal_error ("init_arglist(): too many arguments");
3554 gfc_current_intrinsic_arg[i++] = formal->name;
3555 }
3556}
3557
3558
3559/* Given a pointer to an intrinsic symbol and an expression consisting
3560 of a function call, see if the function call is consistent with the
3561 intrinsic's formal argument list. Return SUCCESS if the expression
3562 and intrinsic match, FAILURE otherwise. */
3563
17b1d2a0 3564static gfc_try
b251af97 3565check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
6de9cd9a
DN
3566{
3567 gfc_actual_arglist *arg, **ap;
17b1d2a0 3568 gfc_try t;
6de9cd9a
DN
3569
3570 ap = &expr->value.function.actual;
3571
3572 init_arglist (specific);
3573
3574 /* Don't attempt to sort the argument list for min or max. */
3575 if (specific->check.f1m == gfc_check_min_max
3576 || specific->check.f1m == gfc_check_min_max_integer
3577 || specific->check.f1m == gfc_check_min_max_real
3578 || specific->check.f1m == gfc_check_min_max_double)
3579 return (*specific->check.f1m) (*ap);
3580
3581 if (sort_actual (specific->name, ap, specific->formal,
3582 &expr->where) == FAILURE)
3583 return FAILURE;
3584
7551270e 3585 if (specific->check.f3ml == gfc_check_minloc_maxloc)
b251af97 3586 /* This is special because we might have to reorder the argument list. */
7551270e 3587 t = gfc_check_minloc_maxloc (*ap);
617097a3 3588 else if (specific->check.f3red == gfc_check_minval_maxval)
7551270e
ES
3589 /* This is also special because we also might have to reorder the
3590 argument list. */
617097a3
TS
3591 t = gfc_check_minval_maxval (*ap);
3592 else if (specific->check.f3red == gfc_check_product_sum)
3593 /* Same here. The difference to the previous case is that we allow a
3594 general numeric type. */
3595 t = gfc_check_product_sum (*ap);
7551270e 3596 else
f3207b37
TS
3597 {
3598 if (specific->check.f1 == NULL)
3599 {
3600 t = check_arglist (ap, specific, error_flag);
3601 if (t == SUCCESS)
3602 expr->ts = specific->ts;
3603 }
3604 else
3605 t = do_check (specific, *ap);
3606 }
6de9cd9a 3607
0881653c 3608 /* Check conformance of elemental intrinsics. */
6de9cd9a
DN
3609 if (t == SUCCESS && specific->elemental)
3610 {
0881653c
DF
3611 int n = 0;
3612 gfc_expr *first_expr;
3613 arg = expr->value.function.actual;
6de9cd9a 3614
0881653c
DF
3615 /* There is no elemental intrinsic without arguments. */
3616 gcc_assert(arg != NULL);
3617 first_expr = arg->expr;
3618
3619 for ( ; arg && arg->expr; arg = arg->next, n++)
3620 {
3621 char buffer[80];
3622 snprintf (buffer, 80, "arguments '%s' and '%s' for intrinsic '%s'",
3623 gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[n],
3624 gfc_current_intrinsic);
3625 if (gfc_check_conformance (buffer, first_expr, arg->expr) == FAILURE)
3626 return FAILURE;
6de9cd9a
DN
3627 }
3628 }
3629
3630 if (t == FAILURE)
3631 remove_nullargs (ap);
3632
3633 return t;
3634}
3635
3636
b7892582 3637/* Check whether an intrinsic belongs to whatever standard the user
c3005b0f
DK
3638 has chosen, taking also into account -fall-intrinsics. Here, no
3639 warning/error is emitted; but if symstd is not NULL, it is pointed to a
3640 textual representation of the symbols standard status (like
3641 "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
3642 can be used to construct a detailed warning/error message in case of
3643 a FAILURE. */
b7892582 3644
17b1d2a0 3645gfc_try
c3005b0f
DK
3646gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
3647 const char** symstd, bool silent, locus where)
b7892582 3648{
c3005b0f
DK
3649 const char* symstd_msg;
3650
3651 /* For -fall-intrinsics, just succeed. */
3652 if (gfc_option.flag_all_intrinsics)
3f2286f2 3653 return SUCCESS;
b7892582 3654
c3005b0f
DK
3655 /* Find the symbol's standard message for later usage. */
3656 switch (isym->standard)
3657 {
3658 case GFC_STD_F77:
3659 symstd_msg = "available since Fortran 77";
3660 break;
3f2286f2 3661
c3005b0f
DK
3662 case GFC_STD_F95_OBS:
3663 symstd_msg = "obsolescent in Fortran 95";
3664 break;
3665
3666 case GFC_STD_F95_DEL:
3667 symstd_msg = "deleted in Fortran 95";
3668 break;
3669
3670 case GFC_STD_F95:
3671 symstd_msg = "new in Fortran 95";
3672 break;
3673
3674 case GFC_STD_F2003:
3675 symstd_msg = "new in Fortran 2003";
3676 break;
3677
3678 case GFC_STD_F2008:
3679 symstd_msg = "new in Fortran 2008";
3680 break;
3681
3682 case GFC_STD_GNU:
3683 symstd_msg = "a GNU Fortran extension";
3684 break;
3685
3686 case GFC_STD_LEGACY:
3687 symstd_msg = "for backward compatibility";
3688 break;
3689
3690 default:
3691 gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
3692 isym->name, isym->standard);
3693 }
3694
3695 /* If warning about the standard, warn and succeed. */
3696 if (gfc_option.warn_std & isym->standard)
3697 {
3698 /* Do only print a warning if not a GNU extension. */
3699 if (!silent && isym->standard != GFC_STD_GNU)
3700 gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
3701 isym->name, _(symstd_msg), &where);
3702
3703 return SUCCESS;
3704 }
3705
3706 /* If allowing the symbol's standard, succeed, too. */
3707 if (gfc_option.allow_std & isym->standard)
3708 return SUCCESS;
3709
3710 /* Otherwise, fail. */
3711 if (symstd)
3712 *symstd = _(symstd_msg);
3713 return FAILURE;
b7892582
JB
3714}
3715
3716
6de9cd9a
DN
3717/* See if a function call corresponds to an intrinsic function call.
3718 We return:
3719
3720 MATCH_YES if the call corresponds to an intrinsic, simplification
b251af97 3721 is done if possible.
6de9cd9a
DN
3722
3723 MATCH_NO if the call does not correspond to an intrinsic
3724
3725 MATCH_ERROR if the call corresponds to an intrinsic but there was an
b251af97 3726 error during the simplification process.
6de9cd9a
DN
3727
3728 The error_flag parameter enables an error reporting. */
3729
3730match
b251af97 3731gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
6de9cd9a
DN
3732{
3733 gfc_intrinsic_sym *isym, *specific;
3734 gfc_actual_arglist *actual;
3735 const char *name;
3736 int flag;
3737
3738 if (expr->value.function.isym != NULL)
3739 return (do_simplify (expr->value.function.isym, expr) == FAILURE)
b251af97 3740 ? MATCH_ERROR : MATCH_YES;
6de9cd9a 3741
a3d3c0f5
DK
3742 if (!error_flag)
3743 gfc_push_suppress_errors ();
6de9cd9a
DN
3744 flag = 0;
3745
3746 for (actual = expr->value.function.actual; actual; actual = actual->next)
3747 if (actual->expr != NULL)
3748 flag |= (actual->expr->ts.type != BT_INTEGER
3749 && actual->expr->ts.type != BT_CHARACTER);
3750
3751 name = expr->symtree->n.sym->name;
3752
3753 isym = specific = gfc_find_function (name);
3754 if (isym == NULL)
3755 {
a3d3c0f5
DK
3756 if (!error_flag)
3757 gfc_pop_suppress_errors ();
6de9cd9a
DN
3758 return MATCH_NO;
3759 }
3760
b7970354
TB
3761 if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
3762 || isym->id == GFC_ISYM_CMPLX)
3763 && gfc_init_expr
3764 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
3765 "as initialization expression at %L", name,
3766 &expr->where) == FAILURE)
a3d3c0f5
DK
3767 {
3768 if (!error_flag)
3769 gfc_pop_suppress_errors ();
3770 return MATCH_ERROR;
3771 }
b7970354 3772
6de9cd9a
DN
3773 gfc_current_intrinsic_where = &expr->where;
3774
3775 /* Bypass the generic list for min and max. */
3776 if (isym->check.f1m == gfc_check_min_max)
3777 {
3778 init_arglist (isym);
3779
3780 if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
3781 goto got_specific;
3782
a3d3c0f5
DK
3783 if (!error_flag)
3784 gfc_pop_suppress_errors ();
6de9cd9a
DN
3785 return MATCH_NO;
3786 }
3787
3788 /* If the function is generic, check all of its specific
3789 incarnations. If the generic name is also a specific, we check
3790 that name last, so that any error message will correspond to the
3791 specific. */
a3d3c0f5 3792 gfc_push_suppress_errors ();
6de9cd9a
DN
3793
3794 if (isym->generic)
3795 {
3796 for (specific = isym->specific_head; specific;
3797 specific = specific->next)
3798 {
3799 if (specific == isym)
3800 continue;
3801 if (check_specific (specific, expr, 0) == SUCCESS)
a3d3c0f5
DK
3802 {
3803 gfc_pop_suppress_errors ();
3804 goto got_specific;
3805 }
6de9cd9a
DN
3806 }
3807 }
3808
a3d3c0f5 3809 gfc_pop_suppress_errors ();
6de9cd9a
DN
3810
3811 if (check_specific (isym, expr, error_flag) == FAILURE)
3812 {
a3d3c0f5
DK
3813 if (!error_flag)
3814 gfc_pop_suppress_errors ();
6de9cd9a
DN
3815 return MATCH_NO;
3816 }
3817
3818 specific = isym;
3819
3820got_specific:
3821 expr->value.function.isym = specific;
3822 gfc_intrinsic_symbol (expr->symtree->n.sym);
3823
a3d3c0f5
DK
3824 if (!error_flag)
3825 gfc_pop_suppress_errors ();
3826
6de9cd9a 3827 if (do_simplify (specific, expr) == FAILURE)
14ceeb32 3828 return MATCH_ERROR;
6de9cd9a 3829
e1633d82
DF
3830 /* F95, 7.1.6.1, Initialization expressions
3831 (4) An elemental intrinsic function reference of type integer or
3832 character where each argument is an initialization expression
3833 of type integer or character
3834
3835 F2003, 7.1.7 Initialization expression
3836 (4) A reference to an elemental standard intrinsic function,
3837 where each argument is an initialization expression */
3838
ef7e861a
TB
3839 if (gfc_init_expr && isym->elemental && flag
3840 && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
3841 "as initialization expression with non-integer/non-"
3842 "character arguments at %L", &expr->where) == FAILURE)
e1633d82 3843 return MATCH_ERROR;
6de9cd9a
DN
3844
3845 return MATCH_YES;
3846}
3847
3848
3849/* See if a CALL statement corresponds to an intrinsic subroutine.
3850 Returns MATCH_YES if the subroutine corresponds to an intrinsic,
3851 MATCH_NO if not, and MATCH_ERROR if there was an error (but did
3852 correspond). */
3853
3854match
b251af97 3855gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
6de9cd9a
DN
3856{
3857 gfc_intrinsic_sym *isym;
3858 const char *name;
3859
3860 name = c->symtree->n.sym->name;
3861
cd5ecab6 3862 isym = gfc_find_subroutine (name);
6de9cd9a
DN
3863 if (isym == NULL)
3864 return MATCH_NO;
3865
a3d3c0f5
DK
3866 if (!error_flag)
3867 gfc_push_suppress_errors ();
6de9cd9a
DN
3868
3869 init_arglist (isym);
3870
3871 if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
3872 goto fail;
3873
3874 if (isym->check.f1 != NULL)
3875 {
3876 if (do_check (isym, c->ext.actual) == FAILURE)
3877 goto fail;
3878 }
3879 else
3880 {
3881 if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
3882 goto fail;
3883 }
3884
3885 /* The subroutine corresponds to an intrinsic. Allow errors to be
f7b529fa 3886 seen at this point. */
a3d3c0f5
DK
3887 if (!error_flag)
3888 gfc_pop_suppress_errors ();
6de9cd9a 3889
12f681a0 3890 c->resolved_isym = isym;
6de9cd9a
DN
3891 if (isym->resolve.s1 != NULL)
3892 isym->resolve.s1 (c);
3893 else
42a8c358
TB
3894 {
3895 c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
3896 c->resolved_sym->attr.elemental = isym->elemental;
3897 }
6de9cd9a
DN
3898
3899 if (gfc_pure (NULL) && !isym->elemental)
3900 {
3901 gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
3902 &c->loc);
3903 return MATCH_ERROR;
3904 }
3905
fe58e076 3906 c->resolved_sym->attr.noreturn = isym->noreturn;
b7892582 3907
6de9cd9a
DN
3908 return MATCH_YES;
3909
3910fail:
a3d3c0f5
DK
3911 if (!error_flag)
3912 gfc_pop_suppress_errors ();
6de9cd9a
DN
3913 return MATCH_NO;
3914}
3915
3916
3917/* Call gfc_convert_type() with warning enabled. */
3918
17b1d2a0 3919gfc_try
b251af97 3920gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
6de9cd9a
DN
3921{
3922 return gfc_convert_type_warn (expr, ts, eflag, 1);
3923}
3924
3925
3926/* Try to convert an expression (in place) from one type to another.
3927 'eflag' controls the behavior on error.
3928
3929 The possible values are:
3930
3931 1 Generate a gfc_error()
3932 2 Generate a gfc_internal_error().
3933
3934 'wflag' controls the warning related to conversion. */
3935
17b1d2a0 3936gfc_try
b251af97 3937gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
6de9cd9a
DN
3938{
3939 gfc_intrinsic_sym *sym;
3940 gfc_typespec from_ts;
3941 locus old_where;
7b901ac4 3942 gfc_expr *new_expr;
6de9cd9a 3943 int rank;
323c74da 3944 mpz_t *shape;
6de9cd9a
DN
3945
3946 from_ts = expr->ts; /* expr->ts gets clobbered */
3947
3948 if (ts->type == BT_UNKNOWN)
3949 goto bad;
3950
3951 /* NULL and zero size arrays get their type here. */
3952 if (expr->expr_type == EXPR_NULL
b251af97 3953 || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
6de9cd9a
DN
3954 {
3955 /* Sometimes the RHS acquire the type. */
3956 expr->ts = *ts;
3957 return SUCCESS;
3958 }
3959
3960 if (expr->ts.type == BT_UNKNOWN)
3961 goto bad;
3962
b251af97 3963 if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
6de9cd9a
DN
3964 && gfc_compare_types (&expr->ts, ts))
3965 return SUCCESS;
3966
3967 sym = find_conv (&expr->ts, ts);
3968 if (sym == NULL)
3969 goto bad;
3970
3971 /* At this point, a conversion is necessary. A warning may be needed. */
c3a29423
RS
3972 if ((gfc_option.warn_std & sym->standard) != 0)
3973 gfc_warning_now ("Extension: Conversion from %s to %s at %L",
3974 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3975 else if (wflag && gfc_option.warn_conversion)
6de9cd9a
DN
3976 gfc_warning_now ("Conversion from %s to %s at %L",
3977 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
3978
3979 /* Insert a pre-resolved function call to the right function. */
3980 old_where = expr->where;
3981 rank = expr->rank;
323c74da
RH
3982 shape = expr->shape;
3983
7b901ac4
KG
3984 new_expr = gfc_get_expr ();
3985 *new_expr = *expr;
3986
3987 new_expr = gfc_build_conversion (new_expr);
3988 new_expr->value.function.name = sym->lib_name;
3989 new_expr->value.function.isym = sym;
3990 new_expr->where = old_where;
3991 new_expr->rank = rank;
3992 new_expr->shape = gfc_copy_shape (shape, rank);
3993
3994 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
3995 new_expr->symtree->n.sym->ts = *ts;
3996 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
3997 new_expr->symtree->n.sym->attr.function = 1;
3998 new_expr->symtree->n.sym->attr.elemental = 1;
3999 new_expr->symtree->n.sym->attr.pure = 1;
4000 new_expr->symtree->n.sym->attr.referenced = 1;
4001 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4002 gfc_commit_symbol (new_expr->symtree->n.sym);
4003
4004 *expr = *new_expr;
4005
4006 gfc_free (new_expr);
6de9cd9a
DN
4007 expr->ts = *ts;
4008
4009 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4010 && do_simplify (sym, expr) == FAILURE)
4011 {
4012
4013 if (eflag == 2)
4014 goto bad;
4015 return FAILURE; /* Error already generated in do_simplify() */
4016 }
4017
4018 return SUCCESS;
4019
4020bad:
4021 if (eflag == 1)
4022 {
4023 gfc_error ("Can't convert %s to %s at %L",
4024 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
4025 return FAILURE;
4026 }
4027
4028 gfc_internal_error ("Can't convert %s to %s at %L",
4029 gfc_typename (&from_ts), gfc_typename (ts),
4030 &expr->where);
4031 /* Not reached */
4032}
d393bbd7
FXC
4033
4034
17b1d2a0 4035gfc_try
d393bbd7
FXC
4036gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
4037{
4038 gfc_intrinsic_sym *sym;
4039 gfc_typespec from_ts;
4040 locus old_where;
7b901ac4 4041 gfc_expr *new_expr;
d393bbd7
FXC
4042 int rank;
4043 mpz_t *shape;
4044
4045 gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
4046 from_ts = expr->ts; /* expr->ts gets clobbered */
4047
4048 sym = find_char_conv (&expr->ts, ts);
4049 gcc_assert (sym);
4050
4051 /* Insert a pre-resolved function call to the right function. */
4052 old_where = expr->where;
4053 rank = expr->rank;
4054 shape = expr->shape;
4055
7b901ac4
KG
4056 new_expr = gfc_get_expr ();
4057 *new_expr = *expr;
d393bbd7 4058
7b901ac4
KG
4059 new_expr = gfc_build_conversion (new_expr);
4060 new_expr->value.function.name = sym->lib_name;
4061 new_expr->value.function.isym = sym;
4062 new_expr->where = old_where;
4063 new_expr->rank = rank;
4064 new_expr->shape = gfc_copy_shape (shape, rank);
d393bbd7 4065
7b901ac4
KG
4066 gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
4067 new_expr->symtree->n.sym->ts = *ts;
4068 new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
4069 new_expr->symtree->n.sym->attr.function = 1;
4070 new_expr->symtree->n.sym->attr.elemental = 1;
4071 new_expr->symtree->n.sym->attr.referenced = 1;
4072 gfc_intrinsic_symbol(new_expr->symtree->n.sym);
4073 gfc_commit_symbol (new_expr->symtree->n.sym);
d393bbd7 4074
7b901ac4 4075 *expr = *new_expr;
d393bbd7 4076
7b901ac4 4077 gfc_free (new_expr);
d393bbd7
FXC
4078 expr->ts = *ts;
4079
4080 if (gfc_is_constant_expr (expr->value.function.actual->expr)
4081 && do_simplify (sym, expr) == FAILURE)
4082 {
4083 /* Error already generated in do_simplify() */
4084 return FAILURE;
4085 }
4086
4087 return SUCCESS;
4088}
c3005b0f
DK
4089
4090
4091/* Check if the passed name is name of an intrinsic (taking into account the
4092 current -std=* and -fall-intrinsic settings). If it is, see if we should
4093 warn about this as a user-procedure having the same name as an intrinsic
4094 (-Wintrinsic-shadow enabled) and do so if we should. */
4095
4096void
4097gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
4098{
4099 gfc_intrinsic_sym* isym;
4100
4101 /* If the warning is disabled, do nothing at all. */
4102 if (!gfc_option.warn_intrinsic_shadow)
4103 return;
4104
4105 /* Try to find an intrinsic of the same name. */
4106 if (func)
4107 isym = gfc_find_function (sym->name);
4108 else
4109 isym = gfc_find_subroutine (sym->name);
4110
4111 /* If no intrinsic was found with this name or it's not included in the
4112 selected standard, everything's fine. */
4113 if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
4114 sym->declared_at) == FAILURE)
4115 return;
4116
4117 /* Emit the warning. */
4118 if (in_module)
4119 gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
4120 " name. In order to call the intrinsic, explicit INTRINSIC"
4121 " declarations may be required.",
4122 sym->name, &sym->declared_at);
4123 else
4124 gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
4125 " only be called via an explicit interface or if declared"
4126 " EXTERNAL.", sym->name, &sym->declared_at);
4127}