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