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