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