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