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