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