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