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