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