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