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