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