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