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